gcc/testsuite/g77.f-torture/execute/19990325-0.f

   1 * test whether complex operators properly handle
   2 * full and partial aliasing.
   3 * (libf2c/libF77 routines used to assume no aliasing,
   4 * then were changed to accommodate full aliasing, while
   5 * the libg2c/libF77 versions were changed to accommodate
   6 * both full and partial aliasing.)
   7 *
   8 * NOTE: this (19990325-0.f) is the single-precision version.
   9 * See 19990325-1.f for the double-precision version.
  10
  11       program complexalias
  12       implicit none
  13
  14 * Make sure non-aliased cases work.  (Catch roundoff/precision
  15 * problems, etc., here.  Modify subroutine check if they occur.)
  16
  17       call tryfull (1, 3, 5)
  18
  19 * Now check various combinations of aliasing.
  20
  21 * Full aliasing.
  22       call tryfull (1, 1, 5)
  23
  24 * Partial aliasing.
  25       call trypart (2, 3, 5)
  26       call trypart (2, 1, 5)
  27       call trypart (2, 5, 3)
  28       call trypart (2, 5, 1)
  29
  30       end
  31
  32       subroutine tryfull (xout, xin1, xin2)
  33       implicit none
  34       integer xout, xin1, xin2
  35
  36 * out, in1, and in2 are the desired indexes into the REAL array (array).
  37
  38       complex expect
  39       integer pwr
  40       integer out, in1, in2
  41
  42       real array(6)
  43       complex carray(3)
  44       equivalence (carray(1), array(1))
  45
  46 * Make sure the indexes can be accommodated by the equivalences above.
  47
  48       if (mod (xout, 2) .ne. 1) call abort
  49       if (mod (xin1, 2) .ne. 1) call abort
  50       if (mod (xin2, 2) .ne. 1) call abort
  51
  52 * Convert the indexes into ones suitable for the COMPLEX array (carray).
  53
  54       out = (xout + 1) / 2
  55       in1 = (xin1 + 1) / 2
  56       in2 = (xin2 + 1) / 2
  57
  58 * Check some open-coded stuff, just in case.
  59
  60       call prepare1 (carray(in1))
  61       expect = + carray(in1)
  62       carray(out) = + carray(in1)
  63       call check (expect, carray(out))
  64
  65       call prepare1 (carray(in1))
  66       expect = - carray(in1)
  67       carray(out) = - carray(in1)
  68       call check (expect, carray(out))
  69
  70       call prepare2 (carray(in1), carray(in2))
  71       expect = carray(in1) + carray(in2)
  72       carray(out) = carray(in1) + carray(in2)
  73       call check (expect, carray(out))
  74
  75       call prepare2 (carray(in1), carray(in2))
  76       expect = carray(in1) - carray(in2)
  77       carray(out) = carray(in1) - carray(in2)
  78       call check (expect, carray(out))
  79
  80       call prepare2 (carray(in1), carray(in2))
  81       expect = carray(in1) * carray(in2)
  82       carray(out) = carray(in1) * carray(in2)
  83       call check (expect, carray(out))
  84
  85       call prepare1 (carray(in1))
  86       expect = carray(in1) ** 2
  87       carray(out) = carray(in1) ** 2
  88       call check (expect, carray(out))
  89
  90       call prepare1 (carray(in1))
  91       expect = carray(in1) ** 3
  92       carray(out) = carray(in1) ** 3
  93       call check (expect, carray(out))
  94
  95       call prepare1 (carray(in1))
  96       expect = abs (carray(in1))
  97       array(out*2-1) = abs (carray(in1))
  98       array(out*2) = 0
  99       call check (expect, carray(out))
 100
 101 * Now check the stuff implemented in libF77.
 102
 103       call prepare1 (carray(in1))
 104       expect = cos (carray(in1))
 105       carray(out) = cos (carray(in1))
 106       call check (expect, carray(out))
 107
 108       call prepare1 (carray(in1))
 109       expect = exp (carray(in1))
 110       carray(out) = exp (carray(in1))
 111       call check (expect, carray(out))
 112
 113       call prepare1 (carray(in1))
 114       expect = log (carray(in1))
 115       carray(out) = log (carray(in1))
 116       call check (expect, carray(out))
 117
 118       call prepare1 (carray(in1))
 119       expect = sin (carray(in1))
 120       carray(out) = sin (carray(in1))
 121       call check (expect, carray(out))
 122
 123       call prepare1 (carray(in1))
 124       expect = sqrt (carray(in1))
 125       carray(out) = sqrt (carray(in1))
 126       call check (expect, carray(out))
 127
 128       call prepare1 (carray(in1))
 129       expect = conjg (carray(in1))
 130       carray(out) = conjg (carray(in1))
 131       call check (expect, carray(out))
 132
 133       call prepare1i (carray(in1), pwr)
 134       expect = carray(in1) ** pwr
 135       carray(out) = carray(in1) ** pwr
 136       call check (expect, carray(out))
 137
 138       call prepare2 (carray(in1), carray(in2))
 139       expect = carray(in1) / carray(in2)
 140       carray(out) = carray(in1) / carray(in2)
 141       call check (expect, carray(out))
 142
 143       call prepare2 (carray(in1), carray(in2))
 144       expect = carray(in1) ** carray(in2)
 145       carray(out) = carray(in1) ** carray(in2)
 146       call check (expect, carray(out))
 147
 148       call prepare1 (carray(in1))
 149       expect = carray(in1) ** .2
 150       carray(out) = carray(in1) ** .2
 151       call check (expect, carray(out))
 152
 153       end
 154
 155       subroutine trypart (xout, xin1, xin2)
 156       implicit none
 157       integer xout, xin1, xin2
 158
 159 * out, in1, and in2 are the desired indexes into the REAL array (array).
 160
 161       complex expect
 162       integer pwr
 163       integer out, in1, in2
 164
 165       real array(6)
 166       complex carray(3), carrayp(2)
 167       equivalence (carray(1), array(1))
 168       equivalence (carrayp(1), array(2))
 169
 170 * Make sure the indexes can be accommodated by the equivalences above.
 171
 172       if (mod (xout, 2) .ne. 0) call abort
 173       if (mod (xin1, 2) .ne. 1) call abort
 174       if (mod (xin2, 2) .ne. 1) call abort
 175
 176 * Convert the indexes into ones suitable for the COMPLEX array (carray).
 177
 178       out = xout / 2
 179       in1 = (xin1 + 1) / 2
 180       in2 = (xin2 + 1) / 2
 181
 182 * Check some open-coded stuff, just in case.
 183
 184       call prepare1 (carray(in1))
 185       expect = + carray(in1)
 186       carrayp(out) = + carray(in1)
 187       call check (expect, carrayp(out))
 188
 189       call prepare1 (carray(in1))
 190       expect = - carray(in1)
 191       carrayp(out) = - carray(in1)
 192       call check (expect, carrayp(out))
 193
 194       call prepare2 (carray(in1), carray(in2))
 195       expect = carray(in1) + carray(in2)
 196       carrayp(out) = carray(in1) + carray(in2)
 197       call check (expect, carrayp(out))
 198
 199       call prepare2 (carray(in1), carray(in2))
 200       expect = carray(in1) - carray(in2)
 201       carrayp(out) = carray(in1) - carray(in2)
 202       call check (expect, carrayp(out))
 203
 204       call prepare2 (carray(in1), carray(in2))
 205       expect = carray(in1) * carray(in2)
 206       carrayp(out) = carray(in1) * carray(in2)
 207       call check (expect, carrayp(out))
 208
 209       call prepare1 (carray(in1))
 210       expect = carray(in1) ** 2
 211       carrayp(out) = carray(in1) ** 2
 212       call check (expect, carrayp(out))
 213
 214       call prepare1 (carray(in1))
 215       expect = carray(in1) ** 3
 216       carrayp(out) = carray(in1) ** 3
 217       call check (expect, carrayp(out))
 218
 219       call prepare1 (carray(in1))
 220       expect = abs (carray(in1))
 221       array(out*2) = abs (carray(in1))
 222       array(out*2+1) = 0
 223       call check (expect, carrayp(out))
 224
 225 * Now check the stuff implemented in libF77.
 226
 227       call prepare1 (carray(in1))
 228       expect = cos (carray(in1))
 229       carrayp(out) = cos (carray(in1))
 230       call check (expect, carrayp(out))
 231
 232       call prepare1 (carray(in1))
 233       expect = exp (carray(in1))
 234       carrayp(out) = exp (carray(in1))
 235       call check (expect, carrayp(out))
 236
 237       call prepare1 (carray(in1))
 238       expect = log (carray(in1))
 239       carrayp(out) = log (carray(in1))
 240       call check (expect, carrayp(out))
 241
 242       call prepare1 (carray(in1))
 243       expect = sin (carray(in1))
 244       carrayp(out) = sin (carray(in1))
 245       call check (expect, carrayp(out))
 246
 247       call prepare1 (carray(in1))
 248       expect = sqrt (carray(in1))
 249       carrayp(out) = sqrt (carray(in1))
 250       call check (expect, carrayp(out))
 251
 252       call prepare1 (carray(in1))
 253       expect = conjg (carray(in1))
 254       carrayp(out) = conjg (carray(in1))
 255       call check (expect, carrayp(out))
 256
 257       call prepare1i (carray(in1), pwr)
 258       expect = carray(in1) ** pwr
 259       carrayp(out) = carray(in1) ** pwr
 260       call check (expect, carrayp(out))
 261
 262       call prepare2 (carray(in1), carray(in2))
 263       expect = carray(in1) / carray(in2)
 264       carrayp(out) = carray(in1) / carray(in2)
 265       call check (expect, carrayp(out))
 266
 267       call prepare2 (carray(in1), carray(in2))
 268       expect = carray(in1) ** carray(in2)
 269       carrayp(out) = carray(in1) ** carray(in2)
 270       call check (expect, carrayp(out))
 271
 272       call prepare1 (carray(in1))
 273       expect = carray(in1) ** .2
 274       carrayp(out) = carray(in1) ** .2
 275       call check (expect, carrayp(out))
 276
 277       end
 278
 279       subroutine prepare1 (in)
 280       implicit none
 281       complex in
 282
 283       in = (3.2, 4.2)
 284
 285       end
 286
 287       subroutine prepare1i (in, i)
 288       implicit none
 289       complex in
 290       integer i
 291
 292       in = (2.3, 2.5)
 293       i = 4
 294
 295       end
 296
 297       subroutine prepare2 (in1, in2)
 298       implicit none
 299       complex in1, in2
 300
 301       in1 = (1.3, 2.4)
 302       in2 = (3.5, 7.1)
 303
 304       end
 305
 306       subroutine check (expect, got)
 307       implicit none
 308       complex expect, got
 309
 310       if (aimag(expect) .ne. aimag(got)) call abort
 311       if (real(expect) .ne. real(got)) call abort
 312
 313       end