* compiler discerns between +0.0 and -0.0

+ test for the above

git-svn-id: trunk@1917 -
This commit is contained in:
Jonas Maebe 2005-12-10 20:37:17 +00:00
parent 52ca5e6922
commit b3b104130d
4 changed files with 55 additions and 8 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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}

View File

@ -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
View 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.