From patchwork Thu Jan 3 23:23:38 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 209331 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 B69A22C008C for ; Fri, 4 Jan 2013 10:23:56 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1357860238; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=AmKOthk kx8yfBHANVEvHVXYe9TE=; b=CwC/QvrpMwpgwv0OpmTx56dTP87fQCvRg1t5NkR qY8ocTcU9CaIIzejzAZvDIjDHjAc/88zHtMo0rDi2emduQjlWeOaLGALTD4YuXfK L0QUewVSOr3vK/JBXJTWjT4wc0TitxXBy+XopKCo38tcw/m7BmmSY/EAYeOhqvPO fl04= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=WOUn5X18gRPkscgrs644yxcElbFkZHLbff6Q62pqpOQeabrSQIDWBQXrEs4hrX kAfio4RHpPnDxBOUe/u1EViBBNc0kq9OV8FZa/ePYT3dTsv0JnxFRZ9MZM+/snZJ ry1uBsTH4Ebs99UDKaCF+ANyJplT+KoCE5sLVy/iC8+5s=; Received: (qmail 21080 invoked by alias); 3 Jan 2013 23:23:46 -0000 Received: (qmail 21060 invoked by uid 22791); 3 Jan 2013 23:23:46 -0000 X-SWARE-Spam-Status: No, hits=-2.2 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; Thu, 03 Jan 2013 23:23:40 +0000 Received: from archimedes.net-b.de (port-92-195-50-179.dynamic.qsc.de [92.195.50.179]) by mx01.qsc.de (Postfix) with ESMTP id 8ADFF3CC6D; Fri, 4 Jan 2013 00:23:38 +0100 (CET) Message-ID: <50E612FA.5090703@net-b.de> Date: Fri, 04 Jan 2013 00:23:38 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/17.0 Thunderbird/17.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR55763 - reject MOLD with NULL() in init-data expressions 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 NULL with MOLD should be rejected as (default) initialization expression. From F2008: R506 null-init is function-reference C512 (R506) The function-reference shall be a reference to the intrinsic function NULL with no arguments. "null-init" occurs twice, as "R505 initialization" in "R505 initialization" and in "R442 component-initialization" (default initialization). Before, integer, pointer :: p => null(x) gave an type error (LHS: integer, RHS: unknown). While class(*), pointer :: p => null(x) was accepted without error diagnostic. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2012-01-04 Tobias Burnus PR fortran/55763 * decl.c (gfc_match_null): Parse and reject MOLD. 2012-01-04 Tobias Burnus PR fortran/55763 * gfortran.dg/null_7.f90: New. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5ed8388..7d49578 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1671,11 +1671,31 @@ match gfc_match_null (gfc_expr **result) { gfc_symbol *sym; - match m; + match m, m2 = MATCH_NO; - m = gfc_match (" null ( )"); - if (m != MATCH_YES) - return m; + if ((m = gfc_match (" null ( )")) == MATCH_ERROR) + return MATCH_ERROR; + + if (m == MATCH_NO) + { + locus old_loc; + char name[GFC_MAX_SYMBOL_LEN + 1]; + + if ((m2 = gfc_match (" null (", name)) != MATCH_YES) + return m2; + + old_loc = gfc_current_locus; + if ((m2 = gfc_match (" %n ) ", name)) == MATCH_ERROR) + return MATCH_ERROR; + if (m2 != MATCH_YES + && ((m2 = gfc_match (" mold = %n )", name)) == MATCH_ERROR)) + return MATCH_ERROR; + if (m2 == MATCH_NO) + { + gfc_current_locus = old_loc; + return MATCH_NO; + } + } /* The NULL symbol now has to be/become an intrinsic function. */ if (gfc_get_symbol ("null", NULL, &sym)) @@ -1694,6 +1714,13 @@ gfc_match_null (gfc_expr **result) *result = gfc_get_null_expr (&gfc_current_locus); + /* Invalid per F2008, C512. */ + if (m2 == MATCH_YES) + { + gfc_error ("NULL() initialization at %C may not have MOLD"); + return MATCH_ERROR; + } + return MATCH_YES; } diff --git a/gcc/testsuite/gfortran.dg/null_7.f90 b/gcc/testsuite/gfortran.dg/null_7.f90 new file mode 100644 index 0000000..d6d77d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/null_7.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! +! PR fortran/55763 +! + +implicit none +integer, pointer :: x +class(*), pointer :: y +integer, pointer :: p1 => null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } +integer, pointer :: p2 => null(mold=x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } +class(*), pointer :: p3 =>null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } +type t + real, pointer :: a1 => null(x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } + real, pointer :: a2 => null ( mold = x) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } + class(*), pointer :: a3 => null(mold = x ) ! { dg-error "NULL.. initialization at .1. may not have MOLD" } +end type t + +x => null(x) ! OK +y => null(y) ! OK +end