In ASIS mode, the source aspect for Pre/Post/Test_Case should be semantically
analyzed, as this is the node that is read by ASIS tools. This does not occur
in normal compilation mode, as the source aspect is first rewritten in a
pragma, and the pragma is analyzed instead. Now, the source aspect is also
analyzed in ASIS mode.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-04 Yannick Moy <m...@adacore.com>
* atree.adb, atree.ads (Set_Original_Node): New set procedure.
* sem_ch13.adb (Analyze_Aspect_Specifications/Pre_Post_Aspects):
In ASIS mode, no splitting of aspects between conjuncts.
(Analyze_Aspect_Specifications/Aspect_Test_Case): Make pragma
expressions refer to the original aspect expressions through
the Original_Node link. This is used in semantic analysis for
ASIS mode, so that the original expression also gets analyzed.
* sem_prag.adb (Preanalyze_TC_Args,
Check_Precondition_Postcondition,
Analyze_Pragma/Pragma_Test_Case): In ASIS mode, for a pragma
generated from a source aspect, also analyze the original aspect
expression.
(Check_Expr_Is_Static_Expression): New procedure
similar to existing procedure Check_Arg_Is_Static_Expression,
except called on expression inside pragma.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 180943)
+++ sem_prag.adb (working copy)
@@ -181,7 +181,7 @@
-- original one, following the renaming chain) is returned. Otherwise the
-- entity is returned unchanged. Should be in Einfo???
- procedure Preanalyze_TC_Args (Arg_Req, Arg_Ens : Node_Id);
+ procedure Preanalyze_TC_Args (N, Arg_Req, Arg_Ens : Node_Id);
-- Preanalyze the boolean expressions in the Requires and Ensures arguments
-- of a Test_Case pragma if present (possibly Empty). We treat these as
-- spec expressions (i.e. similar to a default expression).
@@ -260,9 +260,18 @@
-- Preanalyze the boolean expression, we treat this as a spec expression
-- (i.e. similar to a default expression).
- Preanalyze_Spec_Expression
- (Get_Pragma_Arg (Arg1), Standard_Boolean);
+ Preanalyze_Spec_Expression (Get_Pragma_Arg (Arg1), Standard_Boolean);
+ -- In ASIS mode, for a pragma generated from a source aspect, also
+ -- analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Preanalyze_Spec_Expression
+ (Expression (Corresponding_Aspect (N)), Standard_Boolean);
+ end if;
+
-- For a class-wide condition, a reference to a controlling formal must
-- be interpreted as having the class-wide type (or an access to such)
-- so that the inherited condition can be properly applied to any
@@ -518,6 +527,15 @@
-- This procedure checks for possible duplications if this is the export
-- case, and if found, issues an appropriate error message.
+ procedure Check_Expr_Is_Static_Expression
+ (Argx : Node_Id;
+ Typ : Entity_Id := Empty);
+ -- Check the specified expression Argx to make sure that it is a static
+ -- expression of the given type (i.e. it will be analyzed and resolved
+ -- using this type, which can be any valid argument to Resolve, e.g.
+ -- Any_Integer is OK). If not, given error and raise Pragma_Exit. If
+ -- Typ is left Empty, then any static expression is allowed.
+
procedure Check_First_Subtype (Arg : Node_Id);
-- Checks that Arg, whose expression is an entity name, references a
-- first subtype.
@@ -1197,55 +1215,9 @@
procedure Check_Arg_Is_Static_Expression
(Arg : Node_Id;
- Typ : Entity_Id := Empty)
- is
- Argx : constant Node_Id := Get_Pragma_Arg (Arg);
-
+ Typ : Entity_Id := Empty) is
begin
- if Present (Typ) then
- Analyze_And_Resolve (Argx, Typ);
- else
- Analyze_And_Resolve (Argx);
- end if;
-
- if Is_OK_Static_Expression (Argx) then
- return;
-
- elsif Etype (Argx) = Any_Type then
- raise Pragma_Exit;
-
- -- An interesting special case, if we have a string literal and we
- -- are in Ada 83 mode, then we allow it even though it will not be
- -- flagged as static. This allows the use of Ada 95 pragmas like
- -- Import in Ada 83 mode. They will of course be flagged with
- -- warnings as usual, but will not cause errors.
-
- elsif Ada_Version = Ada_83
- and then Nkind (Argx) = N_String_Literal
- then
- return;
-
- -- Static expression that raises Constraint_Error. This has already
- -- been flagged, so just exit from pragma processing.
-
- elsif Is_Static_Expression (Argx) then
- raise Pragma_Exit;
-
- -- Finally, we have a real error
-
- else
- Error_Msg_Name_1 := Pname;
-
- declare
- Msg : String :=
- "argument for pragma% must be a static expression!";
- begin
- Fix_Error (Msg);
- Flag_Non_Static_Expr (Msg, Argx);
- end;
-
- raise Pragma_Exit;
- end if;
+ Check_Expr_Is_Static_Expression (Get_Pragma_Arg (Arg), Typ);
end Check_Arg_Is_Static_Expression;
------------------------------------------
@@ -1478,6 +1450,60 @@
end if;
end Check_Duplicated_Export_Name;
+ -------------------------------------
+ -- Check_Expr_Is_Static_Expression --
+ -------------------------------------
+
+ procedure Check_Expr_Is_Static_Expression
+ (Argx : Node_Id;
+ Typ : Entity_Id := Empty) is
+ begin
+ if Present (Typ) then
+ Analyze_And_Resolve (Argx, Typ);
+ else
+ Analyze_And_Resolve (Argx);
+ end if;
+
+ if Is_OK_Static_Expression (Argx) then
+ return;
+
+ elsif Etype (Argx) = Any_Type then
+ raise Pragma_Exit;
+
+ -- An interesting special case, if we have a string literal and we
+ -- are in Ada 83 mode, then we allow it even though it will not be
+ -- flagged as static. This allows the use of Ada 95 pragmas like
+ -- Import in Ada 83 mode. They will of course be flagged with
+ -- warnings as usual, but will not cause errors.
+
+ elsif Ada_Version = Ada_83
+ and then Nkind (Argx) = N_String_Literal
+ then
+ return;
+
+ -- Static expression that raises Constraint_Error. This has already
+ -- been flagged, so just exit from pragma processing.
+
+ elsif Is_Static_Expression (Argx) then
+ raise Pragma_Exit;
+
+ -- Finally, we have a real error
+
+ else
+ Error_Msg_Name_1 := Pname;
+
+ declare
+ Msg : String :=
+ "argument for pragma% must be a static expression!";
+ begin
+ Fix_Error (Msg);
+ Flag_Non_Static_Expr (Msg, Argx);
+ end;
+
+ raise Pragma_Exit;
+ end if;
+ end Check_Expr_Is_Static_Expression;
+
-------------------------
-- Check_First_Subtype --
-------------------------
@@ -1980,6 +2006,16 @@
Preanalyze_Spec_Expression
(Get_Pragma_Arg (Arg1), Standard_Boolean);
+
+ -- In ASIS mode, for a pragma generated from a source aspect,
+ -- also analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Preanalyze_Spec_Expression
+ (Expression (Corresponding_Aspect (N)), Standard_Boolean);
+ end if;
end if;
In_Body := True;
@@ -13678,6 +13714,17 @@
Check_Optional_Identifier (Arg1, Name_Name);
Check_Arg_Is_Static_Expression (Arg1, Standard_String);
+
+ -- In ASIS mode, for a pragma generated from a source aspect, also
+ -- analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Check_Expr_Is_Static_Expression
+ (Original_Node (Get_Pragma_Arg (Arg1)), Standard_String);
+ end if;
+
Check_Optional_Identifier (Arg2, Name_Mode);
Check_Arg_Is_One_Of (Arg2, Name_Nominal, Name_Robustness);
@@ -14566,7 +14613,8 @@
-- Preanalyze the boolean expressions, we treat these as spec
-- expressions (i.e. similar to a default expression).
- Preanalyze_TC_Args (Get_Requires_From_Test_Case_Pragma (N),
+ Preanalyze_TC_Args (N,
+ Get_Requires_From_Test_Case_Pragma (N),
Get_Ensures_From_Test_Case_Pragma (N));
-- Remove the subprogram from the scope stack now that the pre-analysis
@@ -15086,19 +15134,41 @@
-- Preanalyze_TC_Args --
------------------------
- procedure Preanalyze_TC_Args (Arg_Req, Arg_Ens : Node_Id) is
+ procedure Preanalyze_TC_Args (N, Arg_Req, Arg_Ens : Node_Id) is
begin
-- Preanalyze the boolean expressions, we treat these as spec
-- expressions (i.e. similar to a default expression).
if Present (Arg_Req) then
+
Preanalyze_Spec_Expression
(Get_Pragma_Arg (Arg_Req), Standard_Boolean);
+
+ -- In ASIS mode, for a pragma generated from a source aspect, also
+ -- analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Preanalyze_Spec_Expression
+ (Original_Node (Get_Pragma_Arg (Arg_Req)), Standard_Boolean);
+ end if;
end if;
if Present (Arg_Ens) then
+
Preanalyze_Spec_Expression
(Get_Pragma_Arg (Arg_Ens), Standard_Boolean);
+
+ -- In ASIS mode, for a pragma generated from a source aspect, also
+ -- analyze the original aspect expression.
+
+ if ASIS_Mode
+ and then Present (Corresponding_Aspect (N))
+ then
+ Preanalyze_Spec_Expression
+ (Original_Node (Get_Pragma_Arg (Arg_Ens)), Standard_Boolean);
+ end if;
end if;
end Preanalyze_TC_Args;
Index: atree.adb
===================================================================
--- atree.adb (revision 180934)
+++ atree.adb (working copy)
@@ -1797,6 +1797,15 @@
Nodes.Table (N).Has_Aspects := Val;
end Set_Has_Aspects;
+ -----------------------
+ -- Set_Original_Node --
+ -----------------------
+
+ procedure Set_Original_Node (N : Node_Id; Val : Node_Id) is
+ begin
+ Orig_Nodes.Table (N) := Val;
+ end Set_Original_Node;
+
---------------------
-- Set_Paren_Count --
---------------------
Index: atree.ads
===================================================================
--- atree.ads (revision 180934)
+++ atree.ads (working copy)
@@ -761,6 +761,9 @@
procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True);
pragma Inline (Set_Has_Aspects);
+ procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
+ pragma Inline (Set_Original_Node);
+
------------------------------
-- Entity Update Procedures --
------------------------------
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 180934)
+++ sem_ch13.adb (working copy)
@@ -1231,8 +1231,13 @@
-- We do not do this for Pre'Class, since we have to put
-- these conditions together in a complex OR expression
- if Pname = Name_Postcondition
- or else not Class_Present (Aspect)
+ -- We do not do this in ASIS mode, as ASIS relies on the
+ -- original node representing the complete expression, when
+ -- retrieving it through the source aspect table.
+
+ if not ASIS_Mode
+ and then (Pname = Name_Postcondition
+ or else not Class_Present (Aspect))
then
while Nkind (Expr) = N_And_Then loop
Insert_After (Aspect,
@@ -1385,6 +1390,7 @@
Args : List_Id;
Comp_Expr : Node_Id;
Comp_Assn : Node_Id;
+ New_Expr : Node_Id;
begin
Args := New_List;
@@ -1401,11 +1407,18 @@
goto Continue;
end if;
+ -- Make pragma expressions refer to the original aspect
+ -- expressions through the Original_Node link. This is used
+ -- in semantic analysis for ASIS mode, so that the original
+ -- expression also gets analyzed.
+
Comp_Expr := First (Expressions (Expr));
while Present (Comp_Expr) loop
+ New_Expr := Relocate_Node (Comp_Expr);
+ Set_Original_Node (New_Expr, Comp_Expr);
Append
(Make_Pragma_Argument_Association (Sloc (Comp_Expr),
- Expression => Relocate_Node (Comp_Expr)),
+ Expression => New_Expr),
Args);
Next (Comp_Expr);
end loop;
@@ -1421,10 +1434,12 @@
goto Continue;
end if;
+ New_Expr := Relocate_Node (Expression (Comp_Assn));
+ Set_Original_Node (New_Expr, Expression (Comp_Assn));
Append (Make_Pragma_Argument_Association (
Sloc => Sloc (Comp_Assn),
Chars => Chars (First (Choices (Comp_Assn))),
- Expression => Relocate_Node (Expression (Comp_Assn))),
+ Expression => New_Expr),
Args);
Next (Comp_Assn);
end loop;
@@ -8732,8 +8747,8 @@
Source : constant Entity_Id := T.Source;
Target : constant Entity_Id := T.Target;
- Source_Siz : Uint;
- Target_Siz : Uint;
+ Source_Siz : Uint;
+ Target_Siz : Uint;
begin
-- This validation check, which warns if we have unequal sizes for
