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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5371789dc93130c0fd8ba8539ab5863c944bc1af..525532509e083288ab3d5b8ef3513be7fe0d54a6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index fc8275a9567c964b42f7dcb1ac0516a996c98e21..9c5a2ca03d06afd0abe4ff70f3dbd5455b324370 100644 (file)
--- 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 3692617f0d467621b3afc956e5c6f064cb37203c..0e6ea4f8fb225c90dc15a014647b0abe7b4f4a86 100644 (file)
--- 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 3196b33e2e850b67612c06fd066f0cde86dbc4c4..e3362542e3954c618dcf96c25b58573b71ed0a88 100644 (file)
--- 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.