2009-12-15 Tobias Burnus <burnus@net-b.de>

            Daniel Franke  <franke.daniel@gmail.com>

        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  <burnus@net-b.de>

        PR fortran/41235
        * auto_char_len_1.f90: New test.
        * auto_char_len_2.f90: New test.
        * auto_char_len_4.f90: Correct test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9319b73..7e0a551 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2009-12-15  Tobias Burnus  <burnus@net-b.de>
+           Daniel Franke  <franke.daniel@gmail.com>
+
+       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  <franke.daniel@gmail.com>
 
        PR fortran/42354
@@ -10,13 +20,13 @@
 
 2009-12-11  Daniel Franke  <franke.daniel@gmail.com>
 
-        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  <janus@gcc.gnu.org>
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 00bd441..78b0a78 100644 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-12-15  Tobias Burnus  <burnus@net-b.de>
+
+       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  <jason@redhat.com>
 
        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 (file)
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 (file)
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 (file)
--- 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  <jv244@cam.ac.uk>
 !
+! 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