diff mbox

[Ada] Undefined symbols with pragma Initialize_Scalars

Message ID 20151118100603.GA16748@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 18, 2015, 10:06 a.m. UTC
This patch modifies the generation of a constrained array subtype for an object
declaration to use an external name. This ensures that a reference to the array
subtype bounds are consistent when compiling with various switches and pragmas
such as Initialize_Scalars. No simple reproducer possible.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 230522)
+++ sem_ch3.adb	(working copy)
@@ -3390,6 +3390,7 @@ 
       --  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 @@ 
                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;
 
Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 230522)
+++ exp_util.adb	(working copy)
@@ -2152,7 +2152,8 @@ 
      (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 @@ 
       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 @@ 
    --  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 @@ 
       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,
Index: exp_util.ads
===================================================================
--- exp_util.ads	(revision 230522)
+++ exp_util.ads	(working copy)
@@ -445,10 +445,12 @@ 
      (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 @@ 
    --  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