@@ -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;
@@ -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 "
From: Steve Baird <baird@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aux.adb | 8 ++++---- gcc/ada/sem_ch6.adb | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 4 deletions(-)