Browse Source

+ patch to support assigning class procedures to procedure variables by Ondrej Pokorny, resolves #30936
+ additional tests

git-svn-id: trunk@34909 -

florian 8 years ago
parent
commit
67570a6262
6 changed files with 135 additions and 1 deletions
  1. 4 0
      .gitattributes
  2. 1 1
      compiler/symdef.pas
  3. 33 0
      tests/webtbs/tw30936.pp
  4. 33 0
      tests/webtbs/tw30936a.pp
  5. 32 0
      tests/webtbs/tw30936b.pp
  6. 32 0
      tests/webtbs/tw30936c.pp

+ 4 - 0
.gitattributes

@@ -15255,6 +15255,10 @@ tests/webtbs/tw3083.pp svneol=native#text/plain
 tests/webtbs/tw30889.pp svneol=native#text/pascal
 tests/webtbs/tw30889.pp svneol=native#text/pascal
 tests/webtbs/tw30923.pp svneol=native#text/pascal
 tests/webtbs/tw30923.pp svneol=native#text/pascal
 tests/webtbs/tw3093.pp svneol=native#text/plain
 tests/webtbs/tw3093.pp svneol=native#text/plain
+tests/webtbs/tw30936.pp svneol=native#text/pascal
+tests/webtbs/tw30936a.pp svneol=native#text/pascal
+tests/webtbs/tw30936b.pp svneol=native#text/pascal
+tests/webtbs/tw30936c.pp svneol=native#text/pascal
 tests/webtbs/tw3101.pp svneol=native#text/plain
 tests/webtbs/tw3101.pp svneol=native#text/plain
 tests/webtbs/tw3104.pp svneol=native#text/plain
 tests/webtbs/tw3104.pp svneol=native#text/plain
 tests/webtbs/tw3109.pp svneol=native#text/plain
 tests/webtbs/tw3109.pp svneol=native#text/plain

+ 1 - 1
compiler/symdef.pas

@@ -6408,7 +6408,7 @@ implementation
 
 
     function tprocvardef.is_addressonly:boolean;
     function tprocvardef.is_addressonly:boolean;
       begin
       begin
-        result:=(not(po_methodpointer in procoptions) and
+        result:=((not(po_methodpointer in procoptions) or (po_staticmethod in procoptions)) and
                  not(po_is_block in procoptions) and
                  not(po_is_block in procoptions) and
                  not is_nested_pd(self)) or
                  not is_nested_pd(self)) or
                 (po_addressonly in procoptions);
                 (po_addressonly in procoptions);

+ 33 - 0
tests/webtbs/tw30936.pp

@@ -0,0 +1,33 @@
+program StaticClassProc;
+
+{$MODE OBJFPC}
+
+type
+  TTest = class
+  public type
+    TProcedure = procedure;
+  private
+    class procedure MyProc; static;
+  public
+    constructor Create;
+  end;
+
+{ TTest }
+
+constructor TTest.Create;
+var
+  aProc: TProcedure;
+begin
+  aProc := @MyProc;
+  aProc;
+end;
+
+class procedure TTest.MyProc;
+begin
+  Writeln('OK');
+end;
+
+begin
+  TTest.Create;
+end.
+

+ 33 - 0
tests/webtbs/tw30936a.pp

@@ -0,0 +1,33 @@
+program StaticClassProc;
+
+{$MODE DELPHI}
+
+type
+  TTest = class
+  public type
+    TProcedure = procedure;
+  private
+    class procedure MyProc; static;
+  public
+    constructor Create;
+  end;
+
+{ TTest }
+
+constructor TTest.Create;
+var
+  aProc: TProcedure;
+begin
+  aProc := MyProc;
+  aProc;
+end;
+
+class procedure TTest.MyProc;
+begin
+  Writeln('OK');
+end;
+
+begin
+  TTest.Create;
+end.
+

+ 32 - 0
tests/webtbs/tw30936b.pp

@@ -0,0 +1,32 @@
+program StaticClassProc;
+
+{$MODE OBJFPC}
+
+type
+  TTest = class
+  public type
+    TProcedure = procedure;
+  private
+    class procedure MyProc; static;
+  public
+    constructor Create;
+  end;
+
+{ TTest }
+
+constructor TTest.Create;
+begin
+end;
+
+class procedure TTest.MyProc;
+begin
+  Writeln('OK');
+end;
+
+var
+  aProc: TProcedure;
+begin
+  aProc := @TTest.MyProc;
+  aProc;
+end.
+

+ 32 - 0
tests/webtbs/tw30936c.pp

@@ -0,0 +1,32 @@
+program StaticClassProc;
+
+{$MODE DELPHI}
+
+type
+  TTest = class
+  public type
+    TProcedure = procedure;
+  private
+    class procedure MyProc; static;
+  public
+    constructor Create;
+  end;
+
+{ TTest }
+
+constructor TTest.Create;
+begin
+end;
+
+class procedure TTest.MyProc;
+begin
+  Writeln('OK');
+end;
+
+var
+  aProc: TProcedure;
+begin
+  aProc := TTest.MyProc;
+  aProc;
+end.
+