paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 04:17:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: low/high(astring)

Browse Source
This commit is contained in:
mattias 2021-06-03 17:11:04 +00:00
parent 2212fd0fcf
commit 7863f634c7
5 changed files with 105 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -1806,6 +1806,8 @@ type
procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
var MsgType: TMessageType); virtual;
function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
function EvalLengthOfString(ParamResolved: TPasResolverResult;
Param: TPasExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
protected
// generic/specialize
type
@ -14822,6 +14824,7 @@ begin
'0'..'9': i:=i*base+ord(Value[p])-ord('0');
'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
else break;
end;
inc(p);
end;
@ -15903,6 +15906,28 @@ begin
end;
end;
function TPasResolver.EvalLengthOfString(ParamResolved: TPasResolverResult;
Param: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
var
Value: TResEvalValue;
begin
Result:=nil;
if rrfReadable in ParamResolved.Flags then
begin
Value:=Eval(Param,Flags);
if Value=nil then exit;
case Value.Kind of
{$ifdef FPC_HAS_CPSTRING}
revkString:
Result:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
{$endif}
revkUnicodeString:
Result:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
end;
ReleaseEvalValue(Value);
end
end;
procedure TPasResolver.AddGenericTemplateIdentifiers(
GenericTemplateTypes: TFPList; Scope: TPasIdentifierScope);
var
@ -18672,7 +18697,6 @@ procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
var
Param, Expr: TPasExpr;
ParamResolved: TPasResolverResult;
Value: TResEvalValue;
Ranges: TPasExprArray;
IdentEl: TPasElement;
begin
@ -18681,22 +18705,7 @@ begin
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[]);
if ParamResolved.BaseType in btAllStringAndChars then
begin
if rrfReadable in ParamResolved.Flags then
begin
Value:=Eval(Param,Flags);
if Value=nil then exit;
case Value.Kind of
{$ifdef FPC_HAS_CPSTRING}
revkString:
Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
{$endif}
revkUnicodeString:
Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
end;
ReleaseEvalValue(Value);
end
end
Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags)
else if ParamResolved.BaseType=btContext then
begin
if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
@ -19262,6 +19271,7 @@ var
Param: TPasExpr;
ParamResolved: TPasResolverResult;
C: TClass;
bt: TResolverBaseType;
begin
if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
exit(cIncompatible);
@ -19271,12 +19281,15 @@ begin
Param:=Params.Params[0];
ComputeElement(Param,ParamResolved,[]);
Result:=cIncompatible;
if ParamResolved.BaseType in btAllRanges then
bt:=ParamResolved.BaseType;
if bt in btAllRanges then
// e.g. high(char)
Result:=cExact
else if ParamResolved.BaseType=btSet then
else if bt=btSet then
Result:=cExact
else if (ParamResolved.BaseType=btContext) then
else if bt in btAllStrings then
Result:=cExact
else if (bt=btContext) then
begin
C:=ParamResolved.LoTypeEl.ClassType;
if (C=TPasArrayType)
@ -19332,6 +19345,12 @@ begin
ResolvedEl.BaseType:=ResolvedEl.SubType;
ResolvedEl.SubType:=btNone;
end
else if ResolvedEl.BaseType in btAllStrings then
begin
// high(aString)
SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
end
else
;// ordinal: result type is argument type
ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
@ -19511,6 +19530,13 @@ begin
else
Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
end
else if bt in btAllStrings then
begin
if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalInt.CreateValue(1)
else
Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags);
end
else
begin
{$IFDEF VerbosePasResolver}
@ -19524,6 +19550,13 @@ begin
// e.g. type t = 2..10;
Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
end
else if ParamResolved.BaseType in btAllStrings then
begin
if Proc.BuiltIn=bfLow then
Evaluated:=TResEvalInt.CreateValue(1)
else
Evaluated:=EvalLengthOfString(ParamResolved,Param,Flags);
end
else
begin
{$IFDEF VerbosePasResolver}

23
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -4948,14 +4948,21 @@ end;
procedure TTestResolver.TestHighLow;
begin
StartProgram(false);
Add('var');
Add(' bo: boolean;');
Add(' by: byte;');
Add(' ch: char;');
Add('begin');
Add(' for bo:=low(boolean) to high(boolean) do;');
Add(' for by:=low(byte) to high(byte) do;');
Add(' for ch:=low(char) to high(char) do;');
Add([
'const',
' abc = ''abc'';',
'var',
' bo: boolean;',
' by: byte;',
' ch: char;',
' s: string;',
' i: longint = high(abc);',
'begin',
' for bo:=low(boolean) to high(boolean) do;',
' for by:=low(byte) to high(byte) do;',
' for ch:=low(char) to high(char) do;',
' for i:=low(s) to high(s) do;',
'']);
ParseProgram;
end;

