From patchwork Tue Apr 11 20:12:39 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 82168 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp2829669vqo; Tue, 11 Apr 2023 13:13:38 -0700 (PDT) X-Google-Smtp-Source: AKy350YFbc0SzDby4NOTkUL8QeMVkIzA5tr+HMUjNOsM70PlxfFNjKCosTX2LX2haPEZg71zGHYn X-Received: by 2002:a17:906:d89:b0:947:d875:68f9 with SMTP id m9-20020a1709060d8900b00947d87568f9mr487910eji.0.1681244018281; Tue, 11 Apr 2023 13:13:38 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1681244018; cv=none; d=google.com; s=arc-20160816; b=pDcjVLXXydguu/leTKhkCJu+Z1tzVxo8cETJEg0CAAiTTgUutIe88LFAryq6lGQh99 LqWf98hwa2A1bHI/Wq2Dfvb78mOSAt/WXqFL6p2/htFzRmC0sZngw6u9dT7xRKrQQaTr +2S2vARwexlARGkvyL6Lt4Q1k/05iLLxuMjWagVXB2Kry+TFI+8sGyilPVeiXkvBFCDy 9UOt5JTUjHHwLNeuTxVV+DOsFBPrRYzvpaPZcD5iWwQCK+nW/lh4tC8M7h8aNxOVok/J QtjFC3sWDgcEWnRzLo4RiCk71uGwL/4F3aKPOQ6K/Tm6v/e9PY8lCRr/NxYqWzXACY/d DQnw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=2JDR3vzEObpFVAGi3O7wUkv2MMmPDbkwS7FNxDHnTX4=; b=y75lnq5PwDLz4SXqG3k9Mt8VxzCRD3mm5TdSH5nAXUS7/+/OoHTFxQORvDMKXm8Cal yYIfTvJB5tN+w+2vg04rMKQeUIP/3exbzLSGF1pid2cC8X6q+pLB65LJQR+/5/oMM4Jn NGwiaXHcVS6CH4g85pCdOIf1ykB32CoUNuGhiKTyb84Ksqksx00LrWqxO5cmuOnuSqi6 tRArE0B7tQz9BROGXGEf+B11wxHgj/4TVQaW2WyF9R9kkXA/RFawxTvNSVIrUGY39EMS Wr/t9eqzyrwNz5cV48W3WhRTqcxUAXgIDAOupdQGtBdGzFUggoKZnRPzXOopLwCfYVDO OHeA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=lqbUBQnM; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id c17-20020a17090654d100b00945347f282csi11844886ejp.1041.2023.04.11.13.13.38 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 11 Apr 2023 13:13:38 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=lqbUBQnM; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9C8A5385840E for ; Tue, 11 Apr 2023 20:13:27 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 9C8A5385840E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1681244007; bh=2JDR3vzEObpFVAGi3O7wUkv2MMmPDbkwS7FNxDHnTX4=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=lqbUBQnMNgxGi689j6LrbAv/MHIUton++gx5ON6eKz+3xg4+hhC8E/6Zrx143F/tz r/nXyqRw8NBxuBJzZpX9BO3ucm5i1EHKNp6hmGmnj0ndhrhWbNMzkVobua6vCtojmy BLEt8nATgVP37th05kWxWMKnLXp2IlMDds1EpGfg= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.18]) by sourceware.org (Postfix) with ESMTPS id 152703858D28; Tue, 11 Apr 2023 20:12:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 152703858D28 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.13.85] ([79.251.13.85]) by web-mail.gmx.net (3c-app-gmx-bs42.server.lan [172.19.170.94]) (via HTTP); Tue, 11 Apr 2023 22:12:39 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312] Date: Tue, 11 Apr 2023 22:12:39 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:C/UNruA3RLO3PiKCYQvcXahwtIR1g7FcPJ6Nvc3IqJSv3oMb8CIjQVMmu7Wv7Srs2OAKA JKi3uH14qn/jX/w9/a1xNOSaUvPNEcM9HkIwfToz6UjaKileKrKpLdqGWt7/lI3a2M35T18QTw06 PT82y+6OVorU8kwO2HAzhwdipKyKMV/Xm6Alb3NKV1aE2HIlN5MJvg5E8JYkv3b+iHt4DdRCwryj ke3umDZjoqr+cBuCM8fLkE1Zbafp2f59x2GslYfEncE2qOi070GRN+/GBaqaklI2iEPkHFvlN/fQ Go= UI-OutboundReport: notjunk:1;M01:P0:kWsp7RX1kNg=;yLmM5mZX18MtwJjHJ2/qwqF7b2a mZ/6YtHNZXpipNcLIuJIMJi8LOkQ+/ZHuYbjm0J+WeQRO8U4Kw7BncMUOcrjF0CA2dl8wk0et gtAexkpft2WrVA9CC9/POkjddyHicRcGmCXBzymMclW1vhAe/XIxnci3NktvLHUBpj8mFPr4u p3wpAyiZRcsRLq2Js91SowVHybKdqTvQwE+ZK3Ol/TvJ6Wo6vUwMTJrNKtuglKyaHSjnzWWtF CMhzP++qiQFYeFmY9GbGcSOZPBetKUVfEFXYD8ht5HcZjDGwUioV7/PzcphG83+3TcjE6v3sf 2Kbmia1kzLkMWeeb6B7BHfyjVJ2jImTSpqv+ePFLgDyEMjW6KboR7uu2loBpa48+WcpGf5KAP 0h84usGE878RQ7mM+g6jcrGe7ZkOETjdOAO8gDd/D0c0veEIwXwvCryP8qDPe9QAe8u3UgDp7 fYtKm79W9sMUm95A3ilMkR5v3OWUfl7xOcMPFQ4IDDZ8xKisOwvkU1Bo3g2OqD780vspqOK0z EPgQExVka12aCaMcta6qFs3iOfBMnlQ+ldaXCifc/1CnHbAqQA4EEumB34glyW0e81btTaYn1 WdDC7zWzX02vd+FytMitOgriLKgEXAAWlztnTnJeZwRPTpJpZmhLhTTl74BM9MeI7Pk4Oxxpb MQ2JCzjP9Hf3n386x55zQJ1EyG+0E+VJRNxjpH1jZuqQjinSPqybboZXZ4la9rOGhO4MMbhpw xxM9wq3Py1PRrn2JEAYh2qUw7nqmrcX99WwTDzlaQDuPA6xa1uV4j4Lt5sIt0nCamLuK3t0SB Ly1ZFaYQtxsECcRtrhH9zUgw== X-Spam-Status: No, score=-12.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1762912127919531603?= X-GMAIL-MSGID: =?utf-8?q?1762912127919531603?= Dear all, the testcase in the PR by Gerhard exhibited a mis-treatment of the function decl of the entry master if the function result had a pointer attribute and the translation unit was compiled with -ff2c. We actually should not use the peculiar special treatment for default-real functions in that case, as -ff2c is reserved for function results that can be expressed in Fortran77, and POINTER was not allowed in that standard. Same for complex. Furthermore, it turned out that ALLOCATABLE function results were not yet handled for functions with entries, even without -ff2c. Adding support for this was straightforward. I also fixed a potential buffer overflow for a generated internal symbol. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald From 60e81b97cf3715347de30ed4fd579be54fdb1997 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 11 Apr 2023 21:44:20 +0200 Subject: [PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312] gcc/fortran/ChangeLog: PR fortran/104312 * resolve.cc (resolve_entries): Handle functions with ENTRY and ALLOCATABLE results. * trans-expr.cc (gfc_conv_procedure_call): Functions with a result with the POINTER or ALLOCATABLE attribute shall not get any special treatment with -ff2c, as they cannot be written in Fortran 77. * trans-types.cc (gfc_return_by_reference): Likewise. (gfc_get_function_type): Likewise. gcc/testsuite/ChangeLog: PR fortran/104312 * gfortran.dg/entry_26.f90: New test. * gfortran.dg/entry_27.f90: New test. --- gcc/fortran/resolve.cc | 19 +++++++- gcc/fortran/trans-expr.cc | 2 + gcc/fortran/trans-types.cc | 4 ++ gcc/testsuite/gfortran.dg/entry_26.f90 | 64 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/entry_27.f90 | 64 ++++++++++++++++++++++++++ 5 files changed, 152 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/entry_26.f90 create mode 100644 gcc/testsuite/gfortran.dg/entry_27.f90 diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 6e42397c2ea..58013d48dff 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -702,7 +702,8 @@ resolve_entries (gfc_namespace *ns) gfc_code *c; gfc_symbol *proc; gfc_entry_list *el; - char name[GFC_MAX_SYMBOL_LEN + 1]; + /* Provide sufficient space to hold "master.%d.%s". */ + char name[GFC_MAX_SYMBOL_LEN + 1 + 18]; static int master_count = 0; if (ns->proc_name == NULL) @@ -827,6 +828,9 @@ resolve_entries (gfc_namespace *ns) "entries returning variables of different " "string lengths", ns->entries->sym->name, &ns->entries->sym->declared_at); + else if (el->sym->result->attr.allocatable + != ns->entries->sym->result->attr.allocatable) + break; } if (el == NULL) @@ -838,6 +842,8 @@ resolve_entries (gfc_namespace *ns) gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL); if (sym->attr.pointer) gfc_add_pointer (&proc->attr, NULL); + if (sym->attr.allocatable) + gfc_add_allocatable (&proc->attr, NULL); } else { @@ -869,6 +875,17 @@ resolve_entries (gfc_namespace *ns) "FUNCTION %s at %L", sym->name, ns->entries->sym->name, &sym->declared_at); } + else if (sym->attr.allocatable) + { + if (el == ns->entries) + gfc_error ("FUNCTION result %s cannot be ALLOCATABLE in " + "FUNCTION %s at %L", sym->name, + ns->entries->sym->name, &sym->declared_at); + else + gfc_error ("ENTRY result %s cannot be ALLOCATABLE in " + "FUNCTION %s at %L", sym->name, + ns->entries->sym->name, &sym->declared_at); + } else { ts = &sym->ts; diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index f052d6b9440..79367fa2ae0 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7800,6 +7800,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, */ if (flag_f2c && sym->ts.type == BT_REAL && sym->ts.kind == gfc_default_real_kind + && !sym->attr.pointer + && !sym->attr.allocatable && !sym->attr.always_explicit) se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr); diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 9c9489a42bd..fc5c221a301 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -2962,6 +2962,8 @@ gfc_return_by_reference (gfc_symbol * sym) require an explicit interface, as no compatibility problems can arise there. */ if (flag_f2c && sym->ts.type == BT_COMPLEX + && !sym->attr.pointer + && !sym->attr.allocatable && !sym->attr.intrinsic && !sym->attr.always_explicit) return 1; @@ -3273,6 +3275,8 @@ arg_type_list_done: type = gfc_get_mixed_entry_union (sym->ns); else if (flag_f2c && sym->ts.type == BT_REAL && sym->ts.kind == gfc_default_real_kind + && !sym->attr.pointer + && !sym->attr.allocatable && !sym->attr.always_explicit) { /* Special case: f2c calling conventions require that (scalar) diff --git a/gcc/testsuite/gfortran.dg/entry_26.f90 b/gcc/testsuite/gfortran.dg/entry_26.f90 new file mode 100644 index 00000000000..018aedc7854 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_26.f90 @@ -0,0 +1,64 @@ +! { dg-do run } +! { dg-additional-options "-fno-f2c" } +! +! PR fortran/104312 - ICE in fold_convert_loc with entry, -ff2c: control +! Contributed by G.Steinmetz + +module m + implicit none +contains + function f() + real, pointer :: f, e + real, target :: a(2) = [1,2] + f => a(1) + return + entry e() + e => a(2) + end + function g() + complex, pointer :: g,h + complex, target :: a(2) = [3,4] + g => a(1) + return + entry h() + h => a(2) + end + function f3() + real, allocatable :: f3, e3 + allocate (f3, source=1.0) + return + entry e3() + allocate (e3, source=2.0) + end + function g3() + complex, allocatable :: g3, h3 + allocate (g3, source=(3.0,0.0)) + return + entry h3() + allocate (h3, source=(4.0,0.0)) + end +end + +program p + use m + real, pointer :: x + complex, pointer :: c + real :: y + complex :: d + x => f() + if (x /= 1.0) stop 1 + x => e() + if (x /= 2.0) stop 2 + c => g() + if (c /= (3.0,0.0)) stop 3 + c => h() + if (c /= (4.0,0.0)) stop 4 + y = f3() + if (y /= 1.0) stop 5 + y = e3() + if (y /= 2.0) stop 6 + d = g3() + if (d /= (3.0,0.0)) stop 7 + d = h3() + if (d /= (4.0,0.0)) stop 8 +end diff --git a/gcc/testsuite/gfortran.dg/entry_27.f90 b/gcc/testsuite/gfortran.dg/entry_27.f90 new file mode 100644 index 00000000000..f1e28fda935 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_27.f90 @@ -0,0 +1,64 @@ +! { dg-do run } +! { dg-additional-options "-ff2c" } +! +! PR fortran/104312 - ICE in fold_convert_loc with entry, -ff2c: test +! Contributed by G.Steinmetz + +module m + implicit none +contains + function f() + real, pointer :: f, e + real, target :: a(2) = [1,2] + f => a(1) + return + entry e() + e => a(2) + end + function g() + complex, pointer :: g,h + complex, target :: a(2) = [3,4] + g => a(1) + return + entry h() + h => a(2) + end + function f3() + real, allocatable :: f3, e3 + allocate (f3, source=1.0) + return + entry e3() + allocate (e3, source=2.0) + end + function g3() + complex, allocatable :: g3, h3 + allocate (g3, source=(3.0,0.0)) + return + entry h3() + allocate (h3, source=(4.0,0.0)) + end +end + +program p + use m + real, pointer :: x + complex, pointer :: c + real :: y + complex :: d + x => f() + if (x /= 1.0) stop 1 + x => e() + if (x /= 2.0) stop 2 + c => g() + if (c /= (3.0,0.0)) stop 3 + c => h() + if (c /= (4.0,0.0)) stop 4 + y = f3() + if (y /= 1.0) stop 5 + y = e3() + if (y /= 2.0) stop 6 + d = g3() + if (d /= (3.0,0.0)) stop 7 + d = h3() + if (d /= (4.0,0.0)) stop 8 +end -- 2.35.3