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 <mira...@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.
Index: errout.adb =================================================================== --- errout.adb (revision 220273) +++ errout.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- 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; ----------------- Index: errout.ads =================================================================== --- errout.ads (revision 220273) +++ errout.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- 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 Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 220279) +++ sem_ch3.adb (working copy) @@ -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 Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 220274) +++ sem_ch6.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- 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;