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