Skip to content

Commit d151130

Browse files
author
Viviane Garese
committed
Merge branch 'mr/backport/release-25.2-issue-eng/ide/libadalang-tools_243' into '25.2'
[25.2] Backport of #243 See merge request eng/ide/libadalang-tools!322
2 parents 00c51d8 + 6bd0303 commit d151130

File tree

8 files changed

+137
-45
lines changed

8 files changed

+137
-45
lines changed

‎src/test-actions.adb‎

Lines changed: 91 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -220,16 +220,26 @@ package body Test.Actions is
220220
Test.Common.Lang_Version :=
221221
Utils.Command_Lines.Common.Ada_Version_Switches.Arg (Cmd);
222222

223-
if Arg (Cmd, Passed_Tests) /= null then
224-
if Arg (Cmd, Passed_Tests).all = "hide" then
225-
Test.Common.Show_Passed_Tests := False;
226-
elsif Arg (Cmd, Passed_Tests).all = "show" then
227-
Test.Common.Show_Passed_Tests := True;
228-
else
229-
Cmd_Error_No_Help
230-
("--passed-tests should be either show or hide");
223+
-- Passed_Tests
224+
declare
225+
Passed_Test_Arg : constant String_Ref := Arg (Cmd, Passed_Tests);
226+
Present : constant Boolean := Passed_Test_Arg /= null;
227+
Passed_Test_Arg_Val : constant String :=
228+
(if Present then To_Lower (Passed_Test_Arg.all) else "");
229+
begin
230+
if Present then
231+
if Passed_Test_Arg_Val = "hide" then
232+
Test.Common.Show_Passed_Tests := False;
233+
234+
elsif Passed_Test_Arg_Val = "show" then
235+
Test.Common.Show_Passed_Tests := True;
236+
237+
else
238+
Cmd_Error_No_Help
239+
("--passed-tests should be either show or hide");
240+
end if;
231241
end if;
232-
end if;
242+
end;
233243

234244
if Status (Tool.Project_Tree.all) = Empty then
235245

@@ -571,57 +581,93 @@ package body Test.Actions is
571581

572582
-- Default behaviour of tests
573583
declare
584+
Skeleton_Default_Switch : constant String_Ref :=
585+
Arg (Cmd, Skeleton_Default);
586+
574587
Skeleton_Default_Att : constant Attribute_Pkg_String :=
575588
Build_Att_String ("skeletons_default");
589+
590+
Present : constant Boolean :=
591+
Skeleton_Default_Switch /= null
592+
or else Root_Prj.Has_Attribute (Skeleton_Default_Att);
593+
576594
Skeleton_Default_Val : constant String :=
577-
(if Arg (Cmd, Skeleton_Default) = null then
578-
(if Root_Prj.Has_Attribute (Skeleton_Default_Att) then
579-
Root_Prj.Attribute_Value (Skeleton_Default_Att)
580-
else
581-
"")
582-
else Arg (Cmd, Skeleton_Default).all);
595+
To_Lower
596+
((if Skeleton_Default_Switch = null then
597+
(if Root_Prj.Has_Attribute (Skeleton_Default_Att)
598+
then Root_Prj.Attribute_Value (Skeleton_Default_Att)
599+
else "")
600+
else Arg (Cmd, Skeleton_Default).all));
601+
-- If Skeleton_Default was specified through a switch, use this
602+
-- value. Otherwise, if it was specified through a project file
603+
-- attribute, use this value. If it was not specified, set it to the
604+
-- empty string.
583605
begin
584-
if Skeleton_Default_Val = "pass" then
585-
Test.Common.Skeletons_Fail := False;
586-
elsif Skeleton_Default_Val = "fail" then
587-
Test.Common.Skeletons_Fail := True;
588-
elsif Skeleton_Default_Val /= "" then
589-
if Arg (Cmd, Skeleton_Default) = null then
590-
Cmd_Error_No_Help
591-
("--skeleton-default should be either fail or pass");
592-
else
606+
if Present then
607+
if Skeleton_Default_Val = "pass" then
608+
Test.Common.Skeletons_Fail := False;
609+
610+
elsif Skeleton_Default_Val = "fail" then
611+
Test.Common.Skeletons_Fail := True;
612+
613+
elsif Skeleton_Default_Val /= "" then
593614
Cmd_Error_No_Help
594-
("Gnattest.Skeletons_Default should be either fail or pass");
615+
((if Skeleton_Default_Switch /= null
616+
then "--skeleton-default"
617+
else "Gnattest.Skeletons_Default")
618+
& " should be either fail or pass");
595619
end if;
596620
end if;
597621
end;
598622

