paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: for-do for char, bool, and constant start/end expression

Browse Source 
git-svn-id: trunk@37580 -
This commit is contained in:
Mattias Gaertner 2017-11-12 14:16:02 +00:00
parent c96f19339f
commit d3a15022d4
4 changed files with 503 additions and 244 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

456
packages/pastojs/src/fppas2js.pp
View File

@ -56,7 +56,6 @@ Works:
- allow only String, no ShortString, AnsiString, UnicodeString,...
- allow type casting string to external class name 'String'
- for loop
- if loopvar is used afterwards append if($loopend>i)i--;
- repeat..until
- while..do
- try..finally
@ -72,7 +71,7 @@ Works:
- case-of
- convert "a div b" to "Math.floor(a / b)"
- and, or, xor, not: logical and bitwise
- typecast boolean to integer and back
- typecast boolean to integer and back with unary plus: +bool and int!=0
- rename name conflicts with js identifiers: apply, bind, call, prototype, ...
- record
- types and vars
@ -252,15 +251,16 @@ Works:
- use 0o for octal literals
- dotted unit names, namespaces
- resourcestring
- custom ranges
- enum, int, char
- low(), high(), pred(), succ(), ord(),
- rg(int), int(rg), enum:=rg,
- rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
- array[rg], low(array), high(array)
ToDos:
- enum range, int range, char range, set of enumrange, set of intrange, set of charrange
- custom ranges
- enum: low(), high(), pred(), succ(), ord(), rg(int), int(rg), enum:=rg,
rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
array[rg], low(array), high(array)
- enumeration for..in..do
enum, set, char, intrange, enumrange, array
- for bool:=
- "use strict" must be at the beginning of the .js file
- typecast longint(highprecint) -> (value+0) & $ffffffff
- static arrays
- a[] of record
@ -273,6 +273,13 @@ ToDos:
- check memleaks
- make records more lightweight
- pointer of record
- enumeration for..in..do
- enum, enum range, set of enum, set of enum range
- int, int range, set of int, set of int range
- char, char range, set of char, set of char range
- array
- operator
- class
- nested types in class
- asm: pas() - useful for overloads and protect an identifier from optimization
- ifthen
@ -446,6 +453,7 @@ type
pbifnUnitInit,
pbivnExceptObject,
pbivnImplementation,
pbivnLoop,
pbivnLoopEnd,
pbivnModule,
pbivnModules,
@ -552,7 +560,8 @@ const
'$init',
'$e',
'$impl',
'$loopend',
'$l',
'$le',
'$mod',
'pas',
'$class',
@ -1092,7 +1101,8 @@ type
coSwitchStatement, // convert case-of into switch instead of if-then-else
coEnumNumbers, // use enum numbers instead of names
coUseStrict, // insert 'use strict'
coNoTypeInfo // do not generate RTTI
coNoTypeInfo, // do not generate RTTI
coEliminateDeadCode // skip code that is never executed
);
TPasToJsConverterOptions = set of TPasToJsConverterOption;
@ -1214,6 +1224,8 @@ type
Function CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
Function CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
Function CreateCallExpression(El: TPasElement): TJSCallExpression;
Function CreateCallCharCodeAt(Arg: TJSElement; aNumber: integer; El: TPasElement): TJSCallExpression; virtual;
Function CreateCallFromCharCode(Arg: TJSElement; El: TPasElement): TJSCallExpression; virtual;
Function CreateUsesList(UsesSection: TPasSection; AContext : TConvertContext): TJSArrayLiteral;
Procedure AddToStatementList(var First, Last: TJSStatementList;
Add: TJSElement; Src: TPasElement);
@ -1230,6 +1242,7 @@ type
Function CreateLiteralNull(El: TPasElement): TJSLiteral; virtual;
Function CreateLiteralUndefined(El: TPasElement): TJSLiteral; virtual;
Function CreateSetLiteralElement(Expr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
Procedure ConvertCharLiteralToInt(Lit: TJSLiteral; ErrorEl: TPasElement; AContext: TConvertContext); virtual;
Function ClonePrimaryExpression(El: TJSPrimaryExpression; Src: TPasElement): TJSPrimaryExpression;
Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasElement;
El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
@ -5221,8 +5234,6 @@ var
LowRg: TResEvalValue;
JSUnaryPlus: TJSUnaryPlusExpression;
w: WideChar;
Call: TJSCallExpression;
JS: TJSString;
begin
Arg:=nil;
B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
@ -5312,22 +5323,12 @@ var
if (Arg is TJSLiteral) and (TJSLiteral(Arg).Value.ValueType=jstString) then
begin
// convert char literal to int
if TJSLiteral(Arg).Value.CustomValue<>'' then
JS:=TJSLiteral(Arg).Value.CustomValue
else
JS:=TJSLiteral(Arg).Value.AsString;
if length(JS)=0 then
RaiseNotSupported(Param,ArgContext,20170910215152);
TJSLiteral(Arg).Value.AsNumber:=ord(JS[1]);
ConvertCharLiteralToInt(TJSLiteral(Arg),Param,ArgContext);
end
else
begin
// convert char to int -> Arg.charCodeAt(0)
Call:=CreateCallExpression(Param);
Call.Expr:=CreateDotExpression(Param,Arg,
CreatePrimitiveDotExpr('charCodeAt',Param));
Arg:=Call;
Call.Args.AddElement(CreateLiteralNumber(Param,0));
Arg:=CreateCallCharCodeAt(Arg,0,Param);
end;
end;
revkUnicodeString:
@ -6829,7 +6830,6 @@ function TPasToJSConverter.ConvertBuiltIn_Chr(El: TParamsExpr;
var
ParamResolved: TPasResolverResult;
Param: TPasExpr;
Call: TJSCallExpression;
begin
Result:=nil;
if AContext.Resolver=nil then
@ -6841,10 +6841,7 @@ begin
// chr(integer) -> String.fromCharCode(integer)
Result:=ConvertElement(Param,AContext);
// Note: convert Param first, as it might raise an exception
Call:=CreateCallExpression(El);
Call.Expr:=CreateMemberExpression(['String','fromCharCode']);
Call.AddArg(Result);
Result:=Call;
Result:=CreateCallFromCharCode(Result,El);
exit;
end;
DoError(20170325185906,nExpectedXButFoundY,sExpectedXButFoundY,['integer',
@ -6905,9 +6902,7 @@ begin
// ord(aChar) -> aChar.charCodeAt()
Result:=ConvertElement(Param,AContext);
// Note: convert Param first, as it might raise an exception
Call:=CreateCallExpression(El);
Call.Expr:=CreateDotExpression(El,Result,CreatePrimitiveDotExpr('charCodeAt',El));
Result:=Call;
Result:=CreateCallCharCodeAt(Result,0,El);
exit;
end
else if ParamResolved.BaseType in btAllBooleans then
@ -10540,68 +10535,96 @@ end;
function TPasToJSConverter.ConvertForStatement(El: TPasImplForLoop;
AContext: TConvertContext): TJSElement;
// Creates the following code:
// var $loopend=<EndExpr>;
// for(LoopVar=<StartExpr>; LoopVar<=$loopend; LoopVar++){}
// if(LoopVar>$loopend)LoopVar--; // this line is only added if LoopVar is read later
// for (var $loop1 = <startexpr>, $loopend = <endexpr>; $loop<=$loopend; $loop++){
// VariableName = $loop;
// ...Body...
// }
//
// The StartExpr must be executed exactly once at beginning.
// The EndExpr must be executed exactly once at beginning.
// LoopVar can be a varname or programname.varname
// For compatibility:
// LoopVar can be a varname or programname.varname
// The StartExpr must be executed exactly once at beginning.
// The EndExpr must be executed exactly once at beginning.
// If the loop is not executed the Variable is not set, aka keeps its old value.
// After the loop the variable has the last value.
Var
ForSt : TJSForStatement;
List, ListEnd: TJSStatementList;
SimpleAss : TJSSimpleAssignStatement;
Incr, Decr : TJSUNaryExpression;
BinExp : TJSBinaryExpression;
VarStat: TJSVariableStatement;
IfSt: TJSIfStatement;
GTExpr: TJSRelationalExpression;
CurLoopEndVarName: String;
FuncContext: TConvertContext;
ResolvedVar: TPasResolverResult;
function NeedDecrAfterLoop: boolean;
function ConvExpr(Expr: TPasExpr): TJSElement;
var
ResolvedVar: TPasResolverResult;
aParent: TPasElement;
ProcBody: TProcedureBody;
FindData: TForLoopFindData;
ResolvedEl: TPasResolverResult;
JSUnaryPlus: TJSUnaryPlusExpression;
begin
Result:=true;
if AContext.Resolver=nil then exit(false);
AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
if ResolvedVar.IdentEl=nil then
exit;
if ResolvedVar.IdentEl.Parent is TProcedureBody then
begin
// loopvar is a local var
ProcBody:=TProcedureBody(ResolvedVar.IdentEl.Parent);
aParent:=El;
while true do
Result:=ConvertElement(Expr,AContext);
if Result is TJSLiteral then
case TJSLiteral(Result).Value.ValueType of
jstBoolean:
// convert bool literal to int
TJSLiteral(Result).Value.AsNumber:=ord(TJSLiteral(Result).Value.AsBoolean);
jstNumber:
exit;
jstString:
begin
aParent:=aParent.Parent;
if aParent=nil then exit;
if aParent is TProcedureBody then
begin
if aParent<>ProcBody then exit;
break;
end;
// convert char literal to int
ConvertCharLiteralToInt(TJSLiteral(Result),Expr,AContext);
exit;
end;
else
Result.Free;
RaiseNotSupported(Expr,AContext,20171112021222);
end
else if AContext.Resolver<>nil then
begin
AContext.Resolver.ComputeElement(Expr,ResolvedEl,[]);
if (ResolvedEl.BaseType in btAllChars)
or ((ResolvedEl.BaseType=btRange) and (ResolvedEl.SubType in btAllChars)) then
begin
// convert char variable to int: append .charCodeAt()
Result:=CreateCallCharCodeAt(Result,0,Expr);
end
else if (ResolvedEl.BaseType in btAllBooleans)
or ((ResolvedEl.BaseType=btRange) and (ResolvedEl.SubType in btAllBooleans)) then
begin
// convert bool variable to int: +expr
JSUnaryPlus:=TJSUnaryPlusExpression(CreateElement(TJSUnaryPlusExpression,Expr));
JSUnaryPlus.A:=Result;
Result:=JSUnaryPlus;
end;
// loopvar is a local var of the same function as where the loop is
// -> check if it is read after the loop
FindData:=Default(TForLoopFindData);
FindData.ForLoop:=El;
FindData.LoopVar:=ResolvedVar.IdentEl;
ProcBody.Body.ForEachCall(@ForLoop_OnProcBodyElement,@FindData);
if not FindData.LoopVarRead then
exit(false);
end;
end;
function GetOrd(Value: TResEvalValue; ErrorEl: TPasElement): MaxPrecInt;
var
OrdValue: TResEvalValue;
begin
if Value=nil then
exit(0);
OrdValue:=AContext.Resolver.ExprEvaluator.OrdValue(Value,ErrorEl);
case OrdValue.Kind of
revkInt: Result:=TResEvalInt(OrdValue).Int;
else
RaiseNotSupported(ErrorEl,AContext,20171112133917);
end;
if Value<>OrdValue then
ReleaseEvalValue(OrdValue);
end;
Var
ForSt : TJSForStatement;
List: TJSStatementList;
SimpleAss : TJSSimpleAssignStatement;
Incr: TJSUNaryExpression;
BinExp : TJSBinaryExpression;
VarStat: TJSVariableStatement;
CurLoopVarName, CurLoopEndVarName: String;
FuncContext: TConvertContext;
ResolvedVar: TPasResolverResult;
Comma: TJSCommaExpression;
LoopPosEl: TPasElement;
StartValue, EndValue: TResEvalValue;
NeedLoopVar, NeedLoopEndVar: Boolean;
StartInt, EndInt: MaxPrecInt;
Statements, V: TJSElement;
NotEqual: TJSEqualityExpressionNE;
begin
Result:=Nil;
BinExp:=Nil;
if AContext.Access<>caRead then
RaiseInconsistency(20170213213740);
if not (El.LoopType in [ltNormal,ltDown]) then
@ -10611,78 +10634,198 @@ begin
FuncContext:=AContext;
while (FuncContext.Parent<>nil) and (not (FuncContext is TFunctionContext)) do
FuncContext:=FuncContext.Parent;
// create unique loopend var name
CurLoopEndVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopEnd]);
// loopvar:=
// for (statementlist...
List:=TJSStatementList(CreateElement(TJSStatementList,El));
ListEnd:=List;
StartValue:=nil;
EndValue:=nil;
Statements:=nil;
try
// add "var $loopend=<EndExpr>"
VarStat:=CreateVarStatement(CurLoopEndVarName,
ConvertElement(El.EndExpr,AContext),El);
List.A:=VarStat;
// add "for()"
ForSt:=TJSForStatement(CreateElement(TJSForStatement,El));
List.B:=ForSt;
// add "LoopVar=<StartExpr>;"
SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.VariableName));
ForSt.Init:=SimpleAss;
NeedLoopVar:=true;
NeedLoopEndVar:=true;
if AContext.Resolver<>nil then
begin
AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
if not (ResolvedVar.IdentEl is TPasVariable) then
DoError(20170213214404,nExpectedXButFoundY,sExpectedXButFoundY,['var',
AContext.Resolver.GetResolverResultDescription(ResolvedVar)],El);
AContext.Resolver.GetResolverResultDescription(ResolvedVar)],El.VariableName);
StartValue:=AContext.Resolver.Eval(El.StartExpr,[],false);
StartInt:=GetOrd(StartValue,El.StartExpr);
EndValue:=AContext.Resolver.Eval(El.EndExpr,[],false);
EndInt:=GetOrd(EndValue,El.EndExpr);
if EndValue<>nil then
begin
NeedLoopEndVar:=false;
if (StartValue<>nil) then
begin
if StartInt<=EndInt then
begin
// loop is always executed
if StartValue.Kind in [revkInt,revkUInt,revkEnum] then
NeedLoopVar:=false; // variable can be used as runner
end
else
begin
// loop is never executed
if coEliminateDeadCode in Options then exit;
end;
end;
end;
end;
SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
// add "LoopVar<=$loopend"
if El.Down then
BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.VariableName))
// create unique var names $loop and $loopend
if NeedLoopVar then
CurLoopVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoop])
else
BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.VariableName));
CurLoopVarName:='';
if NeedLoopEndVar then
CurLoopEndVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopEnd])
else
CurLoopEndVarName:='';
// add "for()"
ForSt:=TJSForStatement(CreateElement(TJSForStatement,El));
Statements:=ForSt;
// add variable=<startexpr>
if (not NeedLoopVar) and NeedLoopEndVar then
begin
// for example:
// i:=<startexpr>;
// for (var $le = <endexpr>; $i<$le; $i++)...
List:=TJSStatementList(CreateElement(TJSStatementList,El));
SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.VariableName));
List.A:=SimpleAss;
List.B:=Statements;
Statements:=List;
SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
if StartValue<>nil then
SimpleAss.Expr:=CreateLiteralNumber(El.StartExpr,StartInt)
else
SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
end;
if NeedLoopVar or NeedLoopEndVar then
begin
// add "for(var ..."
VarStat:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
ForSt.Init:=VarStat;
if NeedLoopVar then
begin
// add "$loop=<StartExpr>"
if StartValue<>nil then
V:=CreateLiteralNumber(El.StartExpr,StartInt)
else
V:=ConvExpr(El.StartExpr);
VarStat.A:=CreateVarDecl(CurLoopVarName,V,El.StartExpr);
end;
if NeedLoopEndVar then
begin
// add "$loopend=<EndExpr>"
if EndValue<>nil then
V:=CreateLiteralNumber(El.EndExpr,EndInt)
else
V:=ConvExpr(El.EndExpr);
V:=CreateVarDecl(CurLoopEndVarName,V,El.EndExpr);
if VarStat.A=nil then
VarStat.A:=V
else
begin
Comma:=TJSCommaExpression(CreateElement(TJSCommaExpression,El.EndExpr));
Comma.A:=VarStat.A;
Comma.B:=V;
VarStat.A:=Comma;
end;
end;
end
else
begin
// for example:
// for (VariableName = <startexpr>; VariableName <= <EndExpr>; VariableName++)
SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.VariableName));
ForSt.Init:=SimpleAss;
SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
if StartValue<>nil then
SimpleAss.Expr:=CreateLiteralNumber(El.StartExpr,StartInt)
else
SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
end;
// add "$loop<=$loopend"
if El.Down then
BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr))
else
BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
ForSt.Cond:=BinExp;
BinExp.A:=ConvertElement(El.VariableName,AContext);
BinExp.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
// add "LoopVar++"
if El.Down then
Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El.VariableName))
if NeedLoopVar then
BinExp.A:=CreatePrimitiveDotExpr(CurLoopVarName,El.EndExpr)
else
Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El.VariableName));
BinExp.A:=ConvertElement(El.VariableName,AContext);
if NeedLoopEndVar then
BinExp.B:=CreatePrimitiveDotExpr(CurLoopEndVarName,El.EndExpr)
else
BinExp.B:=CreateLiteralNumber(El.EndExpr,EndInt);
// add "$loop++"
if El.Down then
Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El.EndExpr))
else
Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El.EndExpr));
ForSt.Incr:=Incr;
Incr.A:=ConvertElement(El.VariableName,AContext);
if NeedLoopVar then
Incr.A:=CreatePrimitiveDotExpr(CurLoopVarName,El.EndExpr)
else
Incr.A:=ConvertElement(El.VariableName,AContext);
// add "VariableName:=$loop;"
if NeedLoopVar then
begin
LoopPosEl:=El.Body;
if LoopPosEl=nil then
LoopPosEl:=El;
// add "VariableName:=$loop;"
LoopPosEl:=El.VariableName;
SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,LoopPosEl));
ForSt.Body:=SimpleAss;
SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
SimpleAss.Expr:=CreatePrimitiveDotExpr(CurLoopVarName,LoopPosEl);
if AContext.Resolver<>nil then
begin
if (ResolvedVar.BaseType in btAllChars)
or ((ResolvedVar.BaseType=btRange) and (ResolvedVar.SubType in btAllChars)) then
begin
// convert int to char
SimpleAss.Expr:=CreateCallFromCharCode(SimpleAss.Expr,LoopPosEl);
end
else if (ResolvedVar.BaseType in btAllBooleans)
or ((ResolvedVar.BaseType=btRange) and (ResolvedVar.SubType in btAllBooleans)) then
begin
// convert int to bool -> $loop!=0
NotEqual:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,LoopPosEl));
NotEqual.A:=SimpleAss.Expr;
NotEqual.B:=CreateLiteralNumber(El,0);
SimpleAss.Expr:=NotEqual;
end
end;
end;
// add body
if El.Body<>nil then
ForSt.Body:=ConvertElement(El.Body,AContext);
if NeedDecrAfterLoop then
begin
// add "if(LoopVar>$loopend)LoopVar--;"
// add "if()"
IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
AddToStatementList(List,ListEnd,IfSt,El);
// add "LoopVar>$loopend"
if El.Down then
GTExpr:=TJSRelationalExpressionLT(CreateElement(TJSRelationalExpressionLT,El.VariableName))
V:=ConvertElement(El.Body,AContext);
if ForSt.Body=nil then
ForSt.Body:=V
else
GTExpr:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El.VariableName));
IfSt.Cond:=GTExpr;
GTExpr.A:=ConvertElement(El.VariableName,AContext);
GTExpr.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
// add "LoopVar--"
if El.Down then
Decr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El.VariableName))
else
Decr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El.VariableName));
IfSt.BTrue:=Decr;
Decr.A:=ConvertElement(El.VariableName,AContext);
begin
List:=TJSStatementList(CreateElement(TJSStatementList,El.Body));
List.A:=ForSt.Body;
List.B:=V;
ForSt.Body:=List;
end;
end;
Result:=List;
Result:=Statements;
finally
ReleaseEvalValue(StartValue);
ReleaseEvalValue(EndValue);
if Result=nil then
List.Free;
Statements.Free;
end;
end;
@ -10920,6 +11063,23 @@ begin
Result.Args:=TJSArguments(CreateElement(TJSArguments,El));
end;
function TPasToJSConverter.CreateCallCharCodeAt(Arg: TJSElement;
aNumber: integer; El: TPasElement): TJSCallExpression;
begin
Result:=CreateCallExpression(El);
Result.Expr:=CreateDotExpression(El,Arg,CreatePrimitiveDotExpr('charCodeAt',El));
if aNumber<>0 then
Result.Args.AddElement(CreateLiteralNumber(El,aNumber));
end;
function TPasToJSConverter.CreateCallFromCharCode(Arg: TJSElement;
El: TPasElement): TJSCallExpression;
begin
Result:=CreateCallExpression(El);
Result.Expr:=CreateMemberExpression(['String','fromCharCode']);
Result.AddArg(Arg);
end;
function TPasToJSConverter.CreateUsesList(UsesSection: TPasSection;
AContext: TConvertContext): TJSArrayLiteral;
var
@ -11161,7 +11321,7 @@ end;
function TPasToJSConverter.CreateVarStatement(const aName: String;
Init: TJSElement; El: TPasElement): TJSVariableStatement;
// craete "var aname = init"
// create "var aname = init"
begin
Result:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
Result.A:=CreateVarDecl(aName,Init,El);
@ -11280,9 +11440,7 @@ begin
or ((ExprResolved.BaseType=btRange) and (ExprResolved.SubType in btAllJSChars)) then
begin
// aChar -> aChar.charCodeAt()
Call:=TJSCallExpression(CreateElement(TJSCallExpression,Expr));
Call.Expr:=CreateDotExpression(Expr,Result,CreatePrimitiveDotExpr('charCodeAt',Expr));
Result:=Call;
Result:=CreateCallCharCodeAt(Result,0,Expr);
end
else if ExprResolved.BaseType in btAllJSInteger then
begin
@ -11305,6 +11463,22 @@ begin
end;
end;
procedure TPasToJSConverter.ConvertCharLiteralToInt(Lit: TJSLiteral;
ErrorEl: TPasElement; AContext: TConvertContext);
var
JS: TJSString;
begin
if Lit.Value.ValueType<>jstString then
RaiseInconsistency(20171112020856);
if Lit.Value.CustomValue<>'' then
JS:=Lit.Value.CustomValue
else
JS:=Lit.Value.AsString;
if length(JS)<>1 then
RaiseNotSupported(ErrorEl,AContext,20171112021003);
Lit.Value.AsNumber:=ord(JS[1]);
end;
function TPasToJSConverter.ClonePrimaryExpression(El: TJSPrimaryExpression;
Src: TPasElement): TJSPrimaryExpression;
begin

