diff options
| -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 608b8c03f3b..bae5e1ba533 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 4de5c3d6a68..51e4f4319c2 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); |