From patchwork Sat Aug 17 00:59:54 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 1148561 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-507173-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=troutmask.apl.washington.edu Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NHtD1ted"; 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 469ML55RqTz9sML for ; Sat, 17 Aug 2019 11:00:11 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=NJq7fZ+V46JLAh71gL131OkW6iv1cy7qd65z0FR24hM FBOUB5w/9ypmlaZLIlftFggmDCSLprpLXfeuVMvnaxj9jAJKr7BZYyp6KpeXbkg/ wtTObLhi7SdkUO2BYHsvq8JADW8jDQ15iqAe825A8VJXK9WMly+HOUX1x5mTi848 = 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:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=7/trXrsRsCiqvwdB2+tCW4nLX+Q=; b=NHtD1tedGalH0accY EwMHlOL+VGGOG6sN4WPm7SlVxdtjbxfbny8axdm5MpRzG6mkK84l1Is9ani3etDf SEYrXkKiKhXDFAWTdDrvtquVtvw8y+GDt+ajfBpeyLJXAwdGD6rCfa1DCHQ1551y 790AKs89/74ECSw2dPruglnY1Q= Received: (qmail 100956 invoked by alias); 17 Aug 2019 00:59:58 -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 100941 invoked by uid 89); 17 Aug 2019 00:59:57 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-8.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS autolearn=ham version=3.3.1 spammy= X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 17 Aug 2019 00:59:56 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id x7H0xsPd054935 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NO); Fri, 16 Aug 2019 17:59:54 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id x7H0xsAG054934; Fri, 16 Aug 2019 17:59:54 -0700 (PDT) (envelope-from sgk) Date: Fri, 16 Aug 2019 17:59:54 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/78719 -- Check for a CLASS Message-ID: <20190817005954.GA54929@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.12.1 (2019-06-15) Regression tested on x86_64-*-freebsd. OK to commit? When checking to see in attrbutes are being added to an entity that alrady has an explcit interface, gfortran failed to consider the case of CLASS. The attach patch corrects this omission. See the 3 testcases for clarity. 2019-08-16 Steven G. Kargl PR fortran/78719 * decl.c (get_proc_name): Check for a CLASS entity when trying to add attributes to an entity that already has an explicit interface. 2019-08-16 Steven G. Kargl PR fortran/78719 * gfortran.dg/pr78719_1.f90: New test. * gfortran.dg/pr78719_2.f90: Ditto. * gfortran.dg/pr78719_3.f90: Ditto. Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 274578) +++ gcc/fortran/decl.c (working copy) @@ -1363,9 +1363,9 @@ get_proc_name (const char *name, gfc_symbol **result, } /* Trap declarations of attributes in encompassing scope. The - signature for this is that ts.kind is set. Legitimate - references only set ts.type. */ - if (sym->ts.kind != 0 + signature for this is that ts.kind is nonzero for no-CLASS + entity. For a CLASS entity, ts.kind is zero. */ + if ((sym->ts.kind != 0 || sym->ts.type == BT_CLASS) && !sym->attr.implicit_type && sym->attr.proc == 0 && gfc_current_ns->parent != NULL Index: gcc/testsuite/gfortran.dg/pr78719_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78719_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78719_1.f90 (working copy) @@ -0,0 +1,29 @@ +! { dg-do run } +! PR fortran/78719 +! Code contributed by Gerhard Steinmetz +program p + + type t + integer :: n + end type + + abstract interface + subroutine h + end + end interface + + procedure(h), pointer :: s + + s => f + call s + s => g + call s + + contains + + subroutine f + end + + subroutine g + end +end program p Index: gcc/testsuite/gfortran.dg/pr78719_2.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78719_2.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78719_2.f90 (working copy) @@ -0,0 +1,32 @@ +! { dg-do compile } +! PR fortran/78719 +! Code contributed by Gerhard Steinmetz +program p + + type t + integer :: n + end type + + real :: g + + abstract interface + subroutine h + end + end interface + + procedure(h), pointer :: s + + s => f + call s + s => g ! { dg-error "Invalid procedure pointer" } + call s + + contains + + subroutine f + end + + subroutine g ! { dg-error "has an explicit interface" } + end + +end program p ! { dg-error "Syntax error" } Index: gcc/testsuite/gfortran.dg/pr78719_3.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr78719_3.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr78719_3.f90 (working copy) @@ -0,0 +1,32 @@ +! { dg-do compile } +! PR fortran/78719 +! Code contributed by Gerhard Steinmetz +program p + + type t + integer :: n + end type + + class(t) :: g ! { dg-error "must be dummy, allocatable or pointer" } + + abstract interface + subroutine h + end + end interface + + procedure(h), pointer :: s + + s => f + call s + s => g ! { dg-error "Invalid procedure pointer" } + call s + + contains + + subroutine f + end + + subroutine g ! { dg-error "has an explicit interface" } + end + +end program p ! { dg-error "Syntax error" }