sem_ch4.adb: Minor reformatting.

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch4.adb: Minor reformatting.

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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

6 files changed, 102 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0d3923a..1393a92 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,29 @@
 2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_ch4.adb: Minor reformatting.
+
+2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
+
 	* sem_util.adb (Has_Full_Default_Initialization):
 	Perform the test for the presence of pragma
 	Default_Initial_Condition prior to the specialized type
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0b9543a..3f10b95 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 41503c6..10fd70c 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 26ed179..cff492a 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 35bb7f2..9ac6f8f 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 d2df5d6..be42aaa 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