|
@@ -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,27 +18806,407 @@ 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;',
|
|
|
- ' 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;',
|
|
|
+ ' 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 () {',
|
|
|
+ ' };',
|
|
|
+ '});',
|
|
|
+ 'rtl.createHelper($mod, "THelper", null, function () {',
|
|
|
+ ' this.Foo = function (w) {',
|
|
|
+ ' var Result = 0;',
|
|
|
+ ' 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:[email protected];',
|
|
|
+ ' g:[email protected];',
|
|
|
+ ' r:[email protected];',
|
|
|
+ ' 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:[email protected];',
|
|
|
+ ' g:[email protected];',
|
|
|
+ ' r:[email protected];',
|
|
|
+ ' with obj do begin',
|
|
|
+ ' f:=@fly;',
|
|
|
+ ' g:=@glide;',
|
|
|
+ ' r:=@run;',
|
|
|
+ ' end;',
|
|
|
+ ' g:[email protected];',
|
|
|
+ ' r:[email protected];',
|
|
|
+ ' 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;',
|
|
|
' };',
|