OpenCores
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/] [internal_pack_1.f90] - Blame information for rev 302

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! Test that the internal pack and unpack routines work OK
3
! for different data types
4
 
5
program main
6
  integer(kind=1), dimension(3) :: i1
7
  integer(kind=2), dimension(3) :: i2
8
  integer(kind=4), dimension(3) :: i4
9
  integer(kind=8), dimension(3) :: i8
10
  real(kind=4), dimension(3) :: r4
11
  real(kind=8), dimension(3) :: r8
12
  complex(kind=4), dimension(3) :: c4
13
  complex(kind=8), dimension(3) :: c8
14
  type i8_t
15
     sequence
16
     integer(kind=8) :: v
17
  end type i8_t
18
  type(i8_t), dimension(3) :: d_i8
19
 
20
  i1 = (/ -1, 1, -3 /)
21
  call sub_i1(i1(1:3:2))
22
  if (any(i1 /= (/ 3, 1, 2 /))) call abort
23
 
24
  i2 = (/ -1, 1, -3 /)
25
  call sub_i2(i2(1:3:2))
26
  if (any(i2 /= (/ 3, 1, 2 /))) call abort
27
 
28
  i4 = (/ -1, 1, -3 /)
29
  call sub_i4(i4(1:3:2))
30
  if (any(i4 /= (/ 3, 1, 2 /))) call abort
31
 
32
  i8 = (/ -1, 1, -3 /)
33
  call sub_i8(i8(1:3:2))
34
  if (any(i8 /= (/ 3, 1, 2 /))) call abort
35
 
36
  r4 = (/ -1.0, 1.0, -3.0 /)
37
  call sub_r4(r4(1:3:2))
38
  if (any(r4 /= (/ 3.0, 1.0, 2.0/))) call abort
39
 
40
  r8 = (/ -1.0_8, 1.0_8, -3.0_8 /)
41
  call sub_r8(r8(1:3:2))
42
  if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) call abort
43
 
44
  c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
45
  call sub_c4(c4(1:3:2))
46
  if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
47
  if (any(aimag(c4) /= 0._4)) call abort
48
 
49
  c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
50
  call sub_c8(c8(1:3:2))
51
  if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
52
  if (any(aimag(c8) /= 0._4)) call abort
53
 
54
  d_i8%v = (/ -1, 1, -3 /)
55
  call sub_d_i8(d_i8(1:3:2))
56
  if (any(d_i8%v /= (/ 3, 1, 2 /))) call abort
57
 
58
end program main
59
 
60
subroutine sub_i1(i)
61
  integer(kind=1), dimension(2) :: i
62
  if (i(1) /= -1) call abort
63
  if (i(2) /= -3) call abort
64
  i(1) = 3
65
  i(2) = 2
66
end subroutine sub_i1
67
 
68
subroutine sub_i2(i)
69
  integer(kind=2), dimension(2) :: i
70
  if (i(1) /= -1) call abort
71
  if (i(2) /= -3) call abort
72
  i(1) = 3
73
  i(2) = 2
74
end subroutine sub_i2
75
 
76
subroutine sub_i4(i)
77
  integer(kind=4), dimension(2) :: i
78
  if (i(1) /= -1) call abort
79
  if (i(2) /= -3) call abort
80
  i(1) = 3
81
  i(2) = 2
82
end subroutine sub_i4
83
 
84
subroutine sub_i8(i)
85
  integer(kind=8), dimension(2) :: i
86
  if (i(1) /= -1) call abort
87
  if (i(2) /= -3) call abort
88
  i(1) = 3
89
  i(2) = 2
90
end subroutine sub_i8
91
 
92
subroutine sub_r4(r)
93
  real(kind=4), dimension(2) :: r
94
  if (r(1) /= -1.) call abort
95
  if (r(2) /= -3.) call abort
96
  r(1) = 3.
97
  r(2) = 2.
98
end subroutine sub_r4
99
 
100
subroutine sub_r8(r)
101
  real(kind=8), dimension(2) :: r
102
  if (r(1) /= -1._8) call abort
103
  if (r(2) /= -3._8) call abort
104
  r(1) = 3._8
105
  r(2) = 2._8
106
end subroutine sub_r8
107
 
108
subroutine sub_c8(r)
109
  implicit none
110
  complex(kind=8), dimension(2) :: r
111
  if (r(1) /= (-1._8,0._8)) call abort
112
  if (r(2) /= (-3._8,0._8)) call abort
113
  r(1) = 3._8
114
  r(2) = 2._8
115
end subroutine sub_c8
116
 
117
subroutine sub_c4(r)
118
  implicit none
119
  complex(kind=4), dimension(2) :: r
120
  if (r(1) /= (-1._4,0._4)) call abort
121
  if (r(2) /= (-3._4,0._4)) call abort
122
  r(1) = 3._4
123
  r(2) = 2._4
124
end subroutine sub_c4
125
 
126
subroutine sub_d_i8(i)
127
  type i8_t
128
     sequence
129
     integer(kind=8) :: v
130
  end type i8_t
131
  type(i8_t), dimension(2) :: i
132
  if (i(1)%v /= -1) call abort
133
  if (i(2)%v /= -3) call abort
134
  i(1)%v = 3
135
  i(2)%v = 2
136
end subroutine sub_d_i8

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.