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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-O2" }
3
! { dg-add-options ieee }
4
! Tests the fix for the meta-bug PR31237 (TRANSFER intrinsic)
5
! Exercises gfc_simplify_transfer a random walk through types and shapes
6
! and compares its results with the middle-end version that operates on
7
! variables.
8
!
9
  implicit none
10
  call integer4_to_real4
11
  call real4_to_integer8
12
  call integer4_to_integer8
13
  call logical4_to_real8
14
  call real8_to_integer4
15
  call integer8_to_real4
16
  call integer8_to_complex4
17
  call character16_to_complex8
18
  call character16_to_real8
19
  call real8_to_character2
20
  call dt_to_integer1
21
  call character16_to_dt
22
contains
23
  subroutine integer4_to_real4
24
    integer(4), parameter ::  i1 = 11111_4
25
    integer(4)            ::  i2 = i1
26
    real(4), parameter    ::  r1 = transfer (i1, 1.0_4)
27
    real(4)               ::  r2
28
 
29
    r2 = transfer (i2, r2);
30
    if (r1 .ne. r2) call abort ()
31
  end subroutine integer4_to_real4
32
 
33
  subroutine real4_to_integer8
34
    real(4), parameter    ::  r1(2) = (/3.14159_4, 0.0_4/)
35
    real(4)               ::  r2(2) = r1
36
    integer(8), parameter ::  i1 = transfer (r1, 1_8)
37
    integer(8)            ::  i2
38
 
39
    i2 = transfer (r2, 1_8);
40
    if (i1 .ne. i2) call abort ()
41
  end subroutine real4_to_integer8
42
 
43
  subroutine integer4_to_integer8
44
    integer(4), parameter ::  i1(2) = (/11111_4, 22222_4/)
45
    integer(4)            ::  i2(2) = i1
46
    integer(8), parameter ::  i3 = transfer (i1, 1_8)
47
    integer(8)            ::  i4
48
 
49
    i4 = transfer (i2, 1_8);
50
    if (i3 .ne. i4) call abort ()
51
  end subroutine integer4_to_integer8
52
 
53
  subroutine logical4_to_real8
54
    logical(4), parameter ::  l1(2) = (/.false., .true./)
55
    logical(4)            ::  l2(2) = l1
56
    real(8), parameter    ::  r1 = transfer (l1, 1_8)
57
    real(8)               ::  r2
58
 
59
    r2 = transfer (l2, 1_8);
60
    if (r1 .ne. r2) call abort ()
61
  end subroutine logical4_to_real8
62
 
63
  subroutine real8_to_integer4
64
    real(8), parameter    ::  r1 = 3.14159_8
65
    real(8)               ::  r2 = r1
66
    integer(4), parameter ::  i1(2) = transfer (r1, 1_4, 2)
67
    integer(4)            ::  i2(2)
68
 
69
    i2 = transfer (r2, i2, 2);
70
    if (any (i1 .ne. i2)) call abort ()
71
  end subroutine real8_to_integer4
72
 
73
  subroutine integer8_to_real4
74
    integer               ::  k
75
    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
76
    integer(8)            ::  i2(2) = i1
77
    real(4), parameter    ::  r1(4) = transfer (i1, (/(1.0_4,k=1,4)/))
78
    real(4)               ::  r2(4)
79
 
80
    r2 = transfer (i2, r2);
81
    if (any (r1 .ne. r2)) call abort ()
82
  end subroutine integer8_to_real4
83
 
84
  subroutine integer8_to_complex4
85
    integer               ::  k
86
    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
87
    integer(8)            ::  i2(2) = i1
88
    complex(4), parameter ::  z1(2) = transfer (i1, (/((1.0_4,2.0_4),k=1,2)/))
89
    complex(4)            ::  z2(2)
90
 
91
    z2 = transfer (i2, z2);
92
    if (any (z1 .ne. z2)) call abort ()
93
  end subroutine integer8_to_complex4
94
 
95
  subroutine character16_to_complex8
96
    character(16), parameter ::  c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
97
    character(16)            ::  c2(2) = c1
98
    complex(8), parameter    ::  z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
99
    complex(8)               ::  z2(2)
100
 
101
    z2 = transfer (c2, z2, 2);
102
    if (any (z1 .ne. z2)) call abort ()
103
  end subroutine character16_to_complex8
104
 
105
  subroutine character16_to_real8
106
    character(16), parameter ::  c1 = "abcdefghijklmnop"
107
    character(16)            ::  c2 = c1
108
    real(8), parameter    ::  r1(2) = transfer (c1, 1.0_8, 2)
109
    real(8)               ::  r2(2)
110
 
111
    r2 = transfer (c2, r2, 2);
112
    if (any (r1 .ne. r2)) call abort ()
113
  end subroutine character16_to_real8
114
 
115
  subroutine real8_to_character2
116
    real(8), parameter    ::  r1 = 3.14159_8
117
    real(8)               ::  r2 = r1
118
    character(2), parameter ::  c1(4) = transfer (r1, "ab", 4)
119
    character(2)            ::  c2(4)
120
 
121
    c2 = transfer (r2, "ab", 4);
122
    if (any (c1 .ne. c2)) call abort ()
123
  end subroutine real8_to_character2
124
 
125
  subroutine dt_to_integer1
126
    integer, parameter    :: i1(4) = (/1_4,2_4,3_4,4_4/)
127
    real, parameter       :: r1(4) = (/1.0_4,2.0_4,3.0_4,4.0_4/)
128
    type :: mytype
129
      integer(4) :: i(4)
130
      real(4) :: x(4)
131
    end type mytype
132
    type (mytype), parameter :: dt1 = mytype (i1, r1)
133
    type (mytype)            :: dt2 = dt1
134
    integer(1), parameter :: i2(32) = transfer (dt1, 1_1, 32)
135
    integer(1)            :: i3(32)
136
 
137
    i3 = transfer (dt2, 1_1, 32);
138
    if (any (i2 .ne. i3)) call abort ()
139
  end subroutine dt_to_integer1
140
 
141
  subroutine character16_to_dt
142
    character(16), parameter ::  c1 = "abcdefghijklmnop"
143
    character(16)            ::  c2 = c1
144
    type :: mytype
145
      real(4) :: x(2)
146
    end type mytype
147
 
148
    type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2)
149
    type (mytype)            :: dt2(2)
150
 
151
    dt2 = transfer (c2, dt2);
152
    if (any (dt1(1)%x .ne. dt2(1)%x)) call abort ()
153
    if (any (dt1(2)%x .ne. dt2(2)%x)) call abort ()
154
  end subroutine character16_to_dt
155
 
156
end

powered by: WebSVN 2.1.0

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