aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2017-11-08 14:07:31 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2017-11-08 14:07:31 +0000
commitdaf82dd806519e567ca6420b5e1c04ec5b732615 (patch)
tree6d2a5589a44e34dc401f2506ce59561013a2617e /gcc/ada
parent428dab52e965f90ce26925d3a89c2f3c6982b460 (diff)
downloadgcc-daf82dd806519e567ca6420b5e1c04ec5b732615.zip
gcc-daf82dd806519e567ca6420b5e1c04ec5b732615.tar.gz
gcc-daf82dd806519e567ca6420b5e1c04ec5b732615.tar.bz2
exp_ch3.adb (Expand_N_Object_Declaration): Save and restore relevant SPARK-related flags.
2017-11-08 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch3.adb (Expand_N_Object_Declaration): Save and restore relevant SPARK-related flags. Add ??? comment. * exp_util.adb (Insert_Actions): Add an entry for node N_Variable_Reference_Marker. * sem.adb (Analyze): Add an entry for node N_Variable_Reference_Marker. * sem_ch8.adb (Find_Direct_Name): Add constant Is_Assignment_LHS. Build and record a variable reference marker for the current name. (Find_Expanded_Name): Add constant Is_Assignment_LHS. Build and record a variable reference marker for the current name. * sem_elab.adb (Build_Variable_Reference_Marker): New routine. (Extract_Variable_Reference_Attributes): Reimplemented. (Info_Scenario): Add output for variable references and remove output for variable reads. (Info_Variable_Read): Removed. (Info_Variable_Reference): New routine. (Is_Suitable_Scenario): Variable references are now suitable scenarios while variable reads are not. (Output_Active_Scenarios): Add output for variable references and remove output for variable reads. (Output_Variable_Read): Removed. (Output_Variable_Reference): New routine. (Process_Variable_Read): Removed. (Process_Variable_Reference): New routine. (Process_Variable_Reference_Read): New routine. * sem_elab.ads (Build_Variable_Reference_Marker): New routine. * sem_res.adb (Resolve_Actuals): Build and record a variable reference marker for the current actual. * sem_spark.adb (Check_Node): Add an entry for node N_Variable_Reference_Marker. * sem_util.adb (Within_Subprogram_Call): Moved to the library level. * sem_util.ads (Within_Subprogram_Call): Moved to the library level. * sinfo.adb (Is_Read): New routine. (Is_Write): New routine. (Target): Updated to handle variable reference markers. (Set_Is_Read): New routine. (Set_Is_Write): New routine. (Set_Target): Updated to handle variable reference markers. * sinfo.ads: Add new attributes Is_Read and Is_Write along with occurrences in nodes. Update attribute Target. Add new node kind N_Variable_Reference_Marker. (Is_Read): New routine along with pragma Inline. (Is_Write): New routine along with pragma Inline. (Set_Is_Read): New routine along with pragma Inline. (Set_Is_Write): New routine along with pragma Inline. * sprint.adb (Sprint_Node_Actual): Add an entry for node N_Variable_Reference_Marker. From-SVN: r254531
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog49
-rw-r--r--gcc/ada/exp_ch3.adb19
-rw-r--r--gcc/ada/exp_util.adb6
-rw-r--r--gcc/ada/sem.adb8
-rw-r--r--gcc/ada/sem_ch8.adb38
-rw-r--r--gcc/ada/sem_elab.adb526
-rw-r--r--gcc/ada/sem_elab.ads9
-rw-r--r--gcc/ada/sem_res.adb15
-rw-r--r--gcc/ada/sem_spark.adb1
-rw-r--r--gcc/ada/sem_util.adb64
-rw-r--r--gcc/ada/sem_util.ads4
-rw-r--r--gcc/ada/sinfo.adb38
-rw-r--r--gcc/ada/sinfo.ads68
-rw-r--r--gcc/ada/sprint.adb19
14 files changed, 570 insertions, 294 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 528988f..10ab49e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,52 @@
+2017-11-08 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch3.adb (Expand_N_Object_Declaration): Save and restore relevant
+ SPARK-related flags. Add ??? comment.
+ * exp_util.adb (Insert_Actions): Add an entry for node
+ N_Variable_Reference_Marker.
+ * sem.adb (Analyze): Add an entry for node N_Variable_Reference_Marker.
+ * sem_ch8.adb (Find_Direct_Name): Add constant Is_Assignment_LHS. Build
+ and record a variable reference marker for the current name.
+ (Find_Expanded_Name): Add constant Is_Assignment_LHS. Build and record
+ a variable reference marker for the current name.
+ * sem_elab.adb (Build_Variable_Reference_Marker): New routine.
+ (Extract_Variable_Reference_Attributes): Reimplemented.
+ (Info_Scenario): Add output for variable references and remove output
+ for variable reads.
+ (Info_Variable_Read): Removed.
+ (Info_Variable_Reference): New routine.
+ (Is_Suitable_Scenario): Variable references are now suitable scenarios
+ while variable reads are not.
+ (Output_Active_Scenarios): Add output for variable references and
+ remove output for variable reads.
+ (Output_Variable_Read): Removed.
+ (Output_Variable_Reference): New routine.
+ (Process_Variable_Read): Removed.
+ (Process_Variable_Reference): New routine.
+ (Process_Variable_Reference_Read): New routine.
+ * sem_elab.ads (Build_Variable_Reference_Marker): New routine.
+ * sem_res.adb (Resolve_Actuals): Build and record a variable reference
+ marker for the current actual.
+ * sem_spark.adb (Check_Node): Add an entry for node
+ N_Variable_Reference_Marker.
+ * sem_util.adb (Within_Subprogram_Call): Moved to the library level.
+ * sem_util.ads (Within_Subprogram_Call): Moved to the library level.
+ * sinfo.adb (Is_Read): New routine.
+ (Is_Write): New routine.
+ (Target): Updated to handle variable reference markers.
+ (Set_Is_Read): New routine.
+ (Set_Is_Write): New routine.
+ (Set_Target): Updated to handle variable reference markers.
+ * sinfo.ads: Add new attributes Is_Read and Is_Write along with
+ occurrences in nodes. Update attribute Target. Add new node
+ kind N_Variable_Reference_Marker.
+ (Is_Read): New routine along with pragma Inline.
+ (Is_Write): New routine along with pragma Inline.
+ (Set_Is_Read): New routine along with pragma Inline.
+ (Set_Is_Write): New routine along with pragma Inline.
+ * sprint.adb (Sprint_Node_Actual): Add an entry for node
+ N_Variable_Reference_Marker.
+
2017-11-08 Arnaud Charlet <charlet@adacore.com>
* sem_util.adb (Subprogram_Name): Append suffix for overloaded
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 043a02c..435ff07 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6727,8 +6727,11 @@ package body Exp_Ch3 is
declare
New_Id : constant Entity_Id := Defining_Identifier (N);
Next_Temp : constant Entity_Id := Next_Entity (New_Id);
- S_Flag : constant Boolean :=
+ Save_CFS : constant Boolean :=
Comes_From_Source (Def_Id);
+ Save_SP : constant Node_Id := SPARK_Pragma (Def_Id);
+ Save_SPI : constant Boolean :=
+ SPARK_Pragma_Inherited (Def_Id);
begin
Set_Next_Entity (New_Id, Next_Entity (Def_Id));
@@ -6740,8 +6743,20 @@ package body Exp_Ch3 is
Set_Sloc (Defining_Identifier (N), Sloc (Def_Id));
Set_Comes_From_Source (Def_Id, False);
+
+ -- ??? This is extremely dangerous!!! Exchanging entities
+ -- is very low level, and as a result it resets flags and
+ -- fields which belong to the original Def_Id. Several of
+ -- these attributes are saved and restored, but there may
+ -- be many more that need to be preserverd.
+
Exchange_Entities (Defining_Identifier (N), Def_Id);
- Set_Comes_From_Source (Def_Id, S_Flag);
+
+ -- Restore clobbered attributes
+
+ Set_Comes_From_Source (Def_Id, Save_CFS);
+ Set_SPARK_Pragma (Def_Id, Save_SP);
+ Set_SPARK_Pragma_Inherited (Def_Id, Save_SPI);
end;
end;
end if;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8fdd8aa..e9522e4 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -7255,9 +7255,11 @@ package body Exp_Util is
null;
end if;
- -- Special case: a call marker
+ -- Special case: a marker
- when N_Call_Marker =>
+ when N_Call_Marker
+ | N_Variable_Reference_Marker
+ =>
if Is_List_Member (P) then
Insert_List_Before_And_Analyze (P, Ins_Actions);
return;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index aaa3ccb..02c8fa2 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -612,10 +612,12 @@ package body Sem is
when N_With_Clause =>
Analyze_With_Clause (N);
- -- A call to analyze a call marker is ignored because the node does
- -- not have any static and run-time semantics.
+ -- A call to analyze a marker is ignored because the node does not
+ -- have any static and run-time semantics.
- when N_Call_Marker =>
+ when N_Call_Marker
+ | N_Variable_Reference_Marker
+ =>
null;
-- A call to analyze the Empty node is an error, but most likely it
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index df176a7..86ceb52 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -5358,6 +5358,8 @@ package body Sem_Ch8 is
-- 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)
@@ -5895,9 +5897,20 @@ package body Sem_Ch8 is
<<Done>>
Check_Restriction_No_Use_Of_Entity (N);
- -- Save the scenario for later examination by the ABE Processing phase
+ -- Annotate the tree by creating a variable reference marker in case the
+ -- original variable reference is folded or optimized away. The variable
+ -- reference marker is automatically saved for later examination by the
+ -- ABE Processing phase. Variable references which act as actuals in a
+ -- call require special processing and are left to Resolve_Actuals. The
+ -- reference is a write when it appears on the left hand side of an
+ -- assignment.
- Record_Elaboration_Scenario (N);
+ if not Within_Subprogram_Call (N) then
+ Build_Variable_Reference_Marker
+ (N => N,
+ Read => not Is_Assignment_LHS,
+ Write => Is_Assignment_LHS);
+ end if;
end Find_Direct_Name;
------------------------
@@ -5969,8 +5982,10 @@ package body Sem_Ch8 is
-- Local variables
- Selector : constant Node_Id := Selector_Name (N);
- Candidate : Entity_Id := Empty;
+ Is_Assignment_LHS : constant Boolean := Is_LHS (N) = Yes;
+ Selector : constant Node_Id := Selector_Name (N);
+
+ Candidate : Entity_Id := Empty;
P_Name : Entity_Id;
Id : Entity_Id;
@@ -6529,9 +6544,20 @@ package body Sem_Ch8 is
Check_Restriction_No_Use_Of_Entity (N);
- -- Save the scenario for later examination by the ABE Processing phase
+ -- Annotate the tree by creating a variable reference marker in case the
+ -- original variable reference is folded or optimized away. The variable
+ -- reference marker is automatically saved for later examination by the
+ -- ABE Processing phase. Variable references which act as actuals in a
+ -- call require special processing and are left to Resolve_Actuals. The
+ -- reference is a write when it appears on the left hand side of an
+ -- assignment.
- Record_Elaboration_Scenario (N);
+ if not Within_Subprogram_Call (N) then
+ Build_Variable_Reference_Marker
+ (N => N,
+ Read => not Is_Assignment_LHS,
+ Write => Is_Assignment_LHS);
+ end if;
end Find_Expanded_Name;
--------------------
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 735ecf7..fb0d825 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -293,7 +293,7 @@ package body Sem_Elab is
-- | | |
-- | +--> Process_Variable_Assignment |
-- | | |
- -- | +--> Process_Variable_Read |
+ -- | +--> Process_Variable_Reference |
-- | |
-- +------------------------- Processing phase -------------------------+
@@ -683,10 +683,6 @@ package body Sem_Elab is
-- variable.
type Variable_Attributes is record
- SPARK_Mode_On : Boolean;
- -- This flag is set when the variable appears in a region subject to
- -- pragma SPARK_Mode with value On, or starts one such region.
-
Unit_Id : Entity_Id;
-- This attribute denotes the entity of the compilation unit where the
-- variable resides.
@@ -965,16 +961,16 @@ package body Sem_Elab is
-- information message, otherwise it emits an error. If flag In_SPARK
-- is set, then string " in SPARK" is added to the end of the message.
- procedure Info_Variable_Read
+ procedure Info_Variable_Reference
(Ref : Node_Id;
Var_Id : Entity_Id;
Info_Msg : Boolean;
In_SPARK : Boolean);
- pragma Inline (Info_Variable_Read);
- -- Output information concerning reference Ref which reads variable Var_Id.
- -- If flag Info_Msg is set, the routine emits an information message,
- -- otherwise it emits an error. If flag In_SPARK is set, then string " in
- -- SPARK" is added to the end of the message.
+ pragma Inline (Info_Variable_Reference);
+ -- Output information concerning reference Ref which mentions variable
+ -- Var_Id. If flag Info_Msg is set, the routine emits an information
+ -- message, otherwise it emits an error. If flag In_SPARK is set, then
+ -- string " in SPARK" is added to the end of the message.
function Insertion_Node (N : Node_Id; Ins_Nod : Node_Id) return Node_Id;
pragma Inline (Insertion_Node);
@@ -1166,10 +1162,10 @@ package body Sem_Elab is
-- Determine whether arbitrary node N denotes a suitable assignment for ABE
-- processing.
- function Is_Suitable_Variable_Read (N : Node_Id) return Boolean;
- pragma Inline (Is_Suitable_Variable_Read);
- -- Determine whether arbitrary node N is a suitable variable read for ABE
- -- processing.
+ function Is_Suitable_Variable_Reference (N : Node_Id) return Boolean;
+ pragma Inline (Is_Suitable_Variable_Reference);
+ -- Determine whether arbitrary node N is a suitable variable reference for
+ -- ABE processing.
function Is_Task_Entry (Id : Entity_Id) return Boolean;
pragma Inline (Is_Task_Entry);
@@ -1418,9 +1414,16 @@ package body Sem_Elab is
-- Perform ABE checks and diagnostics for assignment statement Asmt that
-- updates the value of variable Var_Id using the SPARK rules.
- procedure Process_Variable_Read (Ref : Node_Id);
- -- Perform ABE checks and diagnostics for reference Ref that reads a
- -- variable.
+ procedure Process_Variable_Reference (Ref : Node_Id);
+ -- Top level dispatcher for processing of variable references. Perform ABE
+ -- checks and diagnostics for variable reference Ref.
+
+ procedure Process_Variable_Reference_Read
+ (Ref : Node_Id;
+ Var_Id : Entity_Id;
+ Attrs : Variable_Attributes);
+ -- Perform ABE checks and diagnostics for reference Ref described by its
+ -- attributes Attrs, that reads variable Var_Id.
procedure Push_Active_Scenario (N : Node_Id);
pragma Inline (Push_Active_Scenario);
@@ -1647,6 +1650,12 @@ package body Sem_Elab is
if ASIS_Mode then
return;
+ -- Nothing to do when the call 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 call or a requeue
elsif not Nkind_In (N, N_Entry_Call_Statement,
@@ -1656,12 +1665,6 @@ package body Sem_Elab is
then
return;
- -- Nothing to do when the call is being preanalyzed as the marker will
- -- be inserted in the wrong place.
-
- elsif Preanalysis_Active then
- return;
-
-- Nothing to do when the call is analyzed/resolved too early within an
-- intermediate context.
@@ -1808,6 +1811,146 @@ package body Sem_Elab is
Record_Elaboration_Scenario (Marker);
end Build_Call_Marker;
+ -------------------------------------
+ -- Build_Variable_Reference_Marker --
+ -------------------------------------
+
+ procedure Build_Variable_Reference_Marker
+ (N : Node_Id;
+ Read : Boolean;
+ Write : Boolean)
+ is
+ function In_Pragma (Nod : Node_Id) return Boolean;
+ -- Determine whether arbitrary node Nod appears within a pragma
+
+ ---------------
+ -- 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 for ASIS. As a result, ABE checks and diagnostics are
+ -- not performed in this mode.
+
+ if 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;
+ 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
+
+ Set_Target (Marker, Var_Id);
+ Set_Is_Read (Marker, Read);
+ Set_Is_Write (Marker, Write);
+
+ -- The marker is inserted prior to the original variable reference. The
+ -- insertion must take place even when the reference does not occur in
+ -- the main unit to keep the tree symmetric. This ensures that internal
+ -- name serialization is consistent in case the variable marker causes
+ -- the tree to transform in some way.
+
+ Insert_Action (N, Marker);
+
+ -- The marker becomes the "corresponding" scenario for the reference.
+ -- Save the marker for later processing for the ABE phase.
+
+ Record_Elaboration_Scenario (Marker);
+ end Build_Variable_Reference_Marker;
+
---------------------------------
-- Check_Elaboration_Scenarios --
---------------------------------
@@ -2990,14 +3133,45 @@ package body Sem_Elab is
Var_Id : out Entity_Id;
Attrs : out Variable_Attributes)
is
+ function Get_Renamed_Variable (Id : Entity_Id) return Entity_Id;
+ -- Obtain the ultimate renamed variable of variable Id
+
+ --------------------------
+ -- Get_Renamed_Variable --
+ --------------------------
+
+ function Get_Renamed_Variable (Id : Entity_Id) return Entity_Id is
+ Ren_Id : Entity_Id;
+
+ begin
+ Ren_Id := Id;
+ while Present (Renamed_Entity (Ren_Id))
+ and then Nkind (Renamed_Entity (Ren_Id)) in N_Entity
+ loop
+ Ren_Id := Renamed_Entity (Ren_Id);
+ end loop;
+
+ return Ren_Id;
+ end Get_Renamed_Variable;
+
+ -- Start of processing for Extract_Variable_Reference_Attributes
+
begin
- -- Traverse a possible chain of renamings to obtain the original
- -- variable being referenced.
+ -- Extraction for variable reference markers
+
+ if Nkind (Ref) = N_Variable_Reference_Marker then
+ Var_Id := Target (Ref);
- Var_Id := Get_Renamed_Entity (Entity (Ref));
+ -- Extraction for expanded names and identifiers
- Attrs.SPARK_Mode_On := Is_SPARK_Mode_On_Node (Ref);
- Attrs.Unit_Id := Find_Top_Unit (Var_Id);
+ else
+ Var_Id := Entity (Ref);
+ end if;
+
+ -- Obtain the original variable which the reference mentions
+
+ Var_Id := Get_Renamed_Variable (Var_Id);
+ Attrs.Unit_Id := Find_Top_Unit (Var_Id);
-- At this point certain attributes should always be available
@@ -4284,24 +4458,26 @@ package body Sem_Elab is
In_SPARK => In_SPARK);
end Info_Instantiation;
- ------------------------
- -- Info_Variable_Read --
- ------------------------
+ -----------------------------
+ -- Info_Variable_Reference --
+ -----------------------------
- procedure Info_Variable_Read
+ procedure Info_Variable_Reference
(Ref : Node_Id;
Var_Id : Entity_Id;
Info_Msg : Boolean;
In_SPARK : Boolean)
is
begin
- Elab_Msg_NE
- (Msg => "read of variable & during elaboration",
- N => Ref,
- Id => Var_Id,
- Info_Msg => Info_Msg,
- In_SPARK => In_SPARK);
- end Info_Variable_Read;
+ if Is_Read (Ref) then
+ Elab_Msg_NE
+ (Msg => "read of variable & during elaboration",
+ N => Ref,
+ Id => Var_Id,
+ Info_Msg => Info_Msg,
+ In_SPARK => In_SPARK);
+ end if;
+ end Info_Variable_Reference;
--------------------
-- Insertion_Node --
@@ -5258,7 +5434,7 @@ package body Sem_Elab is
or else Is_Suitable_Call (N)
or else Is_Suitable_Instantiation (N)
or else Is_Suitable_Variable_Assignment (N)
- or else Is_Suitable_Variable_Read (N);
+ or else Is_Suitable_Variable_Reference (N);
end Is_Suitable_Scenario;
-------------------------------------
@@ -5355,187 +5531,19 @@ package body Sem_Elab is
and then Corresponding_Body (Var_Unit) = N_Unit_Id;
end Is_Suitable_Variable_Assignment;
- -------------------------------
- -- Is_Suitable_Variable_Read --
- -------------------------------
-
- function Is_Suitable_Variable_Read (N : Node_Id) return Boolean is
- function In_Pragma (Nod : Node_Id) return Boolean;
- -- Determine whether arbitrary node Nod appears within a pragma
-
- function Is_Variable_Read (Ref : Node_Id) return Boolean;
- -- Determine whether variable reference Ref constitutes a read
-
- ---------------
- -- 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;
-
- ----------------------
- -- Is_Variable_Read --
- ----------------------
-
- function Is_Variable_Read (Ref : Node_Id) return Boolean is
- function Is_Out_Actual (Call : Node_Id) return Boolean;
- -- Determine whether the corresponding formal of actual Ref which
- -- appears in call Call has mode OUT.
-
- -------------------
- -- Is_Out_Actual --
- -------------------
-
- function Is_Out_Actual (Call : Node_Id) return Boolean is
- Actual : Node_Id;
- Call_Attrs : Call_Attributes;
- Formal : Entity_Id;
- Target_Id : Entity_Id;
-
- begin
- Extract_Call_Attributes
- (Call => Call,
- Target_Id => Target_Id,
- Attrs => Call_Attrs);
-
- -- Inspect the actual and formal parameters, trying to find the
- -- corresponding formal for Ref.
-
- Actual := First_Actual (Call);
- Formal := First_Formal (Target_Id);
- while Present (Actual) and then Present (Formal) loop
- if Actual = Ref then
- return Ekind (Formal) = E_Out_Parameter;
- end if;
-
- Next_Actual (Actual);
- Next_Formal (Formal);
- end loop;
-
- return False;
- end Is_Out_Actual;
-
- -- Local variables
-
- Context : constant Node_Id := Parent (Ref);
-
- -- Start of processing for Is_Variable_Read
-
- begin
- -- The majority of variable references are reads, and they can appear
- -- in a great number of contexts. To determine whether a reference is
- -- a read, it is more practical to find out whether it is a write.
-
- -- A reference is a write when it appears immediately on the left-
- -- hand side of an assignment.
-
- if Nkind (Context) = N_Assignment_Statement
- and then Name (Context) = Ref
- then
- return False;
-
- -- A reference is a write when it acts as an actual in a subprogram
- -- call and the corresponding formal has mode OUT.
-
- elsif Nkind_In (Context, N_Function_Call,
- N_Procedure_Call_Statement)
- and then Is_Out_Actual (Context)
- then
- return False;
- end if;
-
- -- Any other reference is a read
-
- return True;
- end Is_Variable_Read;
-
- -- Local variables
-
- Prag : Node_Id;
- Var_Id : Entity_Id;
-
- -- Start of processing for Is_Suitable_Variable_Read
+ ------------------------------------
+ -- Is_Suitable_Variable_Reference --
+ ------------------------------------
+ function Is_Suitable_Variable_Reference (N : Node_Id) return Boolean is
begin
- -- This scenario is relevant only when the static model is in effect
- -- because it is graph-dependent and does not involve any run-time
- -- checks. Allowing it in the dynamic model would create confusing
- -- noise.
-
- if not Static_Elaboration_Checks then
- return False;
-
- -- Attributes and operator sumbols are not considered to be suitable
- -- references even though they are part of predicate Is_Entity_Name.
-
- elsif not Nkind_In (N, N_Expanded_Name, N_Identifier) then
- return False;
-
- -- Nothing to do for internally-generated references because they are
- -- assumed to be ABE safe.
-
- elsif not Comes_From_Source (N) then
- return False;
- end if;
-
- -- Sanitize the reference
-
- Var_Id := Entity (N);
-
- if No (Var_Id) then
- return False;
+ -- Expanded names and identifiers are intentionally ignored because they
+ -- be folded, optimized away, etc. Variable references markers play the
+ -- role of variable references and provide a uniform foundation for ABE
+ -- processing.
- elsif Var_Id = Any_Id then
- return False;
-
- elsif Ekind (Var_Id) /= E_Variable then
- return False;
- end if;
-
- Prag := SPARK_Pragma (Var_Id);
-
- -- To qualify, the reference must meet the following prerequisites:
-
- return
- 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 denote a variable read
-
- and then Is_Variable_Read (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);
- end Is_Suitable_Variable_Read;
+ return Nkind (N) = N_Variable_Reference_Marker;
+ end Is_Suitable_Variable_Reference;
-------------------
-- Is_Task_Entry --
@@ -5710,8 +5718,8 @@ package body Sem_Elab is
Info_Msg => False,
In_SPARK => True);
- elsif Is_Suitable_Variable_Read (N) then
- Info_Variable_Read
+ elsif Is_Suitable_Variable_Reference (N) then
+ Info_Variable_Reference
(Ref => N,
Var_Id => Target_Id,
Info_Msg => False,
@@ -5875,8 +5883,8 @@ package body Sem_Elab is
procedure Output_Variable_Assignment (N : Node_Id);
-- Emit a specific diagnostic message for assignment statement N
- procedure Output_Variable_Read (N : Node_Id);
- -- Emit a specific diagnostic message for reference N which reads a
+ procedure Output_Variable_Reference (N : Node_Id);
+ -- Emit a specific diagnostic message for reference N which mentions a
-- variable.
-------------------
@@ -6206,11 +6214,11 @@ package body Sem_Elab is
Error_Msg_NE ("\\ variable & assigned #", Error_Nod, Var_Id);
end Output_Variable_Assignment;
- --------------------------
- -- Output_Variable_Read --
- --------------------------
+ -------------------------------
+ -- Output_Variable_Reference --
+ -------------------------------
- procedure Output_Variable_Read (N : Node_Id) is
+ procedure Output_Variable_Reference (N : Node_Id) is
Dummy : Variable_Attributes;
Var_Id : Entity_Id;
@@ -6221,8 +6229,11 @@ package body Sem_Elab is
Attrs => Dummy);
Error_Msg_Sloc := Sloc (N);
- Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id);
- end Output_Variable_Read;
+
+ if Is_Read (N) then
+ Error_Msg_NE ("\\ variable & read #", Error_Nod, Var_Id);
+ end if;
+ end Output_Variable_Reference;
-- Local variables
@@ -6283,10 +6294,10 @@ package body Sem_Elab is
elsif Nkind (N) = N_Assignment_Statement then
Output_Variable_Assignment (N);
- -- Variable read
+ -- Variable references
- elsif Is_Suitable_Variable_Read (N) then
- Output_Variable_Read (N);
+ elsif Is_Suitable_Variable_Reference (N) then
+ Output_Variable_Reference (N);
else
pragma Assert (False);
@@ -8140,11 +8151,11 @@ package body Sem_Elab is
end if;
end Process_Variable_Assignment_SPARK;
- ---------------------------
- -- Process_Variable_Read --
- ---------------------------
+ --------------------------------
+ -- Process_Variable_Reference --
+ --------------------------------
- procedure Process_Variable_Read (Ref : Node_Id) is
+ procedure Process_Variable_Reference (Ref : Node_Id) is
Var_Attrs : Variable_Attributes;
Var_Id : Entity_Id;
@@ -8154,6 +8165,24 @@ package body Sem_Elab is
Var_Id => Var_Id,
Attrs => Var_Attrs);
+ if Is_Read (Ref) then
+ Process_Variable_Reference_Read
+ (Ref => Ref,
+ Var_Id => Var_Id,
+ Attrs => Var_Attrs);
+ end if;
+ end Process_Variable_Reference;
+
+ -------------------------------------
+ -- Process_Variable_Reference_Read --
+ -------------------------------------
+
+ procedure Process_Variable_Reference_Read
+ (Ref : Node_Id;
+ Var_Id : Entity_Id;
+ Attrs : Variable_Attributes)
+ is
+ begin
-- Output relevant information when switch -gnatel (info messages on
-- implicit Elaborate[_All] pragmas) is in effect.
@@ -8169,7 +8198,7 @@ package body Sem_Elab is
-- Nothing to do when the variable appears within the main unit because
-- diagnostics on reads are relevant only for external variables.
- if Is_Same_Unit (Var_Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then
+ if Is_Same_Unit (Attrs.Unit_Id, Cunit_Entity (Main_Unit)) then
null;
-- Nothing to do when the variable is already initialized. Note that the
@@ -8181,7 +8210,7 @@ package body Sem_Elab is
-- Nothing to do when the external unit guarantees the initialization of
-- the variable by means of pragma Elaborate_Body.
- elsif Has_Pragma_Elaborate_Body (Var_Attrs.Unit_Id) then
+ elsif Has_Pragma_Elaborate_Body (Attrs.Unit_Id) then
null;
-- A variable read imposes an Elaborate requirement on the context of
@@ -8194,7 +8223,7 @@ package body Sem_Elab is
Target_Id => Var_Id,
Req_Nam => Name_Elaborate);
end if;
- end Process_Variable_Read;
+ end Process_Variable_Reference_Read;
--------------------------
-- Push_Active_Scenario --
@@ -8271,10 +8300,21 @@ package body Sem_Elab is
elsif Is_Suitable_Variable_Assignment (N) then
Process_Variable_Assignment (N);
- -- Variable read
+ -- Variable references
- elsif Is_Suitable_Variable_Read (N) then
- Process_Variable_Read (N);
+ elsif Is_Suitable_Variable_Reference (N) then
+
+ -- In general, only variable references found within the main unit
+ -- are processed because the ALI information supplied to binde is for
+ -- the main unit only. However, to preserve the consistency of the
+ -- tree and ensure proper serialization of internal names, external
+ -- variable references also receive corresponding variable reference
+ -- markers (see Build_Varaible_Reference_Marker). Regardless of the
+ -- reason, external variable references must not be processed.
+
+ if In_Main_Context (N) then
+ Process_Variable_Reference (N);
+ end if;
end if;
-- Remove the current scenario from the stack of active scenarios once
@@ -8365,7 +8405,7 @@ package body Sem_Elab is
Possible_Local_Raise (N, Standard_Program_Error);
elsif Is_Suitable_Variable_Assignment (N)
- or else Is_Suitable_Variable_Read (N)
+ or else Is_Suitable_Variable_Reference (N)
then
null;
diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads
index ddcd433..69d65d8 100644
--- a/gcc/ada/sem_elab.ads
+++ b/gcc/ada/sem_elab.ads
@@ -34,6 +34,15 @@ package Sem_Elab is
-- Create a call marker for call or requeue statement N and record it for
-- later processing by the ABE mechanism.
+ procedure Build_Variable_Reference_Marker
+ (N : Node_Id;
+ Read : Boolean;
+ Write : Boolean);
+ -- Create a variable reference marker for arbitrary node N if it mentions a
+ -- variable, and record it for later processing by the ABE mechanism. Flag
+ -- Read should be set when the reference denotes a read. Flag Write should
+ -- be set when the reference denotes a write.
+
procedure Check_Elaboration_Scenarios;
-- Examine each scenario recorded during analysis/resolution and apply the
-- Ada or SPARK elaboration rules taking into account the model in effect.
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f5c5f9e..07e4ba8 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3744,6 +3744,21 @@ package body Sem_Res is
and then Is_Entity_Name (A)
and then Comes_From_Source (A)
then
+ -- Annotate the tree by creating a variable reference marker when
+ -- the actual denotes a variable reference, in case the reference
+ -- is folded or optimized away. The variable reference marker is
+ -- automatically saved for later examination by the ABE Processing
+ -- phase. The status of the reference is set as follows:
+
+ -- status mode
+ -- 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);
+
Orig_A := Entity (A);
if Present (Orig_A) then
diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb
index 5107d3b..42517ea 100644
--- a/gcc/ada/sem_spark.adb
+++ b/gcc/ada/sem_spark.adb
@@ -2349,6 +2349,7 @@ package body Sem_SPARK is
| N_With_Clause
| N_Use_Type_Clause
| N_Validate_Unchecked_Conversion
+ | N_Variable_Reference_Marker
=>
null;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9d55b0a..429310c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14865,10 +14865,6 @@ package body Sem_Util is
function Within_Check (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a check node
- function Within_Subprogram_Call (Nod : Node_Id) return Boolean;
- -- Determine whether an arbitrary node appears in an entry, function, or
- -- procedure call.
-
function Within_Volatile_Function (Id : Entity_Id) return Boolean;
-- Determine whether an arbitrary entity appears in a volatile function
@@ -14931,36 +14927,6 @@ package body Sem_Util is
return False;
end Within_Check;
- ----------------------------
- -- Within_Subprogram_Call --
- ----------------------------
-
- function Within_Subprogram_Call (Nod : Node_Id) return Boolean is
- Par : Node_Id;
-
- begin
- -- Climb the parent chain looking for a function or procedure call
-
- Par := Nod;
- while Present (Par) loop
- if Nkind_In (Par, N_Entry_Call_Statement,
- N_Function_Call,
- N_Procedure_Call_Statement)
- 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 Within_Subprogram_Call;
-
------------------------------
-- Within_Volatile_Function --
------------------------------
@@ -24241,6 +24207,36 @@ package body Sem_Util is
return Scope_Within_Or_Same (Scope (E), S);
end Within_Scope;
+ ----------------------------
+ -- Within_Subprogram_Call --
+ ----------------------------
+
+ function Within_Subprogram_Call (N : Node_Id) return Boolean is
+ Par : Node_Id;
+
+ begin
+ -- Climb the parent chain looking for a function or procedure call
+
+ Par := N;
+ while Present (Par) loop
+ if Nkind_In (Par, N_Entry_Call_Statement,
+ N_Function_Call,
+ N_Procedure_Call_Statement)
+ 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 Within_Subprogram_Call;
+
----------------
-- Wrong_Type --
----------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c6958cb..f0e06e4 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2735,6 +2735,10 @@ package Sem_Util is
function Within_Scope (E : Entity_Id; S : Entity_Id) return Boolean;
-- Returns True if entity E is declared within scope S
+ function Within_Subprogram_Call (N : Node_Id) return Boolean;
+ -- Determine whether arbitrary node N appears in an entry, function, or
+ -- procedure call.
+
procedure Wrong_Type (Expr : Node_Id; Expected_Type : Entity_Id);
-- Output error message for incorrectly typed expression. Expr is the node
-- for the incorrectly typed construct (Etype (Expr) is the type found),
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index dc4e8fb..5514291 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2090,6 +2090,14 @@ package body Sinfo is
return Flag4 (N);
end Is_Qualified_Universal_Literal;
+ function Is_Read
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
+ return Flag1 (N);
+ end Is_Read;
+
function Is_Recorded_Scenario
(N : Node_Id) return Boolean is
begin
@@ -2179,6 +2187,14 @@ package body Sinfo is
return Flag5 (N);
end Is_Task_Master;
+ function Is_Write
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
+ return Flag2 (N);
+ end Is_Write;
+
function Iteration_Scheme
(N : Node_Id) return Node_Id is
begin
@@ -3277,7 +3293,8 @@ package body Sinfo is
(N : Node_Id) return Entity_Id is
begin
pragma Assert (False
- or else NT (N).Nkind = N_Call_Marker);
+ or else NT (N).Nkind = N_Call_Marker
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
return Node1 (N);
end Target;
@@ -5512,6 +5529,14 @@ package body Sinfo is
Set_Flag4 (N, Val);
end Set_Is_Qualified_Universal_Literal;
+ procedure Set_Is_Read
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
+ Set_Flag1 (N, Val);
+ end Set_Is_Read;
+
procedure Set_Is_Recorded_Scenario
(N : Node_Id; Val : Boolean := True) is
begin
@@ -5601,6 +5626,14 @@ package body Sinfo is
Set_Flag5 (N, Val);
end Set_Is_Task_Master;
+ procedure Set_Is_Write
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
+ Set_Flag2 (N, Val);
+ end Set_Is_Write;
+
procedure Set_Iteration_Scheme
(N : Node_Id; Val : Node_Id) is
begin
@@ -6699,7 +6732,8 @@ package body Sinfo is
(N : Node_Id; Val : Entity_Id) is
begin
pragma Assert (False
- or else NT (N).Nkind = N_Call_Marker);
+ or else NT (N).Nkind = N_Call_Marker
+ or else NT (N).Nkind = N_Variable_Reference_Marker);
Set_Node1 (N, Val); -- semantic field, no parent set
end Set_Target;
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index cf220e4..21e7bb9 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1863,6 +1863,10 @@ package Sinfo is
-- the resolution of accidental overloading of binary or unary operators
-- which may occur in instances.
+ -- Is_Read (Flag1-Sem)
+ -- Present in variable reference markers. Set when the original variable
+ -- reference constitues a read of the variable.
+
-- Is_Recorded_Scenario (Flag6-Sem)
-- Present in call marker and instantiation nodes. Set when the scenario
-- was saved by the ABE Recording phase. This flag aids the ABE machinery
@@ -1916,6 +1920,10 @@ package Sinfo is
-- indicate that the construct is a task master (i.e. has declared tasks
-- or declares an access to a task type).
+ -- Is_Write (Flag2-Sem)
+ -- Present in variable reference markers. Set when the original variable
+ -- reference constitues a write of the variable.
+
-- Itype (Node1-Sem)
-- Used in N_Itype_Reference node to reference an itype for which it is
-- important to ensure that it is defined. See description of this node
@@ -2318,8 +2326,9 @@ package Sinfo is
-- only execute if invalid values are present).
-- Target (Node1-Sem)
- -- Present in call marker nodes. References the entity of the entry,
- -- operator, or subprogram invoked by the related call or requeue.
+ -- Present in call and variable reference marker nodes. References the
+ -- entity of the original entity, operator, or subprogram being invoked,
+ -- or the original variable being read or written.
-- Target_Type (Node2-Sem)
-- Used in an N_Validate_Unchecked_Conversion node to point to the target
@@ -8455,6 +8464,37 @@ package Sinfo is
-- Note: in the case where a debug source file is generated, the Sloc
-- for this node points to the VALIDATE keyword in the file output.
+ -------------------------------
+ -- Variable_Reference_Marker --
+ -------------------------------
+
+ -- This node is created during the analysis of direct or expanded names,
+ -- and the resolution of entry and subprogram calls. It performs several
+ -- functions:
+
+ -- * Variable reference markers provide a uniform model for handling
+ -- variable references by the ABE mechanism, regardless of whether
+ -- expansion took place.
+
+ -- * The variable reference marker captures the entity of the variable
+ -- being read or written.
+
+ -- * The variable reference markers aid the ABE Processing phase by
+ -- signaling the presence of a call in case the original variable
+ -- reference was transformed by expansion.
+
+ -- Sprint syntax: r#target# -- for a read
+ -- rw#target# -- for a read/write
+ -- w#target# -- for a write
+
+ -- The Sprint syntax shown above is not enabled by default
+
+ -- N_Variable_Reference_Marker
+ -- Sloc points to Sloc of original variable reference
+ -- Target (Node1-Sem)
+ -- Is_Read (Flag1-Sem)
+ -- Is_Write (Flag2-Sem)
+
-----------
-- Empty --
-----------
@@ -8877,6 +8917,7 @@ package Sinfo is
N_Triggering_Alternative,
N_Use_Type_Clause,
N_Validate_Unchecked_Conversion,
+ N_Variable_Reference_Marker,
N_Variant,
N_Variant_Part,
N_With_Clause,
@@ -9733,6 +9774,9 @@ package Sinfo is
function Is_Qualified_Universal_Literal
(N : Node_Id) return Boolean; -- Flag4
+ function Is_Read
+ (N : Node_Id) return Boolean; -- Flag1
+
function Is_Recorded_Scenario
(N : Node_Id) return Boolean; -- Flag6
@@ -9760,6 +9804,9 @@ package Sinfo is
function Is_Task_Master
(N : Node_Id) return Boolean; -- Flag5
+ function Is_Write
+ (N : Node_Id) return Boolean; -- Flag2
+
function Iteration_Scheme
(N : Node_Id) return Node_Id; -- Node2
@@ -10822,6 +10869,9 @@ package Sinfo is
procedure Set_Is_Qualified_Universal_Literal
(N : Node_Id; Val : Boolean := True); -- Flag4
+ procedure Set_Is_Read
+ (N : Node_Id; Val : Boolean := True); -- Flag1
+
procedure Set_Is_Recorded_Scenario
(N : Node_Id; Val : Boolean := True); -- Flag6
@@ -10849,6 +10899,9 @@ package Sinfo is
procedure Set_Is_Task_Master
(N : Node_Id; Val : Boolean := True); -- Flag5
+ procedure Set_Is_Write
+ (N : Node_Id; Val : Boolean := True); -- Flag2
+
procedure Set_Iteration_Scheme
(N : Node_Id; Val : Node_Id); -- Node2
@@ -13023,6 +13076,13 @@ package Sinfo is
4 => False, -- unused
5 => False), -- unused
+ N_Variable_Reference_Marker =>
+ (1 => False, -- Target (Node1-Sem)
+ 2 => False, -- unused
+ 3 => False, -- unused
+ 4 => False, -- unused
+ 5 => False), -- unused
+
-- Entries for Empty, Error and Unused. Even thought these have a Chars
-- field for debugging purposes, they are not really syntactic fields, so
-- we mark all fields as unused.
@@ -13276,6 +13336,7 @@ package Sinfo is
pragma Inline (Is_Prefixed_Call);
pragma Inline (Is_Protected_Subprogram_Body);
pragma Inline (Is_Qualified_Universal_Literal);
+ pragma Inline (Is_Read);
pragma Inline (Is_Recorded_Scenario);
pragma Inline (Is_Source_Call);
pragma Inline (Is_SPARK_Mode_On_Node);
@@ -13285,6 +13346,7 @@ package Sinfo is
pragma Inline (Is_Task_Allocation_Block);
pragma Inline (Is_Task_Body_Procedure);
pragma Inline (Is_Task_Master);
+ pragma Inline (Is_Write);
pragma Inline (Iteration_Scheme);
pragma Inline (Itype);
pragma Inline (Kill_Range_Check);
@@ -13634,6 +13696,7 @@ package Sinfo is
pragma Inline (Set_Is_Prefixed_Call);
pragma Inline (Set_Is_Protected_Subprogram_Body);
pragma Inline (Set_Is_Qualified_Universal_Literal);
+ pragma Inline (Set_Is_Read);
pragma Inline (Set_Is_Recorded_Scenario);
pragma Inline (Set_Is_Source_Call);
pragma Inline (Set_Is_SPARK_Mode_On_Node);
@@ -13643,6 +13706,7 @@ package Sinfo is
pragma Inline (Set_Is_Task_Allocation_Block);
pragma Inline (Set_Is_Task_Body_Procedure);
pragma Inline (Set_Is_Task_Master);
+ pragma Inline (Set_Is_Write);
pragma Inline (Set_Iteration_Scheme);
pragma Inline (Set_Iterator_Specification);
pragma Inline (Set_Itype);
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index ac2dcd8..428e91a 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -3459,6 +3459,25 @@ package body Sprint is
Sprint_Node (Target_Type (Node));
Write_Str (");");
+ when N_Variable_Reference_Marker =>
+ null;
+
+ -- Enable the following code for debugging purposes only
+
+ -- if Is_Read (Node) and then Is_Write (Node) then
+ -- Write_Indent_Str ("rw#");
+
+ -- elsif Is_Read (Node) then
+ -- Write_Indent_Str ("r#");
+
+ -- else
+ -- pragma Assert (Is_Write (Node));
+ -- Write_Indent_Str ("w#");
+ -- end if;
+
+ -- Write_Id (Target (Node));
+ -- Write_Char ('#');
+
when N_Variant =>
Write_Indent_Str_Sloc ("when ");
Sprint_Bar_List (Discrete_Choices (Node));