pastojs: low/high(astring)

git-svn-id: trunk@49472 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1809,6 +1809,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
@@ -14917,6 +14919,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;
@@ -15998,6 +16001,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
@@ -18776,7 +18801,6 @@ procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
 var
   Param, Expr: TPasExpr;
   ParamResolved: TPasResolverResult;
-  Value: TResEvalValue;
   Ranges: TPasExprArray;
   IdentEl: TPasElement;
 begin
@@ -18785,22 +18809,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
@@ -19366,6 +19375,7 @@ var
   Param: TPasExpr;
   ParamResolved: TPasResolverResult;
   C: TClass;
+  bt: TResolverBaseType;
 begin
   if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
     exit(cIncompatible);
@@ -19375,12 +19385,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)
@@ -19436,6 +19449,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];
@@ -19615,6 +19634,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}
@@ -19628,6 +19654,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}

packages/fcl-passrc/tests/tcresolver.pas

@@ -4957,14 +4957,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;
 

packages/pastojs/src/fppas2js.pp

@@ -2025,10 +2025,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;
@@ -2037,6 +2039,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;
@@ -2126,25 +2137,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;
@@ -13739,6 +13743,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);
@@ -19742,6 +19760,7 @@ end;
 
 function TPasToJSConverter.CreateDotSplit(El: TPasElement; Expr: TJSElement
   ): TJSElement;
+// create Expr.split('')
 var
   DotExpr: TJSDotMemberExpression;
   Call: TJSCallExpression;

packages/pastojs/src/pas2jsfiler.pp

@@ -80,7 +80,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}
 

packages/pastojs/tests/tcmodules.pas

@@ -7862,8 +7862,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;',
@@ -7882,6 +7885,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}
   '']);
@@ -7893,7 +7897,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="";',
@@ -7913,6 +7920,7 @@ begin
     '$mod.s = $mod.s;',
     '$mod.s = $mod.s.concat("a", $mod.s);',
     '$mod.s = "úč";',
+    '$mod.i = 1 + $mod.a.length;',
     '']));
 end;