gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f

   1 c { dg-do run }
   2 c  f90-intrinsic-bit.f
   3 c
   4 c Test Fortran 90
   5 c  * intrinsic bit manipulation functions - Section 13.10.10
   6 c  * bitcopy subroutine - Section 13.9.3
   7 c David Billinghurst <David.Billinghurst@riotinto.com>
   8 c
   9 c Notes:
  10 c  * g77 only supports scalar arguments
  11 c  * third argument of ISHFTC is not optional in g77
  12
  13       logical fail
  14       integer   i, i2, ia, i3
  15       integer(kind=2) j, j2, j3, ja
  16       integer(kind=1) k, k2, k3, ka
  17       integer(kind=8) m, m2, m3, ma
  18
  19       common /flags/ fail
  20       fail = .false.
  21
  22 c     BIT_SIZE - Section 13.13.16
  23 c     Determine BIT_SIZE by counting the bits
  24       ia = 0
  25       i = 0
  26       i = not(i)
  27       do while ( (i.ne.0) .and. (ia.lt.127) )
  28          ia = ia + 1
  29          i = ishft(i,-1)
  30       end do
  31       call c_i(BIT_SIZE(i),ia,'BIT_SIZE(integer)')
  32       ja = 0
  33       j = 0
  34       j = not(j)
  35       do while  ( (j.ne.0) .and. (ja.lt.127) )
  36          ja = ja + 1
  37          j = ishft(j,-1)
  38       end do
  39       call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer(2))')
  40       ka = 0
  41       k = 0
  42       k = not(k)
  43       do while ( (k.ne.0) .and. (ka.lt.127) )
  44          ka = ka + 1
  45          k = ishft(k,-1)
  46       end do
  47       call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer(1))')
  48       ma = 0
  49       m = 0
  50       m = not(m)
  51       do while ( (m.ne.0) .and. (ma.lt.127) )
  52          ma = ma + 1
  53          m = ishft(m,-1)
  54       end do
  55       call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer(8))')
  56
  57 c     BTEST  - Section 13.13.17
  58       j  = 7
  59       j2 = 3
  60       k  = 7
  61       k2 = 3
  62       m  = 7
  63       m2 = 3
  64       call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
  65       call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer(2))')
  66       call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer(1))')
  67       call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer(8))')
  68       call c_l(BTEST(j,3),.true.,'BTEST(integer(2),integer)')
  69       call c_l(BTEST(j,j2),.true.,'BTEST(integer(2),integer(2))')
  70       call c_l(BTEST(j,k2),.true.,'BTEST(integer(2),integer(1))')
  71       call c_l(BTEST(j,m2),.true.,'BTEST(integer(2),integer(8))')
  72       call c_l(BTEST(k,3),.true.,'BTEST(integer(1),integer)')
  73       call c_l(BTEST(k,j2),.true.,'BTEST(integer(1),integer(2))')
  74       call c_l(BTEST(k,k2),.true.,'BTEST(integer(1),integer(1))')
  75       call c_l(BTEST(k,m2),.true.,'BTEST(integer(1),integer(8))')
  76       call c_l(BTEST(m,3),.true.,'BTEST(integer(8),integer)')
  77       call c_l(BTEST(m,j2),.true.,'BTEST(integer(8),integer(2))')
  78       call c_l(BTEST(m,k2),.true.,'BTEST(integer(8),integer(1))')
  79       call c_l(BTEST(m,m2),.true.,'BTEST(integer(8),integer(8))')
  80
  81 c     IAND   - Section 13.13.40
  82       j  = 3
  83       j2 = 1
  84       ja = 1
  85       k  = 3
  86       k2 = 1
  87       ka = 1
  88       m  = 3
  89       m2 = 1
  90       ma = 1
  91       call c_i(IAND(3,1),1,'IAND(integer,integer)')
  92       call c_i2(IAND(j,j2),ja,'IAND(integer(2),integer(2)')
  93       call c_i1(IAND(k,k2),ka,'IAND(integer(1),integer(1))')
  94       call c_i8(IAND(m,m2),ma,'IAND(integer(8),integer(8))')
  95
  96
  97 c     IBCLR  - Section 13.13.41
  98       j  = 14
  99       j2 = 1
 100       ja = 12
 101       k  = 14
 102       k2 = 1
 103       ka = 12
 104       m  = 14
 105       m2 = 1
 106       ma = 12
 107       call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
 108       call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer(2))')
 109       call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer(1))')
 110       call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer(8))')
 111       call c_i2(IBCLR(j,1),ja,'IBCLR(integer(2),integer)')
 112       call c_i2(IBCLR(j,j2),ja,'IBCLR(integer(2),integer(2))')
 113       call c_i2(IBCLR(j,k2),ja,'IBCLR(integer(2),integer(1))')
 114       call c_i2(IBCLR(j,m2),ja,'IBCLR(integer(2),integer(8))')
 115       call c_i1(IBCLR(k,1),ka,'IBCLR(integer(1),integer)')
 116       call c_i1(IBCLR(k,j2),ka,'IBCLR(integer(1),integer(2))')
 117       call c_i1(IBCLR(k,k2),ka,'IBCLR(integer(1),integer(1))')
 118       call c_i1(IBCLR(k,m2),ka,'IBCLR(integer(1),integer(8))')
 119       call c_i8(IBCLR(m,1),ma,'IBCLR(integer(8),integer)')
 120       call c_i8(IBCLR(m,j2),ma,'IBCLR(integer(8),integer(2))')
 121       call c_i8(IBCLR(m,k2),ma,'IBCLR(integer(8),integer(1))')
 122       call c_i8(IBCLR(m,m2),ma,'IBCLR(integer(8),integer(8))')
 123
 124 c     IBSET  - Section 13.13.43
 125       j  = 12
 126       j2 = 1
 127       ja = 14
 128       k  = 12
 129       k2 = 1
 130       ka = 14
 131       m  = 12
 132       m2 = 1
 133       ma = 14
 134       call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
 135       call c_i(IBSET(12,j2),14,'IBSET(integer,integer(2))')
 136       call c_i(IBSET(12,k2),14,'IBSET(integer,integer(1))')
 137       call c_i(IBSET(12,m2),14,'IBSET(integer,integer(8))')
 138       call c_i2(IBSET(j,1),ja,'IBSET(integer(2),integer)')
 139       call c_i2(IBSET(j,j2),ja,'IBSET(integer(2),integer(2))')
 140       call c_i2(IBSET(j,k2),ja,'IBSET(integer(2),integer(1))')
 141       call c_i2(IBSET(j,m2),ja,'IBSET(integer(2),integer(8))')
 142       call c_i1(IBSET(k,1),ka,'IBSET(integer(1),integer)')
 143       call c_i1(IBSET(k,j2),ka,'IBSET(integer(1),integer(2))')
 144       call c_i1(IBSET(k,k2),ka,'IBSET(integer(1),integer(1))')
 145       call c_i1(IBSET(k,m2),ka,'IBSET(integer(1),integer(8))')
 146       call c_i8(IBSET(m,1),ma,'IBSET(integer(8),integer)')
 147       call c_i8(IBSET(m,j2),ma,'IBSET(integer(8),integer(2))')
 148       call c_i8(IBSET(m,k2),ma,'IBSET(integer(8),integer(1))')
 149       call c_i8(IBSET(m,m2),ma,'IBSET(integer(8),integer(8))')
 150
 151 c     IEOR   - Section 13.13.45
 152       j  = 3
 153       j2 = 1
 154       ja = 2
 155       k  = 3
 156       k2 = 1
 157       ka = 2
 158       m  = 3
 159       m2 = 1
 160       ma = 2
 161       call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
 162       call c_i2(IEOR(j,j2),ja,'IEOR(integer(2),integer(2))')
 163       call c_i1(IEOR(k,k2),ka,'IEOR(integer(1),integer(1))')
 164       call c_i8(IEOR(m,m2),ma,'IEOR(integer(8),integer(8))')
 165
 166 c     ISHFT  - Section 13.13.49
 167       i  = 3
 168       i2 = 1
 169       i3 = 0
 170       ia = 6
 171       j  = 3
 172       j2 = 1
 173       j3 = 0
 174       ja = 6
 175       k  = 3
 176       k2 = 1
 177       k3 = 0
 178       ka = 6
 179       m  = 3
 180       m2 = 1
 181       m3 = 0
 182       ma = 6
 183       call c_i(ISHFT(i,i2),ia,'ISHFT(integer,integer)')
 184       call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
 185       call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
 186       call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
 187       call c_i2(ISHFT(j,j2),ja,'ISHFT(integer(2),integer(2))')
 188       call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
 189      $     'ISHFT(integer(2),integer(2)) 2')
 190       call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
 191      $     'ISHFT(integer(2),integer(2)) 3')
 192       call c_i2(ISHFT(j,0),j,'ISHFT(integer(2),integer(2)) 4')
 193       call c_i1(ISHFT(k,k2),ka,'ISHFT(integer(1),integer(1))')
 194       call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
 195      $     'ISHFT(integer(1),integer(1)) 2')
 196       call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
 197      $     'ISHFT(integer(1),integer(1)) 3')
 198       call c_i1(ISHFT(k,0),k,'ISHFT(integer(1),integer(1)) 4')
 199       call c_i8(ISHFT(m,m2),ma,'ISHFT(integer(8),integer(8))')
 200       call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
 201      $     'ISHFT(integer(8),integer(8)) 2')
 202       call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
 203      $     'ISHFT(integer(8),integer(8)) 3')
 204       call c_i8(ISHFT(m,0),m,'ISHFT(integer(8),integer(8)) 4')
 205
 206 c     ISHFTC - Section 13.13.50
 207 c     The third argument is not optional in g77
 208       i  = 3
 209       i2 = 2
 210       i3 = 3
 211       ia = 5
 212       j  = 3
 213       j2 = 2
 214       j3 = 3
 215       ja = 5
 216       k  = 3
 217       k2 = 2
 218       k3 = 3
 219       ka = 5
 220       m2 = 2
 221       m3 = 3
 222       ma = 5
 223 c     test all the combinations of arguments
 224       call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
 225       call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer(2))')
 226       call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer(1))')
 227       call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer(8))')
 228       call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer(2),integer)')
 229       call c_i(ISHFTC(i,j2,j3),5,
 230      &  'ISHFTC(integer,integer(2),integer(2))')
 231       call c_i(ISHFTC(i,j2,k3),5,
 232      &  'ISHFTC(integer,integer(2),integer(1))')
 233       call c_i(ISHFTC(i,j2,m3),5,
 234      &  'ISHFTC(integer,integer(2),integer(8))')
 235       call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer(1),integer)')
 236       call c_i(ISHFTC(i,k2,j3),5,
 237      &  'ISHFTC(integer,integer(1),integer(2))')
 238       call c_i(ISHFTC(i,k2,k3),5,
 239      &  'ISHFTC(integer,integer(1),integer(1))')
 240       call c_i(ISHFTC(i,k2,m3),5,
 241      &  'ISHFTC(integer,integer(1),integer(8))')
 242       call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer(8),integer)')
 243       call c_i(ISHFTC(i,m2,j3),5,
 244      &  'ISHFTC(integer,integer(8),integer(2))')
 245       call c_i(ISHFTC(i,m2,k3),5,
 246      &  'ISHFTC(integer,integer(8),integer(1))')
 247       call c_i(ISHFTC(i,m2,m3),5,
 248      &  'ISHFTC(integer,integer(8),integer(8))')
 249
 250       call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer(2),integer,integer)')
 251       call c_i2(ISHFTC(j,i2,j3),ja,
 252      $     'ISHFTC(integer(2),integer,integer(2))')
 253       call c_i2(ISHFTC(j,i2,k3),ja,
 254      $     'ISHFTC(integer(2),integer,integer(1))')
 255       call c_i2(ISHFTC(j,i2,m3),ja,
 256      $     'ISHFTC(integer(2),integer,integer(8))')
 257       call c_i2(ISHFTC(j,j2,i3),ja,
 258      $     'ISHFTC(integer(2),integer(2),integer)')
 259       call c_i2(ISHFTC(j,j2,j3),ja,
 260      $     'ISHFTC(integer(2),integer(2),integer(2))')
 261       call c_i2(ISHFTC(j,j2,k3),ja,
 262      $     'ISHFTC(integer(2),integer(2),integer(1))')
 263       call c_i2(ISHFTC(j,j2,m3),ja,
 264      $     'ISHFTC(integer(2),integer(2),integer(8))')
 265       call c_i2(ISHFTC(j,k2,i3),ja,
 266      $     'ISHFTC(integer(2),integer(1),integer)')
 267       call c_i2(ISHFTC(j,k2,j3),ja,
 268      $     'ISHFTC(integer(2),integer(1),integer(2))')
 269       call c_i2(ISHFTC(j,k2,k3),ja,
 270      $     'ISHFTC(integer(2),integer(1),integer(1))')
 271       call c_i2(ISHFTC(j,k2,m3),ja,
 272      $     'ISHFTC(integer(2),integer(1),integer(8))')
 273       call c_i2(ISHFTC(j,m2,i3),ja,
 274      $     'ISHFTC(integer(2),integer(8),integer)')
 275       call c_i2(ISHFTC(j,m2,j3),ja,
 276      $     'ISHFTC(integer(2),integer(8),integer(2))')
 277       call c_i2(ISHFTC(j,m2,k3),ja,
 278      $     'ISHFTC(integer(2),integer(8),integer(1))')
 279       call c_i2(ISHFTC(j,m2,m3),ja,
 280      $     'ISHFTC(integer(2),integer(8),integer(8))')
 281
 282       call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer(1),integer,integer)')
 283       call c_i1(ISHFTC(k,i2,j3),ka,
 284      $     'ISHFTC(integer(1),integer,integer(2))')
 285       call c_i1(ISHFTC(k,i2,k3),ka,
 286      $     'ISHFTC(integer(1),integer,integer(1))')
 287       call c_i1(ISHFTC(k,i2,m3),ka,
 288      $     'ISHFTC(integer(1),integer,integer(8))')
 289       call c_i1(ISHFTC(k,j2,i3),ka,
 290      $     'ISHFTC(integer(1),integer(2),integer)')
 291       call c_i1(ISHFTC(k,j2,j3),ka,
 292      $     'ISHFTC(integer(1),integer(2),integer(2))')
 293       call c_i1(ISHFTC(k,j2,k3),ka,
 294      $     'ISHFTC(integer(1),integer(2),integer(1))')
 295       call c_i1(ISHFTC(k,j2,m3),ka,
 296      $     'ISHFTC(integer(1),integer(2),integer(8))')
 297       call c_i1(ISHFTC(k,k2,i3),ka,
 298      $     'ISHFTC(integer(1),integer(1),integer)')
 299       call c_i1(ISHFTC(k,k2,j3),ka,
 300      $     'ISHFTC(integer(1),integer(1),integer(2))')
 301       call c_i1(ISHFTC(k,k2,k3),ka,
 302      $     'ISHFTC(integer(1),integer(1),integer(1))')
 303       call c_i1(ISHFTC(k,k2,m3),ka,
 304      $     'ISHFTC(integer(1),integer(1),integer(8))')
 305       call c_i1(ISHFTC(k,m2,i3),ka,
 306      $     'ISHFTC(integer(1),integer(8),integer)')
 307       call c_i1(ISHFTC(k,m2,j3),ka,
 308      $     'ISHFTC(integer(1),integer(8),integer(2))')
 309       call c_i1(ISHFTC(k,m2,k3),ka,
 310      $     'ISHFTC(integer(1),integer(8),integer(1))')
 311       call c_i1(ISHFTC(k,m2,m3),ka,
 312      $     'ISHFTC(integer(1),integer(8),integer(8))')
 313
 314       call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer(8),integer,integer)')
 315       call c_i8(ISHFTC(m,i2,j3),ma,
 316      $     'ISHFTC(integer(8),integer,integer(2))')
 317       call c_i8(ISHFTC(m,i2,k3),ma,
 318      $     'ISHFTC(integer(8),integer,integer(1))')
 319       call c_i8(ISHFTC(m,i2,m3),ma,
 320      $     'ISHFTC(integer(8),integer,integer(8))')
 321       call c_i8(ISHFTC(m,j2,i3),ma,
 322      $     'ISHFTC(integer(8),integer(2),integer)')
 323       call c_i8(ISHFTC(m,j2,j3),ma,
 324      $     'ISHFTC(integer(8),integer(2),integer(2))')
 325       call c_i8(ISHFTC(m,j2,k3),ma,
 326      $     'ISHFTC(integer(8),integer(2),integer(1))')
 327       call c_i8(ISHFTC(m,j2,m3),ma,
 328      $     'ISHFTC(integer(8),integer(2),integer(8))')
 329       call c_i8(ISHFTC(m,k2,i3),ma,
 330      $     'ISHFTC(integer(8),integer(1),integer)')
 331       call c_i8(ISHFTC(m,k2,j3),ma,
 332      $     'ISHFTC(integer(1),integer(8),integer(2))')
 333       call c_i8(ISHFTC(m,k2,k3),ma,
 334      $     'ISHFTC(integer(1),integer(8),integer(1))')
 335       call c_i8(ISHFTC(m,k2,m3),ma,
 336      $     'ISHFTC(integer(1),integer(8),integer(8))')
 337       call c_i8(ISHFTC(m,m2,i3),ma,
 338      $     'ISHFTC(integer(8),integer(8),integer)')
 339       call c_i8(ISHFTC(m,m2,j3),ma,
 340      $     'ISHFTC(integer(8),integer(8),integer(2))')
 341       call c_i8(ISHFTC(m,m2,k3),ma,
 342      $     'ISHFTC(integer(8),integer(8),integer(1))')
 343       call c_i8(ISHFTC(m,m2,m3),ma,
 344      $     'ISHFTC(integer(8),integer(8),integer(8))')
 345
 346 c     test the corner cases
 347       call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
 348      $     'ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)) i = integer')
 349       call c_i(ISHFTC(i,0,BIT_SIZE(i)),i,
 350      $     'ISHFTC(i,0,BIT_SIZE(i)) i = integer')
 351       call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
 352      $     'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
 353       call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
 354      $     'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
 355       call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
 356      $     'ISHFTC(j,0,BIT_SIZE(j)) j = integer(2)')
 357       call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
 358      $     'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
 359       call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
 360      $     'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
 361       call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
 362      $     'ISHFTC(k,0,BIT_SIZE(k)) k = integer(1)')
 363       call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
 364      $     'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
 365       call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
 366      $     'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
 367       call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
 368      $     'ISHFTC(m,0,BIT_SIZE(m)) m = integer(8)')
 369       call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
 370      $     'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
 371
 372 c     MVBITS - Section 13.13.74
 373       i = 6
 374       call MVBITS(7,2,2,i,0)
 375       call c_i(i,5,'MVBITS 1')
 376       j = 6
 377       j2 = 7
 378       ja = 5
 379       call MVBITS(j2,2,2,j,0)
 380       call c_i2(j,ja,'MVBITS 2')
 381       k = 6
 382       k2 = 7
 383       ka = 5
 384       call MVBITS(k2,2,2,k,0)
 385       call c_i1(k,ka,'MVBITS 3')
 386       m = 6
 387       m2 = 7
 388       ma = 5
 389       call MVBITS(m2,2,2,m,0)
 390       call c_i8(m,ma,'MVBITS 4')
 391
 392 c     NOT    - Section 13.13.77
 393 c     Rather than assume integer sizes, mask off high bits
 394       j  = 21
 395       j2 = 31
 396       ja = 10
 397       k  = 21
 398       k2 = 31
 399       ka = 10
 400       m  = 21
 401       m2 = 31
 402       ma = 10
 403       call c_i(IAND(NOT(21),31),10,'NOT(integer)')
 404       call c_i2(IAND(NOT(j),j2),ja,'NOT(integer(2))')
 405       call c_i1(IAND(NOT(k),k2),ka,'NOT(integer(1))')
 406       call c_i8(IAND(NOT(m),m2),ma,'NOT(integer(8))')
 407
 408       if ( fail ) call abort()
 409       end
 410
 411       subroutine failure(label)
 412 c     Report failure and set flag
 413       character*(*) label
 414       logical fail
 415       common /flags/ fail
 416       write(6,'(a,a,a)') 'Test ',label,' FAILED'
 417       fail = .true.
 418       end
 419
 420       subroutine c_l(i,j,label)
 421 c     Check if LOGICAL i equals j, and fail otherwise
 422       logical i,j
 423       character*(*) label
 424       if ( i .eqv. j ) then
 425          call failure(label)
 426          write(6,*) 'Got ',i,' expected ', j
 427       end if
 428       end
 429
 430       subroutine c_i(i,j,label)
 431 c     Check if INTEGER i equals j, and fail otherwise
 432       integer i,j
 433       character*(*) label
 434       if ( i .ne. j ) then
 435          call failure(label)
 436          write(6,*) 'Got ',i,' expected ', j
 437       end if
 438       end
 439
 440       subroutine c_i2(i,j,label)
 441 c     Check if INTEGER(kind=2) i equals j, and fail otherwise
 442       integer(kind=2) i,j
 443       character*(*) label
 444       if ( i .ne. j ) then
 445          call failure(label)
 446          write(6,*) 'Got ',i,' expected ', j
 447       end if
 448       end
 449
 450       subroutine c_i1(i,j,label)
 451 c     Check if INTEGER(kind=1) i equals j, and fail otherwise
 452       integer(kind=1) i,j
 453       character*(*) label
 454       if ( i .ne. j ) then
 455          call failure(label)
 456          write(6,*) 'Got ',i,' expected ', j
 457       end if
 458       end
 459
 460       subroutine c_i8(i,j,label)
 461 c     Check if INTEGER(kind=8) i equals j, and fail otherwise
 462       integer(kind=8) i,j
 463       character*(*) label
 464       if ( i .ne. j ) then
 465          call failure(label)
 466          write(6,*) 'Got ',i,' expected ', j
 467       end if
 468       end