1! { dg-do compile }
2! { dg-options "-Wimplicit-procedure" }
3
4! PR fortran/22552
5! Check for correct -Wimplicit-procedure warnings.
6
7MODULE m
8
9CONTAINS
10
11  SUBROUTINE my_sub ()
12  END SUBROUTINE my_sub
13
14  INTEGER FUNCTION my_func ()
15    my_func = 42
16  END FUNCTION my_func
17
18END MODULE m
19
20SUBROUTINE test (proc)
21  IMPLICIT NONE
22  CALL proc () ! { dg-bogus "is not explicitly declared" }
23END SUBROUTINE test
24
25PROGRAM main
26  USE m
27  EXTERNAL :: ext_sub
28  EXTERNAL :: test
29  INTEGER :: ext_func
30
31  CALL ext_sub () ! { dg-bogus "is not explicitly declared" }
32  PRINT *, ext_func () ! { dg-bogus "is not explicitly declared" }
33  PRINT *, implicit_func () ! { dg-bogus "is not explicitly declared" }
34  CALL my_sub () ! { dg-bogus "is not explicitly declared" }
35  PRINT *, my_func () ! { dg-bogus "is not explicitly declared" }
36  PRINT *, SIN (3.14159) ! { dg-bogus "is not explicitly declared" }
37
38  CALL undef_sub (1, 2, 3) ! { dg-warning "is not explicitly declared" }
39  ! Can't check undefined function, because it needs to be declared a type
40  ! in any case (and the implicit type is enough to not trigger this warning).
41END PROGRAM
42