re PR fortran/31463 ([patch] inconsistent warnings if function return value is not set)

gcc/fortran:
2008-02-28  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31463
        PR fortran/33950
        PR fortran/34296
        * lang.opt: Added -Wreturn-type.
        * options.c (gfc_handle_option): Recognize -Wreturn-type.
        * trans-decl.c (gfc_trans_deferred_vars): Emit warnings for funtions
        where the result value is not set.
        (gfc_generate_function_code): Likewise.
        (generate_local_decl): Emit warnings for funtions whose RESULT
        variable is not set.

gcc/testsuite:
2008-02-28  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/31463
        PR fortran/33950
        PR fortran/34296
        * gfortran.dg/arrayio_11.f90: Fixed test.
        * gfortran.dg/arrayio_12.f90: Likewise.
        * gfortran.dg/module_read_1.f90: Added warning-directives.
        * gfortran.dg/pr32242.f90: Likewise.
        * gfortran.dg/result_in_spec_3.f90: Likewise.
        * gfortran.dg/use_12.f90: Likewise.
        * gfortran.dg/warn_function_without_result.f90 : New test.

From-SVN: r132756

12 files changed, 144 insertions, 24 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2082054..20e5ae3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2008-02-28  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31463
+	PR fortran/33950
+	PR fortran/34296
+	* lang.opt: Added -Wreturn-type.
+	* options.c (gfc_handle_option): Recognize -Wreturn-type.
+	* trans-decl.c (gfc_trans_deferred_vars): Emit warnings for funtions
+	where the result value is not set.
+	(gfc_generate_function_code): Likewise.
+	(generate_local_decl): Emit warnings for funtions whose RESULT
+	variable is not set.
+
 2008-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/34868
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 967f634..16db192 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -65,6 +65,10 @@ Wnonstd-intrinsics
 Fortran Warning
 Warn about usage of non-standard intrinsics
 
+Wreturn-type
+Fortran Warning
+; Documented in C
+
 Wsurprising
 Fortran Warning
 Warn about \"suspicious\" constructs
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 7d35fb7..ecab0c5 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -492,6 +492,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       gfc_option.warn_line_truncation = value;
       break;
 
+    case OPT_Wreturn_type:
+      warn_return_type = value;
+      break;
+
     case OPT_Wsurprising:
       gfc_option.warn_surprising = value;
       break;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bf07a88..6f430cb 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2607,8 +2607,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 		if (el->sym != el->sym->result)
 		  break;
 	    }
-	  if (el == NULL)
-	    warning (0, "Function does not return a value");
+	  /* TODO: move to the appropriate place in resolve.c.  */
+	  if (warn_return_type && el == NULL)
+	    gfc_warning ("Return value of function '%s' at %L not set",
+			 proc_sym->name, &proc_sym->declared_at);
 	}
       else if (proc_sym->as)
 	{
@@ -2952,7 +2954,7 @@ generate_local_decl (gfc_symbol * sym)
       /* Warn for unused variables, but not if they're inside a common
 	 block or are use-associated.  */
       else if (warn_unused_variable
-	       && !(sym->attr.in_common || sym->attr.use_assoc))
+	       && !(sym->attr.in_common || sym->attr.use_assoc || sym->mark))
 	gfc_warning ("Unused variable '%s' declared at %L", sym->name,
 		     &sym->declared_at);
       /* For variable length CHARACTER parameters, the PARM_DECL already
@@ -2982,6 +2984,25 @@ generate_local_decl (gfc_symbol * sym)
 	gfc_warning ("Unused parameter '%s' declared at %L", sym->name,
 		     &sym->declared_at);
     }
+  else if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      /* TODO: move to the appropriate place in resolve.c.  */
+      if (warn_return_type
+	  && sym->attr.function
+	  && sym->result
+	  && sym != sym->result
+	  && !sym->result->attr.referenced
+	  && !sym->attr.use_assoc
+	  && sym->attr.if_source != IFSRC_IFBODY)
+	{
+	  gfc_warning ("Return value '%s' of function '%s' declared at "
+		       "%L not set", sym->result->name, sym->name,
+		        &sym->result->declared_at);
+
+	  /* Prevents "Unused variable" warning for RESULT variables.  */
+	  sym->mark = sym->result->mark = 1;
+	}
+    }
 
   if (sym->attr.dummy == 1)
     {
@@ -3275,10 +3296,17 @@ gfc_generate_function_code (gfc_namespace * ns)
 	  gfc_add_expr_to_block (&block, tmp2);
 	}
 
