diff --git a/compiler/types.pas b/compiler/types.pas index d7453a45d0..00d5b7590b 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -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 (lhv) 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