Re: [ping] unreviewed patches for 4.4

[Daniel Franke <franke dot daniel at gmail dot com>]

On Tuesday 19 February 2008 11:06:48 FX wrote:
> > PRs 31463,  33950, 34296 - fix inconsistent warnings if function
> > return value is not set
> >     http://gcc.gnu.org/ml/fortran/2008-01/msg00355.html
>
> I think it would be good to hide them behind a warning option.
> -Wreturn-type is probably the best choice among existing options,
> although clearly not perfect. Maybe we should just bind it to -W or
> -Wall?

Attached patch binds the messages to -Wreturn-type. It is essentially 
identical to the one submitted before besides the code to recognize the 
warning-option in fortran.


gcc/fortran:
2008-02-25 ?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-25 ?Daniel Franke ?<franke.daniel@gmail.com>

????????PR fortran/31463
????????* 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.

After updating, bootstrapped and regression tested on i686-pc-linux-gnu.


> My second concern is your use of TREE_NO_WARNING: if another,
> unrelated warning is to be emitted about that function, my understand
> is that TREE_NO_WARNING will kill it altogether. I'm trying to see if
> there is a really-life situation where that might happen, but I'm
> pretty confident there is. 

Any more ideas here? =)
Otherwise, ok for trunk?

Regards
	Daniel

Index: fortran/trans-decl.c
===================================================================
--- fortran/trans-decl.c	(revision 132630)
+++ fortran/trans-decl.c	(working copy)
@@ -2639,8 +2639,9 @@ gfc_trans_deferred_vars (gfc_symbol * pr
 		if (el->sym != el->sym->result)
 		  break;
 	    }
-	  if (el == NULL)
-	    warning (0, "Function does not return a value");
+	  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)
 	{
@@ -2984,7 +2985,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
@@ -3014,6 +3015,24 @@ 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)
+    {
+      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)
     {
@@ -3307,10 +3326,16 @@ gfc_generate_function_code (gfc_namespac
 	  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)
-	warning (0, "Function return value not set");
+      if (result == NULL_TREE)
+	{
+	  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);
+
+	  TREE_NO_WARNING(sym->backend_decl) = 1;
+	}
       else
 	{
 	  /* Set the return value to the dummy result variable.  The
Index: fortran/lang.opt
===================================================================
--- fortran/lang.opt	(revision 132630)
+++ fortran/lang.opt	(working copy)
@@ -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
Index: fortran/options.c
===================================================================
--- fortran/options.c	(revision 132630)
+++ fortran/options.c	(working copy)
@@ -492,6 +492,10 @@ gfc_handle_option (size_t scode, const c
       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;
Index: testsuite/gfortran.dg/arrayio_11.f90
===================================================================
--- testsuite/gfortran.dg/arrayio_11.f90	(revision 132630)
+++ testsuite/gfortran.dg/arrayio_11.f90	(working copy)
@@ -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)
Index: testsuite/gfortran.dg/arrayio_12.f90
===================================================================
--- testsuite/gfortran.dg/arrayio_12.f90	(revision 132630)
+++ testsuite/gfortran.dg/arrayio_12.f90	(working copy)
@@ -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)
Index: testsuite/gfortran.dg/module_read_1.f90
===================================================================
--- testsuite/gfortran.dg/module_read_1.f90	(revision 132630)
+++ testsuite/gfortran.dg/module_read_1.f90	(working copy)
@@ -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
Index: testsuite/gfortran.dg/pr32242.f90
===================================================================
--- testsuite/gfortran.dg/pr32242.f90	(revision 132630)
+++ testsuite/gfortran.dg/pr32242.f90	(working copy)
@@ -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 ) RE
     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
Index: testsuite/gfortran.dg/result_in_spec_3.f90
===================================================================
--- testsuite/gfortran.dg/result_in_spec_3.f90	(revision 132630)
+++ testsuite/gfortran.dg/result_in_spec_3.f90	(working copy)
@@ -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
Index: testsuite/gfortran.dg/use_12.f90
===================================================================
--- testsuite/gfortran.dg/use_12.f90	(revision 132630)
+++ testsuite/gfortran.dg/use_12.f90	(working copy)
@@ -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
Index: testsuite/gfortran.dg/warn_function_without_result.f90
===================================================================
--- testsuite/gfortran.dg/warn_function_without_result.f90	(revision 0)
+++ testsuite/gfortran.dg/warn_function_without_result.f90	(revision 0)
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-Wreturn-type" }
+! PR fortran/31463 - inconsistent warnings if function return value is not set
+
+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 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