This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] Fix for PR23446 - Ping


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







Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]