pastojs: implemented varargstring[]:=

git-svn-id: trunk@38023 -

packages/pastojs/src/fppas2js.pp

@@ -5270,9 +5270,9 @@ var
       end;
   end;
 
-  procedure ConvertStringBracket;
+  procedure ConvertStringBracket(const ResolvedValue: TPasResolverResult);
   var
-    Call: TJSCallExpression;
+    SetCharCall, SetStrCall: TJSCallExpression;
     Param: TPasExpr;
     DotExpr: TJSDotMemberExpression;
     AssignContext: TAssignContext;
@@ -5280,58 +5280,91 @@ var
     AssignSt: TJSSimpleAssignStatement;
     OldAccess: TCtxAccess;
     IndexExpr: TJSElement;
+    Arg: TPasArgument;
   begin
+    Result:=nil;
     Param:=El.Params[0];
     case AContext.Access of
     caAssign:
       begin
-      // s[index] := value  ->  s = rtl.setCharAt(s,index,value)
+      // s[index] := value
       AssignContext:=AContext.AccessContext as TAssignContext;
-      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      if AssignContext.RightSide=nil then
+        RaiseInconsistency(20180123192020);
+
+      AssignSt:=nil;
+      SetStrCall:=nil;
+      SetCharCall:=nil;
       try
-        OldAccess:=AContext.Access;
-        AContext.Access:=caRead;
-        AssignSt.LHS:=ConvertElement(El.Value,AContext);
+        // rtl.setCharAt(s,index,value)
         // rtl.setCharAt
-        Call:=CreateCallExpression(El);
-        AssignContext.Call:=Call;
-        AssignSt.Expr:=Call;
-        Elements:=Call.Args.Elements;
-        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSetCharAt]]);
+        SetCharCall:=CreateCallExpression(El);
+        SetCharCall.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSetCharAt]]);
         // first param  s
-        Elements.AddElement.Expr:=ConvertElement(El.Value,AContext);
+        OldAccess:=AContext.Access;
+        AContext.Access:=caRead;
+        SetCharCall.AddArg(ConvertElement(El.Value,AContext));
         // second param  index-1
-        IndexExpr:=ConvertIndexMinus1(Param);
-        Elements.AddElement.Expr:=IndexExpr;
+        SetCharCall.AddArg(ConvertIndexMinus1(Param));
         AContext.Access:=OldAccess;
         // third param  value
-        Elements.AddElement.Expr:=AssignContext.RightSide;
+        SetCharCall.AddArg(AssignContext.RightSide);
         AssignContext.RightSide:=nil;
-        Result:=AssignSt
+
+        if ResolvedValue.IdentEl is TPasArgument then
+          begin
+          Arg:=TPasArgument(ResolvedValue.IdentEl);
+          if Arg.Access in [argVar,argOut] then
+            begin
+            // s[index] := value  ->  s.set(rtl.setCharAt(s.get(),index,value))
+            SetStrCall:=CreateCallExpression(El.Value);
+            SetStrCall.Expr:=CreateMemberExpression([TransformVariableName(Arg,AContext),TempRefObjSetterName]);
+            SetStrCall.AddArg(SetCharCall);
+            AssignContext.Call:=SetCharCall;
+            SetCharCall:=nil;
+            Result:=SetStrCall;
+            end;
+          end;
+        if Result=nil then
+          begin
+          // s[index] := value  ->  s = rtl.setCharAt(s,index,value)
+          AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+          AssignSt.Expr:=SetCharCall;
+          AssignContext.Call:=SetCharCall;
+          SetCharCall:=nil;
+          OldAccess:=AContext.Access;
+          AContext.Access:=caRead;
+          AssignSt.LHS:=ConvertElement(El.Value,AContext);
+          Result:=AssignSt;
+          end;
       finally
         if Result=nil then
+          begin
+          SetCharCall.Free;
+          SetStrCall.Free;
           AssignSt.Free;
+          end;
       end;
       end;
     caRead:
       begin
-      Call:=CreateCallExpression(El);
-      Elements:=Call.Args.Elements;
+      SetCharCall:=CreateCallExpression(El);
+      Elements:=SetCharCall.Args.Elements;
       try
         // s[index]  ->  s.charAt(index-1)
         // add string accessor
         DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-        Call.Expr:=DotExpr;
+        SetCharCall.Expr:=DotExpr;
         DotExpr.MExpr:=ConvertElement(El.Value,AContext);
         DotExpr.Name:='charAt';
 
         // add parameter "index-1"
         IndexExpr:=ConvertIndexMinus1(Param);
         Elements.AddElement.Expr:=IndexExpr;
