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

* testrange now always cuts a constant to the size of the destination

Browse Source 
if a rangeerror occurred
  * changed an "and $ffffffff" to "and (int64($fffffff) shl 4 + $f" to
    work around the constant evaluation problem we currently have
This commit is contained in:
Jonas Maebe 2000-11-20 15:52:47 +00:00
parent 71790cc1c8
commit 5d4f432257
1 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
compiler/types.pas
View File

@ -764,8 +764,10 @@ implementation
procedure testrange(def : pdef;var l : tconstexprint);
var
lv,hv: longint;
error: boolean;
begin
error := false;
{ for 64 bit types we need only to check if it is less than }
{ zero, if def is a qword node }
if is_64bitint(def) then
@ -777,6 +779,7 @@ implementation
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);
error := true;
end;
end
else
@ -794,6 +797,7 @@ implementation
else
Message(parser_w_range_check_error);
end;
error := true;
end
else
{ this happens with the wrap around problem }
@ -808,6 +812,7 @@ implementation
else
Message(parser_w_range_check_error);
end;
error := true;
end;
end
else if (l<lv) or (l>hv) then
@ -817,15 +822,17 @@ implementation
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);
{ Fix the value to fit in the allocated space for this type of variable }
case def^.size of
1: l := l and $ff;
2: l := l and $ffff;
4: l := l and $ffffffff;
end
{ l:=lv+(l mod (hv-lv+1));}
error := true;
end;
end;
if error then
{ Fix the value to fit in the allocated space for this type of variable }
case def^.size of
1: l := l and $ff;
2: l := l and $ffff;
{ work around sign extension bug (to be fixed) (JM) }
4: l := l and (int64($fffffff) shl 4 + $f);
end
end;
@ -1720,7 +1727,13 @@ implementation
end.
{
$Log$
Revision 1.23 2000-11-13 14:42:41 jonas
Revision 1.24 2000-11-20 15:52:47 jonas
* testrange now always cuts a constant to the size of the destination
if a rangeerror occurred
* changed an "and $ffffffff" to "and (int64($fffffff) shl 4 + $f" to
work around the constant evaluation problem we currently have
Revision 1.23 2000/11/13 14:42:41 jonas
* fix in testrange so that 64bit constants are properly truncated when
assigned to 32bit vars