From 1e1848da92eb5db956acfb7d43c1470ae8102d3c Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 2 May 2021 19:45:09 +0000
Subject: [PATCH]   * fix exception generation in ln(...), resolves #38832

git-svn-id: trunk@49328 -
---
 .gitattributes          |  1 +
 rtl/inc/genmath.inc     | 17 +++++++++--------
 tests/webtbs/tw38832.pp | 21 +++++++++++++++++++++
 3 files changed, 31 insertions(+), 8 deletions(-)
 create mode 100644 tests/webtbs/tw38832.pp

diff --git a/.gitattributes b/.gitattributes
index c37a99b6fb..196fae90b9 100644
--- a/.gitattributes
+++ b/.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
diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc
index 43c784b177..140ba02df1 100644
--- a/rtl/inc/genmath.inc
+++ b/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;
diff --git a/tests/webtbs/tw38832.pp b/tests/webtbs/tw38832.pp
new file mode 100644
index 0000000000..1dda63976b
--- /dev/null
+++ b/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.