Browse Source

* Patch from Mattias Gaertner:
- char and string literals
- setlength() for string
- property read accessor var and function
- property write accessor var and function
- property with param list
- property of type array
- class property
- convert "a div b" to "Math.floor(a / b)"
- and, or, xor, not: logical or bitwise
- enum type with values and names
- enums: option to write numbers instead of variables
- enums: ord(), low(), high(), pred(), succ()
- type cast number to enum
- set of enum
- include(), exclude()
- assign := for sets
- constant set: enums, enum vars, ranges
- set operators +, -, *, ><, =, <>, >=, <=
- set in-operator
- sets: low(), high()
- assign nil to dyn array

git-svn-id: trunk@35417 -

michael 8 years ago
parent
commit
25fc79b2b8
3 changed files with 1438 additions and 224 deletions
  1. 562 205
      packages/pastojs/src/fppas2js.pp
  2. 3 3
      packages/pastojs/tests/tcconverter.pp
  3. 873 16
      packages/pastojs/tests/tcmodules.pas

File diff suppressed because it is too large
+ 562 - 205
packages/pastojs/src/fppas2js.pp


+ 3 - 3
packages/pastojs/tests/tcconverter.pp

@@ -389,7 +389,7 @@ begin
   //   for(i=1; i<=$loopend1; i++){ a:=b; }
 
   // "var $loopend1=100"
-  LoopEndVar:=DefaultLoopEndVarName+'1';
+  LoopEndVar:=DefaultVarNameLoopEnd+'1';
   VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
@@ -443,7 +443,7 @@ begin
   //   for(i=100; i>=$loopend1; i--){ a:=b; }
 
   // "var $loopend1=1"
-  LoopEndVar:=DefaultLoopEndVarName+'1';
+  LoopEndVar:=DefaultVarNameLoopEnd+'1';
   VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
   VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
   AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
@@ -1197,7 +1197,7 @@ begin
   B.AddParam(CreateIdent('b'));
   B.AddParam(CreateIdent('c'));
   AttemptConvert:=B;
-  AssertException('Cannot yet convert 2-dim arrays',EPasToJS,@TryConvert);
+  AssertException('Pascal element not supported: TParamsExpr:TParamsExpr: Cannot convert 2-dim arrays',EPas2JS,@TryConvert);
 end;
 
 Procedure TTestExpressionConverter.TestVariable;

+ 873 - 16
packages/pastojs/tests/tcmodules.pas

@@ -147,6 +147,12 @@ type
     Procedure TestUnitImplRecord;
     Procedure TestRenameJSNameConflict;
 
+    // strings
+    Procedure TestCharConst;
+    Procedure TestStringConst;
+    Procedure TestString_SetLength;
+    // ToDo: TestString: read, write []
+
     Procedure TestEmptyProc;
     Procedure TestAliasTypeRef;
 
@@ -168,16 +174,27 @@ type
     Procedure TestExit;
     Procedure TestBreak;
     Procedure TestContinue;
-    // ToDo: TestString; SetLength,Length,[],char
 
     // ToDo: pass by reference
 
-    // ToDo: enums
+    Procedure TestEnumName;
+    Procedure TestEnumNumber;
+    Procedure TestEnumFunctions;
+    Procedure TestSet;
+    Procedure TestSetOperators;
+    Procedure TestSetFunctions;
+    // ToDo:  str
+    // ToDo: pass set as non const parameter using cloneSet
 
     // statements
     Procedure TestIncDec;
     Procedure TestAssignments;
-    Procedure TestOperators1;
+    Procedure TestArithmeticOperators1;
+    // test integer := double
+    // test integer := integer + double
+    // test pass double to an integer parameter
+    Procedure TestLogicalOperators;
+    Procedure TestBitwiseOperators;
     Procedure TestFunctionInt;
     Procedure TestFunctionString;
     Procedure TestVarRecord;
@@ -196,7 +213,9 @@ type
     Procedure TestCaseOfRange;
 
     // arrays