-     gfc_add_expr_to_block (&block, tmp);
+      gfc_add_expr_to_block (&block, tmp);
+
+      if (result == NULL_TREE)
+	{
+	  /* TODO: move to the appropriate place in resolve.c.  */
+	  if (warn_return_type && !sym->attr.referenced && sym == sym->result)
+	    gfc_warning ("Return value of function '%s' at %L not set",
+			 sym->name, &sym->declared_at);
 
-     if (result == NULL_TREE)
-	warning (0, "Function return value not set");
+	  TREE_NO_WARNING(sym->backend_decl) = 1;
+	}
       else
 	{
 	  /* Set the return value to the dummy result variable.  The
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 30d1b05..b600cbc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,16 @@
+2008-02-28  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31463
+	PR fortran/33950
+	PR fortran/34296
+	* gfortran.dg/arrayio_11.f90: Fixed test.
+	* gfortran.dg/arrayio_12.f90: Likewise.
+	* gfortran.dg/module_read_1.f90: Added warning-directives.
+	* gfortran.dg/pr32242.f90: Likewise.
+	* gfortran.dg/result_in_spec_3.f90: Likewise.
+	* gfortran.dg/use_12.f90: Likewise.
+	* gfortran.dg/warn_function_without_result.f90 : New test.
+
 2008-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/34868
diff --git a/gcc/testsuite/gfortran.dg/arrayio_11.f90 b/gcc/testsuite/gfortran.dg/arrayio_11.f90
index 39255db..04735d1 100644
--- a/gcc/testsuite/gfortran.dg/arrayio_11.f90
+++ b/gcc/testsuite/gfortran.dg/arrayio_11.f90
@@ -21,7 +21,7 @@ program gfcbug51
   FILE%date = (/'200612231200', '200712231200', &
                 '200812231200'/)
 
-  time = date_to_year (FILE)
+  call date_to_year (FILE)
   if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
 
   call month_to_date ((/8, 9, 10/), FILE)
@@ -30,11 +30,10 @@ program gfcbug51
 
 contains
 
-  function date_to_year (d) result (y)
+  subroutine date_to_year (d)
     type(date_t) :: d(3)
-    type(year_t) :: y(size (d, 1))
-    read (d%date(1:4),'(i4)')  time% year
-  end function date_to_year
+    read (d%date(1:4),'(i4)')  time%year
+  end subroutine
 
   subroutine month_to_date (m, d)
     type(date_t) :: d(3)
diff --git a/gcc/testsuite/gfortran.dg/arrayio_12.f90 b/gcc/testsuite/gfortran.dg/arrayio_12.f90
index ca01047..09fa6c8 100644
--- a/gcc/testsuite/gfortran.dg/arrayio_12.f90
+++ b/gcc/testsuite/gfortran.dg/arrayio_12.f90
@@ -18,7 +18,7 @@ program gfcbug51
   cdate = (/'200612231200', '200712231200', &
             '200812231200'/)
 
-  time = date_to_year (cdate)
+  call date_to_year (cdate)
   if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
 
   call month_to_date ((/8, 9, 10/), cdate)
@@ -27,11 +27,10 @@ program gfcbug51
 
 contains
 
-  function date_to_year (d) result (y)
+  subroutine date_to_year (d)
     character(len=12) :: d(3)
-    type(year_t) :: y(size (d, 1))
-    read (cdate(:)(1:4),'(i4)')  time% year
-  end function date_to_year
+    read (cdate(:)(1:4),'(i4)')  time%year
+  end subroutine
 
   subroutine month_to_date (m, d)
     character(len=12) :: d(3)
diff --git a/gcc/testsuite/gfortran.dg/module_read_1.f90 b/gcc/testsuite/gfortran.dg/module_read_1.f90
index 9a680a6..226c736 100644
--- a/gcc/testsuite/gfortran.dg/module_read_1.f90
+++ b/gcc/testsuite/gfortran.dg/module_read_1.f90
@@ -1,4 +1,5 @@
 ! { dg-do run }
+! { dg-options "-Wreturn-type" }
 ! PR fortran/33941
 ! The problem was that the intrinsic operators
 ! were written to the module file as '/=' etc.
@@ -9,11 +10,11 @@
 
 module foo
 contains
-  function pop(n) result(item)
+  function pop(n) result(item)          ! { dg-warning "not set" }
     integer :: n
     character(len=merge(1, 0, n > 0)) :: item
   end function pop
-  function push(n) result(item)
+  function push(n) result(item)         ! { dg-warning "not set" }
     integer :: n
     character(len=merge(1, 0, n /= 0)) :: item
   end function push
diff --git a/gcc/testsuite/gfortran.dg/pr32242.f90 b/gcc/testsuite/gfortran.dg/pr32242.f90
index 6928f4f..21ecdd1 100644
--- a/gcc/testsuite/gfortran.dg/pr32242.f90
+++ b/gcc/testsuite/gfortran.dg/pr32242.f90
@@ -1,5 +1,6 @@
 !PR fortran/32242
 ! { dg-do compile }
+! { dg-options "-Wreturn-type" }
 ! { dg-final { cleanup-modules "kahan_sum" } }
 
 MODULE kahan_sum
@@ -16,13 +17,13 @@ MODULE kahan_sum
      TYPE ( pw_grid_type ), POINTER :: pw_grid
   END TYPE pw_type
 CONTAINS
- FUNCTION kahan_sum_d1(array,mask) RESULT(ks)
+ FUNCTION kahan_sum_d1(array,mask) RESULT(ks)         ! { dg-warning "not set" }
    REAL(KIND=dp), DIMENSION(:), INTENT(IN)  :: array
    LOGICAL, DIMENSION(:), INTENT(IN), &
      OPTIONAL                               :: mask
    REAL(KIND=dp)                            :: ks
  END FUNCTION kahan_sum_d1
-  FUNCTION kahan_sum_z1(array,mask) RESULT(ks)
+  FUNCTION kahan_sum_z1(array,mask) RESULT(ks)        ! { dg-warning "not set" }
     COMPLEX(KIND=dp), DIMENSION(:), &
       INTENT(IN)                             :: array
     LOGICAL, DIMENSION(:), INTENT(IN), &
@@ -34,6 +35,6 @@ FUNCTION pw_integral_a2b ( pw1, pw2 ) RESULT ( integral_value )
     TYPE(pw_type), INTENT(IN)                :: pw1, pw2
     REAL(KIND=dp)                            :: integral_value
      integral_value = accurate_sum ( REAL ( CONJG ( pw1 % cc ( : ) ) &
-          *  pw2 % cc ( : ) ,KIND=dp) * pw1 % pw_grid % gsq ( : ) )  ! { dg-warning "Function return value not set" }
+          *  pw2 % cc ( : ) ,KIND=dp) * pw1 % pw_grid % gsq ( : ) )
 END FUNCTION pw_integral_a2b
 END MODULE
diff --git a/gcc/testsuite/gfortran.dg/result_in_spec_3.f90 b/gcc/testsuite/gfortran.dg/result_in_spec_3.f90
index ffdf8da..32743c3 100644
--- a/gcc/testsuite/gfortran.dg/result_in_spec_3.f90
+++ b/gcc/testsuite/gfortran.dg/result_in_spec_3.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=gnu -Wreturn-type" }
 ! PR fortran/34248
 !
 ! There was an ICE for assumed-length functions
@@ -10,6 +10,6 @@ character(*) FUNCTION test() RESULT(ctab)
   ctab = "Hello"
 END function test
 
-FUNCTION test2() RESULT(res)
+FUNCTION test2() RESULT(res)      ! { dg-warning "not set" }
   character(*) :: res
 END function test2
diff --git a/gcc/testsuite/gfortran.dg/use_12.f90 b/gcc/testsuite/gfortran.dg/use_12.f90
index 82614b5..7406dc4 100644
--- a/gcc/testsuite/gfortran.dg/use_12.f90
+++ b/gcc/testsuite/gfortran.dg/use_12.f90
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-Wreturn-type" }
 ! Tests the fix of PR34545, in which the 'numclusters' that determines the size
 ! of fnres was not properly associated.
 !
@@ -10,7 +11,7 @@ end module m1
 
 module m2
   contains
-    function get_nfirst( ) result(fnres)
+    function get_nfirst( ) result(fnres)  ! { dg-warning "not set" }
       use m1, only: numclusters
       real :: fnres(numclusters)   ! change to REAL and it works!!  
     end function get_nfirst
diff --git a/gcc/testsuite/gfortran.dg/warn_function_without_result.f90 b/gcc/testsuite/gfortran.dg/warn_function_without_result.f90
new file mode 100644
index 0000000..43af9c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_function_without_result.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-Wreturn-type" }
+!
+! PR fortran/31463 - inconsistent warnings if function return value is not set
+! PR fortran/33950 - Warning missing for function result not set
+! PR fortran/34296 - Intent(out) and character functions with RESULT: Value-not-set warning
+!
+FUNCTION f1()            ! { dg-warning "not set" }
+REAL :: f1
+END FUNCTION
+
+FUNCTION f2()            ! { dg-warning "not set" }
+REAL, DIMENSION(1) :: f2
+END FUNCTION
+
+FUNCTION f3()            ! { dg-warning "not set" }
+REAL, POINTER :: f3
+END FUNCTION
+
+FUNCTION f4()            ! { dg-warning "not set" }
+REAL, DIMENSION(:), POINTER :: f4
+END FUNCTION
+
+FUNCTION f5()            ! { dg-warning "not set" }
+REAL, DIMENSION(:), ALLOCATABLE :: f5
+END FUNCTION
+
+FUNCTION f6()            ! { dg-warning "not set" }
+CHARACTER(2) :: f6
+END FUNCTION
+
+
+
+FUNCTION g1() RESULT(h)  ! { dg-warning "not set" }
+REAL :: h
+END FUNCTION
+
+FUNCTION g2() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(1) :: h
+END FUNCTION
+
+FUNCTION g3() RESULT(h)  ! { dg-warning "not set" }
+REAL, POINTER :: h
+END FUNCTION
+
+FUNCTION g4() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(:), POINTER :: h
+END FUNCTION
+
+FUNCTION g5() RESULT(h)  ! { dg-warning "not set" }
+REAL, DIMENSION(:), ALLOCATABLE :: h
+END FUNCTION
+
+FUNCTION g6() RESULT(h)  ! { dg-warning "not set" }
+CHARACTER(2) :: h
+END FUNCTION
+