From patchwork Wed Jun 15 15:00:18 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 100600 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 012D8B6FA5 for ; Thu, 16 Jun 2011 16:53:33 +1000 (EST) Received: (qmail 22990 invoked by alias); 16 Jun 2011 06:53:31 -0000 Received: (qmail 22974 invoked by uid 22791); 16 Jun 2011 06:53:30 -0000 X-SWARE-Spam-Status: No, hits=0.3 required=5.0 tests=AWL, BAYES_50, DKIM_SIGNED, DKIM_VALID, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, RFC_ABUSE_POST X-Spam-Check-By: sourceware.org Received: from mail-yw0-f47.google.com (HELO mail-yw0-f47.google.com) (209.85.213.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 16 Jun 2011 06:53:16 +0000 Received: by ywa12 with SMTP id 12so148373ywa.20 for ; Wed, 15 Jun 2011 23:53:15 -0700 (PDT) MIME-Version: 1.0 Received: by 10.150.69.9 with SMTP id r9mr1015685yba.261.1308150018156; Wed, 15 Jun 2011 08:00:18 -0700 (PDT) Received: by 10.147.35.7 with HTTP; Wed, 15 Jun 2011 08:00:18 -0700 (PDT) Date: Wed, 15 Jun 2011 17:00:18 +0200 Message-ID: Subject: [Patch, Fortran, OOP] PR 49417: [4.6/4.7 Regression] ICE on invalid CLASS component declaration From: Janus Weil To: gfortran , gcc-patches 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 Hi all, here is the fix for an OOP-regression reported today by Andrew Benson (http://gcc.gnu.org/ml/fortran/2011-06/msg00119.html). It is fixed by checking the 'class_ok' attribute, which determines whether the CLASS declaration was ok. We also need to set this attribute for components read from module files, since the attribute itself is not written to the file. The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk? Cheers, Janus 2011-06-15 Janus Weil PR fortran/49417 * module.c (mio_component): Make sure the 'class_ok' attribute is set for use-associated CLASS components. * parse.c (parse_derived): Check for 'class_ok' attribute. * resolve.c (resolve_fl_derived): Ditto. 2011-06-15 Janus Weil PR fortran/49417 * gfortran.dg/class_43.f03: New. Index: gcc/fortran/module.c =================================================================== --- gcc/fortran/module.c (revision 175079) +++ gcc/fortran/module.c (working copy) @@ -2403,6 +2403,8 @@ mio_component (gfc_component *c, int vtype) mio_array_spec (&c->as); mio_symbol_attribute (&c->attr); + if (c->ts.type == BT_CLASS) + c->attr.class_ok = 1; c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); if (!vtype) Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 175079) +++ gcc/fortran/resolve.c (working copy) @@ -11789,7 +11789,8 @@ resolve_fl_derived (gfc_symbol *sym) return FAILURE; } - if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer + if (c->ts.type == BT_CLASS && c->attr.class_ok + && CLASS_DATA (c)->attr.class_pointer && CLASS_DATA (c)->ts.u.derived->components == NULL && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp) { @@ -11800,9 +11801,10 @@ resolve_fl_derived (gfc_symbol *sym) } /* C437. */ - if (c->ts.type == BT_CLASS - && !(CLASS_DATA (c)->attr.class_pointer - || CLASS_DATA (c)->attr.allocatable)) + if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE + && (!c->attr.class_ok + || !(CLASS_DATA (c)->attr.class_pointer + || CLASS_DATA (c)->attr.allocatable))) { gfc_error ("Component '%s' with CLASS at %L must be allocatable " "or pointer", c->name, &c->loc); Index: gcc/fortran/parse.c =================================================================== --- gcc/fortran/parse.c (revision 175079) +++ gcc/fortran/parse.c (working copy) @@ -2120,13 +2120,15 @@ endType: { /* Look for allocatable components. */ if (c->attr.allocatable - || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) + || (c->ts.type == BT_CLASS && c->attr.class_ok + && CLASS_DATA (c)->attr.allocatable) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp)) sym->attr.alloc_comp = 1; /* Look for pointer components. */ if (c->attr.pointer - || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.class_pointer) + || (c->ts.type == BT_CLASS && c->attr.class_ok + && CLASS_DATA (c)->attr.class_pointer) || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp)) sym->attr.pointer_comp = 1;