Commit 316e3a13 by Robert Dewar Committed by Arnaud Charlet

sem_ch3.adb, [...]: Code clean ups.

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, einfo.ads, exp_ch4.adb: Code clean ups.

From-SVN: r213477
parent 7f1a5156
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, einfo.ads, exp_ch4.adb: Code clean ups.
2014-08-01 Eric Botcazou <ebotcazou@adacore.com> 2014-08-01 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Has_Private_Ancestor): Remove obsolete usage. * einfo.ads (Has_Private_Ancestor): Remove obsolete usage.
......
...@@ -1803,8 +1803,8 @@ package Einfo is ...@@ -1803,8 +1803,8 @@ package Einfo is
-- private type, making some components invisible and aggregates illegal. -- private type, making some components invisible and aggregates illegal.
-- This flag is set at the point of derivation. The legality of the -- This flag is set at the point of derivation. The legality of the
-- aggregate must be rechecked because it also depends on the visibility -- aggregate must be rechecked because it also depends on the visibility
-- at the point the aggregate is resolved. See sem_aggr.adb. -- at the point the aggregate is resolved. See sem_aggr.adb. This is part
-- This is part of AI05-0115. -- of AI05-0115.
-- Has_Private_Declaration (Flag155) -- Has_Private_Declaration (Flag155)
-- Defined in all entities. Set if it is the defining entity of a private -- Defined in all entities. Set if it is the defining entity of a private
......
...@@ -2828,14 +2828,16 @@ package body Exp_Ch4 is ...@@ -2828,14 +2828,16 @@ package body Exp_Ch4 is
Rhs_Discr_Val)); Rhs_Discr_Val));
end; end;
-- All cases other than comparing Unchecked_Union types
else else
declare declare
T : constant Entity_Id := Etype (First_Formal (Eq_Op)); T : constant Entity_Id := Etype (First_Formal (Eq_Op));
begin begin
return return
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (Eq_Op, Loc), Name =>
New_Occurrence_Of (Eq_Op, Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
OK_Convert_To (T, Lhs), OK_Convert_To (T, Lhs),
OK_Convert_To (T, Rhs))); OK_Convert_To (T, Rhs)));
......
...@@ -6606,6 +6606,14 @@ package body Sem_Ch3 is ...@@ -6606,6 +6606,14 @@ package body Sem_Ch3 is
Full_Parent := Full_View (Full_Parent); Full_Parent := Full_View (Full_Parent);
end if; end if;
-- And its underlying full view if necessary
if Is_Private_Type (Full_Parent)
and then Present (Underlying_Full_View (Full_Parent))
then
Full_Parent := Underlying_Full_View (Full_Parent);
end if;
if Ekind (Full_Parent) in Record_Kind if Ekind (Full_Parent) in Record_Kind
or else or else
(Ekind (Full_Parent) in Enumeration_Kind (Ekind (Full_Parent) in Enumeration_Kind
...@@ -6628,15 +6636,16 @@ package body Sem_Ch3 is ...@@ -6628,15 +6636,16 @@ package body Sem_Ch3 is
-- view, the completion does not derive them anew. -- view, the completion does not derive them anew.
if Ekind (Full_Parent) in Record_Kind then if Ekind (Full_Parent) in Record_Kind then
-- If parent type is tagged, the completion inherits the proper -- If parent type is tagged, the completion inherits the proper
-- primitive operations. -- primitive operations.
if Is_Tagged_Type (Parent_Type) then if Is_Tagged_Type (Parent_Type) then
Build_Derived_Record_Type ( Build_Derived_Record_Type
Full_N, Full_Parent, Full_Der, Derive_Subps); (Full_N, Full_Parent, Full_Der, Derive_Subps);
else else
Build_Derived_Record_Type ( Build_Derived_Record_Type
Full_N, Full_Parent, Full_Der, Derive_Subps => False); (Full_N, Full_Parent, Full_Der, Derive_Subps => False);
end if; end if;
else else
...@@ -6653,13 +6662,13 @@ package body Sem_Ch3 is ...@@ -6653,13 +6662,13 @@ package body Sem_Ch3 is
else else
Full_Der := Full_Der :=
Make_Defining_Identifier Make_Defining_Identifier (Sloc (Derived_Type),
(Sloc (Derived_Type), Chars (Derived_Type)); Chars => Chars (Derived_Type));
Set_Is_Itype (Full_Der); Set_Is_Itype (Full_Der);
Set_Associated_Node_For_Itype (Full_Der, N); Set_Associated_Node_For_Itype (Full_Der, N);
Set_Parent (Full_Der, N); Set_Parent (Full_Der, N);
Build_Derived_Type ( Build_Derived_Type
N, Full_Parent, Full_Der, True, Derive_Subps => False); (N, Full_Parent, Full_Der, True, Derive_Subps => False);
end if; end if;
Set_Has_Private_Declaration (Full_Der); Set_Has_Private_Declaration (Full_Der);
...@@ -17876,12 +17885,20 @@ package body Sem_Ch3 is ...@@ -17876,12 +17885,20 @@ package body Sem_Ch3 is
Related_Nod : Node_Id) Related_Nod : Node_Id)
is is
Id_B : constant Entity_Id := Base_Type (Id); Id_B : constant Entity_Id := Base_Type (Id);
Full_B : constant Entity_Id := Full_View (Id_B); Full_B : Entity_Id := Full_View (Id_B);
Full : Entity_Id; Full : Entity_Id;
begin begin
if Present (Full_B) then if Present (Full_B) then
-- Get to the underlying full view if necessary
if Is_Private_Type (Full_B)
and then Present (Underlying_Full_View (Full_B))
then
Full_B := Underlying_Full_View (Full_B);
end if;
-- The Base_Type is already completed, we can complete the subtype -- The Base_Type is already completed, we can complete the subtype
-- now. We have to create a new entity with the same name, Thus we -- now. We have to create a new entity with the same name, Thus we
-- can't use Create_Itype. -- can't use Create_Itype.
......
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