1! RUN: %python %S/test_errors.py %s %flang_fc1
2! 15.5.1 procedure reference constraints and restrictions
3
4subroutine s01(elem, subr)
5  interface
6    !ERROR: A dummy procedure may not be ELEMENTAL
7    elemental real function elem(x)
8      real, intent(in), value :: x
9    end function
10    subroutine subr(dummy)
11      procedure(sin) :: dummy
12    end subroutine
13    subroutine badsubr(dummy)
14      import :: elem
15      !ERROR: A dummy procedure may not be ELEMENTAL
16      procedure(elem) :: dummy
17    end subroutine
18    subroutine optionalsubr(dummy)
19      procedure(sin), optional :: dummy
20    end subroutine
21    subroutine ptrsubr(dummy)
22      procedure(sin), pointer, intent(in) :: dummy
23    end subroutine
24  end interface
25  intrinsic :: cos
26  call subr(cos) ! not an error
27  !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
28  call subr(elem) ! C1533
29  !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer
30  call subr(null())
31  call optionalsubr(null()) ! ok
32  call ptrsubr(null()) ! ok
33  !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless
34  call subr(B"1010")
35end subroutine
36
37subroutine s02
38  !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
39  call sub(elem)
40 contains
41  elemental integer function elem()
42    elem = 1
43  end function
44end
45
46module m01
47  procedure(sin) :: elem01
48  interface
49    elemental real function elem02(x)
50      real, value :: x
51    end function
52    subroutine callme(f)
53      external f
54    end subroutine
55  end interface
56 contains
57  elemental real function elem03(x)
58    real, value :: x
59  end function
60  subroutine test
61    intrinsic :: cos
62    call callme(cos) ! not an error
63    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument
64    call callme(elem01) ! C1533
65    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem02' may not be passed as an actual argument
66    call callme(elem02) ! C1533
67    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem03' may not be passed as an actual argument
68    call callme(elem03) ! C1533
69    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem04' may not be passed as an actual argument
70    call callme(elem04) ! C1533
71   contains
72    elemental real function elem04(x)
73      real, value :: x
74    end function
75  end subroutine
76end module
77
78module m02
79  type :: t
80    integer, pointer :: ptr
81  end type
82  type(t) :: coarray[*]
83 contains
84  subroutine callee(x)
85    type(t), intent(in) :: x
86  end subroutine
87  subroutine test
88    !ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='
89    call callee(coarray[1]) ! C1537
90  end subroutine
91end module
92
93module m03
94 contains
95  subroutine test
96    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
97    call sub(elem)
98   contains
99    elemental integer function elem()
100      elem = 1
101    end function
102  end
103end
104
105program p03
106  logical :: l
107  call s1(index)
108  l = index .eq. 0  ! index is an object entity, not an intrinsic
109  call s2(sin)
110  !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
111  call s3(cos)
112contains
113  subroutine s2(x)
114    real :: x
115  end
116  subroutine s3(p)
117    procedure(real) :: p
118  end
119end
120
121subroutine p04
122  implicit none
123  !ERROR: No explicit type declared for 'index'
124  call s1(index)
125end
126
127subroutine p05
128  integer :: a1(2), a2, a3
129  !ERROR: In an elemental procedure reference with at least one array argument, actual argument a2 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array
130  !ERROR: In an elemental procedure reference with at least one array argument, actual argument a3 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array
131  call s1(a1, a2, a3)
132contains
133  elemental subroutine s1(a, b, c)
134    integer, intent(in) :: a
135    integer, intent(out) :: b
136    integer, intent(inout) :: c
137    b = a
138    c = a
139  end
140end
141