1! { dg-do compile }
2!
3! PR fortran/58099
4!
5! See also interpretation request F03-0130 in 09-217 and 10-006T5r1.
6!
7! - ELEMENTAL is only permitted for external names with PROCEDURE/INTERFACE
8!   but not for dummy arguments or proc-pointers
9! - Using PROCEDURE with an elemental intrinsic as interface name a is valid,
10! but doesn't make the proc-pointer/dummy argument elemental
11!
12
13  interface
14    elemental real function x(y)
15      real, intent(in) :: y
16    end function x
17  end interface
18  intrinsic :: sin
19  procedure(x) :: xx1 ! OK
20  procedure(x), pointer :: xx2 ! { dg-error "Procedure pointer 'xx2' at .1. shall not be elemental" }
21  procedure(real), pointer :: pp
22  procedure(sin) :: bar ! OK
23  procedure(sin), pointer :: foo ! { dg-error "Procedure pointer 'foo' at .1. shall not be elemental" }
24  pp => sin !OK
25contains
26  subroutine sub1(z) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" }
27    procedure(x) :: z
28  end subroutine sub1
29  subroutine sub2(z) ! { dg-error "Procedure pointer 'z' at .1. shall not be elemental" }
30    procedure(x), pointer :: z
31  end subroutine sub2
32  subroutine sub3(z)
33    interface
34      elemental real function z(y) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" }
35        real, intent(in) :: y
36      end function z
37    end interface
38  end subroutine sub3
39  subroutine sub4(z)
40    interface
41      elemental real function z(y) ! { dg-error "Procedure pointer 'z' at .1. shall not be elemental" }
42        real, intent(in) :: y
43      end function z
44    end interface
45    pointer :: z
46  end subroutine sub4
47  subroutine sub5(z) ! { dg-error "Dummy procedure 'z' at .1. shall not be elemental" }
48    procedure(sin) :: z
49  end subroutine sub5
50end
51