From patchwork Tue Sep 20 11:51:13 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 57801 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 E6B9E3857C4D for ; Tue, 20 Sep 2022 11:51:55 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 796733858D28; Tue, 20 Sep 2022 11:51:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 796733858D28 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.93,330,1654588800"; d="diff'?scan'208,217";a="83185334" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 20 Sep 2022 03:51:20 -0800 IronPort-SDR: kBu2ue2vFRpANb6U4UsUyFjD07mWP+bos5llJiG+pU1eOLkVeY/rAx78wnVSdVBgb39ptVCXVU jiAIM0ICsJxTuSf3uJfcK2vnxmZYsPK+Q0cjwDZr57B5WsrmWyWmaeA7fIPV1ig83Rov/GlLtb b4ya9EzfpRJMU0P27KdyJAJ0dbAK13q5nQUsc5/RDxjsis5a3gT1gDkl9oujCGN7mcea1+9OlL S4oeq1m+k8EoaXc2QsHJYYXQkk7jERnHDLFWJq8oUrxQv5XB48X5sVm+8SufBMVt69z/F3TBMm eZU= Message-ID: <86200df9-4b14-11ca-05db-1d033870f537@codesourcery.com> Date: Tue, 20 Sep 2022 13:51:13 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.2.2 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch] Fortran: F2018 type(*),dimension(*) with scalars [PR104143] X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, HTML_MESSAGE, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, 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-Content-Filtered-By: Mailman/MimeDel 2.1.29 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" In several cases, one just wants to have the address where an object starts without requiring the detour via 'c_loc' and the (locally) required 'target' attribute. In principle, type(*),dimension(*) of TS29113 permits this, except that 'dimension(*)' only permits arrays and array elements but not scalars. Fortran 2018 modified this such that with 'type(*)' also scalars are permitted. (See PR for the quotes.) This patch implements this simple change. Before, implementations like MPI had to use '!GCC$ attribute NO_ARG_CHECK ::' in addition to type(*),dimension(*) to achieve this. In GCC, we do likewise, but that's at least inside the compiler, cf. libgomp/openacc{.f90,_lib.h}. OK for mainline? Tobias PS: I know that there are still patches to be reviewed; I am not sure wrt IEEE but I think most of the clobber patches still need a review and likely also some of Harald's patches. I think we also need to take care of some more of the ready or nearly ready patches by José. (I somewhere have a list that could dig it out quickly, if someone want to do some work on this. However, some were already handled by Harald.) Unfortunately, I am currently too busy with other things (OpenMP, looking at issues in mostly OpenMP-related testsuites, OpenMP spec issues, a bunch of odd things) to really work on Fortran, especially as too many of the other listed items are likewise non-primary work items and I shouldn't really keep increasing the time spend on work-related-but-not-to-be-focused-on items... Otherwise: Last weekend was the GNU Tools Cauldron, https://gcc.gnu.org/wiki/cauldron2022 A few slides are already online (including mine) and the recordings should become available soon, in case you are interested. ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 Fortran: F2018 type(*),dimension(*) with scalars [PR104143] Assumed-size dummy arguments accept arrays and array elements as actual arguments. There are also a few exceptions when real scalars are permitted. Since F2018, this includes scalar arguments to assumed-type dummies; while type(*) was added in TS29113, this change is only in F2018 itself. PR fortran/104143 gcc/fortran/ChangeLog: * interface.cc (compare_parameter): Permit scalar args to 'type(*), dimension(*)'. gcc/testsuite/ChangeLog: * gfortran.dg/c-interop/c407b-2.f90: Remove dg-error. * gfortran.dg/assumed_type_16.f90: New test. * gfortran.dg/assumed_type_17.f90: New test. gcc/fortran/interface.cc | 11 ++++++++++- gcc/testsuite/gfortran.dg/assumed_type_16.f90 | 14 ++++++++++++++ gcc/testsuite/gfortran.dg/assumed_type_17.f90 | 18 ++++++++++++++++++ gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 | 2 +- 4 files changed, 43 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 71eec78259b..d3e199535b3 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -2692,7 +2692,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, - if the actual argument is (a substring of) an element of a non-assumed-shape/non-pointer/non-polymorphic array; or - (F2003) if the actual argument is of type character of default/c_char - kind. */ + kind. + - (F2018) if the dummy argument is type(*). */ is_pointer = actual->expr_type == EXPR_VARIABLE ? actual->symtree->n.sym->attr.pointer : false; @@ -2759,6 +2760,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (ref == NULL && actual->expr_type != EXPR_NULL) { + if (actual->rank == 0 + && formal->ts.type == BT_ASSUMED + && formal->as + && formal->as->type == AS_ASSUMED_SIZE) + /* This is new in F2018, type(*) is new in TS29113, but gfortran does + not differentiate. Thus, if type(*) exists, it is valid; + otherwise, type(*) is already rejected. */ + return true; if (where && (!formal->attr.artificial || (!formal->maybe_array && !maybe_dummy_array_arg (actual)))) diff --git a/gcc/testsuite/gfortran.dg/assumed_type_16.f90 b/gcc/testsuite/gfortran.dg/assumed_type_16.f90 new file mode 100644 index 00000000000..52d8ef5ea20 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_16.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2008" } +! +! PR fortran/104143 +! + interface + subroutine foo(x) + type(*) :: x(*) ! { dg-error "Fortran 2018: Assumed type" } + end + end interface + integer :: a + call foo(a) ! { dg-error "Type mismatch in argument" } + call foo((a)) ! { dg-error "Type mismatch in argument" } +end diff --git a/gcc/testsuite/gfortran.dg/assumed_type_17.f90 b/gcc/testsuite/gfortran.dg/assumed_type_17.f90 new file mode 100644 index 00000000000..d6ccd3058ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_type_17.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2018 -fdump-tree-original" } +! +! PR fortran/104143 +! + interface + subroutine foo(x) + type(*) :: x(*) + end + end interface + integer :: a + call foo(a) + call foo((a)) +end + +! { dg-final { scan-tree-dump-times "foo \\(&a\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = a;" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo \\(&D.\[0-9\]+\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 index 4f9f6c73d7d..49352fc9d71 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/c407b-2.f90 @@ -40,7 +40,7 @@ subroutine s0 (x) call g (x, 1) call f (x, 1) ! { dg-error "Type mismatch" } - call h (x, 1) ! { dg-error "Rank mismatch" } + call h (x, 1) ! Scalar to type(*),dimension(*): Invalid in TS29113 but valid since F2018 end subroutine ! Check that you can't use an assumed-type array variable in an array