-    Procedure TestArray;
+    Procedure TestArray_Dynamic;
+    Procedure TestArray_Dynamic_Nil;
+    // ToDo: TestArray_LowHigh
 
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
@@ -207,9 +226,13 @@ type
     Procedure TestClass_AbstractMethod;
     Procedure TestClass_CallInherited_NoParams;
     Procedure TestClass_CallInherited_WithParams;
+    Procedure TestClasS_CallInheritedConstructor;
     Procedure TestClass_ClassVar;
     Procedure TestClass_CallClassMethod;
-    // ToDo: Procedure TestClass_CallInheritedConstructor;
+    Procedure TestClass_Property;
+    Procedure TestClass_Property_ClassMethod;
+    Procedure TestClass_Property_Index;
+    Procedure TestClass_PropertyOfTypeArray;
     // ToDo: overload
     // ToDo: second constructor
     // ToDo: call another constructor within a constructor
@@ -299,7 +322,7 @@ constructor TTestEnginePasResolver.Create;
 begin
   inherited Create;
   StoreSrcColumns:=true;
-  Options:=Options+[proFixCaseOfOverrides];
+  Options:=Options+DefaultPasResolverOptions;
 end;
 
 destructor TTestEnginePasResolver.Destroy;
@@ -1104,7 +1127,7 @@ begin
     ]));
 end;
 
-procedure TTestModule.TestOperators1;
+procedure TTestModule.TestArithmeticOperators1;
 begin
   StartProgram(false);
   Add('var');
@@ -1112,13 +1135,15 @@ begin
   Add('begin');
   Add('  va:=1;');
   Add('  vb:=va+va;');
+  Add('  vb:=va div vb;');
+  Add('  vb:=va mod vb;');
   Add('  vb:=va+va*vb+va div vb;');
   Add('  vc:=-va;');
   Add('  va:=va-vb;');
   Add('  vb:=va;');
   Add('  if va<vb then vc:=va else vc:=vb;');
   ConvertProgram;
