From patchwork Sat Sep 4 16:51:45 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 63799 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 BEA98B7143 for ; Sun, 5 Sep 2010 02:52:34 +1000 (EST) Received: (qmail 29512 invoked by alias); 4 Sep 2010 16:52:27 -0000 Received: (qmail 29486 invoked by uid 22791); 4 Sep 2010 16:52:25 -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 mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 04 Sep 2010 16:51:49 +0000 Received: from [192.168.178.22] (port-92-204-40-202.dynamic.qsc.de [92.204.40.202]) by mx01.qsc.de (Postfix) with ESMTP id 9964E3DABB; Sat, 4 Sep 2010 18:51:46 +0200 (CEST) Message-ID: <4C827921.5010406@net-b.de> Date: Sat, 04 Sep 2010 18:51:45 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.7) Gecko/20100714 SUSE/3.1.1 Thunderbird/3.1.1 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 45530: Reorder namelist checking to avoid endless loop 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, the attached patch is rather obvious: Without the patch, gfortran ends up in an endless loop derived_inaccessible before it can reject the test case because of pointer components. Well, if one reverts the checking order, the code is rejected before one enters the endless loop... Build on x86-64-linux and currently regtesting. I plan to commit the patch to 4.6 and 4.5 as obvious - if there are no test suite failures and no one objects. Tobias 2010-09-04 Tobias Burnus PR fortran/45530 * resolve.c (resolve_fl_namelist): Change constraint checking order to prevent endless loop. 2010-09-04 Tobias Burnus PR fortran/45530 * gfortran.dg/namelist_63.f90: New. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 163859) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -11566,6 +11566,46 @@ resolve_fl_namelist (gfc_symbol *sym) gfc_namelist *nl; gfc_symbol *nlsym; + for (nl = sym->namelist; nl; nl = nl->next) + { + /* Reject namelist arrays of assumed shape. */ + if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE + && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' " + "must not have assumed shape in namelist " + "'%s' at %L", nl->sym->name, sym->name, + &sym->declared_at) == FAILURE) + return FAILURE; + + /* Reject namelist arrays that are not constant shape. */ + if (is_non_constant_shape_array (nl->sym)) + { + gfc_error ("NAMELIST array object '%s' must have constant " + "shape in namelist '%s' at %L", nl->sym->name, + sym->name, &sym->declared_at); + return FAILURE; + } + + /* Namelist objects cannot have allocatable or pointer components. */ + if (nl->sym->ts.type != BT_DERIVED) + continue; + + if (nl->sym->ts.u.derived->attr.alloc_comp) + { + gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " + "have ALLOCATABLE components", + nl->sym->name, sym->name, &sym->declared_at); + return FAILURE; + } + + if (nl->sym->ts.u.derived->attr.pointer_comp) + { + gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " + "have POINTER components", + nl->sym->name, sym->name, &sym->declared_at); + return FAILURE; + } + } + /* Reject PRIVATE objects in a PUBLIC namelist. */ if (gfc_check_access(sym->attr.access, sym->ns->default_access)) { @@ -11607,46 +11647,6 @@ resolve_fl_namelist (gfc_symbol *sym) } } - for (nl = sym->namelist; nl; nl = nl->next) - { - /* Reject namelist arrays of assumed shape. */ - if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE - && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' " - "must not have assumed shape in namelist " - "'%s' at %L", nl->sym->name, sym->name, - &sym->declared_at) == FAILURE) - return FAILURE; - - /* Reject namelist arrays that are not constant shape. */ - if (is_non_constant_shape_array (nl->sym)) - { - gfc_error ("NAMELIST array object '%s' must have constant " - "shape in namelist '%s' at %L", nl->sym->name, - sym->name, &sym->declared_at); - return FAILURE; - } - - /* Namelist objects cannot have allocatable or pointer components. */ - if (nl->sym->ts.type != BT_DERIVED) - continue; - - if (nl->sym->ts.u.derived->attr.alloc_comp) - { - gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " - "have ALLOCATABLE components", - nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; - } - - if (nl->sym->ts.u.derived->attr.pointer_comp) - { - gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot " - "have POINTER components", - nl->sym->name, sym->name, &sym->declared_at); - return FAILURE; - } - } - /* 14.1.2 A module or internal procedure represent local entities of the same type as a namelist member and so are not allowed. */ Index: gcc/testsuite/gfortran.dg/namelist_63.f90 =================================================================== --- gcc/testsuite/gfortran.dg/namelist_63.f90 (Revision 0) +++ gcc/testsuite/gfortran.dg/namelist_63.f90 (Revision 0) @@ -0,0 +1,28 @@ +! { dg-do compile } +! +! PR fortran/45530 +! +! Contributed by david.sagan@gmail.com +! +program test +implicit none + +type c_struct + type (g_struct), pointer :: g +end type + +type g_struct + type (p_struct), pointer :: p +end type + +type p_struct + type (region_struct), pointer :: r +end type + +type region_struct + type (p_struct) plot +end type + +type (c_struct) curve(10) +namelist / params / curve ! { dg-error "NAMELIST object .curve. in namelist .params. at .1. cannot have POINTER components" } +end program