mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 10:19:30 +02:00
* Patch from Mattias Gaertner:
- local const: declare as local var in singleton parent function
- give procedure overloads in module unique names by appending $1, $2, ...
- give nested procedure overloads unique names by appending $1, $2, ...
- give reintroduced/overloaded class members unique names by appending $1, $2, ...
- record operators = and <>
- static arrays
- range: enumtype
- init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
- init with expression from const array
- length(1-dim array)
- low(1-dim array), high(1-dim array)
- property TargetProcessor
- ECMAScript6:
- use 0b for binary literals, and 0o for octal literals
git-svn-id: trunk@35491 -
This commit is contained in:
michael
parent
92af9c1670
commit
0da38fd281
File diff suppressed because it is too large
Load Diff
@ -40,7 +40,7 @@ type
|
||||
|
||||
{ TTestEnginePasResolver }
|
||||
|
||||
TTestEnginePasResolver = class(TPasResolver)
|
||||
TTestEnginePasResolver = class(TPas2JsResolver)
|
||||
private
|
||||
FFilename: string;
|
||||
FModule: TPasModule;
|
||||
@ -51,7 +51,6 @@ type
|
||||
FSource: string;
|
||||
procedure SetModule(AValue: TPasModule);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function FindModule(const AName: String): TPasModule; override;
|
||||
property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
|
||||
@ -148,6 +147,7 @@ type
|
||||
Procedure TestUnitImplConsts;
|
||||
Procedure TestUnitImplRecord;
|
||||
Procedure TestRenameJSNameConflict;
|
||||
Procedure TestLocalConst;
|
||||
|
||||
// strings
|
||||
Procedure TestCharConst;
|
||||
@ -169,8 +169,8 @@ type
|
||||
Procedure TestProcTwoArgs;
|
||||
Procedure TestProc_DefaultValue;
|
||||
Procedure TestUnitProcVar;
|
||||
Procedure TestImplProc;
|
||||
Procedure TestFunctionResult;
|
||||
// ToDo: overloads
|
||||
Procedure TestNestedProc;
|
||||
Procedure TestForwardProc;
|
||||
Procedure TestNestedForwardProc;
|
||||
@ -183,6 +183,10 @@ type
|
||||
Procedure TestProcedureAsm;
|
||||
Procedure TestProcedureAssembler;
|
||||
Procedure TestProcedure_VarParam;
|
||||
Procedure TestProcedureOverload;
|
||||
Procedure TestProcedureOverloadForward;
|
||||
Procedure TestProcedureOverloadUnit;
|
||||
Procedure TestProcedureOverloadNested;
|
||||
|
||||
// enums, sets
|
||||
Procedure TestEnumName;
|
||||
@ -225,7 +229,9 @@ type
|
||||
Procedure TestArray_AsParams;
|
||||
Procedure TestArrayElement_AsParams;
|
||||
Procedure TestArrayElementFromFuncResult_AsParams;
|
||||
Procedure TestArrayEnumTypeRange;
|
||||
// ToDo: const array
|
||||
// ToDo: SetLength(array of static array)
|
||||
|
||||
// record
|
||||
Procedure TestRecord_Var;
|
||||
@ -236,6 +242,7 @@ type
|
||||
Procedure TestRecordElement_AsParams;
|
||||
Procedure TestRecordElementFromFuncResult_AsParams;
|
||||
Procedure TestRecordElementFromWith_AsParams;
|
||||
Procedure TestRecord_Equal;
|
||||
// ToDo: const record
|
||||
|
||||
// classes
|
||||
@ -261,10 +268,10 @@ type
|
||||
Procedure TestClass_WithClassInstDoPropertyWithParams;
|
||||
Procedure TestClass_WithClassInstDoFunc;
|
||||
Procedure TestClass_TypeCast;
|
||||
// ToDo: overload
|
||||
// ToDo: second constructor, requires overload
|
||||
// ToDo: call another constructor within a constructor, requires overload
|
||||
// ToDo: reintroduced var, requires overload
|
||||
Procedure TestClass_Overloads;
|
||||
Procedure TestClass_OverloadsAncestor;
|
||||
Procedure TestClass_OverloadConstructor;
|
||||
Procedure TestClass_ReintroducedVar;
|
||||
|
||||
// class of
|
||||
Procedure TestClassOf_Create;
|
||||
@ -277,6 +284,7 @@ type
|
||||
Procedure TestClassOf_ClassMethodSelf;
|
||||
Procedure TestClassOf_TypeCast;
|
||||
|
||||
// proc types
|
||||
Procedure TestProcType;
|
||||
Procedure TestProcType_FunctionFPC;
|
||||
Procedure TestProcType_FunctionDelphi;
|
||||
@ -359,13 +367,6 @@ begin
|
||||
Module.AddRef;
|
||||
end;
|
||||
|
||||
constructor TTestEnginePasResolver.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
StoreSrcColumns:=true;
|
||||
Options:=Options+DefaultPasResolverOptions;
|
||||
end;
|
||||
|
||||
destructor TTestEnginePasResolver.Destroy;
|
||||
begin
|
||||
FreeAndNil(FResolver);
|
||||
@ -1382,6 +1383,37 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestImplProc;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('');
|
||||
Add('procedure Proc1;');
|
||||
Add('');
|
||||
Add('implementation');
|
||||
Add('');
|
||||
Add('procedure Proc1; begin end;');
|
||||
Add('procedure Proc2; begin end;');
|
||||
Add('initialization');
|
||||
Add(' Proc1;');
|
||||
Add(' Proc2;');
|
||||
ConvertUnit;
|
||||
CheckSource('TestImplProc',
|
||||
LinesToStr([ // statements
|
||||
'var $impl = {',
|
||||
'};',
|
||||
'this.$impl = $impl;',
|
||||
'this.Proc1 = function () {',
|
||||
'};',
|
||||
'$impl.Proc2 = function () {',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([ // this.$init
|
||||
'this.Proc1();',
|
||||
'$impl.Proc2();',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestFunctionResult;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1444,9 +1476,9 @@ begin
|
||||
Add('procedure FuncA(Bar: longint); forward;');
|
||||
Add('procedure FuncB(Bar: longint);');
|
||||
Add('begin');
|
||||
Add(' FuncA(Bar);');
|
||||
Add(' funca(bar);');
|
||||
Add('end;');
|
||||
Add('procedure FuncA(Bar: longint);');
|
||||
Add('procedure funca(bar: longint);');
|
||||
Add('begin');
|
||||
Add(' if bar=3 then ;');
|
||||
Add('end;');
|
||||
@ -1806,6 +1838,206 @@ begin
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProcedureOverload;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt(vI: longint); begin end;');
|
||||
Add('procedure DoIt(vI, vJ: longint); begin end;');
|
||||
Add('procedure DoIt(vD: double); begin end;');
|
||||
Add('begin');
|
||||
Add(' DoIt(1);');
|
||||
Add(' DoIt(2,3);');
|
||||
Add(' DoIt(4.5);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestProcedureOverload',
|
||||
LinesToStr([ // statements
|
||||
'this.DoIt = function (vI) {',
|
||||
'};',
|
||||
'this.DoIt$1 = function (vI, vJ) {',
|
||||
'};',
|
||||
'this.DoIt$2 = function (vD) {',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'this.DoIt(1);',
|
||||
'this.DoIt$1(2, 3);',
|
||||
'this.DoIt$2(4.5);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProcedureOverloadForward;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt(vI: longint); forward;');
|
||||
Add('procedure DoIt(vI, vJ: longint); begin end;');
|
||||
Add('procedure doit(vi: longint); begin end;');
|
||||
Add('begin');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(2,3);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestProcedureOverloadForward',
|
||||
LinesToStr([ // statements
|
||||
'this.DoIt$1 = function (vI, vJ) {',
|
||||
'};',
|
||||
'this.DoIt = function (vI) {',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'this.DoIt(1);',
|
||||
'this.DoIt$1(2, 3);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProcedureOverloadUnit;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('procedure DoIt(vI: longint);');
|
||||
Add('procedure DoIt(vI, vJ: longint);');
|
||||
Add('implementation');
|
||||
Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
|
||||
Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
|
||||
Add('procedure DoIt(vi: longint); begin end;');
|
||||
Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
|
||||
Add('procedure DoIt(vi, vj: longint); begin end;');
|
||||
Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
|
||||
Add('begin');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(2,3);');
|
||||
Add(' doit(4,5,6);');
|
||||
Add(' doit(7,8,9,10);');
|
||||
Add(' doit(11,12,13,14,15);');
|
||||
ConvertUnit;
|
||||
CheckSource('TestProcedureOverloadUnit',
|
||||
LinesToStr([ // statements
|
||||
'var $impl = {',
|
||||
'};',
|
||||
'this.$impl = $impl;',
|
||||
'this.DoIt = function (vI) {',
|
||||
'};',
|
||||
'this.DoIt$1 = function (vI, vJ) {',
|
||||
'};',
|
||||
'$impl.DoIt$3 = function (vI, vJ, vK) {',
|
||||
'};',
|
||||
'$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
|
||||
'};',
|
||||
'$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'this.DoIt(1);',
|
||||
'this.DoIt$1(2, 3);',
|
||||
'$impl.DoIt$3(4,5,6);',
|
||||
'$impl.DoIt$4(7,8,9,10);',
|
||||
'$impl.DoIt$2(11,12,13,14,15);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProcedureOverloadNested;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt(vA: longint); forward;');
|
||||
Add('procedure DoIt(vB, vC: longint);');
|
||||
Add('begin // 2 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add('end;');
|
||||
Add('procedure doit(vA: longint);');
|
||||
Add(' procedure DoIt(vA, vB, vC: longint); forward;');
|
||||
Add(' procedure DoIt(vA, vB, vC, vD: longint);');
|
||||
Add(' begin // 4 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' doit(1,2,3);');
|
||||
Add(' doit(1,2,3,4);');
|
||||
Add(' end;');
|
||||
Add(' procedure doit(vA, vB, vC: longint);');
|
||||
Add(' procedure DoIt(vA, vB, vC, vD, vE: longint); forward;');
|
||||
Add(' procedure DoIt(vA, vB, vC, vD, vE, vF: longint);');
|
||||
Add(' begin // 6 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' doit(1,2,3);');
|
||||
Add(' doit(1,2,3,4);');
|
||||
Add(' doit(1,2,3,4,5);');
|
||||
Add(' doit(1,2,3,4,5,6);');
|
||||
Add(' end;');
|
||||
Add(' procedure doit(vA, vB, vC, vD, vE: longint);');
|
||||
Add(' begin // 5 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' doit(1,2,3);');
|
||||
Add(' doit(1,2,3,4);');
|
||||
Add(' doit(1,2,3,4,5);');
|
||||
Add(' doit(1,2,3,4,5,6);');
|
||||
Add(' end;');
|
||||
Add(' begin // 3 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' doit(1,2,3);');
|
||||
Add(' doit(1,2,3,4);');
|
||||
Add(' doit(1,2,3,4,5);');
|
||||
Add(' doit(1,2,3,4,5,6);');
|
||||
Add(' end;');
|
||||
Add('begin // 1 param overload');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' doit(1,2,3);');
|
||||
Add(' doit(1,2,3,4);');
|
||||
Add('end;');
|
||||
Add('begin // main');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestProcedureOverloadNested',
|
||||
LinesToStr([ // statements
|
||||
'this.DoIt$1 = function (vB, vC) {',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
'};',
|
||||
'this.DoIt = function (vA) {',
|
||||
' function DoIt$3(vA, vB, vC, vD) {',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
' DoIt$2(1, 2, 3);',
|
||||
' DoIt$3(1, 2, 3, 4);',
|
||||
' };',
|
||||
' function DoIt$2(vA, vB, vC) {',
|
||||
' function DoIt$5(vA, vB, vC, vD, vE, vF) {',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
' DoIt$2(1, 2, 3);',
|
||||
' DoIt$3(1, 2, 3, 4);',
|
||||
' DoIt$4(1, 2, 3, 4, 5);',
|
||||
' DoIt$5(1, 2, 3, 4, 5, 6);',
|
||||
' };',
|
||||
' function DoIt$4(vA, vB, vC, vD, vE) {',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
' DoIt$2(1, 2, 3);',
|
||||
' DoIt$3(1, 2, 3, 4);',
|
||||
' DoIt$4(1, 2, 3, 4, 5);',
|
||||
' DoIt$5(1, 2, 3, 4, 5, 6);',
|
||||
' };',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
' DoIt$2(1, 2, 3);',
|
||||
' DoIt$3(1, 2, 3, 4);',
|
||||
' DoIt$4(1, 2, 3, 4, 5);',
|
||||
' DoIt$5(1, 2, 3, 4, 5, 6);',
|
||||
' };',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1, 2);',
|
||||
' DoIt$2(1, 2, 3);',
|
||||
' DoIt$3(1, 2, 3, 4);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'this.DoIt(1);',
|
||||
'this.DoIt$1(1, 2);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestEnumName;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2349,6 +2581,9 @@ begin
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.i == b.i;',
|
||||
' };',
|
||||
'};',
|
||||
'$impl.aRec = new $impl.TMyRecord();'
|
||||
]),
|
||||
@ -2375,6 +2610,44 @@ begin
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestLocalConst;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('procedure DoIt;');
|
||||
Add('const');
|
||||
Add(' cA: longint = 1;');
|
||||
Add(' cB = 2;');
|
||||
Add(' procedure Sub;');
|
||||
Add(' const');
|
||||
Add(' csA = 3;');
|
||||
Add(' cB: double = 4;');
|
||||
Add(' begin');
|
||||
Add(' cb:=cb+csa;');
|
||||
Add(' ca:=ca+csa+5;');
|
||||
Add(' end;');
|
||||
Add('begin');
|
||||
Add(' ca:=ca+cb+6;');
|
||||
Add('end;');
|
||||
Add('begin');
|
||||
ConvertProgram;
|
||||
CheckSource('TestLocalConst',
|
||||
LinesToStr([
|
||||
'var cA = 1;',
|
||||
'var cB = 2;',
|
||||
'var csA = 3;',
|
||||
'var cB$1 = 4;',
|
||||
'this.DoIt = function () {',
|
||||
' function Sub() {',
|
||||
' cB$1 = cB$1 + csA;',
|
||||
' cA = (cA + csA) + 5;',
|
||||
' };',
|
||||
' cA = (cA + cB) + 6;',
|
||||
'};'
|
||||
]),
|
||||
LinesToStr([
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestCharConst;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2530,7 +2803,7 @@ begin
|
||||
'this.s = "";'
|
||||
]),
|
||||
LinesToStr([ // this.$main
|
||||
'rtl.setStringLength(this.s,3);'
|
||||
'rtl.stringSetLength(this.s,3);'
|
||||
]));
|
||||
end;
|
||||
|
||||
@ -3109,7 +3382,7 @@ begin
|
||||
'this.i = 0;'
|
||||
]),
|
||||
LinesToStr([ // this.$main
|
||||
'this.Arr = rtl.setArrayLength(this.Arr,3,0);',
|
||||
'this.Arr = rtl.arraySetLength(this.Arr,3,0);',
|
||||
'this.Arr[0] = 4;',
|
||||
'this.Arr[1] = rtl.length(this.Arr)+this.Arr[0];',
|
||||
'this.Arr[this.i] = 5;',
|
||||
@ -3187,8 +3460,8 @@ begin
|
||||
'this.i = this.Arr2[6][7];',
|
||||
'this.Arr2[8][9] = this.i;',
|
||||
'this.i = this.Arr2[10][11];',
|
||||
'this.Arr2 = rtl.setArrayLength(this.Arr2, 14, []);',
|
||||
'this.Arr2[15] = rtl.setArrayLength(this.Arr2[15], 16, 0);',
|
||||
'this.Arr2 = rtl.arraySetLength(this.Arr2, 14, []);',
|
||||
'this.Arr2[15] = rtl.arraySetLength(this.Arr2[15], 16, 0);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
@ -3222,13 +3495,16 @@ begin
|
||||
' } else {',
|
||||
' this.Int = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.Int == b.Int;',
|
||||
' };',
|
||||
'};',
|
||||
'this.Arr = [];',
|
||||
'this.r = new this.TRec();',
|
||||
'this.i = 0;'
|
||||
]),
|
||||
LinesToStr([ // this.$main
|
||||
'this.Arr = rtl.setArrayLength(this.Arr,3, this.TRec);',
|
||||
'this.Arr = rtl.arraySetLength(this.Arr,3, this.TRec);',
|
||||
'this.Arr[0].Int = 4;',
|
||||
'this.Arr[1].Int = rtl.length(this.Arr)+this.Arr[2].Int;',
|
||||
'this.Arr[this.Arr[this.i].Int].Int = this.Arr[5].Int;',
|
||||
@ -3415,6 +3691,46 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArrayEnumTypeRange;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TEnum = (red,blue);');
|
||||
Add(' TEnumArray = array[TEnum] of longint;');
|
||||
Add('var');
|
||||
Add(' e: TEnum;');
|
||||
Add(' i: longint;');
|
||||
Add(' a: TEnumArray;');
|
||||
Add(' numbers: TEnumArray = (1,2);');
|
||||
Add(' names: array[TEnum] of string = (''red'',''blue'');');
|
||||
Add('begin');
|
||||
Add(' e:=low(a);');
|
||||
Add(' e:=high(a);');
|
||||
Add(' i:=a[red]+length(a);');
|
||||
Add(' a[e]:=a[e];');
|
||||
ConvertProgram;
|
||||
CheckSource('TestArrayEnumTypeRange',
|
||||
LinesToStr([ // statements
|
||||
' this.TEnum = {',
|
||||
' "0": "red",',
|
||||
' red: 0,',
|
||||
' "1": "blue",',
|
||||
' blue: 1',
|
||||
'};',
|
||||
'this.e = 0;',
|
||||
'this.i = 0;',
|
||||
'this.a = rtl.arrayNewMultiDim([2],0);',
|
||||
'this.numbers = [1, 2];',
|
||||
'this.names = ["red", "blue"];',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.e = this.TEnum.red;',
|
||||
'this.e = this.TEnum.blue;',
|
||||
'this.i = this.a[this.TEnum.red]+2;',
|
||||
'this.a[this.e] = this.a[this.e];',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecord_Var;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -3434,6 +3750,9 @@ begin
|
||||
' } else {',
|
||||
' this.Bold = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.Bold == b.Bold;',
|
||||
' };',
|
||||
'};',
|
||||
'this.Rec = new this.TRecA();'
|
||||
]),
|
||||
@ -3468,6 +3787,9 @@ begin
|
||||
' } else {',
|
||||
' this.vI = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.vI == b.vI;',
|
||||
' };',
|
||||
'};',
|
||||
'this.Int = 0;',
|
||||
'this.r = new this.TRec();'
|
||||
@ -3516,6 +3838,9 @@ begin
|
||||
' } else {',
|
||||
' this.N = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.N == b.N;',
|
||||
' };',
|
||||
'};',
|
||||
'this.TBigRec = function (s) {',
|
||||
' if(s){',
|
||||
@ -3531,6 +3856,10 @@ begin
|
||||
' this.Small = new pas.program.TSmallRec();',
|
||||
' this.Enums = {};',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return (this.Int == b.Int) && ((this.D == b.D) && ((this.Arr == b.Arr)',
|
||||
' && (this.Small.$equal(b.Small) && rtl.eqSet(this.Enums, b.Enums))));',
|
||||
' };',
|
||||
'};',
|
||||
'this.r = new this.TBigRec();',
|
||||
'this.s = new this.TBigRec();'
|
||||
@ -3562,6 +3891,9 @@ begin
|
||||
' } else {',
|
||||
' this.Bold = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.Bold == b.Bold;',
|
||||
' };',
|
||||
'};',
|
||||
'this.DoDefault = function (r) {',
|
||||
'};',
|
||||
@ -3606,6 +3938,9 @@ begin
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.i == b.i;',
|
||||
' };',
|
||||
'};',
|
||||
'this.DoIt = function (vG,vH,vI) {',
|
||||
' var vJ = new this.TRecord();',
|
||||
@ -3678,6 +4013,9 @@ begin
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.i == b.i;',
|
||||
' };',
|
||||
'};',
|
||||
'this.DoIt = function (vG,vH,vI) {',
|
||||
' var vJ = new this.TRecord();',
|
||||
@ -3733,6 +4071,9 @@ begin
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.i == b.i;',
|
||||
' };',
|
||||
'};',
|
||||
'this.GetRec = function (vB) {',
|
||||
' var Result = new this.TRecord();',
|
||||
@ -3796,6 +4137,9 @@ begin
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.i == b.i;',
|
||||
' };',
|
||||
'};',
|
||||
'this.DoIt = function (vG,vH,vI) {',
|
||||
'};',
|
||||
@ -3815,6 +4159,71 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecord_Equal;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' integer = longint;');
|
||||
Add(' TFlag = (red,blue);');
|
||||
Add(' TFlags = set of TFlag;');
|
||||
Add(' TProc = procedure;');
|
||||
Add(' TRecord = record');
|
||||
Add(' i: integer;');
|
||||
Add(' Event: TProc;');
|
||||
Add(' f: TFlags;');
|
||||
Add(' end;');
|
||||
Add(' TNested = record');
|
||||
Add(' r: TRecord;');
|
||||
Add(' end;');
|
||||
Add('var');
|
||||
Add(' b: boolean;');
|
||||
Add(' r,s: trecord;');
|
||||
Add('begin');
|
||||
Add(' b:=r=s;');
|
||||
Add(' b:=r<>s;');
|
||||
ConvertProgram;
|
||||
CheckSource('TestRecord_Equal',
|
||||
LinesToStr([ // statements
|
||||
'this.TFlag = {',
|
||||
' "0": "red",',
|
||||
' red: 0,',
|
||||
' "1": "blue",',
|
||||
' blue: 1',
|
||||
'};',
|
||||
'this.TRecord = function (s) {',
|
||||
' if (s) {',
|
||||
' this.i = s.i;',
|
||||
' this.Event = s.Event;',
|
||||
' this.f = rtl.cloneSet(s.f);',
|
||||
' } else {',
|
||||
' this.i = 0;',
|
||||
' this.Event = null;',
|
||||
' this.f = {};',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return (this.i == b.i) && (rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f));',
|
||||
' };',
|
||||
'};',
|
||||
'this.TNested = function (s) {',
|
||||
' if (s) {',
|
||||
' this.r = new pas.program.TRecord(s.r);',
|
||||
' } else {',
|
||||
' this.r = new pas.program.TRecord();',
|
||||
' };',
|
||||
' this.$equal = function (b) {',
|
||||
' return this.r.$equal(b.r);',
|
||||
' };',
|
||||
'};',
|
||||
'this.b = false;',
|
||||
'this.r = new this.TRecord();',
|
||||
'this.s = new this.TRecord();'
|
||||
]),
|
||||
LinesToStr([
|
||||
'this.b = this.r.$equal(this.s);',
|
||||
'this.b = !this.r.$equal(this.s);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_TObjectDefaultConstructor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -5091,6 +5500,216 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_Overloads;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' procedure DoIt;');
|
||||
Add(' procedure DoIt(vI: longint);');
|
||||
Add(' end;');
|
||||
Add('procedure TObject.DoIt;');
|
||||
Add('begin');
|
||||
Add(' DoIt;');
|
||||
Add(' DoIt(1);');
|
||||
Add('end;');
|
||||
Add('procedure TObject.DoIt(vI: longint); begin end;');
|
||||
Add('begin');
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_Overloads',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass(this, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' this.DoIt();',
|
||||
' this.DoIt$1(1);',
|
||||
' };',
|
||||
' this.DoIt$1 = function (vI) {',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_OverloadsAncestor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' procedure DoIt(vA: longint);');
|
||||
Add(' procedure DoIt(vA, vB: longint);');
|
||||
Add(' end;');
|
||||
Add(' TCar = class');
|
||||
Add(' procedure DoIt(vA: longint);');
|
||||
Add(' procedure DoIt(vA, vB: longint);');
|
||||
Add(' end;');
|
||||
Add('procedure tobject.doit(va: longint);');
|
||||
Add('begin');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add('end;');
|
||||
Add('procedure tobject.doit(va, vb: longint); begin end;');
|
||||
Add('procedure tcar.doit(va: longint);');
|
||||
Add('begin');
|
||||
Add(' doit(1);');
|
||||
Add(' doit(1,2);');
|
||||
Add(' inherited doit(1);');
|
||||
Add(' inherited doit(1,2);');
|
||||
Add('end;');
|
||||
Add('procedure tcar.doit(va, vb: longint); begin end;');
|
||||
Add('begin');
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_OverloadsAncestor',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass(this, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.DoIt = function (vA) {',
|
||||
' this.DoIt(1);',
|
||||
' this.DoIt$1(1,2);',
|
||||
' };',
|
||||
' this.DoIt$1 = function (vA, vB) {',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TCar", this.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TObject.$init.call(this);',
|
||||
' };',
|
||||
' this.DoIt$2 = function (vA) {',
|
||||
' this.DoIt$2(1);',
|
||||
' this.DoIt$3(1, 2);',
|
||||
' pas.program.TObject.DoIt.call(this, 1);',
|
||||
' pas.program.TObject.DoIt$1.call(this, 1, 2);',
|
||||
' };',
|
||||
' this.DoIt$3 = function (vA, vB) {',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_OverloadConstructor;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' constructor Create(vA: longint);');
|
||||
Add(' constructor Create(vA, vB: longint);');
|
||||
Add(' end;');
|
||||
Add(' TCar = class');
|
||||
Add(' constructor Create(vA: longint);');
|
||||
Add(' constructor Create(vA, vB: longint);');
|
||||
Add(' end;');
|
||||
Add('constructor tobject.create(va: longint);');
|
||||
Add('begin');
|
||||
Add(' create(1);');
|
||||
Add(' create(1,2);');
|
||||
Add('end;');
|
||||
Add('constructor tobject.create(va, vb: longint); begin end;');
|
||||
Add('constructor tcar.create(va: longint);');
|
||||
Add('begin');
|
||||
Add(' create(1);');
|
||||
Add(' create(1,2);');
|
||||
Add(' inherited create(1);');
|
||||
Add(' inherited create(1,2);');
|
||||
Add('end;');
|
||||
Add('constructor tcar.create(va, vb: longint); begin end;');
|
||||
Add('begin');
|
||||
Add(' tobject.create(1);');
|
||||
Add(' tobject.create(1,2);');
|
||||
Add(' tcar.create(1);');
|
||||
Add(' tcar.create(1,2);');
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_OverloadConstructor',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass(this, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.Create = function (vA) {',
|
||||
' this.Create(1);',
|
||||
' this.Create$1(1,2);',
|
||||
' };',
|
||||
' this.Create$1 = function (vA, vB) {',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TCar", this.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TObject.$init.call(this);',
|
||||
' };',
|
||||
' this.Create$2 = function (vA) {',
|
||||
' this.Create$2(1);',
|
||||
' this.Create$3(1, 2);',
|
||||
' pas.program.TObject.Create.call(this, 1);',
|
||||
' pas.program.TObject.Create$1.call(this, 1, 2);',
|
||||
' };',
|
||||
' this.Create$3 = function (vA, vB) {',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.TObject.$create("Create", [1]);',
|
||||
'this.TObject.$create("Create$1", [1, 2]);',
|
||||
'this.TCar.$create("Create$2", [1]);',
|
||||
'this.TCar.$create("Create$3", [1, 2]);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_ReintroducedVar;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class');
|
||||
Add(' strict private');
|
||||
Add(' Some: longint;');
|
||||
Add(' end;');
|
||||
Add(' TMobile = class');
|
||||
Add(' strict private');
|
||||
Add(' Some: string;');
|
||||
Add(' end;');
|
||||
Add(' TCar = class(tmobile)');
|
||||
Add(' procedure Some;');
|
||||
Add(' procedure Some(vA: longint);');
|
||||
Add(' end;');
|
||||
Add('procedure tcar.some;');
|
||||
Add('begin');
|
||||
Add(' Some;');
|
||||
Add(' Some(1);');
|
||||
Add('end;');
|
||||
Add('procedure tcar.some(va: longint); begin end;');
|
||||
Add('begin');
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_ReintroducedVar',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass(this, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' this.Some = 0;',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TMobile", this.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TObject.$init.call(this);',
|
||||
' this.Some$1 = "";',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TCar", this.TMobile, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TMobile.$init.call(this);',
|
||||
' };',
|
||||
' this.Some$2 = function () {',
|
||||
' this.Some$2();',
|
||||
' this.Some$3(1);',
|
||||
' };',
|
||||
' this.Some$3 = function (vA) {',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClassOf_Create;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -5470,24 +6089,24 @@ begin
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' this.DoIt();',
|
||||
' this.DoIt();',
|
||||
' this.DoIt$1();',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TMobile", this.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TObject.$init.call(this);',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' this.DoIt();',
|
||||
' this.DoIt();',
|
||||
' this.DoIt$1 = function () {',
|
||||
' this.DoIt();',
|
||||
' this.DoIt$1();',
|
||||
' this.DoIt$2();',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass(this, "TCar", this.TMobile, function () {',
|
||||
' this.$init = function () {',
|
||||
' pas.program.TMobile.$init.call(this);',
|
||||
' };',
|
||||
' this.DoIt = function () {',
|
||||
' this.DoIt$2 = function () {',
|
||||
' };',
|
||||
'});',
|
||||
'this.ObjC = null;',
|
||||
@ -5496,17 +6115,17 @@ begin
|
||||
'']),
|
||||
LinesToStr([ // this.$main
|
||||
'this.ObjC.DoIt();',
|
||||
'this.MobileC.DoIt();',
|
||||
'this.CarC.DoIt();',
|
||||
'this.ObjC.DoIt();',
|
||||
'this.ObjC.DoIt();',
|
||||
'this.MobileC.DoIt$1();',
|
||||
'this.CarC.DoIt$2();',
|
||||
'this.ObjC.DoIt();',
|
||||
'this.ObjC.DoIt$1();',
|
||||
'this.ObjC.DoIt$2();',
|
||||
'this.MobileC.DoIt();',
|
||||
'this.MobileC.DoIt();',
|
||||
'this.MobileC.DoIt();',
|
||||
'this.CarC.DoIt();',
|
||||
'this.CarC.DoIt();',
|
||||
'this.MobileC.DoIt$1();',
|
||||
'this.MobileC.DoIt$2();',
|
||||
'this.CarC.DoIt();',
|
||||
'this.CarC.DoIt$1();',
|
||||
'this.CarC.DoIt$2();',
|
||||
'']));
|
||||
end;
|
||||
|
||||
|
||||
18
utils/pas2js/dist/rtl.js
vendored
18
utils/pas2js/dist/rtl.js
vendored
@ -210,7 +210,7 @@ var rtl = {
|
||||
throw pas.System.EInvalidCast.$create("create");
|
||||
},
|
||||
|
||||
setArrayLength: function(arr,newlength,defaultvalue){
|
||||
arraySetLength: function(arr,newlength,defaultvalue){
|
||||
if (newlength == 0) return null;
|
||||
if (arr == null) arr = [];
|
||||
var oldlen = arr.length;
|
||||
@ -226,7 +226,21 @@ var rtl = {
|
||||
return arr;
|
||||
},
|
||||
|
||||
setStringLength: function(s,newlength){
|
||||
arrayNewMultiDim: function(dims,defaultvalue){
|
||||
function create(dim){
|
||||
if (dim == dims.length-1){
|
||||
return rtl.arraySetLength(null,dims[dim],defaultvalue);
|
||||
}
|
||||
var a = [];
|
||||
var count = dims[dim];
|
||||
a.length = count;
|
||||
for(var i=0; i<count; i++) a[i] = create(dim+1);
|
||||
return a;
|
||||
};
|
||||
return create(0);
|
||||
},
|
||||
|
||||
stringSetLength: function(s,newlength){
|
||||
s.length = newlength;
|
||||
},
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user