121
packages/pastojs/tests/tcconverter.pp
View File

@ -365,14 +365,15 @@ Procedure TTestStatementConverter.TestForLoopUp;
Var
F : TPasImplForLoop;
E : TJSForStatement;
ForSt: TJSForStatement;
L : TJSStatementList;
VD : TJSVarDeclaration;
A : TJSSimpleAssignStatement;
I : TJSUnaryPostPlusPlusExpression;
C : TJSRelationalExpressionLE;
Cond : TJSRelationalExpressionLE;
VS: TJSVariableStatement;
LoopEndVar: String;
LoopEndVar, LoopVar: String;
CS: TJSCommaExpression;
begin
// For I:=1 to 100 do a:=b;
@ -382,49 +383,57 @@ begin
F.StartExpr:=CreateLiteral(1);
F.EndExpr:=CreateLiteral(100);
F.Body:=CreateAssignStatement();
L:=TJSStatementList(Convert(F,TJSStatementList));
// Should be a list of two statements:
// var $loopend1=100;
// for(i=1; i<=$loopend1; i++){ a:=b; }
ForSt:=TJSForStatement(Convert(F,TJSForStatement));
// Should be
// for(var $l1=1, $le2=100; $l1<=$le2; $l1++){
// I=$l1;
// a=b;
// }
LoopVar:=Pas2JSBuiltInNames[pbivnLoop]+'1';
LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'2';
// "var $loopend1=100"
LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
// "var $l1=1, $le2=100"
VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
CS:=TJSCommaExpression(AssertElement('For init var has comma',TJSCommaExpression,VS.A));
VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,CS.A));
AssertEquals('Correct name for '+LoopVar,LoopVar,VD.Name);
AssertLiteral('Correct start value',VD.Init,1);
VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,CS.B));
AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
AssertLiteral('Correct end value',VD.Init,100);
E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
// $l1<=$le2
Cond:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,ForSt.Cond));
AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
// i:=1
A:=TJSSimpleAssignStatement(AssertElement('Init statement',TJSSimpleAssignStatement,E.Init));
AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
AssertLiteral('Init statement RHS is start value',A.Expr,1);
// i<=$loopend1
C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
AssertIdentifier('Cond LHS is loop variable',C.A,'i');
AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
// i++
I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
AssertIdentifier('++ on correct variable name',I.A,'i');
// $l1++
I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,ForSt.Incr));
AssertIdentifier('++ on correct variable name',I.A,LoopVar);
// body
AssertAssignStatement('Correct body',E.Body);
L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
// I:=$l1
A:=TJSSimpleAssignStatement(AssertElement('I:=$l1',TJSSimpleAssignStatement,L.A));
AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
AssertAssignStatement('Correct body',L.B);
end;
Procedure TTestStatementConverter.TestForLoopDown;
Var
F : TPasImplForLoop;
E : TJSForStatement;
ForSt: TJSForStatement;
L : TJSStatementList;
VD : TJSVarDeclaration;
A : TJSSimpleAssignStatement;
I : TJSUnaryPostMinusMinusExpression;
C : TJSRelationalExpressionGE;
Cond: TJSRelationalExpressionGE;
VS: TJSVariableStatement;
LoopEndVar: String;
LoopEndVar, LoopVar: String;
CS: TJSCommaExpression;
begin
// For I:=100 downto 1 do a:=b;
@ -435,37 +444,43 @@ begin
F.EndExpr:=CreateLiteral(1);
F.LoopType:=ltDown;
F.Body:=CreateAssignStatement();
L:=TJSStatementList(Convert(F,TJSStatementList));
ForSt:=TJSForStatement(Convert(F,TJSForStatement));
// Should be
// for(var $l1=100, $le2=1; $l1>=$le2; $l1--){
// I=$l1;
// a=b;
// }
LoopVar:=Pas2JSBuiltInNames[pbivnLoop]+'1';
LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'2';
// Should be a list of two statements:
// var $loopend1=1;
// for(i=100; i>=$loopend1; i--){ a:=b; }
// "var $loopend1=1"
LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
// "var $l1=100, $le2=1"
VS:=TJSVariableStatement(AssertElement('For init is var '+LoopEndVar,TJSVariableStatement,ForSt.Init));
CS:=TJSCommaExpression(AssertElement('For init var has comma',TJSCommaExpression,VS.A));
VD:=TJSVarDeclaration(AssertElement('var '+LoopVar,TJSVarDeclaration,CS.A));
AssertEquals('Correct name for '+LoopVar,LoopVar,VD.Name);
AssertLiteral('Correct start value',VD.Init,100);
VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,CS.B));
AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
AssertLiteral('Correct end value',VD.Init,1);
E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
// $l1>=$le2
Cond:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,ForSt.Cond));
AssertIdentifier('Cond LHS is '+LoopVar,Cond.A,LoopVar);
AssertIdentifier('Cond RHS is '+LoopEndVar,Cond.B,LoopEndVar);
// i=100;
A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,E.Init));
AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
AssertLiteral('Init statement RHS is start value',A.Expr,100);
// i>=$loopend1
C:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,E.Cond));
AssertIdentifier('Cond LHS is loop variable',C.A,'i');
AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
// i--
I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
AssertIdentifier('-- on correct variable name',I.A,'i');
// $l1--
I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,ForSt.Incr));
AssertIdentifier('-- on correct variable name',I.A,LoopVar);
// body
AssertAssignStatement('Correct body',E.Body);
L:=TJSStatementList(AssertElement('For body ist list',TJSStatementList,ForSt.Body));
// I:=$l1
A:=TJSSimpleAssignStatement(AssertElement('I:=$l1',TJSSimpleAssignStatement,L.A));
AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
AssertIdentifier('Init statement RHS is '+LoopVar,A.Expr,LoopVar);
AssertAssignStatement('Correct body',L.B);
end;
Procedure TTestStatementConverter.TestBeginEndBlockEmpty;

