mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 02:10:19 +02:00
* compiler discerns between +0.0 and -0.0
+ test for the above git-svn-id: trunk@1917 -
This commit is contained in:
parent
52ca5e6922
commit
b3b104130d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6392,6 +6392,7 @@ tests/webtbs/tw4519.pp -text svneol=unset#text/plain
|
||||
tests/webtbs/tw4520.pp -text svneol=unset#text/plain
|
||||
tests/webtbs/tw4529.pp -text svneol=unset#text/plain
|
||||
tests/webtbs/tw4533.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4534.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4537.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4540.pp -text svneol=unset#text/plain
|
||||
tests/webtbs/tw4557.pp svneol=native#text/plain
|
||||
|
@ -339,6 +339,8 @@ interface
|
||||
|
||||
procedure SetFPUExceptionMask(const Mask: TFPUExceptionMask);
|
||||
function is_number_float(d : double) : boolean;
|
||||
{ discern +0.0 and -0.0 }
|
||||
function get_real_sign(r: bestreal): longint;
|
||||
|
||||
function SetAktProcCall(const s:string; changeInit: boolean):boolean;
|
||||
function SetProcessor(const s:string; changeInit: boolean):boolean;
|
||||
@ -1811,6 +1813,23 @@ end;
|
||||
{$endif FPC_BIG_ENDIAN}
|
||||
end;
|
||||
|
||||
function get_real_sign(r: bestreal): longint;
|
||||
var
|
||||
p: pbyte;
|
||||
begin
|
||||
p := @r;
|
||||
{$ifdef CPU_ARM}
|
||||
inc(p,4);
|
||||
{$else}
|
||||
{$ifdef FPC_LITTLE_ENDIAN}
|
||||
inc(p,sizeof(r)-1);
|
||||
{$endif}
|
||||
{$endif}
|
||||
if (p^ and $80) = 0 then
|
||||
result := 1
|
||||
else
|
||||
result := -1;
|
||||
end;
|
||||
|
||||
function convertdoublearray(d : tdoublearray) : tdoublearray;{$ifdef USEINLINE}inline;{$endif}
|
||||
{$ifdef CPUARM}
|
||||
|
@ -85,6 +85,7 @@ implementation
|
||||
hp1 : tai;
|
||||
lastlabel : tasmlabel;
|
||||
realait : taitype;
|
||||
value_real_sign, hp1_sign: pbyte;
|
||||
{$ifdef ARM}
|
||||
hiloswapped : boolean;
|
||||
{$endif ARM}
|
||||
@ -111,22 +112,22 @@ implementation
|
||||
begin
|
||||
if is_number_float(value_real) and
|
||||
(
|
||||
((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real) and is_number_float(tai_real_32bit(hp1).value)) or
|
||||
((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real) and is_number_float(tai_real_32bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_32bit(hp1).value))) or
|
||||
((realait=ait_real_64bit) and
|
||||
{$ifdef ARM}
|
||||
((tai_real_64bit(hp1).formatoptions=fo_hiloswapped)=hiloswapped) and
|
||||
{$endif ARM}
|
||||
(tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value)) or
|
||||
((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value)) or
|
||||
(tai_real_64bit(hp1).value=value_real) and is_number_float(tai_real_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_64bit(hp1).value))) or
|
||||
((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real) and is_number_float(tai_real_80bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_80bit(hp1).value))) or
|
||||
{$ifdef cpufloat128}
|
||||
((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value)) or
|
||||
((realait=ait_real_128bit) and (tai_real_128bit(hp1).value=value_real) and is_number_float(tai_real_128bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_real_128bit(hp1).value))) or
|
||||
{$endif cpufloat128}
|
||||
((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real) and is_number_float(tai_comp_64bit(hp1).value))
|
||||
((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real) and is_number_float(tai_comp_64bit(hp1).value) and (get_real_sign(value_real) = get_real_sign(tai_comp_64bit(hp1).value)))
|
||||
) then
|
||||
begin
|
||||
{ found! }
|
||||
lab_real:=lastlabel;
|
||||
break;
|
||||
{ found! }
|
||||
lab_real:=lastlabel;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
lastlabel:=nil;
|
||||
|
26
tests/webtbs/tw4534.pp
Normal file
26
tests/webtbs/tw4534.pp
Normal file
@ -0,0 +1,26 @@
|
||||
type
|
||||
pbyte = ^byte;
|
||||
|
||||
procedure checksigns(a,b: extended);
|
||||
var
|
||||
p1, p2: pbyte;
|
||||
i: longint;
|
||||
begin
|
||||
p1 := @a;
|
||||
p2 := @b;
|
||||
for i := 1 to sizeof(a) do
|
||||
begin
|
||||
if (p1^ xor p2^) = $80 then
|
||||
halt(0);
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
var x,y:extended;
|
||||
|
||||
Begin
|
||||
x:=-0.0;
|
||||
y:=0.0;
|
||||
checksigns(x,y);
|
||||
End.
|
||||
|
Loading…
Reference in New Issue
Block a user