1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
! { dg-do compile }
! { dg-options "-pedantic" }
! Check the fix for PR20893, in which actual arguments could violate:
! "(5) If it is an array, it shall not be supplied as an actual argument to
! an elemental procedure unless an array of the same rank is supplied as an
! actual argument corresponding to a nonoptional dummy argument of that
! elemental procedure." (12.4.1.5)
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
CALL T1(1,2)
CONTAINS
SUBROUTINE T1(A1,A2,A3)
INTEGER :: A1,A2, A4(2), A5(2)
INTEGER, OPTIONAL :: A3(2)
interface
elemental function efoo (B1,B2,B3) result(bar)
INTEGER, intent(in) :: B1, B2
integer :: bar
INTEGER, OPTIONAL, intent(in) :: B3
end function efoo
end interface
! check an intrinsic function
write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
write(6,*) MAX(A1,A3,A2)
write(6,*) MAX(A1,A4,A3)
! check an internal elemental function
write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
write(6,*) foo(A1,A3,A2)
write(6,*) foo(A1,A4,A3)
! check an external elemental function
write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
write(6,*) efoo(A1,A3,A2)
write(6,*) efoo(A1,A4,A3)
! check an elemental subroutine
call foobar (A5,A2,A4)
call foobar (A5,A4,A4)
END SUBROUTINE
elemental function foo (B1,B2,B3) result(bar)
INTEGER, intent(in) :: B1, B2
integer :: bar
INTEGER, OPTIONAL, intent(in) :: B3
bar = 1
end function foo
elemental subroutine foobar (B1,B2,B3)
INTEGER, intent(OUT) :: B1
INTEGER, optional, intent(in) :: B2, B3
B1 = 1
end subroutine foobar
END
|
