URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [elemental_optional_args_1.f90] - Rev 149
Go to most recent revision | Compare with Previous | Blame | View Log
! { 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)
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 (A1,A2,A3) ! { dg-warning "array and OPTIONAL" }
call foobar (A1,A2,A4)
call foobar (A1,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
Go to most recent revision | Compare with Previous | Blame | View Log