ada: Missing legality check when type completed

An access discriminant is allowed to have a default value only if the
discriminated type is immutably limited. In the case of a discriminated
limited private type declaration, this rule needs to be checked when
the completion of the type is seen.

gcc/ada/

	* sem_ch6.adb (Check_Discriminant_Conformance): Perform check for
	illegal access discriminant default values when the completion of
	a limited private type is analyzed.
	* sem_aux.adb (Is_Immutably_Limited): If passed the
	not-yet-analyzed entity for the full view of a record type, test
	the Limited_Present flag
	(which is set by the parser).

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 0639a2e4d86b3b66056a18700f527c3525d50f36..9903a2b6a16f66107e6c33bc7d1d28d9b0627a3d 100644 (file)
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1118,6 +1118,17 @@ 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 Nkind (Parent (Ent)) = N_Full_Type_Declaration
+           and then Nkind (Type_Definition (Parent (Ent))) =
+                      N_Record_Definition
+           and then Limited_Present (Type_Definition (Parent (Ent)))
+         then
+            return True;
+         end if;
+
          --  AI05-0063: A type derived from a limited private formal type is
          --  not immutably limited in a generic body.
 

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d3912ffc9d5dc38e029b9c0f6706885a3fb88b2d..5735efb327cf7a5b69f7aa43595f8ec0ccbc4d93 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6456,6 +6456,20 @@ package body Sem_Ch6 is
                      New_Discr_Id);
                   return;
                end if;
+
+               if NewD
+                 and then Ada_Version >= Ada_2005
+                 and then Nkind (Discriminant_Type (New_Discr)) =
+                            N_Access_Definition
+                 and then not Is_Immutably_Limited_Type
+                                (Defining_Identifier (N))
+               then
+                  Error_Msg_N
+                    ("(Ada 2005) default value for access discriminant "
+                     & "requires immutably limited type",
+                     Expression (New_Discr));
+                  return;
+               end if;
             end if;
          end;