mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 18:49:16 +02:00
* denormalized value floating point exception has to result in an rte 206, resolves part of #37926
git-svn-id: trunk@47114 -
This commit is contained in:
parent
3b0168ae16
commit
15695b317c
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -18491,6 +18491,7 @@ tests/webtbs/tw37806.pp svneol=native#text/pascal
|
|||||||
tests/webtbs/tw3782.pp svneol=native#text/plain
|
tests/webtbs/tw3782.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw37823.pp svneol=native#text/pascal
|
tests/webtbs/tw37823.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw37844.pp svneol=native#text/pascal
|
tests/webtbs/tw37844.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw37926.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw3796.pp svneol=native#text/plain
|
tests/webtbs/tw3796.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3805.pp svneol=native#text/plain
|
tests/webtbs/tw3805.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3814.pp svneol=native#text/plain
|
tests/webtbs/tw3814.pp svneol=native#text/plain
|
||||||
|
@ -60,7 +60,7 @@ begin
|
|||||||
else if (FpuState and FPU_Underflow)<>0 then
|
else if (FpuState and FPU_Underflow)<>0 then
|
||||||
res:=206
|
res:=206
|
||||||
else if (FpuState and FPU_Denormal)<>0 then
|
else if (FpuState and FPU_Denormal)<>0 then
|
||||||
res:=216
|
res:=206
|
||||||
else
|
else
|
||||||
res:=207; {'Coprocessor Error'}
|
res:=207; {'Coprocessor Error'}
|
||||||
end;
|
end;
|
||||||
@ -80,7 +80,7 @@ begin
|
|||||||
else if (MMState and MM_Underflow)<>0 then
|
else if (MMState and MM_Underflow)<>0 then
|
||||||
res:=206
|
res:=206
|
||||||
else if (MMState and MM_Denormal)<>0 then
|
else if (MMState and MM_Denormal)<>0 then
|
||||||
res:=216
|
res:=206
|
||||||
else
|
else
|
||||||
res:=207; {'Coprocessor Error'}
|
res:=207; {'Coprocessor Error'}
|
||||||
end;
|
end;
|
||||||
|
@ -76,7 +76,7 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
|
|||||||
else if (FpuState and FPU_Underflow)<>0 then
|
else if (FpuState and FPU_Underflow)<>0 then
|
||||||
res:=206
|
res:=206
|
||||||
else if (FpuState and FPU_Denormal)<>0 then
|
else if (FpuState and FPU_Denormal)<>0 then
|
||||||
res:=216
|
res:=206
|
||||||
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
|
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
|
||||||
res:=207
|
res:=207
|
||||||
else
|
else
|
||||||
@ -100,7 +100,7 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
|
|||||||
else if (MMState and MM_Underflow)<>0 then
|
else if (MMState and MM_Underflow)<>0 then
|
||||||
res:=206
|
res:=206
|
||||||
else if (MMState and MM_Denormal)<>0 then
|
else if (MMState and MM_Denormal)<>0 then
|
||||||
res:=216
|
res:=206
|
||||||
else
|
else
|
||||||
res:=207; {'Coprocessor Error'}
|
res:=207; {'Coprocessor Error'}
|
||||||
|
|
||||||
@ -122,7 +122,6 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
|
|||||||
{ clear top }
|
{ clear top }
|
||||||
swd:=swd and not($3700);
|
swd:=swd and not($3700);
|
||||||
end;
|
end;
|
||||||
SysResetFPU;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
SIGILL,
|
SIGILL,
|
||||||
|
24
tests/webtbs/tw37926.pp
Normal file
24
tests/webtbs/tw37926.pp
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
uses
|
||||||
|
sysutils,math;
|
||||||
|
procedure test(const s: single);
|
||||||
|
var
|
||||||
|
tempcode: integer;
|
||||||
|
sr: single;
|
||||||
|
begin
|
||||||
|
Val('8.077936E-28', sr, tempcode);
|
||||||
|
if sr <> s then
|
||||||
|
end;
|
||||||
|
|
||||||
|
var s, sr: single;
|
||||||
|
i, j, tempcode: Integer;
|
||||||
|
begin
|
||||||
|
for i := 1 to 5000 do begin
|
||||||
|
s := 0;
|
||||||
|
try
|
||||||
|
for j := 0 to Random(5) do s := s + Random(2) * power(2, Random(256) - 127);
|
||||||
|
except
|
||||||
|
on e: EMathError do s := 0; //continue;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user