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:
parent
7f1a5156f9
commit
316e3a13c6
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)));
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue