-- 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
-- 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.
procedure Check_In_Main_Program;
-- Common checks for pragmas that appear within a main program
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 --
-------------------------------------------
(Get_Pragma_Arg (Arg2), Standard_String);
end if;
- -- Record if pragma is enabled
+ -- Record if pragma is disabled
if Check_Enabled (Pname) then
Set_SCO_Pragma_Enabled (Loc);
-- Start of processing for Process_Restrictions_Or_Restriction_Warnings
begin
- -- Ignore all Restrictions pragma in CodePeer mode
+ -- Ignore all Restrictions pragma in CodePeer and ALFA modes
- if CodePeer_Mode then
+ if CodePeer_Mode or ALFA_Mode then
return;
end if;
-- Start of processing for Process_Suppress_Unsuppress
begin
- -- Ignore pragma Suppress/Unsuppress in codepeer mode on user code:
- -- we want to generate checks for analysis purposes, as set by -gnatC
+ -- Ignore pragma Suppress/Unsuppress in CodePeer and ALFA modes on
+ -- user code: we want to generate checks for analysis purposes, as
+ -- set respectively by -gnatC and -gnatd.F
- if CodePeer_Mode and then Comes_From_Source (N) then
+ if (CodePeer_Mode or ALFA_Mode)
+ and then Comes_From_Source (N)
+ then
return;
end if;
(Boolean_Literals (Debug_Pragmas_Enabled and Expander_Active),
Loc);
+ if Debug_Pragmas_Enabled then
+ Set_SCO_Pragma_Enabled (Loc);
+ end if;
+
if Arg_Count = 2 then
Cond :=
Make_And_Then (Loc,
Check_Valid_Configuration_Pragma;
Check_Restriction (No_Initialize_Scalars, N);
- -- Initialize_Scalars creates false positives in CodePeer,
- -- so ignore this pragma in this mode.
+ -- Initialize_Scalars creates false positives in CodePeer, and
+ -- incorrect negative results in ALFA mode, so ignore this pragma
+ -- in these modes.
if not Restriction_Active (No_Initialize_Scalars)
- and then not CodePeer_Mode
+ and then not (CodePeer_Mode or ALFA_Mode)
then
Init_Or_Norm_Scalars := True;
Initialize_Scalars := True;
when Pragma_Inline_Always =>
GNAT_Pragma;
- -- Pragma always active unless in CodePeer mode, since this causes
- -- walk order issues.
+ -- Pragma always active unless in CodePeer or ALFA mode, since
+ -- this causes walk order issues.
- if not CodePeer_Mode then
+ if not (CodePeer_Mode or ALFA_Mode) then
Process_Inline (True);
end if;
Check_Arg_Count (0);
Check_Valid_Configuration_Pragma;
- -- Normalize_Scalars creates false positives in CodePeer, so
- -- ignore this pragma in this mode.
+ -- Normalize_Scalars creates false positives in CodePeer, and
+ -- incorrect negative results in ALFA mode, so ignore this pragma
+ -- in these modes.
- if not CodePeer_Mode then
+ if not (CodePeer_Mode or ALFA_Mode) then
Normalize_Scalars := True;
Init_Or_Norm_Scalars := True;
end if;
-- In the context of static code analysis, we do not need
-- complex front-end expansions related to pragma Pack,
- -- so disable handling of pragma Pack in this case.
+ -- so disable handling of pragma Pack in these cases.
- if CodePeer_Mode then
+ if CodePeer_Mode or ALFA_Mode then
null;
-- Don't attempt any packing for VM targets. We possibly
-- Test_Case --
---------------
- -- pragma Test_Case ([Name =>] String_EXPRESSION
- -- ,[Mode =>] (Normal | Robustness)
+ -- pragma Test_Case ([Name =>] Static_String_EXPRESSION
+ -- ,[Mode =>] MODE_TYPE
-- [, 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.
+ -- MODE_TYPE ::= Normal | Robustness
when Pragma_Test_Case => Test_Case : declare
-
begin
GNAT_Pragma;
Check_At_Least_N_Arguments (3);
Check_At_Most_N_Arguments (4);
Check_Arg_Order
- ((Name_Name, Name_Mode, Name_Requires, Name_Ensures));
+ ((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);
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;
OSDN Git Service
