ada: Missing legality check when type completed

Refine previous fix to better handle tagged cases.

gcc/ada/

	* sem_ch6.adb (Check_Discriminant_Conformance): Immediately after
	calling Is_Immutably_Limited_Type, perform an additional test that
	one might reasonably imagine would instead have been part of
	Is_Immutably_Limited_Type. The new test is a call to a new
	function Has_Tagged_Limited_Partial_View whose implementation
	includes a call to Incomplete_Or_Partial_View, which cannot be
	easily be called from Is_Immutably_Limited_Type (because sem_aux,
	which is in the closure of the binder, cannot easily "with"
	sem_util).
	* sem_aux.adb (Is_Immutably_Limited): Include
	N_Derived_Type_Definition case when testing Limited_Present flag.

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 9903a2b6a16f66107e6c33bc7d1d28d9b0627a3d..5edf6675474290fce86ca54a9b7fd1d23c264adf 100644 (file)
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1118,12 +1118,12 @@ package body Sem_Aux is
 
       elsif Is_Private_Type (Btype) then
 
-      --  If Ent occurs in the completion of a limited private type, then
-      --  look for the word "limited" in the full view.
+         --  If Ent occurs in the completion of a private type, then
+         --  look for the word "limited" in the full view.
 
          if Nkind (Parent (Ent)) = N_Full_Type_Declaration
-           and then Nkind (Type_Definition (Parent (Ent))) =
-                      N_Record_Definition
+           and then Nkind (Type_Definition (Parent (Ent))) in
+                      N_Record_Definition | N_Derived_Type_Definition
            and then Limited_Present (Type_Definition (Parent (Ent)))
          then
             return True;

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 86d784543f38f4611b31c99e2b24fcd2f6c96934..076fb89c7b5082487420ab24fba908f672eb760f 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6432,6 +6432,25 @@ package body Sem_Ch6 is
             OldD : constant Boolean :=
                      Present (Expression (Parent (Old_Discr)));
 
+            function Has_Tagged_Limited_Partial_View
+              (Typ : Entity_Id) return Boolean;
+            --  Returns True iff Typ has a tagged limited partial view.
+
+            -------------------------------------
+            -- Has_Tagged_Limited_Partial_View --
+            -------------------------------------
+
+            function Has_Tagged_Limited_Partial_View
+              (Typ : Entity_Id) return Boolean
+            is
+               Priv : constant Entity_Id := Incomplete_Or_Partial_View (Typ);
+            begin
+               return Present (Priv)
+                 and then not Is_Incomplete_Type (Priv)
+                 and then Is_Tagged_Type (Priv)
+                 and then Limited_Present (Parent (Priv));
+            end Has_Tagged_Limited_Partial_View;
+
          begin
             if NewD or OldD then
 
@@ -6463,6 +6482,13 @@ package body Sem_Ch6 is
                             N_Access_Definition
                  and then not Is_Immutably_Limited_Type
                                 (Defining_Identifier (N))
+
+                 --  Check for a case that would be awkward to handle in
+                 --  Is_Immutably_Limited_Type (because sem_aux can't
+                 --  "with" sem_util).
+
+                 and then not Has_Tagged_Limited_Partial_View
+                                (Defining_Identifier (N))
                then
                   Error_Msg_N
                     ("(Ada 2005) default value for access discriminant "