Browse Source

Fix for Mantis #26481. This is a regression.

nutils.pas, handle_staticfield_access:
  * generics don't have staticvarsyms for their static fieldvarsyms so we need to simulate a non-static access to avoid 1) an exception and 2) incorrect errors that instance methods can't be accessed

+ added tests

git-svn-id: trunk@29484 -
svenbarth 10 years ago
parent
commit
5115c3e680
4 changed files with 94 additions and 0 deletions
  1. 2 0
      .gitattributes
  2. 37 0
      compiler/nutils.pas
  3. 22 0
      tests/tbf/tb0250.pp
  4. 33 0
      tests/webtbs/tw26481.pp

+ 2 - 0
.gitattributes

@@ -9737,6 +9737,7 @@ tests/tbf/tb0246.pp svneol=native#text/pascal
 tests/tbf/tb0247.pp svneol=native#text/pascal
 tests/tbf/tb0248.pp svneol=native#text/pascal
 tests/tbf/tb0249.pp svneol=native#text/pascal
+tests/tbf/tb0250.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -14148,6 +14149,7 @@ tests/webtbs/tw2643.pp svneol=native#text/plain
 tests/webtbs/tw2645.pp svneol=native#text/plain
 tests/webtbs/tw26467.pp svneol=native#text/pascal
 tests/webtbs/tw2647.pp svneol=native#text/plain
+tests/webtbs/tw26481.pp svneol=native#text/pascal
 tests/webtbs/tw26482.pp svneol=native#text/pascal
 tests/webtbs/tw26483.pp svneol=native#text/pascal
 tests/webtbs/tw2649.pp svneol=native#text/plain

+ 37 - 0
compiler/nutils.pas

@@ -1043,6 +1043,41 @@ implementation
 
 
     function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean;
+
+      function handle_generic_staticfield_access:boolean;
+        var
+          tmp : tstoreddef;
+          pd : tprocdef;
+        begin
+          { in case we have a specialization inside a generic (thus the static var sym does not
+            exist) we simply simulate a non static access to avoid unnecessary errors }
+          if assigned(sym.owner.defowner) and (df_specialization in tstoreddef(sym.owner.defowner).defoptions) then
+            begin
+              tmp:=tstoreddef(sym.owner.defowner);
+              while assigned(tmp) do
+                begin
+                  if df_generic in tmp.defoptions then
+                    begin
+                      p1.free;
+                      if assigned(current_procinfo) then
+                        begin
+                          pd:=current_procinfo.get_normal_proc.procdef;
+                          if assigned(pd) and pd.no_self_node then
+                            p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
+                          else
+                            p1:=load_self_node;
+                        end
+                      else
+                        p1:=load_self_node;
+                      p1:=csubscriptnode.create(sym,p1);
+                      exit(true);
+                    end;
+                  tmp:=tstoreddef(tmp.owner.defowner);
+                end;
+            end;
+          result:=false;
+        end;
+
       var
         static_name: shortstring;
         srsymtable: tsymtable;
@@ -1052,6 +1087,8 @@ implementation
         if (sp_static in sym.symoptions) then
           begin
             result:=true;
+            if handle_generic_staticfield_access then
+              exit;
             if not nested then
               static_name:=lower(sym.owner.name^)+'_'+sym.name
             else

+ 22 - 0
tests/tbf/tb0250.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+
+program tb0250;
+
+{$mode delphi}
+
+type
+  TTest<T> = class
+  class var
+    fTest: TClass;
+    procedure Test;
+  end;
+
+procedure TTest<T>.Test;
+begin
+  fTest.ToString;
+end;
+
+begin
+
+end.
+

+ 33 - 0
tests/webtbs/tw26481.pp

@@ -0,0 +1,33 @@
+{ %NORUN }
+
+program tw26481;
+
+{$MODE DELPHI}
+
+type
+  IComparer<T> = interface
+    function Compare(constref Left, Right: T): Integer; overload;
+  end;
+
+  TOrdinalComparer<T, THashFactory> = class(TInterfacedObject, IComparer<T>)
+  protected class var
+    FComparer: IComparer<T>;
+    FTest: TClass;
+  public
+    function Compare(constref Left, Right: T): Integer; virtual; abstract;
+  end;
+
+  TGOrdinalStringComparer<T, THashFactory> = class(TOrdinalComparer<T, THashFactory>)
+  public
+    function Compare(constref ALeft, ARight: T): Integer; override;
+  end;
+
+function TGOrdinalStringComparer<THashFactory, T>.Compare(constref ALeft,
+  ARight: T): Integer;
+begin
+  Result := FComparer.Compare(ALeft, ARight);
+end;
+
+begin
+end.
+