|
@@ -14,7 +14,8 @@
|
|
|
**********************************************************************
|
|
|
|
|
|
Examples:
|
|
|
- ./testpas2js --suite=TTestModuleConverter.TestEmptyProgram
|
|
|
+ ./testpas2js --suite=TTestModule.TestEmptyProgram
|
|
|
+ ./testpas2js --suite=TTestModule.TestEmptyUnit
|
|
|
}
|
|
|
unit tcmodules;
|
|
|
|
|
@@ -92,8 +93,9 @@ type
|
|
|
procedure TearDown; override;
|
|
|
Procedure Add(Line: string);
|
|
|
Procedure StartParsing;
|
|
|
- Procedure ParseModule;
|
|
|
+ procedure ParseModule;
|
|
|
procedure ParseProgram;
|
|
|
+ procedure ParseUnit;
|
|
|
protected
|
|
|
function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
|
|
|
function AddModule(aFilename: string): TTestEnginePasResolver;
|
|
@@ -102,7 +104,10 @@ type
|
|
|
ImplementationSrc: string): TTestEnginePasResolver;
|
|
|
procedure AddSystemUnit;
|
|
|
procedure StartProgram(NeedSystemUnit: boolean);
|
|
|
+ procedure StartUnit(NeedSystemUnit: boolean);
|
|
|
+ Procedure ConvertModule;
|
|
|
Procedure ConvertProgram;
|
|
|
+ Procedure ConvertUnit;
|
|
|
procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
|
|
|
function GetDottedIdentifier(El: TJSElement): string;
|
|
|
procedure CheckSource(Msg,Statements, InitStatements: string);
|
|
@@ -128,10 +133,31 @@ type
|
|
|
property Scanner: TPascalScanner read FScanner;
|
|
|
property Parser: TTestPasParser read FParser;
|
|
|
Published
|
|
|
+ // modules
|
|
|
Procedure TestEmptyProgram;
|
|
|
+ Procedure TestEmptyUnit;
|
|
|
+
|
|
|
+ // vars/const
|
|
|
Procedure TestVarInt;
|
|
|
+ Procedure TestVarBaseTypes;
|
|
|
+ Procedure TestConstBaseTypes;
|
|
|
+ Procedure TestUnitImplVars;
|
|
|
+ Procedure TestUnitImplConsts;
|
|
|
+ Procedure TestUnitImplRecord;
|
|
|
+
|
|
|
Procedure TestEmptyProc;
|
|
|
+ Procedure TestAliasTypeRef;
|
|
|
+
|
|
|
+ // functions
|
|
|
+ Procedure TestPrgProcVar;
|
|
|
Procedure TestProcTwoArgs;
|
|
|
+ Procedure TestUnitProcVar;
|
|
|
+
|
|
|
+ // ToDo: enums
|
|
|
+
|
|
|
+ // statements
|
|
|
+ Procedure TestIncDec;
|
|
|
+ Procedure TestAssignments;
|
|
|
Procedure TestFunctionInt;
|
|
|
Procedure TestFunctionString;
|
|
|
Procedure TestVarRecord;
|
|
@@ -140,6 +166,11 @@ type
|
|
|
Procedure TestRepeatUntil;
|
|
|
Procedure TestAsmBlock;
|
|
|
Procedure TestTryFinally;
|
|
|
+ Procedure TestCaseOf;
|
|
|
+ Procedure TestCaseOf_UseSwitch;
|
|
|
+ Procedure TestCaseOfNoElse;
|
|
|
+ Procedure TestCaseOfNoElse_UseSwitch;
|
|
|
+ Procedure TestCaseOfRange;
|
|
|
end;
|
|
|
|
|
|
function LinesToStr(Args: array of const): string;
|
|
@@ -365,22 +396,15 @@ begin
|
|
|
end;
|
|
|
|
|
|
procedure TTestModule.ParseModule;
|
|
|
-begin
|
|
|
- StartParsing;
|
|
|
- Parser.ParseMain(FModule);
|
|
|
- AssertNotNull('Module resulted in Module',FModule);
|
|
|
- AssertEquals('modulename',ChangeFileExt(FFileName,''),Module.Name);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TTestModule.ParseProgram;
|
|
|
begin
|
|
|
FFirstPasStatement:=nil;
|
|
|
try
|
|
|
- ParseModule;
|
|
|
+ StartParsing;
|
|
|
+ Parser.ParseMain(FModule);
|
|
|
except
|
|
|
on E: EParserError do
|
|
|
begin
|
|
|
- writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message
|
|
|
+ writeln('ERROR: TTestModule.ParseModule Parser: '+E.ClassName+':'+E.Message
|
|
|
+' File='+Scanner.CurFilename
|
|
|
+' LineNo='+IntToStr(Scanner.CurRow)
|
|
|
+' Col='+IntToStr(Scanner.CurColumn)
|
|
@@ -390,7 +414,7 @@ begin
|
|
|
end;
|
|
|
on E: EPasResolve do
|
|
|
begin
|
|
|
- writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
|
|
|
+ writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message
|
|
|
+' File='+Scanner.CurFilename
|
|
|
+' LineNo='+IntToStr(Scanner.CurRow)
|
|
|
+' Col='+IntToStr(Scanner.CurColumn)
|
|
@@ -400,11 +424,18 @@ begin
|
|
|
end;
|
|
|
on E: Exception do
|
|
|
begin
|
|
|
- writeln('ERROR: TTestModule.ParseProgram Exception: '+E.ClassName+':'+E.Message);
|
|
|
+ writeln('ERROR: TTestModule.ParseModule Exception: '+E.ClassName+':'+E.Message);
|
|
|
raise E;
|
|
|
end;
|
|
|
end;
|
|
|
+ AssertNotNull('Module resulted in Module',FModule);
|
|
|
+ AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
|
|
|
TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ParseProgram;
|
|
|
+begin
|
|
|
+ ParseModule;
|
|
|
AssertEquals('Has program',TPasProgram,Module.ClassType);
|
|
|
FPasProgram:=TPasProgram(Module);
|
|
|
AssertNotNull('Has program section',PasProgram.ProgramSection);
|
|
@@ -414,6 +445,18 @@ begin
|
|
|
FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
|
|
|
end;
|
|
|
|
|
|
+procedure TTestModule.ParseUnit;
|
|
|
+begin
|
|
|
+ ParseModule;
|
|
|
+ AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
|
|
|
+ AssertNotNull('Has interface section',Module.InterfaceSection);
|
|
|
+ AssertNotNull('Has implementation section',Module.ImplementationSection);
|
|
|
+ if (Module.InitializationSection<>nil)
|
|
|
+ and (Module.InitializationSection.Elements.Count>0)
|
|
|
+ and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
|
|
|
+ FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
|
|
|
+end;
|
|
|
+
|
|
|
function TTestModule.FindModuleWithFilename(aFilename: string
|
|
|
): TTestEnginePasResolver;
|
|
|
var
|
|
@@ -488,20 +531,29 @@ begin
|
|
|
Add('');
|
|
|
end;
|
|
|
|
|
|
-procedure TTestModule.ConvertProgram;
|
|
|
+procedure TTestModule.StartUnit(NeedSystemUnit: boolean);
|
|
|
+begin
|
|
|
+ if NeedSystemUnit then
|
|
|
+ AddSystemUnit
|
|
|
+ else
|
|
|
+ Parser.ImplicitUses.Clear;
|
|
|
+ Add('unit Test1;');
|
|
|
+ Add('');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ConvertModule;
|
|
|
var
|
|
|
ModuleNameExpr: TJSLiteral;
|
|
|
FunDecl, InitFunction: TJSFunctionDeclarationStatement;
|
|
|
FunDef: TJSFuncDef;
|
|
|
InitAssign: TJSSimpleAssignStatement;
|
|
|
FunBody: TJSFunctionBody;
|
|
|
+ InitName: String;
|
|
|
begin
|
|
|
- FJSSource:=TStringList.Create;
|
|
|
- Add('end.');
|
|
|
- ParseProgram;
|
|
|
FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
|
|
|
+ FJSSource:=TStringList.Create;
|
|
|
FJSSource.Text:=JSToStr(JSModule);
|
|
|
- writeln('TTestModule.ConvertProgram JS:');
|
|
|
+ writeln('TTestModule.ConvertModule JS:');
|
|
|
write(FJSSource.Text);
|
|
|
|
|
|
// rtl.module(...
|
|
@@ -519,7 +571,10 @@ begin
|
|
|
AssertNotNull('module name param',JSModuleCallArgs.Elements.Elements[0].Expr);
|
|
|
ModuleNameExpr:=JSModuleCallArgs.Elements.Elements[0].Expr as TJSLiteral;
|
|
|
AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
|
|
|
- AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString));
|
|
|
+ if Module is TPasProgram then
|
|
|
+ AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
|
|
|
+ else
|
|
|
+ AssertEquals('module name',lowercase(Module.Name),String(ModuleNameExpr.Value.AsString));
|
|
|
|
|
|
// main uses section
|
|
|
AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr);
|
|
@@ -538,12 +593,39 @@ begin
|
|
|
FJSModuleSrc:=FunBody.A as TJSSourceElements;
|
|
|
|
|
|
// init this.$main - the last statement
|
|
|
- AssertEquals('this.$main function 1',true,JSModuleSrc.Statements.Count>0);
|
|
|
- InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
|
|
|
- CheckDottedIdentifier('init function',InitAssign.LHS,'this.$main');
|
|
|
+ if Module is TPasProgram then
|
|
|
+ begin
|
|
|
+ InitName:='$main';
|
|
|
+ AssertEquals('this.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ InitName:='$init';
|
|
|
+ FJSInitBody:=nil;
|
|
|
+ if JSModuleSrc.Statements.Count>0 then
|
|
|
+ begin
|
|
|
+ InitAssign:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node as TJSSimpleAssignStatement;
|
|
|
+ if GetDottedIdentifier(InitAssign.LHS)='this.'+InitName then
|
|
|
+ begin
|
|
|
+ InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
|
|
|
+ FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
|
|
|
+ end
|
|
|
+ else if Module is TPasProgram then
|
|
|
+ CheckDottedIdentifier('init function',InitAssign.LHS,'this.'+InitName);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.ConvertProgram;
|
|
|
+begin
|
|
|
+ Add('end.');
|
|
|
+ ParseProgram;
|
|
|
+ ConvertModule;
|
|
|
+end;
|
|
|
|
|
|
- InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
|
|
|
- FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
|
|
|
+procedure TTestModule.ConvertUnit;
|
|
|
+begin
|
|
|
+ Add('end.');
|
|
|
+ ParseUnit;
|
|
|
+ ConvertModule;
|
|
|
end;
|
|
|
|
|
|
procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
|
|
@@ -556,7 +638,7 @@ begin
|
|
|
else
|
|
|
begin
|
|
|
AssertNotNull(Msg,El);
|
|
|
- AssertEquals(Msg,DottedName,GetDottedIdentifier(EL));
|
|
|
+ AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
|
|
|
end;
|
|
|
end;
|
|
|
|
|
@@ -574,13 +656,20 @@ end;
|
|
|
|
|
|
procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
|
|
|
var
|
|
|
- ActualSrc, ExpectedSrc: String;
|
|
|
+ ActualSrc, ExpectedSrc, InitName: String;
|
|
|
begin
|
|
|
ActualSrc:=JSToStr(JSModuleSrc);
|
|
|
- ExpectedSrc:=Statements+LineEnding
|
|
|
- +'this.$main = function () {'+LineEnding
|
|
|
- +InitStatements
|
|
|
- +'};'+LineEnding;
|
|
|
+ ExpectedSrc:=Statements;
|
|
|
+ if Module is TPasProgram then
|
|
|
+ InitName:='$main'
|
|
|
+ else
|
|
|
+ InitName:='$init';
|
|
|
+ if (Module is TPasProgram) or (InitStatements<>'') then
|
|
|
+ ExpectedSrc:=ExpectedSrc+LineEnding
|
|
|
+ +'this.'+InitName+' = function () {'+LineEnding
|
|
|
+ +InitStatements
|
|
|
+ +'};'+LineEnding;
|
|
|
+ //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
|
|
|
CheckDiff(Msg,ExpectedSrc,ActualSrc);
|
|
|
end;
|
|
|
|
|
@@ -696,6 +785,14 @@ begin
|
|
|
CheckSource('Empty program','','');
|
|
|
end;
|
|
|
|
|
|
+procedure TTestModule.TestEmptyUnit;
|
|
|
+begin
|
|
|
+ StartUnit(false);
|
|
|
+ Add('interface');
|
|
|
+ Add('implementation');
|
|
|
+ ConvertUnit;
|
|
|
+end;
|
|
|
+
|
|
|
procedure TTestModule.TestVarInt;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
@@ -705,6 +802,70 @@ begin
|
|
|
CheckSource('TestVarInt','this.i=0;','');
|
|
|
end;
|
|
|
|
|
|
+procedure TTestModule.TestVarBaseTypes;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var');
|
|
|
+ Add(' i: longint;');
|
|
|
+ Add(' s: string;');
|
|
|
+ Add(' c: char;');
|
|
|
+ Add(' b: boolean;');
|
|
|
+ Add(' d: double;');
|
|
|
+ Add(' i2: longint = 3;');
|
|
|
+ Add(' s2: string = ''foo'';');
|
|
|
+ Add(' c2: char = ''4'';');
|
|
|
+ Add(' b2: boolean = true;');
|
|
|
+ Add(' d2: double = 5.6;');
|
|
|
+ Add(' i3: longint = $707;');
|
|
|
+ Add(' i4: int64 = 4503599627370495;');
|
|
|
+ Add(' i5: int64 = -4503599627370496;');
|
|
|
+ Add(' i6: int64 = $fffffffffffff;');
|
|
|
+ Add(' i7: int64 = -$10000000000000;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarBaseTypes',
|
|
|
+ LinesToStr([
|
|
|
+ 'this.i=0;',
|
|
|
+ 'this.s="";',
|
|
|
+ 'this.c="";',
|
|
|
+ 'this.b=false;',
|
|
|
+ 'this.d=0;',
|
|
|
+ 'this.i2=3;',
|
|
|
+ 'this.s2="foo";',
|
|
|
+ 'this.c2="4";',
|
|
|
+ 'this.b2=true;',
|
|
|
+ 'this.d2=5.6;',
|
|
|
+ 'this.i3=0x707;',
|
|
|
+ 'this.i4= 4503599627370495;',
|
|
|
+ 'this.i5= -4503599627370496;',
|
|
|
+ 'this.i6= 0xfffffffffffff;',
|
|
|
+ 'this.i7=-0x10000000000000;'
|
|
|
+ ]),
|
|
|
+ '');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestConstBaseTypes;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('const');
|
|
|
+ Add(' i: longint = 3;');
|
|
|
+ Add(' s: string = ''foo'';');
|
|
|
+ Add(' c: char = ''4'';');
|
|
|
+ Add(' b: boolean = true;');
|
|
|
+ Add(' d: double = 5.6;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarBaseTypes',
|
|
|
+ LinesToStr([
|
|
|
+ 'this.i=3;',
|
|
|
+ 'this.s="foo";',
|
|
|
+ 'this.c="4";',
|
|
|
+ 'this.b=true;',
|
|
|
+ 'this.d=5.6;'
|
|
|
+ ]),
|
|
|
+ '');
|
|
|
+end;
|
|
|
+
|
|
|
procedure TTestModule.TestEmptyProc;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
@@ -723,6 +884,199 @@ begin
|
|
|
]));
|
|
|
end;
|
|
|
|
|
|
+procedure TTestModule.TestAliasTypeRef;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('type');
|
|
|
+ Add(' a=longint;');
|
|
|
+ Add(' b=a;');
|
|
|
+ Add('var');
|
|
|
+ Add(' c: a;');
|
|
|
+ Add(' d: b;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestAliasTypeRef',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.c = 0;',
|
|
|
+ 'this.d = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestIncDec;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var');
|
|
|
+ Add(' i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' inc(i);');
|
|
|
+ Add(' inc(i,2);');
|
|
|
+ Add(' dec(i);');
|
|
|
+ Add(' dec(i,3);');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestIncDec',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'this.i+=1;',
|
|
|
+ 'this.i+=2;',
|
|
|
+ 'this.i-=1;',
|
|
|
+ 'this.i-=3;'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestAssignments;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Parser.Options:=Parser.Options+[po_cassignments];
|
|
|
+ Add('var');
|
|
|
+ Add(' i:longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' i:=3;');
|
|
|
+ Add(' i+=4;');
|
|
|
+ Add(' i-=5;');
|
|
|
+ Add(' i*=6;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestAssignments',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'this.i=3;',
|
|
|
+ 'this.i+=4;',
|
|
|
+ 'this.i-=5;',
|
|
|
+ 'this.i*=6;'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestPrgProcVar;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('procedure Proc1;');
|
|
|
+ Add('type');
|
|
|
+ Add(' t1=longint;');
|
|
|
+ Add('var');
|
|
|
+ Add(' v1:t1;');
|
|
|
+ Add('begin');
|
|
|
+ Add('end;');
|
|
|
+ Add('begin');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestPrgProcVar',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.proc1 = function () {',
|
|
|
+ ' var v1=0;',
|
|
|
+ '};'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ ''
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestUnitProcVar;
|
|
|
+begin
|
|
|
+ StartUnit(false);
|
|
|
+ Add('interface');
|
|
|
+ Add('');
|
|
|
+ Add('type t1=string; // unit scope');
|
|
|
+ Add('procedure Proc1;');
|
|
|
+ Add('');
|
|
|
+ Add('implementation');
|
|
|
+ Add('');
|
|
|
+ Add('procedure Proc1;');
|
|
|
+ Add('type t1=longint; // local proc scope');
|
|
|
+ Add('var v1:t1; // using local t1');
|
|
|
+ Add('begin');
|
|
|
+ Add('end;');
|
|
|
+ Add('var v2:t1; // using interface t1');
|
|
|
+ ConvertUnit;
|
|
|
+ CheckSource('TestUnitProcVar',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'var $impl = {',
|
|
|
+ '};',
|
|
|
+ 'this.proc1 = function () {',
|
|
|
+ ' var v1 = 0;',
|
|
|
+ '};',
|
|
|
+ 'this.$impl = $impl;',
|
|
|
+ '$impl.v2 = "";'
|
|
|
+ ]),
|
|
|
+ '' // this.$init
|
|
|
+ );
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestUnitImplVars;
|
|
|
+begin
|
|
|
+ StartUnit(false);
|
|
|
+ Add('interface');
|
|
|
+ Add('implementation');
|
|
|
+ Add('var');
|
|
|
+ Add(' v1:longint;');
|
|
|
+ Add(' v2:longint = 3;');
|
|
|
+ Add(' v3:string = ''abc'';');
|
|
|
+ ConvertUnit;
|
|
|
+ CheckSource('TestUnitImplVar',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ ' var $impl = {',
|
|
|
+ '};',
|
|
|
+ 'this.$impl = $impl;',
|
|
|
+ '$impl.v1 = 0;',
|
|
|
+ '$impl.v2 = 3;',
|
|
|
+ '$impl.v3 = "abc";'
|
|
|
+ ]),
|
|
|
+ '');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestUnitImplConsts;
|
|
|
+begin
|
|
|
+ StartUnit(false);
|
|
|
+ Add('interface');
|
|
|
+ Add('implementation');
|
|
|
+ Add('const');
|
|
|
+ Add(' v1 = 3;');
|
|
|
+ Add(' v2:longint = 4;');
|
|
|
+ Add(' v3:string = ''abc'';');
|
|
|
+ ConvertUnit;
|
|
|
+ CheckSource('TestUnitImplVar',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'var $impl = {',
|
|
|
+ '};',
|
|
|
+ 'this.$impl = $impl;',
|
|
|
+ '$impl.v1 = 3;',
|
|
|
+ '$impl.v2 = 4;',
|
|
|
+ '$impl.v3 = "abc";'
|
|
|
+ ]),
|
|
|
+ '');
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestUnitImplRecord;
|
|
|
+begin
|
|
|
+ StartUnit(false);
|
|
|
+ Add('interface');
|
|
|
+ Add('implementation');
|
|
|
+ Add('type');
|
|
|
+ Add(' TMyRecord = record');
|
|
|
+ Add(' i: longint;');
|
|
|
+ Add(' end;');
|
|
|
+ Add('var r: TMyRecord;');
|
|
|
+ Add('initialization');
|
|
|
+ Add(' r.i:=3;');
|
|
|
+ ConvertUnit;
|
|
|
+ CheckSource('TestUnitImplVar',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'var $impl = {',
|
|
|
+ '};',
|
|
|
+ 'this.$impl = $impl;',
|
|
|
+ '$impl.tmyrecord = function () {',
|
|
|
+ ' this.i = 0;',
|
|
|
+ '};',
|
|
|
+ '$impl.r = new $impl.tmyrecord();'
|
|
|
+ ]),
|
|
|
+ '$impl.r.i = 3;'
|
|
|
+ );
|
|
|
+end;
|
|
|
+
|
|
|
procedure TTestModule.TestProcTwoArgs;
|
|
|
begin
|
|
|
StartProgram(false);
|
|
@@ -799,7 +1153,7 @@ begin
|
|
|
CheckSource('TestVarRecord',
|
|
|
LinesToStr([ // statements
|
|
|
'this.treca = function () {',
|
|
|
- ' b = 0;',
|
|
|
+ ' this.b = 0;',
|
|
|
'};',
|
|
|
'this.r = new this.treca();'
|
|
|
]),
|
|
@@ -944,6 +1298,141 @@ begin
|
|
|
Add(' i:=3');
|
|
|
Add(' end;');
|
|
|
ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'try {',
|
|
|
+ ' this.i = 0;',
|
|
|
+ ' this.i = (2 / this.i);',
|
|
|
+ '} finally {',
|
|
|
+ ' this.i = 3;',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestCaseOf;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' case i of');
|
|
|
+ Add(' 1: ;');
|
|
|
+ Add(' 2: i:=3;');
|
|
|
+ Add(' else');
|
|
|
+ Add(' i:=4');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'var $tmp1 = this.i;',
|
|
|
+ 'if (($tmp1 == 1)) {} else if (($tmp1 == 2)) this.i = 3 else {',
|
|
|
+ ' this.i = 4;',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestCaseOf_UseSwitch;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Converter.UseSwitchStatement:=true;
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' case i of');
|
|
|
+ Add(' 1: ;');
|
|
|
+ Add(' 2: i:=3;');
|
|
|
+ Add(' else');
|
|
|
+ Add(' i:=4');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'switch (this.i) {',
|
|
|
+ 'case 1:',
|
|
|
+ ' break;',
|
|
|
+ 'case 2:',
|
|
|
+ ' this.i = 3;',
|
|
|
+ ' break;',
|
|
|
+ 'default:',
|
|
|
+ ' this.i = 4;',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestCaseOfNoElse;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' case i of');
|
|
|
+ Add(' 1: begin i:=2; i:=3; end;');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'var $tmp1 = this.i;',
|
|
|
+ 'if (($tmp1 == 1)) {',
|
|
|
+ ' this.i = 2;',
|
|
|
+ ' this.i = 3;',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestCaseOfNoElse_UseSwitch;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Converter.UseSwitchStatement:=true;
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' case i of');
|
|
|
+ Add(' 1: begin i:=2; i:=3; end;');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'switch (this.i) {',
|
|
|
+ 'case 1:',
|
|
|
+ ' this.i = 2;',
|
|
|
+ ' this.i = 3;',
|
|
|
+ ' break;',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TTestModule.TestCaseOfRange;
|
|
|
+begin
|
|
|
+ StartProgram(false);
|
|
|
+ Add('var i: longint;');
|
|
|
+ Add('begin');
|
|
|
+ Add(' case i of');
|
|
|
+ Add(' 1..3: i:=14;');
|
|
|
+ Add(' 4,5: i:=16;');
|
|
|
+ Add(' 6..7,9..10: ;');
|
|
|
+ Add(' else ;');
|
|
|
+ Add(' end;');
|
|
|
+ ConvertProgram;
|
|
|
+ CheckSource('TestVarRecord',
|
|
|
+ LinesToStr([ // statements
|
|
|
+ 'this.i = 0;'
|
|
|
+ ]),
|
|
|
+ LinesToStr([ // this.$main
|
|
|
+ 'var $tmp1 = this.i;',
|
|
|
+ 'if ((($tmp1 >= 1) && ($tmp1 <= 3))) this.i = 14 else if ((($tmp1 == 4) || ($tmp1 == 5))) this.i = 16 else if (((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10)))) {} else {',
|
|
|
+ '};'
|
|
|
+ ]));
|
|
|
end;
|
|
|
|
|
|
Initialization
|