From b912db16175b8e78c6311e26753e6e2f474063f1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 09:56:05 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Arnaud Charlet * rtsfind.ads (SPARK_Implicit_Load): New procedure for forced loading of an entity. * rtsfind.adb (SPARK_Implicit_Load): Body with a pattern previously repeated in the analysis. * sem_ch9.adb (Analyze_Protected_Type_Declaration): use new procedure SPARK_Implicit_Load. (Analyze_Task_Type_Declaration): use new procedure SPARK_Implicit_Load. * sem_ch10.adb (Analyze_Compilation_Unit): Use new procedure SPARK_Implicit_Load. 2017-04-25 Javier Miranda * sem_util.adb (New_Copy_Tree): By default copying of defining identifiers is prohibited because this would introduce an entirely new entity into the tree. This patch introduces an exception to this general rule: the declaration of constants and variables located in Expression_With_Action nodes. (Copy_Itype_With_Replacement): Renamed as Copy_Entity_With_Replacement. (In_Map): New subprogram. (Visit_Entity): New subprogram. (Visit_Node): Handle EWA_Level, EWA_Inner_Scope_Level, and take care of defining entities defined in Expression_With_Action nodes. 2017-04-25 Thomas Quinot * exp_ch6.adb: minor comment edit. * sinfo.ads, sinfo.adb: New Null_Statement attribute for null procedure specifications that come from source. * par-ch6.adb (P_Subprogram, case of a null procedure): Set new Null_Statement attribute. * par_sco.adb (Traverse_Declarations_Or_Statements): For a null procedure, generate statement SCO for the generated NULL statement. * sem_ch6.adb (Analyze_Null_Procedure): Use null statement from parser, if available. From-SVN: r247136 --- gcc/ada/ChangeLog | 39 ++++++++++ gcc/ada/exp_ch6.adb | 2 +- gcc/ada/par-ch6.adb | 2 + gcc/ada/par_sco.adb | 6 +- gcc/ada/rtsfind.adb | 14 ++++ gcc/ada/rtsfind.ads | 5 ++ gcc/ada/sem_ch10.adb | 9 +-- gcc/ada/sem_ch6.adb | 12 ++- gcc/ada/sem_ch9.adb | 21 +---- gcc/ada/sem_util.adb | 180 ++++++++++++++++++++++++++++++++++++------- gcc/ada/sinfo.adb | 56 +++++++++----- gcc/ada/sinfo.ads | 25 ++++-- 12 files changed, 288 insertions(+), 83 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cb42c811b03..3df9685fc74 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2017-04-25 Arnaud Charlet + + * rtsfind.ads (SPARK_Implicit_Load): New procedure for forced + loading of an entity. + * rtsfind.adb (SPARK_Implicit_Load): Body with a pattern + previously repeated in the analysis. + * sem_ch9.adb (Analyze_Protected_Type_Declaration): use new + procedure SPARK_Implicit_Load. (Analyze_Task_Type_Declaration): + use new procedure SPARK_Implicit_Load. + * sem_ch10.adb (Analyze_Compilation_Unit): Use new procedure + SPARK_Implicit_Load. + +2017-04-25 Javier Miranda + + * sem_util.adb (New_Copy_Tree): By default + copying of defining identifiers is prohibited because + this would introduce an entirely new entity into the + tree. This patch introduces an exception to this general + rule: the declaration of constants and variables located in + Expression_With_Action nodes. + (Copy_Itype_With_Replacement): Renamed as Copy_Entity_With_Replacement. + (In_Map): New subprogram. + (Visit_Entity): New subprogram. + (Visit_Node): Handle EWA_Level, + EWA_Inner_Scope_Level, and take care of defining entities defined + in Expression_With_Action nodes. + +2017-04-25 Thomas Quinot + + * exp_ch6.adb: minor comment edit. + * sinfo.ads, sinfo.adb: New Null_Statement attribute for null + procedure specifications that come from source. + * par-ch6.adb (P_Subprogram, case of a null procedure): Set new + Null_Statement attribute. + * par_sco.adb (Traverse_Declarations_Or_Statements): For a null + procedure, generate statement SCO for the generated NULL statement. + * sem_ch6.adb (Analyze_Null_Procedure): Use null statement from + parser, if available. + 2017-04-04 Andreas Krebbel * system-linux-s390.ads: Use Long_Integer'Size to define diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e9f13319ed5..cb90fd259cd 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5763,7 +5763,7 @@ package body Exp_Ch6 is -- Ada 2005 (AI-348): Generate body for a null procedure. In most -- cases this is superfluous because calls to it will be automatically -- inlined, but we definitely need the body if preconditions for the - -- procedure are present. + -- procedure are present, or if performing coverage analysis. elsif Nkind (Specification (N)) = N_Procedure_Specification and then Null_Present (Specification (N)) diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index a1733d99bf1..b0f4b932f8e 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -607,6 +607,8 @@ package body Ch6 is Error_Msg_SP ("only procedures can be null"); else Set_Null_Present (Specification_Node); + Set_Null_Statement (Specification_Node, + New_Node (N_Null_Statement, Prev_Token_Ptr)); end if; goto Subprogram_Declaration; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 3747605a29e..a3379dd0bc7 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -1812,13 +1812,15 @@ package body Par_SCO is Process_Decisions_Defer (Parameter_Specifications (Spec), 'X'); - -- Case of a null procedure: generate a NULL statement SCO + -- Case of a null procedure: generate SCO for fictitious + -- NULL statement located at the NULL keyword in the + -- procedure specification. if Nkind (N) = N_Subprogram_Declaration and then Nkind (Spec) = N_Procedure_Specification and then Null_Present (Spec) then - Traverse_Degenerate_Subprogram (N); + Traverse_Degenerate_Subprogram (Null_Statement (Spec)); -- Case of an expression function: generate a statement SCO -- for the expression (and then decision SCOs for any nested diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 3b078c2e660..39f4654e3e7 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -1646,4 +1646,18 @@ package body Rtsfind is end loop; end Set_RTU_Loaded; + ------------------------- + -- SPARK_Implicit_Load -- + ------------------------- + + procedure SPARK_Implicit_Load (E : RE_Id) is + Unused : Entity_Id; + + begin + pragma Assert (GNATprove_Mode); + + -- Force loading of a predefined unit + Unused := RTE (E); + end SPARK_Implicit_Load; + end Rtsfind; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index f3dfd3191a0..cbeb007b970 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -3223,4 +3223,9 @@ package Rtsfind is procedure Set_RTU_Loaded (N : Node_Id); -- Register the predefined unit N as already loaded + procedure SPARK_Implicit_Load (E : RE_Id); + -- Force loading of the unit containing the entity E; only needed in + -- GNATprove mode when processing code that implicitly references a + -- given entity. + end Rtsfind; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index f4268a0d903..e413079da19 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1145,8 +1145,7 @@ package body Sem_Ch10 is N_Function_Instantiation) then declare - Spec : Node_Id; - Unused : Entity_Id; + Spec : Node_Id; begin case Nkind (Unit_Node) is @@ -1163,15 +1162,15 @@ package body Sem_Ch10 is pragma Assert (Nkind (Spec) in N_Subprogram_Specification); - -- Only subprogram with no parameters can act as "main", and if - -- it is a function, it needs to return an integer. + -- Main subprogram must have no parameters, and if it is a + -- function, it must return an integer. if No (Parameter_Specifications (Spec)) and then (Nkind (Spec) = N_Procedure_Specification or else Is_Integer_Type (Etype (Result_Definition (Spec)))) then - Unused := RTE (RE_Interrupt_Priority); + SPARK_Implicit_Load (RE_Interrupt_Priority); end if; end; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5a54515c4b9..de7c92a6dc7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1370,6 +1370,7 @@ package body Sem_Ch6 is Designator : Entity_Id; Form : Node_Id; Null_Body : Node_Id := Empty; + Null_Stmt : Node_Id := Null_Statement (Spec); Prev : Entity_Id; begin @@ -1379,13 +1380,22 @@ package body Sem_Ch6 is -- the first case the body is analyzed at the freeze point, in the other -- it replaces the null procedure declaration. + -- For a null procedure that comes from source, a NULL statement is + -- provided by the parser, which carries the source location of the + -- NULL keyword, and has Comes_From_Source set. For a null procedure + -- from expansion, create one now. + + if No (Null_Stmt) then + Null_Stmt := Make_Null_Statement (Loc); + end if; + Null_Body := Make_Subprogram_Body (Loc, Specification => New_Copy_Tree (Spec), Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Make_Null_Statement (Loc)))); + Statements => New_List (Null_Stmt))); -- Create new entities for body and formals diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index efca9fcd8fc..a22e7274297 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1169,12 +1169,7 @@ package body Sem_Ch9 is -- force the loading of the Ada.Real_Time package. if GNATprove_Mode then - declare - Unused : Entity_Id; - - begin - Unused := RTE (RO_RT_Time); - end; + SPARK_Implicit_Load (RO_RT_Time); end if; end Analyze_Delay_Relative; @@ -2263,12 +2258,7 @@ package body Sem_Ch9 is -- calls originating from protected subprograms and entries. if GNATprove_Mode then - declare - Unused : Entity_Id; - - begin - Unused := RTE (RE_Interrupt_Priority); - end; + SPARK_Implicit_Load (RE_Interrupt_Priority); end if; end Analyze_Protected_Type_Declaration; @@ -3215,12 +3205,7 @@ package body Sem_Ch9 is -- calls originating from tasks. if GNATprove_Mode then - declare - Unused : Entity_Id; - - begin - Unused := RTE (RE_Interrupt_Priority); - end; + SPARK_Implicit_Load (RE_Interrupt_Priority); end if; end Analyze_Task_Type_Declaration; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 93d8bd58d81..4203eac98c1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16227,6 +16227,17 @@ package body Sem_Util is New_Sloc : Source_Ptr := No_Location; New_Scope : Entity_Id := Empty) return Node_Id is + EWA_Level : Nat := 0; + -- By default copying of defining identifiers is prohibited because this + -- would introduce an entirely new entity into the tree. The exception + -- to this general rule are declaration of constants and variables + -- located in Expression_With_Action nodes. + + EWA_Inner_Scope_Level : Nat := 0; + -- Level of internal scope of defined in EWAs. Used to avoid creating + -- variables for declarations located in blocks or subprograms defined + -- in Expression_With_Action nodes. + ------------------------------------ -- Auxiliary Data and Subprograms -- ------------------------------------ @@ -16297,11 +16308,11 @@ package body Sem_Util is (Old_Elist : Elist_Id) return Elist_Id; -- Called during second phase to copy element list doing replacements - procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id); - -- Called during the second phase to process a copied Itype. The actual + procedure Copy_Entity_With_Replacement (New_Entity : Entity_Id); + -- Called during the second phase to process a copied Entity. The actual -- copy happened during the first phase (so that we could make the entry -- in the mapping), but we still have to deal with the descendants of - -- the copied Itype and copy them where necessary. + -- the copied Entity and copy them where necessary. function Copy_List_With_Replacement (Old_List : List_Id) return List_Id; -- Called during second phase to copy list doing replacements @@ -16309,9 +16320,18 @@ package body Sem_Util is function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id; -- Called during second phase to copy node doing replacements + function In_Map (E : Entity_Id) return Boolean; + -- Return True if E is one of the old entities specified in the set of + -- mappings to be applied to entities in the tree (ie. Map). + procedure Visit_Elist (E : Elist_Id); -- Called during first phase to visit all elements of an Elist + procedure Visit_Entity (Old_Entity : Entity_Id); + -- Called during first phase to visit subsidiary fields of a defining + -- entity which is not an itype, and also create a copy and make an + -- entry in the replacement map for the new copy. + procedure Visit_Field (F : Union_Id; N : Node_Id); -- Visit a single field, recursing to call Visit_Node or Visit_List if -- the field is a syntactic descendant of the current node (i.e. its @@ -16420,51 +16440,51 @@ package body Sem_Util is return New_Elist; end Copy_Elist_With_Replacement; - --------------------------------- - -- Copy_Itype_With_Replacement -- - --------------------------------- + ---------------------------------- + -- Copy_Entity_With_Replacement -- + ---------------------------------- -- This routine exactly parallels its phase one analog Visit_Itype, - procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id) is + procedure Copy_Entity_With_Replacement (New_Entity : Entity_Id) is begin -- Translate Next_Entity, Scope, and Etype fields, in case they -- reference entities that have been mapped into copies. - Set_Next_Entity (New_Itype, Assoc (Next_Entity (New_Itype))); - Set_Etype (New_Itype, Assoc (Etype (New_Itype))); + Set_Next_Entity (New_Entity, Assoc (Next_Entity (New_Entity))); + Set_Etype (New_Entity, Assoc (Etype (New_Entity))); if Present (New_Scope) then - Set_Scope (New_Itype, New_Scope); + Set_Scope (New_Entity, New_Scope); else - Set_Scope (New_Itype, Assoc (Scope (New_Itype))); + Set_Scope (New_Entity, Assoc (Scope (New_Entity))); end if; -- Copy referenced fields - if Is_Discrete_Type (New_Itype) then - Set_Scalar_Range (New_Itype, - Copy_Node_With_Replacement (Scalar_Range (New_Itype))); + if Is_Discrete_Type (New_Entity) then + Set_Scalar_Range (New_Entity, + Copy_Node_With_Replacement (Scalar_Range (New_Entity))); - elsif Has_Discriminants (Base_Type (New_Itype)) then - Set_Discriminant_Constraint (New_Itype, + elsif Has_Discriminants (Base_Type (New_Entity)) then + Set_Discriminant_Constraint (New_Entity, Copy_Elist_With_Replacement - (Discriminant_Constraint (New_Itype))); + (Discriminant_Constraint (New_Entity))); - elsif Is_Array_Type (New_Itype) then - if Present (First_Index (New_Itype)) then - Set_First_Index (New_Itype, + elsif Is_Array_Type (New_Entity) then + if Present (First_Index (New_Entity)) then + Set_First_Index (New_Entity, First (Copy_List_With_Replacement - (List_Containing (First_Index (New_Itype))))); + (List_Containing (First_Index (New_Entity))))); end if; - if Is_Packed (New_Itype) then - Set_Packed_Array_Impl_Type (New_Itype, + if Is_Packed (New_Entity) then + Set_Packed_Array_Impl_Type (New_Entity, Copy_Node_With_Replacement - (Packed_Array_Impl_Type (New_Itype))); + (Packed_Array_Impl_Type (New_Entity))); end if; end if; - end Copy_Itype_With_Replacement; + end Copy_Entity_With_Replacement; -------------------------------- -- Copy_List_With_Replacement -- @@ -16726,6 +16746,31 @@ package body Sem_Util is return New_Node; end Copy_Node_With_Replacement; + ------------ + -- In_Map -- + ------------ + + function In_Map (E : Entity_Id) return Boolean is + Elmt : Elmt_Id; + Ent : Entity_Id; + + begin + if Present (Map) then + Elmt := First_Elmt (Map); + while Present (Elmt) loop + Ent := Node (Elmt); + + if Ent = E then + return True; + end if; + + Next_Elmt (Elmt); + Next_Elmt (Elmt); + end loop; + end if; + + return False; + end In_Map; ------------------- -- New_Copy_Hash -- ------------------- @@ -16752,6 +16797,44 @@ package body Sem_Util is end if; end Visit_Elist; + ------------------ + -- Visit_Entity -- + ------------------ + + procedure Visit_Entity (Old_Entity : Entity_Id) is + New_E : Entity_Id; + + begin + pragma Assert (not Is_Itype (Old_Entity)); + pragma Assert (Nkind (Old_Entity) in N_Entity); + + -- Restrict entity creation to variable declarations. There is no + -- need to create variables declared in inner scopes. + + if not Ekind_In (Old_Entity, E_Constant, E_Variable) + or else EWA_Inner_Scope_Level > 0 + then + return; + end if; + + New_E := New_Copy (Old_Entity); + + -- The new entity has all the attributes of the old one, and we + -- just copy the contents of the entity. However, the back-end + -- needs different names for debugging purposes, so we create a + -- new internal name for it in all cases. + + Set_Chars (New_E, New_Internal_Name ('T')); + + -- Add new association to map + + NCT_Assoc.Set (Old_Entity, New_E); + + -- Visit descendants that eventually get copied + + Visit_Field (Union_Id (Etype (Old_Entity)), Old_Entity); + end Visit_Entity; + ----------------- -- Visit_Field -- ----------------- @@ -16931,9 +17014,19 @@ package body Sem_Util is procedure Visit_Node (N : Node_Or_Entity_Id) is begin + if Nkind (N) = N_Expression_With_Actions then + EWA_Level := EWA_Level + 1; + + elsif EWA_Level > 0 + and then Nkind_In (N, N_Block_Statement, + N_Subprogram_Body, + N_Subprogram_Declaration) + then + EWA_Inner_Scope_Level := EWA_Inner_Scope_Level + 1; + -- Handle case of an Itype, which must be copied - if Nkind (N) in N_Entity and then Is_Itype (N) then + elsif Nkind (N) in N_Entity and then Is_Itype (N) then -- Nothing to do if already in the list. This can happen with an -- Itype entity that appears more than once in the tree. Note that @@ -16944,6 +17037,18 @@ package body Sem_Util is end if; Visit_Itype (N); + + -- Handle defining entities in Expression_With_Action nodes + + elsif Nkind (N) in N_Entity and then EWA_Level > 0 then + + -- Nothing to do if already in the hash table + + if Present (NCT_Assoc.Get (Entity_Id (N))) then + return; + end if; + + Visit_Entity (N); end if; -- Visit descendants @@ -16953,6 +17058,17 @@ package body Sem_Util is Visit_Field (Field3 (N), N); Visit_Field (Field4 (N), N); Visit_Field (Field5 (N), N); + + if EWA_Level > 0 + and then Nkind_In (N, N_Block_Statement, + N_Subprogram_Body, + N_Subprogram_Declaration) + then + EWA_Inner_Scope_Level := EWA_Inner_Scope_Level - 1; + + elsif Nkind (N) = N_Expression_With_Actions then + EWA_Level := EWA_Level - 1; + end if; end Visit_Node; -- Start of processing for New_Copy_Tree @@ -16975,8 +17091,16 @@ package body Sem_Util is begin NCT_Assoc.Get_First (Old_E, New_E); while Present (New_E) loop - if Is_Itype (New_E) then - Copy_Itype_With_Replacement (New_E); + + -- Skip entities that were not created in the first phase (that + -- is, old entities specified by the caller in the set of mappings + -- to be applied to the tree). + + if Is_Itype (New_E) + or else No (Map) + or else not In_Map (Old_E) + then + Copy_Entity_With_Replacement (New_E); end if; NCT_Assoc.Get_Next (Old_E, New_E); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index fc88da8e012..400ac421932 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -2472,16 +2472,6 @@ package body Sinfo is return Flag18 (N); end Non_Aliased_Prefix; - function Null_Present - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List - or else NT (N).Nkind = N_Procedure_Specification - or else NT (N).Nkind = N_Record_Definition); - return Flag13 (N); - end Null_Present; - function Null_Excluding_Subtype (N : Node_Id) return Boolean is begin @@ -2519,6 +2509,16 @@ package body Sinfo is return Flag14 (N); end Null_Exclusion_In_Return_Present; + function Null_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Component_List + or else NT (N).Nkind = N_Procedure_Specification + or else NT (N).Nkind = N_Record_Definition); + return Flag13 (N); + end Null_Present; + function Null_Record_Present (N : Node_Id) return Boolean is begin @@ -2528,6 +2528,14 @@ package body Sinfo is return Flag17 (N); end Null_Record_Present; + function Null_Statement + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Procedure_Specification); + return Node2 (N); + end Null_Statement; + function Object_Definition (N : Node_Id) return Node_Id is begin @@ -5774,16 +5782,6 @@ package body Sinfo is Set_Flag18 (N, Val); end Set_Non_Aliased_Prefix; - procedure Set_Null_Present - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Component_List - or else NT (N).Nkind = N_Procedure_Specification - or else NT (N).Nkind = N_Record_Definition); - Set_Flag13 (N, Val); - end Set_Null_Present; - procedure Set_Null_Excluding_Subtype (N : Node_Id; Val : Boolean := True) is begin @@ -5821,6 +5819,16 @@ package body Sinfo is Set_Flag14 (N, Val); end Set_Null_Exclusion_In_Return_Present; + procedure Set_Null_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Component_List + or else NT (N).Nkind = N_Procedure_Specification + or else NT (N).Nkind = N_Record_Definition); + Set_Flag13 (N, Val); + end Set_Null_Present; + procedure Set_Null_Record_Present (N : Node_Id; Val : Boolean := True) is begin @@ -5830,6 +5838,14 @@ package body Sinfo is Set_Flag17 (N, Val); end Set_Null_Record_Present; + procedure Set_Null_Statement + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Procedure_Specification); + Set_Node2 (N, Val); + end Set_Null_Statement; + procedure Set_Object_Definition (N : Node_Id; Val : Node_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 69f283759b5..a1741fb0d56 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -5155,6 +5155,7 @@ package Sinfo is -- N_Procedure_Specification -- Sloc points to PROCEDURE -- Defining_Unit_Name (Node1) + -- Null_Statement (Node2-Sem) NULL statement for body, if Null_Present -- Parameter_Specifications (List3) (set to No_List if no formal part) -- Generic_Parent (Node5-Sem) -- Null_Present (Flag13) set for null procedure case (Ada 2005 feature) @@ -9699,9 +9700,6 @@ package Sinfo is function Non_Aliased_Prefix (N : Node_Id) return Boolean; -- Flag18 - function Null_Present - (N : Node_Id) return Boolean; -- Flag13 - function Null_Excluding_Subtype (N : Node_Id) return Boolean; -- Flag16 @@ -9711,9 +9709,15 @@ package Sinfo is function Null_Exclusion_In_Return_Present (N : Node_Id) return Boolean; -- Flag14 + function Null_Present + (N : Node_Id) return Boolean; -- Flag13 + function Null_Record_Present (N : Node_Id) return Boolean; -- Flag17 + function Null_Statement + (N : Node_Id) return Node_Id; -- Node2 + function Object_Definition (N : Node_Id) return Node_Id; -- Node4 @@ -10755,9 +10759,6 @@ package Sinfo is procedure Set_Non_Aliased_Prefix (N : Node_Id; Val : Boolean := True); -- Flag18 - procedure Set_Null_Present - (N : Node_Id; Val : Boolean := True); -- Flag13 - procedure Set_Null_Excluding_Subtype (N : Node_Id; Val : Boolean := True); -- Flag16 @@ -10767,9 +10768,15 @@ package Sinfo is procedure Set_Null_Exclusion_In_Return_Present (N : Node_Id; Val : Boolean := True); -- Flag14 + procedure Set_Null_Present + (N : Node_Id; Val : Boolean := True); -- Flag13 + procedure Set_Null_Record_Present (N : Node_Id; Val : Boolean := True); -- Flag17 + procedure Set_Null_Statement + (N : Node_Id; Val : Node_Id); -- Node2 + procedure Set_Object_Definition (N : Node_Id; Val : Node_Id); -- Node4 @@ -11900,7 +11907,7 @@ package Sinfo is N_Procedure_Specification => (1 => True, -- Defining_Unit_Name (Node1) - 2 => False, -- unused + 2 => False, -- Null_Statement (Node2-Sem) 3 => True, -- Parameter_Specifications (List3) 4 => False, -- unused 5 => False), -- Generic_Parent (Node5-Sem) @@ -13088,11 +13095,12 @@ package Sinfo is pragma Inline (No_Side_Effect_Removal); pragma Inline (No_Truncation); pragma Inline (Non_Aliased_Prefix); - pragma Inline (Null_Present); pragma Inline (Null_Excluding_Subtype); pragma Inline (Null_Exclusion_Present); pragma Inline (Null_Exclusion_In_Return_Present); + pragma Inline (Null_Present); pragma Inline (Null_Record_Present); + pragma Inline (Null_Statement); pragma Inline (Object_Definition); pragma Inline (Of_Present); pragma Inline (Original_Discriminant); @@ -13441,6 +13449,7 @@ package Sinfo is pragma Inline (Set_Null_Exclusion_In_Return_Present); pragma Inline (Set_Null_Present); pragma Inline (Set_Null_Record_Present); + pragma Inline (Set_Null_Statement); pragma Inline (Set_Object_Definition); pragma Inline (Set_Of_Present); pragma Inline (Set_Original_Discriminant); -- 2.30.2