From e4821cd8679ab65057ad7f48c2236be8ad3ed8b7 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 4 Jan 2013 20:50:15 +0000 Subject: [PATCH] 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/ChangeLog | 9 +++++ gcc/fortran/match.c | 23 +++++++++--- gcc/fortran/resolve.c | 22 ++++++++++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/select_type_31.f03 | 52 ++++++++++++++++++++++++++++ 5 files changed, 105 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/select_type_31.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5c0d6d4..4e1cf55 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +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 Tobias Burnus PR fortran/55763 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) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 873400a..54ac3c6 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1,6 +1,6 @@ /* Perform type resolution on the various structures. Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, - 2010, 2011, 2012 + 2010, 2011, 2012, 2013 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -8349,9 +8349,27 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) if (code->expr1->symtree->n.sym->attr.untyped) code->expr1->symtree->n.sym->ts = code->expr2->ts; selector_type = CLASS_DATA (code->expr2)->ts.u.derived; + + /* F2008: C803 The selector expression must not be coindexed. */ + if (gfc_is_coindexed (code->expr2)) + { + gfc_error ("Selector at %L must not be coindexed", + &code->expr2->where); + return; + } + } else - selector_type = CLASS_DATA (code->expr1)->ts.u.derived; + { + selector_type = CLASS_DATA (code->expr1)->ts.u.derived; + + if (gfc_is_coindexed (code->expr1)) + { + gfc_error ("Selector at %L must not be coindexed", + &code->expr1->where); + return; + } + } /* Loop over TYPE IS / CLASS IS cases. */ for (body = code->block; body; body = body->block) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ceba87b..9835a26 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-01-04 Paul Thomas + + PR fortran/55172 + * gfortran.dg/select_type_31.f03: New test. + 2013-01-04 Paolo Carlini PR c++/54526 (again) diff --git a/gcc/testsuite/gfortran.dg/select_type_31.f03 b/gcc/testsuite/gfortran.dg/select_type_31.f03 new file mode 100644 index 0000000..a285812 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_31.f03 @@ -0,0 +1,52 @@ +! { dg-do compile } +! { dg-options "-fcoarray=single" } +! Test the fix for PR55172. +! +! Contributed by Arjen Markus +! +module gn + type :: ncb + end type ncb + type, public :: tn + class(ncb), allocatable, dimension(:) :: cb + end type tn +contains + integer function name(self) + implicit none + class (tn), intent(in) :: self + select type (component => self%cb(i)) ! { dg-error "has no IMPLICIT type" } + end select + end function name +end module gn + +! Further issues, raised by Tobias Burnus in the course of fixing the PR + +module gn1 + type :: ncb1 + end type ncb1 + type, public :: tn1 + class(ncb1), allocatable, dimension(:) :: cb + end type tn1 +contains + integer function name(self) + implicit none + class (tn1), intent(in) :: self + select type (component => self%cb([4,7+1])) ! { dg-error "needs a temporary" } + end select + end function name +end module gn1 + +module gn2 + type :: ncb2 + end type ncb2 + type, public :: tn2 + class(ncb2), allocatable :: cb[:] + end type tn2 +contains + integer function name(self) + implicit none + class (tn2), intent(in) :: self + select type (component => self%cb[4]) ! { dg-error "must not be coindexed" } + end select + end function name +end module gn2 -- 2.7.4