599623
-- Exit status
600-
if Arg (Cmd, Exit_Status) /= null then
601-
if Arg (Cmd, Exit_Status).all = "off" then
602-
Test.Common.Show_Passed_Tests := False;
603-
elsif Arg (Cmd, Exit_Status).all = "on" then
604-
Test.Common.Add_Exit_Status := True;
605-
else
606-
Cmd_Error_No_Help
607-
("--exit-status should be either on or off");
624+
declare
625+
Exit_Status_Switch : constant String_Ref := Arg (Cmd, Exit_Status);
626+
Present : constant Boolean := Exit_Status_Switch /= null;
627+
Exit_Status_Val : constant String :=
628+
(if Present then To_Lower (Exit_Status_Switch.all) else "");
629+
begin
630+
if Present then
631+
if Exit_Status_Val = "off" then
632+
Test.Common.Add_Exit_Status := False;
633+
634+
elsif Exit_Status_Val = "on" then
635+
Test.Common.Add_Exit_Status := True;
636+
637+
else
638+
Cmd_Error_No_Help
639+
("--exit-status should be either on or off");
640+
end if;
608641
end if;
609-
end if;
642+
end;
610643

611644
-- Separate drivers
612-
if Arg (Cmd, Separate_Drivers) /= null then
613-
if Arg (Cmd, Separate_Drivers).all in "unit" | "" then
614-
Test.Common.Separate_Drivers := True;
615-
Test.Common.Driver_Per_Unit := True;
616-
elsif Arg (Cmd, Separate_Drivers).all = "test" then
645+
declare
646+
Separate_Drivers_Switch : constant String_Ref :=
647+
Arg (Cmd, Separate_Drivers);
648+
Present : constant Boolean :=
649+
Separate_Drivers_Switch /= null;
650+
Separate_Drivers_Val : constant String :=
651+
(if Present then To_Lower (Separate_Drivers_Switch.all) else "");
652+
begin
653+
if Present then
617654
Test.Common.Separate_Drivers := True;
618-
Test.Common.Driver_Per_Unit := False;
619-
else
620-
Cmd_Error_No_Help
621-
("--separate-drivers should be either unit or test"
622-
& " >" & Arg (Cmd, Separate_Drivers).all & "<");
655+
656+
if Separate_Drivers_Val = "unit"
657+
or else Separate_Drivers_Val = ""
658+
then
659+
Test.Common.Driver_Per_Unit := True;
660+
661+
elsif Separate_Drivers_Val = "test" then
662+
Test.Common.Driver_Per_Unit := False;
663+
664+
else
665+
Cmd_Error_No_Help
666+
("--separate-drivers should be either unit or test"
667+
& " >" & Separate_Drivers_Switch.all & "<");
668+
end if;
623669
end if;
624-
end if;
670+
end;
625671

626672
-- Reporter
627673
if Arg (Cmd, Reporter) /= null then

‎testsuite/tests/test/243-case_sensitive_attr/main.adb‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
with Ada.Text_IO; use Ada.Text_IO;
2+
3+
with Pkg;
4+
5+
procedure Main is
6+
begin
7+
Put_Line (Pkg.Foo);
8+
end Main;

‎testsuite/tests/test/243-case_sensitive_attr/pkg.adb‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
package body Pkg is
2+
function Foo return String is
3+
begin
4+
return "Foo";
5+
end Foo;
6+
end Pkg;

‎testsuite/tests/test/243-case_sensitive_attr/pkg.ads‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
package Pkg is
2+
function Foo return String;
3+
end Pkg;

‎testsuite/tests/test/243-case_sensitive_attr/test.sh‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
#!/bin/bash
2+
3+
gnattest -q -P test1.gpr
4+
gnattest -q -P test2.gpr

‎testsuite/tests/test/243-case_sensitive_attr/test.yaml‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
description:
2+
For switches --skeleton_default, --passed_tests, --separate-drivers and
3+
--exit-status, check that passing one of their two possible options is
4+
accepted in any casing.
5+
6+
driver: shell_script
7+

‎testsuite/tests/test/243-case_sensitive_attr/test1.gpr‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
project Test1 is
2+
package Gnattest is
3+
for Gnattest_Switches use
4+
("--passed-tests=show",
5+
"--skeleton-default=Fail",
6+
"--separate-drivers=TesT",
7+
"--exit-status=ON");
8+
end Gnattest;
9+
end Test1;

‎testsuite/tests/test/243-case_sensitive_attr/test2.gpr‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
project Test2 is
2+
package Gnattest is
3+
for Skeletons_Default use "PasS";
4+
for Gnattest_Switches use
5+
("--passed-tests=Hide",
6+
"--separate-drivers=uNIT",
7+
"--exit-status=OFF");
8+
end Gnattest;
9+
end Test2;

0 commit comments

Comments
 (0)