URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [entry_13.f90] - Rev 307
Go to most recent revision | Compare with Previous | Blame | View Log
! { dg-do run }
! Tests the fix for pr31214, in which the typespec for the entry would be lost,
! thereby causing the function to be disallowed, since the function and entry
! types did not match.
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
module type_mod
implicit none
type x
real x
end type x
type y
real x
end type y
type z
real x
end type z
interface assignment(=)
module procedure equals
end interface assignment(=)
interface operator(//)
module procedure a_op_b, b_op_a
end interface operator(//)
interface operator(==)
module procedure a_po_b, b_po_a
end interface operator(==)
contains
subroutine equals(x,y)
type(z), intent(in) :: y
type(z), intent(out) :: x
x%x = y%x
end subroutine equals
function a_op_b(a,b)
type(x), intent(in) :: a
type(y), intent(in) :: b
type(z) a_op_b
type(z) b_op_a
a_op_b%x = a%x + b%x
return
entry b_op_a(b,a)
b_op_a%x = a%x - b%x
end function a_op_b
function a_po_b(a,b)
type(x), intent(in) :: a
type(y), intent(in) :: b
type(z) a_po_b
type(z) b_po_a
entry b_po_a(b,a)
a_po_b%x = a%x/b%x
end function a_po_b
end module type_mod
program test
use type_mod
implicit none
type(x) :: x1 = x(19.0_4)
type(y) :: y1 = y(7.0_4)
type(z) z1
z1 = x1//y1
if (z1%x .ne. 19.0_4 + 7.0_4) call abort ()
z1 = y1//x1
if (z1%x .ne. 19.0_4 - 7.0_4) call abort ()
z1 = x1==y1
if (z1%x .ne. 19.0_4/7.0_4) call abort ()
z1 = y1==x1
if (z1%x .ne. 19.0_4/7.0_4) call abort ()
end program test
! { dg-final { cleanup-modules "type_mod" } }
Go to most recent revision | Compare with Previous | Blame | View Log