diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2008-05-29 10:55:46 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2008-05-29 10:55:46 +0200 |
| commit | fe63b1b12c7ac3e7e43afa5201c8cc7b4763d48c (patch) | |
| tree | e4a4e06f97b2ff721660cb56b157fd14efe588e6 | |
| parent | 8682d22c802ff44bdb2c152da7aff7e2be6a67fe (diff) | |
| download | gcc-fe63b1b12c7ac3e7e43afa5201c8cc7b4763d48c.zip gcc-fe63b1b12c7ac3e7e43afa5201c8cc7b4763d48c.tar.gz gcc-fe63b1b12c7ac3e7e43afa5201c8cc7b4763d48c.tar.bz2 | |
sem_ch6.adb (Analyze_Subprogram_Specification): if the return type is abstract...
2008-05-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Specification): if the return type
is abstract, do not apply abstractness check on subprogram if this is
a renaming declaration.
From-SVN: r136148
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 14 |
1 files changed, 6 insertions, 8 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index f376e95..640a20d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2496,21 +2496,19 @@ package body Sem_Ch6 is May_Need_Actuals (Designator); - -- Ada 2005 (AI-251): In case of primitives associated with abstract - -- interface types the following error message will be reported later - -- (see Analyze_Subprogram_Declaration). + -- Ada 2005 (AI-251): If the return type is abstract, verify that + -- the subprogram is abstract also. This does not apply to renaming + -- declarations, where abstractness is inherited. + -- In case of primitives associated with abstract interface types + -- the check is applied later (see Analyze_Subprogram_Declaration). if Is_Abstract_Type (Etype (Designator)) and then not Is_Interface (Etype (Designator)) + and then Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration and then Nkind (Parent (N)) /= N_Abstract_Subprogram_Declaration and then (Nkind (Parent (N))) /= N_Formal_Abstract_Subprogram_Declaration - and then - (Nkind (Parent (N)) /= N_Subprogram_Renaming_Declaration - or else not Is_Entity_Name (Name (Parent (N))) - or else not Is_Abstract_Subprogram - (Entity (Name (Parent (N))))) then Error_Msg_N ("function that returns abstract type must be abstract", N); |