re PR fortran/41235 (Missing explicit interface for variable-length character functions)

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.

From-SVN: r155247

6 files changed, 112 insertions, 24 deletions

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  <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
--- 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  <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
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  <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