Răsfoiți Sursa

* patch by Aleksa Todorovic to handle access to types inside generics correctly
when they are used as class variables, resolves #18096

git-svn-id: trunk@16474 -

florian 14 ani în urmă
părinte
comite
7d1627e9ca
4 a modificat fișierele cu 74 adăugiri și 4 ștergeri
  1. 2 0
      .gitattributes
  2. 17 4
      compiler/nmem.pas
  3. 24 0
      tests/webtbf/tw18096.pp
  4. 31 0
      tests/webtbf/tw18096c.pp

+ 2 - 0
.gitattributes

@@ -9977,6 +9977,8 @@ tests/webtbf/tw1754.pp svneol=native#text/plain
 tests/webtbf/tw1754b.pp svneol=native#text/plain
 tests/webtbf/tw17646a.pp svneol=native#text/plain
 tests/webtbf/tw1782.pp svneol=native#text/plain
+tests/webtbf/tw18096.pp svneol=native#text/pascal
+tests/webtbf/tw18096c.pp svneol=native#text/pascal
 tests/webtbf/tw1827.pp svneol=native#text/plain
 tests/webtbf/tw1830.pp svneol=native#text/plain
 tests/webtbf/tw1842.pp svneol=native#text/plain

+ 17 - 4
compiler/nmem.pas

@@ -149,6 +149,8 @@ implementation
 
 
     function tloadvmtaddrnode.pass_typecheck:tnode;
+      var
+        defaultresultdef : boolean;
       begin
         result:=nil;
         typecheckpass(left);
@@ -160,13 +162,24 @@ implementation
             resultdef:=left.resultdef;
           objectdef :
             { access to the classtype while specializing? }
-            if (df_generic in left.resultdef.defoptions) and
-              assigned(current_objectdef.genericdef) then
+            if (df_generic in left.resultdef.defoptions) then
               begin
-                if current_objectdef.genericdef=left.resultdef then
-                  resultdef:=tclassrefdef.create(current_objectdef)
+                defaultresultdef:=true;
+                if assigned(current_objectdef) then
+                  begin
+                    if assigned(current_objectdef.genericdef) then
+                      if current_objectdef.genericdef=left.resultdef then
+                        begin
+                          resultdef:=tclassrefdef.create(current_objectdef);
+                          defaultresultdef:=false;
+                        end
+                      else
+                        message(parser_e_cant_create_generics_of_this_type);
+                  end
                 else
                   message(parser_e_cant_create_generics_of_this_type);
+                if defaultresultdef then
+                  resultdef:=tclassrefdef.create(left.resultdef);
               end
             else
               resultdef:=tclassrefdef.create(left.resultdef);

+ 24 - 0
tests/webtbf/tw18096.pp

@@ -0,0 +1,24 @@
+{ %fail }
+{$mode objfpc}
+type
+  generic tc1<T> = class
+  public
+    x : T;
+  end;
+  
+  generic tc2<T> = class
+  type tc2a = specialize tc1<T>;
+  var x : tc2a;
+  end;
+  
+  tc2_Integer = specialize tc2<Integer>;
+
+var
+  a : tc2_Integer;
+begin
+  a := tc2_Integer.Create;
+  a.x := tc2.tc2a.Create; // this is not allowed, user must use specialization of tc2
+  a.x.x := 99;
+  if (a.x.x <> 99) then
+    Halt(1);
+end.

+ 31 - 0
tests/webtbf/tw18096c.pp

@@ -0,0 +1,31 @@
+{ %fail }
+{$mode objfpc}
+
+type
+  generic G<_T> = class
+  end;
+  
+  generic TGen<_T> = class
+  public
+    function Check(ASource: TObject): Boolean;
+  end;
+
+  TSpec = specialize TGen<Integer>;
+
+function TGen.Check(ASource: TObject): Boolean;
+begin
+  Result := not (ASource is G) // we are testing this: usage of another generic is not allowed
+  and (ASource is TGen) // this should work...
+  and (ASource is ClassType);   // ...and it should be equivelent to this line
+end;
+
+var
+  f:  TSpec;
+  o: TObject;
+begin
+  f := TSpec.Create;
+  o := TObject.Create;
+  if not(f.Check(f)) or f.Check(o) then
+    halt(1);
+  writeln('ok');
+end.