Переглянути джерело

* fix exception generation in ln(...), resolves #38832
(cherry picked from commit 1e1848da92eb5db956acfb7d43c1470ae8102d3c)

# Conflicts:
# .gitattributes

florian 4 роки тому
батько
коміт
1f8c547561
2 змінених файлів з 28 додано та 0 видалено
  1. 7 0
      rtl/inc/genmath.inc
  2. 21 0
      tests/webtbs/tw38832.pp

+ 7 - 0
rtl/inc/genmath.inc

@@ -1456,6 +1456,12 @@ type
       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);
@@ -1472,6 +1478,7 @@ type
       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.