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

gcc/fortran/ChangeLog

+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

gcc/fortran/resolve.c

@@ -1831,6 +1831,21 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 		   "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,24 +9053,13 @@ 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 (sym->attr.proc == PROC_ST_FUNCTION)
+      if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+	  && 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;
-	    }
-	}
     }
 
   /* Ensure that derived type for are not of a private type.  Internal

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/auto_char_len_1.f90

+! { 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

gcc/testsuite/gfortran.dg/auto_char_len_2.f90

+! { 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

gcc/testsuite/gfortran.dg/auto_char_len_4.f90

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