! { 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 ! 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