-  CheckSource('TestOperators1',
+  CheckSource('TestArithmeticOperators1',
     LinesToStr([ // statements
     'this.vA = 0;',
     'this.vB = 0;',
@@ -1127,7 +1152,9 @@ begin
     LinesToStr([ // this.$main
     'this.vA = 1;',
     'this.vB = this.vA + this.vA;',
-    'this.vB = (this.vA + (this.vA * this.vB)) + (this.vA / this.vB);',
+    'this.vB = Math.floor(this.vA / this.vB);',
+    'this.vB = this.vA % this.vB;',
+    'this.vB = (this.vA + (this.vA * this.vB)) + Math.floor(this.vA / this.vB);',
     'this.vC = -this.vA;',
     'this.vA = this.vA - this.vB;',
     'this.vB = this.vA;',
@@ -1135,6 +1162,66 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestLogicalOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vA,vB,vC:boolean;');
+  Add('begin');
+  Add('  va:=vb and vc;');
+  Add('  va:=vb or vc;');
+  Add('  va:=true and vc;');
+  Add('  va:=(vb and vc) or (va and vb);');
+  Add('  va:=not vb;');
+  ConvertProgram;
+  CheckSource('TestLogicalOperators',
+    LinesToStr([ // statements
+    'this.vA = false;',
+    'this.vB = false;',
+    'this.vC = false;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.vA = this.vB && this.vC;',
+    'this.vA = this.vB || this.vC;',
+    'this.vA = true && this.vC;',
+    'this.vA = (this.vB && this.vC) || (this.vA && this.vB);',
+    'this.vA = !this.vB;'
+    ]));
+end;
+
+procedure TTestModule.TestBitwiseOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vA,vB,vC:longint;');
+  Add('begin');
+  Add('  va:=vb and vc;');
+  Add('  va:=vb or vc;');
+  Add('  va:=vb xor vc;');
+  Add('  va:=vb shl vc;');
+  Add('  va:=vb shr vc;');
+  Add('  va:=3 and vc;');
+  Add('  va:=(vb and vc) or (va and vb);');
+  Add('  va:=not vb;');
+  ConvertProgram;
+  CheckSource('TestBitwiseOperators',
+    LinesToStr([ // statements
+    'this.vA = 0;',
+    'this.vB = 0;',
+    'this.vC = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.vA = this.vB & this.vC;',
+    'this.vA = this.vB | this.vC;',
+    'this.vA = this.vB ^ this.vC;',
+    'this.vA = this.vB << this.vC;',
+    'this.vA = this.vB >>> this.vC;',
+    'this.vA = 3 & this.vC;',
+    'this.vA = (this.vB & this.vC) | (this.vA & this.vB);',
+    'this.vA = ~this.vB;'
+    ]));
+end;
+
 procedure TTestModule.TestPrgProcVar;
 begin
   StartProgram(false);
@@ -1179,10 +1266,10 @@ begin
     LinesToStr([ // statements
     'var $impl = {',
     '};',
+    'this.$impl = $impl;',
     'this.Proc1 = function () {',
     '  var v1 = 0;',
     '};',
-    'this.$impl = $impl;',
     '$impl.v2 = "";'
     ]),
     '' // this.$init
@@ -1476,6 +1563,300 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestEnumName;
+begin
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green, Blue);');
+  Add('var e: TMyEnum;');
+  Add('var f: TMyEnum = Blue;');
+  Add('begin');
+  Add('  e:=green;');
+  ConvertProgram;
+  CheckSource('TestEnumName',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.e = 0;',
+    'this.f = this.TMyEnum.Blue;'
+    ]),
+    LinesToStr([
+    'this.e=this.TMyEnum.Green;'
+    ]));
+end;
+
+procedure TTestModule.TestEnumNumber;
+begin
+  Converter.Options:=Converter.Options+[coEnumNumbers];
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green);');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  f: TMyEnum = Green;');
+  Add('begin');
+  Add('  e:=green;');
+  ConvertProgram;
+  CheckSource('TestEnumNumber',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.f = 1;'
+    ]),
+    LinesToStr([
+    'this.e=1;'
+    ]));
+end;
+
+procedure TTestModule.TestEnumFunctions;
+begin
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green);');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(green);');
+  Add('  i:=ord(e);');
+  Add('  e:=low(tmyenum);');
+  Add('  e:=low(e);');
+  Add('  e:=high(tmyenum);');
+  Add('  e:=high(e);');
+  Add('  e:=pred(green);');
+  Add('  e:=pred(e);');
+  Add('  e:=succ(red);');
+  Add('  e:=succ(e);');
+  Add('  e:=tmyenum(1);');
+  Add('  e:=tmyenum(i);');
+  ConvertProgram;
+  CheckSource('TestEnumNumber',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    'this.i=this.TMyEnum.Red;',
+    'this.i=this.TMyEnum.Green;',
+    'this.i=this.e;',
+    'this.e=this.TMyEnum.Red;',
+    'this.e=this.TMyEnum.Red;',
+    'this.e=this.TMyEnum.Green;',
+    'this.e=this.TMyEnum.Green;',
+    'this.e=this.TMyEnum.Green-1;',
+    'this.e=this.e-1;',
+    'this.e=this.TMyEnum.Red+1;',
+    'this.e=this.e+1;',
+    'this.e=1;',
+    'this.e=this.i;',
+    '']));
+end;
+
+procedure TTestModule.TestSet;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (Red, Green, Blue);');
+  Add('  TColors = set of TColor;');
+  Add('var');
+  Add('  c: TColor;');
+  Add('  s: TColors;');
+  Add('  t: TColors = [];');
+  Add('  u: TColors = [Red];');
+  Add('begin');
+  Add('  s:=[];');
+  Add('  s:=[Green];');
+  Add('  s:=[Green,Blue];');
+  Add('  s:=[Red..Blue];');
+  Add('  s:=[Red,Green..Blue];');
+  Add('  s:=[Red,c];');
+  Add('  s:=t;');
+  ConvertProgram;
+  CheckSource('TestEnumName',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.c = 0;',
+    'this.s = {};',
+    'this.t = {};',
+    'this.u = rtl.createSet(this.TColor.Red);'
+    ]),
+    LinesToStr([
+    'this.s={};',
+    'this.s=rtl.createSet(this.TColor.Green);',
+    'this.s=rtl.createSet(this.TColor.Green,this.TColor.Blue);',
+    'this.s=rtl.createSet(null,this.TColor.Red,this.TColor.Blue);',
+    'this.s=rtl.createSet(this.TColor.Red,null,this.TColor.Green,this.TColor.Blue);',
+    'this.s=rtl.createSet(this.TColor.Red,this.c);',
+    'this.s=rtl.cloneSet(this.t);',
+    '']));
+end;
+
+procedure TTestModule.TestSetOperators;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (Red, Green, Blue);');
+  Add('  TColors = set of tcolor;');
+  Add('var');
+  Add('  vC: TColor;');
+  Add('  vS: TColors;');
+  Add('  vT: TColors;');
+  Add('  vU: TColors;');
+  Add('  B: boolean;');
+  Add('begin');
+  Add('  include(vs,green);');
+  Add('  exclude(vs,vc);');
+  Add('  vs:=vt+vu;');
+  Add('  vs:=vt+[red];');
+  Add('  vs:=[red]+vt;');
+  Add('  vs:=[red]+[green];');
+  Add('  vs:=vt-vu;');
+  Add('  vs:=vt-[red];');
+  Add('  vs:=[red]-vt;');
+  Add('  vs:=[red]-[green];');
+  Add('  vs:=vt*vu;');
+  Add('  vs:=vt*[red];');
+  Add('  vs:=[red]*vt;');
+  Add('  vs:=[red]*[green];');
+  Add('  vs:=vt><vu;');
+  Add('  vs:=vt><[red];');
+  Add('  vs:=[red]><vt;');
+  Add('  vs:=[red]><[green];');
+  Add('  b:=vt=vu;');
+  Add('  b:=vt=[red];');
+  Add('  b:=[red]=vt;');
+  Add('  b:=[red]=[green];');
+  Add('  b:=vt<>vu;');
+  Add('  b:=vt<>[red];');
+  Add('  b:=[red]<>vt;');
+  Add('  b:=[red]<>[green];');
+  Add('  b:=vt<=vu;');
+  Add('  b:=vt<=[red];');
+  Add('  b:=[red]<=vt;');
+  Add('  b:=[red]<=[green];');
+  Add('  b:=vt>=vu;');
+  Add('  b:=vt>=[red];');
+  Add('  b:=[red]>=vt;');
+  Add('  b:=[red]>=[green];');
+  Add('  b:=Red in vt;');
+  Add('  b:=vc in vt;');
+  Add('  b:=Green in [Red..Blue];');
+  Add('  b:=vc in [Red..Blue];');
+  ConvertProgram;
+  CheckSource('TestEnumName',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.vC = 0;',
+    'this.vS = {};',
+    'this.vT = {};',
+    'this.vU = {};',
+    'this.B = false;'
+    ]),
+    LinesToStr([
+    'this.vS[this.TColor.Green] = true;',
+    'delete this.vS[this.vC];',
+    'this.vS = rtl.unionSet(this.vT, this.vU);',
+    'this.vS = rtl.unionSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.vS = rtl.unionSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.vS = rtl.unionSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.vS = rtl.diffSet(this.vT, this.vU);',
+    'this.vS = rtl.diffSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.vS = rtl.diffSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.vS = rtl.diffSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.vS = rtl.intersectSet(this.vT, this.vU);',
+    'this.vS = rtl.intersectSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.vS = rtl.intersectSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.vS = rtl.intersectSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.vS = rtl.symDiffSet(this.vT, this.vU);',
+    'this.vS = rtl.symDiffSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.vS = rtl.symDiffSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.vS = rtl.symDiffSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.B = rtl.eqSet(this.vT, this.vU);',
+    'this.B = rtl.eqSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.B = rtl.eqSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.B = rtl.eqSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.B = rtl.neSet(this.vT, this.vU);',
+    'this.B = rtl.neSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.B = rtl.neSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.B = rtl.neSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.B = rtl.leSet(this.vT, this.vU);',
+    'this.B = rtl.leSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.B = rtl.leSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.B = rtl.leSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.B = rtl.geSet(this.vT, this.vU);',
+    'this.B = rtl.geSet(this.vT, rtl.createSet(this.TColor.Red));',
+    'this.B = rtl.geSet(rtl.createSet(this.TColor.Red), this.vT);',
+    'this.B = rtl.geSet(rtl.createSet(this.TColor.Red), rtl.createSet(this.TColor.Green));',
+    'this.B = this.vT[this.TColor.Red];',
+    'this.B = this.vT[this.vC];',
+    'this.B = rtl.createSet(null, this.TColor.Red, this.TColor.Blue)[this.TColor.Green];',
+    'this.B = rtl.createSet(null, this.TColor.Red, this.TColor.Blue)[this.vC];',
+    '']));
+end;
+
+procedure TTestModule.TestSetFunctions;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TMyEnum = (Red, Green);');
+  Add('  TMyEnums = set of TMyEnum;');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  s: TMyEnums;');
+  Add('begin');
+  Add('  e:=Low(TMyEnums);');
+  Add('  e:=Low(s);');
+  Add('  e:=High(TMyEnums);');
+  Add('  e:=High(s);');
+  ConvertProgram;
+  CheckSource('TestSetFunctions',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.s = {};'
+    ]),
+    LinesToStr([
+    'this.e=this.TMyEnum.Red;',
+    'this.e=this.TMyEnum.Red;',
+    'this.e=this.TMyEnum.Green;',
+    'this.e=this.TMyEnum.Green;',
+    '']));
+end;
+
 procedure TTestModule.TestUnitImplVars;
 begin
   StartUnit(false);
