diff mbox

[Ada] Better error message for illegal use of 'Access in a call.

Message ID 20170425083725.GA103530@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 25, 2017, 8:37 a.m. UTC
This patch improves the error message in the case of an attribute reference
that is an actual in a call to a subprogram inherited from a generic formal
type with unknown discriminants, which makes the subprogram and its formal
parameters intrinsic (see RM 6.3.1 (8) and (13)).

Compiling l.adb must yield:

 l.adb:6:08: subprogram and its formal paramenters have convention Intrinsic
 l.adb:6:22: actual cannot be access attribute

with G;
generic
   type D (<>) is new G.T with private;
package L is
   type DT is new D with null record;
   procedure Foo (A_T : DT; P : access procedure);
end;
---
package body L is
   procedure Foo (A_T : DT; P : access procedure) is
      procedure Q is begin null; end;
   begin
       D (A_T).Foo (Q'Access);
   end Foo;
end;
---
package G is
   type T is tagged null record;
   procedure Foo (A_T : T; P : access procedure);
end;

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

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Access): Specialize
	the error message when the attribute reference is an actual in
	a call to a subprogram inherited from a generic formal type with
	unknown discriminants, which makes the subprogram and its formal
	parameters intrinsic (see RM 6.3.1 (8) and (13)).
diff mbox

Patch

Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 247147)
+++ sem_attr.adb	(working copy)
@@ -10532,11 +10532,34 @@ 
                   if Convention (Designated_Type (Btyp)) /=
                      Convention (Entity (P))
                   then
-                     Error_Msg_FE
-                       ("subprogram & has wrong convention", P, Entity (P));
-                     Error_Msg_Sloc := Sloc (Btyp);
-                     Error_Msg_FE ("\does not match & declared#", P, Btyp);
+                     --  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 "
+                              & "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;
+
                      if not Is_Itype (Btyp)
                        and then not Has_Convention_Pragma (Btyp)
                      then