The compiler does not report an error when a task type does not define an
entry or a procedure to cover a primitive inherited from an interface type.

After this patch the following test compiles with an error:

package Progenitor is
  type Progenitor_T is synchronized interface;

  procedure Primitive_Operation (P : Progenitor_T) is abstract;
end;

with Progenitor; use Progenitor;
package Pkg is
  task type T is new Progenitor_T with end T;

  procedure Fee;
end;

Command:i
gcc -c pkg.ads
pkg.ads:4:03: interface subprogram "Primitive_Operation" must be overridden

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

2014-01-24  Javier Miranda  <mira...@adacore.com>

        * sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration
        required to report the error in case of task types.

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 207026)
+++ sem_ch3.adb (working copy)
@@ -9684,18 +9684,17 @@
                elsif Is_Concurrent_Record_Type (T)
                  and then Present (Interfaces (T))
                then
-                  --  The controlling formal of Subp must be of mode "out",
-                  --  "in out" or an access-to-variable to be overridden.
+                  --  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))
 
-                  if Ekind (First_Formal (Subp)) = E_In_Parameter
+                  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
-                     if not Is_Predefined_Dispatching_Operation (Subp)
-                       and then Is_Protected_Type
-                                  (Corresponding_Concurrent_Type (T))
-                     then
-                        Error_Msg_PT (T, Subp);
-                     end if;
+                     Error_Msg_PT (T, Subp);
 
                   --  Some other kind of overriding failure
 

Reply via email to