1! { dg-do compile }
2! { dg-options "-std=legacy" }
3! We want to check for statement functions, thus legacy mode.
4
5! Check for errors with declarations not allowed within BLOCK.
6
7SUBROUTINE proc (a)
8  IMPLICIT NONE
9  INTEGER :: a
10
11  BLOCK
12    INTENT(IN) :: a ! { dg-error "not allowed inside of BLOCK" }
13    VALUE :: a ! { dg-error "not allowed inside of BLOCK" }
14    OPTIONAL :: a ! { dg-error "not allowed inside of BLOCK" }
15  END BLOCK
16END SUBROUTINE proc
17
18PROGRAM main
19  IMPLICIT NONE
20
21  BLOCK
22    IMPLICIT INTEGER(a-z) ! { dg-error "not allowed inside of BLOCK" }
23    INTEGER :: a, b, c, d
24    INTEGER :: stfunc
25    stfunc(a, b) = a + b ! { dg-error "not allowed inside of BLOCK" }
26    EQUIVALENCE (a, b) ! { dg-error "not allowed inside of BLOCK" }
27    NAMELIST /NLIST/ a, b ! { dg-error "not allowed inside of BLOCK" }
28    COMMON /CBLOCK/ c, d ! { dg-error "not allowed inside of BLOCK" }
29  ! This contains is in the specification part.
30  CONTAINS ! { dg-error "Unexpected CONTAINS statement" }
31  END BLOCK
32
33  BLOCK
34    PRINT *, "Hello, world"
35  ! This one in the executable statement part.
36  CONTAINS ! { dg-error "Unexpected CONTAINS statement" }
37  END BLOCK
38END PROGRAM main
39