-        Result:=Call;
+        Result:=SetCharCall;
       finally
         if Result=nil then
-          Call.Free;
+          SetCharCall.Free;
       end;
       end;
     else
@@ -5810,7 +5843,7 @@ begin
   {$ENDIF}
   if ResolvedEl.BaseType in btAllJSStrings then
     // astring[]
-    ConvertStringBracket
+    ConvertStringBracket(ResolvedEl)
   else if (ResolvedEl.IdentEl is TPasProperty)
       and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
     // aproperty[]

packages/pastojs/tests/tcmodules.pas

@@ -260,6 +260,7 @@ type
     Procedure TestProc_Asm;
     Procedure TestProc_Assembler;
     Procedure TestProc_VarParam;
+    Procedure TestProc_VarParamString;
     Procedure TestProc_Overload;
     Procedure TestProc_OverloadForward;
     Procedure TestProc_OverloadUnit;
@@ -2634,7 +2635,7 @@ begin
   Add('  i:=Bar;');
   Add('  i:=Bla(''abc'');');
   ConvertProgram;
-  CheckSource('TestProcedureExternal',
+  CheckSource('TestProc_External',
     LinesToStr([ // statements
     'this.i = 0;'
     ]),
@@ -2666,7 +2667,7 @@ begin
   Add('  doit;');
   Add('  uNit2.doit;');
   ConvertUnit;
-  CheckSource('TestProcedureExternalOtherUnit',
+  CheckSource('TestProc_ExternalOtherUnit',
     LinesToStr([
     '']),
     LinesToStr([
@@ -2692,7 +2693,7 @@ begin
   'end;',
   'begin']);
   ConvertProgram;
-  CheckSource('TestProcedureAsm',
+  CheckSource('TestProc_Asm',
     LinesToStr([ // statements
     'this.DoIt = function () {',
     '  var Result = 0;',
@@ -2715,7 +2716,7 @@ begin
   Add('end;');
   Add('begin');
   ConvertProgram;
-  CheckSource('TestProcedureAssembler',
+  CheckSource('TestProc_Assembler',
     LinesToStr([ // statements
     'this.DoIt = function () {',
     '  { a:{ b:{}, c:[]}, d:''1'' };',
@@ -2745,7 +2746,7 @@ begin
   Add('begin');
   Add('  doit(i,i,i);');
   ConvertProgram;
-  CheckSource('TestProcedure_VarParam',
+  CheckSource('TestProc_VarParam',
     LinesToStr([ // statements
     'this.DoIt = function (vG,vH,vI) {',
     '  var vJ = 0;',
@@ -2793,6 +2794,32 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_VarParamString;
+begin
+  StartProgram(false);
+  Add(['type TCaption = string;',
+  'procedure DoIt(vA: TCaption; var vB: TCaption; out vC: TCaption);',
+  'var c: char;',
+  'begin',
+  '  va[1]:=c;',
+  '  vb[2]:=c;',
+  '  vc[3]:=c;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestProc_VarParamString',
+    LinesToStr([ // statements
+    'this.DoIt = function (vA,vB,vC) {',
+    '  var c = "";',
+    '  vA = rtl.setCharAt(vA, 0, c);',
+    '  vB.set(rtl.setCharAt(vB.get(), 1, c));',
+    '  vC.set(rtl.setCharAt(vC.get(), 2, c));',
+    '};',
+    '']),
+    LinesToStr([
+    ]));
+end;
+
 procedure TTestModule.TestProc_Overload;
 begin
   StartProgram(false);
@@ -4710,20 +4737,21 @@ end;
 procedure TTestModule.TestString_CharAt;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  s: string;');
-  Add('  c: char;');
-  Add('  b: boolean;');
-  Add('begin');
-  Add('  b:= s[1] = c;');
-  Add('  b:= c = s[1];');
-  Add('  b:= c <> s[1];');
-  Add('  b:= c > s[1];');
-  Add('  b:= c >= s[1];');
-  Add('  b:= c < s[2];');
-  Add('  b:= c <= s[1];');
-  Add('  s[1] := c;');
-  Add('  s[2+3] := c;');
+  Add([
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  b: boolean;',
+  'begin',
+  '  b:= s[1] = c;',
+  '  b:= c = s[1];',
+  '  b:= c <> s[1];',
+  '  b:= c > s[1];',
+  '  b:= c >= s[1];',
+  '  b:= c < s[2];',
+  '  b:= c <= s[1];',
+  '  s[1] := c;',
+  '  s[2+3] := c;']);
   ConvertProgram;
   CheckSource('TestString_CharAt',
     LinesToStr([ // statements