1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3!
4! PR fortran/48820
5!
6! Assumed-rank constraint checks and other diagnostics
7!
8
9subroutine foo(x) ! { dg-error "Assumed-type variable x at .1. may not have the INTENT.OUT. attribute" }
10  type(*), intent(out) :: x
11end subroutine
12
13subroutine bar(x)
14  integer, intent(out) :: x(..)
15end subroutine bar
16
17subroutine foo3(y)
18  integer :: y(..)
19  y = 7           ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
20  print *, y + 10 ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
21  print *, y      ! { dg-error "Assumed-rank variable y at .1. may only be used as actual argument" }
22end subroutine
23
24subroutine foo2(x, y)
25  integer :: x(..), y(..)
26  call valid3(x(:)) ! { dg-error "Assumed-rank variable x at .1. shall not have a subobject reference" }
27contains
28  subroutine valid3(y)
29    integer :: y(..)
30  end subroutine
31end subroutine
32
33subroutine foo4(x)
34  integer, codimension[*] :: x(..) ! { dg-error "The assumed-rank array at .1. shall not have a codimension" }
35end subroutine
36
37subroutine foo5(y) ! { dg-error "may not have the VALUE or CODIMENSION attribute" }
38  integer :: y(..)[*]
39end subroutine
40