! { dg-do run }
|
! { dg-do run }
|
! { dg-options "-std=f2003 -fall-intrinsics" }
|
! { dg-options "-std=f2003 -fall-intrinsics" }
|
! Tests the functionality of the patch for PR29642, which requested the
|
! Tests the functionality of the patch for PR29642, which requested the
|
! implementation of the F2003 VALUE attribute for gfortran.
|
! implementation of the F2003 VALUE attribute for gfortran.
|
!
|
!
|
! Contributed by Paul Thomas
|
! Contributed by Paul Thomas
|
!
|
!
|
module global
|
module global
|
type :: mytype
|
type :: mytype
|
real(4) :: x
|
real(4) :: x
|
character(4) :: c
|
character(4) :: c
|
end type mytype
|
end type mytype
|
contains
|
contains
|
subroutine typhoo (dt)
|
subroutine typhoo (dt)
|
type(mytype), value :: dt
|
type(mytype), value :: dt
|
if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
|
if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
|
dt = mytype (21.0, "wxyz")
|
dt = mytype (21.0, "wxyz")
|
if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
|
if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
|
end subroutine typhoo
|
end subroutine typhoo
|
|
|
logical function dtne (a, b)
|
logical function dtne (a, b)
|
type(mytype) :: a, b
|
type(mytype) :: a, b
|
dtne = .FALSE.
|
dtne = .FALSE.
|
if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
|
if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
|
end function dtne
|
end function dtne
|
end module global
|
end module global
|
|
|
program test_value
|
program test_value
|
use global
|
use global
|
integer(8) :: i = 42
|
integer(8) :: i = 42
|
real(8) :: r = 42.0
|
real(8) :: r = 42.0
|
character(2) :: c = "ab"
|
character(2) :: c = "ab"
|
complex(8) :: z = (-99.0, 199.0)
|
complex(8) :: z = (-99.0, 199.0)
|
type(mytype) :: dt = mytype (42.0, "lmno")
|
type(mytype) :: dt = mytype (42.0, "lmno")
|
|
|
call foo (c)
|
call foo (c)
|
if (c /= "ab") call abort ()
|
if (c /= "ab") call abort ()
|
|
|
call bar (i)
|
call bar (i)
|
if (i /= 42) call abort ()
|
if (i /= 42) call abort ()
|
|
|
call foobar (r)
|
call foobar (r)
|
if (r /= 42.0) call abort ()
|
if (r /= 42.0) call abort ()
|
|
|
call complex_foo (z)
|
call complex_foo (z)
|
if (z /= (-99.0, 199.0)) call abort ()
|
if (z /= (-99.0, 199.0)) call abort ()
|
|
|
call typhoo (dt)
|
call typhoo (dt)
|
if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
|
if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
|
|
|
r = 20.0
|
r = 20.0
|
call foobar (r*2.0 + 2.0)
|
call foobar (r*2.0 + 2.0)
|
|
|
contains
|
contains
|
subroutine foo (c)
|
subroutine foo (c)
|
character(2), value :: c
|
character(2), value :: c
|
if (c /= "ab") call abort ()
|
if (c /= "ab") call abort ()
|
c = "cd"
|
c = "cd"
|
if (c /= "cd") call abort ()
|
if (c /= "cd") call abort ()
|
end subroutine foo
|
end subroutine foo
|
|
|
subroutine bar (i)
|
subroutine bar (i)
|
integer(8), value :: i
|
integer(8), value :: i
|
if (i /= 42) call abort ()
|
if (i /= 42) call abort ()
|
i = 99
|
i = 99
|
if (i /= 99) call abort ()
|
if (i /= 99) call abort ()
|
end subroutine bar
|
end subroutine bar
|
|
|
subroutine foobar (r)
|
subroutine foobar (r)
|
real(8), value :: r
|
real(8), value :: r
|
if (r /= 42.0) call abort ()
|
if (r /= 42.0) call abort ()
|
r = 99.0
|
r = 99.0
|
if (r /= 99.0) call abort ()
|
if (r /= 99.0) call abort ()
|
end subroutine foobar
|
end subroutine foobar
|
|
|
subroutine complex_foo (z)
|
subroutine complex_foo (z)
|
COMPLEX(8), value :: z
|
COMPLEX(8), value :: z
|
if (z /= (-99.0, 199.0)) call abort ()
|
if (z /= (-99.0, 199.0)) call abort ()
|
z = (77.0, -42.0)
|
z = (77.0, -42.0)
|
if (z /= (77.0, -42.0)) call abort ()
|
if (z /= (77.0, -42.0)) call abort ()
|
end subroutine complex_foo
|
end subroutine complex_foo
|
|
|
end program test_value
|
end program test_value
|
! { dg-final { cleanup-modules "global" } }
|
! { dg-final { cleanup-modules "global" } }
|
|
|
