Sfoglia il codice sorgente

* fpc_ln_real raises an exception for invalid operands if they exception is not masked

git-svn-id: trunk@47813 -
florian 4 anni fa
parent
commit
1d92cc43bb
2 ha cambiato i file con 20 aggiunte e 2 eliminazioni
  1. 8 2
      rtl/inc/genmath.inc
  2. 12 0
      tests/test/texception4.pp

+ 8 - 2
rtl/inc/genmath.inc

@@ -1443,9 +1443,15 @@ end;
       if (hx < $00100000) then              { x < 2**-1022  }
       begin
         if (((hx and $7fffffff) or longint(lx))=0) then
-          exit(-two54/zero);                { log(+-0)=-inf }
+          begin
+            float_raise(float_flag_divbyzero);
+            exit(-two54/zero);                { log(+-0)=-inf }
+          end;
         if (hx<0) then
-          exit((d-d)/zero);                 { log(-#) = NaN }
+          begin
+            float_raise(float_flag_invalid);
+            exit((d-d)/zero);                 { log(-#) = NaN }
+          end;
         dec(k, 54); d := d * two54;         { subnormal number, scale up x }
         hx := float64high(d);
       end;

+ 12 - 0
tests/test/texception4.pp

@@ -123,6 +123,18 @@ begin
        end;
    end;
    test_exception('ln(-1)');
+   try
+   exception_called:=false;
+   i := 0;
+   e := ln(i);
+   except
+     on e : exception do
+       begin
+         Writeln('exception called ',e.message);
+         exception_called:=true;
+       end;
+   end;
+   test_exception('ln(0)');
    if program_has_errors then
      Halt(1);
 end.