[Patch, fortran] PR25090 - Bad automatic character length

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

At present, gfortran does not produce an error for the following:

SUBROUTINE S1(I)
CHARACTER(LEN=I+J) :: a
ENTRY E1(J)
END SUBROUTINE S1
END

Both entries should provide dummy arguments to pass values for the 
variables in the specification expression.  In fact, this should apply 
to array specification expressions too; this has been implemented and is 
tested by the testcase.

ifort produces the message:

"This entry point does not define all dummy variables used in bounds or 
length expressions of automatic data objects"

for both entries.

The fix is straightforward and can be followed with the ChangeLog entry. 
It makes use of existing calls to

gfc_resolve_expr, whilst resolving specification expressions, to check 
that variables used are parameters of each and every entry. Since 
existing code is recycled and the test in gfc_resolve_expr is pretty 
exclusive, the load on the resolution stage is negligible.

OK for trunk and, a week later, for 4.1?

Paul

2006-05-13  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/25090
   * resolve..c : Static resolving_index_expr initialized.
   (entry_parameter): New function to emit errors for variables
   that are not entry parameters.
   (gfc_resolve_expr): Call entry_parameter, when resolving
   variables, if the namespace has entries and resolving_index_expr
   is set.
   (resolve_charlen): Set resolving_index_expr before the call to
   resolve_index_expr and reset it afterwards.
   (resolve_fl_variable): The same before and after the call to
   is_non_constant_shape_array, which ultimately makes a call to
   gfc_resolve_expr.

2006-05-13  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/25090
   * gfortran.dg/entry_dummy_ref_1.f90: New test.


Index: gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/entry_dummy_ref_1.f90	(revision 0)
***************
*** 0 ****
--- 1,13 ----
+ ! { dg-do compile }
+ ! Tests fix for PR25090 in which references in specification
+ ! expressions to variables that were not entry formal arguments
+ ! would be missed.
+ !
+ ! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+ !
+    SUBROUTINE S1(I) ! { dg-error "must be a parameter of the entry" }
+    CHARACTER(LEN=I+J) :: a ! { dg-error "must be a parameter of the entry" }
+    real :: x(i:j) ! { dg-error "must be a parameter of the entry" }
+    ENTRY E1(J) ! { dg-error "must be a parameter of the entry" }
+    END SUBROUTINE S1
+    END
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 113735)
--- gcc/fortran/resolve.c	(working copy)
*************** static int omp_workshare_flag;
*** 60,65 ****
--- 60,68 ----
     resets the flag each time that it is read.  */
  static int formal_arg_flag = 0;
  
+ /* True if we are resolving a specification expression.  */
+ static int resolving_index_expr = 0;
+ 
  int
  gfc_is_formal_arg (void)
  {
*************** resolve_variable (gfc_expr * e)
*** 2626,2631 ****
--- 2629,2671 ----
  }
  
  
+ /* Emits an error if the expression is a variable that is not a parameter
+    in all entry formal argument lists for the namespace.  */
+ 
+ static void
+ entry_parameter (gfc_expr *e)
+ {
+   gfc_symbol *sym, *esym;
+   gfc_entry_list *entry;
+   gfc_formal_arglist *f;
+   bool p;
+ 
+ 
+   sym = e->symtree->n.sym;
+ 
+   if (sym->attr.use_assoc
+ 	|| !sym->attr.dummy
+ 	|| sym->ns != gfc_current_ns)
+     return;
+ 
+   entry = sym->ns->entries;
+   for (; entry; entry = entry->next)
+     {
+       esym = entry->sym;
+       p = false;
+       for (f = esym->formal; f && !p; f = f->next)
+ 	{
+ 	  if (f->sym && f->sym->name && sym->name == f->sym->name)
+ 	    p = true;
+ 	}
+       if (!p)
+ 	gfc_error ("%s at %L must be a parameter of the entry at %L",
+ 		   sym->name, &e->where, &esym->declared_at);
+     }
+   return;
+ }
+ 
+ 
  /* Resolve an expression.  That is, make sure that types of operands agree
     with their operators, intrinsic operators are converted to function calls
     for overloaded types and unresolved function references are resolved.  */
