--- Merging r35789 into '.':

U    packages/fcl-js/src/jstree.pp
--- Recording mergeinfo for merge of r35789 into '.':
 U   .
--- Merging r36007 into '.':
U    packages/pastojs/tests/tcoptimizations.pas
--- Recording mergeinfo for merge of r36007 into '.':
 G   .
--- Merging r36035 into '.':
U    packages/pastojs/src/fppas2js.pp
U    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r36035 into '.':
 G   .
--- Merging r36037 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r36037 into '.':
 G   .
--- Merging r36070 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r36070 into '.':
 G   .
--- Merging r36235 into '.':
G    packages/fcl-js/src/jstree.pp
--- Recording mergeinfo for merge of r36235 into '.':
 G   .
--- Merging r36471 into '.':
G    packages/fcl-js/src/jstree.pp
--- Recording mergeinfo for merge of r36471 into '.':
 G   .
--- Merging r36492 into '.':
A    packages/fcl-js/tests/tcsrcmap.pas
U    packages/fcl-js/tests/testjs.lpi
U    packages/fcl-js/tests/testjs.lpr
U    packages/fcl-js/src/jswriter.pp
A    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r36492 into '.':
 G   .
--- Merging r36493 into '.':
U    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r36493 into '.':
 G   .
--- Merging r36494 into '.':
G    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r36494 into '.':
 G   .

# revisions: 35789,36007,36035,36037,36070,36235,36471,36492,36493,36494

git-svn-id: branches/fixes_3_0@36535 -

.gitattributes

@@ -2446,11 +2446,13 @@ packages/fcl-js/src/jsbase.pp svneol=native#text/plain
 packages/fcl-js/src/jsminifier.pp svneol=native#text/plain
 packages/fcl-js/src/jsparser.pp svneol=native#text/plain
 packages/fcl-js/src/jsscanner.pp svneol=native#text/plain
+packages/fcl-js/src/jssrcmap.pas svneol=native#text/plain
 packages/fcl-js/src/jstoken.pp svneol=native#text/plain
 packages/fcl-js/src/jstree.pp svneol=native#text/plain
 packages/fcl-js/src/jswriter.pp svneol=native#text/plain
 packages/fcl-js/tests/tcparser.pp svneol=native#text/plain
 packages/fcl-js/tests/tcscanner.pp svneol=native#text/plain
+packages/fcl-js/tests/tcsrcmap.pas svneol=native#text/plain
 packages/fcl-js/tests/tcwriter.pp svneol=native#text/plain
 packages/fcl-js/tests/testjs.ico -text
 packages/fcl-js/tests/testjs.lpi svneol=native#text/plain

packages/fcl-js/src/jssrcmap.pas