152
packages/pastojs/tests/tcmodules.pas
View File

@ -222,6 +222,8 @@ type
Procedure TestBaseType_RawByteStringFail;
Procedure TestTypeShortstring_Fail;
Procedure TestCharSet_Custom;
Procedure TestForCharDo;
Procedure TestForBoolDo;
// alias types
Procedure TestAliasTypeRef;
@ -264,6 +266,7 @@ type
Procedure TestEnum_Number;
Procedure TestEnum_Functions;
Procedure TestEnum_AsParams;
Procedure TestEnumRange_Array;
Procedure TestSet;
Procedure TestSet_Operators;
Procedure TestSet_Operator_In;
@ -2493,10 +2496,8 @@ begin
' break;',
'} while (!true);',
'while (true) break;',
'var $loopend1 = 2;',
'for ($mod.i = 1; $mod.i <= $loopend1; $mod.i++) break;',
'if ($mod.i > $loopend1) $mod.i--;'
]));
'for ($mod.i = 1; $mod.i <= 2; $mod.i++) break;',
'']));
end;
procedure TTestModule.TestContinue;
@ -2521,10 +2522,8 @@ begin
' continue;',
'} while (!true);',
'while (true) continue;',
'var $loopend1 = 2;',
'for ($mod.i = 1; $mod.i <= $loopend1; $mod.i++) continue;',
'if ($mod.i > $loopend1) $mod.i--;'
]));
'for ($mod.i = 1; $mod.i <= 2; $mod.i++) continue;',
'']));
end;
procedure TTestModule.TestProc_External;
@ -3190,6 +3189,38 @@ begin
]));
end;
procedure TTestModule.TestEnumRange_Array;
begin
StartProgram(false);
Add([
'type',
' TEnum = (Red, Green, Blue);',
' TEnumRg = green..blue;',
' TArr = array[TEnumRg] of byte;',
'var',
' a: TArr;',
' b: TArr = (3,4);',
'begin',
' a[green] := b[blue];']);
ConvertProgram;
CheckSource('TestEnumRange_Array',
LinesToStr([ // statements
'this.TEnum = {',
' "0": "Red",',
' Red: 0,',
' "1": "Green",',
' Green: 1,',
' "2": "Blue",',
' Blue: 2',
'};',
'this.a = rtl.arraySetLength(null, 0, 2);',
'this.b = [3, 4];',
'']),
LinesToStr([
' $mod.a[$mod.TEnum.Green - 1] = $mod.b[$mod.TEnum.Blue - 1];',
'']));
end;
procedure TTestModule.TestSet;
begin
StartProgram(false);
@ -3714,19 +3745,21 @@ end;
procedure TTestModule.TestSet_ConstChar;
begin
StartProgram(false);
Add('const');
Add(' LowChars = [''a''..''z''];');
Add(' Chars = LowChars+[''A''..''Z''];');
Add('var');
Add(' c: char;');
Add(' s: string;');
Add('begin');
Add(' if c in lowchars then ;');
Add(' if ''a'' in lowchars then ;');
Add(' if s[1] in lowchars then ;');
Add(' if c in chars then ;');
Add(' if c in [''a''..''z'',''_''] then ;');
Add(' if ''b'' in [''a''..''z'',''_''] then ;');
Add([
'const',
' LowChars = [''a''..''z''];',
' Chars = LowChars+[''A''..''Z''];',
'var',
' c: char;',
' s: string;',
'begin',
' if c in lowchars then ;',
' if ''a'' in lowchars then ;',
' if s[1] in lowchars then ;',
' if c in chars then ;',
' if c in [''a''..''z'',''_''] then ;',
' if ''b'' in [''a''..''z'',''_''] then ;',
'']);
ConvertProgram;
CheckSource('TestSet_ConstChar',
LinesToStr([ // statements
@ -4495,6 +4528,44 @@ begin
'']));
end;
procedure TTestModule.TestForCharDo;
begin
StartProgram(false);
Add([
'var c: char;',
'begin',
' for c:=''a'' to ''c'' do ;',
' for c:=c downto ''a'' do ;',
'']);
ConvertProgram;
CheckSource('TestForCharDo',
LinesToStr([ // statements
'this.c = "";']),
LinesToStr([ // this.$main
'for (var $l1 = 97; $l1 <= 99; $l1++) $mod.c = String.fromCharCode($l1);',
'for (var $l2 = $mod.c.charCodeAt(); $l2 >= 97; $l2--) $mod.c = String.fromCharCode($l2);',
'']));
end;
procedure TTestModule.TestForBoolDo;
begin
StartProgram(false);
Add([
'var b: boolean;',
'begin',
' for b:=false to true do ;',
' for b:=b downto false do ;',
'']);
ConvertProgram;
CheckSource('TestForBoolDo',
LinesToStr([ // statements
'this.b = false;']),
LinesToStr([ // this.$main
'for (var $l1 = 0; $l1 <= 1; $l1++) $mod.b = $l1 != 0;',
'for (var $l2 = +$mod.b; $l2 >= 0; $l2--) $mod.b = $l2 != 0;',
'']));
end;
procedure TTestModule.TestProcTwoArgs;
begin
StartProgram(false);
@ -4622,12 +4693,11 @@ begin
LinesToStr([ // this.$main
' $mod.vJ = 0;',
' $mod.vN = 3;',
' var $loopend1 = $mod.vN;',
' for ($mod.vI = 1; $mod.vI <= $loopend1; $mod.vI++) {',
' for (var $l1 = 1, $le2 = $mod.vN; $l1 <= $le2; $l1++) {',
' $mod.vI = $l1;',
' $mod.vJ = $mod.vJ + $mod.vI;',
' };',
' if ($mod.vI > $loopend1) $mod.vI--;'
]));
'']));
end;
procedure TTestModule.TestForLoopInFunction;
@ -4653,8 +4723,8 @@ begin
' var vI = 0;',
' var vJ = 0;',
' vJ = 0;',
' var $loopend1 = Count;',
' for (vI = 1; vI <= $loopend1; vI++) {',
' for (var $l1 = 1, $le2 = Count; $l1 <= $le2; $l1++) {',
' vI = $l1;',
' vJ = vJ + vI;',
' };',
' return Result;',
@ -4679,9 +4749,7 @@ begin
'this.vI = 0;'
]),
LinesToStr([ // this.$main
' var $loopend1 = 2;',
' for ($mod.vI = 1; $mod.vI <= $loopend1; $mod.vI++);',
' if($mod.vI>$loopend1)$mod.vI--;',
' for ($mod.vI = 1; $mod.vI <= 2; $mod.vI++) ;',
' if ($mod.vI===3) ;'
]));
end;
@ -4713,10 +4781,10 @@ begin
' var vJ = 0;',
' var vK = 0;',
' vK = 0;',
' var $loopend1 = Count;',
' for (vI = 1; vI <= $loopend1; vI++) {',
' var $loopend2 = vI;',
' for (vJ = 1; vJ <= $loopend2; vJ++) {',
' for (var $l1 = 1, $le2 = Count; $l1 <= $le2; $l1++) {',
' vI = $l1;',
' for (var $l3 = 1, $le4 = vI; $l3 <= $le4; $l3++) {',
' vJ = $l3;',
' vK = vK + vI;',
' };',
' };',
@ -5310,15 +5378,15 @@ begin
'$mod.c = "\x00";',
'$mod.c = "'#$EF#$BF#$BF'";',
'$mod.Arr[66] = "a";',
'$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt(0)];',
'$mod.Arr[$mod.c.charCodeAt(0)] = $mod.Arr[100];',
'$mod.Arr[$mod.Arr[$mod.c.charCodeAt(0)].charCodeAt(0)] = $mod.Arr[65535];',
'$mod.Arr[68] = $mod.Arr[$mod.c.charCodeAt()];',
'$mod.Arr[$mod.c.charCodeAt()] = $mod.Arr[100];',
'$mod.Arr[$mod.Arr[$mod.c.charCodeAt()].charCodeAt()] = $mod.Arr[65535];',
'$mod.b = $mod.Arr[0] === $mod.Arr[101];',
'$mod.c = "a";',
'$mod.c = "z";',
'$mod.Arr2[1] = "f";',
'$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt(0) - 97];',
'$mod.Arr2[$mod.c.charCodeAt(0) - 97] = $mod.Arr2[6];',
'$mod.Arr2[0] = $mod.Arr2[$mod.c.charCodeAt() - 97];',
'$mod.Arr2[$mod.c.charCodeAt() - 97] = $mod.Arr2[6];',
'']));
end;
@ -5731,8 +5799,10 @@ begin
'this.DoIt = function (a) {',
' var i = 0;',
' var s = "";',
' var $loopend1 = rtl.length(a) - 1;',
' for (i = 0; i <= $loopend1; i++) s = a[(rtl.length(a) - i) - 1];',
' for (var $l1 = 0, $le2 = rtl.length(a) - 1; $l1 <= $le2; $l1++) {',
' i = $l1;',
' s = a[(rtl.length(a) - i) - 1];',
' };',
'};',
'this.s = "";',
'']),

