From d94be5e02d4a25241e6e3b1cfbf098b5f1b68b39 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 15 Dec 2009 09:37:41 +0100 Subject: [PATCH] re PR fortran/41235 (Missing explicit interface for variable-length character functions) 2009-12-15 Tobias Burnus Daniel Franke PR fortran/41235 * resolve.c (resolve_global_procedure): Add check for presence of an explicit interface for nonconstant, nonassumed character-length functions. (resolve_fl_procedure): Remove check for nonconstant character-length functions. 2009-12-15 Tobias Burnus PR fortran/41235 * auto_char_len_1.f90: New test. * auto_char_len_2.f90: New test. * auto_char_len_4.f90: Correct test. From-SVN: r155247 --- gcc/fortran/ChangeLog | 24 ++++++++++++------ gcc/fortran/resolve.c | 36 +++++++++++++++------------ gcc/testsuite/ChangeLog | 7 ++++++ gcc/testsuite/gfortran.dg/auto_char_len_1.f90 | 27 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/auto_char_len_2.f90 | 25 +++++++++++++++++++ gcc/testsuite/gfortran.dg/auto_char_len_4.f90 | 17 ++++++++++++- 6 files changed, 112 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/auto_char_len_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/auto_char_len_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9319b73..7e0a551 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2009-12-15 Tobias Burnus + Daniel Franke + + PR fortran/41235 + * resolve.c (resolve_global_procedure): Add check for + presence of an explicit interface for nonconstant, + nonassumed character-length functions. + (resolve_fl_procedure): Remove check for nonconstant + character-length functions. + 2009-12-14 Daniel Franke PR fortran/42354 @@ -10,13 +20,13 @@ 2009-12-11 Daniel Franke - PR fortran/40290 - * expr.c (gfc_type_convert_binary): Added warn-on-conversion flag, - passed on to gfc_convert_type_warn() instead of gfc_convert_type(); - enabled warnings on all callers but ... - * arith.c (eval_intrinsic): Disabled warnings on implicit type - conversion. - * gfortran.h gfc_type_convert_binary): Adjusted prototype. + PR fortran/40290 + * expr.c (gfc_type_convert_binary): Added warn-on-conversion flag, + passed on to gfc_convert_type_warn() instead of gfc_convert_type(); + enabled warnings on all callers but ... + * arith.c (eval_intrinsic): Disabled warnings on implicit type + conversion. + * gfortran.h gfc_type_convert_binary): Adjusted prototype. 2009-12-11 Janus Weil diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 00bd441..78b0a78 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1830,6 +1830,21 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, gfc_error ("The reference to function '%s' at %L either needs an " "explicit INTERFACE or the rank is incorrect", sym->name, where); + + /* Non-assumed length character functions. */ + if (sym->attr.function && sym->ts.type == BT_CHARACTER + && gsym->ns->proc_name->ts.u.cl->length != NULL) + { + gfc_charlen *cl = sym->ts.u.cl; + + if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN + && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT) + { + gfc_error ("Nonconstant character-length function '%s' at %L " + "must have an explicit interface", sym->name, + &sym->declared_at); + } + } if (gfc_option.flag_whole_file == 1 || ((gfc_option.warn_std & GFC_STD_LEGACY) @@ -9038,23 +9053,12 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) && resolve_charlen (cl) == FAILURE) return FAILURE; - if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT) + if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT) + && sym->attr.proc == PROC_ST_FUNCTION) { - if (sym->attr.proc == PROC_ST_FUNCTION) - { - gfc_error ("Character-valued statement function '%s' at %L must " - "have constant length", sym->name, &sym->declared_at); - return FAILURE; - } - - if (sym->attr.external && sym->formal == NULL - && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT) - { - gfc_error ("Automatic character length function '%s' at %L must " - "have an explicit interface", sym->name, - &sym->declared_at); - return FAILURE; - } + gfc_error ("Character-valued statement function '%s' at %L must " + "have constant length", sym->name, &sym->declared_at); + return FAILURE; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 654cb1c..eb9cf47 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-12-15 Tobias Burnus + + PR fortran/41235 + * auto_char_len_1.f90: New test. + * auto_char_len_2.f90: New test. + * auto_char_len_4.f90: Correct test. + 2009-12-14 Jason Merrill PR c++/42364 diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_1.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_1.f90 new file mode 100644 index 0000000..628e6e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/auto_char_len_1.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "" } +! [option to disable -pedantic as assumed character length +! functions are obsolescent] +! +! PR fortran/41235 +! + +character(len=*) function func() + func = 'ABC' +end function func + +subroutine test(i) + integer :: i + character(len=i), external :: func + print *, func() +end subroutine test + +subroutine test2(i) + integer :: i + character(len=i) :: func + print *, func() +end subroutine test2 + +call test(2) +call test2(2) +end diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_2.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_2.f90 new file mode 100644 index 0000000..95825c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/auto_char_len_2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fwhole-file" } +! +! PR fortran/41235 +! + +character(len=*) function func() + func = 'ABC' +end function func + +subroutine test(i) + integer :: i + character(len=i), external :: func + print *, func() +end subroutine test + +subroutine test2(i) + integer :: i + character(len=i) :: func + print *, func() +end subroutine test2 + +call test(2) +call test2(2) +end diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 index 3749abd..6b4e26e 100644 --- a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 +++ b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 @@ -1,20 +1,31 @@ ! { dg-do compile } +! { dg-options "-fwhole-file" } +! ! Tests the fix for PR25087, in which the following invalid code ! was not detected. ! ! Contributed by Joost VandeVondele ! +! Modified by Tobias Burnus to fix PR fortran/41235. +! +FUNCTION a() + CHARACTER(len=10) :: a + a = '' +END FUNCTION a + SUBROUTINE s(n) CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "must have an explicit interface" } + CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "must have an explicit interface" } interface function b (m) ! This is OK CHARACTER(LEN=m) :: b integer :: m end function b end interface - write(6,*) a(n) + write(6,*) a() write(6,*) b(n) write(6,*) c() + write(6,*) d() contains function c () ! This is OK CHARACTER(LEN=n):: c @@ -22,3 +33,7 @@ contains end function c END SUBROUTINE s +FUNCTION d() + CHARACTER(len=99) :: d + d = '' +END FUNCTION d -- 2.7.4