diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 74df4fbad3..542cd73563 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -172,6 +172,7 @@ Works: - mode delphi: functype=funcresulttype - nested functions - reference to + - @@ compare method in delphi mode - class-of - assign := nil, var - call class method @@ -251,6 +252,17 @@ ToDos: - ignore attributes - constant evaluation - static arrays + - error on "arr:=nil" + - error on "if arr=nil then" + - error on "if Assigned(arr) then" + - error on "setlength(arr,2)" + - a[int] + - a[boolean] + - a[enum] + - a[char] + - a[][] + - const + - RTTI - property index specifier - RTTI - stored false/true @@ -262,7 +274,6 @@ ToDos: - var absolute - FuncName:= (instead of Result:=) - check memleaks -- @@ compare method in delphi mode - make records more lightweight - enumeration for..in..do - pointer of record @@ -5066,7 +5077,13 @@ var i, ArgNo: Integer; Arg: TJSElement; OldAccess: TCtxAccess; + Ranges: TPasExprArray; + Int: MaxPrecInt; + Param: TPasExpr; + ArgAdjusted: TJSAdditiveExpression; + Value: TResEvalValue; begin + Arg:=nil; B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El)); try // add read accessor @@ -5079,19 +5096,72 @@ var ArgNo:=0; repeat // Note: dynamic array has length(ArrayEl.Ranges)=0 - for i:=1 to Max(length(ArrayEl.Ranges),1) do + Ranges:=ArrayEl.Ranges; + for i:=1 to Max(length(Ranges),1) do begin // add parameter + Param:=El.Params[ArgNo]; ArgContext.Access:=caRead; - Arg:=ConvertElement(El.Params[ArgNo],ArgContext); + Arg:=ConvertElement(Param,ArgContext); ArgContext.Access:=OldAccess; + + if i<=length(Ranges) then + begin + // static array + Value:=ArgContext.Resolver.EvalRangeLimit(Ranges[i-1],[refConst],true,El); + if Value=nil then + RaiseNotSupported(Param,ArgContext,20170910163341); + case Value.Kind of + revkBool: + Int:=ord(TResEvalBool(Value).B); + revkEnum: + Int:=TResEvalEnum(Value).Index; + revkInt: + Int:=TResEvalInt(Value).Int; + // revkString + // revkUnicodeString + else + ReleaseEvalValue(Value); + RaiseNotSupported(Param,ArgContext,20170910170446); + end; + if Int<>0 then + begin + if (Arg is TJSLiteral) and (TJSLiteral(Arg).Value.ValueType=jstNumber) then + // parameter is single number -> simply subtract the offset + TJSLiteral(Arg).Value.AsNumber:=TJSLiteral(Arg).Value.AsNumber-Int + else + begin + // parameter is an expression -> add offset + if Int>0 then + begin + // Arg-Offset + ArgAdjusted:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param)); + ArgAdjusted.A:=Arg; + ArgAdjusted.B:=CreateLiteralNumber(Param,Int); + Arg:=ArgAdjusted; + end + else + begin + // Arg+Offset + ArgAdjusted:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param)); + ArgAdjusted.A:=Arg; + ArgAdjusted.B:=CreateLiteralNumber(Param,-Int); + Arg:=ArgAdjusted; + end; + end; + end; + ReleaseEvalValue(Value); + end; + if B.Name<>nil then begin + // nested [][] Sub:=B; B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El)); B.MExpr:=Sub; end; B.Name:=Arg; + Arg:=nil; inc(ArgNo); if ArgNo>length(El.Params) then RaiseInconsistency(20170206180553); @@ -5104,7 +5174,10 @@ var Result:=B; finally if Result=nil then + begin + Arg.Free; B.Free; + end; end; end; @@ -5389,9 +5462,11 @@ begin writeln('TPasToJSConverter.ConvertArrayParams Value=',GetResolverResultDbg(ResolvedEl)); {$ENDIF} if ResolvedEl.BaseType in btAllJSStrings then + // astring[] ConvertStringBracket else if (ResolvedEl.IdentEl is TPasProperty) and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then + // aproperty[] ConvertIndexedProperty(TPasProperty(ResolvedEl.IdentEl),AContext) else if ResolvedEl.BaseType=btContext then begin @@ -5401,18 +5476,21 @@ begin aClass:=TPasClassType(TypeEl); ClassScope:=aClass.CustomData as TPas2JSClassScope; if ClassScope.DefaultProperty<>nil then + // anObject[] ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty) else RaiseInconsistency(20170206180448); end else if TypeEl.ClassType=TPasClassOfType then begin + // aClass[] ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPas2JSClassScope; if ClassScope.DefaultProperty=nil then RaiseInconsistency(20170206180503); ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty); end else if TypeEl.ClassType=TPasArrayType then + // anArray[] ConvertArray(TPasArrayType(TypeEl)) else RaiseNotSupported(El,AContext,20170206181220,GetResolverResultDbg(ResolvedEl)); @@ -6603,10 +6681,11 @@ function TPasToJSConverter.ConvertBuiltIn_Low(El: TParamsExpr; end; var - ResolvedEl, RangeResolved: TPasResolverResult; + ResolvedEl: TPasResolverResult; Param: TPasExpr; TypeEl: TPasType; Ranges: TPasExprArray; + Value: TResEvalValue; begin Result:=nil; if AContext.Resolver=nil then @@ -6634,29 +6713,33 @@ begin else if TypeEl.ClassType=TPasArrayType then begin Ranges:=TPasArrayType(TypeEl).Ranges; + writeln('TPasToJSConverter.ConvertBuiltIn_Low AAA1'); if length(Ranges)=0 then begin + // dynamic array starts at 0 Result:=CreateLiteralNumber(El,0); exit; end - else if length(Ranges)=1 then + else begin - AContext.Resolver.ComputeElement(Ranges[0],RangeResolved,[rcConstant]); - if RangeResolved.BaseType=btContext then - begin - if RangeResolved.IdentEl is TPasEnumType then - begin - CreateEnumValue(TPasEnumType(RangeResolved.IdentEl)); - exit; - end; - end - else if RangeResolved.BaseType=btBoolean then - begin - Result:=CreateLiteralBoolean(El,LowJSBoolean); - exit; - end; + // static array + Value:=AContext.Resolver.EvalRangeLimit(Ranges[0],[refConst],true,El); + if Value=nil then + RaiseNotSupported(El,AContext,20170910160817); + case Value.Kind of + revkBool: + Result:=CreateLiteralBoolean(El,TResEvalBool(Value).B); + revkEnum: + Result:=CreateReferencePathExpr(TResEvalEnum(Value).GetEnumValue,AContext); + revkInt: + Result:=CreateLiteralNumber(El,TResEvalInt(Value).Int); + else + ReleaseEvalValue(Value); + RaiseNotSupported(El,AContext,20170222231008); + end; + ReleaseEvalValue(Value); + exit; end; - RaiseNotSupported(El,AContext,20170222231008); end; end; btChar, @@ -6702,12 +6785,13 @@ function TPasToJSConverter.ConvertBuiltIn_High(El: TParamsExpr; end; var - ResolvedEl, RangeResolved: TPasResolverResult; - Param, Range: TPasExpr; + ResolvedEl: TPasResolverResult; + Param: TPasExpr; TypeEl: TPasType; MinusExpr: TJSAdditiveExpressionMinus; Call: TJSCallExpression; - aMinValue, aMaxValue: int64; + Value: TResEvalValue; + Ranges: TPasExprArray; begin Result:=nil; if AContext.Resolver=nil then @@ -6734,7 +6818,8 @@ begin end else if TypeEl.ClassType=TPasArrayType then begin - if length(TPasArrayType(TypeEl).Ranges)=0 then + Ranges:=TPasArrayType(TypeEl).Ranges; + if length(Ranges)=0 then begin // dynamic array -> rtl.length(Param)-1 Result:=ConvertElement(Param,AContext); @@ -6748,32 +6833,26 @@ begin Result:=MinusExpr; exit; end - else if length(TPasArrayType(TypeEl).Ranges)=1 then + else begin // static array - Range:=TPasArrayType(TypeEl).Ranges[0]; - AContext.Resolver.ComputeElement(Range,RangeResolved,[rcConstant]); - if RangeResolved.BaseType=btContext then - begin - if RangeResolved.IdentEl is TPasEnumType then - begin - CreateEnumValue(TPasEnumType(RangeResolved.IdentEl)); - exit; - end; - end - else if RangeResolved.BaseType=btBoolean then - begin - Result:=CreateLiteralBoolean(Param,HighJSBoolean); - exit; - end - else if RangeResolved.BaseType in btAllJSInteger then - begin - ComputeRange(RangeResolved,AContext,aMinValue,aMaxValue,Range); - Result:=CreateLiteralNumber(Param,aMaxValue); - exit; - end; + Value:=AContext.Resolver.EvalRangeLimit(Ranges[0],[refConst],false,El); + if Value=nil then + RaiseNotSupported(El,AContext,20170910161555); + case Value.Kind of + revkBool: + Result:=CreateLiteralBoolean(El,TResEvalBool(Value).B); + revkEnum: + Result:=CreateReferencePathExpr(TResEvalEnum(Value).GetEnumValue,AContext); + revkInt: + Result:=CreateLiteralNumber(El,TResEvalInt(Value).Int); + else + ReleaseEvalValue(Value); + RaiseNotSupported(El,AContext,20170910161553); + end; + ReleaseEvalValue(Value); + exit; end; - RaiseNotSupported(El,AContext,20170222231101); end; end; btBoolean: diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index f3c59c26b6..75e10c7d07 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -295,6 +295,8 @@ type Procedure TestArray_Dynamic; Procedure TestArray_Dynamic_Nil; Procedure TestArray_DynMultiDimensional; + Procedure TestArray_StaticInt; + Procedure TestArray_StaticMultiDim; // ToDo Procedure TestArrayOfRecord; // ToDo: Procedure TestArrayOfSet; Procedure TestArray_AsParams; @@ -4851,6 +4853,91 @@ begin ''])); end; +procedure TTestModule.TestArray_StaticInt; +begin + StartProgram(false); + Add('type'); + Add(' TArrayInt = array[2..4] of longint;'); + Add('var'); + Add(' Arr: TArrayInt;'); + Add(' i: longint;'); + Add(' b: boolean;'); + Add('begin'); + Add(' arr[2]:=4;'); + Add(' arr[3]:=arr[2]+arr[3];'); + Add(' arr[i]:=5;'); + Add(' arr[arr[i]]:=arr[high(arr)];'); + Add(' i:=low(arr);'); + Add(' i:=high(arr);'); + Add(' b:=arr[2]=arr[3];'); + ConvertProgram; + CheckSource('TestArray_StaticInt', + LinesToStr([ // statements + 'this.Arr = rtl.arrayNewMultiDim([3],0);', + 'this.i = 0;', + 'this.b = false;' + ]), + LinesToStr([ // $mod.$main + '$mod.Arr[0] = 4;', + '$mod.Arr[1] = $mod.Arr[0] + $mod.Arr[1];', + '$mod.Arr[$mod.i-2] = 5;', + '$mod.Arr[$mod.Arr[$mod.i-2]-2] = $mod.Arr[2];', + '$mod.i = 2;', + '$mod.i = 4;', + '$mod.b = $mod.Arr[0] === $mod.Arr[1];', + ''])); +end; + +procedure TTestModule.TestArray_StaticMultiDim; +begin + exit; + StartProgram(false); + Add('type'); + Add(' TArrayInt = array[1..3] of longint;'); + Add(' TArrayArrayInt = array[5..6] of TArrayInt;'); + Add('var'); + Add(' Arr: TArrayInt;'); + Add(' Arr2: TArrayArrayInt;'); + Add(' i: longint;'); + Add('begin'); + Add(' i:=low(arr);'); + Add(' i:=low(arr2);'); + Add(' i:=low(arr2[5]);'); + Add(' i:=high(arr);'); + Add(' i:=high(arr2);'); + Add(' i:=high(arr2[6]);'); + Add(' arr2[3]:=arr;'); + Add(' arr2[4][5]:=i;'); + Add(' i:=arr2[6][7];'); + Add(' arr2[8,9]:=i;'); + Add(' i:=arr2[10,11];'); + Add(' SetLength(arr2,14);'); + Add(' SetLength(arr2[15],16);'); + ConvertProgram; + CheckSource('TestArray_StaticMultiDim', + LinesToStr([ // statements + 'this.Arr = [];', + 'this.Arr2 = [];', + 'this.i = 0;' + ]), + LinesToStr([ // $mod.$main + '$mod.Arr2 = [];', + 'if (rtl.length($mod.Arr2) === 0) ;', + 'if (rtl.length($mod.Arr2) === 0) ;', + '$mod.i = 0;', + '$mod.i = 0;', + '$mod.i = rtl.length($mod.Arr2) - 1;', + '$mod.i = rtl.length($mod.Arr2[2]) - 1;', + '$mod.Arr2[3] = $mod.Arr;', + '$mod.Arr2[4][5] = $mod.i;', + '$mod.i = $mod.Arr2[6][7];', + '$mod.Arr2[8][9] = $mod.i;', + '$mod.i = $mod.Arr2[10][11];', + '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, 14, []);', + '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 16, 0);', + ''])); +end; + procedure TTestModule.TestArrayOfRecord; begin StartProgram(false); @@ -5092,7 +5179,7 @@ begin Add('begin'); Add(' e:=low(a);'); Add(' e:=high(a);'); - Add(' i:=a[red]+length(a);'); + Add(' i:=a[red];'); Add(' a[e]:=a[e];'); ConvertProgram; CheckSource('TestArrayEnumTypeRange', @@ -5112,7 +5199,7 @@ begin LinesToStr([ // $mod.$main '$mod.e = $mod.TEnum.red;', '$mod.e = $mod.TEnum.blue;', - '$mod.i = $mod.a[$mod.TEnum.red]+2;', + '$mod.i = $mod.a[$mod.TEnum.red];', '$mod.a[$mod.e] = $mod.a[$mod.e];', ''])); end;