1! PR 54753 2! { dg-do compile } 3! 4! TS 29113 5! C535c If an assumed-size or nonallocatable nonpointer assumed-rank 6! array is an actual argument corresponding to a dummy argument that 7! is an INTENT(OUT) assumed-rank array, it shall not be [...] 8! of a type for which default initialization is specified. 9! 10! This constraint is numbered C839 in the Fortran 2018 standard. 11! 12! This test file contains tests that are expected to issue diagnostics 13! for invalid code. 14 15module m 16 17 type :: t1 18 integer :: id 19 real :: xyz(3) 20 integer :: tag = -1 21 end type 22 23contains 24 25 subroutine finalize_t1 (obj) 26 type(t1) :: obj 27 end subroutine 28 29 subroutine s1 (x, y) 30 type(t1) :: x(..) 31 type(t1), intent(out) :: y(..) 32 end subroutine 33 34 ! This call should be OK as it does not involve assumed-size or 35 ! assumed-rank actual arguments. 36 subroutine test_known_size (a1, a2, n) 37 integer :: n 38 type(t1) :: a1(n,n), a2(n) 39 40 call s1 (a1, a2) 41 end subroutine 42 43 ! Calls with an assumed-size array argument should be rejected. 44 subroutine test_assumed_size (a1, a2) 45 type(t1) :: a1(*), a2(*) 46 47 call s1 (a1, a2) ! { dg-error "(A|a)ssumed.rank" } 48 end subroutine 49 50 ! This call should be OK. 51 subroutine test_assumed_rank_pointer (a1, a2) 52 type(t1), pointer :: a1(..), a2(..) 53 54 call s1 (a1, a2) 55 end subroutine 56 57 ! This call should be OK. 58 subroutine test_assumed_rank_allocatable (a1, a2) 59 type(t1), allocatable :: a1(..), a2(..) 60 61 call s1 (a1, a2) 62 end subroutine 63 64 ! The call should be rejected with a nonallocatable nonpointer 65 ! assumed-rank actual argument. 66 subroutine test_assumed_rank_plain (a1, a2) 67 type(t1) :: a1(..), a2(..) 68 69 call s1 (a1, a2) ! { dg-error "(A|a)ssumed.rank" } 70 end subroutine 71 72end module 73