paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 20:49:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed overflow checking for inc/dec on non-x86

Browse Source 
+ test for the above

git-svn-id: trunk@5317 -
This commit is contained in:
Jonas Maebe 2006-11-10 21:14:11 +00:00
parent 5522cbd7cd
commit b8c3fecd1d
4 changed files with 159 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6334,6 +6334,7 @@ tests/test/cg/tfor.pp svneol=native#text/plain
tests/test/cg/tformfnc.pp -text
tests/test/cg/tfuncret.pp svneol=native#text/plain
tests/test/cg/tin.pp svneol=native#text/plain
tests/test/cg/tincdec.pp svneol=native#text/plain
tests/test/cg/tincexc.pp svneol=native#text/plain
tests/test/cg/tinitdon.pp svneol=native#text/plain
tests/test/cg/tis.pp svneol=native#text/plain

9
compiler/ncginl.pas
View File

@ -464,7 +464,14 @@ implementation
cg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],
hregister,tcallparanode(left).left.location);
end;
cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
{ things which can overflow must NOT pass via here, but have to be }
{ handled via a regular add node (conversion in tinlinenode.pass_1) }
{ Or someone has to rewrite the above to use a_op_const_reg_reg_ov }
{ and friends in case of overflow checking, and ask everyone to }
{ implement these methods since they don't exist for all cpus (JM) }
if (cs_check_overflow in current_settings.localswitches) then
internalerror(2006111010);
// cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef);
cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,
tcallparanode(left).left.resultdef);
end;

54
compiler/ninl.pas
View File

@ -2191,7 +2191,7 @@ implementation
function tinlinenode.pass_1 : tnode;
var
hp,hpp : tnode;
hp,hpp,resultnode : tnode;
shiftconst: longint;
tempnode: ttempcreatenode;
newstatement: tstatementnode;
@ -2306,20 +2306,9 @@ implementation
begin
expectloc:=LOC_VOID;
{ check type }
if
{$ifndef cpu64bit}
is_64bit(left.resultdef) or
{$endif cpu64bit}
{ range/overflow checking doesn't work properly }
{ with the inc/dec code that's generated (JM) }
(
(((left.resultdef.typ = orddef) and
not(is_char(left.resultdef)) and
not(is_boolean(left.resultdef))) or
(left.resultdef.typ = pointerdef)) and
(current_settings.localswitches * [cs_check_overflow,cs_check_range] <> [])
) then
{ range/overflow checking doesn't work properly }
{ with the inc/dec code that's generated (JM) }
if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) then
{ convert to simple add (JM) }
begin
newblock := internalstatements(newstatement);
@ -2338,10 +2327,13 @@ implementation
hpp := cordconstnode.create(1,tcallparanode(left).left.resultdef,false);
end;
typecheckpass(hpp);
{$ifndef cpu64bit}
if not((hpp.resultdef.typ=orddef) and
{$ifndef cpu64bit}
(torddef(hpp.resultdef).ordtype<>u32bit)) then
{$endif cpu64bit}
{$else not cpu64bit}
(torddef(hpp.resultdef).ordtype<>u64bit)) then
{$endif not cpu64bit}
inserttypeconv_internal(hpp,sinttype);
{ No overflow check for pointer operations, because inc(pointer,-1) will always
trigger an overflow. For uint32 it works because then the operation is done
@ -2364,14 +2356,38 @@ implementation
hp := tcallparanode(left).left.getcopy;
tempnode := nil;
end;
resultnode := hp.getcopy;
{ avoid type errors from the addn/subn }
if not is_integer(resultnode.resultdef) and
(resultnode.resultdef.typ <> pointerdef) then
begin
inserttypeconv_internal(hp,sinttype);
inserttypeconv_internal(hpp,sinttype);
end;
{ addition/substraction depending on inc/dec }
if inlinenumber = in_inc_x then
hpp := caddnode.create(addn,hp,hpp)
else
hpp := caddnode.create(subn,hp,hpp);
{ assign result of addition }
inserttypeconv_internal(hpp,hp.resultdef);
addstatement(newstatement,cassignmentnode.create(hp.getcopy,hpp));
if not(is_integer(resultnode.resultdef)) and
(resultnode.resultdef.typ <> pointerdef) then
inserttypeconv(hpp,torddef.create(
{$ifdef cpu64bit}
s64bit,
{$else cpu64bit}
s32bit,
{$endif cpu64bit}
get_min_value(resultnode.resultdef),
get_max_value(resultnode.resultdef)))
else
inserttypeconv(hpp,resultnode.resultdef);
{ avoid any possible warnings }
inserttypeconv_internal(hpp,resultnode.resultdef);
addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
{ deallocate the temp }
if assigned(tempnode) then
addstatement(newstatement,ctempdeletenode.create(tempnode));

115
tests/test/cg/tincdec.pp Normal file
View File

@ -0,0 +1,115 @@
{$mode objfpc}
{$q+}
{$r+}
uses
sysutils;
type
tenum = (ea,eb,ec,ed,ef,eg,eh);
procedure testbool;
var
b: boolean;
caught: boolean;
begin
caught := false;
b := false;
inc(b);
try
inc(b);
except
on ERangeError do
caught := true;
end;
if not caught or
not b then
halt(1);
caught := false;
dec(b);
try
dec(b);
except
on ERangeError do
caught := true;
end;
if not caught or
b then
halt(2);
end;
procedure testchar;
var
b: char;
caught: boolean;
begin
caught := false;
b := #254;
inc(b);
try
inc(b);
except
on ERangeError do
caught := true;
end;
if not caught or
(b <> #255) then
halt(3);
caught := false;
b := #1;
dec(b);
try
dec(b);
except
on ERangeError do
caught := true;
end;
if not caught or
(b <> #0) then
halt(4);
end;
procedure testenum;
var
b: tenum;
caught: boolean;
begin
caught := false;
b := eg;
inc(b);
try
inc(b);
except
on ERangeError do
caught := true;
end;
if not caught or
(b <> eh) then
halt(5);
caught := false;
b := eb;
dec(b);
try
dec(b);
except
on ERangeError do
caught := true;
end;
if not caught or
(b <> ea) then
halt(6);
end;
begin
testbool;
testchar;
testenum;
end.