*************** gfc_resolve_expr (gfc_expr * e)
*** 2650,2655 ****
--- 2690,2699 ----
  
      case EXPR_VARIABLE:
        t = resolve_variable (e);
+ 
+       if (gfc_current_ns->entries && resolving_index_expr)
+ 	entry_parameter (e);
+ 
        if (t == SUCCESS)
  	expression_rank (e);
        break;
*************** resolve_values (gfc_symbol * sym)
*** 4600,4606 ****
  static try
  resolve_index_expr (gfc_expr * e)
  {
- 
    if (gfc_resolve_expr (e) == FAILURE)
      return FAILURE;
  
--- 4644,4649 ----
*************** resolve_charlen (gfc_charlen *cl)
*** 4623,4631 ****
--- 4666,4677 ----
  
    cl->resolved = 1;
  
+   resolving_index_expr = 1;
+ 
    if (resolve_index_expr (cl->length) == FAILURE)
      return FAILURE;
  
+   resolving_index_expr = 0;
    return SUCCESS;
  }
  
*************** resolve_fl_variable (gfc_symbol *sym, in
*** 4712,4731 ****
    if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
      return FAILURE;
  
!   /* The shape of a main program or module array needs to be constant.  */
!   if (sym->ns->proc_name
! 	&& (sym->ns->proc_name->attr.flavor == FL_MODULE
! 	     || sym->ns->proc_name->attr.is_main_program)
! 	&& !sym->attr.use_assoc
  	&& !sym->attr.allocatable
  	&& !sym->attr.pointer
  	&& is_non_constant_shape_array (sym))
      {
!        gfc_error ("The module or main program array '%s' at %L must "
! 		     "have constant shape", sym->name, &sym->declared_at);
! 	  return FAILURE;
      }
  
    if (sym->ts.type == BT_CHARACTER)
      {
        /* Make sure that character string variables with assumed length are
--- 4758,4786 ----
    if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
      return FAILURE;
  
!   /* Set this flag to check that variables are parameters of all entries.
!      This check is effected by the call to gfc_resolve_expr through
!      is_non_contant_shape_array.  */
!   resolving_index_expr = 1;
! 
!   if (!sym->attr.use_assoc
  	&& !sym->attr.allocatable
  	&& !sym->attr.pointer
  	&& is_non_constant_shape_array (sym))
      {
! 	/* The shape of a main program or module array needs to be constant.  */
! 	if (sym->ns->proc_name
! 	      && (sym->ns->proc_name->attr.flavor == FL_MODULE
! 		    || sym->ns->proc_name->attr.is_main_program))
! 	  {
! 	    gfc_error ("The module or main program array '%s' at %L must "
! 		       "have constant shape", sym->name, &sym->declared_at);
! 	    return FAILURE;
! 	  }
      }
  
+   resolving_index_expr = 0;
+ 
    if (sym->ts.type == BT_CHARACTER)
      {
        /* Make sure that character string variables with assumed length are

2006-05-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25090
	* resolve..c : Static resolving_index_expr initialized.
	(entry_parameter): New function to emit errors for variables
	that are not entry parameters.
	(gfc_resolve_expr): Call entry_parameter, when resolving
	variables, if the namespace has entries and resolving_index_expr
	is set.
	(resolve_charlen): Set resolving_index_expr before the call to
	resolve_index_expr and reset it afterwards.
	(resolve_fl_variable): The same before and after the call to
	is_non_constant_shape_array, which ultimately makes a call to
	gfc_resolve_expr.

2006-05-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25090
	* gfortran.dg/entry_dummy_ref_1.f90: New test.