Skip to content

Added exact name matching to Test_Filter #26

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
orhanugurlu wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Added exact name matching to Test_Filter #26

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 31 additions & 8 deletions include/aunit/framework/aunit-test_filters.adb
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,16 @@ package body AUnit.Test_Filters is
Filter.Name := Format (Name);
end Set_Name;

---------------------
-- Set_Exact_Match --
---------------------

procedure Set_Exact_Match (Filter : in out Name_Filter;
Exact_Match : Boolean) is
begin
Filter.Exact_Match := Exact_Match;
end Set_Exact_Match;

---------------
-- Is_Active --
---------------
Expand All @@ -80,15 +90,28 @@ package body AUnit.Test_Filters is
end if;

if Routine_Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)) = null then
return Starts_With
(Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all,
Filter.Name.all);
if Filter.Exact_Match then
return Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all
= Filter.Name.all;
else
return Starts_With
(Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all,
Filter.Name.all);
end if;
else
return Starts_With
(Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all
& " : "
& Routine_Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all,
Filter.Name.all);
if Filter.Exact_Match then
return Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all
& " : "
& Routine_Name
(AUnit.Simple_Test_Cases.Test_Case'Class (T)).all
= Filter.Name.all;
else
return Starts_With
(Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all
Copy link

@pjljvandelaar pjljvandelaar May 28, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why didn't you use declare to factor out the common code in both branches, i.e.

Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all                   
& " : "                   
& Routine_Name  (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all

& " : "
& Routine_Name (AUnit.Simple_Test_Cases.Test_Case'Class (T)).all,
Filter.Name.all);
end if;
end if;
end Is_Active;

Expand Down
8 changes: 7 additions & 1 deletion include/aunit/framework/aunit-test_filters.ads
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ package AUnit.Test_Filters is
procedure Set_Name
(Filter : in out Name_Filter; Name : String);
-- Set the name of the test(s) to run.
-- If Exact_Match is set to True, only test with given name will be run.
-- The name can take several forms:
-- * Either the fully qualified name of the test (including routine).
-- For instance, if you have an instance of
Expand All @@ -61,6 +62,10 @@ package AUnit.Test_Filters is
-- all routines for instance
-- If the name is the empty string, all tests will be run

procedure Set_Exact_Match (Filter : in out Name_Filter;
Exact_Match : Boolean);
-- Enables/disables exact name matching

function Is_Active
(Filter : Name_Filter;
T : AUnit.Tests.Test'Class) return Boolean;
Expand All @@ -70,7 +75,8 @@ private
type Test_Filter is abstract tagged limited null record;

type Name_Filter is new Test_Filter with record
Name : Message_String;
Name : Message_String;
Exact_Match : Boolean := False;
end record;

end AUnit.Test_Filters;
16 changes: 11 additions & 5 deletions test/src/aunit_harness.adb
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,10 @@ procedure AUnit_Harness is
procedure Harness is new AUnit.Run.Test_Runner (Suite);
-- The full test harness

Reporter : AUnit.Reporter.Text.Text_Reporter;
Filter : aliased AUnit.Test_Filters.Name_Filter;
Options : AUnit.Options.AUnit_Options :=
Reporter : AUnit.Reporter.Text.Text_Reporter;
Filter : aliased AUnit.Test_Filters.Name_Filter;
Exact_Filter : aliased AUnit.Test_Filters.Name_Filter;
Options : AUnit.Options.AUnit_Options :=
(Global_Timer => False,
Test_Case_Timer => True,
Report_Successes => True,
Expand All @@ -29,9 +30,14 @@ begin
-- This filter should be initialized from the command line arguments. In
-- this example, we don't do it to support limited runtimes with no support
-- for Ada.Command_Line

Options.Filter := Filter'Unchecked_Access;
Set_Name (Filter, "(test_case) Test routines registration");
Set_Name (Filter, "(suite)");
Harness (Reporter, Options);

-- Test exact match option of the filter
Options.Filter := Exact_Filter'Unchecked_Access;
Set_Name (Exact_Filter, "(test_case) Test routines registration");
Set_Exact_Match (Exact_Filter, False);
Harness (Reporter, Options);

end AUnit_Harness;