@@ -1566,6 +1947,92 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestCharConst;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  c: char = ''1'';');
+  Add('begin');
+  Add('  c:=#0;');
+  Add('  c:=#1;');
+  Add('  c:=#9;');
+  Add('  c:=#10;');
+  Add('  c:=#13;');
+  Add('  c:=#31;');
+  Add('  c:=#32;');
+  Add('  c:=#$A;');
+  Add('  c:=#$0A;');
+  Add('  c:=#$b;');
+  Add('  c:=#$0b;');
+  Add('  c:=^A;');
+  Add('  c:=''"'';');
+  ConvertProgram;
+  CheckSource('TestCharConst',
+    LinesToStr([
+    'this.c="1";'
+    ]),
+    LinesToStr([
+    'this.c="\x00";',
+    'this.c="\x01";',
+    'this.c="\t";',
+    'this.c="\n";',
+    'this.c="\r";',
+    'this.c="\x1F";',
+    'this.c=" ";',
+    'this.c="\n";',
+    'this.c="\n";',
+    'this.c="\x0B";',
+    'this.c="\x0B";',
+    'this.c="\x01";',
+    'this.c=''"'';'
+    ]));
+end;
+
+procedure TTestModule.TestStringConst;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string = ''abc'';');
+  Add('begin');
+  Add('  s:='''';');
+  Add('  s:=#13#10;');
+  Add('  s:=#9''foo'';');
+  Add('  s:=#$A9;');
+  Add('  s:=''foo''#13''bar'';');
+  Add('  s:=''"'';');
+  Add('  s:=''"''''"'';');
+  ConvertProgram;
+  CheckSource('TestCharConst',
+    LinesToStr([
+    'this.s="abc";'
+    ]),
+    LinesToStr([
+    'this.s="";',
+    'this.s="\r\n";',
+    'this.s="\tfoo";',
+    'this.s="©";',
+    'this.s="foo\rbar";',
+    'this.s=''"'';',
+    'this.s=''"\''"'';'
+    ]));
+end;
+
+procedure TTestModule.TestString_SetLength;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  SetLength(s,3);');
+  ConvertProgram;
+  CheckSource('TestString_SetLength',
+    LinesToStr([ // statements
+    'this.s = "";'
+    ]),
+    LinesToStr([ // this.$main
+    'rtl.setStringLength(this.s,3);'
+    ]));
+end;
+
 procedure TTestModule.TestProcTwoArgs;
 begin
   StartProgram(false);
