2
0
Эх сурвалжийг харах

* fix exception generation in ln(...), resolves #38832

git-svn-id: trunk@49328 -
florian 4 жил өмнө
parent
commit
1e1848da92

+ 1 - 0
.gitattributes

@@ -18843,6 +18843,7 @@ tests/webtbs/tw38718.pp svneol=native#text/pascal
 tests/webtbs/tw38733.pp svneol=native#text/pascal
 tests/webtbs/tw38766.pp svneol=native#text/plain
 tests/webtbs/tw38802.pp svneol=native#text/pascal
+tests/webtbs/tw38832.pp svneol=native#text/pascal
 tests/webtbs/tw38833.pp svneol=native#text/plain
 tests/webtbs/tw3893.pp svneol=native#text/plain
 tests/webtbs/tw3898.pp svneol=native#text/plain

+ 9 - 8
rtl/inc/genmath.inc

@@ -1435,6 +1435,12 @@ end;
       hfsq,f,s,z,R,w,t1,t2,dk: double;
       k,hx,i,j: longint;
       lx: longword;
+{$push}
+{ if we have to check manually fpu exceptions, then force the exit statements here to
+  throw one }
+{$CHECKFPUEXCEPTIONS+}
+{ turn off fastmath as it converts (d-d)/zero into 0 and thus not raising an exception }
+{$OPTIMIZATION NOFASTMATH}
     begin
       hx := float64high(d);
       lx := float64low(d);
@@ -1443,20 +1449,15 @@ end;
       if (hx < $00100000) then              { x < 2**-1022  }
       begin
         if (((hx and $7fffffff) or longint(lx))=0) then
-          begin
-            float_raise(float_flag_divbyzero);
-            exit(-two54/zero);                { log(+-0)=-inf }
-          end;
+          exit(-two54/zero);                { log(+-0)=-inf }
         if (hx<0) then
-          begin
-            float_raise(float_flag_invalid);
-            exit((d-d)/zero);                 { log(-#) = NaN }
-          end;
+          exit((d-d)/zero);                 { log(-#) = NaN }
         dec(k, 54); d := d * two54;         { subnormal number, scale up x }
         hx := float64high(d);
       end;
       if (hx >= $7ff00000) then
         exit(d+d);
+{$pop}
       inc(k, (hx shr 20)-1023);
       hx := hx and $000fffff;
       i := (hx + $95f64) and $100000;

+ 21 - 0
tests/webtbs/tw38832.pp

@@ -0,0 +1,21 @@
+program Math1;
+
+{$mode delphi}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ cthreads,
+ {$ENDIF}
+ Classes,
+ Math
+ { you can add units after this };
+
+var x:double;
+begin
+ SetExceptionMask([exInvalidOp,exDenormalized,exZeroDivide,exOverflow,exUnderflow,exPrecision]);
+ x:=0;
+ writeln('ln(x)');
+ writeln(ln(x));
+ writeln('1/x');
+ writeln(1/x);
+end.