Patchwork [Ada] Check missing function returns in generic template

login
register
mail settings
Submitter Arnaud Charlet
Date June 23, 2010, 6:12 a.m.
Message ID <20100623061232.GA17232@adacore.com>
Download mbox | patch
Permalink /patch/56586/
State New
Headers show

Comments

Arnaud Charlet - June 23, 2010, 6:12 a.m.
This patch fixes the problem of not catching a missing return in
a generic function (the error was caught at instantiation time, but
it is an illegality in the template).

with apa; use apa;
procedure mainmr is
   function fool2 is new fool;
begin
   null;
end;

package apa is
   generic
   function fool return integer;
end apa;

package body apa is
   function fool return integer is
   begin
      null;
   end fool;
end apa;

If we compile mainmr.adb, we now get the message on the template:

Compiling: mainmr.adb

     1. with apa; use apa;
     2. procedure mainmr is
     3.    function fool2 is new fool;
     4. begin
     5.    null;
     6. end;

==============Error messages for source file: apa.adb
     2.    function fool return integer is
           |
        >>> missing "return" statement in function body

 6 lines: 1 error

Prior to this patch, the error was issued on the instantiation,
and not issued at all if the generic was never instantiated.

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

2010-06-23  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Properly handle
	checking returns in generic case.
	(Check_Missing_Return): New procedure.

Patch

Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 161243)
+++ sem_ch6.adb	(working copy)
@@ -515,10 +515,10 @@  package body Sem_Ch6 is
       -------------------------------------
 
       procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is
-         Return_Obj  : constant Node_Id   := Defining_Identifier (Obj_Decl);
-         R_Stm_Type  : constant Entity_Id := Etype (Return_Obj);
-         --  Subtype given in the extended return statement;
-         --  this must match R_Type.
+         Return_Obj : constant Node_Id   := Defining_Identifier (Obj_Decl);
+
+         R_Stm_Type : constant Entity_Id := Etype (Return_Obj);
+         --  Subtype given in the extended return statement (must match R_Type)
 
          Subtype_Ind : constant Node_Id :=
                          Object_Definition (Original_Node (Obj_Decl));
@@ -543,7 +543,7 @@  package body Sem_Ch6 is
          --  True if type of the return object is an anonymous access type
 
       begin
-         --  First, avoid cascade errors:
+         --  First, avoid cascaded errors
 
          if Error_Posted (Obj_Decl) or else Error_Posted (Subtype_Ind) then
             return;
@@ -1430,7 +1430,6 @@  package body Sem_Ch6 is
       Prev_Id      : constant Entity_Id  := Current_Entity_In_Scope (Body_Id);
       Conformant   : Boolean;
       HSS          : Node_Id;
-      Missing_Ret  : Boolean;
       P_Ent        : Entity_Id;
       Prot_Typ     : Entity_Id := Empty;
       Spec_Id      : Entity_Id;
@@ -1472,6 +1471,10 @@  package body Sem_Ch6 is
       --  If pragma does not appear after the body, check whether there is
       --  an inline pragma before any local declarations.
 
+      procedure Check_Missing_Return;
+      --  Checks for a function with a no return statements, and also performs
+      --  the warning checks implemented by Check_Returns.
+
       function Disambiguate_Spec return Entity_Id;
       --  When a primitive is declared between the private view and the full
       --  view of a concurrent type which implements an interface, a special
@@ -1664,6 +1667,46 @@  package body Sem_Ch6 is
          end if;
       end Check_Inline_Pragma;
 
+      --------------------------
+      -- Check_Missing_Return --
+      --------------------------
+
+      procedure Check_Missing_Return is
+         Id          : Entity_Id;
+         Missing_Ret : Boolean;
+
+      begin
+         if Nkind (Body_Spec) = N_Function_Specification then
+            if Present (Spec_Id) then
+               Id := Spec_Id;
+            else
+               Id := Body_Id;
+            end if;
+
+            if Return_Present (Id) then
+               Check_Returns (HSS, 'F', Missing_Ret);
+
+               if Missing_Ret then
+                  Set_Has_Missing_Return (Id);
+               end if;
+
+            elsif (Is_Generic_Subprogram (Id)
+                     or else not Is_Machine_Code_Subprogram (Id))
+              and then not Body_Deleted
+            then
+               Error_Msg_N ("missing RETURN statement in function body", N);
+            end if;
+
+         --  If procedure with No_Return, check returns
+
+         elsif Nkind (Body_Spec) = N_Procedure_Specification
+           and then Present (Spec_Id)
+           and then No_Return (Spec_Id)
+         then
+               Check_Returns (HSS, 'P', Missing_Ret, Spec_Id);
+         end if;
+      end Check_Missing_Return;
+
       -----------------------
       -- Disambiguate_Spec --
       -----------------------
@@ -1888,6 +1931,12 @@  package body Sem_Ch6 is
             Set_Is_Child_Unit       (Body_Id, Is_Child_Unit       (Spec_Id));
 
             Analyze_Generic_Subprogram_Body (N, Spec_Id);
+
+            if Nkind (N) = N_Subprogram_Body then
+               HSS := Handled_Statement_Sequence (N);
+               Check_Missing_Return;
+            end if;
+
             return;
 
          else
@@ -2426,41 +2475,7 @@  package body Sem_Ch6 is
          end if;
       end if;
 
-      --  If function, check return statements
-
-      if Nkind (Body_Spec) = N_Function_Specification then
-         declare
-            Id : Entity_Id;
-
-         begin
-            if Present (Spec_Id) then
-               Id := Spec_Id;
-            else
-               Id := Body_Id;
-            end if;
-
-            if Return_Present (Id) then
-               Check_Returns (HSS, 'F', Missing_Ret);
-
-               if Missing_Ret then
-                  Set_Has_Missing_Return (Id);
-               end if;
-
-            elsif not Is_Machine_Code_Subprogram (Id)
-              and then not Body_Deleted
-            then
-               Error_Msg_N ("missing RETURN statement in function body", N);
-            end if;
-         end;
-
-      --  If procedure with No_Return, check returns
-
-      elsif Nkind (Body_Spec) = N_Procedure_Specification
-        and then Present (Spec_Id)
-        and then No_Return (Spec_Id)
-      then
-         Check_Returns (HSS, 'P', Missing_Ret, Spec_Id);
-      end if;
+      Check_Missing_Return;
 
       --  Now we are going to check for variables that are never modified in
       --  the body of the procedure. But first we deal with a special case