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

* fixed val(s,int64) (it accepted values in the range

Browse Source 
high(int64+1)..high(qword) if written in decimal notation) + test
  * fixed range checking of qword constants parsed by the compiler
    (they always gave a range error if > high(int64), because the compiler
     internally stores them as int64)
  * turn off range checking flag of rdconstnodes created by the parser
    from _INTCONST, because those are already range checked by the
    way they are parsed using val()

git-svn-id: trunk@6814 -
This commit is contained in:
Jonas Maebe 2007-03-12 22:22:43 +00:00
parent d79d29ccda
commit 69cf42c4f7
10 changed files with 64 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6264,6 +6264,7 @@ tests/tbs/tb0528.pp svneol=native#text/x-pascal
tests/tbs/tb0530.pp svneol=native#text/plain
tests/tbs/tb0531.pp svneol=native#text/plain
tests/tbs/tb0532.pp svneol=native#text/x-pascal
tests/tbs/tb0533.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain
tests/tbs/ub0119.pp svneol=native#text/plain

27
compiler/defutil.pas
View File

@ -198,10 +198,10 @@ interface
{# Returns true, if def is a 64 bit type }
function is_64bit(def : tdef) : boolean;
{# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
{# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
the value is placed within the range
}
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
procedure testrange(fromdef, todef : tdef;var l : tconstexprint;explicit:boolean);
{# Returns the range of def, where @var(l) is the low-range and @var(h) is
the high-range.
@ -693,9 +693,9 @@ implementation
end;
{ if l isn't in the range of def a range check error (if not explicit) is generated and
{ if l isn't in the range of todef a range check error (if not explicit) is generated and
the value is placed within the range }
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
procedure testrange(fromdef, todef : tdef;var l : tconstexprint;explicit:boolean);
var
lv,hv: TConstExprInt;
error: boolean;
@ -703,9 +703,14 @@ implementation
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
if is_64bitint(todef) then
begin
if (l<0) and (torddef(def).ordtype=u64bit) then
if (l<0) and
(torddef(todef).ordtype=u64bit) and
{ since tconstexprint is an int64, values > high(int64) will }
{ always be stored as negative numbers }
(not is_64bitint(fromdef) or
(torddef(fromdef).ordtype<>u64bit)) then
begin
{ don't zero the result, because it may come from hex notation
like $ffffffffffffffff! (JM)
@ -722,12 +727,12 @@ implementation
end
else
begin
getrange(def,lv,hv);
getrange(todef,lv,hv);
if (l<lv) or (l>hv) then
begin
if not explicit then
begin
if ((def.typ=enumdef) and
if ((todef.typ=enumdef) and
{ delphi allows range check errors in
enumeration type casts FK }
not(m_delphi in current_settings.modeswitches)) or
@ -742,16 +747,16 @@ implementation
if error then
begin
{ Fix the value to fit in the allocated space for this type of variable }
case longint(def.size) of
case longint(todef.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;
{ do sign extension if necessary (JM) }
if is_signed(def) then
if is_signed(todef) then
begin
case longint(def.size) of
case longint(todef.size) of
1: l := shortint(l);
2: l := smallint(l);
4: l := longint(l);

4
compiler/ncnv.pas
View File

@ -1830,10 +1830,10 @@ implementation
not(convtype=tc_char_2_char) then
begin
{ replace the resultdef and recheck the range }
left.resultdef:=resultdef;
if ([nf_explicit,nf_internal] * flags <> []) then
include(left.flags, nf_explicit);
testrange(left.resultdef,tordconstnode(left).value,(nf_explicit in flags));
testrange(left.resultdef,resultdef,tordconstnode(left).value,(nf_explicit in flags));
left.resultdef:=resultdef;
result:=left;
left:=nil;
exit;

2
compiler/ncon.pas
View File

@ -623,7 +623,7 @@ implementation
resultdef:=typedef;
{ only do range checking when explicitly asked for it }
if rangecheck then
testrange(resultdef,value,false);
testrange(resultdef,resultdef,value,false);
end;
function tordconstnode.pass_1 : tnode;

4
compiler/ninl.pas
View File

@ -1419,9 +1419,9 @@ implementation
(index.left.nodetype = ordconstn) and
not is_special_array(unpackedarraydef) then
begin
testrange(unpackedarraydef,tordconstnode(index.left).value,false);
testrange(index.left.resultdef,unpackedarraydef,tordconstnode(index.left).value,false);
tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
testrange(unpackedarraydef,tempindex,false);
testrange(index.left.resultdef,unpackedarraydef,tempindex,false);
end;
end;

5
compiler/pexpr.pas
View File

@ -2459,7 +2459,10 @@ implementation
consume(_INTCONST);
p1:=crealconstnode.create(d,pbestrealtype^);
end;
end;
end
else
{ the necessary range checking has already been done by val }
tordconstnode(p1).rangecheck:=false;
end;
_REALNUMBER :

6
compiler/pstatmnt.pas
View File

@ -183,8 +183,8 @@ implementation
CGMessage(parser_e_case_lower_less_than_upper_bound);
if not casedeferror then
begin
testrange(casedef,hl1,false);
testrange(casedef,hl2,false);
testrange(casedef,casedef,hl1,false);
testrange(casedef,casedef,hl2,false);
end;
end
else
@ -198,7 +198,7 @@ implementation
CGMessage(parser_e_case_mismatch);
hl1:=get_ordinal_value(p);
if not casedeferror then
testrange(casedef,hl1,false);
testrange(casedef,casedef,hl1,false);
casenode.addlabel(blockid,hl1,hl1);
end;
p.free;

2
compiler/ptconst.pas
View File

@ -233,7 +233,7 @@ implementation
begin
if is_constintnode(n) then
begin
testrange(def,tordconstnode(n).value,false);
testrange(n.resultdef,def,tordconstnode(n).value,false);
case def.size of
1 :
list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value)));

16
rtl/inc/sstrings.inc
View File

@ -879,7 +879,7 @@ end;
Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; [public, alias:'FPC_VAL_INT64_SHORTSTR']; compilerproc;
var u, temp, prev : qword;
var u, temp, prev, maxprevvalue, maxnewvalue : qword;
base : byte;
negative : boolean;
@ -892,6 +892,11 @@ end;
Code:=InitVal(s,negative,base);
if Code>length(s) then
exit;
maxprevvalue := maxqword div base;
if (base = 10) then
maxnewvalue := maxint64 + ord(negative)
else
maxnewvalue := maxqword;
while Code<=Length(s) do
begin
@ -904,13 +909,10 @@ end;
u:=16;
end;
Prev:=Temp;
Temp:=Temp*Int64(base);
Temp:=Temp*qword(base);
If (u >= base) or
((base = 10) and
(maxint64-temp+ord(negative) < u)) or
((base <> 10) and
(qword(maxqword-temp) < u)) or
(prev > maxqword div qword(base)) Then
(qword(maxnewvalue-u) < temp) or
(prev > maxprevvalue) Then
Begin
fpc_val_int64_shortstr := 0;
Exit

25
tests/tbs/tb0533.pp Normal file
View File

@ -0,0 +1,25 @@
{$r+}
const
q: qword = 18446744073709551615;
var
i: int64;
code: longint;
begin
val('18446744073709551615',i,code);
if (code = 0) then
halt(1);
val('-9223372036854775808',i,code);
if (code <> 0) or
(i <> low(int64)) then
halt(2);
val('9223372036854775807',i,code);
if (code <> 0) or
(i <> high(int64)) then
halt(3);
val('$8000000000000000',i,code);
if (code <> 0) or
(i <> low(int64)) then
halt(4);
end.