mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-09 21:31:30 +08:00
[multiple changes]
2014-07-29 Thomas Quinot <quinot@adacore.com> * sem_ch3.adb (Constrain_Corresponding_Record): For the case of the subtype created for a record component, do not mark the subtype as frozen. For one thing, this is anomalous (in particular, the base type might not itself be frozen yet); furthermore, proper freezing of the subtype must happen in any case. So, we just mark the subtype as requiring delayed freezing (and we'll actually freeze it when generating the init_proc of the enclosing record). Also change the name of the constrained record subtype (append a 'C' so that it is clearly different from the unconstrained record type, "related_idV") to make debugging easier. (Process_Full_View): When creating a full subtype for a pending private subtype, re-establish the scope of the private subtype so that we get proper visibility on outer discriminants. * exp_ch3.adb (Build_Init_Statements): Freeze any component subtype that is not frozen yet. 2014-07-29 Vincent Celier <celier@adacore.com> * prj-proc.adb (Recursive_Process): Always initialize the environment when the project is an aggregate project, even when it is not the root tree. From-SVN: r213197
This commit is contained in:
parent
0677a1c750
commit
422e02cfdf
@ -1,3 +1,27 @@
|
||||
2014-07-29 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Constrain_Corresponding_Record): For the case
|
||||
of the subtype created for a record component, do not mark
|
||||
the subtype as frozen. For one thing, this is anomalous (in
|
||||
particular, the base type might not itself be frozen yet);
|
||||
furthermore, proper freezing of the subtype must happen in any
|
||||
case. So, we just mark the subtype as requiring delayed freezing
|
||||
(and we'll actually freeze it when generating the init_proc of
|
||||
the enclosing record).
|
||||
Also change the name of the constrained record subtype (append a
|
||||
'C' so that it is clearly different from the unconstrained record
|
||||
type, "related_idV") to make debugging easier.
|
||||
(Process_Full_View): When creating a full subtype for a pending
|
||||
private subtype, re-establish the scope of the private subtype
|
||||
so that we get proper visibility on outer discriminants.
|
||||
* exp_ch3.adb (Build_Init_Statements): Freeze any component
|
||||
subtype that is not frozen yet.
|
||||
|
||||
2014-07-29 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* prj-proc.adb (Recursive_Process): Always initialize the
|
||||
environment when the project is an aggregate project, even when
|
||||
it is not the root tree.
|
||||
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch5.adb, exp_ch9.adb: Minor comment additions.
|
||||
|
@ -2818,6 +2818,14 @@ package body Exp_Ch3 is
|
||||
-- Regular component cases
|
||||
|
||||
else
|
||||
-- In the context of the init proc, references to discriminants
|
||||
-- resolve to denote the discriminals: this is where we can
|
||||
-- freeze discriminant dependent component subtypes.
|
||||
|
||||
if not Is_Frozen (Typ) then
|
||||
Append_List_To (Stmts, Freeze_Entity (Typ, N));
|
||||
end if;
|
||||
|
||||
-- Explicit initialization
|
||||
|
||||
if Present (Expression (Decl)) then
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -2898,7 +2898,7 @@ package body Prj.Proc is
|
||||
|
||||
Process_Imported_Projects (Imported, Limited_With => False);
|
||||
|
||||
if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
|
||||
if Project.Qualifier = Aggregate then
|
||||
Initialize_And_Copy (Child_Env, Copy_From => Env);
|
||||
|
||||
elsif Project.Qualifier = Aggregate_Library then
|
||||
|
@ -35,7 +35,6 @@ with Exp_Ch3; use Exp_Ch3;
|
||||
with Exp_Ch9; use Exp_Ch9;
|
||||
with Exp_Disp; use Exp_Disp;
|
||||
with Exp_Dist; use Exp_Dist;
|
||||
with Exp_Pakd; use Exp_Pakd;
|
||||
with Exp_Tss; use Exp_Tss;
|
||||
with Exp_Util; use Exp_Util;
|
||||
with Fname; use Fname;
|
||||
@ -413,15 +412,14 @@ package body Sem_Ch3 is
|
||||
-- Def_Id is an in/out parameter).
|
||||
--
|
||||
-- Related_Nod gives the place where this type has to be inserted
|
||||
-- in the tree
|
||||
-- in the tree.
|
||||
--
|
||||
-- The last two arguments are used to create its external name if needed.
|
||||
|
||||
function Constrain_Corresponding_Record
|
||||
(Prot_Subt : Entity_Id;
|
||||
Corr_Rec : Entity_Id;
|
||||
Related_Nod : Node_Id;
|
||||
Related_Id : Entity_Id) return Entity_Id;
|
||||
Related_Nod : Node_Id) return Entity_Id;
|
||||
-- When constraining a protected type or task type with discriminants,
|
||||
-- constrain the corresponding record with the same discriminant values.
|
||||
|
||||
@ -10926,8 +10924,7 @@ package body Sem_Ch3 is
|
||||
then
|
||||
Set_Corresponding_Record_Type (Full,
|
||||
Constrain_Corresponding_Record
|
||||
(Full, Corresponding_Record_Type (Full_Base),
|
||||
Related_Nod, Full_Base));
|
||||
(Full, Corresponding_Record_Type (Full_Base), Related_Nod));
|
||||
|
||||
else
|
||||
Set_Corresponding_Record_Type (Full,
|
||||
@ -11367,8 +11364,7 @@ package body Sem_Ch3 is
|
||||
or else Is_Protected_Type (Desig_Type))
|
||||
and then not Is_Constrained (Desig_Type)
|
||||
then
|
||||
Constrain_Concurrent
|
||||
(Desig_Subtype, S, Related_Nod, Desig_Type, ' ');
|
||||
Constrain_Concurrent (Desig_Subtype, S, Related_Nod, Desig_Type, ' ');
|
||||
|
||||
else
|
||||
Error_Msg_N ("invalid constraint on access type", S);
|
||||
@ -11563,7 +11559,6 @@ package body Sem_Ch3 is
|
||||
is
|
||||
Loc : constant Source_Ptr := Sloc (Constrained_Typ);
|
||||
Compon_Type : constant Entity_Id := Etype (Comp);
|
||||
Array_Comp : Node_Id;
|
||||
|
||||
function Build_Constrained_Array_Type
|
||||
(Old_Type : Entity_Id) return Entity_Id;
|
||||
@ -11961,22 +11956,7 @@ package body Sem_Ch3 is
|
||||
return Compon_Type;
|
||||
|
||||
elsif Is_Array_Type (Compon_Type) then
|
||||
Array_Comp := Build_Constrained_Array_Type (Compon_Type);
|
||||
|
||||
-- If the component of the parent is packed, and the record type is
|
||||
-- already frozen, as is the case for an itype, the component type
|
||||
-- itself will not be frozen, and the packed array type for it must
|
||||
-- be constructed explicitly. Since the creation of packed types is
|
||||
-- an expansion activity, we only do this if expansion is active.
|
||||
|
||||
if Expander_Active
|
||||
and then Is_Packed (Compon_Type)
|
||||
and then Is_Frozen (Current_Scope)
|
||||
then
|
||||
Create_Packed_Array_Impl_Type (Array_Comp);
|
||||
end if;
|
||||
|
||||
return Array_Comp;
|
||||
return Build_Constrained_Array_Type (Compon_Type);
|
||||
|
||||
elsif Has_Discriminants (Compon_Type) then
|
||||
return Build_Constrained_Discriminated_Type (Compon_Type);
|
||||
@ -12027,8 +12007,7 @@ package body Sem_Ch3 is
|
||||
|
||||
Set_Depends_On_Private (Def_Id, Has_Private_Component (Def_Id));
|
||||
Set_Corresponding_Record_Type (Def_Id,
|
||||
Constrain_Corresponding_Record
|
||||
(Def_Id, T_Val, Related_Nod, Related_Id));
|
||||
Constrain_Corresponding_Record (Def_Id, T_Val, Related_Nod));
|
||||
|
||||
else
|
||||
-- If there is no associated record, expansion is disabled and this
|
||||
@ -12050,11 +12029,10 @@ package body Sem_Ch3 is
|
||||
function Constrain_Corresponding_Record
|
||||
(Prot_Subt : Entity_Id;
|
||||
Corr_Rec : Entity_Id;
|
||||
Related_Nod : Node_Id;
|
||||
Related_Id : Entity_Id) return Entity_Id
|
||||
Related_Nod : Node_Id) return Entity_Id
|
||||
is
|
||||
T_Sub : constant Entity_Id :=
|
||||
Create_Itype (E_Record_Subtype, Related_Nod, Related_Id, 'V');
|
||||
Create_Itype (E_Record_Subtype, Related_Nod, Corr_Rec, 'C');
|
||||
|
||||
begin
|
||||
Set_Etype (T_Sub, Corr_Rec);
|
||||
@ -12063,16 +12041,6 @@ package body Sem_Ch3 is
|
||||
Set_First_Entity (T_Sub, First_Entity (Corr_Rec));
|
||||
Set_Last_Entity (T_Sub, Last_Entity (Corr_Rec));
|
||||
|
||||
-- As elsewhere, we do not want to create a freeze node for this itype
|
||||
-- if it is created for a constrained component of an enclosing record
|
||||
-- because references to outer discriminants will appear out of scope.
|
||||
|
||||
if Ekind (Scope (Prot_Subt)) /= E_Record_Type then
|
||||
Conditional_Delay (T_Sub, Corr_Rec);
|
||||
else
|
||||
Set_Is_Frozen (T_Sub);
|
||||
end if;
|
||||
|
||||
if Has_Discriminants (Prot_Subt) then -- False only if errors.
|
||||
Set_Discriminant_Constraint
|
||||
(T_Sub, Discriminant_Constraint (Prot_Subt));
|
||||
@ -12083,6 +12051,19 @@ package body Sem_Ch3 is
|
||||
|
||||
Set_Depends_On_Private (T_Sub, Has_Private_Component (T_Sub));
|
||||
|
||||
if Ekind (Scope (Prot_Subt)) /= E_Record_Type then
|
||||
Conditional_Delay (T_Sub, Corr_Rec);
|
||||
|
||||
else
|
||||
-- This is a component subtype: it will be frozen in the context of
|
||||
-- the enclosing record's init_proc, so that discriminant references
|
||||
-- are resolved to discriminals. (Note: we used to skip freezing
|
||||
-- altogether in that case, which caused errors downstream for
|
||||
-- components of a bit packed array type).
|
||||
|
||||
Set_Has_Delayed_Freeze (T_Sub);
|
||||
end if;
|
||||
|
||||
return T_Sub;
|
||||
end Constrain_Corresponding_Record;
|
||||
|
||||
@ -18622,6 +18603,7 @@ package body Sem_Ch3 is
|
||||
|
||||
declare
|
||||
Priv_Elmt : Elmt_Id;
|
||||
Priv_Scop : Entity_Id;
|
||||
Priv : Entity_Id;
|
||||
Full : Entity_Id;
|
||||
|
||||
@ -18629,6 +18611,7 @@ package body Sem_Ch3 is
|
||||
Priv_Elmt := First_Elmt (Private_Dependents (Priv_T));
|
||||
while Present (Priv_Elmt) loop
|
||||
Priv := Node (Priv_Elmt);
|
||||
Priv_Scop := Scope (Priv);
|
||||
|
||||
if Ekind_In (Priv, E_Private_Subtype,
|
||||
E_Limited_Private_Subtype,
|
||||
@ -18642,10 +18625,26 @@ package body Sem_Ch3 is
|
||||
-- Now we need to complete the private subtype, but since the
|
||||
-- base type has already been swapped, we must also swap the
|
||||
-- subtypes (and thus, reverse the arguments in the call to
|
||||
-- Complete_Private_Subtype).
|
||||
-- Complete_Private_Subtype). Also note that we may need to
|
||||
-- re-establish the scope of the private subtype.
|
||||
|
||||
Copy_And_Swap (Priv, Full);
|
||||
|
||||
if not In_Open_Scopes (Priv_Scop) then
|
||||
Push_Scope (Priv_Scop);
|
||||
|
||||
else
|
||||
-- Reset Priv_Scop to Empty to indicate no scope was pushed
|
||||
|
||||
Priv_Scop := Empty;
|
||||
end if;
|
||||
|
||||
Complete_Private_Subtype (Full, Priv, Full_T, N);
|
||||
|
||||
if Present (Priv_Scop) then
|
||||
Pop_Scope;
|
||||
end if;
|
||||
|
||||
Replace_Elmt (Priv_Elmt, Full);
|
||||
end if;
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user