paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 21:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* another cardinal-cardinal fix

Browse Source 
git-svn-id: trunk@548 -
This commit is contained in:
peter 2005-06-30 15:19:28 +00:00
parent 1f0a20fd18
commit 534109351b
3 changed files with 44 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6098,6 +6098,7 @@ tests/webtbs/tw3971.pp svneol=native#text/plain
tests/webtbs/tw3973.pp svneol=native#text/plain
tests/webtbs/tw3977.pp svneol=native#text/plain
tests/webtbs/tw3977.txt svneol=native#text/plain
tests/webtbs/tw4009.pp svneol=native#text/plain
tests/webtbs/tw4010.pp svneol=native#text/plain
tests/webtbs/tw4013.pp svneol=native#text/plain
tests/webtbs/tw4038.pp svneol=native#text/plain

35
compiler/nadd.pas
View File

@ -962,7 +962,8 @@ implementation
{ when one of the operand is signed perform
the operation in 64bit, can't use rd/ld here because there
could be already typeconvs inserted }
if is_signed(left.resulttype.def) or is_signed(right.resulttype.def) then
if is_signed(left.resulttype.def) or
is_signed(right.resulttype.def) then
begin
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,s64inttype);
@ -970,38 +971,10 @@ implementation
end
else
begin
{ convert positive constants to u32bit }
if (torddef(ld).typ<>u32bit) and
is_constintnode(left) and
(tordconstnode(left).value >= 0) then
if (torddef(left.resulttype.def).typ<>u32bit) then
inserttypeconv(left,u32inttype);
if (torddef(rd).typ<>u32bit) and
is_constintnode(right) and
(tordconstnode(right).value >= 0) then
if (torddef(right.resulttype.def).typ<>u32bit) then
inserttypeconv(right,u32inttype);
{ when one of the operand is signed perform
the operation in 64bit, can't use rd/ld here because there
could be already typeconvs inserted }
if is_signed(left.resulttype.def) or is_signed(right.resulttype.def) then
begin
CGMessage(type_w_mixed_signed_unsigned);
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end
{ For substraction the result can be < 0 but also > maxlongint, we
fallback to int64 that can handle both }
else if (nodetype=subn) then
begin
inserttypeconv(left,s64inttype);
inserttypeconv(right,s64inttype);
end
else
begin
if (torddef(left.resulttype.def).typ<>u32bit) then
inserttypeconv(left,u32inttype);
if (torddef(right.resulttype.def).typ<>u32bit) then
inserttypeconv(right,u32inttype);
end;
end;
end
{$endif cpu64bit}

39
tests/webtbs/tw4009.pp Executable file
View File

@ -0,0 +1,39 @@
{ Source provided for Free Pascal Bug Report 4009 }
{ Submitted by "Daniël Mantione" on 2005-05-23 }
{ e-mail: daniel@freepascal.org }
program testpointercalcbug;
{$R+}
{$Q+}
type Pheader=^Theader;
Theader=record
x:cardinal
end;
Ppayload=^Tpayload;
Tpayload=record
s:string;
end;
Trecordwithheader=record
header:Theader;
payload:Tpayload;
end;
{$ifndef fpc} ptruint = cardinal; {$endif}
var r:Trecordwithheader;
p:Ppayload;
h:Pheader;
l,l2 : cardinal;
begin
p:=@r.payload;
{Calculate address of header from address of payload.}
h:=Pheader(ptruint(p)-shortint(sizeof(Theader)));
writeln(ptruint(h));
l:=$ffffffff;
l2:=1;
writeln(l-l2);
end.