From: Steve Baird <[email protected]>
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 --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;
--
2.45.2
