diff mbox series

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

Message ID 20210615102052.GA3709@adacore.com
State New
Headers show
Series [Ada] Error when passing subprogram'Access to null-defaulted formal subprogram | expand

Commit Message

Pierre-Marie de Rodat June 15, 2021, 10:20 a.m. UTC 
The compiler issues an error on passing 'Access of a subprogram declared
within a generic unit body to an anonymous access-to-subprogram formal
of a formal subprogram of the generic that has an "is null" default,
when the generic is instantiated and the actual for that formal
subprogram is defaulted. This is because such a null formal subprogram
default is defined to have convention Intrinsic (a consequence of RM
6.3.1(4 and 8)), and the anonymous access-to-subprogram type formal
inherits that convention via Set_Profile_Convention. However, the rule
in RM 6.3.1(13.1/5), which was revised by AI12-0207, now specifies that
such formal types do not inherit the convention of their associated
subprogram, but instead have a convention of Ada, so passing 'Access on
calls to the formal subprogram is legal in an instantiation where the
formal subprogram's actual defaults to null. This is fixed by
suppressing the convention inheritance when a subprogram has convention
Intrinsic (as well as when the subprogram has entry convention, as also
specified in RM 6.3.1(13.1/5)).

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- 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
--- 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)