undo accidental commit: fppas2js: test TestFunctionResult

git-svn-id: trunk@35023 -
This commit is contained in:
Mattias Gaertner 2016-11-30 10:29:13 +00:00
parent 3bb089223b
commit 7f8cdc56d3
5 changed files with 188 additions and 1094 deletions

View File

@ -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' }

View File

@ -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

View File

@ -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

View File

@ -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;