1! { dg-do compile }
2! { dg-options "-std=f2003 -Wintrinsic-shadow -fall-intrinsics" }
3
4! PR fortran/33141
5! Check that the expected warnings are emitted if a user-procedure has the same
6! name as an intrinsic, with -fall-intrinsics even regardless of std=*.
7
8MODULE testmod
9  IMPLICIT NONE
10
11CONTAINS
12
13  ! ASINH is one but not in F2003
14  REAL FUNCTION asinh (arg) ! { dg-warning "shadow the intrinsic" }
15    IMPLICIT NONE
16    REAL :: arg
17  END FUNCTION asinh
18
19END MODULE testmod
20
21! ACOSH not for F2003
22REAL FUNCTION acosh (arg) ! { dg-warning "of an intrinsic" }
23  IMPLICIT NONE
24  REAL :: arg
25END FUNCTION acosh
26
27! We do only compile, so no main program needed.
28