mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 21:29:26 +02:00
pastojs: proc ref of helper method
git-svn-id: trunk@41235 -
This commit is contained in:
Mattias Gaertner
parent
75bf1e4291
commit
4d8ae767f7
File diff suppressed because it is too large
Load Diff
@ -631,14 +631,39 @@ type
|
||||
Procedure TestClassHelper_ClassVar;
|
||||
Procedure TestClassHelper_Method_AccessInstanceFields;
|
||||
Procedure TestClassHelper_Method_Call;
|
||||
Procedure TestClassHelper_Method_Nested_Call;
|
||||
Procedure TestClassHelper_ClassMethod_Call;
|
||||
Procedure TestClassHelper_ClassOf;
|
||||
Procedure TestClassHelper_MethodRefObjFPC;
|
||||
// Procedure TestClassHelper_MethodRefDelphi;
|
||||
//Procedure TestClassHelper_Constructor;
|
||||
//Procedure TestClassHelper_InheritedObjFPC;
|
||||
//Procedure TestClassHelper_InheritedDelphi;
|
||||
// todo: TestClassHelper_Property
|
||||
// todo: TestClassHelper_Property_Array
|
||||
// todo: TestClassHelper_Property_Index
|
||||
// todo: TestClassHelper_ClassProperty
|
||||
// todo: TestClassHelper_ClassProperty_Array
|
||||
// todo: TestClassHelper_ClassProperty_Index
|
||||
// todo: TestClassHelper_Overload
|
||||
// todo: TestRecordHelper
|
||||
// todo: TestTypeHelper
|
||||
// todo: TestRecordHelper_ClassVar
|
||||
// todo: TestRecordHelper_Method
|
||||
// todo: TestRecordHelper_ClassMethod
|
||||
// todo: TestRecordHelper_NestedMethod
|
||||
// todo: TestRecorHelper_Constructor;
|
||||
// todo: TestRecordHelper_Args
|
||||
// todo: TestRecordHelper_Property
|
||||
// todo: TestRecordHelper_Property_Array
|
||||
// todo: TestRecordHelper_ClassProperty
|
||||
// todo: TestRecordHelper_ClassProperty_Array
|
||||
// todo: TestTypeHelper_ClassVar
|
||||
// todo: TestTypeHelper_Method
|
||||
// todo: TestTypeHelper_ClassMethod
|
||||
// todo: TestTypeHelper_Constructor;
|
||||
// todo: TestTypeHelper_Property
|
||||
// todo: TestTypeHelper_Property_Array
|
||||
// todo: TestTypeHelper_ClassProperty
|
||||
// todo: TestTypeHelper_ClassProperty_Array
|
||||
|
||||
// proc types
|
||||
Procedure TestProcType;
|
||||
@ -4485,19 +4510,19 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' var p = null;',
|
||||
' function Sub() {',
|
||||
' p = function () {',
|
||||
' Self.i = 3;',
|
||||
' Self.i = 4;',
|
||||
' $Self.i = 3;',
|
||||
' $Self.i = 4;',
|
||||
' p = function () {',
|
||||
' function SubSub() {',
|
||||
' Self.i = 13;',
|
||||
' Self.i = 14;',
|
||||
' $Self.i = 13;',
|
||||
' $Self.i = 14;',
|
||||
' };',
|
||||
' Self.i = 13;',
|
||||
' Self.i = 14;',
|
||||
' $Self.i = 13;',
|
||||
' $Self.i = 14;',
|
||||
' };',
|
||||
' };',
|
||||
' };',
|
||||
@ -13392,24 +13417,24 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' function Sub() {',
|
||||
' Self.Key = Self.Key + 2;',
|
||||
' Self.Key = Self.Key + 3;',
|
||||
' $mod.TObject.State = Self.State + 4;',
|
||||
' $mod.TObject.State = Self.State + 5;',
|
||||
' $Self.Key = $Self.Key + 2;',
|
||||
' $Self.Key = $Self.Key + 3;',
|
||||
' $mod.TObject.State = $Self.State + 4;',
|
||||
' $mod.TObject.State = $Self.State + 5;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 6;',
|
||||
' Self.SetSize(Self.GetSize() + 7);',
|
||||
' Self.SetSize(Self.GetSize() + 8);',
|
||||
' $Self.SetSize($Self.GetSize() + 7);',
|
||||
' $Self.SetSize($Self.GetSize() + 8);',
|
||||
' };',
|
||||
' Sub();',
|
||||
' Self.Key = Self.Key + 12;',
|
||||
' Self.Key = Self.Key + 13;',
|
||||
' $mod.TObject.State = Self.State + 14;',
|
||||
' $mod.TObject.State = Self.State + 15;',
|
||||
' $Self.Key = $Self.Key + 12;',
|
||||
' $Self.Key = $Self.Key + 13;',
|
||||
' $mod.TObject.State = $Self.State + 14;',
|
||||
' $mod.TObject.State = $Self.State + 15;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 16;',
|
||||
' Self.SetSize(Self.GetSize() + 17);',
|
||||
' Self.SetSize(Self.GetSize() + 18);',
|
||||
' $Self.SetSize($Self.GetSize() + 17);',
|
||||
' $Self.SetSize($Self.GetSize() + 18);',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
@ -13468,24 +13493,24 @@ begin
|
||||
'});',
|
||||
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
||||
' this.DoIt = function () {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' function Sub() {',
|
||||
' Self.Key = Self.Key + 2;',
|
||||
' Self.Key = Self.Key + 3;',
|
||||
' $mod.TObject.State = Self.State + 4;',
|
||||
' $mod.TObject.State = Self.State + 5;',
|
||||
' $Self.Key = $Self.Key + 2;',
|
||||
' $Self.Key = $Self.Key + 3;',
|
||||
' $mod.TObject.State = $Self.State + 4;',
|
||||
' $mod.TObject.State = $Self.State + 5;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 6;',
|
||||
' Self.SetSize(Self.GetSize() + 7);',
|
||||
' Self.SetSize(Self.GetSize() + 8);',
|
||||
' $Self.SetSize($Self.GetSize() + 7);',
|
||||
' $Self.SetSize($Self.GetSize() + 8);',
|
||||
' };',
|
||||
' Sub();',
|
||||
' Self.Key = Self.Key + 12;',
|
||||
' Self.Key = Self.Key + 13;',
|
||||
' $mod.TObject.State = Self.State + 14;',
|
||||
' $mod.TObject.State = Self.State + 15;',
|
||||
' $Self.Key = $Self.Key + 12;',
|
||||
' $Self.Key = $Self.Key + 13;',
|
||||
' $mod.TObject.State = $Self.State + 14;',
|
||||
' $mod.TObject.State = $Self.State + 15;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 16;',
|
||||
' Self.SetSize(Self.GetSize() + 17);',
|
||||
' Self.SetSize(Self.GetSize() + 18);',
|
||||
' $Self.SetSize($Self.GetSize() + 17);',
|
||||
' $Self.SetSize($Self.GetSize() + 18);',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
@ -13536,21 +13561,21 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' function Sub() {',
|
||||
' $mod.TObject.State = Self.State + 2;',
|
||||
' $mod.TObject.State = Self.State + 3;',
|
||||
' $mod.TObject.State = $Self.State + 2;',
|
||||
' $mod.TObject.State = $Self.State + 3;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 4;',
|
||||
' Self.SetSize(Self.GetSize() + 5);',
|
||||
' Self.SetSize(Self.GetSize() + 6);',
|
||||
' $Self.SetSize($Self.GetSize() + 5);',
|
||||
' $Self.SetSize($Self.GetSize() + 6);',
|
||||
' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
|
||||
' };',
|
||||
' Sub();',
|
||||
' $mod.TObject.State = Self.State + 12;',
|
||||
' $mod.TObject.State = Self.State + 13;',
|
||||
' $mod.TObject.State = $Self.State + 12;',
|
||||
' $mod.TObject.State = $Self.State + 13;',
|
||||
' $mod.TObject.State = $mod.TObject.State + 14;',
|
||||
' Self.SetSize(Self.GetSize() + 15);',
|
||||
' Self.SetSize(Self.GetSize() + 16);',
|
||||
' $Self.SetSize($Self.GetSize() + 15);',
|
||||
' $Self.SetSize($Self.GetSize() + 16);',
|
||||
' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
|
||||
' };',
|
||||
'});',
|
||||
@ -13602,14 +13627,14 @@ begin
|
||||
'});',
|
||||
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
||||
' this.DoIt = function (k) {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' var Result = 0;',
|
||||
' function Sub() {',
|
||||
' $mod.TObject.DoIt.call(Self, true);',
|
||||
' $mod.TObject.DoIt.call($Self, true);',
|
||||
' };',
|
||||
' Sub();',
|
||||
' $mod.TObject.DoIt.apply(Self, arguments);',
|
||||
' $mod.TObject.DoIt.call(Self, true);',
|
||||
' $mod.TObject.DoIt.apply($Self, arguments);',
|
||||
' $mod.TObject.DoIt.call($Self, true);',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
@ -15999,12 +16024,12 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function (i) {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' function Sub() {',
|
||||
' };',
|
||||
' var f = null;',
|
||||
' f = rtl.createCallback(Self, "DoIt");',
|
||||
' f = rtl.createCallback(Self, "DoIt").bind(null, 13);',
|
||||
' f = rtl.createCallback($Self, "DoIt");',
|
||||
' f = rtl.createCallback($Self, "DoIt").bind(null, 13);',
|
||||
' f = Sub;',
|
||||
' f = $mod.GetIt;',
|
||||
' };',
|
||||
@ -18725,7 +18750,6 @@ end;
|
||||
|
||||
procedure TTestModule.TestClassHelper_Method_Call;
|
||||
begin
|
||||
exit;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
@ -18782,7 +18806,264 @@ begin
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' this.FSize = 0;',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Run = function (w) {',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 2);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 3);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 4);',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||
' this.Foo = function (w) {',
|
||||
' var Result = 0;',
|
||||
' this.Run(10);',
|
||||
' this.Run(10);',
|
||||
' this.Run(11);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 12);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 13);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 14);',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'this.Obj = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.THelper.Foo.apply($mod.Obj, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.Obj, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.Obj, 21);',
|
||||
'var $with1 = $mod.Obj;',
|
||||
'$mod.THelper.Foo.apply($with1, 1);',
|
||||
'$mod.THelper.Foo.apply($with1, 1);',
|
||||
'$mod.THelper.Foo.apply($with1, 22);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClassHelper_Method_Nested_Call;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure Run(w: word = 10);',
|
||||
' end;',
|
||||
' THelper = class helper for TObject',
|
||||
' function Foo(w: word = 1): word;',
|
||||
' end;',
|
||||
'procedure TObject.Run(w: word);',
|
||||
' procedure Sub(Self: TObject);',
|
||||
' begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' Self.Foo;',
|
||||
' Self.Foo();',
|
||||
' with Self do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
' end;',
|
||||
'begin',
|
||||
'end;',
|
||||
'function THelper.foo(w: word): word;',
|
||||
' procedure Sub(Self: TObject);',
|
||||
' begin',
|
||||
' Run;',
|
||||
' Run();',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' Self.Foo;',
|
||||
' Self.Foo();',
|
||||
' with Self do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
' end;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClassHelper_Method_Nested_Call',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Run = function (w) {',
|
||||
' var $Self = this;',
|
||||
' function Sub(Self) {',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' };',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||
' this.Foo = function (w) {',
|
||||
' var $Self = this;',
|
||||
' var Result = 0;',
|
||||
' function Sub(Self) {',
|
||||
' $Self.Run(10);',
|
||||
' $Self.Run(10);',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply(Self, 1);',
|
||||
' $mod.THelper.Foo.apply($Self, 1);',
|
||||
' };',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClassHelper_ClassMethod_Call;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' class procedure Run(w: word = 10);',
|
||||
' end;',
|
||||
' THelper = class helper for TObject',
|
||||
' class function Foo(w: word = 1): word;',
|
||||
' end;',
|
||||
'class procedure TObject.Run(w: word);',
|
||||
'begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' Self.Foo;',
|
||||
' Self.Foo();',
|
||||
' with Self do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
'end;',
|
||||
'class function THelper.foo(w: word): word;',
|
||||
'begin',
|
||||
' Run;',
|
||||
' Run();',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' Self.Foo;',
|
||||
' Self.Foo();',
|
||||
' with Self do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
'end;',
|
||||
'var',
|
||||
' Obj: TObject;',
|
||||
'begin',
|
||||
' obj.Foo;',
|
||||
' obj.Foo();',
|
||||
' with obj do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
' tobject.Foo;',
|
||||
' tobject.Foo();',
|
||||
' with tobject do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClassHelper_ClassMethod_Call',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Run = function (w) {',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||
' this.Foo = function (w) {',
|
||||
' var Result = 0;',
|
||||
' this.Run(10);',
|
||||
' this.Run(10);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' $mod.THelper.Foo.apply(this, 1);',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'this.Obj = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.THelper.Foo.apply($mod.Obj.$class, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.Obj.$class, 1);',
|
||||
'var $with1 = $mod.Obj;',
|
||||
'$mod.THelper.Foo.apply($with1.$class, 1);',
|
||||
'$mod.THelper.Foo.apply($with1.$class, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.TObject, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.TObject, 1);',
|
||||
'var $with2 = $mod.TObject;',
|
||||
'$mod.THelper.Foo.apply($mod.TObject, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.TObject, 1);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClassHelper_ClassOf;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' end;',
|
||||
' TClass = class of TObject;',
|
||||
' THelper = class helper for TObject',
|
||||
' class function Foo(w: word = 1): word;',
|
||||
' end;',
|
||||
'class function THelper.foo(w: word): word;',
|
||||
'begin',
|
||||
'end;',
|
||||
'var',
|
||||
' c: TClass;',
|
||||
'begin',
|
||||
' c.Foo;',
|
||||
' c.Foo();',
|
||||
' with c do begin',
|
||||
' Foo;',
|
||||
' Foo();',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClassHelper_ClassOf',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
@ -18790,19 +19071,142 @@ begin
|
||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||
' this.Foo = function (w) {',
|
||||
' var Result = 0;',
|
||||
' Result = this.FSize;',
|
||||
' this.FSize = this.FSize + 2;',
|
||||
' this.FSize = this.FSize + 3;',
|
||||
' this.FSize = this.FSize + 4;',
|
||||
' this.FSize = this.FSize + 5;',
|
||||
' this.FSize = this.FSize + 6;',
|
||||
' this.FSize = this.FSize + 7;',
|
||||
' this.FSize = this.FSize + 8;',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'this.c = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.THelper.Foo.apply($mod.c, 1);',
|
||||
'$mod.THelper.Foo.apply($mod.c, 1);',
|
||||
'var $with1 = $mod.c;',
|
||||
'$mod.THelper.Foo.apply($with1, 1);',
|
||||
'$mod.THelper.Foo.apply($with1, 1);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClassHelper_MethodRefObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure DoIt;',
|
||||
' end;',
|
||||
' THelper = class helper for TObject',
|
||||
' procedure Fly(w: word = 1);',
|
||||
' class procedure Glide(w: word = 1);',
|
||||
' class procedure Run(w: word = 1); static;',
|
||||
' end;',
|
||||
' TFly = procedure(w: word) of object;',
|
||||
' TGlide = TFly;',
|
||||
' TRun = procedure(w: word);',
|
||||
'var',
|
||||
' f: TFly;',
|
||||
' g: TGlide;',
|
||||
' r: TRun;',
|
||||
'procedure TObject.DoIt;',
|
||||
'begin',
|
||||
' f:=@fly;',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
' f:=@Self.fly;',
|
||||
' g:=@Self.glide;',
|
||||
' r:=@Self.run;',
|
||||
' with self do begin',
|
||||
' f:=@fly;',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
' end;',
|
||||
'end;',
|
||||
'procedure THelper.fly(w: word);',
|
||||
'begin',
|
||||
' f:=@fly;',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
'end;',
|
||||
'class procedure THelper.glide(w: word);',
|
||||
'begin',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
'end;',
|
||||
'class procedure THelper.run(w: word);',
|
||||
'begin',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
'end;',
|
||||
'var',
|
||||
' Obj: TObject;',
|
||||
'begin',
|
||||
' f:=@obj.fly;',
|
||||
' g:=@obj.glide;',
|
||||
' r:=@obj.run;',
|
||||
' with obj do begin',
|
||||
' f:=@fly;',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
' end;',
|
||||
' g:=@tobject.glide;',
|
||||
' r:=@tobject.run;',
|
||||
' with tobject do begin',
|
||||
' g:=@glide;',
|
||||
' r:=@run;',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClassHelper_MethodRefObjFPC',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
|
||||
' $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
|
||||
' $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
|
||||
' $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||
' this.Fly = function (w) {',
|
||||
' $mod.f = rtl.createCallback(this, $mod.THelper.Fly);',
|
||||
' $mod.g = rtl.createCallback(this.$class, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' };',
|
||||
' this.Glide = function (w) {',
|
||||
' $mod.g = rtl.createCallback(this, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' };',
|
||||
' this.Run = function (w) {',
|
||||
' $mod.g = rtl.createCallback($mod.THelper, $mod.THelper.Glide);',
|
||||
' $mod.r = $mod.THelper.Run;',
|
||||
' };',
|
||||
'});',
|
||||
'this.f = null;',
|
||||
'this.g = null;',
|
||||
'this.r = null;',
|
||||
'this.Obj = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.f = rtl.createCallback($mod.Obj, $mod.THelper.Fly);',
|
||||
'$mod.g = rtl.createCallback($mod.Obj.$class, $mod.THelper.Glide);',
|
||||
'$mod.r = $mod.THelper.Run;',
|
||||
'var $with1 = $mod.Obj;',
|
||||
'$mod.f = rtl.createCallback($with1, $mod.THelper.Fly);',
|
||||
'$mod.g = rtl.createCallback($with1.$class, $mod.THelper.Glide);',
|
||||
'$mod.r = $mod.THelper.Run;',
|
||||
'$mod.g = rtl.createCallback($mod.TObject, $mod.THelper.Glide);',
|
||||
'$mod.r = $mod.THelper.Run;',
|
||||
'var $with2 = $mod.TObject;',
|
||||
'$mod.g = rtl.createCallback($with2, $mod.THelper.Glide);',
|
||||
'$mod.r = $mod.THelper.Run;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
@ -19837,16 +20241,16 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.DoIt = function (vJ) {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' var aProc = null;',
|
||||
' var b = false;',
|
||||
' function Sub(vK) {',
|
||||
' var aSub = null;',
|
||||
' function SubSub(vK) {',
|
||||
' var aSubSub = null;',
|
||||
' aProc = rtl.createCallback(Self, "DoIt");',
|
||||
' aSub = rtl.createCallback(Self, "DoIt");',
|
||||
' aSubSub = rtl.createCallback(Self, "DoIt");',
|
||||
' aProc = rtl.createCallback($Self, "DoIt");',
|
||||
' aSub = rtl.createCallback($Self, "DoIt");',
|
||||
' aSubSub = rtl.createCallback($Self, "DoIt");',
|
||||
' aProc = Sub;',
|
||||
' aSub = Sub;',
|
||||
' aSubSub = Sub;',
|
||||
@ -19953,15 +20357,15 @@ begin
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Grow = function (s) {',
|
||||
' var Self = this;',
|
||||
' var $Self = this;',
|
||||
' var Result = 0;',
|
||||
' function GrowSub(i) {',
|
||||
' var Result = 0;',
|
||||
' $mod.f = rtl.createCallback(Self, "Grow");',
|
||||
' $mod.f = rtl.createCallback($Self, "Grow");',
|
||||
' $mod.f = GrowSub;',
|
||||
' return Result;',
|
||||
' };',
|
||||
' $mod.f = rtl.createCallback(Self, "Grow");',
|
||||
' $mod.f = rtl.createCallback($Self, "Grow");',
|
||||
' $mod.f = GrowSub;',
|
||||
' return Result;',
|
||||
' };',
|
||||
|
||||
Loading…
Reference in New Issue
Block a user