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