Re: [Patch, fortran] PR25087 - Error for missing explicit interface needed.

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

Sorry about that - please find the patch attached.

Paul
> :ADDPATCH fortran:
>
> This represents my first contribution in a private campaign to 
> eliminate the interface meta-bug PR29670.
>
> The patch is completely straightforward and adds a missing error in 
> the resolution of procedures.  As well as testsing the original PR, 
> the testcase ensures that legal calls to automatic character length 
> functions still work.
>
> The only remark that I would make concerns the adequacy of using the 
> presence of an automatic arglist for detecting a formal interface.  
> One recent fix had to be done because procedures without dummies have 
> formal == NULL.  However, since this involves an external automatic 
> character length, there must be at least one dummy :-)
>
> Regtested on Cygwin_NT/amd64 - OK for trunk, 4.2 and 4.1?
>
> Paul
>
> 2006-11-15  Paul Thomas <pault@gcc.gnu.org>
>
>    PR fortran/25087
>    * resolve.c (resolve_fl_procedure): Add an error if an external 
> automatic
>    character length function does not have an explicit interface.
>
> 2006-11-15  Paul Thomas  <pault@gcc.gnu.org>
>
>    PR fortran/25087
>    * gfortran.dg/auto_char_len_4.f90: New test.

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 118704)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_formal_arglist (gfc_symbol * pro
*** 89,96 ****
    gfc_symbol *sym;
    int i;
  
-   /* TODO: Procedures whose return character length parameter is not constant
-      or assumed must also have explicit interfaces.  */
    if (proc->result != NULL)
      sym = proc->result;
    else
--- 89,94 ----
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 5519,5535 ****
  	&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
      return FAILURE;
  
!   if (sym->attr.proc == PROC_ST_FUNCTION)
      {
!       if (sym->ts.type == BT_CHARACTER)
!         {
!           gfc_charlen *cl = sym->ts.cl;
!           if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
!             {
                gfc_error ("Character-valued statement function '%s' at %L must "
                           "have constant length", sym->name, &sym->declared_at);
                return FAILURE;
              }
          }
      }
  
--- 5517,5541 ----
  	&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
      return FAILURE;
  
!   if (sym->ts.type == BT_CHARACTER)
      {
!       gfc_charlen *cl = sym->ts.cl;
!       if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
! 	{
! 	  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;
+             }
          }
      }
  
Index: gcc/testsuite/gfortran.dg/auto_char_len_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/auto_char_len_4.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/auto_char_len_4.f90	(revision 0)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR25087, in which the following invalid code
+ ! was not detected.
+ !
+ ! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+ !
+ SUBROUTINE s(n)
+   CHARACTER(LEN=n), EXTERNAL :: a ! { 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,*) b(n)
+   write(6,*) c()
+ contains
+     function c ()                ! This is OK
+       CHARACTER(LEN=n):: c
+       c = ""
+     end function c
+ END SUBROUTINE s
+