From patchwork Thu Nov 30 21:06:10 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 81057 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C24EB385DC3D for ; Thu, 30 Nov 2023 21:06:28 +0000 (GMT) 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.17.20]) by sourceware.org (Postfix) with ESMTPS id 15069385E010; Thu, 30 Nov 2023 21:06:11 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 15069385E010 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 15069385E010 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.20 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1701378373; cv=none; b=u6juFZvO/BXXOkh0Pqv3VItQJ3UBfyYANz4/A7KwyEBrpHF7HlZs37dC/H2HYN93nKWX7Q+uafDRzuZOtPn9n4xEdFKLI5CYktdwKgxcuB9/LIJYrDKqOTaRb4pAsH3a2gt9yjOcdsNQzHDvJAXsHJTpw7HZFJR0RM+sNjTDVn8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1701378373; c=relaxed/simple; bh=vuaHgdXOWvnQt/C5g5g7jvZ6XQPWmQzegboVpO/nnhY=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=fNxr/hHvLSeulHePR4SJeASyWhWL27oU7Lk6vUNQSAHc3IFFuuBrL+N/yefKMbCCJMw0i5KAKa9W0aKrd2Kx/5Lv+KoBGojdqgUVY3tyCfOfto71xlfvCMsSn+eTfRPW8ssI4QTGfGwAPcqiTXXDrOkojgA0X6IYfXD6D9sS428= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1701378370; x=1701983170; i=anlauf@gmx.de; bh=vuaHgdXOWvnQt/C5g5g7jvZ6XQPWmQzegboVpO/nnhY=; h=X-UI-Sender-Class:From:To:Subject:Date; b=euvfnVaX7w5Q8FJ2HLUCuim3Yj2s9bNQcNLejo52FVMg53n8tP2qsD0qAT8D7uDm OVJSlB3t1KGrFdZ82bnRMGu6nUe8lYQ1ktx/eq0dL+vZ6lU7BKcmc2NLUvOsZW29h tZHbfSfRHjjgwfTR6k1NthAprl4Dqlc6DORLcW3FzOv7E/EFz3y1HE2j0pRjLUUC3 nBZwfr3GPsZY8oCPkaNgRnp+mYKdRAPl+gt8LmtjAYXVwsxDdyTEvCDgSdVz+lxn9 OAh1krnqcGC8hf/D4hHg7hUT5xipXI8nZ1oJfrgV+/RpwWRa2Lg/iElZCB8Fg4nja V9PTDawhMkFs92hoQg== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.144.194] ([79.232.144.194]) by web-mail.gmx.net (3c-app-gmx-bap36.server.lan [172.19.172.106]) (via HTTP); Thu, 30 Nov 2023 22:06:10 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: copy-out for possibly missing OPTIONAL CLASS arguments [PR112772] Date: Thu, 30 Nov 2023 22:06:10 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:Q1MqpMdFA3kpCgXF/2tVCPglrTTQsfhB4Oxf3QSvw6VLEjpkDE0nIrTjqZYVPs0ozLQuJ 3sxTpvj3mCFMtGNQbnaR2RYYn+o+CABim+EE4Qihj+0D1QV3nEeHsW3au1GonpxVR40GVVAYQBiJ qsFze7Bmw3CyP8WF8HIgLyF7r3+KPpjijENLQMAXyfyI1NJdGVH685baPuaHAFupCag3H8WvZWrP /e96s3xrhTxB0T08C2p4252S6Tqu+hcwdzj4/cVormDuM0ptNWnBEiWqT45VlQUiv7z4SaAjqeqF XM= UI-OutboundReport: notjunk:1;M01:P0:A/NbNPQShw4=;Gc5iLapNLYD8a+O8rvWtd5fZ7Z7 +ueODUFOrQejWzwpvnw9ieAmU2MxDUBlilrKZsl2fWP+20pi4iAFz5fTbqAwe9EGVGf06k8E5 xzrL3ub0McUYnx/sZJE8qQpP6NgtaAQ62wg9O7B8NTBmirdDr7S2Cb9hVPx/DwjTv7FyD4RnC 7zaNu5Hb0cjbXdl+zKGULvB21L1RZaltocGTn4UBmzcZQ/HaJ/bgEXGvuHgShmhOqV6oRlWFc 5VE8nSLaVbW35n2YSAnFemAPv3ROL7pEeRwGEGF/9ICnxNh27fdQlv/4R5szTnr3sinxKICtS lzr/a6XuKgDBbjdcdu9Gxoo0kZJwyAIPoPNP73OJh3Z8GFcUPJ0VS7uUUd6ueBE5md9Ns3prC fxr1B3SZfRyi72ArAdiRoa1H9orlwYuXiYjUqz0ak7sSzXTFOL2L3/zuaSTJQeFtWMzrrfa4A MC94+D9IZaCgIxT6V2mItlR1hGxC/QnywpDwk4JrbDRKcy6WxDNZ8GxyrIHBFfEOCze4TUbbZ cst4KTl2d8gJEkPSEvbVcBaLoxWfAq/7hc+N27M1M0VhJYdUtqgTj3i+Tqn3vJZVrwO6WAI/o hysPRx1VNl4gApRtZWQ5B/w1dF0faSRAvH6v6nrn/tN4NEPa9Zyc5fYoISk73dRi9qEPK2B+K UHbnaGV1uoLqeVJsKUPcv9U6zjm80oRvBS1/szwkm+OluRHl10hJRcLKWgyo9xuTdF0JCpHtl PNwT7Zk941LSUAHaIbtP8VaHckiyqxKlxTeTywkOCpfKZlFKxi2A15r+9AxOeQyN0c8J78PxZ M1zCnBLIghMM2k2k8LVoEBow== X-Spam-Status: No, score=-10.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Dear all, the attached rather obvious patch fixes the first testcase of pr112772: we unconditionally generated copy-out code for optional class arguments, while the copy-in properly checked the presence of arguments. Regtested on x86_64-pc-linux-gnu. OK for mainline? (The second testcase is a different issue.) Thanks, Harald From 38433016def0337a72cb0ef0029cd2c05d702282 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 30 Nov 2023 21:53:21 +0100 Subject: [PATCH] Fortran: copy-out for possibly missing OPTIONAL CLASS arguments [PR112772] gcc/fortran/ChangeLog: PR fortran/112772 * trans-expr.cc (gfc_conv_class_to_class): Make copy-out conditional on the presence of an OPTIONAL CLASS argument passed to an OPTIONAL CLASS dummy. gcc/testsuite/ChangeLog: PR fortran/112772 * gfortran.dg/missing_optional_dummy_7.f90: New test. --- gcc/fortran/trans-expr.cc | 9 +++ .../gfortran.dg/missing_optional_dummy_7.f90 | 64 +++++++++++++++++++ 2 files changed, 73 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/missing_optional_dummy_7.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index bfe9996ced6..6a47af39c57 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1365,6 +1365,15 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, tmp = build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, tmp2); gfc_add_expr_to_block (&parmse->pre, tmp); + + if (!elemental && full_array && copyback) + { + tmp2 = build_empty_stmt (input_location); + tmp = gfc_finish_block (&parmse->post); + tmp = build3_loc (input_location, COND_EXPR, void_type_node, + cond, tmp, tmp2); + gfc_add_expr_to_block (&parmse->post, tmp); + } } else gfc_add_block_to_block (&parmse->pre, &block); diff --git a/gcc/testsuite/gfortran.dg/missing_optional_dummy_7.f90 b/gcc/testsuite/gfortran.dg/missing_optional_dummy_7.f90 new file mode 100644 index 00000000000..ad9ecd8f2b6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/missing_optional_dummy_7.f90 @@ -0,0 +1,64 @@ +! { dg-do run } +! PR fortran/112772 - test absent OPTIONAL, ALLOCATABLE/POINTER class dummies + +program main + implicit none + type t + end type t + call test_c_a () + call test_u_a () + call test_c_p () + call test_u_p () +contains + ! class, allocatable + subroutine test_c_a (msg1) + class(t), optional, allocatable :: msg1(:) + if (present (msg1)) stop 1 + call assert_c_a () + call assert_c_a (msg1) + end + + subroutine assert_c_a (msg2) + class(t), optional, allocatable :: msg2(:) + if (present (msg2)) stop 2 + end + + ! unlimited polymorphic, allocatable + subroutine test_u_a (msg1) + class(*), optional, allocatable :: msg1(:) + if (present (msg1)) stop 3 + call assert_u_a () + call assert_u_a (msg1) + end + + subroutine assert_u_a (msg2) + class(*), optional, allocatable :: msg2(:) + if (present (msg2)) stop 4 + end + + ! class, pointer + subroutine test_c_p (msg1) + class(t), optional, pointer :: msg1(:) + if (present (msg1)) stop 5 + call assert_c_p () + call assert_c_p (msg1) + end + + subroutine assert_c_p (msg2) + class(t), optional, pointer :: msg2(:) + if (present (msg2)) stop 6 + end + + ! unlimited polymorphic, pointer + subroutine test_u_p (msg1) + class(*), optional, pointer :: msg1(:) + if (present (msg1)) stop 7 + call assert_u_p () + call assert_u_p (msg1) + end + + subroutine assert_u_p (msg2) + class(*), optional, pointer :: msg2(:) + if (present (msg2)) stop 8 + end +end -- 2.35.3