diff options
| author | Ed Schonberg <schonber@gnat.com> | 2001-12-05 01:38:41 +0000 |
|---|---|---|
| committer | Geert Bosch <bosch@gcc.gnu.org> | 2001-12-05 02:38:41 +0100 |
| commit | ee0a48c5e8998fba3a4050c77794ef234793a1d2 (patch) | |
| tree | 3ea0ec5f380be3d84c89de9d4c2fe8019664bd10 | |
| parent | dd5875a602fb7adef53362fab59cac17bf5ff77d (diff) | |
| download | gcc-ee0a48c5e8998fba3a4050c77794ef234793a1d2.zip gcc-ee0a48c5e8998fba3a4050c77794ef234793a1d2.tar.gz gcc-ee0a48c5e8998fba3a4050c77794ef234793a1d2.tar.bz2 | |
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
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | 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 <schonber@gnat.com> + * 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 <schonber@gnat.com> + * 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) |