diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index b5c8556eaa..bd28dda1aa 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -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=; -// for(LoopVar=; LoopVar<=$loopend; LoopVar++){} -// if(LoopVar>$loopend)LoopVar--; // this line is only added if LoopVar is read later +// for (var $loop1 = , $loopend = ; $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=" - VarStat:=CreateVarStatement(CurLoopEndVarName, - ConvertElement(El.EndExpr,AContext),El); - List.A:=VarStat; - // add "for()" - ForSt:=TJSForStatement(CreateElement(TJSForStatement,El)); - List.B:=ForSt; - // add "LoopVar=;" - 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= + if (not NeedLoopVar) and NeedLoopEndVar then + begin + // for example: + // i:=; + // for (var $le = ; $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=" + 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=" + 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 = ; VariableName <= ; 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 diff --git a/packages/pastojs/tests/tcconverter.pp b/packages/pastojs/tests/tcconverter.pp index ddcb417c24..7d5366ec57 100644 --- a/packages/pastojs/tests/tcconverter.pp +++ b/packages/pastojs/tests/tcconverter.pp @@ -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; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index c132070333..8c0b1ab46a 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -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 = "";', '']), diff --git a/packages/pastojs/tests/tcsrcmap.pas b/packages/pastojs/tests/tcsrcmap.pas index 694b218a8d..aa5bb22723 100644 --- a/packages/pastojs/tests/tcsrcmap.pas +++ b/packages/pastojs/tests/tcsrcmap.pas @@ -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;', ' };',