Browse Source

* symtable.pas, search_last_objectpascal_helper:
moved setting of "odef" to Nil outside of the if-statement just to be sure that "odef" will be really Nil
* pstatmnt.pas, _with_statement:
the symtables of the helper(s) need to pushed as well in the correct locations so that their methods can be found as well
* added tests for this usecase:
- tchlp55, tchlp57, trhlp42 test a "with"-statement with a normal method
- tchlp56, tchlp58, trhlp43 test a "with"-statement with a class method
- tchlp57 and tchlp58 test that the helpers for parent classes are available as well

Please note that trhlp42 doesn't compile currently as a type reference to a record is not supported in "with"-statements => needs bugreport

git-svn-id: branches/svenbarth/classhelpers@17834 -

svenbarth 14 years ago
parent
commit
f9416d3b02

+ 6 - 0
.gitattributes

@@ -9846,6 +9846,10 @@ tests/test/tchlp51.pp svneol=native#text/pascal
 tests/test/tchlp52.pp svneol=native#text/pascal
 tests/test/tchlp53.pp svneol=native#text/pascal
 tests/test/tchlp54.pp svneol=native#text/pascal
+tests/test/tchlp55.pp svneol=native#text/pascal
+tests/test/tchlp56.pp svneol=native#text/pascal
+tests/test/tchlp57.pp svneol=native#text/pascal
+tests/test/tchlp58.pp svneol=native#text/pascal
 tests/test/tchlp6.pp svneol=native#text/pascal
 tests/test/tchlp7.pp svneol=native#text/pascal
 tests/test/tchlp8.pp svneol=native#text/pascal
@@ -10364,6 +10368,8 @@ tests/test/trhlp39.pp svneol=native#text/pascal
 tests/test/trhlp4.pp svneol=native#text/pascal
 tests/test/trhlp40.pp svneol=native#text/pascal
 tests/test/trhlp41.pp svneol=native#text/pascal
+tests/test/trhlp42.pp svneol=native#text/pascal
+tests/test/trhlp43.pp svneol=native#text/pascal
 tests/test/trhlp5.pp svneol=native#text/pascal
 tests/test/trhlp6.pp svneol=native#text/pascal
 tests/test/trhlp7.pp svneol=native#text/pascal

+ 45 - 0
compiler/pstatmnt.pas

@@ -516,19 +516,36 @@ implementation
          hp,
          refnode  : tnode;
          hdef : tdef;
+         extendeddef : tabstractrecorddef;
+         helperdef : tobjectdef;
          hasimplicitderef : boolean;
          withsymtablelist : TFPObjectList;
 
          procedure pushobjchild(withdef,obj:tobjectdef);
+         var
+           parenthelperdef : tobjectdef;
          begin
            if not assigned(obj) then
              exit;
            pushobjchild(withdef,obj.childof);
+           { we need to look for helpers that were defined for the parent
+             class as well }
+           search_last_objectpascal_helper(obj,current_structdef,parenthelperdef);
+           { push the symtables of the helper's parents in reverse order }
+           if assigned(parenthelperdef) then
+             pushobjchild(withdef,parenthelperdef.childof);
            { keep the original tobjectdef as owner, because that is used for
              visibility of the symtable }
            st:=twithsymtable.create(withdef,obj.symtable.SymList,refnode.getcopy);
            symtablestack.push(st);
            withsymtablelist.add(st);
+           { push the symtable of the helper }
+           if assigned(parenthelperdef) then
+             begin
+               st:=twithsymtable.create(withdef,parenthelperdef.symtable.SymList,refnode.getcopy);
+               symtablestack.push(st);
+               withsymtablelist.add(st);
+             end;
          end;
 
 
@@ -625,12 +642,25 @@ implementation
                 typecheckpass(refnode);
               end;
 
+            { do we have a helper for this type? }
+            if p.resultdef.typ=classrefdef then
+              extendeddef:=tobjectdef(tclassrefdef(p.resultdef).pointeddef)
+            else
+              extendeddef:=tabstractrecorddef(p.resultdef);
+            search_last_objectpascal_helper(extendeddef,current_structdef,helperdef);
+            { Note: the symtable of the helper is pushed after the following
+                    "case", the symtables of the helper's parents are passed in
+                    the "case" branches }
+
             withsymtablelist:=TFPObjectList.create(true);
             case p.resultdef.typ of
               objectdef :
                 begin
                    { push symtables of all parents in reverse order }
                    pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof);
