mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-11 09:40:33 +08:00
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.
This commit is contained in:
parent
5976fbf9d5
commit
59f6dea963
@ -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))))
|
||||
|
14
gcc/testsuite/gfortran.dg/assumed_type_16.f90
Normal file
14
gcc/testsuite/gfortran.dg/assumed_type_16.f90
Normal file
@ -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
|
18
gcc/testsuite/gfortran.dg/assumed_type_17.f90
Normal file
18
gcc/testsuite/gfortran.dg/assumed_type_17.f90
Normal file
@ -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" } }
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user