1! { dg-do compile }
2
3! Check for constraints restricting arguments of ELEMENTAL procedures.
4
5! Contributed by Daniel Kraft, d@domob.eu.
6
7PROGRAM main
8  IMPLICIT NONE
9
10CONTAINS
11
12  IMPURE ELEMENTAL SUBROUTINE foobar &
13    (a, & ! { dg-error "must be scalar" }
14     b, & ! { dg-error "POINTER attribute" }
15     c, & ! { dg-error "ALLOCATABLE attribute" }
16     d) ! { dg-error "must have its INTENT specified or have the VALUE attribute" }
17    INTEGER, INTENT(IN) :: a(:)
18    INTEGER, POINTER, INTENT(IN) :: b
19    INTEGER, ALLOCATABLE, INTENT(IN) :: c
20    INTEGER :: d
21  END SUBROUTINE foobar
22
23END PROGRAM main
24