From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id DE35F3857409; Fri, 23 Sep 2022 08:48:28 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DE35F3857409 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1663922908; bh=kJdA0TllRDG4KkboMJNp1CdPU9ABfSvAl0OU0nsTLnc=; h=From:To:Subject:Date:From; b=FZ/BQCSIUplqI9Z8Dp7Pw4LMD27D1X1Ri7+cEC0EIyl03YYrdq/ed6E7Jb9Tlqux/ Zjen5x7p23392e4TSyq7z+T6duLrpg/BvRr8e1yT/ll7ruuS9fbGg+UVDyCvw1zA7b j9OC8IzaryU+KlxpxHbg0WfPjUnUrSnMQjNfFfeo= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-12] Fortran: F2018 type(*), dimension(*) with scalars [PR104143] X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-12 X-Git-Oldrev: ccd3d15a5c27ecbfc5b244eeee30a5846fa0f979 X-Git-Newrev: ff46d9d669266820560423c5791d8fa1a921756a Message-Id: <20220923084828.DE35F3857409@sourceware.org> Date: Fri, 23 Sep 2022 08:48:28 +0000 (GMT) List-Id: https://gcc.gnu.org/g:ff46d9d669266820560423c5791d8fa1a921756a commit ff46d9d669266820560423c5791d8fa1a921756a Author: Tobias Burnus Date: Fri Sep 23 09:55:07 2022 +0200 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. (cherry picked from commit 59f6dea963b5f7a6b9ced325200359b4831e7fa7) Diff: --- gcc/fortran/ChangeLog.omp | 9 +++++++++ gcc/fortran/interface.cc | 11 ++++++++++- gcc/testsuite/ChangeLog.omp | 10 ++++++++++ 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 +- 6 files changed, 62 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 8c89cd5bd43..923a46312a9 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,12 @@ +2022-09-23 Tobias Burnus + + Backport from mainline: + 2022-09-20 Tobias Burnus + + PR fortran/104143 + * interface.cc (compare_parameter): Permit scalar args to + 'type(*), dimension(*)'. + 2022-09-09 Tobias Burnus Backport from mainline: 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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index e0c8c138620..7b085e8254e 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,13 @@ +2022-09-23 Tobias Burnus + + Backport from mainline: + 2022-09-20 Tobias Burnus + + PR fortran/104143 + * 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. + 2022-09-09 Paul-Antoine Arras Backport from mainline: 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