18
packages/pastojs/tests/tcsrcmap.pas
View File

@ -57,7 +57,7 @@ type
procedure TestEmptyUnit;
procedure TestIf;
procedure TestIfBegin;
procedure TestFor;
procedure TestForConstRange;
procedure TestFunction;
procedure TestExternalObjCall;
procedure TestBracketAccessor;
@ -374,24 +374,22 @@ begin
'});']);
end;
procedure TTestSrcMap.TestFor;
procedure TTestSrcMap.TestForConstRange;
begin
StartProgram(false);
Add([
'var Runner, i: longint;',
'begin',
' (*for*)for (*r*)Runner := (*start*)1000 + 2000 to (*end*)3000 do',
' (*for*)for (*r*)Runner := (*start*)1000 to (*end*)3000 do',
' (*inc*)inc(i);']);
ConvertProgram;
CheckSrcMap('TestFor',[
CheckSrcMap('TestForConstRange',[
'rtl.module("program", [], function () {',
' var $mod = this;',
' this.Runner = 0;',
' this.i = 0;',
' $mod.$main = function () {',
'(*for*) var $loopend1 = (*end*)3000;',
'(*for*) for ((*r*)$mod.Runner = (*start*)1000 + 2000; (*r*)$mod.Runner <= (*end*)$loopend1; (*r*)$mod.Runner++)(*for*) $mod.i (*inc*)+= 1;',
'(*for*) if ($mod.Runner > $loopend1) $mod.Runner--;(*for*)',
'(*for*) for ((*r*)$mod.Runner = (*start*)1000; (*r*)$mod.Runner (*end*)<= 3000; (*r*)$mod.Runner++) $mod.i (*inc*)+= 1;',
' };',
'});'
]);
@ -423,8 +421,10 @@ begin
' var Runner = 0;',
' var j = 0;',
' j = 0;',
' var $loopend1 = j;',
' for (Runner = $mod.p; Runner <= $loopend1; Runner++) j += 1;',
' for (var $l1 = 3, $le2 = j; $l1 <= $le2; $l1++) {',
' Runner = $l1;',
' j += 1;',
' };',
' Result = j;',
' return Result;',
' };',