1! { dg-do compile }
2! { dg-options "-std=f2008" }
3
4! PR fortran/45197
5! Check for errors with IMPURE.
6
7! Contributed by Daniel Kraft, d@domob.eu.
8
9MODULE m
10  IMPLICIT NONE
11
12CONTAINS
13
14  IMPURE PURE SUBROUTINE foobar () ! { dg-error "must not appear both" }
15
16  PURE ELEMENTAL IMPURE FUNCTION xyz () ! { dg-error "must not appear both" }
17
18  IMPURE ELEMENTAL SUBROUTINE mysub ()
19  END SUBROUTINE mysub
20
21  PURE SUBROUTINE purified ()
22    CALL mysub () ! { dg-error "is not PURE" }
23  END SUBROUTINE purified
24
25END MODULE m
26