Skip to content

R
riscv-gcc-1
Commit 64dbfdec by Arnaud Charlet
Options

[multiple changes] 

2014-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch3.adb (Build_Derived_Private_Type): When the parent
	is untagged and has discriminants, build the implicit full
	view even if the derived type is a completion, and make it
	the Underlying_Full_View of the type.
	(Copy_And_Build): Fix Is_Completion actual parameter in the calls to
	Build_Derived_Type.
	(Build_Derived_Record_Type): Likewise.

2014-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb: Add guard to convention setting.

From-SVN: r216487
parent 59f2e9d8
Showing with 78 additions and 67 deletions
gcc/ada/ChangeLog
2014-10-20 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch3.adb (Build_Derived_Private_Type): When the parent
is untagged and has discriminants, build the implicit full
view even if the derived type is a completion, and make it
the Underlying_Full_View of the type.
(Copy_And_Build): Fix Is_Completion actual parameter in the calls to
Build_Derived_Type.
(Build_Derived_Record_Type): Likewise.
2014-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb: Add guard to convention setting.
2014-10-20 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, prj-proc.adb, prj-proc.ads, prj-conf.adb: Minor
......
gcc/ada/sem_ch13.adb
......@@ -10705,7 +10705,9 @@ package body Sem_Ch13 is
-- Convention
if Typ /= Base_Type (Typ) and then Is_Frozen (Base_Type (Typ)) then
if Is_Record_Type (Typ)
and then Typ /= Base_Type (Typ) and then Is_Frozen (Base_Type (Typ))
then
Set_Convention (Typ, Convention (Base_Type (Typ)));
end if;
......
gcc/ada/sem_ch3.adb
......@@ -6668,14 +6668,11 @@ package body Sem_Ch3 is
Is_Completion : Boolean;
Derive_Subps : Boolean := True)
is
Loc : constant Source_Ptr := Sloc (N);
Par_Base : constant Entity_Id := Base_Type (Parent_Type);
Par_Scope : constant Entity_Id := Scope (Par_Base);
Der_Base : Entity_Id;
Discr : Entity_Id;
Full_Der : Entity_Id;
Full_P : Entity_Id;
Last_Discr : Entity_Id;
Loc : constant Source_Ptr := Sloc (N);
Par_Base : constant Entity_Id := Base_Type (Parent_Type);
Par_Scope : constant Entity_Id := Scope (Par_Base);
Full_Der : Entity_Id := Empty;
Full_P : Entity_Id;
procedure Build_Full_Derivation;
-- Build full derivation, i.e. derive from the full view
......@@ -6796,7 +6793,8 @@ package body Sem_Ch3 is
else
Build_Derived_Type
(Full_N, Full_Parent, Full_Der, True, Derive_Subps => False);
(Full_N, Full_Parent, Full_Der,
Is_Completion => False, Derive_Subps => False);
end if;
-- The full declaration has been introduced into the tree and
......@@ -6815,7 +6813,8 @@ package body Sem_Ch3 is
Set_Associated_Node_For_Itype (Full_Der, N);
Set_Parent (Full_Der, N);
Build_Derived_Type
(N, Full_Parent, Full_Der, True, Derive_Subps => False);
(N, Full_Parent, Full_Der,
Is_Completion => False, Derive_Subps => False);
end if;
Set_Has_Private_Declaration (Full_Der);
......@@ -6945,40 +6944,17 @@ package body Sem_Ch3 is
return;
elsif Has_Discriminants (Parent_Type) then
if Present (Full_View (Parent_Type)) then
if not Is_Completion then
-- If this is not a completion, construct the implicit full
-- view by deriving from the full view of the parent type.
Build_Full_Derivation;
else
-- If this is a completion, the full view being built is itself
-- private. We build a subtype of the parent with the same
-- constraints as this full view, to convey to the back end the
-- constrained components and the size of this subtype. If the
-- parent is constrained, its full view can serve as the
-- underlying full view of the derived type.
if No (Discriminant_Specifications (N)) then
if Nkind (Subtype_Indication (Type_Definition (N))) =
N_Subtype_Indication
then
Build_Underlying_Full_View (N, Derived_Type, Parent_Type);
elsif Is_Constrained (Full_View (Parent_Type)) then
Set_Underlying_Full_View
(Derived_Type, Full_View (Parent_Type));
end if;
else
-- If there are new discriminants, the parent subtype is
-- constrained by them, but it is not clear how to build
-- the Underlying_Full_View in this case???
-- Build the full derivation if this is not the anonymous derived
-- base type created by Build_Derived_Record_Type in the constrained
-- case (see point 5. of its head comment) since we build it for the
-- derived subtype. And skip it for protected types altogether, as
-- gigi does not use these types directly.
null;
end if;
end if;
if Present (Full_View (Parent_Type))
and then not Is_Itype (Derived_Type)
and then not (Ekind (Full_View (Parent_Type)) in Protected_Kind)
then
Build_Full_Derivation;
end if;
-- Build partial view of derived type from partial view of parent
......@@ -6986,35 +6962,54 @@ package body Sem_Ch3 is
Build_Derived_Record_Type
(N, Parent_Type, Derived_Type, Derive_Subps);
if Present (Full_View (Parent_Type)) and then not Is_Completion then
-- Install full view in derived type (base type and subtype)
if Present (Full_Der) then
declare
Der_Base : constant Entity_Id := Base_Type (Derived_Type);
Discr : Entity_Id;
Last_Discr : Entity_Id;
Der_Base := Base_Type (Derived_Type);
Set_Full_View (Derived_Type, Full_Der);
Set_Full_View (Der_Base, Base_Type (Full_Der));
begin
-- If this is not a completion, construct the implicit full
-- view by deriving from the full view of the parent type.
-- But if this is a completion, the derived private type
-- being built is a full view and the full derivation can
-- only be its underlying full view.
if not Is_Completion then
Set_Full_View (Derived_Type, Full_Der);
else
Set_Underlying_Full_View (Derived_Type, Full_Der);
end if;
-- Copy the discriminant list from full view to the partial views
-- (base type and its subtype). Gigi requires that the partial and
-- full views have the same discriminants.
if not Is_Base_Type (Derived_Type) then
Set_Full_View (Der_Base, Base_Type (Full_Der));
end if;
-- Note that since the partial view is pointing to discriminants
-- in the full view, their scope will be that of the full view.
-- This might cause some front end problems and need adjustment???
-- Copy the discriminant list from full view to the partial
-- view (base type and its subtype). Gigi requires that the
-- partial and full views have the same discriminants.
Discr := First_Discriminant (Base_Type (Full_Der));
Set_First_Entity (Der_Base, Discr);
-- Note that since the partial view points to discriminants
-- in the full view, their scope will be that of the full
-- view. This might cause some front end problems and need
-- adjustment???
loop
Last_Discr := Discr;
Next_Discriminant (Discr);
exit when No (Discr);
end loop;
Discr := First_Discriminant (Base_Type (Full_Der));
Set_First_Entity (Der_Base, Discr);
Set_Last_Entity (Der_Base, Last_Discr);
loop
Last_Discr := Discr;
Next_Discriminant (Discr);
exit when No (Discr);
end loop;
Set_First_Entity (Derived_Type, First_Entity (Der_Base));
Set_Last_Entity (Derived_Type, Last_Entity (Der_Base));
Set_Stored_Constraint (Full_Der, Stored_Constraint (Derived_Type));
Set_Last_Entity (Der_Base, Last_Discr);
Set_First_Entity (Derived_Type, First_Entity (Der_Base));
Set_Last_Entity (Derived_Type, Last_Entity (Der_Base));
Set_Stored_Constraint
(Full_Der, Stored_Constraint (Derived_Type));
end;
end if;
elsif Present (Full_View (Parent_Type))
......@@ -7859,7 +7854,7 @@ package body Sem_Ch3 is
Build_Derived_Type
(New_Decl, Parent_Base, New_Base,
Is_Completion => True, Derive_Subps => False);
Is_Completion => False, Derive_Subps => False);
-- ??? This needs re-examination to determine whether the
-- above call can simply be replaced by a call to Analyze.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment