diff options
Diffstat (limited to 'gcc/ada/sem_ch6.adb')
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 136 |
1 files changed, 44 insertions, 92 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 6c9b399..05c0ccf 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -82,11 +82,7 @@ package body Sem_Ch6 is -- Analyze a generic subprogram body. N is the body to be analyzed, -- and Gen_Id is the defining entity Id for the corresponding spec. - function Build_Body_To_Inline - (N : Node_Id; - Subp : Entity_Id; - Orig_Body : Node_Id) - return Boolean; + procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id); -- If a subprogram has pragma Inline and inlining is active, use generic -- machinery to build an unexpanded body for the subprogram. This body is -- subsequenty used for inline expansions at call sites. If subprogram can @@ -132,8 +128,7 @@ package body Sem_Ch6 is function Is_Non_Overriding_Operation (Prev_E : Entity_Id; - New_E : Entity_Id) - return Boolean; + New_E : Entity_Id) return Boolean; -- Enforce the rule given in 12.3(18): a private operation in an instance -- overrides an inherited operation only if the corresponding operation -- was overriding in the generic. This can happen for primitive operations @@ -156,8 +151,7 @@ package body Sem_Ch6 is (T1 : Entity_Id; T2 : Entity_Id; Ctype : Conformance_Type; - Get_Inst : Boolean := False) - return Boolean; + Get_Inst : Boolean := False) return Boolean; -- Check that two formal parameter types conform, checking both -- for equality of base types, and where required statically -- matching subtypes, depending on the setting of Ctype. @@ -1142,9 +1136,7 @@ package body Sem_Ch6 is (Front_End_Inlining or else Configurable_Run_Time_Mode))) then - if Build_Body_To_Inline (N, Spec_Id, Copy_Separate_Tree (N)) then - null; - end if; + Build_Body_To_Inline (N, Spec_Id); end if; -- Now we can go on to analyze the body @@ -1492,12 +1484,7 @@ package body Sem_Ch6 is -- Build_Body_To_Inline -- -------------------------- - function Build_Body_To_Inline - (N : Node_Id; - Subp : Entity_Id; - Orig_Body : Node_Id) - return Boolean - is + procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id) is Decl : constant Node_Id := Unit_Declaration_Node (Subp); Original_Body : Node_Id; Body_To_Analyze : Node_Id; @@ -1732,7 +1719,7 @@ package body Sem_Ch6 is if Nkind (Decl) = N_Subprogram_Declaration and then Present (Body_To_Inline (Decl)) then - return True; -- Done already. + return; -- Done already. -- Functions that return unconstrained composite types will require -- secondary stack handling, and cannot currently be inlined. @@ -1744,64 +1731,13 @@ package body Sem_Ch6 is then Cannot_Inline ("cannot inline & (unconstrained return type)?", N, Subp); - return False; - end if; - - -- We need to capture references to the formals in order to substitute - -- the actuals at the point of inlining, i.e. instantiation. To treat - -- the formals as globals to the body to inline, we nest it within - -- a dummy parameterless subprogram, declared within the real one. - - Original_Body := Orig_Body; - - -- Within an instance, the current tree is already the result of - -- a generic copy, and not what we need for subsequent inlining. - -- We create the required body by doing an instantiating copy, to - -- obtain the proper partially analyzed tree. - - if In_Instance then - if No (Generic_Parent (Specification (N))) then - return False; - - elsif Is_Child_Unit (Scope (Current_Scope)) then - return False; - - elsif Scope (Current_Scope) = Cunit_Entity (Main_Unit) then - - -- compiling an instantiation. There is no point in generating - -- bodies to inline, because they will not be used. - - return False; - - else - Body_To_Analyze := - Copy_Generic_Node - (Generic_Parent (Specification (N)), Empty, - Instantiating => True); - end if; - - -- Case of not in an instance - - else - Body_To_Analyze := - Copy_Generic_Node (Original_Body, Empty, - Instantiating => False); - end if; - - Set_Parameter_Specifications (Specification (Original_Body), No_List); - Set_Defining_Unit_Name (Specification (Original_Body), - Make_Defining_Identifier (Sloc (N), New_Internal_Name ('S'))); - Set_Corresponding_Spec (Original_Body, Empty); - - if Ekind (Subp) = E_Function then - Set_Subtype_Mark (Specification (Original_Body), - New_Occurrence_Of (Etype (Subp), Sloc (N))); + return; end if; - if Present (Declarations (Orig_Body)) - and then Has_Excluded_Declaration (Declarations (Orig_Body)) + if Present (Declarations (N)) + and then Has_Excluded_Declaration (Declarations (N)) then - return False; + return; end if; if Present (Handled_Statement_Sequence (N)) then @@ -1810,12 +1746,12 @@ package body Sem_Ch6 is ("cannot inline& (exception handler)?", First (Exception_Handlers (Handled_Statement_Sequence (N))), Subp); - return False; + return; elsif Has_Excluded_Statement (Statements (Handled_Statement_Sequence (N))) then - return False; + return; end if; end if; @@ -1827,16 +1763,36 @@ package body Sem_Ch6 is and then not Is_Always_Inlined (Subp) then Cannot_Inline ("cannot inline& (body too large)?", N, Subp); - return False; + return; end if; if Has_Pending_Instantiation then Cannot_Inline ("cannot inline& (forward instance within enclosing body)?", N, Subp); - return False; + return; + end if; + + -- Within an instance, the body to inline must be treated as a nested + -- generic, so that the proper global references are preserved. + + if In_Instance then + Save_Env (Scope (Current_Scope), Scope (Current_Scope)); + Original_Body := Copy_Generic_Node (N, Empty, True); + else + Original_Body := Copy_Separate_Tree (N); end if; + -- We need to capture references to the formals in order to substitute + -- the actuals at the point of inlining, i.e. instantiation. To treat + -- the formals as globals to the body to inline, we nest it within + -- a dummy parameterless subprogram, declared within the real one. + + Set_Parameter_Specifications (Specification (Original_Body), No_List); + Set_Defining_Unit_Name (Specification (Original_Body), + Make_Defining_Identifier (Sloc (N), New_Internal_Name ('S'))); + Set_Corresponding_Spec (Original_Body, Empty); + Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); -- Set return type of function, which is also global and does not need @@ -1866,7 +1822,10 @@ package body Sem_Ch6 is Set_Body_To_Inline (Decl, Original_Body); Set_Ekind (Defining_Entity (Original_Body), Ekind (Subp)); Set_Is_Inlined (Subp); - return True; + + if In_Instance then + Restore_Env; + end if; end Build_Body_To_Inline; ------------------- @@ -2972,8 +2931,7 @@ package body Sem_Ch6 is (T1 : Entity_Id; T2 : Entity_Id; Ctype : Conformance_Type; - Get_Inst : Boolean := False) - return Boolean + Get_Inst : Boolean := False) return Boolean is Type_1 : Entity_Id := T1; Type_2 : Entity_Id := T2; @@ -3475,8 +3433,7 @@ package body Sem_Ch6 is function Fully_Conformant_Expressions (Given_E1 : Node_Id; - Given_E2 : Node_Id) - return Boolean + Given_E2 : Node_Id) return Boolean is E1 : constant Node_Id := Original_Node (Given_E1); E2 : constant Node_Id := Original_Node (Given_E2); @@ -3849,8 +3806,7 @@ package body Sem_Ch6 is function Fully_Conformant_Discrete_Subtypes (Given_S1 : Node_Id; - Given_S2 : Node_Id) - return Boolean + Given_S2 : Node_Id) return Boolean is S1 : constant Node_Id := Original_Node (Given_S1); S2 : constant Node_Id := Original_Node (Given_S2); @@ -3942,8 +3898,7 @@ package body Sem_Ch6 is function Is_Non_Overriding_Operation (Prev_E : Entity_Id; - New_E : Entity_Id) - return Boolean + New_E : Entity_Id) return Boolean is Formal : Entity_Id; F_Typ : Entity_Id; @@ -3956,8 +3911,7 @@ package body Sem_Ch6 is function Types_Correspond (P_Type : Entity_Id; - N_Type : Entity_Id) - return Boolean; + N_Type : Entity_Id) return Boolean; -- Returns true if and only if the types (or designated types -- in the case of anonymous access types) are the same or N_Type -- is derived directly or indirectly from P_Type. @@ -4005,8 +3959,7 @@ package body Sem_Ch6 is function Types_Correspond (P_Type : Entity_Id; - N_Type : Entity_Id) - return Boolean + N_Type : Entity_Id) return Boolean is Prev_Type : Entity_Id := Base_Type (P_Type); New_Type : Entity_Id := Base_Type (N_Type); @@ -5245,7 +5198,6 @@ package body Sem_Ch6 is function Type_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is Result : Boolean; - begin Check_Conformance (New_Id, Old_Id, Type_Conformant, False, Result); return Result; |