diff mbox series

[COMMITTED,6/6] ada: Missing legality check when type completed

Message ID 20240808142948.807190-6-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,1/6] ada: Finalization_Size raises Constraint_Error | expand

Commit Message

Marc Poulhiès Aug. 8, 2024, 2:29 p.m. UTC
From: Steve Baird <baird@adacore.com>

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).

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_aux.adb | 11 +++++++++++
 gcc/ada/sem_ch6.adb | 14 ++++++++++++++
 2 files changed, 25 insertions(+)
diff mbox series

Patch

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 0639a2e4d86..9903a2b6a16 100644
--- 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 d3912ffc9d5..5735efb327c 100644
--- 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;