From patchwork Fri Mar 27 08:03:35 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1262599 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 48pZDB24ndz9sPR for ; Fri, 27 Mar 2020 19:05:44 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 47F2B39450F4; Fri, 27 Mar 2020 08:05:39 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id E4EC639450E5; Fri, 27 Mar 2020 08:05:36 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org E4EC639450E5 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: MDGQZYgg4/T/LgaydkPN/blIoBWsWlV3r3i3xx1c2E8obbUTv/umw2PtFkPX4D5FPOCgUeRsC3 AS1Ts3g52YprfxgH6Q8b6J5Qztpx78HYCxtqpAwhAqUqH0M6i9gE4l/D6mLBirLdcuA2KojAyz J2RQQPFACzVrFxkFcHaEhjVgRQBz6BCF+mz/HPSwg0CggjPQjBg3UNlvo42V6UaV2HqgU9c6wN PvOmRZ316B5hWAjp0NcHzBKIlviSBICfNX0N5mfBy9biAC4SPix02LCl99BOJYvYFKZ9yBXygm CDk= X-IronPort-AV: E=Sophos;i="5.72,311,1580803200"; d="diff'?scan'208";a="47212923" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 27 Mar 2020 00:05:35 -0800 IronPort-SDR: aruLzBPTmUAuLQ5Ex9V0gmA/lO+2A2Ei+eyEl4fCOj9H7pbw+igsWGoJFcVZ9lePk/ZjiZ5ptJ /X1pzpg+qep6Tl0w5CCMIf+5AtzfdUHsftQtN8RlGCFCmZW97sWYc+n/ge7mYIi9uYc9aAeQ++ zQGSuch5OHhVcIR5Sb8kB68Cv6pFk5FcWnUk/KTCvV07rAIRlXVjNQwKj/Hrz+RoglWYF3201u ZeCa38ZMMUoCD2TWBSsIDq0hgETtsliqLOkjFCk5Fi6RHtP/PrKKMcm+3UUNE8zoobeMjOn0ua 3mI= To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch, Fortran] Reject invalid association target (PR93363) Message-ID: <7cf24818-0050-8240-064c-3cee3ccf0c1a@codesourcery.com> Date: Fri, 27 Mar 2020 09:03:35 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.5.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-08.mgc.mentorg.com (139.181.222.8) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-29.7 required=5.0 tests=BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Using "associate (y => procedure_name)" and "associate (y => derived_type_name)" failed with an ICE when converting to a tree. This patch rejects those now. (This is a GCC 10 regression; before there was no ICE but the code was silently accepted.) OK? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter 2020-03-27 Tobias Burnus PR fortran/93363 * resolve.c (resolve_assoc_var): Reject association to DT and function name. PR fortran/93363 * gfortran.dg/associate_51.f90: Fix test case. * gfortran.dg/associate_53.f90: New. gcc/fortran/resolve.c | 32 +++++++++++--- gcc/testsuite/gfortran.dg/associate_51.f90 | 2 +- gcc/testsuite/gfortran.dg/associate_53.f90 | 71 ++++++++++++++++++++++++++++++ 3 files changed, 97 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2dcb261fc71..b6277d236da 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8868,27 +8868,45 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) /* For variable targets, we get some attributes from the target. */ if (target->expr_type == EXPR_VARIABLE) { - gfc_symbol* tsym; + gfc_symbol *tsym, *dsym; gcc_assert (target->symtree); tsym = target->symtree->n.sym; - if (tsym->attr.subroutine - || tsym->attr.external - || (tsym->attr.function && tsym->result != tsym)) + if (gfc_expr_attr (target).proc_pointer) { - gfc_error ("Associating entity %qs at %L is a procedure name", + gfc_error ("Associating entity %qs at %L is a procedure pointer", tsym->name, &target->where); return; } - if (gfc_expr_attr (target).proc_pointer) + if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic + && (dsym = gfc_find_dt_in_generic (tsym)) != NULL + && dsym->attr.flavor == FL_DERIVED) { - gfc_error ("Associating entity %qs at %L is a procedure pointer", + gfc_error ("Derived type %qs cannot be used as a variable at %L", tsym->name, &target->where); return; } + if (tsym->attr.flavor == FL_PROCEDURE) + { + bool is_error = true; + if (tsym->attr.function && tsym->result == tsym) + for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent) + if (tsym == ns->proc_name) + { + is_error = false; + break; + } + if (is_error) + { + gfc_error ("Associating entity %qs at %L is a procedure name", + tsym->name, &target->where); + return; + } + } + sym->attr.asynchronous = tsym->attr.asynchronous; sym->attr.volatile_ = tsym->attr.volatile_; diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90 index b6ab1414b02..e6f2e4fafa3 100644 --- a/gcc/testsuite/gfortran.dg/associate_51.f90 +++ b/gcc/testsuite/gfortran.dg/associate_51.f90 @@ -29,7 +29,7 @@ subroutine p2 type t end type type(t) :: z = t() - associate (y => t) + associate (y => t()) end associate end diff --git a/gcc/testsuite/gfortran.dg/associate_53.f90 b/gcc/testsuite/gfortran.dg/associate_53.f90 new file mode 100644 index 00000000000..5b56af38e47 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_53.f90 @@ -0,0 +1,71 @@ +! { dg-do compile } +! +! PR fortran/93363 +! +! Contributed by G. Steinmetz + +program p + type t + integer :: a + end type + type(t) :: z + z = t(1) + associate (var1 => t) ! { dg-error "Derived type 't' cannot be used as a variable" } + end associate +end + +subroutine sub + if (f() /= 1) stop + associate (var2 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + block + block + associate (var2a => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + end block + end block +contains + integer function f() + f = 1 + associate (var3 => f) + end associate + block + block + associate (var4 => f) + end associate + end block + end block + end + integer recursive function f2() result(res) + res = 1 + associate (var5 => f2) ! { dg-error "Associating entity 'f2' at .1. is a procedure name" } + end associate + block + block + associate (var6 => f2) ! { dg-error "Associating entity 'f2' at .1. is a procedure name" } + end associate + end block + end block + end + subroutine subsub + associate (var7 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + block + block + associate (var8 => f) ! { dg-error "Associating entity 'f' at .1. is a procedure name" } + end associate + end block + end block + end +end + +subroutine sub2 + interface g + procedure s + end interface + associate (var9 => g) ! { dg-error "Associating entity 'g' at .1. is a procedure name" } + end associate +contains + subroutine s + end +end