Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/sem_ch7.adb @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line diff
--- a/gcc/ada/sem_ch7.adb Thu Oct 25 07:37:49 2018 +0900 +++ b/gcc/ada/sem_ch7.adb Thu Feb 13 11:34:05 2020 +0900 @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -389,6 +389,8 @@ end if; -- An inlined subprogram body acts as a referencer + -- unless we generate C code since inlining is then + -- handled by the C compiler. -- Note that we test Has_Pragma_Inline here in addition -- to Is_Inlined. We are doing this for a client, since @@ -397,8 +399,9 @@ -- should occur, so we need to catch all cases where the -- subprogram may be inlined by the client. - if Is_Inlined (Decl_Id) - or else Has_Pragma_Inline (Decl_Id) + if not Generate_C_Code + and then (Is_Inlined (Decl_Id) + or else Has_Pragma_Inline (Decl_Id)) then Has_Referencer_Of_Non_Subprograms := True; @@ -415,9 +418,12 @@ Decl_Id := Defining_Entity (Decl); -- An inlined subprogram body acts as a referencer - - if Is_Inlined (Decl_Id) - or else Has_Pragma_Inline (Decl_Id) + -- unless we generate C code since inlining is then + -- handled by the C compiler. + + if not Generate_C_Code + and then (Is_Inlined (Decl_Id) + or else Has_Pragma_Inline (Decl_Id)) then Has_Referencer_Of_Non_Subprograms := True; @@ -669,6 +675,7 @@ Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_EA : constant Boolean := Expander_Active; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; -- Save the Ghost and SPARK mode-related data to restore on exit @@ -780,6 +787,18 @@ Mark_And_Set_Ghost_Body (N, Spec_Id); + -- Deactivate expansion inside the body of ignored Ghost entities, + -- as this code will ultimately be ignored. This avoids requiring the + -- presence of run-time units which are not needed. Only do this for + -- user entities, as internally generated entities might still need + -- to be expanded (e.g. those generated for types). + + if Present (Ignored_Ghost_Region) + and then Comes_From_Source (Body_Id) + then + Expander_Active := False; + end if; + -- If the body completes the initial declaration of a compilation unit -- which is subject to pragma Elaboration_Checks, set the model of the -- pragma because it applies to all parts of the unit. @@ -906,9 +925,12 @@ -- This is a nested package, so it may be necessary to declare certain -- inherited subprograms that are not yet visible because the parent -- type's subprograms are now visible. + -- Note that for child units these operations were generated when + -- analyzing the package specification. if Ekind (Scope (Spec_Id)) = E_Package and then Scope (Spec_Id) /= Standard_Standard + and then not Is_Child_Unit (Spec_Id) then Declare_Inherited_Private_Subprograms (Spec_Id); end if; @@ -1044,7 +1066,7 @@ -- to the linker as their Is_Public flag is set to True. This proactive -- approach is necessary because an inlined or a generic body for which -- code is generated in other units may need to see these entities. Cut - -- down the number of global symbols that do not neet public visibility + -- down the number of global symbols that do not need public visibility -- as this has two beneficial effects: -- (1) It makes the compilation process more efficient. -- (2) It gives the code generator more leeway to optimize within each @@ -1075,6 +1097,10 @@ end if; end if; + if Present (Ignored_Ghost_Region) then + Expander_Active := Saved_EA; + end if; + Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; Restore_Ghost_Region (Saved_GM, Saved_IGR); end Analyze_Package_Body_Helper; @@ -1248,7 +1274,7 @@ procedure Generate_Parent_References; -- For a child unit, generate references to parent units, for - -- GPS navigation purposes. + -- GNAT Studio navigation purposes. function Is_Public_Child (Child, Unit : Entity_Id) return Boolean; -- Child and Unit are entities of compilation units. True if Child @@ -1485,9 +1511,21 @@ Inst_Par := Renamed_Entity (Inst_Par); end if; - Gen_Par := - Generic_Parent - (Specification (Unit_Declaration_Node (Inst_Par))); + -- The instance may appear in a sibling generic unit, in + -- which case the prefix must include the common (generic) + -- ancestor, which is treated as a current instance. + + if Inside_A_Generic + and then Ekind (Inst_Par) = E_Generic_Package + then + Gen_Par := Inst_Par; + pragma Assert (In_Open_Scopes (Gen_Par)); + + else + Gen_Par := + Generic_Parent + (Specification (Unit_Declaration_Node (Inst_Par))); + end if; -- Install the private declarations and private use clauses -- of a parent instance of the child instance, unless the @@ -1734,7 +1772,7 @@ end if; -- There may be inherited private subprograms that need to be declared, - -- even in the absence of an explicit private part. If there are any + -- even in the absence of an explicit private part. If there are any -- public declarations in the package and the package is a public child -- unit, then an implicit private part is assumed. @@ -1860,7 +1898,7 @@ end if; -- Nested package specs that do not require bodies are not checked for - -- ineffective use clauses due to the possbility of subunits. This is + -- ineffective use clauses due to the possibility of subunits. This is -- because at this stage it is impossible to tell whether there will be -- a separate body. @@ -2238,13 +2276,14 @@ procedure Swap_Private_Dependents (Priv_Deps : Elist_Id); -- When the full view of a private type is made available, we do the -- same for its private dependents under proper visibility conditions. - -- When compiling a grand-chid unit this needs to be done recursively. + -- When compiling a child unit this needs to be done recursively. ----------------------------- -- Swap_Private_Dependents -- ----------------------------- procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is + Cunit : Entity_Id; Deps : Elist_Id; Priv : Entity_Id; Priv_Elmt : Elmt_Id; @@ -2262,6 +2301,7 @@ if Present (Full_View (Priv)) and then Is_Visible_Dependent (Priv) then if Is_Private_Type (Priv) then + Cunit := Cunit_Entity (Current_Sem_Unit); Deps := Private_Dependents (Priv); Is_Priv := True; else @@ -2289,11 +2329,14 @@ Set_Is_Potentially_Use_Visible (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt))); - -- Within a child unit, recurse, except in generic child unit, - -- which (unfortunately) handle private_dependents separately. + -- Recurse for child units, except in generic child units, + -- which unfortunately handle private_dependents separately. + -- Note that the current unit may not have been analyzed, + -- for example a package body, so we cannot rely solely on + -- the Is_Child_Unit flag, but that's only an optimization. if Is_Priv - and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit)) + and then (No (Etype (Cunit)) or else Is_Child_Unit (Cunit)) and then not Is_Empty_Elmt_List (Deps) and then not Inside_A_Generic then @@ -2678,13 +2721,16 @@ Decl : constant Node_Id := Unit_Declaration_Node (P); Id : Entity_Id; Full : Entity_Id; - Priv_Elmt : Elmt_Id; - Priv_Sub : Entity_Id; procedure Preserve_Full_Attributes (Priv : Entity_Id; Full : Entity_Id); -- Copy to the private declaration the attributes of the full view that -- need to be available for the partial view also. + procedure Swap_Private_Dependents (Priv_Deps : Elist_Id); + -- When the full view of a private type is made unavailable, we do the + -- same for its private dependents under proper visibility conditions. + -- When compiling a child unit this needs to be done recursively. + function Type_In_Use (T : Entity_Id) return Boolean; -- Check whether type or base type appear in an active use_type clause @@ -2733,6 +2779,16 @@ Propagate_Concurrent_Flags (Priv, Base_Type (Full)); end if; + -- As explained in Freeze_Entity, private types are required to point + -- to the same freeze node as their corresponding full view, if any. + -- But we ought not to overwrite a node already inserted in the tree. + + pragma Assert + (Serious_Errors_Detected /= 0 + or else No (Freeze_Node (Priv)) + or else No (Parent (Freeze_Node (Priv))) + or else Freeze_Node (Priv) = Freeze_Node (Full)); + Set_Freeze_Node (Priv, Freeze_Node (Full)); -- Propagate Default_Initial_Condition-related attributes from the @@ -2793,6 +2849,66 @@ end if; end Preserve_Full_Attributes; + ----------------------------- + -- Swap_Private_Dependents -- + ----------------------------- + + procedure Swap_Private_Dependents (Priv_Deps : Elist_Id) is + Cunit : Entity_Id; + Deps : Elist_Id; + Priv : Entity_Id; + Priv_Elmt : Elmt_Id; + Is_Priv : Boolean; + + begin + Priv_Elmt := First_Elmt (Priv_Deps); + while Present (Priv_Elmt) loop + Priv := Node (Priv_Elmt); + + -- Before we do the swap, we verify the presence of the Full_View + -- field, which may be empty due to a swap by a previous call to + -- End_Package_Scope (e.g. from the freezing mechanism). + + if Present (Full_View (Priv)) then + if Is_Private_Type (Priv) then + Cunit := Cunit_Entity (Current_Sem_Unit); + Deps := Private_Dependents (Priv); + Is_Priv := True; + else + Is_Priv := False; + end if; + + if Scope (Priv) = P + or else not In_Open_Scopes (Scope (Priv)) + then + Set_Is_Immediately_Visible (Priv, False); + end if; + + if Is_Visible_Dependent (Priv) then + Preserve_Full_Attributes (Priv, Full_View (Priv)); + Replace_Elmt (Priv_Elmt, Full_View (Priv)); + Exchange_Declarations (Priv); + + -- Recurse for child units, except in generic child units, + -- which unfortunately handle private_dependents separately. + -- Note that the current unit may not have been analyzed, + -- for example a package body, so we cannot rely solely on + -- the Is_Child_Unit flag, but that's only an optimization. + + if Is_Priv + and then (No (Etype (Cunit)) or else Is_Child_Unit (Cunit)) + and then not Is_Empty_Elmt_List (Deps) + and then not Inside_A_Generic + then + Swap_Private_Dependents (Deps); + end if; + end if; + end if; + + Next_Elmt (Priv_Elmt); + end loop; + end Swap_Private_Dependents; + ----------------- -- Type_In_Use -- ----------------- @@ -2820,8 +2936,9 @@ -- a) If the entity is an operator, it may be a primitive operator of -- a type for which there is a visible use-type clause. - -- b) for other entities, their use-visibility is determined by a - -- visible use clause for the package itself. For a generic instance, + -- b) For other entities, their use-visibility is determined by a + -- visible use clause for the package itself or a use-all-type clause + -- applied directly to the entity's type. For a generic instance, -- the instantiation of the formals appears in the visible part, -- but the formals are private and remain so. @@ -2854,6 +2971,16 @@ Set_Is_Potentially_Use_Visible (Id); end if; + -- We need to avoid incorrectly marking enumeration literals as + -- non-visible when a visible use-all-type clause is in effect. + + elsif Type_In_Use (Etype (Id)) + and then Nkind (Current_Use_Clause (Etype (Id))) = + N_Use_Type_Clause + and then All_Present (Current_Use_Clause (Etype (Id))) + then + null; + else Set_Is_Potentially_Use_Visible (Id, False); end if; @@ -3033,31 +3160,7 @@ -- were compiled in this scope, or installed previously -- by Install_Private_Declarations. - -- Before we do the swap, we verify the presence of the Full_View - -- field which may be empty due to a swap by a previous call to - -- End_Package_Scope (e.g. from the freezing mechanism). - - Priv_Elmt := First_Elmt (Private_Dependents (Id)); - while Present (Priv_Elmt) loop - Priv_Sub := Node (Priv_Elmt); - - if Present (Full_View (Priv_Sub)) then - if Scope (Priv_Sub) = P - or else not In_Open_Scopes (Scope (Priv_Sub)) - then - Set_Is_Immediately_Visible (Priv_Sub, False); - end if; - - if Is_Visible_Dependent (Priv_Sub) then - Preserve_Full_Attributes - (Priv_Sub, Full_View (Priv_Sub)); - Replace_Elmt (Priv_Elmt, Full_View (Priv_Sub)); - Exchange_Declarations (Priv_Sub); - end if; - end if; - - Next_Elmt (Priv_Elmt); - end loop; + Swap_Private_Dependents (Private_Dependents (Id)); -- Now restore the type itself to its private view @@ -3152,7 +3255,7 @@ E : Entity_Id; Requires_Body : Boolean := False; - -- Flag set when the unit has at least one construct that requries + -- Flag set when the unit has at least one construct that requires -- completion in a body. begin @@ -3215,7 +3318,7 @@ -- A [generic] package that defines at least one non-null abstract state -- requires a completion only when at least one other construct requires - -- a completion in a body (SPARK RM 7.1.4(4) and (6)). This check is not + -- a completion in a body (SPARK RM 7.1.4(4) and (5)). This check is not -- performed if the caller requests this behavior. if Do_Abstract_States