From: Steve Baird <[email protected]>
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(-)
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 9903a2b6a16..5edf6675474 100644
--- 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 86d784543f3..076fb89c7b5 100644
--- 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 "
--
2.45.2
