+2018-06-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch8.adb (Find_Direct_Name): Mode the declaration of
+ Is_Assignment_LHS further in. Use predicate
+ Needs_Variable_Reference_Marker to determine whether to create a
+ variable marker.
+ (Find_Expanded_Name): Mode the declaration of Is_Assignment_LHS further
+ in. Use predicate Needs_Variable_Reference_Marker to determine whether
+ to create a variable marker.
+ * sem_elab.adb (Build_Variable_Reference_Marker): Remove the various
+ checks that determine whether the identifier or expanded name is a
+ suitable variable reference. The checks are now performed by
+ Needs_Variable_Reference_Marker.
+ * sem_res.adb (Resolve_Actuals): Use predicate
+ Needs_Variable_Reference_Marker to determine whether to create a
+ variable marker.
+ * sem_util.adb (Needs_Variable_Reference_Marker): New routine.
+ * sem_util.ads (Needs_Variable_Reference_Marker): New routine.
+
2018-06-11 Valentine Reboul <reboul@adacore.com>
* doc/gnat_rm.rst, doc/gnat_ugn.rst: Rename "GPL Edition" into
-- Local variables
- Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
-
Nested_Inst : Entity_Id := Empty;
-- The entity of a nested instance which appears within Inst (if any)
-- reference is a write when it appears on the left hand side of an
-- assignment.
- if not Within_Subprogram_Call (N) then
- Build_Variable_Reference_Marker
- (N => N,
- Read => not Is_Assignment_LHS,
- Write => Is_Assignment_LHS);
+ if Needs_Variable_Reference_Marker
+ (N => N,
+ Calls_OK => False)
+ then
+ declare
+ Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
+
+ begin
+ Build_Variable_Reference_Marker
+ (N => N,
+ Read => not Is_Assignment_LHS,
+ Write => Is_Assignment_LHS);
+ end;
end if;
end Find_Direct_Name;
-- Local variables
- Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
- Selector : constant Node_Id := Selector_Name (N);
+ Selector : constant Node_Id := Selector_Name (N);
Candidate : Entity_Id := Empty;
P_Name : Entity_Id;
-- reference is a write when it appears on the left hand side of an
-- assignment.
- if not Within_Subprogram_Call (N) then
- Build_Variable_Reference_Marker
- (N => N,
- Read => not Is_Assignment_LHS,
- Write => Is_Assignment_LHS);
+ if Needs_Variable_Reference_Marker
+ (N => N,
+ Calls_OK => False)
+ then
+ declare
+ Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
+
+ begin
+ Build_Variable_Reference_Marker
+ (N => N,
+ Read => not Is_Assignment_LHS,
+ Write => Is_Assignment_LHS);
+ end;
end if;
end Find_Expanded_Name;
----------------------
procedure Mark_Use_Clauses (Id : Node_Or_Entity_Id) is
-
procedure Mark_Parameters (Call : Entity_Id);
-- Perform use_type_clause marking for all parameters in a subprogram
-- or operator call.
if Legacy_Elaboration_Checks then
return;
- -- Nothing to do for ASIS. As a result, ABE checks and diagnostics are
- -- not performed in this mode.
+ -- Nothing to do for ASIS because ABE checks and diagnostics are not
+ -- performed in this mode.
elsif ASIS_Mode then
return;
Read : Boolean;
Write : Boolean)
is
- function In_Compilation_Instance_Formal_Part
- (Nod : Node_Id) return Boolean;
- -- Determine whether arbitrary node Nod appears within the formal part
- -- of an instantiation which acts as a compilation unit.
-
- function In_Pragma (Nod : Node_Id) return Boolean;
- -- Determine whether arbitrary node Nod appears within a pragma
-
- -----------------------------------------
- -- In_Compilation_Instance_Formal_Part --
- -----------------------------------------
-
- function In_Compilation_Instance_Formal_Part
- (Nod : Node_Id) return Boolean
- is
- Par : Node_Id;
-
- begin
- Par := Nod;
- while Present (Par) loop
- if Nkind (Par) = N_Generic_Association
- and then Nkind (Parent (Par)) in N_Generic_Instantiation
- and then Nkind (Parent (Parent (Par))) = N_Compilation_Unit
- then
- return True;
-
- -- Prevent the search from going too far
-
- elsif Is_Body_Or_Package_Declaration (Par) then
- exit;
- end if;
-
- Par := Parent (Par);
- end loop;
-
- return False;
- end In_Compilation_Instance_Formal_Part;
-
- ---------------
- -- In_Pragma --
- ---------------
-
- function In_Pragma (Nod : Node_Id) return Boolean is
- Par : Node_Id;
-
- begin
- Par := Nod;
- while Present (Par) loop
- if Nkind (Par) = N_Pragma then
- return True;
-
- -- Prevent the search from going too far
-
- elsif Is_Body_Or_Package_Declaration (Par) then
- exit;
- end if;
-
- Par := Parent (Par);
- end loop;
-
- return False;
- end In_Pragma;
-
- -- Local variables
-
Marker : Node_Id;
- Prag : Node_Id;
Var_Attrs : Variable_Attributes;
Var_Id : Entity_Id;
- -- Start of processing for Build_Variable_Reference_Marker
-
begin
- -- Nothing to do when switch -gnatH (legacy elaboration checking mode
- -- enabled) is in effect because the legacy ABE mechanism does not need
- -- to carry out this action.
-
- if Legacy_Elaboration_Checks then
- return;
-
- -- Nothing to do for ASIS. As a result, ABE checks and diagnostics are
- -- not performed in this mode.
-
- elsif ASIS_Mode then
- return;
-
- -- Nothing to do when the reference is being preanalyzed as the marker
- -- will be inserted in the wrong place.
-
- elsif Preanalysis_Active then
- return;
-
- -- Nothing to do when the input does not denote a reference
-
- elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then
- return;
-
- -- Nothing to do for internally-generated references
-
- elsif not Comes_From_Source (N) then
- return;
-
- -- Nothing to do when the reference is erroneous, left in a bad state,
- -- or does not denote a variable.
-
- elsif not (Present (Entity (N))
- and then Ekind (Entity (N)) = E_Variable
- and then Entity (N) /= Any_Id)
- then
- return;
-
- -- Nothing to do when the reference appears within the formal part of
- -- an instantiation which acts as compilation unit because there is no
- -- proper context for the insertion of the marker.
-
- -- Performance note: parent traversal
-
- elsif In_Compilation_Instance_Formal_Part (N) then
- return;
- end if;
-
Extract_Variable_Reference_Attributes
(Ref => N,
Var_Id => Var_Id,
Attrs => Var_Attrs);
- Prag := SPARK_Pragma (Var_Id);
-
- if Comes_From_Source (Var_Id)
-
- -- Both the variable and the reference must appear in SPARK_Mode On
- -- regions because this scenario falls under the SPARK rules.
-
- and then Present (Prag)
- and then Get_SPARK_Mode_From_Annotation (Prag) = On
- and then Is_SPARK_Mode_On_Node (N)
-
- -- The reference must not be considered when it appears in a pragma.
- -- If the pragma has run-time semantics, then the reference will be
- -- reconsidered once the pragma is expanded.
-
- -- Performance note: parent traversal
-
- and then not In_Pragma (N)
- then
- null;
-
- -- Otherwise the reference is not suitable for ABE processing. This
- -- prevents the generation of variable markers which will never play
- -- a role in ABE diagnostics.
-
- else
- return;
- end if;
-
- -- At this point it is known that the variable reference will play some
- -- role in ABE checks and diagnostics. Create a corresponding variable
- -- marker in case the original variable reference is folded or optimized
- -- away.
-
Marker := Make_Variable_Reference_Marker (Sloc (N));
-- Inherit the attributes of the original variable reference
if Legacy_Elaboration_Checks then
return;
- -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics
- -- are performed in this mode.
+ -- Nothing to do for ASIS because ABE checks and diagnostics are not
+ -- performed in this mode.
elsif ASIS_Mode then
return;
if Legacy_Elaboration_Checks then
return;
- -- Nothing to do for ASIS. As a result, no ABE checks and diagnostics
- -- are performed in this mode.
+ -- Nothing to do for ASIS because ABE checks and diagnostics are not
+ -- performed in this mode.
elsif ASIS_Mode then
return;
-- read IN, IN OUT
-- write IN OUT, OUT
- Build_Variable_Reference_Marker
- (N => A,
- Read => Ekind (F) /= E_Out_Parameter,
- Write => Ekind (F) /= E_In_Parameter);
+ if Needs_Variable_Reference_Marker
+ (N => A,
+ Calls_OK => True)
+ then
+ Build_Variable_Reference_Marker
+ (N => A,
+ Read => Ekind (F) /= E_Out_Parameter,
+ Write => Ekind (F) /= E_In_Parameter);
+ end if;
Orig_A := Entity (A);
end if;
end Needs_Simple_Initialization;
+ -------------------------------------
+ -- Needs_Variable_Reference_Marker --
+ -------------------------------------
+
+ function Needs_Variable_Reference_Marker
+ (N : Node_Id;
+ Calls_OK : Boolean) return Boolean
+ is
+ function Within_Suitable_Context (Ref : Node_Id) return Boolean;
+ -- Deteremine whether variable reference Ref appears within a suitable
+ -- context that allows the creation of a marker.
+
+ -----------------------------
+ -- Within_Suitable_Context --
+ -----------------------------
+
+ function Within_Suitable_Context (Ref : Node_Id) return Boolean is
+ Par : Node_Id;
+
+ begin
+ Par := Ref;
+ while Present (Par) loop
+
+ -- The context is not suitable when the reference appears within
+ -- the formal part of an instantiation which acts as compilation
+ -- unit because there is no proper list for the insertion of the
+ -- marker.
+
+ if Nkind (Par) = N_Generic_Association
+ and then Nkind (Parent (Par)) in N_Generic_Instantiation
+ and then Nkind (Parent (Parent (Par))) = N_Compilation_Unit
+ then
+ return False;
+
+ -- The context is not suitable when the reference appears within
+ -- a pragma. If the pragma has run-time semantics, the reference
+ -- will be reconsidered once the pragma is expanded.
+
+ elsif Nkind (Par) = N_Pragma then
+ return False;
+
+ -- The context is not suitable when the reference appears within a
+ -- subprogram call, and the caller requests this behavior.
+
+ elsif not Calls_OK
+ and then Nkind_In (Par, N_Entry_Call_Statement,
+ N_Function_Call,
+ N_Procedure_Call_Statement)
+ then
+ return False;
+
+ -- Prevent the search from going too far
+
+ elsif Is_Body_Or_Package_Declaration (Par) then
+ exit;
+ end if;
+
+ Par := Parent (Par);
+ end loop;
+
+ return True;
+ end Within_Suitable_Context;
+
+ -- Local variables
+
+ Prag : Node_Id;
+ Var_Id : Entity_Id;
+
+ -- Start of processing for Needs_Variable_Reference_Marker
+
+ begin
+ -- No marker needs to be created when switch -gnatH (legacy elaboration
+ -- checking mode enabled) is in effect because the legacy ABE mechanism
+ -- does use markers.
+
+ if Legacy_Elaboration_Checks then
+ return False;
+
+ -- No marker needs to be created for ASIS because ABE diagnostics and
+ -- checks are not performed in this mode.
+
+ elsif ASIS_Mode then
+ return False;
+
+ -- No marker needs to be created when the reference is preanalyzed
+ -- because the marker will be inserted in the wrong place.
+
+ elsif Preanalysis_Active then
+ return False;
+
+ -- Only references warrant a marker
+
+ elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then
+ return False;
+
+ -- Only source references warrant a marker
+
+ elsif not Comes_From_Source (N) then
+ return False;
+
+ -- No marker needs to be created when the reference is erroneous, left
+ -- in a bad state, or does not denote a variable.
+
+ elsif not (Present (Entity (N))
+ and then Ekind (Entity (N)) = E_Variable
+ and then Entity (N) /= Any_Id)
+ then
+ return False;
+ end if;
+
+ Var_Id := Entity (N);
+ Prag := SPARK_Pragma (Var_Id);
+
+ -- Both the variable and reference must appear in SPARK_Mode On regions
+ -- because this elaboration scenario falls under the SPARK rules.
+
+ if not (Comes_From_Source (Var_Id)
+ and then Present (Prag)
+ and then Get_SPARK_Mode_From_Annotation (Prag) = On
+ and then Is_SPARK_Mode_On_Node (N))
+ then
+ return False;
+
+ -- No marker needs to be created when the reference does not appear
+ -- within a suitable context (see body for details).
+
+ -- Performance note: parent traversal
+
+ elsif not Within_Suitable_Context (N) then
+ return False;
+ end if;
+
+ -- At this point it is known that the variable reference will play a
+ -- role in ABE diagnostics and requires a marker.
+
+ return True;
+ end Needs_Variable_Reference_Marker;
+
------------------------
-- New_Copy_List_Tree --
------------------------
-- set to False, but if Consider_IS is set to True, then the cases above
-- mentioning Normalize_Scalars also apply for Initialize_Scalars mode.
+ function Needs_Variable_Reference_Marker
+ (N : Node_Id;
+ Calls_OK : Boolean) return Boolean;
+ -- Determine whether arbitrary node N denotes a reference to a variable
+ -- which is suitable for SPARK elaboration checks. Flag Calls_OK should
+ -- be set when the reference is allowed to appear within calls.
+
function New_Copy_List_Tree (List : List_Id) return List_Id;
-- Copy recursively an analyzed list of nodes. Uses New_Copy_Tree defined
-- below. As for New_Copy_Tree, it is illegal to attempt to copy extended
projects / gcc.git / commitdiff