From e4821cd8679ab65057ad7f48c2236be8ad3ed8b7 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 4 Jan 2013 20:50:15 +0000 Subject: re PR fortran/55172 ([OOP] gfc_variable_attr(): Bad array reference in SELECT TYPE) 2013-01-04 Paul Thomas PR fortran/55172 * match.c (copy_ts_from_selector_to_associate): Remove call to gfc_resolve_expr and replace it with explicit setting of the array reference type. * resolve.c (resolve_select_type): It is an error if the selector is coindexed. 2013-01-04 Paul Thomas PR fortran/55172 * gfortran.dg/select_type_31.f03: New test. From-SVN: r194916 --- gcc/fortran/match.c | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/match.c') diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index ca8f08c..2a3f5b4 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1,6 +1,6 @@ /* Matching subroutines in all sizes, shapes and colors. Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009, 2010, 2011, 2012 + 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -5144,12 +5144,10 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) { gfc_ref *ref; gfc_symbol *assoc_sym; + int i; assoc_sym = associate->symtree->n.sym; - /* Ensure that any array reference is resolved. */ - gfc_resolve_expr (selector); - /* At this stage the expression rank and arrayspec dimensions have not been completely sorted out. We must get the expr2->rank right here, so that the correct class container is obtained. */ @@ -5161,6 +5159,23 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) && CLASS_DATA (selector)->as && ref && ref->type == REF_ARRAY) { + /* Ensure that the array reference type is set. We cannot use + gfc_resolve_expr at this point, so the usable parts of + resolve.c(resolve_array_ref) are employed to do it. */ + if (ref->u.ar.type == AR_UNKNOWN) + { + ref->u.ar.type = AR_ELEMENT; + for (i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_RANGE + || ref->u.ar.dimen_type[i] == DIMEN_VECTOR + || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN + && ref->u.ar.start[i] && ref->u.ar.start[i]->rank)) + { + ref->u.ar.type = AR_SECTION; + break; + } + } + if (ref->u.ar.type == AR_FULL) selector->rank = CLASS_DATA (selector)->as->rank; else if (ref->u.ar.type == AR_SECTION) -- cgit v1.1