pastojs: implemented SetLength(string,int)

git-svn-id: trunk@36037 -

packages/pastojs/src/fppas2js.pp

@@ -50,7 +50,7 @@ Works:
   - chr(integer)  -> String.fromCharCode(integer)
 - string
   - literals
-  - setlength(s,newlen) -> s.length == newlen
+  - setlength(s,newlen) -> s = rtl.strSetLength(s,newlen)
   - read and write char aString[]
   - allow only String, no ShortString, AnsiString, UnicodeString,...
   - allow type casting string to external class name 'String'
@@ -307,7 +307,7 @@ Not in Version 1.0:
   -O1 insert unit vars for complex literals
   -O1 no function Result var when assigned only once
   - SetLength(scope.a,l) -> read scope only once, same for
-    Include, Exclude, Inc, Dec
+    Include, Exclude, Inc, Dec, +=, -=, *=, /=
   -O1 replace constant expression with result
   -O1 pass array element by ref: when index is constant, use that directly
 - objects, interfaces, advanced records
@@ -438,6 +438,7 @@ type
     pbifnSet_SymDiffSet,
     pbifnSet_Union,
     pbifnSpaceLeft,
+    pbifnStringSetLength,
     pbifnUnitInit,
     pbivnExceptObject,
     pbivnImplementation,
@@ -534,6 +535,7 @@ const
     'symDiffSet', // rtl.symDiffSet >< (symmetrical difference)
     'unionSet', // rtl.unionSet +
     'spaceLeft', // rtl.spaceLeft
+    'strSetLength',
     '$init',
     '$e',
     '$impl',
@@ -5883,8 +5885,7 @@ var
   ResolvedParam0: TPasResolverResult;
   ArrayType: TPasArrayType;
   Call: TJSCallExpression;
-  ValInit, Arg: TJSElement;
-  AssignSt: TJSSimpleAssignStatement;
+  ValInit: TJSElement;
   AssignContext: TAssignContext;
   ElType: TPasType;
 begin
@@ -5936,21 +5937,26 @@ begin
     end
   else if ResolvedParam0.BaseType=btString then
     begin
-    // convert "SetLength(string,NewLen);" to "string.length == NewLen;"
+    // convert "SetLength(astring,NewLen);" to "astring = rtl.strSetLength(astring,NewLen);"
     {$IFDEF VerbosePasResolver}
     writeln('TPasToJSConverter.ConvertBuiltInSetLength string');
     {$ENDIF}
-    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignContext:=TAssignContext.Create(El,nil,AContext);
     try
-      Arg:=ConvertElement(Param0,AContext);
-      // left side: string.length
-      AssignSt.LHS:=CreateDotExpression(El,Arg,CreateBuiltInIdentifierExpr('length'));
-      // right side: newlength
-      AssignSt.Expr:=ConvertElement(El.Params[1],AContext);
-      Result:=AssignSt;
+      AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      AssignContext.RightResolved:=AssignContext.LeftResolved;
+
+      // create right side  rtl.strSetLength(aString,NewLen)
+      Call:=CreateCallExpression(El);
+      AssignContext.RightSide:=Call;
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnStringSetLength]]);
+      Call.AddArg(ConvertElement(Param0,AContext));
+      Call.AddArg(ConvertElement(El.Params[1],AContext));
+
+      Result:=CreateAssignStatement(Param0,AssignContext);
     finally
-      if Result=nil then
-        AssignSt.Free;
+      AssignContext.RightSide.Free;
+      AssignContext.Free;
     end;
     end
   else

packages/pastojs/tests/tcmodules.pas

@@ -292,6 +292,7 @@ type
     Procedure TestArrayElement_AsParams;
     Procedure TestArrayElementFromFuncResult_AsParams;
     Procedure TestArrayEnumTypeRange;
+    Procedure TestArray_SetLengthOutArg;
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_OpenArrayOfString;
     Procedure TestArray_Concat;
@@ -3853,16 +3854,25 @@ end;
 procedure TTestModule.TestString_SetLength;
 begin
   StartProgram(false);
-  Add('var s: string;');
-  Add('begin');
-  Add('  SetLength(s,3);');
+  Add([
+  'procedure DoIt(var s: string);',
+  'begin',
+  '  SetLength(s,2);',
+  'end;',
+  'var s: string;',
+  'begin',
+  '  SetLength(s,3);',
+  '']);
   ConvertProgram;
   CheckSource('TestString_SetLength',
     LinesToStr([ // statements
-    'this.s = "";'
-    ]),
+    'this.DoIt = function (s) {',
+    '  s.set(rtl.strSetLength(s.get(), 2));',
+    '};',
+    'this.s = "";',
+    '']),
     LinesToStr([ // this.$main
-    '$mod.s.length = 3;'
+    '$mod.s = rtl.strSetLength($mod.s, 3);'
     ]));
 end;
 
@@ -4950,6 +4960,28 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_SetLengthOutArg;
+begin
+  StartProgram(false);
+  Add([
+  'type TArrInt = array of longint;',
+  'procedure DoIt(out a: TArrInt);',
+  'begin',
+  '  SetLength(a,2);',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_SetLengthOutArg',
+    LinesToStr([ // statements
+    'this.DoIt = function (a) {',
+    '  a.set(rtl.arraySetLength(a.get(), 2, 0));',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestArray_SetLengthProperty;
 begin
   StartProgram(false);