+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):
(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);
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;
-- 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);
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,
(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
-- 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
-- Local variables
Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
+ Related_Id : Entity_Id;
-- Start of processing for Analyze_Object_Declaration
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;
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);
-- 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
-- EXTERNAL_PROPERTY_LIST ::=
-- EXTERNAL_PROPERTY
- -- | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY} )
+ -- | (EXTERNAL_PROPERTY {, EXTERNAL_PROPERTY})
-- EXTERNAL_PROPERTY ::=
-- Async_Readers [=> boolean_EXPRESSION]
-- pragma Depends (DEPENDENCY_RELATION);
-- DEPENDENCY_RELATION ::=
- -- null
- -- | DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE}
+ -- null
+ -- | (DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE})
-- DEPENDENCY_CLAUSE ::=
-- OUTPUT_LIST =>[+] INPUT_LIST
-- 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
-- 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
-- pragma Refined_Depends (DEPENDENCY_RELATION);
-- DEPENDENCY_RELATION ::=
- -- null
- -- | DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE}
+ -- null
+ -- | (DEPENDENCY_CLAUSE {, DEPENDENCY_CLAUSE})
-- DEPENDENCY_CLAUSE ::=
-- OUTPUT_LIST =>[+] INPUT_LIST
-- 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
-- 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
projects / gcc.git / commitdiff