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 <at> 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 <at> 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 <at> 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
>
>
>
>
RSS Feed