From 316e3a13c6743c8c3181f0bf6df2d7af23edd10a Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 1 Aug 2014 14:33:17 +0000 Subject: [PATCH] sem_ch3.adb, [...]: Code clean ups. 2014-08-01 Robert Dewar * sem_ch3.adb, einfo.ads, exp_ch4.adb: Code clean ups. From-SVN: r213477 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/einfo.ads | 4 ++-- gcc/ada/exp_ch4.adb | 6 ++++-- gcc/ada/sem_ch3.adb | 35 ++++++++++++++++++++++++++--------- 4 files changed, 36 insertions(+), 13 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5371789dc93..525532509e0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2014-08-01 Robert Dewar + + * sem_ch3.adb, einfo.ads, exp_ch4.adb: Code clean ups. + 2014-08-01 Eric Botcazou * einfo.ads (Has_Private_Ancestor): Remove obsolete usage. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index fc8275a9567..9c5a2ca03d0 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 3692617f0d4..0e6ea4f8fb2 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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))); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3196b33e2e8..e3362542e39 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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. -- 2.30.2