diff options
author | Ed Schonberg <schonberg@adacore.com> | 2011-08-29 10:06:16 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-29 12:06:16 +0200 |
commit | 97216ca891349cb06e86c929d6ec4f76d79e5a62 (patch) | |
tree | 65d3c9d1cc631c7d03783defc139d982469f2130 /gcc/ada | |
parent | d3cb4cc0df047020719e5eaa3f5be0c17f256f2c (diff) | |
download | gcc-97216ca891349cb06e86c929d6ec4f76d79e5a62.zip gcc-97216ca891349cb06e86c929d6ec4f76d79e5a62.tar.gz gcc-97216ca891349cb06e86c929d6ec4f76d79e5a62.tar.bz2 |
sem_res.adb (Resolve_Actuals): Use base type to determine whether an access subtype is access_to_subprogram...
2011-08-29 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Actuals): Use base type to determine whether an
access subtype is access_to_subprogram, when applying checks for
RM 3.10.2 (27).
From-SVN: r178185
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 13 |
2 files changed, 13 insertions, 6 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 608b8c0..bae5e1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2011-08-29 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Resolve_Actuals): Use base type to determine whether an + access subtype is access_to_subprogram, when applying checks for + RM 3.10.2 (27). + 2011-08-29 Matthew Heaney <heaney@adacore.com> * a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Splice_Subtree): Only check diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4de5c3d..51e4f43 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3987,14 +3987,17 @@ package body Sem_Res is ("& is not a dispatching operation of &!", A, Nam); end if; + -- Apply the checks described in 3.10.2(27): if the context is a + -- specific access-to-object, the actual cannot be class-wide. + -- Use base type to exclude access_to_subprogram cases. + elsif Is_Access_Type (A_Typ) and then Is_Access_Type (F_Typ) - and then Ekind (F_Typ) /= E_Access_Subprogram_Type - and then Ekind (F_Typ) /= E_Anonymous_Access_Subprogram_Type + and then not Is_Access_Subprogram_Type (Base_Type (F_Typ)) and then (Is_Class_Wide_Type (Designated_Type (A_Typ)) or else (Nkind (A) = N_Attribute_Reference and then - Is_Class_Wide_Type (Etype (Prefix (A))))) + Is_Class_Wide_Type (Etype (Prefix (A))))) and then not Is_Class_Wide_Type (Designated_Type (F_Typ)) and then not Is_Controlling_Formal (F) @@ -4008,9 +4011,7 @@ package body Sem_Res is Error_Msg_N ("access to class-wide argument not allowed here!", A); - if Is_Subprogram (Nam) - and then Comes_From_Source (Nam) - then + if Is_Subprogram (Nam) and then Comes_From_Source (Nam) then Error_Msg_Node_2 := Designated_Type (F_Typ); Error_Msg_NE ("& is not a dispatching operation of &!", A, Nam); |