37
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -2015,10 +2015,12 @@ type
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;
// js statement list
Procedure AddToStatementList(var First, Last: TJSStatementList;
Add: TJSElement; Src: TPasElement); overload;
Procedure AddToStatementList(St: TJSStatementList; Add: TJSElement; Src: TPasElement); overload;
Procedure PrependToStatementList(var St: TJSElement; Add: TJSElement; PosEl: TPasElement);
// js var
Procedure AddToVarStatement(VarStat: TJSVariableStatement; Add: TJSElement;
Src: TPasElement);
Function CreateValInit(PasType: TPasType; Expr: TPasExpr; El: TPasElement;
@ -2027,6 +2029,15 @@ type
Function CreateVarStatement(const aName: String; Init: TJSElement;
El: TPasElement): TJSVariableStatement; virtual;
Function CreateVarDecl(const aName: String; Init: TJSElement; El: TPasElement): TJSVarDeclaration; virtual;
// misc
Function CreateExternalBracketAccessorCall(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
Function CreateAssignStatement(LeftEl: TPasExpr; AssignContext: TAssignContext): TJSElement; virtual;
Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
AContext: TConvertContext): TJSElement; virtual;
Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
Function CreateDotSplit(El: TPasElement; Expr: TJSElement): TJSElement; virtual;
Function CreatePrecompiledJS(El: TJSElement): string; virtual;
Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
// JS literals
Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
Function CreateLiteralFloat(El: TPasElement; const n: TJSNumber): TJSElement; virtual;
@ -2116,25 +2127,18 @@ type
Procedure AddClassConstructors(FuncContext: TFunctionContext; PosEl: TPasElement); virtual;
Procedure AddClassMessageIds(El: TPasClassType; Src: TJSSourceElements;
FuncContext: TFunctionContext; pbivn: TPas2JSBuiltInName); virtual;
// misc
// callbacks
Function CreateCallback(Expr: TPasExpr; ResolvedEl: TPasResolverResult;
aSafeCall: boolean; AContext: TConvertContext): TJSElement; virtual;
Function CreateSafeCallback(Expr: TPasExpr; JS: TJSElement; AContext: TConvertContext): TJSElement; virtual;
Function CreateExternalBracketAccessorCall(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
Function CreateAssignStatement(LeftEl: TPasExpr; AssignContext: TAssignContext): TJSElement; virtual;
Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
AContext: TConvertContext): TJSElement; virtual;
Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
// property
Function CreatePropertyGet(Prop: TPasProperty; Expr: TPasExpr;
AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual;
Function AppendPropertyAssignArgs(Call: TJSCallExpression; Prop: TPasProperty;
AssignContext: TAssignContext; PosEl: TPasElement): TJSCallExpression; virtual;
Function AppendPropertyReadArgs(Call: TJSCallExpression; Prop: TPasProperty;
aContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
Function CreateDotSplit(El: TPasElement; Expr: TJSElement): TJSElement; virtual;
Function CreatePrecompiledJS(El: TJSElement): string; virtual;
Function CreateRaisePropReadOnly(PosEl: TPasElement): TJSElement; virtual;
Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
// create elements for RTTI
Function CreateTypeInfoRef(El: TPasType; AContext: TConvertContext;
ErrorEl: TPasElement): TJSElement; virtual;
@ -13687,6 +13691,20 @@ begin
exit;
end;
end;
btString:
begin
writeln('AAA1 TPasToJSConverter.ConvertBuiltIn_LowHigh ',IsLow);
if isLow then
// low(aString) -> 1
Result:=CreateLiteralNumber(El,1)
else
begin
// high(aString) -> aString.length
Result:=ConvertExpression(Param,AContext);
Result:=CreateDotNameExpr(El,Result,'length');
end;
exit;
end;
end;
DoError(20170210110717,nXExpectedButYFound,sXExpectedButYFound,['enum or array',
AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
@ -19672,6 +19690,7 @@ end;
function TPasToJSConverter.CreateDotSplit(El: TPasElement; Expr: TJSElement
): TJSElement;
// create Expr.split('')
var
DotExpr: TJSDotMemberExpression;
Call: TJSCallExpression;

2
compiler/packages/pastojs/src/pas2jsfiler.pp
View File

@ -81,7 +81,7 @@ unit Pas2JsFiler;
{$mode objfpc}{$H+}
{$IF FPC_FULLVERSION>30200}
{$IF FPC_FULLVERSION>=30300}
{$WARN 6060 off : case statement does not handle all possible cases}
{$ENDIF}

8
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -7815,8 +7815,11 @@ begin
' c = string(''ä'');',
' d = UnicodeString(''b'');',
' e = UnicodeString(''ö'');',
' f = low(a)+high(b);',
' g: word = low(a);',
'var',
' s: string = ''abc'';',
' i: longint;',
'begin',
' s:='''';',
' s:=#13#10;',
@ -7835,6 +7838,7 @@ begin
' s:=concat(s);',
' s:=concat(s,''a'',s);',
' s:=#250#269;',
' i:=low(s)+high(a);',
//' s:=#$2F804;',
// ToDo: \uD87E\uDC04 -> \u{2F804}
'']);
@ -7846,7 +7850,10 @@ begin
'this.c = "ä";',
'this.d = "b";',
'this.e = "ö";',
'this.f = 1 + this.b.length;',
'this.g = 1;',
'this.s="abc";',
'this.i = 0;',
'']),
LinesToStr([
'$mod.s="";',
@ -7866,6 +7873,7 @@ begin
'$mod.s = $mod.s;',
'$mod.s = $mod.s.concat("a", $mod.s);',
'$mod.s = "úč";',
'$mod.i = 1 + $mod.a.length;',
'']));
end;