* IntPower inverts the base first for negative exponents and multiplies then, resolves #34124

git-svn-id: trunk@39621 -
This commit is contained in:
florian 2018-08-16 20:45:35 +00:00
parent 098464d260
commit a825a66d01
3 changed files with 31 additions and 3 deletions

1
.gitattributes vendored
View File

@ -16237,6 +16237,7 @@ tests/webtbs/tw33898.pp -text svneol=native#text/pascal
tests/webtbs/tw3402.pp svneol=native#text/plain
tests/webtbs/tw34021.pp -text svneol=native#text/pascal
tests/webtbs/tw3411.pp svneol=native#text/plain
tests/webtbs/tw34124.pp svneol=native#text/pascal
tests/webtbs/tw3418.pp svneol=native#text/plain
tests/webtbs/tw3423.pp svneol=native#text/plain
tests/webtbs/tw3429.pp svneol=native#text/plain

View File

@ -1021,8 +1021,8 @@ function lnxp1(x : float) : float;
end;
end;
function power(base,exponent : float) : float;
function power(base,exponent : float) : float;
begin
if Exponent=0.0 then
result:=1.0
@ -1034,6 +1034,7 @@ function power(base,exponent : float) : float;
result:=exp(exponent * ln (base));
end;
function intpower(base : float;const exponent : Integer) : float;
var
i : longint;
@ -1042,6 +1043,8 @@ function intpower(base : float;const exponent : Integer) : float;
result:=1
else
begin
if exponent<0 then
base:=1.0/base;
i:=abs(exponent);
intpower:=1.0;
while i>0 do
@ -1054,8 +1057,6 @@ function intpower(base : float;const exponent : Integer) : float;
i:=i-1;
intpower:=intpower*base;
end;
if exponent<0 then
intpower:=1.0/intpower;
end;
end;

26
tests/webtbs/tw34124.pp Normal file
View File

@ -0,0 +1,26 @@
program intpow;
{$apptype console}
{$mode delphi}
uses sysutils, math;
var
x,d: double;
begin
{$ifdef FPC_HAS_TYPE_DOUBLE}
writeln('Spurious overflows in intpower');
try
d := 10;
x := intpower(d,-314);
writeln('10^(-314) = ',x); //should be 1e-315
except
on E: Exception do writeln('10^(-314) (should be 1e-314): ', E.Message);
end;
try
d := 2;
x := intpower(d,-2000);
writeln('2^(-2000) = ',x); //should be 0
except
on E: Exception do writeln(' 0.5^2000 (should be 0) : ', E.Message);
end;
{$endif FPC_HAS_TYPE_DOUBLE}
end.