1! { dg-do run }
2! { dg-options "-std=f95 -Wno-intrinsics-std" }
3
4! PR fortran/33141
5! Check that calls to intrinsics not in the current standard are "allowed" and
6! linked to external procedures with that name.
7! Addionally, this checks that -Wno-intrinsics-std turns off the warning.
8
9SUBROUTINE abort ()
10  IMPLICIT NONE
11  WRITE (*,*) "Correct"
12END SUBROUTINE abort
13
14REAL FUNCTION asinh (arg)
15  IMPLICIT NONE
16  REAL :: arg
17
18  WRITE (*,*) "Correct"
19  asinh = arg
20END FUNCTION asinh
21
22SUBROUTINE implicit_none
23  IMPLICIT NONE
24  REAL :: asinh ! { dg-bogus "Fortran 2008" }
25  REAL :: x
26
27  ! Both times our version above should be called
28  CALL abort () ! { dg-bogus "extension" }
29  x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
30END SUBROUTINE implicit_none
31
32SUBROUTINE implicit_type
33  ! ASINH has implicit type here
34  REAL :: x
35
36  ! Our version should be called
37  x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
38END SUBROUTINE implicit_type
39
40PROGRAM main
41  ! This should give a total of three "Correct"s
42  CALL implicit_none ()
43  CALL implicit_type ()
44END PROGRAM main
45
46! { dg-output "Correct\.*Correct\.*Correct" }
47