1! { dg-do run { target fd_truncate } } 2! PR60128 Invalid outputs with EN descriptors 3! Test case provided by Walt Brainerd. 4program pr60128 5use ISO_FORTRAN_ENV 6 implicit none 7 integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]] 8 logical :: l_skip(4) = .false. 9 integer :: i 10 integer :: n_tst = 0, n_cnt = 0, n_skip = 0 11 character(len=20) :: s, s1 12 13! Check that the default rounding mode is to nearest and to even on tie. 14 do i=1,size(real_kinds) 15 if (i == 1) then 16 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), & 17 real(9.49999905,kind=j(1)), & 18 real(9.5,kind=j(1)), real(8.5,kind=j(1)) 19 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), & 20 real(98765.0,kind=j(1)) 21 else if (i == 2) then 22 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), & 23 real(9.49999905,kind=j(2)), & 24 real(9.5,kind=j(2)), real(8.5,kind=j(2)) 25 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), & 26 real(98765.0,kind=j(2)) 27 else if (i == 3) then 28 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), & 29 real(9.49999905,kind=j(3)), & 30 real(9.5,kind=j(3)), real(8.5,kind=j(3)) 31 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), & 32 real(98765.0,kind=j(3)) 33 else if (i == 4) then 34 write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), & 35 real(9.49999905,kind=j(4)), & 36 real(9.5,kind=j(4)), real(8.5,kind=j(4)) 37 write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), & 38 real(98765.0,kind=j(4)) 39 end if 40 if (s /= '-9.5 9.5 10. 8.' .or. s1 /= ' 987.4E+03 98.76E+03') then 41 l_skip(i) = .true. 42! print "('Unsupported rounding for real(',i0,')')", j(i) 43 end if 44 end do 45 46 47! Original test. 48 call checkfmt("(en15.2)", -.44444, " -444.44E-03") 49 50! Test for the bug in comment 6. 51 call checkfmt("(en15.0)", 1.0, " 1.E+00") 52 call checkfmt("(en15.0)", 1.00000012, " 1.E+00") 53 call checkfmt("(en15.0)", 0.99999994, " 1.E+00") 54 call checkfmt("(en15.0)", 10.0, " 10.E+00") 55 call checkfmt("(en15.0)", 10.0000010, " 10.E+00") 56 call checkfmt("(en15.0)", 9.99999905, " 10.E+00") 57 call checkfmt("(en15.0)", 100.0, " 100.E+00") 58 call checkfmt("(en15.0)", 100.000008, " 100.E+00") 59 call checkfmt("(en15.0)", 99.9999924, " 100.E+00") 60 call checkfmt("(en15.0)", 1000.0, " 1.E+03") 61 call checkfmt("(en15.0)", 1000.00006, " 1.E+03") 62 call checkfmt("(en15.0)", 999.999939, " 1.E+03") 63 call checkfmt("(en15.0)", 9.5, " 10.E+00") 64 call checkfmt("(en15.0)", 9.50000095, " 10.E+00") 65 call checkfmt("(en15.0)", 9.49999905, " 9.E+00") 66 call checkfmt("(en15.0)", 99.5, " 100.E+00") 67 call checkfmt("(en15.0)", 99.5000076, " 100.E+00") 68 call checkfmt("(en15.0)", 99.4999924, " 99.E+00") 69 call checkfmt("(en15.0)", 999.5, " 1.E+03") 70 call checkfmt("(en15.0)", 999.500061, " 1.E+03") 71 call checkfmt("(en15.0)", 999.499939, " 999.E+00") 72 call checkfmt("(en15.0)", 9500.0, " 10.E+03") 73 call checkfmt("(en15.0)", 9500.00098, " 10.E+03") 74 call checkfmt("(en15.0)", 9499.99902, " 9.E+03") 75 call checkfmt("(en15.1)", 9950.0, " 10.0E+03") 76 call checkfmt("(en15.2)", 9995.0, " 10.00E+03") 77 call checkfmt("(en15.3)", 9999.5, " 10.000E+03") 78 call checkfmt("(en15.1)", 9.5, " 9.5E+00") 79 call checkfmt("(en15.1)", 9.50000095, " 9.5E+00") 80 call checkfmt("(en15.1)", 9.49999905, " 9.5E+00") 81 call checkfmt("(en15.1)", 0.099951, " 100.0E-03") 82 call checkfmt("(en15.1)", 0.009951, " 10.0E-03") 83 call checkfmt("(en15.1)", 0.000999951," 1.0E-03") 84 85 call checkfmt("(en15.0)", -1.0, " -1.E+00") 86 call checkfmt("(en15.0)", -1.00000012, " -1.E+00") 87 call checkfmt("(en15.0)", -0.99999994, " -1.E+00") 88 call checkfmt("(en15.0)", -10.0, " -10.E+00") 89 call checkfmt("(en15.0)", -10.0000010, " -10.E+00") 90 call checkfmt("(en15.0)", -9.99999905, " -10.E+00") 91 call checkfmt("(en15.0)", -100.0, " -100.E+00") 92 call checkfmt("(en15.0)", -100.000008, " -100.E+00") 93 call checkfmt("(en15.0)", -99.9999924, " -100.E+00") 94 call checkfmt("(en15.0)", -1000.0, " -1.E+03") 95 call checkfmt("(en15.0)", -1000.00006, " -1.E+03") 96 call checkfmt("(en15.0)", -999.999939, " -1.E+03") 97 call checkfmt("(en15.0)", -9.5, " -10.E+00") 98 call checkfmt("(en15.0)", -9.50000095, " -10.E+00") 99 call checkfmt("(en15.0)", -9.49999905, " -9.E+00") 100 call checkfmt("(en15.0)", -99.5, " -100.E+00") 101 call checkfmt("(en15.0)", -99.5000076, " -100.E+00") 102 call checkfmt("(en15.0)", -99.4999924, " -99.E+00") 103 call checkfmt("(en15.0)", -999.5, " -1.E+03") 104 call checkfmt("(en15.0)", -999.500061, " -1.E+03") 105 call checkfmt("(en15.0)", -999.499939, " -999.E+00") 106 call checkfmt("(en15.0)", -9500.0, " -10.E+03") 107 call checkfmt("(en15.0)", -9500.00098, " -10.E+03") 108 call checkfmt("(en15.0)", -9499.99902, " -9.E+03") 109 call checkfmt("(en15.1)", -9950.0, " -10.0E+03") 110 call checkfmt("(en15.2)", -9995.0, " -10.00E+03") 111 call checkfmt("(en15.3)", -9999.5, " -10.000E+03") 112 call checkfmt("(en15.1)", -9.5, " -9.5E+00") 113 call checkfmt("(en15.1)", -9.50000095, " -9.5E+00") 114 call checkfmt("(en15.1)", -9.49999905, " -9.5E+00") 115 call checkfmt("(en15.1)", -0.099951, " -100.0E-03") 116 call checkfmt("(en15.1)", -0.009951, " -10.0E-03") 117 call checkfmt("(en15.1)", -0.000999951," -1.0E-03") 118 119 call checkfmt("(en15.1)", 987350., " 987.4E+03") 120 call checkfmt("(en15.2)", 98735., " 98.74E+03") 121 call checkfmt("(en15.3)", 9873.5, " 9.874E+03") 122 call checkfmt("(en15.1)", 987650., " 987.6E+03") 123 call checkfmt("(en15.2)", 98765., " 98.76E+03") 124 call checkfmt("(en15.3)", 9876.5, " 9.876E+03") 125 call checkfmt("(en15.1)", 3.125E-02, " 31.2E-03") 126 call checkfmt("(en15.1)", 9.375E-02, " 93.8E-03") 127 call checkfmt("(en15.2)", 1.5625E-02, " 15.62E-03") 128 call checkfmt("(en15.2)", 4.6875E-02, " 46.88E-03") 129 call checkfmt("(en15.3)", 7.8125E-03, " 7.812E-03") 130 call checkfmt("(en15.3)", 2.34375E-02, " 23.438E-03") 131 call checkfmt("(en15.3)", 9.765625E-04," 976.562E-06") 132 call checkfmt("(en15.6)", 2.9296875E-03," 2.929688E-03") 133 134 call checkfmt("(en15.1)", -987350., " -987.4E+03") 135 call checkfmt("(en15.2)", -98735., " -98.74E+03") 136 call checkfmt("(en15.3)", -9873.5, " -9.874E+03") 137 call checkfmt("(en15.1)", -987650., " -987.6E+03") 138 call checkfmt("(en15.2)", -98765., " -98.76E+03") 139 call checkfmt("(en15.3)", -9876.5, " -9.876E+03") 140 call checkfmt("(en15.1)", -3.125E-02, " -31.2E-03") 141 call checkfmt("(en15.1)", -9.375E-02, " -93.8E-03") 142 call checkfmt("(en15.2)", -1.5625E-02, " -15.62E-03") 143 call checkfmt("(en15.2)", -4.6875E-02, " -46.88E-03") 144 call checkfmt("(en15.3)", -7.8125E-03, " -7.812E-03") 145 call checkfmt("(en15.3)", -2.34375E-02, " -23.438E-03") 146 call checkfmt("(en15.3)", -9.765625E-04," -976.562E-06") 147 call checkfmt("(en15.6)", -2.9296875E-03," -2.929688E-03") 148 149 ! print *, n_tst, n_cnt, n_skip 150 if (n_cnt /= 0) STOP 1 151 if (all(.not. l_skip)) print *, "All kinds rounded to nearest" 152 153contains 154 subroutine checkfmt(fmt, x, cmp) 155 implicit none 156 integer :: i 157 character(len=*), intent(in) :: fmt 158 real, intent(in) :: x 159 character(len=*), intent(in) :: cmp 160 do i=1,size(real_kinds) 161 if (i == 1) then 162 write(s, fmt) real(x,kind=j(1)) 163 else if (i == 2) then 164 write(s, fmt) real(x,kind=j(2)) 165 else if (i == 3) then 166 write(s, fmt) real(x,kind=j(3)) 167 else if (i == 4) then 168 write(s, fmt) real(x,kind=j(4)) 169 end if 170 n_tst = n_tst + 1 171 if (s /= cmp) then 172 if (l_skip(i)) then 173 n_skip = n_skip + 1 174 else 175 print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp 176 n_cnt = n_cnt + 1 177 end if 178 end if 179 end do 180 181 end subroutine 182end program 183! { dg-output "All kinds rounded to nearest" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } } 184