diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 396f765..010d607 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -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} diff --git a/compiler/packages/fcl-passrc/tests/tcresolver.pas b/compiler/packages/fcl-passrc/tests/tcresolver.pas index 6a42783..5869f83 100644 --- a/compiler/packages/fcl-passrc/tests/tcresolver.pas +++ b/compiler/packages/fcl-passrc/tests/tcresolver.pas @@ -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; diff --git a/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index 16d5167..1be56ab 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -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; diff --git a/compiler/packages/pastojs/src/pas2jsfiler.pp b/compiler/packages/pastojs/src/pas2jsfiler.pp index f4ec0c7..6dc5821 100644 --- a/compiler/packages/pastojs/src/pas2jsfiler.pp +++ b/compiler/packages/pastojs/src/pas2jsfiler.pp @@ -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} diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index b27a275..3650e2a 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -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;