URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [value_1.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


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

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`! { dg-options "-std=f2003 -fall-intrinsics" }`
3			`! Tests the functionality of the patch for PR29642, which requested the`
4			`! implementation of the F2003 VALUE attribute for gfortran.`
5			`!`
6			`! Contributed by Paul Thomas`
7			`!`
8			`module global`
9			`type :: mytype`
10			`real(4) :: x`
11			`character(4) :: c`
12			`end type mytype`
13			`contains`
14			`subroutine typhoo (dt)`
15			`type(mytype), value :: dt`
16			`if (dtne (dt, mytype (42.0, "lmno"))) call abort ()`
17			`dt = mytype (21.0, "wxyz")`
18			`if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()`
19			`end subroutine typhoo`
20
21			`logical function dtne (a, b)`
22			`type(mytype) :: a, b`
23			`dtne = .FALSE.`
24			`if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.`
25			`end function dtne`
26			`end module global`
27
28			`program test_value`
29			`use global`
30			`integer(8) :: i = 42`
31			`real(8) :: r = 42.0`
32			`character(2) :: c = "ab"`
33			`complex(8) :: z = (-99.0, 199.0)`
34			`type(mytype) :: dt = mytype (42.0, "lmno")`
35
36			`call foo (c)`
37			`if (c /= "ab") call abort ()`
38
39			`call bar (i)`
40			`if (i /= 42) call abort ()`
41
42			`call foobar (r)`
43			`if (r /= 42.0) call abort ()`
44
45			`call complex_foo (z)`
46			`if (z /= (-99.0, 199.0)) call abort ()`
47
48			`call typhoo (dt)`
49			`if (dtne (dt, mytype (42.0, "lmno"))) call abort ()`
50
51			`r = 20.0`
52			`call foobar (r*2.0 + 2.0)`
53
54			`contains`
55			`subroutine foo (c)`
56			`character(2), value :: c`
57			`if (c /= "ab") call abort ()`
58			`c = "cd"`
59			`if (c /= "cd") call abort ()`
60			`end subroutine foo`
61
62			`subroutine bar (i)`
63			`integer(8), value :: i`
64			`if (i /= 42) call abort ()`
65			`i = 99`
66			`if (i /= 99) call abort ()`
67			`end subroutine bar`
68
69			`subroutine foobar (r)`
70			`real(8), value :: r`
71			`if (r /= 42.0) call abort ()`
72			`r = 99.0`
73			`if (r /= 99.0) call abort ()`
74			`end subroutine foobar`
75
76			`subroutine complex_foo (z)`
77			`COMPLEX(8), value :: z`
78			`if (z /= (-99.0, 199.0)) call abort ()`
79			`z = (77.0, -42.0)`
80			`if (z /= (77.0, -42.0)) call abort ()`
81			`end subroutine complex_foo`
82
83			`end program test_value`
84			`! { dg-final { cleanup-modules "global" } }`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [value_1.f90] - Blame information for rev 801