@@ -1901,7 +2368,7 @@ begin
     LinesToStr([ // this.$main
     'try {',
     '  this.i = 0;',
-    '  this.i = 2 / this.i;',
+    '  this.i = Math.floor(2 / this.i);',
     '} finally {',
     '  this.i = 3;',
     '};'
@@ -2495,6 +2962,103 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClasS_CallInheritedConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create; virtual;');
+  Add('    constructor CreateWithB(b: boolean);');
+  Add('  end;');
+  Add('  TA = class');
+  Add('    constructor Create; override;');
+  Add('    constructor CreateWithC(c: char);');
+  Add('    procedure DoIt;');
+  Add('    class function DoSome: TObject;');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('end;');
+  Add('constructor tobject.createwithb(b: boolean);');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('  create; // normal call');
+  Add('end;');
+  Add('constructor ta.create;');
+  Add('begin');
+  Add('  inherited; // normal call TObject.Create');
+  Add('  inherited create; // normal call TObject.Create');
+  Add('  inherited createwithb(false); // normal call TObject.CreateWithB');
+  Add('end;');
+  Add('constructor ta.createwithc(c: char);');
+  Add('begin');
+  Add('  inherited create; // call TObject.Create');
+  Add('  inherited createwithb(true); // call TObject.CreateWithB');
+  Add('  doit;');
+  Add('  doit();');
+  Add('  dosome;');
+  Add('end;');
+  Add('procedure ta.doit;');
+  Add('begin');
+  Add('  create; // normal call');
+  Add('  createwithb(false); // normal call');
+  Add('  createwithc(''c''); // normal call');
+  Add('end;');
+  Add('class function ta.dosome: TObject;');
+  Add('begin');
+  Add('  Result:=create; // constructor');
+  Add('  Result:=createwithb(true); // constructor');
+  Add('  Result:=createwithc(''c''); // constructor');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInheritedConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass(this,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.CreateWithB = function (b) {',
+    '    this.Create();',
+    '  };',
+    '});',
+    'rtl.createClass(this, "TA", this.TObject, function () {',
+    '  this.$init = function () {',
+    '    pas.program.TObject.$init.call(this);',
+    '  };',
+    '  this.Create = function () {',
+    '    pas.program.TObject.Create.apply(this, arguments);',
+    '    pas.program.TObject.Create.call(this);',
+    '    pas.program.TObject.CreateWithB.call(this, false);',
+    '  };',
+    '  this.CreateWithC = function (c) {',
+    '    pas.program.TObject.Create.call(this);',
+    '    pas.program.TObject.CreateWithB.call(this, true);',
+    '    this.DoIt();',
+    '    this.DoIt();',
+    '    this.$class.DoSome();',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Create();',
+    '    this.CreateWithB(false);',
+    '    this.CreateWithC("c");',
+    '  };',
+    '  this.DoSome = function () {',
+    '    var Result = null;',
+    '    Result = this.$create("Create");',
+    '    Result = this.$create("CreateWithB", [true]);',
+    '    Result = this.$create("CreateWithC", ["c"]);',
+    '    return Result;',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
 procedure TTestModule.TestClass_ClassVar;
 begin
   StartProgram(false);
@@ -2643,7 +3207,277 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestArray;
+procedure TTestModule.TestClass_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    Fx: longint;');
+  Add('    Fy: longint;');
+  Add('    function GetInt: longint;');
+  Add('    procedure SetInt(Value: longint);');
+  Add('    procedure DoIt;');
+  Add('    property IntA: longint read Fx write Fy;');
+  Add('    property IntB: longint read GetInt write SetInt;');
+  Add('  end;');
+  Add('function tobject.getint: longint;');
+  Add('begin');
+  Add('  result:=fx;');
+  Add('end;');
+  Add('procedure tobject.setint(value: longint);');
+  Add('begin');
+  Add('  if value=fy then exit;');
+  Add('  fy:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  IntA:=IntA+1;');
+  Add('  Self.IntA:=Self.IntA+1;');
+  Add('  IntB:=IntB+1;');
+  Add('  Self.IntB:=Self.IntB+1;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.inta:=obj.inta+1;');
+  Add('  if obj.intb=2 then;');
+  Add('  obj.intb:=obj.intb+2;');
+  Add('  obj.setint(obj.inta);');
+  ConvertProgram;
+  CheckSource('TestClass_Property',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Fx = 0;',
+    '    this.Fy = 0;',
+    '  };',
+    '  this.GetInt = function () {',
+    '    var Result = 0;',
+    '    Result = this.Fx;',
+    '    return Result;',
+    '  };',
+    '  this.SetInt = function (Value) {',
+    '    if (Value == this.Fy) return;',
+    '    this.Fy = Value;',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Fy = this.Fx + 1;',
+    '    this.Fy = this.Fx + 1;',
+    '    this.SetInt(this.GetInt() + 1);',
+    '    this.SetInt(this.GetInt() + 1);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Obj.Fy = this.Obj.Fx + 1;',
+    'if (this.Obj.GetInt() == 2) {',
+    '};',
+    'this.Obj.SetInt(this.Obj.GetInt() + 2);',
+    'this.Obj.SetInt(this.Obj.Fx);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Property_ClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var Fx: longint;');
+  Add('    class var Fy: longint;');
+  Add('    class function GetInt: longint;');
+  Add('    class procedure SetInt(Value: longint);');
+  Add('    class procedure DoIt;');
+  Add('    class property IntA: longint read Fx write Fy;');
+  Add('    class property IntB: longint read GetInt write SetInt;');
+  Add('  end;');
+  Add('class function tobject.getint: longint;');
+  Add('begin');
+  Add('  result:=fx;');
+  Add('end;');
+  Add('class procedure tobject.setint(value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('class procedure tobject.doit;');
+  Add('begin');
+  Add('  IntA:=IntA+1;');
+  Add('  Self.IntA:=Self.IntA+1;');
+  Add('  IntB:=IntB+1;');
+  Add('  Self.IntB:=Self.IntB+1;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  tobject.inta:=tobject.inta+1;');
+  Add('  if tobject.intb=2 then;');
+  Add('  tobject.intb:=tobject.intb+2;');
+  Add('  tobject.setint(tobject.inta);');
+  Add('  obj.inta:=obj.inta+1;');
+  Add('  if obj.intb=2 then;');
+  Add('  obj.intb:=obj.intb+2;');
+  Add('  obj.setint(obj.inta);');
+  ConvertProgram;
+  CheckSource('TestClass_Property_ClassMethod',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.Fx = 0;',
+    '  this.Fy = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.GetInt = function () {',
+    '    var Result = 0;',
+    '    Result = this.Fx;',
+    '    return Result;',
+    '  };',
+    '  this.SetInt = function (Value) {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Fy = this.Fx + 1;',
+    '    this.Fy = this.Fx + 1;',
+    '    this.SetInt(this.GetInt() + 1);',
+    '    this.SetInt(this.GetInt() + 1);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.TObject.Fy = this.TObject.Fx + 1;',
+    'if (this.TObject.GetInt() == 2) {',
+    '};',
+    'this.TObject.SetInt(this.TObject.GetInt() + 2);',
+    'this.TObject.SetInt(this.TObject.Fx);',
+    'this.Obj.$class.Fy = this.Obj.Fx + 1;',
+    'if (this.Obj.$class.GetInt() == 2) {',
+    '};',
+    'this.Obj.$class.SetInt(this.Obj.$class.GetInt() + 2);',
+    'this.Obj.$class.SetInt(this.Obj.Fx);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Property_Index;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FItems: array of longint;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index: longint; Value: longint);');
+  Add('    procedure DoIt;');
+  Add('    property Items[Index: longint]: longint read getitems write setitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): longint;');
+  Add('begin');
+  Add('  Result:=fitems[index];');
+  Add('end;');
+  Add('procedure tobject.setitems(index: longint; value: longint);');
+  Add('begin');
+  Add('  fitems[index]:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  items[1]:=2;');
+  Add('  items[3]:=items[4];');
+  Add('  self.items[5]:=self.items[6];');
+  Add('  items[items[7]]:=items[items[8]];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.Items[11]:=obj.Items[12];');
+  ConvertProgram;
+  CheckSource('TestClass_Property_Index',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    Result = this.FItems[Index];',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '    this.FItems[Index] = Value;',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.SetItems(1, 2);',
+    '    this.SetItems(3,this.GetItems(4));',
+    '    this.SetItems(5,this.GetItems(6));',
+    '    this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Obj.SetItems(11,this.Obj.GetItems(12));'
+    ]));
+end;
+
+procedure TTestModule.TestClass_PropertyOfTypeArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems: tarray;');
+  Add('    procedure SetItems(Value: tarray);');
+  Add('    property Items: tarray read getitems write setitems;');
+  Add('  end;');
+  Add('function tobject.getitems: tarray;');
+  Add('begin');
+  Add('  Result:=fitems;');
+  Add('end;');
+  Add('procedure tobject.setitems(value: tarray);');
+  Add('begin');
+  Add('  fitems:=value;');
+  Add('  fitems:=nil;');
+  Add('  Items:=nil;');
+  Add('  Items:=Items;');
+  Add('  Items[1]:=2;');
+  Add('  fitems[3]:=Items[4];');
+  Add('  Items[5]:=Items[6];');
+  Add('  Self.Items[7]:=8;');
+  Add('  Self.Items[9]:=Self.Items[10];');
+  Add('  Items[Items[11]]:=Items[Items[12]];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.items:=nil;');
+  Add('  obj.items:=obj.items;');
+  Add('  obj.items[11]:=obj.items[12];');
+  ConvertProgram;
+  CheckSource('TestClass_PropertyOfTypeArray',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.GetItems = function () {',
+    '    var Result = [];',
+    '    Result = this.FItems;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Value) {',
+    '    this.FItems = Value;',
+    '    this.FItems = null;',
+    '    this.SetItems(null);',
+    '    this.SetItems(this.GetItems());',
+    '    this.GetItems()[1] = 2;',
+    '    this.FItems[3] = this.GetItems()[4];',
+    '    this.GetItems()[5] = this.GetItems()[6];',
+    '    this.GetItems()[7] = 8;',
+    '    this.GetItems()[9] = this.GetItems()[10];',
+    '    this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Obj.SetItems(null);',
+    'this.Obj.SetItems(this.Obj.GetItems());',
+    'this.Obj.GetItems()[11] = this.Obj.GetItems()[12];'
+    ]));
+end;
+
+procedure TTestModule.TestArray_Dynamic;
 begin
   StartProgram(false);
   Add('type');
@@ -2655,14 +3489,37 @@ begin
   Add('  arr[0]:=4;');
   Add('  arr[1]:=length(arr)+arr[0];');
   ConvertProgram;
-  CheckSource('TestArray',
+  CheckSource('TestArray_Dynamic',
+    LinesToStr([ // statements
+    'this.Arr = [];'
+    ]),
+    LinesToStr([ // this.$main
+    'this.Arr = rtl.setArrayLength(this.Arr,3,0);',
+    'this.Arr[0] = 4;',
+    'this.Arr[1] = rtl.length(this.Arr)+this.Arr[0];'
+    ]));
+end;
+
+procedure TTestModule.TestArray_Dynamic_Nil;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('var');
+  Add('  Arr: TArrayInt;');
+  Add('begin');
+  Add('  arr:=nil;');
+  Add('  if arr=nil then;');
+  Add('  if nil=arr then;');
+  ConvertProgram;
+  CheckSource('TestArray_Dynamic',
     LinesToStr([ // statements
     'this.Arr = [];'
     ]),
     LinesToStr([ // this.$main
-    'rtl.setArrayLength(this.Arr,3,0);',
-    'this.Arr[0]=4;',
-    'this.Arr[1]=rtl.length(this.Arr)+this.Arr[0];'
+    'this.Arr = null;',
+    'if (this.Arr == null) {};',
+    'if (null == this.Arr) {};'
     ]));
 end;
 

Some files were not shown because too many files changed in this diff