From d930784028af209c12327ae6ee0cc2b163fe82ae Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Wed, 18 Nov 2015 10:05:58 +0000 Subject: [PATCH] sem_ch4.adb: Minor reformatting. 2015-11-18 Hristian Kirtchev * sem_ch4.adb: Minor reformatting. 2015-11-18 Hristian Kirtchev * exp_util.adb (Expand_Subtype_From_Expr): Add new formal parameter Related_Id and propagate it to Make_Subtype_From_Expr. (Make_Subtype_From_Expr): Add new formal parameter Related_Id. Create external entities when requested by the caller. * exp_util.ads (Expand_Subtype_From_Expr): Add new formal parameter Related_Id. Update the comment on usage. (Make_Subtype_From_Expr): Add new formal parameter Related_Id. Update the comment on usage. * sem_ch3.adb (Analyze_Object_Declaration): Add local variable Related_Id. Generate an external constrained subtype when the object is a public symbol. 2015-11-18 Hristian Kirtchev * sem_prag.adb (Analyze_Pragma): Update the grammars of pragmas Abstract_State, Depends, Global, Initializes, Refined_Depends, Refined_Global and Refined_State. From-SVN: r230524 --- gcc/ada/ChangeLog | 24 ++++++++++++++++++++++ gcc/ada/exp_util.adb | 34 +++++++++++++++++++++++--------- gcc/ada/exp_util.ads | 16 +++++++++------ gcc/ada/sem_ch3.adb | 21 +++++++++++++++++++- gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_prag.adb | 47 +++++++++++++++++++++----------------------- 6 files changed, 102 insertions(+), 42 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d3923a31f9..1393a92c0be 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2015-11-18 Hristian Kirtchev + + * sem_ch4.adb: Minor reformatting. + +2015-11-18 Hristian Kirtchev + + * exp_util.adb (Expand_Subtype_From_Expr): Add new formal + parameter Related_Id and propagate it to Make_Subtype_From_Expr. + (Make_Subtype_From_Expr): Add new formal parameter + Related_Id. Create external entities when requested by the caller. + * exp_util.ads (Expand_Subtype_From_Expr): Add new formal + parameter Related_Id. Update the comment on usage. + (Make_Subtype_From_Expr): Add new formal parameter + Related_Id. Update the comment on usage. + * sem_ch3.adb (Analyze_Object_Declaration): Add local variable + Related_Id. Generate an external constrained subtype when the + object is a public symbol. + +2015-11-18 Hristian Kirtchev + + * sem_prag.adb (Analyze_Pragma): Update the grammars of pragmas + Abstract_State, Depends, Global, Initializes, Refined_Depends, + Refined_Global and Refined_State. + 2015-11-18 Hristian Kirtchev * sem_util.adb (Has_Full_Default_Initialization): diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 0b9543a6bea..3f10b9573fd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2152,7 +2152,8 @@ package body Exp_Util is (N : Node_Id; Unc_Type : Entity_Id; Subtype_Indic : Node_Id; - Exp : Node_Id) + Exp : Node_Id; + Related_Id : Entity_Id := Empty) is Loc : constant Source_Ptr := Sloc (N); Exp_Typ : constant Entity_Id := Etype (Exp); @@ -2357,7 +2358,7 @@ package body Exp_Util is else Remove_Side_Effects (Exp); Rewrite (Subtype_Indic, - Make_Subtype_From_Expr (Exp, Unc_Type)); + Make_Subtype_From_Expr (Exp, Unc_Type, Related_Id)); end if; end Expand_Subtype_From_Expr; @@ -6566,8 +6567,9 @@ package body Exp_Util is -- 3. If Expr is class-wide, creates an implicit class-wide subtype function Make_Subtype_From_Expr - (E : Node_Id; - Unc_Typ : Entity_Id) return Node_Id + (E : Node_Id; + Unc_Typ : Entity_Id; + Related_Id : Entity_Id := Empty) return Node_Id is List_Constr : constant List_Id := New_List; Loc : constant Source_Ptr := Sloc (E); @@ -6584,18 +6586,32 @@ package body Exp_Util is if Is_Private_Type (Unc_Typ) and then Has_Unknown_Discriminants (Unc_Typ) then + -- The caller requests a unque external name for both the private and + -- the full subtype. + + if Present (Related_Id) then + Full_Subtyp := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Related_Id), 'C')); + Priv_Subtyp := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Related_Id), 'P')); + + else + Full_Subtyp := Make_Temporary (Loc, 'C'); + Priv_Subtyp := Make_Temporary (Loc, 'P'); + end if; + -- Prepare the subtype completion. Use the base type to find the -- underlying type because the type may be a generic actual or an -- explicit subtype. - Utyp := Underlying_Type (Base_Type (Unc_Typ)); - Full_Subtyp := Make_Temporary (Loc, 'C'); - Full_Exp := + Utyp := Underlying_Type (Base_Type (Unc_Typ)); + + Full_Exp := Unchecked_Convert_To (Utyp, Duplicate_Subexpr_No_Checks (E)); Set_Parent (Full_Exp, Parent (E)); - Priv_Subtyp := Make_Temporary (Loc, 'P'); - Insert_Action (E, Make_Subtype_Declaration (Loc, Defining_Identifier => Full_Subtyp, diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 41503c6c82f..10fd70c7981 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -445,10 +445,12 @@ package Exp_Util is (N : Node_Id; Unc_Type : Entity_Id; Subtype_Indic : Node_Id; - Exp : Node_Id); + Exp : Node_Id; + Related_Id : Entity_Id := Empty); -- Build a constrained subtype from the initial value in object -- declarations and/or allocations when the type is indefinite (including - -- class-wide). + -- class-wide). Set Related_Id to request an external name for the subtype + -- rather than an internal temporary. function Finalize_Address (Typ : Entity_Id) return Entity_Id; -- Locate TSS primitive Finalize_Address in type Typ. Return Empty if the @@ -780,11 +782,13 @@ package Exp_Util is -- Predicate_Check is suppressed then a null statement is returned instead. function Make_Subtype_From_Expr - (E : Node_Id; - Unc_Typ : Entity_Id) return Node_Id; + (E : Node_Id; + Unc_Typ : Entity_Id; + Related_Id : Entity_Id := Empty) return Node_Id; -- Returns a subtype indication corresponding to the actual type of an - -- expression E. Unc_Typ is an unconstrained array or record, or - -- a classwide type. + -- expression E. Unc_Typ is an unconstrained array or record, or a class- + -- wide type. Set Related_Id to request an external name for the subtype + -- rather than an internal temporary. function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id; -- Given a scalar subtype Typ, returns a matching type in standard that diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 26ed179296f..cff492a8c41 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3390,6 +3390,7 @@ package body Sem_Ch3 is -- Local variables Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Related_Id : Entity_Id; -- Start of processing for Analyze_Object_Declaration @@ -4015,7 +4016,25 @@ package body Sem_Ch3 is return; else - Expand_Subtype_From_Expr (N, T, Object_Definition (N), E); + -- Ensure that the generated subtype has a unique external name + -- when the related object is public. This guarantees that the + -- subtype and its bounds will not be affected by switches or + -- pragmas that may offset the internal counter due to extra + -- generated code. + + if Is_Public (Id) then + Related_Id := Id; + else + Related_Id := Empty; + end if; + + Expand_Subtype_From_Expr + (N => N, + Unc_Type => T, + Subtype_Indic => Object_Definition (N), + Exp => E, + Related_Id => Related_Id); + Act_T := Find_Type_Of_Object (Object_Definition (N), N); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 35bb7f2afbb..9ac6f8fc5ac 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3073,7 +3073,7 @@ package body Sem_Ch4 is if not Is_Type (Nam) then if Is_Entity_Name (Name (N)) then Set_Entity (Name (N), Nam); - Set_Etype (Name (N), Etype (Nam)); + Set_Etype (Name (N), Etype (Nam)); elsif Nkind (Name (N)) = N_Selected_Component then Set_Entity (Selector_Name (Name (N)), Nam); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d2df5d6a0ce..be42aaa390c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9998,7 +9998,7 @@ package body Sem_Prag is -- ABSTRACT_STATE_LIST ::= -- null -- | STATE_NAME_WITH_OPTIONS - -- | (STATE_NAME_WITH_OPTIONS {, STATE_NAME_WITH_OPTIONS} ) + -- | (STATE_NAME_WITH_OPTIONS {, STATE_NAME_WITH_OPTIONS}) -- STATE_NAME_WITH_OPTIONS ::= -- STATE_NAME @@ -10018,7 +10018,7 @@ package body Sem_Prag is -- EXTERNAL_PROPERTY_LIST ::= -- EXTERNAL_PROPERTY - -- | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY} ) + -- | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY}) -- EXTERNAL_PROPERTY ::= -- Async_Readers [=> boolean_EXPRESSION] @@ -13412,8 +13412,8 @@ package body Sem_Prag is -- pragma Depends (DEPENDENCY_RELATION); -- DEPENDENCY_RELATION ::= - -- null - -- | DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE} + -- null + -- | (DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE}) -- DEPENDENCY_CLAUSE ::= -- OUTPUT_LIST =>[+] INPUT_LIST @@ -14945,9 +14945,9 @@ package body Sem_Prag is -- pragma Global (GLOBAL_SPECIFICATION); -- GLOBAL_SPECIFICATION ::= - -- null - -- | GLOBAL_LIST - -- | MODED_GLOBAL_LIST {, MODED_GLOBAL_LIST} + -- null + -- | (GLOBAL_LIST) + -- | (MODED_GLOBAL_LIST {, MODED_GLOBAL_LIST}) -- MODED_GLOBAL_LIST ::= MODE_SELECTOR => GLOBAL_LIST @@ -15689,20 +15689,18 @@ package body Sem_Prag is -- Initializes -- ----------------- - -- pragma Initializes (INITIALIZATION_SPEC); - - -- INITIALIZATION_SPEC ::= null | INITIALIZATION_LIST + -- pragma Initializes (INITIALIZATION_LIST); -- INITIALIZATION_LIST ::= - -- INITIALIZATION_ITEM - -- | (INITIALIZATION_ITEM {, INITIALIZATION_ITEM}) + -- null + -- | (INITIALIZATION_ITEM {, INITIALIZATION_ITEM}) -- INITIALIZATION_ITEM ::= name [=> INPUT_LIST] -- INPUT_LIST ::= - -- null - -- | INPUT - -- | (INPUT {, INPUT}) + -- null + -- | INPUT + -- | (INPUT {, INPUT}) -- INPUT ::= name @@ -19287,8 +19285,8 @@ package body Sem_Prag is -- pragma Refined_Depends (DEPENDENCY_RELATION); -- DEPENDENCY_RELATION ::= - -- null - -- | DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE} + -- null + -- | (DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE}) -- DEPENDENCY_CLAUSE ::= -- OUTPUT_LIST =>[+] INPUT_LIST @@ -19363,9 +19361,9 @@ package body Sem_Prag is -- pragma Refined_Global (GLOBAL_SPECIFICATION); -- GLOBAL_SPECIFICATION ::= - -- null - -- | GLOBAL_LIST - -- | MODED_GLOBAL_LIST {, MODED_GLOBAL_LIST} + -- null + -- | (GLOBAL_LIST) + -- | (MODED_GLOBAL_LIST {, MODED_GLOBAL_LIST}) -- MODED_GLOBAL_LIST ::= MODE_SELECTOR => GLOBAL_LIST @@ -19488,15 +19486,14 @@ package body Sem_Prag is -- pragma Refined_State (REFINEMENT_LIST); -- REFINEMENT_LIST ::= - -- REFINEMENT_CLAUSE - -- | (REFINEMENT_CLAUSE {, REFINEMENT_CLAUSE}) + -- (REFINEMENT_CLAUSE {, REFINEMENT_CLAUSE}) -- REFINEMENT_CLAUSE ::= state_NAME => CONSTITUENT_LIST -- CONSTITUENT_LIST ::= - -- null - -- | CONSTITUENT - -- | (CONSTITUENT {, CONSTITUENT}) + -- null + -- | CONSTITUENT + -- | (CONSTITUENT {, CONSTITUENT}) -- CONSTITUENT ::= object_NAME | state_NAME -- 2.30.2