@@ -0,0 +1,621 @@
+{ *********************************************************************
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 Mattias Gaertner.
+
+    Javascript Source Map
+
+    See Source Maps Revision 3:
+    https://docs.google.com/document/d/1U1RGAehQwRypUTovF1KRlpiOFze0b-_2gc6fAH0KY0k/edit?hl=en_US&pli=1&pli=1#
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+  **********************************************************************}
+unit JSSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, fpjson;
+
+const
+  Base64Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+  DefaultSrcMapHeader = ')]}'+LineEnding;
+
+type
+
+  { TSourceMapSegment }
+
+  TSourceMapSegment = class
+  public
+    Index: integer; // index in FNodes
+    GeneratedLine: integer;
+    GeneratedColumn: integer;
+    SrcFileIndex: integer; // index in FSources
+    SrcLine: integer;
+    SrcColumn: integer;
+    NameIndex: integer; // index in FNames
+  end;
+
+  TSourceMapSrc = class
+  public
+    Filename: string;
+    Source: String;
+  end;
+
+  { TSourceMap }
+
+  TSourceMap = class
+  private
+    type
+
+      { TStringToIndex }
+
+      TStringToIndex = class
+      private
+        FItems: TFPHashList;
+      public
+        constructor Create;
+        destructor Destroy; override;
+        procedure Clear;
+        procedure Add(const Value: String; Index: integer);
+        function FindValue(const Value: String): integer;
+      end;
+  private
+    FAddMonotonous: boolean;
+    FHeader: String;
+    FGeneratedFilename: string;
+    FNames: TStrings; // in adding order
+    FNameToIndex: TStringToIndex; // name to index in FNames
+    FItems: TFPList; // TSourceMapSegment, in adding order
+    FSourceRoot: string;
+    FSources: TFPList; // list of TSourceMapSrc, in adding order
+    FSourceToIndex: TStringToIndex; // srcfile to index in FSources
+    FVersion: integer;
+    function GetNames(Index: integer): string;
+    function GetItems(Index: integer): TSourceMapSegment;
+    function GetSourceContents(Index: integer): String;
+    function GetSourceFiles(Index: integer): String;
+    procedure SetGeneratedFilename(const AValue: string);
+    procedure SetSourceContents(Index: integer; const AValue: String);
+  public
+    constructor Create(const aGeneratedFilename: string);
+    destructor Destroy; override;
+    procedure Clear; virtual;
+    function AddMapping(
+      GeneratedLine: integer; // 1-based
+      GeneratedCol: integer = 0; // 0-based
+      const SourceFile: string = ''; // can be empty ''
+      SrcLine: integer = 1; // 1-based
+      SrcCol: integer = 0; // 0-based
+      const Name: String = ''): TSourceMapSegment; virtual;
+    property AddMonotonous: boolean read FAddMonotonous
+      write FAddMonotonous default true;// true = AddMapping GeneratedLine/Col must be behind last add, false = check all adds for duplicate
+    function CreateMappings: String; virtual;
+    function ToJSON: TJSONObject; virtual;
+    procedure SaveToStream(aStream: TStream); virtual;
+    procedure SaveToFile(Filename: string); virtual;
+    function ToString: string; override;
+    property GeneratedFilename: string read FGeneratedFilename write SetGeneratedFilename;
+    function IndexOfName(const Name: string; AddIfNotExists: boolean = false): integer;
+    function IndexOfSourceFile(const SrcFile: string; AddIfNotExists: boolean = false): integer;
+    function Count: integer;
+    property Items[Index: integer]: TSourceMapSegment read GetItems; default; // segments
+    function SourceCount: integer;
+    property SourceRoot: string read FSourceRoot write FSourceRoot;
+    property SourceFiles[Index: integer]: String read GetSourceFiles;
+    property SourceContents[Index: integer]: String read GetSourceContents write SetSourceContents;
+    function NameCount: integer;
+    property Names[Index: integer]: string read GetNames;
+    property Version: integer read FVersion; // 3
+    property Header: String read FHeader write FHeader; // DefaultSrcMapHeader
+  end;
+
+function EncodeBase64VLQ(i: NativeInt): String; // base64 Variable Length Quantity
+function DecodeBase64VLQ(const s: string): NativeInt; // base64 Variable Length Quantity
+function DecodeBase64VLQ(var p: PChar): NativeInt; // base64 Variable Length Quantity
+
+implementation
+
+function EncodeBase64VLQ(i: NativeInt): String;
+{ Convert signed number to base64-VLQ:
+  Each base64 has 6bit, where the most significant bit is the continuation bit
+  (1=there is a next base64 character).
+  The first character contains the 5 least significant bits of the number.
+  The last bit of the first character is the sign bit (1=negative).
+  For example:
+  A = 0 = %000000 => 0
+  B = 1 = %000001 => -0
+  C = 2 = %000010 => 1
+  iF = 34 5 = %100010 %000101 = 00010 00101 = 1000101 = 69
+}
+
+  procedure RaiseRange;
+  begin
+    raise ERangeError.Create('EncodeBase64VLQ');
+  end;
+
+var
+  digits: NativeInt;
+begin
+  Result:='';
+  if i<0 then
+    begin
+    i:=-i;
+    if i>(High(NativeInt)-1) shr 1 then
+      RaiseRange;
+    i:=(i shl 1)+1;
+    end
+  else
+    begin
+    if i>High(NativeInt) shr 1 then
+      RaiseRange;
+    i:=i shl 1;
+    end;
+  repeat
+    digits:=i and %11111;
+    i:=i shr 5;
+    if i>0 then
+      inc(digits,%100000); // need another char -> set continuation bit
+    Result:=Result+Base64Chars[digits+1];
+  until i=0;
+end;
+
+function DecodeBase64VLQ(const s: string): NativeInt;
+var
+  p: PChar;
+begin
+  if s='' then
+    raise EConvertError.Create('DecodeBase64VLQ empty');
+  p:=PChar(s);
+  Result:=DecodeBase64VLQ(p);
+  if p-PChar(s)<>length(s) then
+    raise EConvertError.Create('DecodeBase64VLQ waste');
+end;
+
+function DecodeBase64VLQ(var p: PChar): NativeInt;
+{ Convert base64-VLQ to signed number,
+  For the fomat see EncodeBase64VLQ
+}
+
+  procedure RaiseInvalid;
+  begin
+    raise ERangeError.Create('DecodeBase64VLQ');
+  end;
+
+const
+  MaxShift = 63-5; // actually log2(High(NativeInt))-5
+var
+  c: Char;
+  digit, Shift: Integer;
+begin
+  Result:=0;
+  Shift:=0;
+  repeat
+    c:=p^;
+    case c of
+    'A'..'Z': digit:=ord(c)-ord('A');
+    'a'..'z': digit:=ord(c)-ord('a')+26;
+    '0'..'9': digit:=ord(c)-ord('0')+52;
+    '+': digit:=62;
+    '/': digit:=63;
+    else RaiseInvalid;
+    end;
+    inc(p);
+    if Shift>MaxShift then
+      RaiseInvalid;
+    inc(Result,(digit and %11111) shl Shift);
+    inc(Shift,5);
+  until digit<%100000;
+  if (Result and 1)>0 then
+    Result:=-(Result shr 1)
+  else
+    Result:=Result shr 1;
+end;
+
+{ TSourceMap.TStringToIndex }
+
+constructor TSourceMap.TStringToIndex.Create;
+begin
+  FItems:=TFPHashList.Create;
+end;
+
+destructor TSourceMap.TStringToIndex.Destroy;
+begin
+  FItems.Clear;
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+procedure TSourceMap.TStringToIndex.Clear;
+begin
+  FItems.Clear;
+end;
+
+procedure TSourceMap.TStringToIndex.Add(const Value: String; Index: integer);
+begin
+  // Note: nil=0 means not found in TFPHashList
+  FItems.Add(Value,{%H-}Pointer(PtrInt(Index+1)));
+end;
+
+function TSourceMap.TStringToIndex.FindValue(const Value: String
+  ): integer;
+begin
+  // Note: nil=0 means not found in TFPHashList
+  Result:=integer({%H-}PtrInt(FItems.Find(Value)))-1;
+end;
+
+{ TSourceMap }
+
+procedure TSourceMap.SetGeneratedFilename(const AValue: string);
+begin
+  if FGeneratedFilename=AValue then Exit;
+  FGeneratedFilename:=AValue;
+end;
+
+procedure TSourceMap.SetSourceContents(Index: integer; const AValue: String);
+begin
+  TSourceMapSrc(FSources[Index]).Source:=AValue;
+end;
+
+function TSourceMap.GetItems(Index: integer): TSourceMapSegment;
+begin
+  Result:=TSourceMapSegment(FItems[Index]);
+end;
+
+function TSourceMap.GetSourceContents(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Source;
+end;
+
+function TSourceMap.GetNames(Index: integer): string;
+begin
+  Result:=FNames[Index];
+end;
+
+function TSourceMap.GetSourceFiles(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Filename;
+end;
+
+constructor TSourceMap.Create(const aGeneratedFilename: string);
+begin
+  FVersion:=3;
+  FNames:=TStringList.Create;
+  FNameToIndex:=TStringToIndex.Create;
+  FItems:=TFPList.Create;
+  FSources:=TFPList.Create;
+  FSourceToIndex:=TStringToIndex.Create;
+  FAddMonotonous:=true;
+  FHeader:=DefaultSrcMapHeader;
+  GeneratedFilename:=aGeneratedFilename;
+end;
+
+destructor TSourceMap.Destroy;
+begin
+  Clear;
+  FreeAndNil(FSourceToIndex);
+  FreeAndNil(FSources);
+  FreeAndNil(FItems);
+  FreeAndNil(FNameToIndex);
+  FreeAndNil(FNames);
+  inherited Destroy;
+end;
+
+procedure TSourceMap.Clear;
+var
+  i: Integer;
+begin
+  FSourceToIndex.Clear;
+  for i:=0 to FSources.Count-1 do
+    TObject(FSources[i]).Free;
+  FSources.Clear;
+  for i:=0 to FItems.Count-1 do
+    TObject(FItems[i]).Free;
+  FItems.Clear;
+  FNameToIndex.Clear;
+  FNames.Clear;
+end;
+
+function TSourceMap.AddMapping(GeneratedLine: integer; GeneratedCol: integer;
+  const SourceFile: string; SrcLine: integer; SrcCol: integer;
+  const Name: String): TSourceMapSegment;
+
+  procedure RaiseInvalid(Msg: string);
+  begin
+    raise Exception.CreateFmt('%s (GeneratedLine=%d GeneratedCol=%d SrcFile="%s" SrcLine=%d SrcCol=%d Name="%s")',
+      [Msg,GeneratedLine,GeneratedCol,SourceFile,SrcLine,SrcCol,Name]);
+  end;
+
+var
+  NodeCnt, i: Integer;
+  OtherNode: TSourceMapSegment;
+begin
+  if GeneratedLine<1 then
+    RaiseInvalid('invalid GeneratedLine');
+  if GeneratedCol<0 then
+    RaiseInvalid('invalid GeneratedCol');
+  if SourceFile='' then
+    begin
+    if Count=0 then
+      RaiseInvalid('missing source file');
+    if SrcLine<>1 then
+      RaiseInvalid('invalid SrcLine');
+    if SrcCol<>0 then
+      RaiseInvalid('invalid SrcCol');
+    if Name<>'' then
+      RaiseInvalid('invalid Name');
+    end
+  else
+    begin
+    if SrcLine<1 then
+      RaiseInvalid('invalid SrcLine');
+    if SrcCol<0 then
+      RaiseInvalid('invalid SrcCol');
+    end;
+
+  // check if generated line/col already exists
+  NodeCnt:=Count;
+  if AddMonotonous then
+    begin
+    if NodeCnt>0 then
+      begin
+      OtherNode:=Items[NodeCnt-1];
+      if (OtherNode.GeneratedLine>GeneratedLine)
+          or ((OtherNode.GeneratedLine=GeneratedLine)
+            and (OtherNode.GeneratedColumn>GeneratedCol)) then
+        RaiseInvalid('GeneratedLine/Col not monotonous');
+      // Note: same line/col is allowed
+      end;
+    end
+  else
+    begin
+    for i:=0 to NodeCnt-1 do
+      begin
+      OtherNode:=Items[i];
+      if (OtherNode.GeneratedLine=GeneratedLine) and (OtherNode.GeneratedColumn=GeneratedCol) then
+        RaiseInvalid('duplicate GeneratedLine/Col');
+      end;
+    end;
+
+  // add
+  Result:=TSourceMapSegment.Create;
+  Result.Index:=FItems.Count;
+  Result.GeneratedLine:=GeneratedLine;
+  Result.GeneratedColumn:=GeneratedCol;
+  if SourceFile='' then
+    Result.SrcFileIndex:=-1
+  else
+    Result.SrcFileIndex:=IndexOfSourceFile(SourceFile,true);
+  Result.SrcLine:=SrcLine;
+  Result.SrcColumn:=SrcCol;
+  if Name<>'' then
+    Result.NameIndex:=IndexOfName(Name,true)
+  else
+    Result.NameIndex:=-1;
+  FItems.Add(Result);
+end;
+
+function TSourceMap.CreateMappings: String;
+
+  procedure Add(ms: TMemoryStream; const s: string);
+  begin
+    if s<>'' then
+      ms.Write(s[1],length(s));
+  end;
+
+var
+  ms: TMemoryStream;
+  i, LastGeneratedLine, LastGeneratedColumn, j, LastSrcFileIndex, LastSrcLine,
+    LastSrcColumn, SrcLine, LastNameIndex: Integer;
+  Item: TSourceMapSegment;
+begin
+  Result:='';
+  LastGeneratedLine:=1;
+  LastGeneratedColumn:=0;
+  LastSrcFileIndex:=0;
+  LastSrcLine:=0;
+  LastSrcColumn:=0;
+  LastNameIndex:=0;
+  ms:=TMemoryStream.Create;
+  try
+    for i:=0 to Count-1 do
+      begin
+      Item:=Items[i];
+      if LastGeneratedLine<Item.GeneratedLine then
+        begin
+        // new line
+        LastGeneratedColumn:=0;
+        for j:=LastGeneratedLine+1 to Item.GeneratedLine do
+          ms.WriteByte(ord(';'));
+        LastGeneratedLine:=Item.GeneratedLine;
+        end
+      else if i>0 then
+        begin
+        // not the first segment
+        if (LastGeneratedLine=Item.GeneratedLine)
+            and (LastGeneratedColumn=Item.GeneratedColumn) then
+          continue;
+        ms.WriteByte(ord(','));
+        end;
+      // column diff
+      Add(ms,EncodeBase64VLQ(Item.GeneratedColumn-LastGeneratedColumn));
+      LastGeneratedColumn:=Item.GeneratedColumn;
+
+      if Item.SrcFileIndex<0 then
+        continue; // no source -> segment length 1
+      // src file index diff
+      Add(ms,EncodeBase64VLQ(Item.SrcFileIndex-LastSrcFileIndex));
+      LastSrcFileIndex:=Item.SrcFileIndex;
+      // src line diff
+      SrcLine:=Item.SrcLine-1; // 0 based in version 3
+      Add(ms,EncodeBase64VLQ(SrcLine-LastSrcLine));
+      LastSrcLine:=SrcLine;
+      // src column diff
+      Add(ms,EncodeBase64VLQ(Item.SrcColumn-LastSrcColumn));
+      LastSrcColumn:=Item.SrcColumn;
+      // name index
+      if Item.NameIndex<0 then
+        continue; // no name -> segment length 4
+      Add(ms,EncodeBase64VLQ(Item.NameIndex-LastNameIndex));
+      LastNameIndex:=Item.NameIndex;
+      end;
+    SetLength(Result,ms.Size);
+    if Result<>'' then
+      Move(ms.Memory^,Result[1],ms.Size);
+  finally
+    ms.Free;
+  end;
+end;
+
+function TSourceMap.ToJSON: TJSONObject;
+var
+  Obj: TJSONObject;
+  i: Integer;
+  Arr: TJSONArray;
+  Mappings: String;
+begin
+  Result:=nil;
+  Mappings:=CreateMappings;
+
+  Obj:=TJSONObject.Create;
+  try
+    // "version" - integer
+    Obj.Add('version',Version);
+
+    // "file" - GeneratedFilename
+    if GeneratedFilename<>'' then
+      Obj.Add('file',GeneratedFilename);
+
+    // "sourceRoot" - SourceRoot
+    if SourceRoot<>'' then
+      Obj.Add('sourceRoot',SourceRoot);
+
+    // "sources" - array of filenames
+    Arr:=TJSONArray.Create;
+    Obj.Add('sources',Arr);
+    for i:=0 to SourceCount-1 do
+      Arr.Add(SourceFiles[i]);
+
+    // "sourcesContent" - array of source content: null or source as string
+    // only needed if there is a source
+    i:=SourceCount-1;
+    while i>=0 do
+      if SourceContents[i]='' then
+        dec(i)
+      else
+        begin
+        // there is a source -> add array
+        Arr:=TJSONArray.Create;
+        Obj.Add('sourcesContent',Arr);
+        for i:=0 to SourceCount-1 do
+          if SourceContents[i]='' then
+            Arr.Add(TJSONNull.Create)
+          else
+            Arr.Add(SourceContents[i]);
+        break;
+        end;
+
+    // "names" - array of names
+    Arr:=TJSONArray.Create;
+    Obj.Add('names',Arr);
+    for i:=0 to NameCount-1 do
+      Arr.Add(Names[i]);
+
+    // "mappings" - string
+    Obj.Add('mappings',Mappings);
+
+    Result:=Obj;
+  finally
+    if Result=nil then
+      Obj.Free;
+  end;
+end;
+
+procedure TSourceMap.SaveToStream(aStream: TStream);
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    if Header<>'' then
+      aStream.Write(Header[1],length(Header));
+    Obj.DumpJSON(aStream);
+  finally
+    Obj.Free;
+  end;
+end;
+
+procedure TSourceMap.SaveToFile(Filename: string);
+var
+  TheStream: TMemoryStream;
+begin
+  TheStream:=TMemoryStream.Create;
+  try
+    SaveToStream(TheStream);
+    TheStream.Position:=0;
+    TheStream.SaveToFile(Filename);
+  finally
+    TheStream.Free;
+  end;
+end;
+
+function TSourceMap.ToString: string;
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    Result:=Header+Obj.AsJSON;
+  finally
+    Obj.Free;
+  end;
+end;
+
+function TSourceMap.IndexOfName(const Name: string; AddIfNotExists: boolean
+  ): integer;
+begin
+  Result:=FNameToIndex.FindValue(Name);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Result:=FNames.Count;
+  FNames.Add(Name);
+  FNameToIndex.Add(Name,Result);
+end;
+
+function TSourceMap.IndexOfSourceFile(const SrcFile: string;
+  AddIfNotExists: boolean): integer;
+var
+  Src: TSourceMapSrc;
+begin
+  Result:=FSourceToIndex.FindValue(SrcFile);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Src:=TSourceMapSrc.Create;
+  Src.Filename:=SrcFile;
+  Result:=FSources.Count;
+  FSources.Add(Src);
+  FSourceToIndex.Add(SrcFile,Result);
+end;
+
+function TSourceMap.Count: integer;
+begin
+  Result:=FItems.Count;
+end;
+
+function TSourceMap.SourceCount: integer;
+begin
+  Result:=FSources.Count;
+end;
+
+function TSourceMap.NameCount: integer;
+begin
+  Result:=FNames.Count;
+end;
+
+end.
+

packages/fcl-js/src/jstree.pp

@@ -145,13 +145,13 @@ Type
   private
     FFlags: TJSElementFlags;
     FLine: Integer;
-    FRow: Integer;
+    FColumn: Integer;
     FSource: String;
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); virtual;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); virtual;
     Property Source : String Read FSource Write FSource;
