1! { dg-do compile }
2! { dg-options "-Wno-intrinsic-shadow -fall-intrinsics" }
3
4! PR fortran/33141
5! Check that the "intrinsic shadow" warnings are not emitted if the warning
6! is negated.
7
8MODULE testmod
9  IMPLICIT NONE
10
11CONTAINS
12
13  REAL FUNCTION asin (arg) ! { dg-bogus "shadow the intrinsic" }
14    IMPLICIT NONE
15    REAL :: arg
16  END FUNCTION asin
17
18END MODULE testmod
19
20REAL FUNCTION acos (arg) ! { dg-bogus "of an intrinsic" }
21  IMPLICIT NONE
22  REAL :: arg
23END FUNCTION acos
24
25! We do only compile, so no main program needed.
26