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

* typecheck all array indices, not just integer and boolean types

Browse Source 
o allows converting indices to the proper type if required (such as
     variant, mantis #20873)
   o do not create temporary defs for this type checking anymore if not
     necessary
   o makes sure that errors are thrown in case of conversions considered
     as invalid by the compiler rather than that wrong code is silently
     generated (such as in mantis #20873 before this change)

git-svn-id: trunk@20108 -
This commit is contained in:
Jonas Maebe 2012-01-18 21:29:44 +00:00
parent bab8e5da5a
commit ceee186f2f
3 changed files with 69 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12150,6 +12150,7 @@ tests/webtbs/tw20836.pp svneol=native#text/pascal
tests/webtbs/tw20872a.pp svneol=native#text/pascal
tests/webtbs/tw20872b.pp svneol=native#text/pascal
tests/webtbs/tw20872c.pp svneol=native#text/pascal
tests/webtbs/tw20873.pp svneol=native#text/plain
tests/webtbs/tw20874a.pp svneol=native#text/pascal
tests/webtbs/tw20874b.pp svneol=native#text/pascal
tests/webtbs/tw20889.pp svneol=native#text/pascal

73
compiler/nmem.pas
View File

@ -770,6 +770,7 @@ implementation
var
hightree: tnode;
htype,elementdef : tdef;
newordtyp: tordtype;
valid : boolean;
begin
result:=nil;
@ -808,30 +809,58 @@ implementation
exit;
{ maybe type conversion for the index value, but
do not convert enums, char (why not? (JM))
and do not convert range nodes }
if (right.nodetype<>rangen) and (is_integer(right.resultdef) or is_boolean(right.resultdef) or (left.resultdef.typ<>arraydef)) then
do not convert range nodes }
if (right.nodetype<>rangen) then
case left.resultdef.typ of
arraydef:
if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then
{Variant arrays are a special array, can have negative indexes and would therefore
need s32bit. However, they should not appear in a vecn, as they are handled in
handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
internal error... }
internalerror(200707031)
else if is_special_array(left.resultdef) then
{Arrays without a high bound (dynamic arrays, open arrays) are zero based,
convert indexes into these arrays to aword.}
inserttypeconv(right,uinttype)
{ convert between pasbool and cbool if necessary }
else if is_boolean(right.resultdef) then
inserttypeconv(right,tarraydef(left.resultdef).rangedef)
else
{Convert array indexes to low_bound..high_bound.}
inserttypeconv(right,Torddef.create(Torddef(sinttype).ordtype,
int64(Tarraydef(left.resultdef).lowrange),
int64(Tarraydef(left.resultdef).highrange)
));
begin
htype:=Tarraydef(left.resultdef).rangedef;
if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then
{Variant arrays are a special array, can have negative indexes and would therefore
need s32bit. However, they should not appear in a vecn, as they are handled in
handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an
internal error... }
internalerror(200707031)
else if is_special_array(left.resultdef) then
{Arrays without a high bound (dynamic arrays, open arrays) are zero based,
convert indexes into these arrays to aword.}
inserttypeconv(right,uinttype)
{ note: <> rather than </>, because indexing e.g. an array 0..0
must not result in truncating the indexing value from 2/4/8
bytes to 1 byte (with range checking off, the full index
value must be used) }
else if (htype.typ=enumdef) and
(right.resultdef.typ=enumdef) and
(tenumdef(htype).basedef=tenumdef(right.resultdef).basedef) and
((tarraydef(left.resultdef).lowrange<>tenumdef(htype).min) or
(tarraydef(left.resultdef).highrange<>tenumdef(htype).max)) then
{Convert array indexes to low_bound..high_bound.}
inserttypeconv(right,tenumdef.create_subrange(tenumdef(right.resultdef),
asizeint(Tarraydef(left.resultdef).lowrange),
asizeint(Tarraydef(left.resultdef).highrange)
))
else if (htype.typ=orddef) and
{ don't try to create boolean types with custom ranges }
not is_boolean(right.resultdef) and
{ ordtype determines the size of the loaded value -> make
sure we don't truncate }
((Torddef(right.resultdef).ordtype<>torddef(htype).ordtype) or
(tarraydef(left.resultdef).lowrange<>torddef(htype).low) or
(tarraydef(left.resultdef).highrange<>torddef(htype).high)) then
{Convert array indexes to low_bound..high_bound.}
begin
if right.resultdef.typ=orddef then
newordtyp:=Torddef(right.resultdef).ordtype
else
newordtyp:=torddef(ptrsinttype).ordtype;
inserttypeconv(right,Torddef.create(newordtyp,
int64(Tarraydef(left.resultdef).lowrange),
int64(Tarraydef(left.resultdef).highrange)
))
end
else
inserttypeconv(right,htype)
end;
stringdef:
if is_open_string(left.resultdef) then
inserttypeconv(right,u8inttype)

17
tests/webtbs/tw20873.pp Normal file
View File

@ -0,0 +1,17 @@
{$MODE OBJFPC}
program variant_bug;
uses variants;
var SomeArray : array[1..10] of DWord;
v : Variant;
y: longint;
begin
for y := 1 to 10 do SomeArray[y] := 0;
v := 7;
SomeArray[ v ] := 1;
for y := 1 to 10 do Write( SomeArray[y] );
writeln;
if somearray[v]<>1 then
halt(1);
end.