1! { dg-do compile }
2! { dg-options "-frecursive" }
3
4! PR fortran/37779
5! Check that -frecursive allows using procedures in as procedure expressions.
6
7MODULE m
8  IMPLICIT NONE
9
10CONTAINS
11
12  SUBROUTINE test ()
13    IMPLICIT NONE
14    PROCEDURE(test), POINTER :: procptr
15
16    CALL bar (test) ! { dg-bogus "Non-RECURSIVE" }
17    procptr => test ! { dg-bogus "Non-RECURSIVE" }
18  END SUBROUTINE test
19
20  INTEGER FUNCTION func ()
21    ! Using a result variable is ok of course!
22    func = 42 ! { dg-bogus "Non-RECURSIVE" }
23  END FUNCTION func
24
25END MODULE m
26