diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index f8a1c71196..e98d0f4764 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -260,6 +260,7 @@ Works: - array[rg], low(array), high(array), length(array) ToDos: +- remove hasOwnProperty from rtl set functions - typecast longint(highprecint) -> (value+0) & $ffffffff - static arrays - a[] of record @@ -9446,7 +9447,20 @@ begin Result:=CreateLiteralString(El,TResEvalString(Value).S); revkUnicodeString: Result:=CreateLiteralJSString(El,TResEvalUTF16(Value).S); + revkSetOfInt: + if Value.IdentEl is TPasExpr then + Result:=ConvertElement(Value.IdentEl,AContext) + else + begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertConstValue Value=',Value.AsDebugString,' IdentEl=',GetObjName(Value.IdentEl)); + {$ENDIF} + RaiseNotSupported(El,AContext,20171221125842); + end else + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertConstValue Value=',Value.AsDebugString); + {$ENDIF} RaiseNotSupported(El,AContext,20170910211951); end; end; @@ -10578,7 +10592,10 @@ type ikBool, ikChar, ikString, - ikArray + ikArray, + ikSetInt, + ikSetBool, + ikSetChar ); function ConvExpr(Expr: TPasExpr): TJSElement; overload; @@ -10649,17 +10666,19 @@ type end; var + FuncContext: TConvertContext; ResolvedVar, ResolvedIn: TPasResolverResult; StartValue, EndValue, InValue: TResEvalValue; StartInt, EndInt: MaxPrecInt; HasLoopVar, HasEndVar, HasInVar: Boolean; InKind: TInKind; - procedure InitWithResolver; + function InitWithResolver: boolean; var EnumType: TPasEnumType; TypeEl: TPasType; begin + Result:=true; AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]); if not (ResolvedVar.IdentEl is TPasVariable) then DoError(20170213214404,nExpectedXButFoundY,sExpectedXButFoundY,['var', @@ -10687,7 +10706,9 @@ var begin if length(TPasArrayType(TypeEl).Ranges)=1 then InValue:=AContext.Resolver.Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]); - end; + end + else if TypeEl is TPasSetType then + InValue:=AContext.Resolver.EvalTypeRange(TPasSetType(TypeEl).EnumType,[refConst]); end; end; if InValue<>nil then @@ -10707,8 +10728,26 @@ var EndInt:=length(TResEvalUTF16(InValue).S)-1; ReleaseEvalValue(InValue); end; - revkRangeInt: + revkRangeInt,revkSetOfInt: begin + if InValue.Kind=revkSetOfInt then + begin + if length(TResEvalSet(InValue).Ranges)=0 then + exit(false); + if length(TResEvalSet(InValue).Ranges)>1 then + begin + // set, non continuous range + case TResEvalSet(InValue).ElKind of + revskEnum,revskInt: InKind:=ikSetInt; + revskChar: InKind:=ikSetChar; + revskBool: InKind:=ikSetBool; + end; + HasInVar:=false; + HasLoopVar:=InKind<>ikSetInt; + HasEndVar:=false; + exit; + end; + end; StartInt:=TResEvalRangeInt(InValue).RangeStart; EndInt:=TResEvalRangeInt(InValue).RangeEnd; HasInVar:=false; @@ -10724,6 +10763,8 @@ var StartValue:=GetEnumValue(EnumType,StartInt); EndValue:=GetEnumValue(EnumType,EndInt); end; + revskInt: + InKind:=ikNone; revskChar: InKind:=ikChar; revskBool: @@ -10775,6 +10816,26 @@ var {$ENDIF} RaiseNotSupported(El.StartExpr,AContext,20171113012226); end; + end + else if ResolvedIn.BaseType=btSet then + begin + if ResolvedIn.SubType in btAllBooleans then + InKind:=ikSetBool + else if ResolvedIn.SubType in btAllChars then + InKind:=ikSetChar + else + InKind:=ikSetInt; + HasInVar:=false; + HasLoopVar:=InKind<>ikSetInt; + HasEndVar:=false; + exit; + end + else + begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertForStatement.InitWithResolver ResolvedIn=',GetResolverResultDbg(ResolvedIn)); + {$ENDIF} + RaiseNotSupported(El.StartExpr,AContext,20171220221747); end; end else @@ -10818,14 +10879,13 @@ var end; Var - ForSt : TJSForStatement; + ForSt : TJSBodyStatement; List: TJSStatementList; SimpleAss : TJSSimpleAssignStatement; Incr: TJSUNaryExpression; BinExp : TJSBinaryExpression; VarStat: TJSVariableStatement; CurLoopVarName, CurEndVarName, CurInVarName: String; - FuncContext: TConvertContext; PosEl: TPasElement; Statements, V: TJSElement; Call: TJSCallExpression; @@ -10863,7 +10923,9 @@ begin HasEndVar:=true; HasInVar:=false; if AContext.Resolver<>nil then - InitWithResolver; + begin + if not InitWithResolver then exit; + end; // create unique var names $l, $end, $in if HasInVar then CurInVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopIn]) @@ -10879,8 +10941,12 @@ begin CurEndVarName:=''; // add "for()" - ForSt:=TJSForStatement(CreateElement(TJSForStatement,El)); + if InKind in [ikSetInt,ikSetBool,ikSetChar] then + ForSt:=TJSForInStatement(CreateElement(TJSForInStatement,El)) + else + ForSt:=TJSForStatement(CreateElement(TJSForStatement,El)); Statements:=ForSt; + PosEl:=El; // add in front of for(): variable= if (not HasLoopVar) and (HasEndVar or HasInVar) then @@ -10901,16 +10967,31 @@ begin PosEl:=El.StartExpr; end; - if HasLoopVar or HasEndVar or HasInVar then + if ForSt.ClassType=TJSForInStatement then + begin + if HasLoopVar then + begin + // add for("var $l" in ) + VarStat:=TJSVariableStatement(CreateElement(TJSVariableStatement,PosEl)); + VarStat.A:=CreatePrimitiveDotExpr(CurLoopVarName,PosEl); + TJSForInStatement(ForSt).LHS:=VarStat; + end + else + // add for("" in ) + TJSForInStatement(ForSt).LHS:=ConvertElement(El.VariableName,AContext); + // add for( in "") + TJSForInStatement(ForSt).List:=ConvertElement(El.StartExpr,AContext); + end + else if HasLoopVar or HasEndVar or HasInVar then begin // add "for(var ..." VarStat:=TJSVariableStatement(CreateElement(TJSVariableStatement,El)); - ForSt.Init:=VarStat; + TJSForStatement(ForSt).Init:=VarStat; if HasInVar then begin // add "$in=" PosEl:=El.StartExpr; - if InValue<>nil then + if (InValue<>nil) and (InValue.Kind<>revkSetOfInt) then V:=ConvertConstValue(InValue,AContext,PosEl) else V:=ConvertElement(El.StartExpr,AContext); @@ -10973,7 +11054,7 @@ begin // No new vars. For example: // for (VariableName = ; VariableName <= ; VariableName++) SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.VariableName)); - ForSt.Init:=SimpleAss; + TJSForStatement(ForSt).Init:=SimpleAss; SimpleAss.LHS:=ConvertElement(El.VariableName,AContext); if StartValue<>nil then SimpleAss.Expr:=CreateLiteralNumber(El.StartExpr,StartInt) @@ -10982,33 +11063,36 @@ begin PosEl:=El.StartExpr; end; - // add "$l<=$end" - if (El.EndExpr<>nil) then - PosEl:=El.EndExpr; - if El.Down then - BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,PosEl)) - else - BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,PosEl)); - ForSt.Cond:=BinExp; - if HasLoopVar then - BinExp.A:=CreatePrimitiveDotExpr(CurLoopVarName,PosEl) - else - BinExp.A:=ConvertElement(El.VariableName,AContext); - if HasEndVar then - BinExp.B:=CreatePrimitiveDotExpr(CurEndVarName,PosEl) - else - BinExp.B:=CreateLiteralNumber(PosEl,EndInt); + if ForSt.ClassType=TJSForStatement then + begin + // add "$l<=$end" + if (El.EndExpr<>nil) then + PosEl:=El.EndExpr; + if El.Down then + BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,PosEl)) + else + BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,PosEl)); + TJSForStatement(ForSt).Cond:=BinExp; + if HasLoopVar then + BinExp.A:=CreatePrimitiveDotExpr(CurLoopVarName,PosEl) + else + BinExp.A:=ConvertElement(El.VariableName,AContext); + if HasEndVar then + BinExp.B:=CreatePrimitiveDotExpr(CurEndVarName,PosEl) + else + BinExp.B:=CreateLiteralNumber(PosEl,EndInt); - // add "$l++" - if El.Down then - Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,PosEl)) - else - Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,PosEl)); - ForSt.Incr:=Incr; - if HasLoopVar then - Incr.A:=CreatePrimitiveDotExpr(CurLoopVarName,PosEl) - else - Incr.A:=ConvertElement(El.VariableName,AContext); + // add "$l++" + if El.Down then + Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,PosEl)) + else + Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,PosEl)); + TJSForStatement(ForSt).Incr:=Incr; + if HasLoopVar then + Incr.A:=CreatePrimitiveDotExpr(CurLoopVarName,PosEl) + else + Incr.A:=ConvertElement(El.VariableName,AContext); + end; // add "VariableName:=$l;" if HasLoopVar then @@ -11025,11 +11109,11 @@ begin begin if InKind<>ikNone then case InKind of - ikEnum: ; - ikBool: + ikEnum,ikSetInt: ; + ikBool,ikSetBool: // $in!==0; SimpleAss.Expr:=CreateStrictNotEqual0(SimpleAss.Expr,PosEl); - ikChar: + ikChar,ikSetChar: // String.fromCharCode($l) SimpleAss.Expr:=CreateCallFromCharCode(SimpleAss.Expr,PosEl); ikString: diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index e256203e8b..547433c88a 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -206,6 +206,8 @@ type Procedure TestDouble; Procedure TestIntegerRange; Procedure TestForBoolDo; + Procedure TestForIntDo; + Procedure TestForIntInDo; // strings Procedure TestCharConst; @@ -282,6 +284,7 @@ type Procedure TestSet_ConstEnum; Procedure TestSet_ConstChar; Procedure TestSet_ConstInt; + Procedure TestSet_ForIn; // statements Procedure TestNestBegin; @@ -3308,22 +3311,23 @@ end; procedure TTestModule.TestSet; begin StartProgram(false); - Add('type'); - Add(' TColor = (Red, Green, Blue);'); - Add(' TColors = set of TColor;'); - Add('var'); - Add(' c: TColor;'); - Add(' s: TColors;'); - Add(' t: TColors = [];'); - Add(' u: TColors = [Red];'); - Add('begin'); - Add(' s:=[];'); - Add(' s:=[Green];'); - Add(' s:=[Green,Blue];'); - Add(' s:=[Red..Blue];'); - Add(' s:=[Red,Green..Blue];'); - Add(' s:=[Red,c];'); - Add(' s:=t;'); + Add([ + 'type', + ' TColor = (Red, Green, Blue);', + ' TColors = set of TColor;', + 'var', + ' c: TColor;', + ' s: TColors;', + ' t: TColors = [];', + ' u: TColors = [Red];', + 'begin', + ' s:=[];', + ' s:=[Green];', + ' s:=[Green,Blue];', + ' s:=[Red..Blue];', + ' s:=[Red,Green..Blue];', + ' s:=[Red,c];', + ' s:=t;']); ConvertProgram; CheckSource('TestEnumName', LinesToStr([ // statements @@ -3892,6 +3896,56 @@ begin ''])); end; +procedure TTestModule.TestSet_ForIn; +begin + StartProgram(false); + Add([ + 'type', + ' TEnum = (Red, Green, Blue);', + ' TEnumRg = green..blue;', + ' TSetOfEnum = set of TEnum;', + ' TSetOfEnumRg = set of TEnumRg;', + 'var', + ' e, e2: TEnum;', + ' er: TEnum;', + ' s: TSetOfEnum;', + 'begin', + ' for e in TSetOfEnum do ;', + ' for e in TSetOfEnumRg do ;', + ' for e in [] do e2:=e;', + ' for e in [red..green] do e2:=e;', + ' for e in [green,blue] do e2:=e;', + ' for e in [red,blue] do e2:=e;', + ' for e in s do e2:=e;', + ' for er in TSetOfEnumRg do ;', + '']); + ConvertProgram; + CheckSource('TestEnumName', + LinesToStr([ // statements + 'this.TEnum = {', + ' "0":"Red",', + ' Red:0,', + ' "1":"Green",', + ' Green:1,', + ' "2":"Blue",', + ' Blue:2', + ' };', + 'this.e = 0;', + 'this.e2 = 0;', + 'this.er = 0;', + 'this.s = {};', + '']), + LinesToStr([ + 'for ($mod.e = 0; $mod.e <= 2; $mod.e++) ;', + 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) ;', + 'for ($mod.e = 0; $mod.e <= 1; $mod.e++) $mod.e2 = $mod.e;', + 'for ($mod.e = 1; $mod.e <= 2; $mod.e++) $mod.e2 = $mod.e;', + 'for ($mod.e in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Blue)) $mod.e2 = $mod.e;', + 'for ($mod.e in $mod.s) $mod.e2 = $mod.e;', + 'for ($mod.er = 1; $mod.er <= 2; $mod.er++) ;', + ''])); +end; + procedure TTestModule.TestNestBegin; begin StartProgram(false); @@ -4216,6 +4270,83 @@ begin ''])); end; +procedure TTestModule.TestForIntDo; +begin + StartProgram(false); + Add([ + 'var i: longint;', + 'begin', + ' for i:=3 to 5 do ;', + ' for i:=i downto 2 do ;', + ' for i in byte do ;', + '']); + ConvertProgram; + CheckSource('TestForIntDo', + LinesToStr([ // statements + 'this.i = 0;']), + LinesToStr([ // this.$main + 'for ($mod.i = 3; $mod.i <= 5; $mod.i++) ;', + 'for (var $l1 = $mod.i; $l1 >= 2; $l1--) $mod.i = $l1;', + 'for (var $l2 = 0; $l2 <= 255; $l2++) $mod.i = $l2;', + ''])); +end; + +procedure TTestModule.TestForIntInDo; +begin + StartProgram(false); + Add([ + 'type', + ' TSetOfInt = set of byte;', + ' TIntRg = 3..7;', + ' TSetOfIntRg = set of TIntRg;', + 'var', + ' i,i2: longint;', + ' a1: array of byte;', + ' a2: array[1..3] of byte;', + ' soi: TSetOfInt;', + ' soir: TSetOfIntRg;', + ' ir: TIntRg;', + 'begin', + ' for i in byte do ;', + ' for i in a1 do ;', + ' for i in a2 do ;', + ' for i in [11..13] do ;', + ' for i in TSetOfInt do ;', + ' for i in TIntRg do ;', + ' for i in soi do i2:=i;', + ' for i in TSetOfIntRg do ;', + ' for i in soir do ;', + ' for ir in TIntRg do ;', + ' for ir in TSetOfIntRg do ;', + ' for ir in soir do ;', + '']); + ConvertProgram; + CheckSource('TestForIntInDo', + LinesToStr([ // statements + 'this.i = 0;', + 'this.i2 = 0;', + 'this.a1 = [];', + 'this.a2 = rtl.arraySetLength(null, 0, 3);', + 'this.soi = {};', + 'this.soir = {};', + 'this.ir = 3;', + '']), + LinesToStr([ // this.$main + 'for (var $l1 = 0; $l1 <= 255; $l1++) $mod.i = $l1;', + 'for (var $in2 = $mod.a1, $l3 = 0, $end4 = rtl.length($in2) - 1; $l3 <= $end4; $l3++) $mod.i = $in2[$l3];', + 'for (var $in5 = $mod.a2, $l6 = 0, $end7 = rtl.length($in5) - 1; $l6 <= $end7; $l6++) $mod.i = $in5[$l6];', + 'for (var $l8 = 11; $l8 <= 13; $l8++) $mod.i = $l8;', + 'for (var $l9 = 0; $l9 <= 255; $l9++) $mod.i = $l9;', + 'for (var $l10 = 3; $l10 <= 7; $l10++) $mod.i = $l10;', + 'for ($mod.i in $mod.soi) $mod.i2 = $mod.i;', + 'for (var $l11 = 3; $l11 <= 7; $l11++) $mod.i = $l11;', + 'for ($mod.i in $mod.soir) ;', + 'for (var $l12 = 3; $l12 <= 7; $l12++) $mod.ir = $l12;', + 'for (var $l13 = 3; $l13 <= 7; $l13++) $mod.ir = $l13;', + 'for ($mod.ir in $mod.soir) ;', + ''])); +end; + procedure TTestModule.TestCharConst; begin StartProgram(false); @@ -4662,11 +4793,10 @@ begin ' TSetOfCharRg = set of TCharRg;', 'const Foo = ''foo'';', 'var', - ' c: char;', + ' c,c2: char;', ' s: string;', ' a1: array of char;', ' a2: array[1..3] of char;', - ' a3: array[1..3,4..5] of char;', ' soc: TSetOfChar;', ' socr: TSetOfCharRg;', ' cr: TCharRg;', @@ -4674,28 +4804,27 @@ begin ' for c in foo do ;', ' for c in s do ;', ' for c in char do ;', - //' for c in a1 do ;', - //' for c in a2 do ;', - //' for c in a3 do ;', - //' for c in [''1''..''3''] do ;', - //' for c in TSetOfChar do ;', - //' for c in TCharRg do ;', - //' for c in soc do ;', - //' for c in TSetOfCharRg do ;', - //' for c in socr do ;', - //' for cr in TCharRg do ;', - //' for cr in TSetOfCharRg do ;', - //' for cr in socr do ;', + ' for c in a1 do ;', + ' for c in a2 do ;', + ' for c in [''1''..''3''] do ;', + ' for c in TSetOfChar do ;', + ' for c in TCharRg do ;', + ' for c in soc do c2:=c;', + ' for c in TSetOfCharRg do ;', + ' for c in socr do ;', + ' for cr in TCharRg do ;', + ' for cr in TSetOfCharRg do ;', + ' for cr in socr do ;', '']); ConvertProgram; CheckSource('TestForCharInDo', LinesToStr([ // statements 'this.Foo = "foo";', 'this.c = "";', + 'this.c2 = "";', 'this.s = "";', 'this.a1 = [];', 'this.a2 = rtl.arraySetLength(null, "", 3);', - 'this.a3 = rtl.arraySetLength(null, "", 3, 2);', 'this.soc = {};', 'this.socr = {};', 'this.cr = "a";', @@ -4704,6 +4833,20 @@ begin 'for (var $in1 = $mod.Foo, $l2 = 0, $end3 = $in1.length - 1; $l2 <= $end3; $l2++) $mod.c = $in1.charAt($l2);', 'for (var $in4 = $mod.s, $l5 = 0, $end6 = $in4.length - 1; $l5 <= $end6; $l5++) $mod.c = $in4.charAt($l5);', 'for (var $l7 = 0; $l7 <= 65535; $l7++) $mod.c = String.fromCharCode($l7);', + 'for (var $in8 = $mod.a1, $l9 = 0, $end10 = rtl.length($in8) - 1; $l9 <= $end10; $l9++) $mod.c = $in8[$l9];', + 'for (var $in11 = $mod.a2, $l12 = 0, $end13 = rtl.length($in11) - 1; $l12 <= $end13; $l12++) $mod.c = $in11[$l12];', + 'for (var $l14 = 49; $l14 <= 51; $l14++) $mod.c = String.fromCharCode($l14);', + 'for (var $l15 = 0; $l15 <= 65535; $l15++) $mod.c = String.fromCharCode($l15);', + 'for (var $l16 = 97; $l16 <= 122; $l16++) $mod.c = String.fromCharCode($l16);', + 'for (var $l17 in $mod.soc) {', + ' $mod.c = String.fromCharCode($l17);', + ' $mod.c2 = $mod.c;', + '};', + 'for (var $l18 = 97; $l18 <= 122; $l18++) $mod.c = String.fromCharCode($l18);', + 'for (var $l19 in $mod.socr) $mod.c = String.fromCharCode($l19);', + 'for (var $l20 = 97; $l20 <= 122; $l20++) $mod.cr = String.fromCharCode($l20);', + 'for (var $l21 = 97; $l21 <= 122; $l21++) $mod.cr = String.fromCharCode($l21);', + 'for (var $l22 in $mod.socr) $mod.cr = String.fromCharCode($l22);', ''])); end;