+                   { push symtables of all parents of the helper in reverse order }
+                   if assigned(helperdef) then
+                     pushobjchild(helperdef,helperdef.childof);
                    { push object symtable }
                    st:=twithsymtable.Create(tobjectdef(p.resultdef),tobjectdef(p.resultdef).symtable.SymList,refnode);
                    symtablestack.push(st);
@@ -640,6 +670,9 @@ implementation
                 begin
                    { push symtables of all parents in reverse order }
                    pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof);
+                   { push symtables of all parents of the helper in reverse order }
+                   if assigned(helperdef) then
+                     pushobjchild(helperdef,helperdef.childof);
                    { push object symtable }
                    st:=twithsymtable.Create(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).symtable.SymList,refnode);
                    symtablestack.push(st);
@@ -647,6 +680,10 @@ implementation
                 end;
               recorddef :
                 begin
+                   { push symtables of all parents of the helper in reverse order }
+                   if assigned(helperdef) then
+                     pushobjchild(helperdef,helperdef.childof);
+                   { push record symtable }
                    st:=twithsymtable.create(trecorddef(p.resultdef),trecorddef(p.resultdef).symtable.SymList,refnode);
                    symtablestack.push(st);
                    withsymtablelist.add(st);
@@ -655,6 +692,14 @@ implementation
                 internalerror(200601271);
             end;
 
+            { push helper symtable }
+            if assigned(helperdef) then
+              begin
+                st:=twithsymtable.Create(helperdef,helperdef.symtable.SymList,refnode.getcopy);
+                symtablestack.push(st);
+                withsymtablelist.add(st);
+              end;
+
             if try_to_consume(_COMMA) then
               p:=_with_statement()
             else

+ 3 - 3
compiler/symtable.pas

@@ -2586,10 +2586,10 @@ implementation
                       is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
               dec(i);
             until result or (i<0);
-            if not result then
-              { just to be sure that noone uses odef }
-              odef:=nil;
           end;
+        if not result then
+          { just to be sure that noone uses odef }
+          odef:=nil;
       end;
 
     function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;

+ 21 - 0
tests/test/tchlp55.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 1: normal method in current helper }
+program tchlp55;
+
+{$mode objfpc}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure Test;
+  end;
+
+procedure TObjectHelper.Test;
+begin
+end;
+
+begin
+  with TObject.Create do
+    Test;
+end.

+ 21 - 0
tests/test/tchlp56.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 2: class method in current helper }
+program tchlp56;
+
+{$mode objfpc}
+
+type
+  TObjectHelper = class helper for TObject
+    class procedure Test;
+  end;
+
+class procedure TObjectHelper.Test;
+begin
+end;
+
+begin
+  with TObject do
+    Test;
+end.

+ 24 - 0
tests/test/tchlp57.pp

@@ -0,0 +1,24 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 3: normal method in parent's helper }
+program tchlp57;
+
+{$mode objfpc}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure Test;
+  end;
+
+  TTest = class
+  end;
+
+procedure TObjectHelper.Test;
+begin
+end;
+
+begin
+  with TTest.Create do
+    Test;
+end.

+ 24 - 0
tests/test/tchlp58.pp

@@ -0,0 +1,24 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 4: class method in parent's helper }
+program tchlp58;
+
+{$mode objfpc}
+
+type
+  TObjectHelper = class helper for TObject
+    class procedure Test;
+  end;
+
+  TTest = class
+  end;
+
+class procedure TObjectHelper.Test;
+begin
+end;
+
+begin
+  with TTest do
+    Test;
+end.

+ 27 - 0
tests/test/trhlp42.pp

@@ -0,0 +1,27 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 1: normal method in current helper }
+program trhlp42;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  end;
+
+  TTestHelper = record helper for TTest
+    procedure Test;
+  end;
+
+procedure TTestHelper.Test;
+begin
+end;
+
+var
+  t: TTest;
+begin
+  with t do
+    Test;
+end.

+ 25 - 0
tests/test/trhlp43.pp

@@ -0,0 +1,25 @@
+{ %NORUN }
+
+{ This tests that methods introduced by a helper can be found in 
+  with-Statements as well - Case 2: class method in current helper }
+program trhlp43;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  end;
+
+  TTestHelper = record helper for TTest
+    class procedure Test; static;
+  end;
+
+class procedure TTestHelper.Test;
+begin
+end;
+
+begin
+  with TTest do
+    Test;
+end.