! { dg-do compile }
|
! { dg-do compile }
|
! { dg-options "-pedantic" }
|
! { dg-options "-pedantic" }
|
! Check the fix for PR20893, in which actual arguments could violate:
|
! 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
|
! "(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
|
! an elemental procedure unless an array of the same rank is supplied as an
|
! actual argument corresponding to a nonoptional dummy argument of that
|
! actual argument corresponding to a nonoptional dummy argument of that
|
! elemental procedure." (12.4.1.5)
|
! elemental procedure." (12.4.1.5)
|
!
|
!
|
! Contributed by Joost VandeVondele
|
! Contributed by Joost VandeVondele
|
!
|
!
|
CALL T1(1,2)
|
CALL T1(1,2)
|
CONTAINS
|
CONTAINS
|
SUBROUTINE T1(A1,A2,A3)
|
SUBROUTINE T1(A1,A2,A3)
|
INTEGER :: A1,A2, A4(2), A5(2)
|
INTEGER :: A1,A2, A4(2), A5(2)
|
INTEGER, OPTIONAL :: A3(2)
|
INTEGER, OPTIONAL :: A3(2)
|
interface
|
interface
|
elemental function efoo (B1,B2,B3) result(bar)
|
elemental function efoo (B1,B2,B3) result(bar)
|
INTEGER, intent(in) :: B1, B2
|
INTEGER, intent(in) :: B1, B2
|
integer :: bar
|
integer :: bar
|
INTEGER, OPTIONAL, intent(in) :: B3
|
INTEGER, OPTIONAL, intent(in) :: B3
|
end function efoo
|
end function efoo
|
end interface
|
end interface
|
|
|
! check an intrinsic function
|
! check an intrinsic function
|
write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) MAX(A1,A3,A2)
|
write(6,*) MAX(A1,A3,A2)
|
write(6,*) MAX(A1,A4,A3)
|
write(6,*) MAX(A1,A4,A3)
|
! check an internal elemental function
|
! check an internal elemental function
|
write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) foo(A1,A3,A2)
|
write(6,*) foo(A1,A3,A2)
|
write(6,*) foo(A1,A4,A3)
|
write(6,*) foo(A1,A4,A3)
|
! check an external elemental function
|
! check an external elemental function
|
write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
|
write(6,*) efoo(A1,A3,A2)
|
write(6,*) efoo(A1,A3,A2)
|
write(6,*) efoo(A1,A4,A3)
|
write(6,*) efoo(A1,A4,A3)
|
! check an elemental subroutine
|
! check an elemental subroutine
|
call foobar (A5,A2,A4)
|
call foobar (A5,A2,A4)
|
call foobar (A5,A4,A4)
|
call foobar (A5,A4,A4)
|
END SUBROUTINE
|
END SUBROUTINE
|
elemental function foo (B1,B2,B3) result(bar)
|
elemental function foo (B1,B2,B3) result(bar)
|
INTEGER, intent(in) :: B1, B2
|
INTEGER, intent(in) :: B1, B2
|
integer :: bar
|
integer :: bar
|
INTEGER, OPTIONAL, intent(in) :: B3
|
INTEGER, OPTIONAL, intent(in) :: B3
|
bar = 1
|
bar = 1
|
end function foo
|
end function foo
|
elemental subroutine foobar (B1,B2,B3)
|
elemental subroutine foobar (B1,B2,B3)
|
INTEGER, intent(OUT) :: B1
|
INTEGER, intent(OUT) :: B1
|
INTEGER, optional, intent(in) :: B2, B3
|
INTEGER, optional, intent(in) :: B2, B3
|
B1 = 1
|
B1 = 1
|
end subroutine foobar
|
end subroutine foobar
|
|
|
END
|
END
|
|
|
|
|
