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
This commit is contained in:
Robert Dewar 2014-08-01 14:33:17 +00:00 committed by Arnaud Charlet
parent 7f1a5156f9
commit 316e3a13c6
4 changed files with 36 additions and 13 deletions

View File

@ -1,3 +1,7 @@
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>
* einfo.ads (Has_Private_Ancestor): Remove obsolete usage.

View File

@ -1803,8 +1803,8 @@ package Einfo is
-- private type, making some components invisible and aggregates illegal.
-- This flag is set at the point of derivation. The legality of the
-- aggregate must be rechecked because it also depends on the visibility
-- at the point the aggregate is resolved. See sem_aggr.adb.
-- This is part of AI05-0115.
-- at the point the aggregate is resolved. See sem_aggr.adb. This is part
-- of AI05-0115.
-- Has_Private_Declaration (Flag155)
-- Defined in all entities. Set if it is the defining entity of a private

View File

@ -2828,14 +2828,16 @@ package body Exp_Ch4 is
Rhs_Discr_Val));
end;
-- All cases other than comparing Unchecked_Union types
else
declare
T : constant Entity_Id := Etype (First_Formal (Eq_Op));
begin
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Eq_Op, Loc),
Name =>
New_Occurrence_Of (Eq_Op, Loc),
Parameter_Associations => New_List (
OK_Convert_To (T, Lhs),
OK_Convert_To (T, Rhs)));

View File

@ -6606,6 +6606,14 @@ package body Sem_Ch3 is
Full_Parent := Full_View (Full_Parent);
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
or else
(Ekind (Full_Parent) in Enumeration_Kind
@ -6628,15 +6636,16 @@ package body Sem_Ch3 is
-- view, the completion does not derive them anew.
if Ekind (Full_Parent) in Record_Kind then
-- If parent type is tagged, the completion inherits the proper
-- primitive operations.
if Is_Tagged_Type (Parent_Type) then
Build_Derived_Record_Type (
Full_N, Full_Parent, Full_Der, Derive_Subps);
Build_Derived_Record_Type
(Full_N, Full_Parent, Full_Der, Derive_Subps);
else
Build_Derived_Record_Type (
Full_N, Full_Parent, Full_Der, Derive_Subps => False);
Build_Derived_Record_Type
(Full_N, Full_Parent, Full_Der, Derive_Subps => False);
end if;
else
@ -6653,13 +6662,13 @@ package body Sem_Ch3 is
else
Full_Der :=
Make_Defining_Identifier
(Sloc (Derived_Type), Chars (Derived_Type));
Make_Defining_Identifier (Sloc (Derived_Type),
Chars => Chars (Derived_Type));
Set_Is_Itype (Full_Der);
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);
Build_Derived_Type
(N, Full_Parent, Full_Der, True, Derive_Subps => False);
end if;
Set_Has_Private_Declaration (Full_Der);
@ -17876,12 +17885,20 @@ package body Sem_Ch3 is
Related_Nod : Node_Id)
is
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;
begin
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
-- now. We have to create a new entity with the same name, Thus we
-- can't use Create_Itype.