Follow-up of implementation of Test_Case pragma/aspect.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-04 Yannick Moy <m...@adacore.com>
* sem_prag.adb (Check_Arg_Is_String_Literal): remove useless procedure
(Analyze_Pragma): allow static string expression for name of Test_Case,
instead of simply string literals.
* sem_util.adb (Get_Name_From_Test_Case_Pragma): adapt to static string
expressions.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 177388)
+++ sem_prag.adb (working copy)
@@ -335,10 +335,6 @@
-- Check the specified argument Arg to make sure that it is an integer
-- literal. If not give error and raise Pragma_Exit.
- procedure Check_Arg_Is_String_Literal (Arg : Node_Id);
- -- Check the specified argument Arg to make sure that it is a string
- -- literal. If not give error and raise Pragma_Exit.
-
procedure Check_Arg_Is_Library_Level_Local_Name (Arg : Node_Id);
-- Check the specified argument Arg to make sure that it has the proper
-- syntactic form for a local name and meets the semantic requirements
@@ -426,9 +422,9 @@
-- Checks that the given argument has an identifier, and if so, requires
-- it to match one of the given identifier names. If there is no
-- identifier, or a non-matching identifier, then an error message is
- -- given and Pragma_Exit is raised. ??? why is this needed, why isnt
- -- Check_Arg_Is_One_Of good enough. At the very least explain this
- -- odd apparent redundancy
+ -- given and Pragma_Exit is raised. This checks the optional identifier
+ -- of a pragma argument, not the argument itself like
+ -- Check_Arg_Is_One_Of does.
procedure Check_In_Main_Program;
-- Common checks for pragmas that appear within a main program
@@ -901,19 +897,6 @@
end if;
end Check_Arg_Is_Integer_Literal;
- ---------------------------------
- -- Check_Arg_Is_String_Literal --
- ---------------------------------
-
- procedure Check_Arg_Is_String_Literal (Arg : Node_Id) is
- Argx : constant Node_Id := Get_Pragma_Arg (Arg);
- begin
- if Nkind (Argx) /= N_String_Literal then
- Error_Pragma_Arg
- ("argument for pragma% must be string literal", Argx);
- end if;
- end Check_Arg_Is_String_Literal;
-
-------------------------------------------
-- Check_Arg_Is_Library_Level_Local_Name --
-------------------------------------------
@@ -13264,17 +13247,12 @@
-- Test_Case --
---------------
- -- pragma Test_Case ([Name =>] String_EXPRESSION
+ -- pragma Test_Case ([Name =>] static_string_EXPRESSION
-- ,[Mode =>] (Normal | Robustness)
-- [, Requires => Boolean_EXPRESSION]
-- [, Ensures => Boolean_EXPRESSION]);
- -- ??? Why is Name not static_string_EXPRESSION??? Seems very
- -- weird to require it to be a string literal, and if we DO want
- -- that restriction the grammar should make this clear.
-
when Pragma_Test_Case => Test_Case : declare
-
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (3);
@@ -13283,7 +13261,7 @@
((Name_Name, Name_Mode, Name_Requires, Name_Ensures));
Check_Optional_Identifier (Arg1, Name_Name);
- Check_Arg_Is_String_Literal (Arg1);
+ Check_Arg_Is_Static_Expression (Arg1, Standard_String);
Check_Optional_Identifier (Arg2, Name_Mode);
Check_Arg_Is_One_Of (Arg2, Name_Normal, Name_Robustness);
@@ -13291,9 +13269,6 @@
Check_Identifier (Arg3, Name_Requires);
Check_Identifier (Arg4, Name_Ensures);
else
- -- ??? why not Check_Arg_Is_One_Of, very odd!!! At the very
- -- least needs an explanation!
-
Check_Identifier_Is_One_Of (Arg3, Name_Requires, Name_Ensures);
end if;
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 177385)
+++ sem_util.adb (working copy)
@@ -4336,9 +4336,10 @@
------------------------------------
function Get_Name_From_Test_Case_Pragma (N : Node_Id) return String_Id is
+ Arg : constant Node_Id :=
+ Get_Pragma_Arg (First (Pragma_Argument_Associations (N)));
begin
- return
- Strval (Get_Pragma_Arg (First (Pragma_Argument_Associations (N))));
+ return Strval (Expr_Value_S (Arg));
end Get_Name_From_Test_Case_Pragma;
-------------------
