Browse Source

* 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 -

svenbarth 13 years ago
parent
commit
17a276aabc

+ 7 - 0
.gitattributes

@@ -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

+ 18 - 2
compiler/ptype.pas

@@ -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 - 0
tests/test/tgeneric69.pp

@@ -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 - 0
tests/test/tgeneric70.pp

@@ -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 - 0
tests/test/tgeneric71.pp

@@ -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 - 0
tests/webtbs/tw20577a.pp

@@ -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 - 0
tests/webtbs/tw20577b.pp

@@ -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 - 0
tests/webtbs/tw20995a.pp

@@ -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 - 0
tests/webtbs/tw20995b.pp

@@ -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.
+