From patchwork Fri Jun 18 07:32:22 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 56145 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 258C11007D3 for ; Fri, 18 Jun 2010 17:32:45 +1000 (EST) Received: (qmail 27086 invoked by alias); 18 Jun 2010 07:32:42 -0000 Received: (qmail 27066 invoked by uid 22791); 18 Jun 2010 07:32:41 -0000 X-SWARE-Spam-Status: No, hits=-2.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 18 Jun 2010 07:32:37 +0000 Received: from [192.168.178.22] (port-92-204-52-171.dynamic.qsc.de [92.204.52.171]) by mx01.qsc.de (Postfix) with ESMTP id E07023CD9D; Fri, 18 Jun 2010 09:32:22 +0200 (CEST) Message-ID: <4C1B2106.5040807@net-b.de> Date: Fri, 18 Jun 2010 09:32:22 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.1.9) Gecko/20100317 SUSE/3.0.4 Thunderbird/3.0.4 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR44556 Fix 4.5/4.6 regression in (DE)ALLOCATE stat/errmsg checking 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 Since 4.5, gfortran has a check which prevents "allocate(a, stat=a)", i.e. that the allocate and stat variable is the same. However, the current check fails for different components of the same derived type. The attached patch fixes this. Build and regtested on x86-64-linux. OK for the trunk? Tobias 2010-06-18 Tobias Burnus PR fortran/44556 * resolve.c (resolve_allocate_deallocate): Properly check part-refs in stat=/errmsg= for invalid use. 2010-06-18 Tobias Burnus PR fortran/44556 * gfortran.dg/allocate_alloc_opt_11.f90: New. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 160936) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -6589,8 +6589,29 @@ resolve_allocate_deallocate (gfc_code *c for (p = code->ext.alloc.list; p; p = p->next) if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name) - gfc_error ("Stat-variable at %L shall not be %sd within " - "the same %s statement", &stat->where, fcn, fcn); + { + gfc_ref *ref1, *ref2; + bool found = true; + + for (ref1 = p->expr->ref, ref2 = stat->ref; ref1 && ref2; + ref1 = ref1->next, ref2 = ref2->next) + { + if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT) + continue; + if (ref1->u.c.component->name != ref2->u.c.component->name) + { + found = false; + break; + } + } + + if (found) + { + gfc_error ("Stat-variable at %L shall not be %sd within " + "the same %s statement", &stat->where, fcn, fcn); + break; + } + } } /* Check the errmsg variable. */ @@ -6618,8 +6639,29 @@ resolve_allocate_deallocate (gfc_code *c for (p = code->ext.alloc.list; p; p = p->next) if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name) - gfc_error ("Errmsg-variable at %L shall not be %sd within " - "the same %s statement", &errmsg->where, fcn, fcn); + { + gfc_ref *ref1, *ref2; + bool found = true; + + for (ref1 = p->expr->ref, ref2 = errmsg->ref; ref1 && ref2; + ref1 = ref1->next, ref2 = ref2->next) + { + if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT) + continue; + if (ref1->u.c.component->name != ref2->u.c.component->name) + { + found = false; + break; + } + } + + if (found) + { + gfc_error ("Errmsg-variable at %L shall not be %sd within " + "the same %s statement", &errmsg->where, fcn, fcn); + break; + } + } } /* Check that an allocate-object appears only once in the statement. Index: gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/allocate_alloc_opt_11.f90 (Revision 0) @@ -0,0 +1,26 @@ +! { dg-do compile } +! +! PR fortran/44556 +! +! Contributed by Jonathan Hogg and Steve Kargl. +! +program oh_my + implicit none + type a + integer, allocatable :: b(:), d(:) + character(len=80) :: err + character(len=80), allocatable :: str(:) + integer :: src + end type a + + integer j + type(a) :: c + c%err = 'ok' + allocate(c%d(1)) + allocate(c%b(2), errmsg=c%err, stat=c%d(1)) ! OK + deallocate(c%b, errmsg=c%err, stat=c%d(1)) ! OK + allocate(c%b(2), errmsg=c%err, stat=c%b(1)) ! { dg-error "the same ALLOCATE statement" } + deallocate(c%b, errmsg=c%err, stat=c%b(1)) ! { dg-error "the same DEALLOCATE statement" } + allocate(c%str(2), errmsg=c%str(1), stat=j) ! { dg-error "the same ALLOCATE statement" } + deallocate(c%str, errmsg=c%str(1), stat=j) ! { dg-error "the same DEALLOCATE statement" } +end program oh_my