-    Property Row : Integer Read FRow Write FRow;
     Property Line : Integer Read FLine Write FLine;
+    Property Column : Integer Read FColumn Write FColumn;
     Property Flags : TJSElementFlags Read FFlags Write FFlags;
   end;
   TJSElementClass = Class of TJSElement;
@@ -170,7 +170,7 @@ Type
   private
     FValue: TJSValue;
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Value : TJSValue Read FValue Write FValue;
   end;
@@ -185,7 +185,7 @@ Type
     function GetA(AIndex : integer): TJSValue;
     procedure SetA(AIndex : integer; const AValue: TJSValue);
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Pattern : TJSValue Read FPattern Write FPattern;
     Property PatternFlags : TJSValue Read FPatternFlags Write FPatternFlags;
@@ -213,7 +213,7 @@ Type
     FFindex: Integer;
   Public
     Destructor Destroy; override;
-    Property Expr : TJSelement Read FExpr Write FExpr;
+    Property Expr : TJSElement Read FExpr Write FExpr;
     Property ElementIndex : Integer Read FFindex Write FFIndex;
   end;
 
@@ -233,7 +233,8 @@ Type
   private
     FElements: TJSArrayLiteralElements;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    procedure AddElement(El: TJSElement);
     Destructor Destroy; override;
     Property Elements : TJSArrayLiteralElements Read FElements;
   end;
