From 766d0c8c4401b260163f0895c69dbc88eb421a87 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Thu, 28 Feb 2008 15:22:55 -0500 Subject: [PATCH] re PR fortran/31463 ([patch] inconsistent warnings if function return value is not set) gcc/fortran: 2008-02-28 Daniel Franke 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 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 --- gcc/fortran/ChangeLog | 13 +++++ gcc/fortran/lang.opt | 4 ++ gcc/fortran/options.c | 4 ++ gcc/fortran/trans-decl.c | 40 +++++++++++-- gcc/testsuite/ChangeLog | 13 +++++ gcc/testsuite/gfortran.dg/arrayio_11.f90 | 9 ++- gcc/testsuite/gfortran.dg/arrayio_12.f90 | 9 ++- gcc/testsuite/gfortran.dg/module_read_1.f90 | 5 +- gcc/testsuite/gfortran.dg/pr32242.f90 | 7 ++- .../gfortran.dg/result_in_spec_3.f90 | 4 +- gcc/testsuite/gfortran.dg/use_12.f90 | 3 +- .../warn_function_without_result.f90 | 57 +++++++++++++++++++ 12 files changed, 144 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/warn_function_without_result.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2082054df0a..20e5ae3225c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2008-02-28 Daniel Franke + + 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 PR fortran/34868 diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 967f634de94..16db1928522 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 7d35fb704ce..ecab0c5850b 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 bf07a88f238..6f430cbc7a6 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) - warning (0, "Function return value not set"); + 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); + + 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 30d1b0527ad..b600cbc1dc9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2008-02-28 Daniel Franke + + 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 PR fortran/34868 diff --git a/gcc/testsuite/gfortran.dg/arrayio_11.f90 b/gcc/testsuite/gfortran.dg/arrayio_11.f90 index 39255dbcdae..04735d11bec 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 ca010479bd2..09fa6c8a15e 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 9a680a62f3e..226c7366cd2 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 6928f4f52d4..21ecdd1786c 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 ffdf8da4251..32743c32ced 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 82614b5142e..7406dc43388 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 00000000000..43af9c9ca10 --- /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 +