compiler:

- fix for-in loop for string const array
  - add some test from Alexander S. Klenin
(issue #0014990)

git-svn-id: trunk@14041 -
This commit is contained in:
paul 2009-11-04 12:07:42 +00:00
parent cbdbf0fd32
commit 5752be310d
11 changed files with 126 additions and 5 deletions

6
.gitattributes vendored
View File

@ -8229,6 +8229,12 @@ tests/test/tfinal2.pp svneol=native#text/pascal
tests/test/tforin1.pp svneol=native#text/pascal
tests/test/tforin10.pp svneol=native#text/plain
tests/test/tforin11.pp svneol=native#text/plain
tests/test/tforin12.pp svneol=native#text/pascal
tests/test/tforin13.pp svneol=native#text/pascal
tests/test/tforin14.pp svneol=native#text/pascal
tests/test/tforin15.pp svneol=native#text/pascal
tests/test/tforin16.pp svneol=native#text/pascal
tests/test/tforin17.pp svneol=native#text/pascal
tests/test/tforin2.pp svneol=native#text/pascal
tests/test/tforin3.pp svneol=native#text/pascal
tests/test/tforin4.pp svneol=native#text/pascal

View File

@ -304,10 +304,13 @@ var
loopstatement, loopbodystatement: tstatementnode;
loopvar, arrayvar: ttempcreatenode;
arrayindex, lowbound, highbound, loopbody, forloopnode: tnode;
is_string: boolean;
begin
{ result is a block of statements }
result:=internalstatements(loopstatement);
is_string := ado_IsConstString in tarraydef(expr.resultdef).arrayoptions;
if (node_complexity(expr) > 1) and not is_open_array(expr.resultdef) then
begin
{ create a temp variable for expression }
@ -316,8 +319,16 @@ begin
expr.resultdef.size,
tt_persistent,true);
lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
if is_string then
begin
lowbound:=genintconstnode(1);
highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar))
end
else
begin
lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar));
highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar));
end;
addstatement(loopstatement,arrayvar);
addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expr.getcopy));
@ -325,8 +336,16 @@ begin
else
begin
arrayvar:=nil;
lowbound:=cinlinenode.create(in_low_x,false,expr.getcopy);
highbound:=cinlinenode.create(in_high_x,false,expr.getcopy);
if is_string then
begin
lowbound:=genintconstnode(1);
highbound:=cinlinenode.create(in_length_x,false,expr.getcopy);
end
else
begin
lowbound:=cinlinenode.create(in_low_x,false,expr.getcopy);
highbound:=cinlinenode.create(in_high_x,false,expr.getcopy);
end;
end;
{ create a loop counter }

View File

@ -44,7 +44,7 @@
<Version Value="8"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="C:\programming\fpc_features\bin\i386-win32\pp.exe"/>
<Filename Value="..\bin\i386-win32\pp.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="i386\"/>

View File

@ -5,6 +5,7 @@
program tforin10;
{$mode objfpc}{$H+}
{$apptype console}
type
TSomeClass = class

View File

@ -5,6 +5,7 @@
program tforin11;
{$mode objfpc}{$H+}
{$apptype console}
var
s: String;

10
tests/test/tforin12.pp Normal file
View File

@ -0,0 +1,10 @@
{mode objfpc}
{$apptype console}
type T = array [1..3] of Char;
var
a: array [1..3] of T = ('asd', 'sdf', 'ddf');
s: T;
begin
for s in a do
Writeln(s);
end.

8
tests/test/tforin13.pp Normal file
View File

@ -0,0 +1,8 @@
{mode objfpc}
{$apptype console}
var
ch: Char;
begin
for ch in ['a'..'c', '0'..'3', '_'] do
Writeln(ch);
end.

24
tests/test/tforin14.pp Normal file
View File

@ -0,0 +1,24 @@
{mode objfpc}
{$apptype console}
type
T = array [1..3] of Integer;
procedure P(a: array of T);
var
r: T;
i: Integer;
begin
for r in a do
begin
for i in r do Write(i, ' ');
Writeln;
end;
end;
const
r1: T = (1,2,9);
r2: T = (3,4,5);
begin
P([r1, r2]);
end.

39
tests/test/tforin15.pp Normal file
View File

@ -0,0 +1,39 @@
{$mode objfpc}
{$apptype console}
type
T = class
stop: boolean;
F: Integer;
function MoveNext: Boolean;
property Current: Integer read F;
end;
Twice = type Integer;
function T.MoveNext: Boolean;
begin
Result := not stop;
stop := true;
end;
operator enumerator(a: Integer): T;
begin
Result := T.Create;
Result.F := a;
Result.stop := false;
end;
operator enumerator(a: Twice): T;
begin
Result := T.Create;
Result.F := a * 2;
Result.stop := false;
end;
var
i: Integer;
begin
for i in Twice(1) do
Writeln(i);
end.

7
tests/test/tforin16.pp Normal file
View File

@ -0,0 +1,7 @@
{mode objfpc}
{$apptype console}
const S = 'abc';
var ch: Char;
begin
for ch in S do Writeln(ch);
end.

6
tests/test/tforin17.pp Normal file
View File

@ -0,0 +1,6 @@
{mode objfpc}
{$apptype console}
var ch: Char;
begin
for ch in 'abc' do Writeln(ch);
end.