@@ -266,7 +267,7 @@ Type
   private
     FElements: TJSObjectLiteralElements;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Elements : TJSObjectLiteralElements Read FElements;
   end;
@@ -292,6 +293,7 @@ Type
     FArgs: TJSArguments;
   Public
     Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
     Property Args : TJSArguments Read FArgs Write FArgs;
   end;
 
@@ -322,6 +324,7 @@ Type
     FExpr: TJSElement;
   Public
     Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
     Property Expr : TJSElement Read FExpr Write FExpr;
     Property Args : TJSArguments Read FArgs Write FArgs;
   end;
@@ -345,7 +348,7 @@ Type
 
   TJSVariableStatement = Class(TJSUnary);
 
-  { TJSExpressionStatement - ? }
+  { TJSExpressionStatement - A; }
 
   TJSExpressionStatement = Class(TJSUnary);
 
@@ -879,7 +882,7 @@ Type
     FCond: TJSelement;
     FDefault: TJSCaseElement;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Cond : TJSelement Read FCond Write FCond;
     Property Cases : TJSCaseElements Read FCases;
@@ -967,7 +970,7 @@ Type
     FStatements: TJSElementNodes;
     FVars: TJSElementNodes;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Vars : TJSElementNodes Read FVars;
     Property Functions : TJSElementNodes Read FFunctions;
@@ -1500,10 +1503,10 @@ end;
 
 { TJSElement }
 
-constructor TJSElement.Create(ALine, ARow: Integer; const ASource: String);
+constructor TJSElement.Create(ALine, AColumn: Integer; const ASource: String);
 begin
   FLine:=ALine;
-  FRow:=ARow;
+  FColumn:=AColumn;
   FSource:=ASource;
 end;
 
@@ -1520,10 +1523,10 @@ begin
   FArgv[AIndex]:=Avalue;
 end;
 
