mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-14 05:40:28 +02:00
undo accidental commit: fppas2js: test TestFunctionResult
git-svn-id: trunk@35023 -
This commit is contained in:
parent
3bb089223b
commit
7f8cdc56d3
@ -883,7 +883,7 @@ Type
|
||||
Destructor Destroy; override;
|
||||
Property Cond : TJSelement Read FCond Write FCond;
|
||||
Property Cases : TJSCaseElements Read FCases;
|
||||
Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases
|
||||
Property TheDefault : TJSCaseelement Read FDefault Write FDefault; // one of Cases
|
||||
end;
|
||||
|
||||
{ TJSLabeledStatement - e.g. 'TheLabel : A' }
|
||||
|
@ -136,7 +136,7 @@ Type
|
||||
Procedure WriteIfStatement(El: TJSIfStatement);virtual;
|
||||
Procedure WriteSourceElements(El: TJSSourceElements);virtual;
|
||||
Procedure WriteStatementList(El: TJSStatementList);virtual;
|
||||
Procedure WriteTryStatement(El: TJSTryStatement);virtual;
|
||||
Procedure WriteTryStatement(el: TJSTryStatement);virtual;
|
||||
Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual;
|
||||
Procedure WriteWithStatement(El: TJSWithStatement);virtual;
|
||||
Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual;
|
||||
@ -426,7 +426,7 @@ Var
|
||||
S : String;
|
||||
begin
|
||||
if V.CustomValue<>'' then
|
||||
S:=JSStringToStr(V.CustomValue)
|
||||
S:=V.CustomValue
|
||||
else
|
||||
Case V.ValueType of
|
||||
jstUNDEFINED : S:='undefined';
|
||||
@ -821,7 +821,7 @@ begin
|
||||
WriteJS(EL.LHS);
|
||||
S:=El.OperatorString;
|
||||
If Not (woCompact in Options) then
|
||||
S:=' '+S+' ';
|
||||
S:=' '+S+' ';
|
||||
Write(s);
|
||||
WriteJS(EL.Expr);
|
||||
end;
|
||||
@ -841,16 +841,11 @@ procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
|
||||
|
||||
begin
|
||||
Write('if (');
|
||||
WriteJS(El.Cond);
|
||||
Write(')');
|
||||
If Not (woCompact in Options) then
|
||||
Write(' ');
|
||||
if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then
|
||||
WriteJS(El.BTrue);
|
||||
WriteJS(EL.Cond);
|
||||
Write(') ');
|
||||
WriteJS(El.BTrue);
|
||||
if Assigned(El.BFalse) then
|
||||
begin
|
||||
if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then
|
||||
Write('{}');
|
||||
Write(' else ');
|
||||
WriteJS(El.BFalse)
|
||||
end;
|
||||
@ -934,15 +929,15 @@ begin
|
||||
C:=(woCompact in Options);
|
||||
Write('switch (');
|
||||
If Assigned(El.Cond) then
|
||||
WriteJS(El.Cond);
|
||||
WriteJS(EL.Cond);
|
||||
if C then
|
||||
Write(') {')
|
||||
else
|
||||
Writeln(') {');
|
||||
For I:=0 to El.Cases.Count-1 do
|
||||
For I:=0 to EL.Cases.Count-1 do
|
||||
begin
|
||||
EC:=El.Cases[i];
|
||||
if EC=El.TheDefault then
|
||||
EC:=EL.Cases[i];
|
||||
if EC=EL.TheDefault then
|
||||
Write('default')
|
||||
else
|
||||
begin
|
||||
@ -955,22 +950,14 @@ begin
|
||||
Writeln(':');
|
||||
if Assigned(EC.Body) then
|
||||
begin
|
||||
FSkipBrackets:=true;
|
||||
Indent;
|
||||
WriteJS(EC.Body);
|
||||
Undent;
|
||||
if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
|
||||
if C then
|
||||
Write('; ')
|
||||
else
|
||||
Writeln(';');
|
||||
end
|
||||
else
|
||||
begin
|
||||
if C then
|
||||
Write('; ')
|
||||
begin
|
||||
if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
|
||||
write('; ')
|
||||
end
|
||||
else
|
||||
Writeln(';');
|
||||
Writeln('');
|
||||
end;
|
||||
end;
|
||||
Write('}');
|
||||
@ -1030,7 +1017,7 @@ begin
|
||||
WriteJS(EL.A);
|
||||
end;
|
||||
|
||||
procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
|
||||
procedure TJSWriter.WriteTryStatement(el: TJSTryStatement);
|
||||
|
||||
Var
|
||||
C : Boolean;
|
||||
@ -1047,6 +1034,7 @@ begin
|
||||
Write('} ')
|
||||
else
|
||||
begin
|
||||
Writeln('');
|
||||
Writeln('}');
|
||||
end;
|
||||
If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
|
||||
@ -1057,7 +1045,7 @@ begin
|
||||
else
|
||||
Writeln(') {');
|
||||
Indent;
|
||||
WriteJS(El.BCatch);
|
||||
WriteJS(EL.BCatch);
|
||||
Undent;
|
||||
If C then
|
||||
if (El is TJSTryCatchFinallyStatement) then
|
||||
@ -1077,10 +1065,15 @@ begin
|
||||
else
|
||||
Writeln('finally {');
|
||||
Indent;
|
||||
FSkipBrackets:=True;
|
||||
WriteJS(El.BFinally);
|
||||
WriteJS(EL.BFinally);
|
||||
Undent;
|
||||
Write('}');
|
||||
If C then
|
||||
Write('}')
|
||||
else
|
||||
begin
|
||||
Writeln('');
|
||||
Writeln('}');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -14,8 +14,7 @@
|
||||
**********************************************************************
|
||||
|
||||
Examples:
|
||||
./testpas2js --suite=TTestModule.TestEmptyProgram
|
||||
./testpas2js --suite=TTestModule.TestEmptyUnit
|
||||
./testpas2js --suite=TTestModuleConverter.TestEmptyProgram
|
||||
}
|
||||
unit tcmodules;
|
||||
|
||||
@ -93,9 +92,8 @@ 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;
|
||||
@ -104,10 +102,7 @@ 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);
|
||||
@ -133,31 +128,10 @@ 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;
|
||||
@ -166,11 +140,6 @@ 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;
|
||||
@ -396,15 +365,22 @@ 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
|
||||
StartParsing;
|
||||
Parser.ParseMain(FModule);
|
||||
ParseModule;
|
||||
except
|
||||
on E: EParserError do
|
||||
begin
|
||||
writeln('ERROR: TTestModule.ParseModule Parser: '+E.ClassName+':'+E.Message
|
||||
writeln('ERROR: TTestModule.ParseProgram Parser: '+E.ClassName+':'+E.Message
|
||||
+' File='+Scanner.CurFilename
|
||||
+' LineNo='+IntToStr(Scanner.CurRow)
|
||||
+' Col='+IntToStr(Scanner.CurColumn)
|
||||
@ -414,7 +390,7 @@ begin
|
||||
end;
|
||||
on E: EPasResolve do
|
||||
begin
|
||||
writeln('ERROR: TTestModule.ParseModule PasResolver: '+E.ClassName+':'+E.Message
|
||||
writeln('ERROR: TTestModule.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
|
||||
+' File='+Scanner.CurFilename
|
||||
+' LineNo='+IntToStr(Scanner.CurRow)
|
||||
+' Col='+IntToStr(Scanner.CurColumn)
|
||||
@ -424,18 +400,11 @@ begin
|
||||
end;
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln('ERROR: TTestModule.ParseModule Exception: '+E.ClassName+':'+E.Message);
|
||||
writeln('ERROR: TTestModule.ParseProgram 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);
|
||||
@ -445,18 +414,6 @@ 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
|
||||
@ -531,29 +488,20 @@ begin
|
||||
Add('');
|
||||
end;
|
||||
|
||||
procedure TTestModule.StartUnit(NeedSystemUnit: boolean);
|
||||
begin
|
||||
if NeedSystemUnit then
|
||||
AddSystemUnit
|
||||
else
|
||||
Parser.ImplicitUses.Clear;
|
||||
Add('unit Test1;');
|
||||
Add('');
|
||||
end;
|
||||
|
||||
procedure TTestModule.ConvertModule;
|
||||
procedure TTestModule.ConvertProgram;
|
||||
var
|
||||
ModuleNameExpr: TJSLiteral;
|
||||
FunDecl, InitFunction: TJSFunctionDeclarationStatement;
|
||||
FunDef: TJSFuncDef;
|
||||
InitAssign: TJSSimpleAssignStatement;
|
||||
FunBody: TJSFunctionBody;
|
||||
InitName: String;
|
||||
begin
|
||||
FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
|
||||
FJSSource:=TStringList.Create;
|
||||
Add('end.');
|
||||
ParseProgram;
|
||||
FJSModule:=FConverter.ConvertPasElement(Module,nil) as TJSSourceElements;
|
||||
FJSSource.Text:=JSToStr(JSModule);
|
||||
writeln('TTestModule.ConvertModule JS:');
|
||||
writeln('TTestModule.ConvertProgram JS:');
|
||||
write(FJSSource.Text);
|
||||
|
||||
// rtl.module(...
|
||||
@ -571,10 +519,7 @@ 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));
|
||||
if Module is TPasProgram then
|
||||
AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
|
||||
else
|
||||
AssertEquals('module name',lowercase(Module.Name),String(ModuleNameExpr.Value.AsString));
|
||||
AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString));
|
||||
|
||||
// main uses section
|
||||
AssertNotNull('interface uses section',JSModuleCallArgs.Elements.Elements[1].Expr);
|
||||
@ -593,39 +538,12 @@ begin
|
||||
FJSModuleSrc:=FunBody.A as TJSSourceElements;
|
||||
|
||||
// init this.$main - the last statement
|
||||
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;
|
||||
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');
|
||||
|
||||
procedure TTestModule.ConvertProgram;
|
||||
begin
|
||||
Add('end.');
|
||||
ParseProgram;
|
||||
ConvertModule;
|
||||
end;
|
||||
|
||||
procedure TTestModule.ConvertUnit;
|
||||
begin
|
||||
Add('end.');
|
||||
ParseUnit;
|
||||
ConvertModule;
|
||||
InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
|
||||
FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
|
||||
end;
|
||||
|
||||
procedure TTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
|
||||
@ -638,7 +556,7 @@ begin
|
||||
else
|
||||
begin
|
||||
AssertNotNull(Msg,El);
|
||||
AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
|
||||
AssertEquals(Msg,DottedName,GetDottedIdentifier(EL));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -656,20 +574,13 @@ end;
|
||||
|
||||
procedure TTestModule.CheckSource(Msg, Statements, InitStatements: string);
|
||||
var
|
||||
ActualSrc, ExpectedSrc, InitName: String;
|
||||
ActualSrc, ExpectedSrc: String;
|
||||
begin
|
||||
ActualSrc:=JSToStr(JSModuleSrc);
|
||||
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,'"');
|
||||
ExpectedSrc:=Statements+LineEnding
|
||||
+'this.$main = function () {'+LineEnding
|
||||
+InitStatements
|
||||
+'};'+LineEnding;
|
||||
CheckDiff(Msg,ExpectedSrc,ActualSrc);
|
||||
end;
|
||||
|
||||
@ -785,14 +696,6 @@ begin
|
||||
CheckSource('Empty program','','');
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestEmptyUnit;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add('interface');
|
||||
Add('implementation');
|
||||
ConvertUnit;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestVarInt;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -802,70 +705,6 @@ 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);
|
||||
@ -884,199 +723,6 @@ 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);
|
||||
@ -1153,7 +799,7 @@ begin
|
||||
CheckSource('TestVarRecord',
|
||||
LinesToStr([ // statements
|
||||
'this.treca = function () {',
|
||||
' this.b = 0;',
|
||||
' b = 0;',
|
||||
'};',
|
||||
'this.r = new this.treca();'
|
||||
]),
|
||||
@ -1298,141 +944,6 @@ 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
|
||||
|
@ -110,41 +110,8 @@ procedure GetFormatSettings(out fmts: TFormatSettings);
|
||||
end;
|
||||
|
||||
function GetLocaleChar(item: cint): char;
|
||||
var
|
||||
p: PChar;
|
||||
begin
|
||||
p := nl_langinfo(item);
|
||||
Result := p^;
|
||||
if (ord(Result)>127) and (DefaultSystemCodePage=CP_UTF8) then begin
|
||||
Result := #0;
|
||||
case p^ of
|
||||
#$C2:
|
||||
case p[1] of
|
||||
#$A0: Result:=' '; // non breakable space
|
||||
#$B7: Result:='.'; // middle stop
|
||||
end;
|
||||
#$CB:
|
||||
if p[1]=#$99 then Result:=''''; // dot above, italian handwriting
|
||||
#$D9:
|
||||
case p[1] of
|
||||
#$AB: Result:=','; // arabic decimal separator, persian thousand separator
|
||||
#$AC: Result:=''''; // arabic thousand separator
|
||||
end;
|
||||
#$E2:
|
||||
case p[1] of
|
||||
#$80:
|
||||
case p[2] of
|
||||
#$82, // long space
|
||||
#$83, // long space
|
||||
#$89, // thin space
|
||||
#$AF: // narrow non breakable space
|
||||
Result := ' ';
|
||||
#$94: Result := '-'; // persian decimal mark
|
||||
end;
|
||||
#$8E: if p[2]=#$96 then Result := ''''; // codepoint 9110 decimal separator
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
GetLocaleChar := nl_langinfo(item)^;
|
||||
end;
|
||||
|
||||
function SkipModifiers(const s: string; var i: integer): string;
|
||||
|
Loading…
Reference in New Issue
Block a user