[Patch, fortran] Fix for PR23446 - Ping

[Paul Thomas]

Paul Thomas wrote:

> :ADDPATCH fortran:
>
> This one is relatively easy:  check_restricted was being too restrictive
> when checking indices of formal argument lists.  Since several levels of
> indirection are positioned between the information that this is a formal
> argument list and the error, a flag and an interface function are 
> deployed.
>
> The testcase checks the correct functioning for three different forms of
> assumed shape array in a contained procedure.
>
> Bubblestrapped and regtested on FC3/Athlon1700.
>
> OK for mainline and 4.03, when open?
>
> Paul T
>
> ===================================================================
>
> 2005-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>    PR fortran/23446
>    * gfortran.h: Primitive for gfc_is_formal_arg.
>    * resolve.c(gfc_is_formal_arg): New function to signal across
>    several function calls that formal argument lists are being
>    processed.
>    (resolve_formal_arglist): Set/reset the flag for gfc_is_formal_arg.
>    *expr.c(check_restricted): Add check, via gfc_is_formal_arg, if
>    symbol is part of an formal argument declaration.
>
> 2005-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>    PR fortran/23446
>    * gfortran.dg/host_dummy_index_1.f90: New test.
>
>
>
> Index: gcc/gcc/fortran/gfortran.h
> ===================================================================
> RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
> retrieving revision 1.87
> diff -c -p -r1.87 gfortran.h
> *** gcc/gcc/fortran/gfortran.h    17 Sep 2005 18:57:59 -0000    1.87
> --- gcc/gcc/fortran/gfortran.h    21 Sep 2005 20:35:32 -0000
> *************** int gfc_elemental (gfc_symbol *);
> *** 1793,1798 ****
> --- 1793,1799 ----
>  try gfc_resolve_iterator (gfc_iterator *, bool);
>  try gfc_resolve_index (gfc_expr *, int);
>  try gfc_resolve_dim_arg (gfc_expr *);
> + int gfc_is_formal_arg (void);
>
>  /* array.c */
>  void gfc_free_array_spec (gfc_array_spec *);
> Index: gcc/gcc/fortran/resolve.c
> ===================================================================
> RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
> retrieving revision 1.54
> diff -c -p -r1.54 resolve.c
> *** gcc/gcc/fortran/resolve.c    18 Sep 2005 05:50:01 -0000    1.54
> --- gcc/gcc/fortran/resolve.c    21 Sep 2005 20:35:39 -0000
> *************** static code_stack *cs_base = NULL;
> *** 43,48 ****
> --- 43,58 ----
>
>  static int forall_flag;
>
> + /* Nonzero if we are processing a formal arglist. The corresponding 
> function
> +    resets the flag each time that it is read.  */
> + static int formal_arg_flag = 0;
> +
> + int
> + gfc_is_formal_arg (void)
> + {
> +   return formal_arg_flag;
> + }
> +
>  /* Resolve types of formal argument lists.  These have to be done 
> early so that
>     the formal argument lists of module procedures can be copied to the
>     containing module before the individual procedures are resolved
> *************** resolve_formal_arglist (gfc_symbol * pro
> *** 71,76 ****
> --- 81,88 ----
>        || (sym->as && sym->as->rank > 0))
>      proc->attr.always_explicit = 1;
>
> +   formal_arg_flag = 1;
> +
>    for (f = proc->formal; f; f = f->next)
>      {
>        sym = f->sym;
> *************** resolve_formal_arglist (gfc_symbol * pro
> *** 217,222 ****
> --- 229,235 ----
>              }
>          }
>      }
> +   formal_arg_flag = 0;
>  }
>
>
> Index: gcc/gcc/fortran/expr.c
> ===================================================================
> RCS file: /cvs/gcc/gcc/gcc/fortran/expr.c,v
> retrieving revision 1.29
> diff -c -p -r1.29 expr.c
> *** gcc/gcc/fortran/expr.c    17 Sep 2005 18:57:59 -0000    1.29
> --- gcc/gcc/fortran/expr.c    21 Sep 2005 20:35:42 -0000
> *************** check_restricted (gfc_expr * e)
> *** 1679,1685 ****
>        || sym->attr.dummy
>        || sym->ns != gfc_current_ns
>        || (sym->ns->proc_name != NULL
> !           && sym->ns->proc_name->attr.flavor == FL_MODULE))
>      {
>        t = SUCCESS;
>        break;
> --- 1679,1686 ----
>        || sym->attr.dummy
>        || sym->ns != gfc_current_ns
>        || (sym->ns->proc_name != NULL
> !           && sym->ns->proc_name->attr.flavor == FL_MODULE)
> !       || gfc_is_formal_arg ())
>      {
>        t = SUCCESS;
>        break;
>
>
> ===============host_dummy_index_1.f90===============
>
> ! { dg-do run }
> ! Tests the fix for PR23446.
> !
> ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
> !
> PROGRAM TST
>  INTEGER IMAX
>  INTEGER :: A(4) = 1
>  IMAX=2
>
>  CALL S(A)
>  CALL T(A)
>  CALL U(A)
>  if ( ALL(A.ne.(/2,2,3,4/))) CALL ABORT ()
>
> CONTAINS
>  SUBROUTINE S(A)
>    INTEGER A(IMAX)
>    a = 2
>  END SUBROUTINE S
>  SUBROUTINE T(A)
>    INTEGER A(3:IMAX+4)
>    A(5:IMAX+4) = 3
>  END SUBROUTINE T
>  SUBROUTINE U(A)
>    INTEGER A(2,IMAX)
>    A(2,2) = 4
>  END SUBROUTINE U
> ENDPROGRAM TST
>
>
>
>