mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 13:29:21 +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_ClassVar;
|
||||||
Procedure TestClassHelper_Method_AccessInstanceFields;
|
Procedure TestClassHelper_Method_AccessInstanceFields;
|
||||||
Procedure TestClassHelper_Method_Call;
|
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_Constructor;
|
||||||
//Procedure TestClassHelper_InheritedObjFPC;
|
//Procedure TestClassHelper_InheritedObjFPC;
|
||||||
//Procedure TestClassHelper_InheritedDelphi;
|
//Procedure TestClassHelper_InheritedDelphi;
|
||||||
// todo: TestClassHelper_Property
|
// todo: TestClassHelper_Property
|
||||||
|
// todo: TestClassHelper_Property_Array
|
||||||
|
// todo: TestClassHelper_Property_Index
|
||||||
// todo: TestClassHelper_ClassProperty
|
// todo: TestClassHelper_ClassProperty
|
||||||
|
// todo: TestClassHelper_ClassProperty_Array
|
||||||
|
// todo: TestClassHelper_ClassProperty_Index
|
||||||
// todo: TestClassHelper_Overload
|
// todo: TestClassHelper_Overload
|
||||||
// todo: TestRecordHelper
|
// todo: TestRecordHelper_ClassVar
|
||||||
// todo: TestTypeHelper
|
// 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
|
// proc types
|
||||||
Procedure TestProcType;
|
Procedure TestProcType;
|
||||||
@ -4485,19 +4510,19 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.DoIt = function () {',
|
' this.DoIt = function () {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' var p = null;',
|
' var p = null;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' p = function () {',
|
' p = function () {',
|
||||||
' Self.i = 3;',
|
' $Self.i = 3;',
|
||||||
' Self.i = 4;',
|
' $Self.i = 4;',
|
||||||
' p = function () {',
|
' p = function () {',
|
||||||
' function SubSub() {',
|
' function SubSub() {',
|
||||||
' Self.i = 13;',
|
' $Self.i = 13;',
|
||||||
' Self.i = 14;',
|
' $Self.i = 14;',
|
||||||
' };',
|
' };',
|
||||||
' Self.i = 13;',
|
' $Self.i = 13;',
|
||||||
' Self.i = 14;',
|
' $Self.i = 14;',
|
||||||
' };',
|
' };',
|
||||||
' };',
|
' };',
|
||||||
' };',
|
' };',
|
||||||
@ -13392,24 +13417,24 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.DoIt = function () {',
|
' this.DoIt = function () {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' Self.Key = Self.Key + 2;',
|
' $Self.Key = $Self.Key + 2;',
|
||||||
' Self.Key = Self.Key + 3;',
|
' $Self.Key = $Self.Key + 3;',
|
||||||
' $mod.TObject.State = Self.State + 4;',
|
' $mod.TObject.State = $Self.State + 4;',
|
||||||
' $mod.TObject.State = Self.State + 5;',
|
' $mod.TObject.State = $Self.State + 5;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 6;',
|
' $mod.TObject.State = $mod.TObject.State + 6;',
|
||||||
' Self.SetSize(Self.GetSize() + 7);',
|
' $Self.SetSize($Self.GetSize() + 7);',
|
||||||
' Self.SetSize(Self.GetSize() + 8);',
|
' $Self.SetSize($Self.GetSize() + 8);',
|
||||||
' };',
|
' };',
|
||||||
' Sub();',
|
' Sub();',
|
||||||
' Self.Key = Self.Key + 12;',
|
' $Self.Key = $Self.Key + 12;',
|
||||||
' Self.Key = Self.Key + 13;',
|
' $Self.Key = $Self.Key + 13;',
|
||||||
' $mod.TObject.State = Self.State + 14;',
|
' $mod.TObject.State = $Self.State + 14;',
|
||||||
' $mod.TObject.State = Self.State + 15;',
|
' $mod.TObject.State = $Self.State + 15;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 16;',
|
' $mod.TObject.State = $mod.TObject.State + 16;',
|
||||||
' Self.SetSize(Self.GetSize() + 17);',
|
' $Self.SetSize($Self.GetSize() + 17);',
|
||||||
' Self.SetSize(Self.GetSize() + 18);',
|
' $Self.SetSize($Self.GetSize() + 18);',
|
||||||
' };',
|
' };',
|
||||||
'});',
|
'});',
|
||||||
'']),
|
'']),
|
||||||
@ -13468,24 +13493,24 @@ begin
|
|||||||
'});',
|
'});',
|
||||||
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
||||||
' this.DoIt = function () {',
|
' this.DoIt = function () {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' Self.Key = Self.Key + 2;',
|
' $Self.Key = $Self.Key + 2;',
|
||||||
' Self.Key = Self.Key + 3;',
|
' $Self.Key = $Self.Key + 3;',
|
||||||
' $mod.TObject.State = Self.State + 4;',
|
' $mod.TObject.State = $Self.State + 4;',
|
||||||
' $mod.TObject.State = Self.State + 5;',
|
' $mod.TObject.State = $Self.State + 5;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 6;',
|
' $mod.TObject.State = $mod.TObject.State + 6;',
|
||||||
' Self.SetSize(Self.GetSize() + 7);',
|
' $Self.SetSize($Self.GetSize() + 7);',
|
||||||
' Self.SetSize(Self.GetSize() + 8);',
|
' $Self.SetSize($Self.GetSize() + 8);',
|
||||||
' };',
|
' };',
|
||||||
' Sub();',
|
' Sub();',
|
||||||
' Self.Key = Self.Key + 12;',
|
' $Self.Key = $Self.Key + 12;',
|
||||||
' Self.Key = Self.Key + 13;',
|
' $Self.Key = $Self.Key + 13;',
|
||||||
' $mod.TObject.State = Self.State + 14;',
|
' $mod.TObject.State = $Self.State + 14;',
|
||||||
' $mod.TObject.State = Self.State + 15;',
|
' $mod.TObject.State = $Self.State + 15;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 16;',
|
' $mod.TObject.State = $mod.TObject.State + 16;',
|
||||||
' Self.SetSize(Self.GetSize() + 17);',
|
' $Self.SetSize($Self.GetSize() + 17);',
|
||||||
' Self.SetSize(Self.GetSize() + 18);',
|
' $Self.SetSize($Self.GetSize() + 18);',
|
||||||
' };',
|
' };',
|
||||||
'});',
|
'});',
|
||||||
'']),
|
'']),
|
||||||
@ -13536,21 +13561,21 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.DoIt = function () {',
|
' this.DoIt = function () {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' $mod.TObject.State = Self.State + 2;',
|
' $mod.TObject.State = $Self.State + 2;',
|
||||||
' $mod.TObject.State = Self.State + 3;',
|
' $mod.TObject.State = $Self.State + 3;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 4;',
|
' $mod.TObject.State = $mod.TObject.State + 4;',
|
||||||
' Self.SetSize(Self.GetSize() + 5);',
|
' $Self.SetSize($Self.GetSize() + 5);',
|
||||||
' Self.SetSize(Self.GetSize() + 6);',
|
' $Self.SetSize($Self.GetSize() + 6);',
|
||||||
' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
|
' $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
|
||||||
' };',
|
' };',
|
||||||
' Sub();',
|
' Sub();',
|
||||||
' $mod.TObject.State = Self.State + 12;',
|
' $mod.TObject.State = $Self.State + 12;',
|
||||||
' $mod.TObject.State = Self.State + 13;',
|
' $mod.TObject.State = $Self.State + 13;',
|
||||||
' $mod.TObject.State = $mod.TObject.State + 14;',
|
' $mod.TObject.State = $mod.TObject.State + 14;',
|
||||||
' Self.SetSize(Self.GetSize() + 15);',
|
' $Self.SetSize($Self.GetSize() + 15);',
|
||||||
' Self.SetSize(Self.GetSize() + 16);',
|
' $Self.SetSize($Self.GetSize() + 16);',
|
||||||
' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
|
' $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
|
||||||
' };',
|
' };',
|
||||||
'});',
|
'});',
|
||||||
@ -13602,14 +13627,14 @@ begin
|
|||||||
'});',
|
'});',
|
||||||
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
||||||
' this.DoIt = function (k) {',
|
' this.DoIt = function (k) {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' var Result = 0;',
|
' var Result = 0;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' $mod.TObject.DoIt.call(Self, true);',
|
' $mod.TObject.DoIt.call($Self, true);',
|
||||||
' };',
|
' };',
|
||||||
' Sub();',
|
' Sub();',
|
||||||
' $mod.TObject.DoIt.apply(Self, arguments);',
|
' $mod.TObject.DoIt.apply($Self, arguments);',
|
||||||
' $mod.TObject.DoIt.call(Self, true);',
|
' $mod.TObject.DoIt.call($Self, true);',
|
||||||
' return Result;',
|
' return Result;',
|
||||||
' };',
|
' };',
|
||||||
'});',
|
'});',
|
||||||
@ -15999,12 +16024,12 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.DoIt = function (i) {',
|
' this.DoIt = function (i) {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' function Sub() {',
|
' function Sub() {',
|
||||||
' };',
|
' };',
|
||||||
' var f = null;',
|
' var f = null;',
|
||||||
' f = rtl.createCallback(Self, "DoIt");',
|
' f = rtl.createCallback($Self, "DoIt");',
|
||||||
' f = rtl.createCallback(Self, "DoIt").bind(null, 13);',
|
' f = rtl.createCallback($Self, "DoIt").bind(null, 13);',
|
||||||
' f = Sub;',
|
' f = Sub;',
|
||||||
' f = $mod.GetIt;',
|
' f = $mod.GetIt;',
|
||||||
' };',
|
' };',
|
||||||
@ -18725,7 +18750,6 @@ end;
|
|||||||
|
|
||||||
procedure TTestModule.TestClassHelper_Method_Call;
|
procedure TTestModule.TestClassHelper_Method_Call;
|
||||||
begin
|
begin
|
||||||
exit;
|
|
||||||
StartProgram(false);
|
StartProgram(false);
|
||||||
Add([
|
Add([
|
||||||
'type',
|
'type',
|
||||||
@ -18782,7 +18806,264 @@ begin
|
|||||||
LinesToStr([ // statements
|
LinesToStr([ // statements
|
||||||
'rtl.createClass($mod, "TObject", null, function () {',
|
'rtl.createClass($mod, "TObject", null, function () {',
|
||||||
' this.$init = 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 () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
@ -18790,19 +19071,142 @@ begin
|
|||||||
'rtl.createHelper($mod, "THelper", null, function () {',
|
'rtl.createHelper($mod, "THelper", null, function () {',
|
||||||
' this.Foo = function (w) {',
|
' this.Foo = function (w) {',
|
||||||
' var Result = 0;',
|
' 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;',
|
' return Result;',
|
||||||
' };',
|
' };',
|
||||||
'});',
|
'});',
|
||||||
|
'this.c = null;',
|
||||||
'']),
|
'']),
|
||||||
LinesToStr([ // $mod.$main
|
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;
|
end;
|
||||||
|
|
||||||
@ -19837,16 +20241,16 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.DoIt = function (vJ) {',
|
' this.DoIt = function (vJ) {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' var aProc = null;',
|
' var aProc = null;',
|
||||||
' var b = false;',
|
' var b = false;',
|
||||||
' function Sub(vK) {',
|
' function Sub(vK) {',
|
||||||
' var aSub = null;',
|
' var aSub = null;',
|
||||||
' function SubSub(vK) {',
|
' function SubSub(vK) {',
|
||||||
' var aSubSub = null;',
|
' var aSubSub = null;',
|
||||||
' aProc = rtl.createCallback(Self, "DoIt");',
|
' aProc = rtl.createCallback($Self, "DoIt");',
|
||||||
' aSub = rtl.createCallback(Self, "DoIt");',
|
' aSub = rtl.createCallback($Self, "DoIt");',
|
||||||
' aSubSub = rtl.createCallback(Self, "DoIt");',
|
' aSubSub = rtl.createCallback($Self, "DoIt");',
|
||||||
' aProc = Sub;',
|
' aProc = Sub;',
|
||||||
' aSub = Sub;',
|
' aSub = Sub;',
|
||||||
' aSubSub = Sub;',
|
' aSubSub = Sub;',
|
||||||
@ -19953,15 +20357,15 @@ begin
|
|||||||
' this.$final = function () {',
|
' this.$final = function () {',
|
||||||
' };',
|
' };',
|
||||||
' this.Grow = function (s) {',
|
' this.Grow = function (s) {',
|
||||||
' var Self = this;',
|
' var $Self = this;',
|
||||||
' var Result = 0;',
|
' var Result = 0;',
|
||||||
' function GrowSub(i) {',
|
' function GrowSub(i) {',
|
||||||
' var Result = 0;',
|
' var Result = 0;',
|
||||||
' $mod.f = rtl.createCallback(Self, "Grow");',
|
' $mod.f = rtl.createCallback($Self, "Grow");',
|
||||||
' $mod.f = GrowSub;',
|
' $mod.f = GrowSub;',
|
||||||
' return Result;',
|
' return Result;',
|
||||||
' };',
|
' };',
|
||||||
' $mod.f = rtl.createCallback(Self, "Grow");',
|
' $mod.f = rtl.createCallback($Self, "Grow");',
|
||||||
' $mod.f = GrowSub;',
|
' $mod.f = GrowSub;',
|
||||||
' return Result;',
|
' return Result;',
|
||||||
' };',
|
' };',
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user