From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 3A4DB3858C2F; Tue, 20 Sep 2022 21:06:51 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3A4DB3858C2F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1663708014; bh=16gL1p8qZIunAqK8jvti7Hk8dbAzwRn/+q2l3tHxogg=; h=From:To:Subject:Date:From; b=xX8QCm4S/wQsx1Q5oCZSXrHytQF0qJal2DAPn/o1QSs3dkFicPWTXgbFBtAGM6ikX pcY2g4o9M89RoyM6na8P6LL1nS55HfONyhzQEJ4LyF6cS0NswXf9r+5nRx/y9RcHSR XYwHq2j36XBm1r07mdcAX6TZVHnP1h6mXg+4vglE= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-2748] Fortran: F2018 type(*), dimension(*) with scalars [PR104143] X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/master X-Git-Oldrev: 5976fbf9d5dd9542fcb82eebb2185886fd52d000 X-Git-Newrev: 59f6dea963b5f7a6b9ced325200359b4831e7fa7 Message-Id: <20220920210654.3A4DB3858C2F@sourceware.org> Date: Tue, 20 Sep 2022 21:06:51 +0000 (GMT) List-Id: https://gcc.gnu.org/g:59f6dea963b5f7a6b9ced325200359b4831e7fa7 commit r13-2748-g59f6dea963b5f7a6b9ced325200359b4831e7fa7 Author: Tobias Burnus Date: Tue Sep 20 23:06:19 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. Diff: --- 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