From 8d1fe980a29ead0572d0bb451197a14b490adef3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 May 2015 11:14:02 +0200 Subject: [PATCH] [multiple changes] 2015-05-12 Ed Schonberg * sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate freeze nodes for these in ASIS mode, because they lead to elaoration order issues in gigi. 2015-05-12 Hristian Kirtchev * sem_ch6.adb (Analyze_Expression_Function): Code cleanup. Use Copy_Subprogram_Spec to create a proper spec. (Analyze_Subprogram_Body_Helper): Code cleanup. Do not prepare a stand alone body for inlining in GNATprove mode when inside a generic. (Body_Has_Contract): Reimplemented. (Build_Subprogram_Declaration): New routine. * sem_ch10.adb (Analyze_Compilation_Unit): Capture global references within generic bodies by loading them. * sem_util.adb (Copy_Parameter_List): Code cleanup. (Copy_Subprogram_Spec): New routine. (Is_Contract_Annotation): New routine. * sem_util.ads (Copy_Subprogram_Spec): New routine. (Is_Contract_Annotation): New routine. 2015-05-12 Hristian Kirtchev * sem_attr.adb (Resolve_Attribute): Do not analyze the generated body of an expression function when the prefix of attribute 'Access is the body. From-SVN: r223048 --- gcc/ada/ChangeLog | 28 ++++++ gcc/ada/sem_attr.adb | 30 +++++-- gcc/ada/sem_ch10.adb | 43 +++++----- gcc/ada/sem_ch3.adb | 17 +++- gcc/ada/sem_ch6.adb | 235 ++++++++++++++++++++++----------------------------- gcc/ada/sem_util.adb | 128 +++++++++++++++++++++------- gcc/ada/sem_util.ads | 21 +++-- 7 files changed, 305 insertions(+), 197 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ce6cd7a..fb21d93 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,33 @@ 2015-05-12 Ed Schonberg + * sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate + freeze nodes for these in ASIS mode, because they lead to + elaoration order issues in gigi. + +2015-05-12 Hristian Kirtchev + + * sem_ch6.adb (Analyze_Expression_Function): Code + cleanup. Use Copy_Subprogram_Spec to create a proper spec. + (Analyze_Subprogram_Body_Helper): Code cleanup. Do not + prepare a stand alone body for inlining in GNATprove mode + when inside a generic. (Body_Has_Contract): Reimplemented. + (Build_Subprogram_Declaration): New routine. + * sem_ch10.adb (Analyze_Compilation_Unit): Capture global + references within generic bodies by loading them. + * sem_util.adb (Copy_Parameter_List): Code cleanup. + (Copy_Subprogram_Spec): New routine. + (Is_Contract_Annotation): New routine. + * sem_util.ads (Copy_Subprogram_Spec): New routine. + (Is_Contract_Annotation): New routine. + +2015-05-12 Hristian Kirtchev + + * sem_attr.adb (Resolve_Attribute): Do not analyze the generated + body of an expression function when the prefix of attribute + 'Access is the body. + +2015-05-12 Ed Schonberg + * sem_ch3.adb (Build_Derived_Enumeration_Type): The anonymous base created for a derived enumeration type is not a first subtype, even though it is defined through a full type declaration. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 68901b1..16cbccf 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10675,13 +10675,31 @@ package body Sem_Attr is Subp_Body := Unit_Declaration_Node (Corresponding_Body (Subp_Decl)); - -- Analyze the body of the expression function to freeze - -- the expression. This takes care of the case where the - -- 'Access is part of dispatch table initialization and - -- the generated body of the expression function has not - -- been analyzed yet. + -- The body has already been analyzed when the expression + -- function acts as a completion. - if not Analyzed (Subp_Body) then + if Analyzed (Subp_Body) then + null; + + -- Attribute 'Access may appear within the generated body + -- of the expression function subject to the attribute: + + -- function F is (... F'Access ...); + + -- If the expression function is on the scope stack, then + -- the body is currently being analyzed. Do not reanalyze + -- it because this will lead to infinite recursion. + + elsif In_Open_Scopes (Subp_Id) then + null; + + -- Analyze the body of the expression function to freeze + -- the expression. This takes care of the case where the + -- 'Access is part of dispatch table initialization and + -- the generated body of the expression function has not + -- been analyzed yet. + + else Analyze (Subp_Body); end if; end if; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index bf1704e..9f68d15 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1020,16 +1020,18 @@ package body Sem_Ch10 is Remove_Context (N); - -- If this is the main unit and we are generating code, we must check - -- that all generic units in the context have a body if they need it, - -- even if they have not been instantiated. In the absence of .ali files - -- for generic units, we must force the load of the body, just to - -- produce the proper error if the body is absent. We skip this - -- verification if the main unit itself is generic. + -- When generating code for a non-generic main unit, check that withed + -- generic units have a body if they need it, even if the units have not + -- been instantiated. Force the load of the bodies to produce the proper + -- error if the body is absent. The same applies to GNATprove mode, with + -- the added benefit of capturing global references within the generic. + -- This in turn allows for proper inlining of subprogram bodies without + -- a previous declaration. if Get_Cunit_Unit_Number (N) = Main_Unit - and then Operating_Mode = Generate_Code - and then Expander_Active + and then ((Operating_Mode = Generate_Code and then Expander_Active) + or else + (Operating_Mode = Check_Semantics and then GNATprove_Mode)) then -- Check whether the source for the body of the unit must be included -- in a standalone library. @@ -1066,7 +1068,7 @@ package body Sem_Ch10 is then Nam := Entity (Name (Item)); - -- Compile generic subprogram, unless it is intrinsic or + -- Compile the generic subprogram, unless it is intrinsic or -- imported so no body is required, or generic package body -- if the package spec requires a body. @@ -1080,20 +1082,21 @@ package body Sem_Ch10 is if Present (Renamed_Object (Nam)) then Un := - Load_Unit - (Load_Name => Get_Body_Name - (Get_Unit_Name - (Unit_Declaration_Node - (Renamed_Object (Nam)))), - Required => False, - Subunit => False, - Error_Node => N, - Renamings => True); + Load_Unit + (Load_Name => + Get_Body_Name + (Get_Unit_Name + (Unit_Declaration_Node + (Renamed_Object (Nam)))), + Required => False, + Subunit => False, + Error_Node => N, + Renamings => True); else Un := Load_Unit - (Load_Name => Get_Body_Name - (Get_Unit_Name (Item)), + (Load_Name => + Get_Body_Name (Get_Unit_Name (Item)), Required => False, Subunit => False, Error_Node => N, diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 08ad303..c88e1d8 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1772,9 +1772,13 @@ package body Sem_Ch3 is -- locally defined tagged types (or compiling with static -- dispatch tables generation disabled) the corresponding -- entry of the secondary dispatch table is filled when - -- such an entity is frozen. + -- such an entity is frozen. This is an expansion activity + -- that must be suppressed for ASIS because it leads to + -- gigi elaboration issues in annotate mode. - Set_Has_Delayed_Freeze (New_Subp); + if not ASIS_Mode then + Set_Has_Delayed_Freeze (New_Subp); + end if; end if; <> @@ -1794,7 +1798,7 @@ package body Sem_Ch3 is ----------------------------------- procedure Analyze_Component_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (Component_Definition (N)); Id : constant Entity_Id := Defining_Identifier (N); E : constant Node_Id := Expression (N); Typ : constant Node_Id := @@ -2137,9 +2141,14 @@ package body Sem_Ch3 is then declare Act_T : constant Entity_Id := Build_Default_Subtype (T, N); + begin Set_Etype (Id, Act_T); - Set_Component_Definition (N, + + -- Rewrite the component definition to use the constrained + -- subtype. + + Rewrite (Component_Definition (N), Make_Component_Definition (Loc, Subtype_Indication => New_Occurrence_Of (Act_T, Loc))); end; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c4c47a5..f0fb6d4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -268,10 +268,10 @@ package body Sem_Ch6 is --------------------------------- procedure Analyze_Expression_Function (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - LocX : constant Source_Ptr := Sloc (Expression (N)); - Expr : constant Node_Id := Expression (N); - Spec : constant Node_Id := Specification (N); + Expr : constant Node_Id := Expression (N); + Loc : constant Source_Ptr := Sloc (N); + LocX : constant Source_Ptr := Sloc (Expr); + Spec : constant Node_Id := Specification (N); Def_Id : Entity_Id; @@ -293,36 +293,11 @@ package body Sem_Ch6 is Inline_Processing_Required := True; - -- Create a specification for the generated body. Types and defauts in - -- the profile are copies of the spec, but new entities must be created - -- for the unit name and the formals. + -- Create a specification for the generated body. This must be done + -- prior to the analysis of the initial declaration. - New_Spec := New_Copy_Tree (Spec); - Set_Defining_Unit_Name (New_Spec, - Make_Defining_Identifier (Sloc (Defining_Unit_Name (Spec)), - Chars (Defining_Unit_Name (Spec)))); - - if Present (Parameter_Specifications (New_Spec)) then - declare - Formal_Spec : Node_Id; - Def : Entity_Id; - - begin - Formal_Spec := First (Parameter_Specifications (New_Spec)); - - -- Create a new formal parameter at the same source position - - while Present (Formal_Spec) loop - Def := Defining_Identifier (Formal_Spec); - Set_Defining_Identifier (Formal_Spec, - Make_Defining_Identifier (Sloc (Def), - Chars => Chars (Def))); - Next (Formal_Spec); - end loop; - end; - end if; - - Prev := Current_Entity_In_Scope (Defining_Entity (Spec)); + New_Spec := Copy_Subprogram_Spec (Spec); + Prev := Current_Entity_In_Scope (Defining_Entity (Spec)); -- If there are previous overloadable entities with the same name, -- check whether any of them is completed by the expression function. @@ -2272,7 +2247,7 @@ package body Sem_Ch6 is procedure Analyze_Subprogram_Body_Helper (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Body_Spec : constant Node_Id := Specification (N); + Body_Spec : Node_Id := Specification (N); Body_Id : Entity_Id := Defining_Entity (Body_Spec); Prev_Id : constant Entity_Id := Current_Entity_In_Scope (Body_Id); Conformant : Boolean; @@ -2309,6 +2284,9 @@ package body Sem_Ch6 is -- Check whether unanalyzed body has an aspect or pragma that may -- generate a SPARK contract. + procedure Build_Subprogram_Declaration; + -- Create a matching subprogram declaration for subprogram body N + procedure Check_Anonymous_Return; -- Ada 2005: if a function returns an access type that denotes a task, -- or a type that contains tasks, we must create a master entity for @@ -2486,63 +2464,114 @@ package body Sem_Ch6 is ----------------------- function Body_Has_Contract return Boolean is - Decls : constant List_Id := Declarations (N); - A_Spec : Node_Id; - A : Aspect_Id; - Decl : Node_Id; - P_Id : Pragma_Id; + Decls : constant List_Id := Declarations (N); + Item : Node_Id; begin - -- Check for unanalyzed aspects in the body that will - -- generate a contract. + -- Check for unanalyzed aspects in the body that will generate a + -- contract. if Present (Aspect_Specifications (N)) then - A_Spec := First (Aspect_Specifications (N)); - while Present (A_Spec) loop - A := Get_Aspect_Id (Chars (Identifier (A_Spec))); - - if A = Aspect_Contract_Cases or else - A = Aspect_Depends or else - A = Aspect_Global or else - A = Aspect_Pre or else - A = Aspect_Precondition or else - A = Aspect_Post or else - A = Aspect_Postcondition - then + Item := First (Aspect_Specifications (N)); + while Present (Item) loop + if Is_Contract_Annotation (Item) then return True; end if; - Next (A_Spec); + Next (Item); end loop; end if; -- Check for pragmas that may generate a contract if Present (Decls) then - Decl := First (Decls); - while Present (Decl) loop - if Nkind (Decl) = N_Pragma then - P_Id := Get_Pragma_Id (Pragma_Name (Decl)); - - if P_Id = Pragma_Contract_Cases or else - P_Id = Pragma_Depends or else - P_Id = Pragma_Global or else - P_Id = Pragma_Pre or else - P_Id = Pragma_Precondition or else - P_Id = Pragma_Post or else - P_Id = Pragma_Postcondition - then - return True; - end if; + Item := First (Decls); + while Present (Item) loop + if Nkind (Item) = N_Pragma + and then Is_Contract_Annotation (Item) + then + return True; end if; - Next (Decl); + Next (Item); end loop; end if; return False; end Body_Has_Contract; + ---------------------------------- + -- Build_Subprogram_Declaration -- + ---------------------------------- + + procedure Build_Subprogram_Declaration is + Asp : Node_Id; + Decl : Node_Id; + Subp_Decl : Node_Id; + + begin + -- Create a matching subprogram spec using the profile of the body. + -- The structure of the tree is identical, but has new entities for + -- the defining unit name and formal parameters. + + Subp_Decl := + Make_Subprogram_Declaration (Loc, + Specification => Copy_Subprogram_Spec (Body_Spec)); + + -- Relocate the aspects of the subprogram body to the new subprogram + -- spec because it acts as the initial declaration. + -- ??? what about pragmas + + Move_Aspects (N, To => Subp_Decl); + Insert_Before_And_Analyze (N, Subp_Decl); + + -- The analysis of the subprogram spec aspects may introduce pragmas + -- that need to be analyzed. + + Decl := Next (Subp_Decl); + while Present (Decl) loop + + -- Stop the search for pragmas once the body has been reached as + -- this terminates the region where pragmas may appear. + + if Decl = N then + exit; + + elsif Nkind (Decl) = N_Pragma then + Analyze (Decl); + end if; + + Next (Decl); + end loop; + + Spec_Id := Defining_Entity (Subp_Decl); + Set_Corresponding_Spec (N, Spec_Id); + + -- Mark the generated spec as a source construct to ensure that all + -- calls to it are properly registered in ALI files for GNATprove. + + Set_Comes_From_Source (Spec_Id, True); + + -- If aspect SPARK_Mode was specified on the body, it needs to be + -- repeated both on the generated spec and the body. + + Asp := Find_Aspect (Spec_Id, Aspect_SPARK_Mode); + + if Present (Asp) then + Asp := New_Copy_Tree (Asp); + Set_Analyzed (Asp, False); + Set_Aspect_Specifications (N, New_List (Asp)); + end if; + + -- Ensure that the specs of the subprogram declaration and its body + -- are identical, otherwise they will appear non-conformant due to + -- rewritings in the default values of formal parameters. + + Body_Spec := Copy_Subprogram_Spec (Body_Spec); + Set_Specification (N, Body_Spec); + Body_Id := Analyze_Subprogram_Specification (Body_Spec); + end Build_Subprogram_Declaration; + ---------------------------- -- Check_Anonymous_Return -- ---------------------------- @@ -3221,68 +3250,9 @@ package body Sem_Ch6 is -- to the spec, leading to legality errors. and then not Body_Has_Contract + and then not Inside_A_Generic then - declare - Body_Spec : constant Node_Id := - Copy_Separate_Tree (Specification (N)); - New_Decl : constant Node_Id := - Make_Subprogram_Declaration (Loc, - Copy_Separate_Tree (Specification (N))); - - SPARK_Mode_Aspect : Node_Id; - Aspects : List_Id; - Prag, Aspect : Node_Id; - - begin - Insert_Before (N, New_Decl); - Move_Aspects (From => N, To => New_Decl); - - -- Mark the newly moved aspects as not analyzed, so that - -- their effect on New_Decl is properly analyzed. - - Aspect := First (Aspect_Specifications (New_Decl)); - while Present (Aspect) loop - Set_Analyzed (Aspect, False); - Next (Aspect); - end loop; - - Analyze (New_Decl); - - -- The analysis of the generated subprogram declaration - -- may have introduced pragmas that need to be analyzed. - - Prag := Next (New_Decl); - while Prag /= N loop - Analyze (Prag); - Next (Prag); - end loop; - - Spec_Id := Defining_Entity (New_Decl); - - -- As Body_Id originally comes from source, mark the new - -- Spec_Id as such, which is required so that calls to - -- this subprogram are registered in the local effects - -- stored in ALI files for GNATprove. - - Set_Comes_From_Source (Spec_Id, True); - - -- If aspect SPARK_Mode was specified on the body, it - -- needs to be repeated on the generated decl and the - -- body. Since the original aspect was moved to the - -- generated decl, copy it for the body. - - if Has_Aspect (Spec_Id, Aspect_SPARK_Mode) then - SPARK_Mode_Aspect := - New_Copy (Find_Aspect (Spec_Id, Aspect_SPARK_Mode)); - Set_Analyzed (SPARK_Mode_Aspect, False); - Aspects := New_List (SPARK_Mode_Aspect); - Set_Aspect_Specifications (N, Aspects); - end if; - - Set_Specification (N, Body_Spec); - Body_Id := Analyze_Subprogram_Specification (Body_Spec); - Set_Corresponding_Spec (N, Spec_Id); - end; + Build_Subprogram_Declaration; end if; end if; @@ -3777,7 +3747,8 @@ package body Sem_Ch6 is and then Full_Analysis and then not Inside_A_Generic and then Present (Spec_Id) - and then Nkind (Parent (Parent (Spec_Id))) = N_Subprogram_Declaration + and then Nkind (Unit_Declaration_Node (Spec_Id)) = + N_Subprogram_Declaration and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id) and then not Body_Has_Contract then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index bebb7db..ba8eb1d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4412,21 +4412,19 @@ package body Sem_Util is if No (First_Formal (Subp_Id)) then return No_List; else - Plist := New_List; + Plist := New_List; Formal := First_Formal (Subp_Id); while Present (Formal) loop - Append - (Make_Parameter_Specification (Loc, + Append_To (Plist, + Make_Parameter_Specification (Loc, Defining_Identifier => - Make_Defining_Identifier (Sloc (Formal), - Chars => Chars (Formal)), - In_Present => In_Present (Parent (Formal)), - Out_Present => Out_Present (Parent (Formal)), - Parameter_Type => + Make_Defining_Identifier (Sloc (Formal), Chars (Formal)), + In_Present => In_Present (Parent (Formal)), + Out_Present => Out_Present (Parent (Formal)), + Parameter_Type => New_Occurrence_Of (Etype (Formal), Loc), - Expression => - New_Copy_Tree (Expression (Parent (Formal)))), - Plist); + Expression => + New_Copy_Tree (Expression (Parent (Formal))))); Next_Formal (Formal); end loop; @@ -4435,6 +4433,43 @@ package body Sem_Util is return Plist; end Copy_Parameter_List; + -------------------------- + -- Copy_Subprogram_Spec -- + -------------------------- + + function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id is + Def_Id : Node_Id; + Formal_Spec : Node_Id; + Result : Node_Id; + + begin + -- The structure of the original tree must be replicated without any + -- alterations. Use New_Copy_Tree for this purpose. + + Result := New_Copy_Tree (Spec); + + -- Create a new entity for the defining unit name + + Def_Id := Defining_Unit_Name (Result); + Set_Defining_Unit_Name (Result, + Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id))); + + -- Create new entities for the formal parameters + + if Present (Parameter_Specifications (Result)) then + Formal_Spec := First (Parameter_Specifications (Result)); + while Present (Formal_Spec) loop + Def_Id := Defining_Identifier (Formal_Spec); + Set_Defining_Identifier (Formal_Spec, + Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id))); + + Next (Formal_Spec); + end loop; + end if; + + return Result; + end Copy_Subprogram_Spec; + -------------------------------- -- Corresponding_Generic_Type -- -------------------------------- @@ -10299,6 +10334,29 @@ package body Sem_Util is or else Is_Task_Interface (T)); end Is_Concurrent_Interface; + ----------------------- + -- Is_Constant_Bound -- + ----------------------- + + function Is_Constant_Bound (Exp : Node_Id) return Boolean is + begin + if Compile_Time_Known_Value (Exp) then + return True; + + elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then + return Is_Constant_Object (Entity (Exp)) + or else Ekind (Entity (Exp)) = E_Enumeration_Literal; + + elsif Nkind (Exp) in N_Binary_Op then + return Is_Constant_Bound (Left_Opnd (Exp)) + and then Is_Constant_Bound (Right_Opnd (Exp)) + and then Scope (Entity (Exp)) = Standard_Standard; + + else + return False; + end if; + end Is_Constant_Bound; + --------------------------- -- Is_Container_Element -- --------------------------- @@ -10478,28 +10536,40 @@ package body Sem_Util is end; end Is_Container_Element; - ----------------------- - -- Is_Constant_Bound -- - ----------------------- - - function Is_Constant_Bound (Exp : Node_Id) return Boolean is - begin - if Compile_Time_Known_Value (Exp) then - return True; + ---------------------------- + -- Is_Contract_Annotation -- + ---------------------------- - elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then - return Is_Constant_Object (Entity (Exp)) - or else Ekind (Entity (Exp)) = E_Enumeration_Literal; + function Is_Contract_Annotation (Item : Node_Id) return Boolean is + Nam : Name_Id; - elsif Nkind (Exp) in N_Binary_Op then - return Is_Constant_Bound (Left_Opnd (Exp)) - and then Is_Constant_Bound (Right_Opnd (Exp)) - and then Scope (Entity (Exp)) = Standard_Standard; + begin + if Nkind (Item) = N_Aspect_Specification then + Nam := Chars (Identifier (Item)); - else - return False; + else pragma Assert (Nkind (Item) = N_Pragma); + Nam := Pragma_Name (Item); end if; - end Is_Constant_Bound; + + return + Nam = Name_Abstract_State + or else Nam = Name_Contract_Cases + or else Nam = Name_Depends + or else Nam = Name_Extensions_Visible + or else Nam = Name_Global + or else Nam = Name_Initial_Condition + or else Nam = Name_Initializes + or else Nam = Name_Post + or else Nam = Name_Post_Class + or else Nam = Name_Postcondition + or else Nam = Name_Pre + or else Nam = Name_Pre_Class + or else Nam = Name_Precondition + or else Nam = Name_Refined_Depends + or else Nam = Name_Refined_Global + or else Nam = Name_Refined_State + or else Nam = Name_Test_Case; + end Is_Contract_Annotation; -------------------------------------- -- Is_Controlling_Limited_Procedure -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 06239d2..044047b 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -397,12 +397,6 @@ package Sem_Util is -- Depends -- Global - function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id; - -- Utility to create a parameter profile for a new subprogram spec, when - -- the subprogram has a body that acts as spec. This is done for some cases - -- of inlining, and for private protected ops. Also used to create bodies - -- for stubbed subprograms. - function Copy_Component_List (R_Typ : Entity_Id; Loc : Source_Ptr) return List_Id; @@ -410,6 +404,17 @@ package Sem_Util is -- create a new compatible record type. Loc is the source location assigned -- to the created nodes. + function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id; + -- Utility to create a parameter profile for a new subprogram spec, when + -- the subprogram has a body that acts as spec. This is done for some cases + -- of inlining, and for private protected ops. Also used to create bodies + -- for stubbed subprograms. + + function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id; + -- Replicate a function or a procedure specification denoted by Spec. The + -- resulting tree is an exact duplicate of the original tree. New entities + -- are created for the unit name and the formal parameters. + function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id; -- If a type is a generic actual type, return the corresponding formal in -- the generic parent unit. There is no direct link in the tree for this @@ -1186,6 +1191,10 @@ package Sem_Util is -- explicit dereference. The transformation applies when it has the form -- F (X).Discr.all. + function Is_Contract_Annotation (Item : Node_Id) return Boolean; + -- Determine whether aspect specification or pragma Item is a contract + -- annotation. + function Is_Controlling_Limited_Procedure (Proc_Nam : Entity_Id) return Boolean; -- Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure -- 2.7.4