paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 11:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: low(), high(), [] for static array with integer range

Browse Source 
git-svn-id: trunk@37165 -
This commit is contained in:
Mattias Gaertner 2017-09-10 15:08:27 +00:00
parent 2bb0b48b51
commit 4bd77800cb
2 changed files with 215 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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