===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -680,14 +680,14 @@
-- Error_Msg_PT --
------------------
- procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id) is
+ procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id) is
begin
- Error_Msg_NE
- ("first formal of & must be of mode `OUT`, `IN OUT` or " &
- "access-to-variable", Typ, Subp);
Error_Msg_N
- ("\in order to be overridden by protected procedure or entry " &
- "(RM 9.4(11.9/2))", Typ);
+ ("illegal overriding of subprogram inherited from interface", E);
+
+ Error_Msg_Sloc := Sloc (Iface_Prim);
+ Error_Msg_N
+ ("\first formal of & declared # has wrong mode (RM 9.4(11.9))", E);
end Error_Msg_PT;
-----------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -848,9 +848,10 @@
-- run-time mode or no run-time mode (as appropriate). In the former case,
-- the name of the library is output if available.
- procedure Error_Msg_PT (Typ : Node_Id; Subp : Node_Id);
- -- Posts an error on the protected type declaration Typ indicating wrong
- -- mode of the first formal of protected type primitive Subp.
+ procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id);
+ -- Posts an error on protected type entry or subprogram E (referencing its
+ -- overridden interface primitive Iface_Prim) indicating wrong mode of the
+ -- first formal (RM 9.4(11.9/3))
procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
-- If not operating in Ada 2012 mode, posts errors complaining that Feature
===================================================================
@@ -10050,46 +10050,34 @@
elsif Is_Concurrent_Record_Type (T)
and then Present (Interfaces (T))
then
- -- If an inherited subprogram is implemented by a protected
- -- procedure or an entry, then the first parameter of the
- -- inherited subprogram shall be of mode OUT or IN OUT, or
- -- an access-to-variable parameter (RM 9.4(11.9/3))
+ -- There is no need to check here RM 9.4(11.9/3) since we
+ -- are processing the corresponding record type and the
+ -- mode of the overriding subprograms was verified by
+ -- Check_Conformance when the corresponding concurrent
+ -- type declaration was analyzed.
- if Is_Protected_Type (Corresponding_Concurrent_Type (T))
- and then Ekind (First_Formal (Subp)) = E_In_Parameter
- and then Ekind (Subp) /= E_Function
- and then not Is_Predefined_Dispatching_Operation (Subp)
- then
- Error_Msg_PT (T, Subp);
+ Error_Msg_NE
+ ("interface subprogram & must be overridden", T, Subp);
- -- Some other kind of overriding failure
+ -- Examine primitive operations of synchronized type to find
+ -- homonyms that have the wrong profile.
- else
- Error_Msg_NE
- ("interface subprogram & must be overridden",
- T, Subp);
+ declare
+ Prim : Entity_Id;
- -- Examine primitive operations of synchronized type,
- -- to find homonyms that have the wrong profile.
+ begin
+ Prim := First_Entity (Corresponding_Concurrent_Type (T));
+ while Present (Prim) loop
+ if Chars (Prim) = Chars (Subp) then
+ Error_Msg_NE
+ ("profile is not type conformant with prefixed "
+ & "view profile of inherited operation&",
+ Prim, Subp);
+ end if;
- declare
- Prim : Entity_Id;
-
- begin
- Prim :=
- First_Entity (Corresponding_Concurrent_Type (T));
- while Present (Prim) loop
- if Chars (Prim) = Chars (Subp) then
- Error_Msg_NE
- ("profile is not type conformant with "
- & "prefixed view profile of "
- & "inherited operation&", Prim, Subp);
- end if;
-
- Next_Entity (Prim);
- end loop;
- end;
- end if;
+ Next_Entity (Prim);
+ end loop;
+ end;
end if;
else
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -5117,7 +5117,7 @@
begin
if Is_Protected_Type (Corresponding_Concurrent_Type (T))
then
- Error_Msg_PT (T, New_Id);
+ Error_Msg_PT (New_Id, Ultimate_Alias (Old_Id));
else
Conformance_Error
("\mode of & does not match!", New_Formal);
@@ -9364,7 +9364,7 @@
or else Is_Synchronized_Interface (Iface_Typ)
or else Is_Task_Interface (Iface_Typ))
then
- Error_Msg_PT (Parent (Typ), Candidate);
+ Error_Msg_PT (Def_Id, Candidate);
end if;
end if;
This patch improves the text of the error reported for RM 9.4(11.9). This new output is visible using this small reproducer: procedure by30018 is package pack is type Iface is synchronized interface; procedure Prim1_1 (M : in Iface) is abstract; protected type T_PO is new Iface with entry Prim1_1; -- ERROR end T_PO; end pack; package body Pack is protected body T_PO is entry Prim1_1 when True is begin null; end; end T_PO; end Pack; begin null; end by30018; Command: gcc -c -gnat05 by30018.adb Output: by30018.adb:8:16: illegal overriding of subprogram inherited from interface by30018.adb:8:16: first formal of "prim1_1" declared at line 5 has wrong mode (RM 9.4(11.9)) Tested on x86_64-pc-linux-gnu, committed on trunk 2015-01-30 Javier Miranda <miranda@adacore.com> * errout.ads (Error_Msg_PT): Replace Node_Id by Entity_Id and improve its documentation. * errout.adb (Error_Msg_PT): Improve the error message. * sem_ch6.adb (Check_Conformance): Update call to Error_Msg_PT. (Check_Synchronized_Overriding): Update call to Error_Msg_PT. * sem_ch3.adb (Check_Abstract_Overriding): Code cleanup.