mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-03 20:49:35 +01:00
* the result of not(dword(ordconst)) has to be dword as well for Delphi
compatibility (and to avoid range errors like in mantis #10931) git-svn-id: trunk@10451 -
This commit is contained in:
parent
761f2e5c93
commit
0ae33aeab0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8007,6 +8007,7 @@ tests/webtbs/tw10897.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1090.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1092.pp svneol=native#text/plain
|
||||
tests/webtbs/tw10920.pp svneol=native#text/plain
|
||||
tests/webtbs/tw10931.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1096.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1097.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1103.pp svneol=native#text/plain
|
||||
|
||||
@ -625,8 +625,8 @@ implementation
|
||||
resultdef:=typedef;
|
||||
{ only do range checking when explicitly asked for it
|
||||
and if the type can be range checked, see tests/tbs/tb0539.pp }
|
||||
if rangecheck and (resultdef.typ in [orddef,enumdef]) then
|
||||
testrange(resultdef,value,false);
|
||||
if (resultdef.typ in [orddef,enumdef]) then
|
||||
testrange(resultdef,value,not rangecheck)
|
||||
end;
|
||||
|
||||
function tordconstnode.pass_1 : tnode;
|
||||
|
||||
@ -799,18 +799,24 @@ implementation
|
||||
s8bit,
|
||||
u16bit,
|
||||
s16bit,
|
||||
u32bit,
|
||||
s32bit,
|
||||
s64bit,
|
||||
u64bit :
|
||||
s64bit:
|
||||
begin
|
||||
v:=int64(not int64(v)); { maybe qword is required }
|
||||
int_to_type(v,def);
|
||||
end;
|
||||
u32bit,
|
||||
u64bit :
|
||||
begin
|
||||
{ Delphi-compatible: not dword = dword (not word = longint) }
|
||||
{ Extension: not qword = qword }
|
||||
v:=qword(not qword(v));
|
||||
{ will be truncated by the ordconstnode for u32bit }
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
t:=cordconstnode.create(v,def,true);
|
||||
t:=cordconstnode.create(v,def,false);
|
||||
result:=t;
|
||||
exit;
|
||||
end;
|
||||
|
||||
18
tests/webtbs/tw10931.pp
Normal file
18
tests/webtbs/tw10931.pp
Normal file
@ -0,0 +1,18 @@
|
||||
{ %opt=-Cr -Sew }
|
||||
|
||||
var
|
||||
a: PtrUInt;
|
||||
q: qword;
|
||||
begin
|
||||
a := not(ptruint(7));
|
||||
if a<>$fffffff8 then
|
||||
halt(1);
|
||||
q := not(qword(7));
|
||||
if q<>qword($fffffffffffffff8) then
|
||||
halt(2);
|
||||
a := 99;
|
||||
WriteLn((a + 9) and not PtrUInt(7));
|
||||
if ((a + 9) and not PtrUInt(7))<>$68 then
|
||||
halt(3);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user