[gcc r12-1467] [Ada] Error when passing subprogram'Access to null-defaulted formal subprogram

[gcc r12-1467] [Ada] Error when passing subprogram'Access to null-defaulted formal subprogram

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:3d4fbcb4c98bc593e7e9ff7e0202d622d6c64f73

commit r12-1467-g3d4fbcb4c98bc593e7e9ff7e0202d622d6c64f73
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Tue Feb 9 20:18:47 2021 -0500

    [Ada] Error when passing subprogram'Access to null-defaulted formal subprogram
    
    gcc/ada/
    
            * freeze.adb (Freeze_Subprogram): Don't propagate conventions
            Intrinsic or Entry to anonymous access-to-subprogram types
            associated with subprograms having those conventions. Update
            related comment.
            * sem_attr.adb (Resolve_Attribute, Attribute_*Access): Remove
            special-case warning code for cases where a called subprogram
            has convention Intrinsic as well as its formal's type (the
            expected type for the Access attribute), since this case can no
            longer occur.

Diff:
---
 gcc/ada/freeze.adb   |  7 +++++--
 gcc/ada/sem_attr.adb | 32 ++++----------------------------
 2 files changed, 9 insertions(+), 30 deletions(-)

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index f8e73875f19..48b958d3b46 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -9428,15 +9428,18 @@ package body Freeze is
       end if;
 
       --  Ensure that all anonymous access-to-subprogram types inherit the
-      --  convention of their related subprogram (RM 6.3.1 13.1/3). This is
+      --  convention of their related subprogram (RM 6.3.1(13.1/5)). This is
       --  not done for a defaulted convention Ada because those types also
       --  default to Ada. Convention Protected must not be propagated when
       --  the subprogram is an entry because this would be illegal. The only
       --  way to force convention Protected on these kinds of types is to
-      --  include keyword "protected" in the access definition.
+      --  include keyword "protected" in the access definition. Conventions
+      --  Entry and Intrinsic are also not propagated (specified by AI12-0207).
 
       if Convention (E) /= Convention_Ada
         and then Convention (E) /= Convention_Protected
+        and then Convention (E) /= Convention_Entry
+        and then Convention (E) /= Convention_Intrinsic
       then
          Set_Profile_Convention (E);
       end if;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 17aa577addc..83f53cdf1fb 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -10887,34 +10887,10 @@ package body Sem_Attr is
                   if Convention (Designated_Type (Btyp)) /=
                      Convention (Entity (P))
                   then
-                     --  The rule in 6.3.1 (8) deserves a special error
-                     --  message.
-
-                     if Convention (Btyp) = Convention_Intrinsic
-                       and then Nkind (Parent (N)) = N_Procedure_Call_Statement
-                       and then Is_Entity_Name (Name (Parent (N)))
-                       and then Inside_A_Generic
-                     then
-                        declare
-                           Subp : constant Entity_Id :=
-                                    Entity (Name (Parent (N)));
-                        begin
-                           if Convention (Subp) = Convention_Intrinsic then
-                              Error_Msg_FE
-                                ("?subprogram and its formal access "
-                                 & "parameters have convention Intrinsic",
-                                 Parent (N), Subp);
-                              Error_Msg_N
-                                ("actual cannot be access attribute", N);
-                           end if;
-                        end;
-
-                     else
-                        Error_Msg_FE
-                          ("subprogram & has wrong convention", P, Entity (P));
-                        Error_Msg_Sloc := Sloc (Btyp);
-                        Error_Msg_FE ("\does not match & declared#", P, Btyp);
-                     end if;
+                     Error_Msg_FE
+                       ("subprogram & has wrong convention", P, Entity (P));
+                     Error_Msg_Sloc := Sloc (Btyp);
+                     Error_Msg_FE ("\does not match & declared#", P, Btyp);
 
                      if not Is_Itype (Btyp)
                        and then not Has_Convention_Pragma (Btyp)