OSDN Git Service

gcc/fortran:
authordfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 28 Feb 2008 20:22:55 +0000 (20:22 +0000)
committerdfranke <dfranke@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 28 Feb 2008 20:22:55 +0000 (20:22 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@132756 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed:
gcc/fortran/ChangeLog
gcc/fortran/lang.opt
gcc/fortran/options.c
gcc/fortran/trans-decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/arrayio_11.f90
gcc/testsuite/gfortran.dg/arrayio_12.f90
gcc/testsuite/gfortran.dg/module_read_1.f90
gcc/testsuite/gfortran.dg/pr32242.f90
gcc/testsuite/gfortran.dg/result_in_spec_3.f90
gcc/testsuite/gfortran.dg/use_12.f90
gcc/testsuite/gfortran.dg/warn_function_without_result.f90 [new file with mode: 0644]

index 2082054..20e5ae3 100644 (file)
@@ -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
index 967f634..16db192 100644 (file)
@@ -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 7d35fb7..ecab0c5 100644 (file)
@@ -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;
index bf07a88..6f430cb 100644 (file)
@@ -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
index 30d1b05..b600cbc 100644 (file)
@@ -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
index 39255db..04735d1 100644 (file)
@@ -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 ca01047..09fa6c8 100644 (file)
@@ -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 9a680a6..226c736 100644 (file)
@@ -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.
 
 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 6928f4f..21ecdd1 100644 (file)
@@ -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
index ffdf8da..32743c3 100644 (file)
@@ -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 82614b5..7406dc4 100644 (file)
@@ -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 (file)
index 0000000..43af9c9
--- /dev/null
@@ -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
+