-constructor TJSRegularExpressionLiteral.Create(ALine, ARow: Integer;
+constructor TJSRegularExpressionLiteral.Create(ALine, AColumn: Integer;
   const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FPattern:=TJSValue.Create;
   FPatternFlags:=TJSValue.Create;
 end;
@@ -1549,12 +1552,17 @@ end;
 
 { TJSArrayLiteral }
 
-constructor TJSArrayLiteral.Create(ALine, ARow: Integer; Const ASource: String = '');
+constructor TJSArrayLiteral.Create(ALine, AColumn: Integer; const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FElements:=TJSArrayLiteralElements.Create(TJSArrayLiteralElement);
 end;
 
+procedure TJSArrayLiteral.AddElement(El: TJSElement);
+begin
+  Elements.AddElement.Expr:=El;
+end;
+
 destructor TJSArrayLiteral.Destroy;
 begin
   FreeAndNil(FElements);
@@ -1577,9 +1585,9 @@ end;
 
 { TJSObjectLiteral }
 
-constructor TJSObjectLiteral.Create(ALine, ARow: Integer; const ASource: String = '');
+constructor TJSObjectLiteral.Create(ALine, AColumn: Integer; const ASource: String = '');
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FElements:=TJSObjectLiteralElements.Create(TJSObjectLiteralElement);
 end;
 
@@ -1613,6 +1621,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TJSNewMemberExpression.AddArg(El: TJSElement);
+begin
+  Args.Elements.AddElement.Expr:=El;
+end;
+
 { TJSMemberExpression }
 
 destructor TJSMemberExpression.Destroy;
@@ -1630,6 +1643,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TJSCallExpression.AddArg(El: TJSElement);
+begin
+  Args.Elements.AddElement.Expr:=El;
+end;
+
 { TJSUnary }
 
 Class function TJSUnary.PrefixOperatorToken: tjsToken;
@@ -1796,9 +1814,9 @@ end;
 
 { TJSSwitch }
 
-constructor TJSSwitchStatement.Create(ALine, ARow: Integer; const ASource: String);
+constructor TJSSwitchStatement.Create(ALine, AColumn: Integer; const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FCases:=TJSCaseElements.Create(TJSCaseElement);
 end;
 
@@ -1834,10 +1852,10 @@ end;
 
 { TJSSourceElements }
 
-constructor TJSSourceElements.Create(ALine, ARow: Integer; const ASource: String
+constructor TJSSourceElements.Create(ALine, AColumn: Integer; const ASource: String
   );
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FStatements:=TJSElementNodes.Create(TJSElementNode);
   FFunctions:=TJSElementNodes.Create(TJSElementNode);
   FVars:=TJSElementNodes.Create(TJSElementNode);
@@ -1916,10 +1934,10 @@ end;
 
 { TJSLiteral }
 
-constructor TJSLiteral.Create(ALine, ARow: Integer; const ASource: String);
+constructor TJSLiteral.Create(ALine, AColumn: Integer; const ASource: String);
 begin
   FValue:=TJSValue.Create;
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
 end;
 
 destructor TJSLiteral.Destroy;

packages/fcl-js/src/jswriter.pp

@@ -23,15 +23,25 @@ uses
   SysUtils, jstoken, jsbase, jstree;
 
 Type
+  TTextWriter = class;
+
+  TTextWriterWriting = procedure(Sender: TTextWriter) of object;
 
   { TTextWriter }
 
   TTextWriter = Class(TObject)
+  private
+    FCurElement: TJSElement;
+    FCurLine: integer;
+    FCurColumn: integer;
+    FOnWriting: TTextWriterWriting;
   protected
     Function DoWrite(Const S : AnsiString) : Integer; virtual; abstract;
     Function DoWrite(Const S : UnicodeString) : Integer; virtual; abstract;
+    Procedure Writing; // called before adding new characters
   Public
     // All functions return the number of bytes copied to output stream.
+    constructor Create;
     Function Write(Const S : UnicodeString) : Integer;
     Function Write(Const S : AnsiString) : Integer;
     Function WriteLn(Const S : AnsiString) : Integer;
@@ -39,6 +49,10 @@ Type
     Function WriteLn(Const Fmt : AnsiString; Args : Array of const) : Integer;
     Function Write(Const Args : Array of const) : Integer;
     Function WriteLn(Const Args : Array of const) : Integer;
+    Property CurLine: integer read FCurLine write FCurLine;
+    Property CurColumn: integer read FCurColumn write FCurColumn;// char index, not codepoint
+    Property CurElement: TJSElement read FCurElement write FCurElement;
+    Property OnWriting: TTextWriterWriting read FOnWriting write FOnWriting;
   end;
 
   { TFileWriter }
@@ -105,14 +119,14 @@ Type
   TJSWriter = Class
   private
     FCurIndent : Integer;
-    FLinePos : Integer;
-    FIndentSize: Byte;
+    FFreeWriter : Boolean;
     FIndentChar : Char;
+    FIndentSize: Byte;
+    FLinePos : Integer;
     FOptions: TWriteOptions;
-    FWriter: TTextWriter;
-    FFreeWriter : Boolean;
     FSkipCurlyBrackets : Boolean;
     FSkipRoundBrackets : Boolean;
+    FWriter: TTextWriter;
     function GetUseUTF8: Boolean;
     procedure SetOptions(AValue: TWriteOptions);
   Protected
@@ -254,7 +268,7 @@ begin
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
-    DesLen:=Round(FCapacity*1.25);
+    DesLen:=(FCapacity*5) div 4;
     if DesLen>MinLen then
       MinLen:=DesLen;
     Capacity:=MinLen;
@@ -274,7 +288,7 @@ begin
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
-    DesLen:=Round(FCapacity*1.25);
+    DesLen:=(FCapacity*5) div 4;
     if DesLen>MinLen then
       MinLen:=DesLen;
     Capacity:=MinLen;
@@ -285,6 +299,7 @@ end;
 
 Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
 begin
+  inherited Create;
   Capacity:=ACapacity;
 end;
 
@@ -673,7 +688,9 @@ begin
   if El is TJSPrimaryExpressionThis then
     Write('this')
   else if El is TJSPrimaryExpressionIdent then
-    Write(TJSPrimaryExpressionIdent(El).Name);
+    Write(TJSPrimaryExpressionIdent(El).Name)
+  else
+    Error(SErrUnknownJSClass,[El.ClassName]);
 end;
 
 procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
@@ -777,6 +794,7 @@ procedure TJSWriter.WriteMemberExpression(El: TJSMemberExpression);
 
 var
   MExpr: TJSElement;
+  Args: TJSArguments;
 begin
   if El is TJSNewMemberExpression then
     Write('new ');
@@ -809,8 +827,12 @@ begin
     end
   else if (El is TJSNewMemberExpression) then
     begin
-    if (Assigned(TJSNewMemberExpression(El).Args)) then
-      WriteArrayLiteral(TJSNewMemberExpression(El).Args)
+    Args:=TJSNewMemberExpression(El).Args;
+    if Assigned(Args) then
+      begin
+      Writer.CurElement:=Args;
+      WriteArrayLiteral(Args);
+      end
     else
       Write('()');
     end;
@@ -821,7 +843,10 @@ procedure TJSWriter.WriteCallExpression(El: TJSCallExpression);
 begin
   WriteJS(El.Expr);
   if Assigned(El.Args) then
-    WriteArrayLiteral(El.Args)
+    begin
+    Writer.CurElement:=El.Args;
+    WriteArrayLiteral(El.Args);
+    end
   else
     Write('()');
 end;
@@ -1219,23 +1244,23 @@ Var
   TN : TJSString;
 
 begin
-  TN:=EL.TargetName;
+  TN:=El.TargetName;
   if (El is TJSForStatement) then
     WriteForStatement(TJSForStatement(El))
   else if (El is TJSSwitchStatement) then
     WriteSwitchStatement(TJSSwitchStatement(El))
   else if (El is TJSForInStatement) then
     WriteForInStatement(TJSForInStatement(El))
-  else if EL is TJSWhileStatement then
+  else if El is TJSWhileStatement then
     WriteWhileStatement(TJSWhileStatement(El))
-  else if (EL is TJSContinueStatement) then
+  else if (El is TJSContinueStatement) then
     begin
     if (TN<>'') then
       Write('continue '+TN)
     else
       Write('continue');
     end
-  else if (EL is TJSBreakStatement) then
+  else if (El is TJSBreakStatement) then
     begin
    if (TN<>'') then
       Write('break '+TN)
@@ -1243,7 +1268,7 @@ begin
       Write('break');
     end
   else
-    Error('Unknown target statement class: "%s"',[EL.ClassName])
+    Error('Unknown target statement class: "%s"',[El.ClassName])
 end;
 
 procedure TJSWriter.WriteReturnStatement(El: TJSReturnStatement);
@@ -1384,6 +1409,8 @@ begin
 end;
 
 procedure TJSWriter.WriteJS(El: TJSElement);
+var
+  LastWritingEl: TJSElement;
 begin
 {$IFDEF DEBUGJSWRITER}
   if (EL<>Nil) then
@@ -1391,6 +1418,8 @@ begin
   else
     system.Writeln('WriteJS : El = Nil');
 {$ENDIF}
+  LastWritingEl:=Writer.CurElement;
+  Writer.CurElement:=El;
   if (El is TJSEmptyBlockStatement ) then
     WriteEmptyBlockStatement(TJSEmptyBlockStatement(El))
   else if (El is TJSEmptyStatement) then
@@ -1449,6 +1478,7 @@ begin
     Error(SErrUnknownJSClass,[El.ClassName]);
 //  Write('/* '+El.ClassName+' */');
   FSkipCurlyBrackets:=False;
+  Writer.CurElement:=LastWritingEl;
 end;
 
 { TFileWriter }
@@ -1467,6 +1497,7 @@ end;
 
 Constructor TFileWriter.Create(Const AFileNAme: String);
 begin
+  inherited Create;
   FFileName:=AFileName;
   Assign(FFile,AFileName);
   Rewrite(FFile);
@@ -1490,33 +1521,103 @@ end;
 
 { TTextWriter }
 
-Function TTextWriter.Write(Const S: UnicodeString) : Integer;
+procedure TTextWriter.Writing;
 begin
+  if Assigned(OnWriting) then
+    OnWriting(Self);
+end;
+
+constructor TTextWriter.Create;
+begin
+  FCurLine:=1;
+  FCurColumn:=1;
+end;
+
+function TTextWriter.Write(const S: UnicodeString): Integer;
+var
+  p: PWideChar;
+  c: WideChar;
+begin
+  if S='' then exit;
+  Writing;
   Result:=DoWrite(S);
+  p:=PWideChar(S);
+  repeat
+    c:=p^;
+    case c of
+    #0:
+      if p-PWideChar(S)=length(S)*2 then
+        break
+      else
+        inc(FCurColumn);
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
+      continue;
+      end;
+    else
+      // ignore low/high surrogate, CurColumn is char index, not codepoint
+      inc(FCurColumn);
+    end;
+    inc(p);
+  until false;
 end;
 
-Function TTextWriter.Write(Const S: AnsiString) : integer;
+function TTextWriter.Write(const S: AnsiString): Integer;
+var
+  p: PChar;
+  c: Char;
 begin
+  if S='' then exit;
+  Writing;
   Result:=DoWrite(S);
+  p:=PChar(S);
+  repeat
+    c:=p^;
+    case c of
+    #0:
+      if p-PChar(S)=length(S) then
+        break
+      else
+        inc(FCurColumn);
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
+      continue;
+      end;
+    else
+      // ignore UTF-8 multibyte chars, CurColumn is char index, not codepoint
+      inc(FCurColumn);
+    end;
+    inc(p);
+  until false;
 end;
 
-Function TTextWriter.WriteLn(Const S: AnsiString) : Integer;
+function TTextWriter.WriteLn(const S: AnsiString): Integer;
 begin
-  Result:=DoWrite(S)+DoWrite(sLineBreak);
+  Result:=Write(S)+Write(sLineBreak);
 end;
 
-Function TTextWriter.Write(Const Fmt: AnsiString; Args: Array of const) : Integer;
+function TTextWriter.Write(const Fmt: AnsiString;
+  Args: array of const): Integer;
 
 begin
-  Result:=DoWrite(Format(Fmt,Args));
+  Result:=Write(Format(Fmt,Args));
 end;
 
-Function TTextWriter.WriteLn(Const Fmt: AnsiString; Args: Array of const) : integer;
+function TTextWriter.WriteLn(const Fmt: AnsiString;
+  Args: array of const): Integer;
 begin
   Result:=WriteLn(Format(Fmt,Args));
 end;
 
-Function TTextWriter.Write(Const Args: Array of const) : Integer;
+function TTextWriter.Write(const Args: array of const): Integer;
 
 Var
   I : Integer;
@@ -1552,11 +1653,11 @@ begin
     if (U<>'') then
       Result:=Result+Write(u)
     else if (S<>'') then
-      Result:=Result+write(s);
+      Result:=Result+Write(s);
     end;
 end;
 
-Function TTextWriter.WriteLn(Const Args: Array of const) : integer;
+function TTextWriter.WriteLn(const Args: array of const): Integer;
 begin
   Result:=Write(Args)+Writeln('');
 end;

packages/fcl-js/tests/tcsrcmap.pas

@@ -0,0 +1,175 @@
+unit TCSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, JSSrcMap;
+
+type
+
+  { TCustomTestSrcMap }
+
+  TCustomTestSrcMap = class(TTestCase)
+  protected
+    procedure CheckEl(aName: String; El: TJSONData; aClass: TClass);
+    function GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+  end;
+
+  { TTestSrcMap }
+
+  TTestSrcMap = class(TCustomTestSrcMap)
+  published
+    procedure Test_Base64VLQ;
+    procedure TestSrcMapIgnoreDuplicate;
+    procedure TestSrcMapNames;
+  end;
+
+implementation
+
+{ TCustomTestSrcMap }
+
+procedure TCustomTestSrcMap.CheckEl(aName: String; El: TJSONData; aClass: TClass);
+begin
+  AssertNotNull('json "'+aName+'" exists',El);
+  AssertEquals('json "'+aName+'" class',El.ClassType,aClass);
+end;
+
+function TCustomTestSrcMap.GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+begin
+  Result:=Obj.Elements[aName];
+  CheckEl(aName,Result,aClass);
+end;
+
+{ TTestSrcMap }
+
+procedure TTestSrcMap.Test_Base64VLQ;
+var
+  i: Integer;
+  s: String;
+  p: PChar;
+  j: NativeInt;
+begin
+  for i:=-511 to 511 do
+  begin
+    s:=EncodeBase64VLQ(i);
+    p:=PChar(s);
+    j:=DecodeBase64VLQ(p);
+    if i<>j then
+      Fail('Encode/DecodeBase64VLQ OrigIndex='+IntToStr(i)+' Code="'+s+'" NewIndex='+IntToStr(j));
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapIgnoreDuplicate;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,0,'a.js',1,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(3,0,'a.js',2,0);
+
+    //writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: [],
+      mappings: 'AAAA;A;AACA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,0);
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'AAAA;A;AACA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapNames;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,1,'a.js',2,2,'foo');
+    sm.AddMapping(3,3,'a.js',4,4,'foo');
+    writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: ['foo'],
+      mappings: 'CACEA;;GAEEA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('names[0]',El,TJSONString);
+    AssertEquals('json "names[0]" value',El.AsString,'foo');
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'CACEA;;GAEEA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+initialization
+  RegisterTests([TTestSrcMap]);
+end.
+

packages/fcl-js/tests/testjs.lpi

@@ -1,32 +1,21 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
+      <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
-      <ActiveWindowIndexAtStart Value="0"/>
+      <UseAppBundle Value="False"/>
     </General>
-    <VersionInfo>
-      <Language Value=""/>
-      <CharSet Value=""/>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestStatementWriter"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -34,260 +23,84 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="16">
+    <Units Count="13">
       <Unit0>
         <Filename Value="testjs.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjs"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="48" Y="3"/>
-        <UsageCount Value="201"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcscanner.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcscanner"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="17" Y="22"/>
-        <UsageCount Value="201"/>
       </Unit1>
       <Unit2>
         <Filename Value="../src/jsbase.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jsbase"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="1" Y="12"/>
-        <UsageCount Value="200"/>
       </Unit2>
       <Unit3>
         <Filename Value="../src/jsparser.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jsparser"/>
-        <EditorIndex Value="3"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="67"/>
-        <CursorPos X="14" Y="85"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit3>
       <Unit4>
         <Filename Value="../src/jsscanner.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="JSScanner"/>
-        <EditorIndex Value="6"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="342"/>
-        <CursorPos X="76" Y="345"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit4>
       <Unit5>
         <Filename Value="../src/jstree.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jstree"/>
-        <EditorIndex Value="5"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="739"/>
-        <CursorPos X="3" Y="757"/>
-        <UsageCount Value="200"/>
-        <Loaded Value="True"/>
       </Unit5>
       <Unit6>
         <Filename Value="tcparser.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcparser"/>
-        <EditorIndex Value="4"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1878"/>
-        <CursorPos X="3" Y="1883"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit6>
       <Unit7>
         <Filename Value="../src/jswriter.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jswriter"/>
-        <EditorIndex Value="0"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="8"/>
-        <CursorPos X="28" Y="15"/>
-        <UsageCount Value="202"/>
-        <Loaded Value="True"/>
       </Unit7>
       <Unit8>
         <Filename Value="tctextwriter.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tctextwriter"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="4"/>
-        <CursorPos X="15" Y="22"/>
-        <UsageCount Value="201"/>
       </Unit8>
       <Unit9>
-        <Filename Value="../../../../../projects/lazarus/components/fpcunit/console/consoletestrunner.pas"/>
-        <UnitName Value="consoletestrunner"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="157"/>
-        <CursorPos X="1" Y="175"/>
-        <UsageCount Value="4"/>
+        <Filename Value="tcwriter.pp"/>
+        <IsPartOfProject Value="True"/>
       </Unit9>
       <Unit10>
-        <Filename Value="tcwriter.pp"/>
+        <Filename Value="../src/jstoken.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcwriter"/>
-        <IsVisibleTab Value="True"/>
-        <EditorIndex Value="2"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="668"/>
-        <CursorPos X="45" Y="698"/>
-        <UsageCount Value="220"/>
-        <Loaded Value="True"/>
       </Unit10>
       <Unit11>
-        <Filename Value="../../../../released/packages/fcl-json/src/fpjson.pp"/>
-        <UnitName Value="fpjson"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="558"/>
-        <CursorPos X="21" Y="580"/>
-        <UsageCount Value="61"/>
+        <Filename Value="tcsrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCSrcMap"/>
       </Unit11>
       <Unit12>
-        <Filename Value="../src/jstoken.pp"/>
+        <Filename Value="../src/jssrcmap.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jstoken"/>
-        <EditorIndex Value="1"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="18" Y="8"/>
-        <UsageCount Value="200"/>
-        <Loaded Value="True"/>
+        <UnitName Value="JSSrcMap"/>
       </Unit12>
-      <Unit13>
-        <Filename Value="../../../../released/packages/fcl-fpcunit/src/testregistry.pp"/>
-        <UnitName Value="testregistry"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="106"/>
-        <CursorPos X="22" Y="108"/>
-        <UsageCount Value="13"/>
-      </Unit13>
-      <Unit14>
-        <Filename Value="../../../rtl/tests/punit.pp"/>
-        <UnitName Value="punit"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="405"/>
-        <CursorPos X="41" Y="415"/>
-        <UsageCount Value="18"/>
-      </Unit14>
-      <Unit15>
-        <Filename Value="../../../../released/rtl/inc/mathh.inc"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="60"/>
-        <CursorPos X="14" Y="78"/>
-        <UsageCount Value="13"/>
-      </Unit15>
     </Units>
-    <JumpHistory Count="6" HistoryIndex="5">
-      <Position1>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position1>
-      <Position2>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1732" Column="55" TopLine="1713"/>
-      </Position2>
-      <Position3>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1883" Column="3" TopLine="1878"/>
-      </Position3>
-      <Position4>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="66" Column="43" TopLine="51"/>
-      </Position4>
-      <Position5>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="76" Column="43" TopLine="48"/>
-      </Position5>
-      <Position6>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="251" Column="31" TopLine="232"/>
-      </Position6>
-    </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="/home/michael/source/fcl-js/;..;../src"/>
+      <OtherUnitFiles Value="../src"/>
     </SearchPaths>
     <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
       <Optimizations>
         <OptimizationLevel Value="0"/>
       </Optimizations>
     </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-      </Debugging>
-    </Linking>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
-    <BreakPoints Count="7">
-      <Item1>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsGlobal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../jsscanner.pp"/>
-        <Line Value="717"/>
-      </Item1>
-      <Item2>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2086"/>
-      </Item2>
-      <Item3>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2566"/>
-      </Item3>
-      <Item4>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="845"/>
-      </Item4>
-      <Item5>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="754"/>
-      </Item5>
-      <Item6>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="1287"/>
-      </Item6>
-      <Item7>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2253"/>
-      </Item7>
-    </BreakPoints>
     <Exceptions Count="3">
       <Item1>
         <Name Value="EAbort"/>
@@ -300,5 +113,4 @@
       </Item3>
     </Exceptions>
   </Debugging>
-  <EditorMacros Count="0"/>
 </CONFIG>

packages/fcl-js/tests/testjs.lpr

@@ -7,7 +7,7 @@ uses
   cwstring,
   {$ENDIF}
   Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
-  tcparser, jswriter, tcwriter, jstoken;
+  tcparser, jswriter, tcwriter, jstoken, JSSrcMap, TCSrcMap;
 
 var
   Application: TTestRunner;

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'
@@ -309,7 +309,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
@@ -440,6 +440,7 @@ type
     pbifnSet_SymDiffSet,
     pbifnSet_Union,
     pbifnSpaceLeft,
+    pbifnStringSetLength,
     pbifnUnitInit,
     pbivnExceptObject,
     pbivnImplementation,
@@ -536,6 +537,7 @@ const
     'symDiffSet', // rtl.symDiffSet >< (symmetrical difference)
     'unionSet', // rtl.unionSet +
     'spaceLeft', // rtl.spaceLeft
+    'strSetLength',
     '$init',
     '$e',
     '$impl',
@@ -1128,6 +1130,7 @@ type
     Function CreateBuiltInIdentifierExpr(AName: string): TJSPrimaryExpressionIdent;
     Function CreateSubDeclNameExpr(El: TPasElement; const Name: string;
       AContext: TConvertContext): TJSPrimaryExpressionIdent;
+    Function CreateIdentifierExpr(El: TPasElement; AContext: TConvertContext): TJSPrimaryExpressionIdent;
     Function CreateIdentifierExpr(AName: string; El: TPasElement; AContext: TConvertContext): TJSPrimaryExpressionIdent;
     Function CreateSwitchStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
     Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement;
@@ -3424,13 +3427,13 @@ Var
   OuterSrc , Src: TJSSourceElements;
   RegModuleCall: TJSCallExpression;
   ArgArray: TJSArguments;
-  UsesList: TFPList;
   FunDecl, ImplFunc: TJSFunctionDeclarationStatement;
   UsesSection: TPasSection;
   ModuleName, ModVarName: String;
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
   HasImplUsesList: Boolean;
+  UsesList: TFPList;
 begin
   Result:=Nil;
   OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@@ -4282,12 +4285,20 @@ begin
   Result:=CreateDotExpression(El,Left,Right);
 end;
 
-function TPasToJSConverter.CreateIdentifierExpr(AName: string; El: TPasElement;
+function TPasToJSConverter.CreateIdentifierExpr(El: TPasElement;
   AContext: TConvertContext): TJSPrimaryExpressionIdent;
+var
+  I: TJSPrimaryExpressionIdent;
+begin
+  I:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
+  I.Name:=TJSString(TransformVariableName(El,AContext));
+  Result:=I;
+end;
 
+function TPasToJSConverter.CreateIdentifierExpr(AName: string; El: TPasElement;
+  AContext: TConvertContext): TJSPrimaryExpressionIdent;
 Var
   I : TJSPrimaryExpressionIdent;
-
 begin
   I:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
   AName:=TransformVariableName(El,AName,AContext);
@@ -5895,8 +5906,7 @@ var
   ResolvedParam0: TPasResolverResult;
   ArrayType: TPasArrayType;
   Call: TJSCallExpression;
-  ValInit, Arg: TJSElement;
-  AssignSt: TJSSimpleAssignStatement;
+  ValInit: TJSElement;
   AssignContext: TAssignContext;
   ElType: TPasType;
 begin
@@ -5948,21 +5958,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
@@ -6046,21 +6061,96 @@ end;
 
 function TPasToJSConverter.ConvertBuiltIn_IncDec(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
-// convert inc(a,b) to a+=b
-// convert dec(a,b) to a-=b
+{ inc(a) or inc(a,b)
+ if a is a variable:
+   convert inc(a,b) to a+=b
+ if a is a var/out arg:
+   convert inc(a,b) to a.set(a.get+b)
+ if a is a property
+   Getter: field, procedure
+ if a is an indexed-property
+   Getter: field, procedure
+ if a is a property with index-specifier
+   Getter: field, procedure
+}
 var
   AssignSt: TJSAssignStatement;
+  Expr: TPasExpr;
+  ExprResolved: TPasResolverResult;
+  ExprArg: TPasArgument;
+  ValueJS: TJSElement;
+  Call: TJSCallExpression;
+  IsInc: Boolean;
+  AddJS: TJSAdditiveExpression;
 begin
-  if CompareText((El.Value as TPrimitiveExpr).Value,'inc')=0 then
-    AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El))
-  else
-    AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
-  Result:=AssignSt;
-  AssignSt.LHS:=ConvertExpression(El.Params[0],AContext);
+  Result:=nil;
+  IsInc:=CompareText((El.Value as TPrimitiveExpr).Value,'inc')=0;
+  Expr:=El.Params[0];
+  AContext.Resolver.ComputeElement(Expr,ExprResolved,[]);
+
+  // convert value
   if length(El.Params)=1 then
-    AssignSt.Expr:=CreateLiteralNumber(El,1)
+    ValueJS:=CreateLiteralNumber(El,1)
   else
-    AssignSt.Expr:=ConvertExpression(El.Params[1],AContext);
+    ValueJS:=ConvertExpression(El.Params[1],AContext);
+
+  // check target variable
+  AssignSt:=nil;
+  Call:=nil;
+  try
+    if ExprResolved.IdentEl is TPasArgument then
+      begin
+      ExprArg:=TPasArgument(ExprResolved.IdentEl);
+      if ExprArg.Access in [argVar,argOut] then
+        begin
+        // target variable is a reference
+        // -> convert inc(ref,b)  to  ref.set(ref.get()+b)
+        Call:=CreateCallExpression(El);
+        // create "ref.set"
+        Call.Expr:=CreateDotExpression(El,
+          CreateIdentifierExpr(ExprResolved.IdentEl,AContext),
+          CreateBuiltInIdentifierExpr(TempRefObjSetterName));
+        // create "+"
+        if IsInc then
+          AddJS:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El))
+        else
+          AddJS:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
+        Call.AddArg(AddJS);
+        // create "ref.get()"
+        AddJS.A:=TJSCallExpression(CreateElement(TJSCallExpression,El));
+        TJSCallExpression(AddJS.A).Expr:=CreateDotExpression(El,
+          CreateIdentifierExpr(ExprResolved.IdentEl,AContext),
+          CreateBuiltInIdentifierExpr(TempRefObjGetterName));
+        // add "b"
+        AddJS.B:=ValueJS;
+        ValueJS:=nil;
+
+        Result:=Call;
+        exit;
+        end;
+      end
+    else if ExprResolved.IdentEl is TPasProperty then
+      begin
+      RaiseNotSupported(Expr,AContext,20170501151316);
+      end;
+
+    // convert inc(avar,b)  to  a+=b
+    if IsInc then
+      AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El))
+    else
+      AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
+    AssignSt.LHS:=ConvertExpression(El.Params[0],AContext);
+    AssignSt.Expr:=ValueJS;
+    ValueJS:=nil;
+    Result:=AssignSt;
+  finally
+    ValueJS.Free;
+    if Result=nil then
+      begin
+      AssignSt.Free;
+      Call.Free;
+      end;
+  end;
 end;
 
 function TPasToJSConverter.ConvertBuiltIn_Assigned(El: TParamsExpr;

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;
@@ -357,6 +358,7 @@ type
     Procedure TestClass_NestedSelf;
     Procedure TestClass_NestedClassSelf;
     Procedure TestClass_NestedCallInherited;
+    Procedure TestClass_TObjectFree; // ToDO
 
     // class of
     Procedure TestClassOf_Create;
@@ -1680,16 +1682,27 @@ end;
 procedure TTestModule.TestIncDec;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  Bar: longint;');
-  Add('begin');
-  Add('  inc(bar);');
-  Add('  inc(bar,2);');
-  Add('  dec(bar);');
-  Add('  dec(bar,3);');
+  Add([
+  'procedure DoIt(var i: longint);',
+  'begin',
+  '  inc(i);',
+  '  inc(i,2);',
+  'end;',
+  'var',
+  '  Bar: longint;',
+  'begin',
+  '  inc(bar);',
+  '  inc(bar,2);',
+  '  dec(bar);',
+  '  dec(bar,3);',
+  '']);
   ConvertProgram;
   CheckSource('TestIncDec',
     LinesToStr([ // statements
+    'this.DoIt = function (i) {',
+    '  i.set(i.get()+1);',
+    '  i.set(i.get()+2);',
+    '};',
     'this.Bar = 0;'
     ]),
     LinesToStr([ // this.$main
@@ -2237,11 +2250,8 @@ begin
   Add('  now();');
   Add('  uNit2.now;');
   Add('  uNit2.now();');
-  Add('  test1.now;');
-  Add('  test1.now();');
   Add('  doit;');
   Add('  uNit2.doit;');
-  Add('  test1.doit;');
   ConvertUnit;
   CheckSource('TestProcedureExternalOtherUnit',
     LinesToStr([
@@ -2251,12 +2261,9 @@ begin
     'Date.now();',
     'Date.now();',
     'Date.now();',
-    'Date.now();',
-    'Date.now();',
     'pas.unit2.DoIt();',
     'pas.unit2.DoIt();',
-    'pas.unit2.DoIt();'
-    ]));
+    '']));
 end;
 
 procedure TTestModule.TestProc_Asm;
@@ -3573,10 +3580,10 @@ begin
   Add('begin');
   Add('  d:=nan;');
   Add('  d:=uNit2.nan;');
-  Add('  d:=test1.nan;');
+  Add('  d:=test1.d;');
   Add('  i:=iv;');
   Add('  i:=uNit2.iv;');
-  Add('  i:=test1.iv;');
+  Add('  i:=test1.i;');
   ConvertUnit;
   CheckSource('TestVarExternalOtherUnit',
     LinesToStr([
@@ -3585,10 +3592,10 @@ begin
     LinesToStr([ // this.$init
     '$impl.d = Global.NaN;',
     '$impl.d = Global.NaN;',
-    '$impl.d = Global.NaN;',
-    '$i = pas.unit2.iV;',
+    '$impl.d = $impl.d;',
     '$i = pas.unit2.iV;',
     '$i = pas.unit2.iV;',
+    '$i = $i;',
     '']),
     LinesToStr([ // implementation
     '$impl.d = 0.0;',
@@ -3843,16 +3850,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;
 
@@ -4940,6 +4956,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);
@@ -8026,6 +8064,59 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_TObjectFree;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    Obj: tobject;',
+  '    procedure Free;',
+  '  end;',
+  'procedure tobject.free;',
+  'begin',
+  'end;',
+  'function DoIt(o: tobject): tobject;',
+  'var l: tobject;',
+  'begin',
+  '  o.free;',
+  '  o.free();',
+  '  l.free;',
+  '  o.obj.free;',
+  '  o.obj.free();',
+  '  result.Free;',
+  '  result.Free();',
+  'end;',
+  'var o: tobject;',
+  'begin',
+  '  o.free;',
+  '  o.obj.free;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_NestedCallInherited',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Obj = null;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Free = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (o) {',
+    '  var Result = null;',
+    '  var l = null;',
+    '  return Result;',
+    '};',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestClassOf_Create;
 begin
   StartProgram(false);

packages/pastojs/tests/tcoptimizations.pas

@@ -24,7 +24,7 @@ unit tcoptimizations;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testregistry, fppas2js, pastree,
+  Classes, SysUtils, testregistry, fppas2js, pastree,
   PScanner, PasUseAnalyzer, PasResolver,
   tcmodules;