From ee0a48c5e8998fba3a4050c77794ef234793a1d2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 5 Dec 2001 01:38:41 +0000 Subject: [PATCH] sem_attr.adb (Resolve_Attribute): Handle properly an non-classwide access discriminant within a type extension... * sem_attr.adb (Resolve_Attribute): Handle properly an non-classwide access discriminant within a type extension that constrains its parent discriminants. From-SVN: r47643 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_attr.adb | 35 +++++++++++++++++++++++------------ 2 files changed, 29 insertions(+), 12 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 72e747d..ea362f1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2001-12-04 Ed Schonberg + * sem_attr.adb (Resolve_Attribute): Handle properly an non-classwide + access discriminant within a type extension that constrains its + parent discriminants. + +2001-12-04 Ed Schonberg + * sem_ch3.adb (Find_Type_Of_Subtype_Indic): If subtype indication is malformed, use instance of Any_Id to allow analysis to proceed. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2870645..98b5fdf 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.1 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- -- @@ -6278,18 +6278,29 @@ package body Sem_Attr is if not Covers (Designated_Type (Typ), Nom_Subt) and then not Covers (Nom_Subt, Designated_Type (Typ)) then - if Is_Anonymous_Tagged_Base - (Nom_Subt, Etype (Designated_Type (Typ))) - then - null; - else - Error_Msg_NE - ("type of prefix: & not compatible", P, Nom_Subt); - Error_Msg_NE - ("\with &, the expected designated type", - P, Designated_Type (Typ)); - end if; + declare + Desig : Entity_Id; + + begin + Desig := Designated_Type (Typ); + + if Is_Class_Wide_Type (Desig) then + Desig := Etype (Desig); + end if; + + if Is_Anonymous_Tagged_Base (Nom_Subt, Desig) then + null; + + else + Error_Msg_NE + ("type of prefix: & not compatible", + P, Nom_Subt); + Error_Msg_NE + ("\with &, the expected designated type", + P, Designated_Type (Typ)); + end if; + end; end if; elsif not Covers (Designated_Type (Typ), Nom_Subt) -- 2.7.4