From patchwork Tue Feb 13 18:24:35 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Janus Weil X-Patchwork-Id: 873111 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-473192-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="jJUmK7I5"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zgrYV2bjDz9sRm for ; Wed, 14 Feb 2018 05:25:00 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=DpScWhYQ9hQqPjDPz7yuo0kimoy33akc9NoukW23GKryOh UmFvfJGU9tSOvysKW+Iq4b7ETYX42l3ymGS0c0n32920087O4F3gva9ajOsTmWB9 L4J4nyqpEa164ZWtC1DDwDWC0OBWcQQexrYSw63+02z1ZtM6h4VFecPAB5eAo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=TYECVjCTM0PyvUhZISKePPBsQpw=; b=jJUmK7I5dFiKWhB+fKlG kDpjpRdAkABvIUcs7kRdXalFYO6sBaSHIqMkutjMbtZqlVMPv0jqNK1GRosjU3o2 WBbKewhPeiVu9IV3PPW3fCuUHXfubUo5OdSyhUFNuHA32KNQormiSz+eX1wVGnG5 Eth1W7tpHiSvoa/H153JsKk= Received: (qmail 67698 invoked by alias); 13 Feb 2018 18:24:41 -0000 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 Received: (qmail 67507 invoked by uid 89); 13 Feb 2018 18:24:40 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.0 required=5.0 tests=AWL, BAYES_00, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-yw0-f181.google.com Received: from mail-yw0-f181.google.com (HELO mail-yw0-f181.google.com) (209.85.161.181) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 13 Feb 2018 18:24:38 +0000 Received: by mail-yw0-f181.google.com with SMTP id f12so4141102ywb.8; Tue, 13 Feb 2018 10:24:37 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:sender:from:date:message-id:subject :to; bh=3sFOwJbWYH0uh8ZRN5vvrEnnwf4O0u2InqF2OSzVLDg=; b=DRqLYtvuC7Nem9hSPkB46bcmQi4iFH3+70CPQ8kVlI3z0c1DnGd54Yxv/iObKuQe+x BEQaRq7mdGclNcn8uZXK5axFkZKPoeW9sglhnIB174BFn+lY/DjZgZciNnUtM+GUqkJE ZjeazXULDIGVCY45Cn10vSWdtxVy9X8vjjw+SB+5Fjp3hvPzU0hB04WTK3pAkBD8PuO9 L8dWOslqCAGXIpkwz/Wy1Rw5BrrlLa0StDrNjixLwNLI6YtlYIHl7PIZ5xSARDiB7jFz eweXzefWXsXM+1umqtbwsAohL4NZsik864McgA3T+xbT6YsEjn1TbCsoi6o6f/wjJg7a gc3Q== X-Gm-Message-State: APf1xPBmKwtUoZF3beU2mbCakvqu8fL8Ow+VcA+pmye81p+qTmU/2y/j 4DKrPk1yhDUQOtyrS8hV30p/0dhIDyI3D8E/NUJS7g== X-Google-Smtp-Source: AH8x2264pnvEEa795HSgCnpcS/2FY3066awmfD2ZxQAkgV4S/i5I5skjOPUSNKhTm/VrecLq+Ytbk3ZBPskO/thsBGw= X-Received: by 10.129.134.129 with SMTP id w123mr1435929ywf.329.1518546276192; Tue, 13 Feb 2018 10:24:36 -0800 (PST) MIME-Version: 1.0 Received: by 10.129.85.138 with HTTP; Tue, 13 Feb 2018 10:24:35 -0800 (PST) From: Janus Weil Date: Tue, 13 Feb 2018 19:24:35 +0100 Message-ID: Subject: [Patch, Fortran, F08] PR 84313: reject procedure pointers in COMMON blocks To: gfortran , gcc-patches , Richard Guenther , Jakub Jelinek Hi all, as the subject line says, the attached patch rejects procedure pointers in COMMON blocks (which is forbidden in F08). Since it's apparently legal in F03, I'm still accepting it with -std=f2003 and add that flag to a test case where this 'feature' is used. In another one, I'm adding the error message that one gets with -std=f2008. As my last submission, this fixes fallout from https://groups.google.com/forum/?fromgroups#!topic/comp.lang.fortran/AIHRQ2kJv3c. As the last one, it is a very simple fix for an accepts-invalid problem (which is not a regression), so I hope this one will also still be suitable for trunk (if not, I hope the release managers, in CC, will stop me). It does regtest cleanly on x86_64-linux-gnu. Ok for trunk? Cheers, Janus 2018-02-13 Janus Weil PR fortran/84313 * symbol.c (check_conflict): Reject procedure pointers in common blocks. 2018-02-13 Janus Weil PR fortran/84313 * gfortran.dg/proc_ptr_common_1.f90: Fix invalid test case, add necessary compiler options. * gfortran.dg/proc_ptr_common_2.f90: Add missing error message. Index: gcc/fortran/symbol.c =================================================================== --- gcc/fortran/symbol.c (revision 257589) +++ gcc/fortran/symbol.c (working copy) @@ -809,7 +809,9 @@ check_conflict (symbol_attribute *attr, const char conf2 (threadprivate); } - if (!attr->proc_pointer) + /* Procedure pointers in COMMON blocks are allowed in F03, + * but forbidden per F08:C5100. */ + if (!attr->proc_pointer || (gfc_option.allow_std & GFC_STD_F2008)) conf2 (in_common); conf2 (omp_declare_target_link); Index: gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90 (revision 257589) +++ gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90 (working copy) @@ -1,16 +1,18 @@ ! { dg-do run } - +! { dg-options "-std=f2003 -fall-intrinsics" } +! ! PR fortran/36592 ! ! Procedure Pointers inside COMMON blocks. +! (Allowed in F03, but forbidden in F08.) ! ! Contributed by Janus Weil . subroutine one() implicit none - common /com/ p1,p2,a,b procedure(real), pointer :: p1,p2 integer :: a,b + common /com/ p1,p2,a,b if (a/=5 .or. b/=-9 .or. p1(0.0)/=1.0 .or. p2(0.0)/=0.0) call abort() end subroutine one Index: gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90 (revision 257589) +++ gcc/testsuite/gfortran.dg/proc_ptr_common_2.f90 (working copy) @@ -12,7 +12,7 @@ abstract interface end interface procedure(foo), pointer, bind(C) :: proc -common /com/ proc,r +common /com/ proc,r ! { dg-error "PROCEDURE attribute conflicts with COMMON attribute" } common s call s() ! { dg-error "PROCEDURE attribute conflicts with COMMON attribute" }