* compiler\pdecl.pas:

in "array_dec" and "procvar_dec" "parse_generic" needs to be true if the currently
      parsed declaration (array or procvar) is declared inside a generic, because only then
      specializations of other types (it does not matter whether they are inline or in a type
      section of the current generic) are parsed correctly (this fixes Mantis #20577 and
      Mantis #20955 )
+ add tests for the mentioned bug reports (testing only the array case) (tests\webtbs) and
  tests for the procvar case (tests\test)

git-svn-id: trunk@19953 -
This commit is contained in:
svenbarth 2012-01-02 16:02:51 +00:00
parent 628b35d100
commit 17a276aabc
9 changed files with 200 additions and 2 deletions

7
.gitattributes vendored
View File

@ -10228,7 +10228,10 @@ tests/test/tgeneric65.pp svneol=native#text/pascal
tests/test/tgeneric66.pp svneol=native#text/pascal
tests/test/tgeneric67.pp svneol=native#text/pascal
tests/test/tgeneric68.pp svneol=native#text/pascal
tests/test/tgeneric69.pp svneol=native#text/pascal
tests/test/tgeneric7.pp svneol=native#text/plain
tests/test/tgeneric70.pp svneol=native#text/pascal
tests/test/tgeneric71.pp svneol=native#text/pascal
tests/test/tgeneric8.pp svneol=native#text/plain
tests/test/tgeneric9.pp svneol=native#text/plain
tests/test/tgoto.pp svneol=native#text/plain
@ -12024,6 +12027,8 @@ tests/webtbs/tw2045.pp svneol=native#text/plain
tests/webtbs/tw2046a.pp svneol=native#text/plain
tests/webtbs/tw20527.pp svneol=native#text/plain
tests/webtbs/tw20557.pp svneol=native#text/pascal
tests/webtbs/tw20577a.pp svneol=native#text/pascal
tests/webtbs/tw20577b.pp svneol=native#text/pascal
tests/webtbs/tw2059.pp svneol=native#text/plain
tests/webtbs/tw20594.pp svneol=native#text/pascal
tests/webtbs/tw20627.pp svneol=native#text/pascal
@ -12046,6 +12051,8 @@ tests/webtbs/tw20872c.pp svneol=native#text/pascal
tests/webtbs/tw20874a.pp svneol=native#text/pascal
tests/webtbs/tw20874b.pp svneol=native#text/pascal
tests/webtbs/tw20889.pp svneol=native#text/pascal
tests/webtbs/tw20995a.pp svneol=native#text/pascal
tests/webtbs/tw20995b.pp svneol=native#text/pascal
tests/webtbs/tw2109.pp svneol=native#text/plain
tests/webtbs/tw2110.pp svneol=native#text/plain
tests/webtbs/tw2128.pp svneol=native#text/plain

View File

@ -1119,7 +1119,15 @@ implementation
current_genericdef:=arrdef;
symtablestack.push(arrdef.symtable);
insert_generic_parameter_types(arrdef,genericdef,genericlist);
parse_generic:=(df_generic in arrdef.defoptions);
{ there are two possibilties for the following to be true:
* the array declaration itself is generic
* the array is declared inside a generic
in both cases we need "parse_generic" and "current_genericdef"
so that e.g. specializations of another generic inside the
current generic can be used (either inline ones or "type" ones) }
parse_generic:=(df_generic in arrdef.defoptions) or old_parse_generic;
if parse_generic and not assigned(current_genericdef) then
current_genericdef:=old_current_genericdef;
end;
consume(_OF);
read_anon_type(tt2,true);
@ -1166,7 +1174,15 @@ implementation
current_genericdef:=pd;
symtablestack.push(pd.parast);
insert_generic_parameter_types(pd,genericdef,genericlist);
parse_generic:=(df_generic in pd.defoptions);
{ there are two possibilties for the following to be true:
* the procvar declaration itself is generic
* the procvar is declared inside a generic
in both cases we need "parse_generic" and "current_genericdef"
so that e.g. specializations of another generic inside the
current generic can be used (either inline ones or "type" ones) }
parse_generic:=(df_generic in pd.defoptions) or old_parse_generic;
if parse_generic and not assigned(current_genericdef) then
current_genericdef:=old_current_genericdef;
{ don't allow to add defs to the symtable - use it for type param search only }
tparasymtable(pd.parast).readonly:=true;

23
tests/test/tgeneric69.pp Normal file
View File

@ -0,0 +1,23 @@
{ %NORUN }
{ This tests that one can use a specialization of another generic which was
introduced in the currently parsed generic can be used as a parameter type
in a procedure variable introduced in the current generic as well }
program tgeneric69;
{$mode delphi}
type
TSomeGeneric<T> = class
end;
TSomeOtherGeneric<T> = class
type
TSomeGenericT = TSomeGeneric<T>;
TSomeProc = procedure(aParam: TSomeGenericT);
end;
begin
end.

22
tests/test/tgeneric70.pp Normal file
View File

@ -0,0 +1,22 @@
{ %NORUN }
{ This tests that one can use a specialization of another generic which was
introduced in the currently parsed generic can be used as a parameter type
in a procedure variable introduced in the current generic as well }
program tgeneric70;
{$mode delphi}
type
TSomeGeneric<T> = class
end;
TSomeOtherGeneric<T> = class
type
TSomeProc = procedure(aParam: TSomeGeneric<T>);
end;
begin
end.

23
tests/test/tgeneric71.pp Normal file
View File

@ -0,0 +1,23 @@
{ %NORUN }
{ This tests that one can use a specialization of another generic which was
introduced in the currently parsed generic can be used as a parameter type
in a procedure variable introduced in the current generic as well }
program tgeneric71;
{$mode objfpc}
type
generic TSomeGeneric<T> = class
end;
generic TSomeOtherGeneric<T> = class
type
TSomeGenericT = specialize TSomeGeneric<T>;
TSomeProc = procedure(aParam: TSomeGenericT);
end;
begin
end.

33
tests/webtbs/tw20577a.pp Normal file
View File

@ -0,0 +1,33 @@
program tw20577a;
{$mode delphi}{$H+}
type
TSimpleHashBucket<T> = record
HashCode : Integer;
Value : T;
end;
TSimpleHashBucketArray<T> = array of TSimpleHashBucket<T>;
{ TSimpleHash }
TSimpleHash<T> = class
private
FBuckets : TSimpleHashBucketArray<T>;
procedure test;
end;
{ TSimpleHash<T> }
procedure TSimpleHash<T>.test;
var
oldBuckets : TSimpleHashBucketArray<T>;
begin
oldBuckets := FBuckets;
end;
begin
end.

36
tests/webtbs/tw20577b.pp Normal file
View File

@ -0,0 +1,36 @@
program tw20577b;
{$mode delphi}{$H+}
type
TSimpleHashBucket<T> = record
HashCode : Integer;
Value : T;
end;
TSimpleHashBucketArray<T> = array of TSimpleHashBucket<T>;
{ TSimpleHash }
TSimpleHash<T> = class
private
type
THashBucket = TSimpleHashBucket<T>;
var
FBuckets: array of THashBucket;
procedure test;
end;
{ TSimpleHash<T> }
procedure TSimpleHash<T>.test;
var
oldBuckets : TSimpleHashBucketArray<T>;
begin
oldBuckets := FBuckets;
end;
begin
end.

20
tests/webtbs/tw20995a.pp Normal file
View File

@ -0,0 +1,20 @@
program tw20995a;
{$mode delphi}{$H+}
type
ITest<T> = interface
end;
TTest<T> = class
type
IGenTest = ITest<T>;
private
FData: array of IGenTest;
end;
TObjTest = TTest<TObject>;
begin
end.

18
tests/webtbs/tw20995b.pp Normal file
View File

@ -0,0 +1,18 @@
program tw20995b;
{$mode delphi}{$H+}
type
ITest<T> = interface
end;
TTest<T> = class
private
FData: array of ITest<T>;
end;
TObjTest = TTest<TObject>;
begin
end.