gcc/testsuite/gfortran.dg/boz_9.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fno-range-check" }
   3 !
   4 ! PR fortran/34342
   5 !
   6 ! Test for Fortran 2003 BOZ.
   7 !
   8 program f2003
   9 implicit none
  10
  11 real,parameter             :: r2c = real(int(z'3333'))
  12 real,parameter             :: rc  = real(z'3333')
  13 double precision,parameter :: dc  = dble(Z'3FD34413509F79FF')
  14 complex,parameter          :: z1c = cmplx(b'10101',-4.0)
  15 complex,parameter          :: z2c = cmplx(5.0, o'01245')
  16
  17 real             :: r2 = real(int(z'3333'))
  18 real             :: r  = real(z'3333')
  19 double precision :: d  = dble(Z'3FD34413509F79FF')
  20 complex          :: z1 = cmplx(b'10101',-4.0)
  21 complex          :: z2 = cmplx(5.0, o'01245')
  22
  23 if (r2c /= 13107.0) call abort()
  24 if (rc  /= 1.83668190E-41) call abort()
  25 if (dc /= 0.30102999566398120) call abort()
  26 if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
  27 if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
  28
  29 if (r2 /= 13107.0) call abort()
  30 if (r  /= 1.83668190E-41) call abort()
  31 if (d /= 0.30102999566398120) call abort()
  32 if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
  33 if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
  34
  35 r2 = dble(int(z'3333'))
  36 r = real(z'3333')
  37 d = dble(Z'3FD34413509F79FF')
  38 z1 = cmplx(b'10101',-4.0)
  39 z2 = cmplx(5.0, o'01245')
  40
  41 if (r2 /= 13107.0) call abort()
  42 if (r  /= 1.83668190E-41) call abort()
  43 if (d /= 0.30102999566398120) call abort()
  44 if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
  45 if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
  46
  47 call test4()
  48 call test8()
  49
  50 contains
  51
  52 subroutine test4
  53 real,parameter             :: r2c = real(int(z'3333', kind=4), kind=4)
  54 real,parameter             :: rc  = real(z'3333', kind=4)
  55 complex,parameter          :: z1c = cmplx(b'10101',-4.0, kind=4)
  56 complex,parameter          :: z2c = cmplx(5.0, o'01245', kind=4)
  57
  58 real             :: r2 = real(int(z'3333', kind=4), kind=4)
  59 real             :: r  = real(z'3333', kind=4)
  60 complex          :: z1 = cmplx(b'10101',-4.0, kind=4)
  61 complex          :: z2 = cmplx(5.0, o'01245', kind=4)
  62
  63 if (r2c /= 13107.0) call abort()
  64 if (rc  /= 1.83668190E-41) call abort()
  65 if (real(z1c) /= 2.94272678E-44 .or. aimag(z1c) /= -4.0) call abort()
  66 if (real(z2c) /= 5.0 .or. aimag(z2c) /= 9.48679060E-43) call abort()
  67
  68 if (r2 /= 13107.0) call abort()
  69 if (r  /= 1.83668190E-41) call abort()
  70 if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
  71 if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
  72
  73 r2 = real(int(z'3333'), kind=4)
  74 r = real(z'3333', kind=4)
  75 z1 = cmplx(b'10101',-4.0, kind=4)
  76 z2 = cmplx(5.0, o'01245', kind=4)
  77
  78 if (r2 /= 13107.0) call abort()
  79 if (r  /= 1.83668190E-41) call abort()
  80 if (real(z1) /= 2.94272678E-44 .or. aimag(z1) /= -4.0) call abort()
  81 if (real(z2) /= 5.0 .or. aimag(z2) /= 9.48679060E-43) call abort()
  82 end subroutine test4
  83
  84
  85 subroutine test8
  86 real(8),parameter     :: r2c = real(int(z'FFFFFF3333', kind=8), kind=8)
  87 real(8),parameter     :: rc  = real(z'AAAAAFFFFFFF3333', kind=8)
  88 complex(8),parameter  :: z1c = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
  89 complex(8),parameter  :: z2c = cmplx(5.0, o'442222222222233301245', kind=8)
  90
  91 real(8)             :: r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
  92 real(8)             :: r  = real(z'AAAAAFFFFFFF3333', kind=8)
  93 complex(8)          :: z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
  94 complex(8)          :: z2 = cmplx(5.0, o'442222222222233301245', kind=8)
  95
  96 if (r2c /= 1099511575347.0d0) call abort()
  97 if (rc  /= -3.72356884822177915d-103) call abort()
  98 if (real(z1c) /= 3.05175781249999627d-5 .or. aimag(z1c) /= -4.0) call abort()
  99 if (real(z2c) /= 5.0 .or. aimag(z2c) /= 3.98227593015308981d41) call abort()
 100
 101 if (r2 /= 1099511575347.0d0) call abort()
 102 if (r  /= -3.72356884822177915d-103) call abort()
 103 if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
 104 if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
 105
 106 r2 = real(int(z'FFFFFF3333',kind=8),kind=8)
 107 r  = real(z'AAAAAFFFFFFF3333', kind=8)
 108 z1 = cmplx(b'11111011111111111111111111111111111111111111111111111111110101',-4.0, kind=8)
 109 z2 = cmplx(5.0, o'442222222222233301245', kind=8)
 110
 111 if (r2 /= 1099511575347.0d0) call abort()
 112 if (r  /= -3.72356884822177915d-103) call abort()
 113 if (real(z1) /= 3.05175781249999627d-5 .or. aimag(z1) /= -4.0) call abort()
 114 if (real(z2) /= 5.0 .or. aimag(z2) /= 3.98227593015308981d41) call abort()
 115
 116 end subroutine test8
 117
 118 end program f2003