diff options
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 370bc1df999..171373ca3b9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6507,7 +6507,12 @@ package body Sem_Attr is -- also be accessibility checks on those, this is where the -- checks can eventually be centralized ??? - if Ekind (Btyp) = E_Access_Subprogram_Type then + if Ekind (Btyp) = E_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Protected_Subprogram_Type + then if Convention (Btyp) /= Convention (Entity (P)) then Error_Msg_N ("subprogram has invalid convention for context", P); @@ -6533,8 +6538,12 @@ package body Sem_Attr is -- warning is needed. elsif Attr_Id = Attribute_Access - and then Subprogram_Access_Level (Entity (P)) - > Type_Access_Level (Btyp) + and then Subprogram_Access_Level (Entity (P)) > + Type_Access_Level (Btyp) + and then Ekind (Btyp) /= + E_Anonymous_Access_Subprogram_Type + and then Ekind (Btyp) /= + E_Anonymous_Access_Protected_Subprogram_Type then if not In_Instance_Body then Error_Msg_N @@ -6617,9 +6626,12 @@ package body Sem_Attr is -- The rule does not apply to 'Unrestricted_Access. if not (Ekind (Btyp) = E_Access_Subprogram_Type + or else Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type or else (Is_Record_Type (Btyp) and then Present (Corresponding_Remote_Type (Btyp))) or else Ekind (Btyp) = E_Access_Protected_Subprogram_Type + or else Ekind (Btyp) + = E_Anonymous_Access_Protected_Subprogram_Type or else Is_Access_Constant (Btyp) or else Is_Variable (P) or else Attr_Id = Attribute_Unrestricted_Access) @@ -6791,13 +6803,17 @@ package body Sem_Attr is end if; end if; - if Ekind (Btyp) = E_Access_Protected_Subprogram_Type + if (Ekind (Btyp) = E_Access_Protected_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Protected_Subprogram_Type) and then Is_Entity_Name (P) and then not Is_Protected_Type (Scope (Entity (P))) then Error_Msg_N ("context requires a protected subprogram", P); - elsif Ekind (Btyp) = E_Access_Subprogram_Type + elsif (Ekind (Btyp) = E_Access_Subprogram_Type + or else + Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type) and then Ekind (Etype (N)) = E_Access_Protected_Subprogram_Type then Error_Msg_N ("context requires a non-protected subprogram", P); |