From patchwork Sat Dec 3 19:12:50 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 129111 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 2D773B6F69 for ; Sun, 4 Dec 2011 06:13:13 +1100 (EST) Received: (qmail 5458 invoked by alias); 3 Dec 2011 19:13:09 -0000 Received: (qmail 5440 invoked by uid 22791); 3 Dec 2011 19:13:07 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 03 Dec 2011 19:12:51 +0000 Received: from [192.168.178.22] (port-92-204-12-48.dynamic.qsc.de [92.204.12.48]) by mx02.qsc.de (Postfix) with ESMTP id 2032B1E149; Sat, 3 Dec 2011 20:12:50 +0100 (CET) Message-ID: <4EDA74B2.9010909@net-b.de> Date: Sat, 03 Dec 2011 20:12:50 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:8.0) Gecko/20111105 Thunderbird/8.0 MIME-Version: 1.0 To: gfortran , gcc patches Subject: [Patch, Fortran] PR 51383 - fix ASSOCIATE with extended types Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Another OOP-related patch: If one uses type extension, the first REF_COMPONENT does not necessarily refer directly to a component in the linked list starting at sym->ts.u.derived->components. Using simply ref->u.c.component directly seems to work fine, thus, I do this with this patch. Build and regtested on x86-64-linux. OK for the trunk? Tobias PS: Other patches where review is pending: - http://gcc.gnu.org/ml/fortran/2011-11/msg00250.html - no -fcheck=bounds for character(LEN=:) to avoid ICE - http://gcc.gnu.org/ml/fortran/2011-11/msg00253.html - (Re)enable warning if a function result variable is not set [4.4-4.7 diagnostics regression] - http://gcc.gnu.org/ml/fortran/2011-11/msg00254.html - Thomas' dependency-ICE patch [4.6/4.7 regression] (I will try to review this one, unless someone else is faster) 2011-12-03 Tobias Burnus PR fortran/51383 * resolve.c (find_array_spec): Use ref->u.c.component directly without starting from ts.u.derived. 2011-12-03 Tobias Burnus PR fortran/51383 * gfortran.dg/associate_10.f90: New. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 181975) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -4515,14 +4515,12 @@ find_array_spec (gfc_expr *e) { gfc_array_spec *as; gfc_component *c; - gfc_symbol *derived; gfc_ref *ref; if (e->symtree->n.sym->ts.type == BT_CLASS) as = CLASS_DATA (e->symtree->n.sym)->as; else as = e->symtree->n.sym->as; - derived = NULL; for (ref = e->ref; ref; ref = ref->next) switch (ref->type) @@ -4536,26 +4534,7 @@ find_array_spec (gfc_expr *e) break; case REF_COMPONENT: - if (derived == NULL) - derived = e->symtree->n.sym->ts.u.derived; - - if (derived->attr.is_class) - derived = derived->components->ts.u.derived; - - c = derived->components; - - for (; c; c = c->next) - if (c == ref->u.c.component) - { - /* Track the sequence of component references. */ - if (c->ts.type == BT_DERIVED) - derived = c->ts.u.derived; - break; - } - - if (c == NULL) - gfc_internal_error ("find_array_spec(): Component not found"); - + c = ref->u.c.component; if (c->attr.dimension) { if (as != NULL) Index: gcc/testsuite/gfortran.dg/associate_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/associate_10.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/associate_10.f90 (Arbeitskopie) @@ -0,0 +1,23 @@ +! { dg-do compile } +! +! PR fortran/51383 +! +! Contributed by kaiserkarl31@yahoo.com +! +! Was failing before at the ref resolution of y1(1)%i. +! +program extend + type :: a + integer :: i + end type a + type, extends (a) :: b + integer :: j + end type b + type (a) :: x(2) + type (b) :: y(2) + associate (x1 => x, y1 => y) + x1(1)%i = 1 + ! Commenting out the following line will avoid the error + y1(1)%i = 2 + end associate +end program extend