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 <kirtc...@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.
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
