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

    r2 = transfer (i2, r2);
    if (r1 .ne. r2) call abort ()
  end subroutine integer4_to_real4

  subroutine real4_to_integer8
    real(4), parameter    ::  r1(2) = (/3.14159_4, 0.0_4/)
    real(4)               ::  r2(2) = r1
    integer(8), parameter ::  i1 = transfer (r1, 1_8)
    integer(8)            ::  i2

    i2 = transfer (r2, 1_8);
    if (i1 .ne. i2) call abort ()
  end subroutine real4_to_integer8

  subroutine integer4_to_integer8
    integer(4), parameter ::  i1(2) = (/11111_4, 22222_4/)
    integer(4)            ::  i2(2) = i1
    integer(8), parameter ::  i3 = transfer (i1, 1_8)
    integer(8)            ::  i4

    i4 = transfer (i2, 1_8);
    if (i3 .ne. i4) call abort ()
  end subroutine integer4_to_integer8

  subroutine logical4_to_real8
    logical(4), parameter ::  l1(2) = (/.false., .true./)
    logical(4)            ::  l2(2) = l1
    real(8), parameter    ::  r1 = transfer (l1, 1_8)
    real(8)               ::  r2

    r2 = transfer (l2, 1_8);
    if (r1 .ne. r2) call abort ()
  end subroutine logical4_to_real8

  subroutine real8_to_integer4
    real(8), parameter    ::  r1 = 3.14159_8
    real(8)               ::  r2 = r1
    integer(4), parameter ::  i1(2) = transfer (r1, 1_4, 2)
    integer(4)            ::  i2(2)

    i2 = transfer (r2, i2, 2);
    if (any (i1 .ne. i2)) call abort ()
  end subroutine real8_to_integer4

  subroutine integer8_to_real4
    integer               ::  k
    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
    integer(8)            ::  i2(2) = i1
    real(4), parameter    ::  r1(4) = transfer (i1, (/(1.0_4,k=1,4)/))
    real(4)               ::  r2(4)

    r2 = transfer (i2, r2);
    if (any (r1 .ne. r2)) call abort ()
  end subroutine integer8_to_real4

  subroutine integer8_to_complex4
    integer               ::  k
    integer(8), parameter ::  i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
    integer(8)            ::  i2(2) = i1
    complex(4), parameter ::  z1(2) = transfer (i1, (/((1.0_4,2.0_4),k=1,2)/))
    complex(4)            ::  z2(2)

    z2 = transfer (i2, z2);
    if (any (z1 .ne. z2)) call abort ()
  end subroutine integer8_to_complex4

  subroutine character16_to_complex8
    character(16), parameter ::  c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
    character(16)            ::  c2(2) = c1
    complex(8), parameter    ::  z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
    complex(8)               ::  z2(2)

    z2 = transfer (c2, z2, 2);
    if (any (z1 .ne. z2)) call abort ()
  end subroutine character16_to_complex8

  subroutine character16_to_real8
    character(16), parameter ::  c1 = "abcdefghijklmnop"
    character(16)            ::  c2 = c1
    real(8), parameter    ::  r1(2) = transfer (c1, 1.0_8, 2)
    real(8)               ::  r2(2)

    r2 = transfer (c2, r2, 2);
    if (any (r1 .ne. r2)) call abort ()
  end subroutine character16_to_real8

  subroutine real8_to_character2
    real(8), parameter    ::  r1 = 3.14159_8
    real(8)               ::  r2 = r1
    character(2), parameter ::  c1(4) = transfer (r1, "ab", 4)
    character(2)            ::  c2(4)

    c2 = transfer (r2, "ab", 4);
    if (any (c1 .ne. c2)) call abort ()
  end subroutine real8_to_character2

  subroutine dt_to_integer1
    integer, parameter    :: i1(4) = (/1_4,2_4,3_4,4_4/)
    real, parameter       :: r1(4) = (/1.0_4,2.0_4,3.0_4,4.0_4/)
    type :: mytype
      integer(4) :: i(4)
      real(4) :: x(4)
    end type mytype
    type (mytype), parameter :: dt1 = mytype (i1, r1)
    type (mytype)            :: dt2 = dt1
    integer(1), parameter :: i2(32) = transfer (dt1, 1_1, 32)
    integer(1)            :: i3(32)

    i3 = transfer (dt2, 1_1, 32);
    if (any (i2 .ne. i3)) call abort ()
  end subroutine dt_to_integer1

  subroutine character16_to_dt
    character(16), parameter ::  c1 = "abcdefghijklmnop"
    character(16)            ::  c2 = c1
    type :: mytype
      real(4) :: x(2)
    end type mytype

    type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2)
    type (mytype)            :: dt2(2)

    dt2 = transfer (c2, dt2);
    if (any (dt1(1)%x .ne. dt2(1)%x)) call abort ()
    if (any (dt1(2)%x .ne. dt2(2)%x)) call abort ()
  end subroutine character16_to_dt

end