Browse Source

pastojs: added test for generating sourcemap

git-svn-id: trunk@37236 -
Mattias Gaertner 8 years ago
parent
commit
49115a4199

+ 2 - 0
.gitattributes

@@ -6834,9 +6834,11 @@ packages/pastojs/Makefile svneol=native#text/plain
 packages/pastojs/Makefile.fpc svneol=native#text/plain
 packages/pastojs/Makefile.fpc svneol=native#text/plain
 packages/pastojs/fpmake.pp svneol=native#text/plain
 packages/pastojs/fpmake.pp svneol=native#text/plain
 packages/pastojs/src/fppas2js.pp svneol=native#text/plain
 packages/pastojs/src/fppas2js.pp svneol=native#text/plain
+packages/pastojs/src/fppjssrcmap.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
 packages/pastojs/tests/tcoptimizations.pas svneol=native#text/plain
 packages/pastojs/tests/tcoptimizations.pas svneol=native#text/plain
+packages/pastojs/tests/tcsrcmap.pas svneol=native#text/plain
 packages/pastojs/tests/testpas2js.lpi svneol=native#text/plain
 packages/pastojs/tests/testpas2js.lpi svneol=native#text/plain
 packages/pastojs/tests/testpas2js.pp svneol=native#text/plain
 packages/pastojs/tests/testpas2js.pp svneol=native#text/plain
 packages/pastojs/todo.txt svneol=native#text/plain
 packages/pastojs/todo.txt svneol=native#text/plain

+ 1 - 0
packages/pastojs/fpmake.pp

@@ -33,6 +33,7 @@ begin
     P.Options.Add('-S2h');
     P.Options.Add('-S2h');
 
 
     T:=P.Targets.AddUnit('fppas2js.pp');
     T:=P.Targets.AddUnit('fppas2js.pp');
+    T:=P.Targets.AddUnit('fppjssrcmap.pp');
 {$ifndef ALLPACKAGES}
 {$ifndef ALLPACKAGES}
     Run;
     Run;
     end;
     end;

+ 10 - 17
packages/pastojs/src/fppas2js.pp

@@ -128,7 +128,7 @@ Works:
   - procedure delete(var array,const start,count)
   - procedure delete(var array,const start,count)
   - const c: dynarray = (a,b,...)
   - const c: dynarray = (a,b,...)
 - static arrays
 - static arrays
-  - range: enumtype
+  - range: enumtype, boolean, int, char, custom int
   - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
   - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
   - init with expression
   - init with expression
   - length(1-dim array)
   - length(1-dim array)
@@ -250,18 +250,13 @@ Works:
 
 
 ToDos:
 ToDos:
 - ignore attributes
 - ignore attributes
-- constant evaluation
 - static arrays
 - static arrays
   - error on "arr:=nil"
   - error on "arr:=nil"
-  - error on "if arr=nil then"
-  - error on "if Assigned(arr) then"
   - error on "setlength(arr,2)"
   - error on "setlength(arr,2)"
-  - a[int]
-  - a[boolean]
-  - a[enum]
-  - a[char]
+  - error on "insert(arr,2)"
+  - error on "delete(arr,2)"
   - a[][]
   - a[][]
-  - const
+  - a[] of record
   - RTTI
   - RTTI
 - property index specifier
 - property index specifier
 - RTTI
 - RTTI
@@ -325,10 +320,10 @@ Not in Version 1.0:
 - inline
 - inline
 - anonymous functions
 - anonymous functions
 
 
-Compile flags for debugging: -d<x>
+Debugging this unit: -d<x>
    VerbosePas2JS
    VerbosePas2JS
 *)
 *)
-unit fppas2js;
+unit FPPas2Js;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 {$inline on}
 {$inline on}
@@ -342,7 +337,7 @@ uses
 // message numbers
 // message numbers
 const
 const
   nPasElementNotSupported = 4001;
   nPasElementNotSupported = 4001;
-  nIdentifierNotFound = 4002;
+  nNotSupportedX = 4002;
   nUnaryOpcodeNotSupported = 4003;
   nUnaryOpcodeNotSupported = 4003;
   nBinaryOpcodeNotSupported = 4004;
   nBinaryOpcodeNotSupported = 4004;
   nInvalidNumber = 4005;
   nInvalidNumber = 4005;
@@ -362,13 +357,12 @@ const
   nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
   nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
   nBracketAccessorOfExternalClassMustHaveOneParameter = 4020;
   nBracketAccessorOfExternalClassMustHaveOneParameter = 4020;
   nTypeXCannotBePublished = 4021;
   nTypeXCannotBePublished = 4021;
-  nNotSupportedX = 4022;
-  nNestedInheritedNeedsParameters = 4023;
-  nFreeNeedsVar = 4024;
+  nNestedInheritedNeedsParameters = 4022;
+  nFreeNeedsVar = 4023;
 // resourcestring patterns of messages
 // resourcestring patterns of messages
 resourcestring
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
   sPasElementNotSupported = 'Pascal element not supported: %s';
-  sIdentifierNotFound = 'Identifier not found "%s"';
+  sNotSupportedX = 'Not supported: %s';
   sUnaryOpcodeNotSupported = 'Unary OpCode not yet supported "%s"';
   sUnaryOpcodeNotSupported = 'Unary OpCode not yet supported "%s"';
   sBinaryOpcodeNotSupported = 'Binary OpCode not yet supported "%s"';
   sBinaryOpcodeNotSupported = 'Binary OpCode not yet supported "%s"';
   sInvalidNumber = 'Invalid number "%s"';
   sInvalidNumber = 'Invalid number "%s"';
@@ -388,7 +382,6 @@ resourcestring
   sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
   sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
   sBracketAccessorOfExternalClassMustHaveOneParameter = 'Bracket accessor of external class must have one parameter';
   sBracketAccessorOfExternalClassMustHaveOneParameter = 'Bracket accessor of external class must have one parameter';
   sTypeXCannotBePublished = 'Type "%s" cannot be published';
   sTypeXCannotBePublished = 'Type "%s" cannot be published';
-  sNotSupportedX = 'Not supported: %s';
   sNestedInheritedNeedsParameters = 'nested inherited needs parameters';
   sNestedInheritedNeedsParameters = 'nested inherited needs parameters';
   sFreeNeedsVar = 'Free needs a variable';
   sFreeNeedsVar = 'Free needs a variable';
 
 

+ 212 - 0
packages/pastojs/src/fppjssrcmap.pp

@@ -0,0 +1,212 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2014 by Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    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.
+
+ **********************************************************************
+}(*
+Abstract:
+  Pascal to JavaScript source map.
+
+
+*)
+unit FPPJsSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, math,
+  jswriter, jstree, JSSrcMap;
+
+type
+  { TPas2JSSrcMap }
+
+  TPas2JSSrcMap = class(TSourceMap)
+  private
+    fRefCount: integer;
+  public
+    LocalFilename: string;
+    procedure AddRef;
+    procedure Release;
+  end;
+
+  { TPas2JSMapper }
+
+  TPas2JSMapper = class(TBufferWriter)
+  private
+    FSrcMap: TPas2JSSrcMap;
+    procedure SetSrcMap(const AValue: TPas2JSSrcMap);
+  protected
+    FNeedMapping: boolean;
+    FGeneratedStartLine: integer; // first line where CurElement was set or a line was written
+    // last valid CurElement position
+    FSrcFilename: String;
+    FSrcLine: integer;
+    FSrcColumn: integer;
+    procedure SetCurElement(const AValue: TJSElement); override;
+    procedure Writing; override;
+  public
+    property SrcMap: TPas2JSSrcMap read FSrcMap write SetSrcMap;
+    destructor Destroy; override;
+    procedure WriteFile(Src, Filename: string);
+  end;
+
+implementation
+
+{ TPas2JSSrcMap }
+
+procedure TPas2JSSrcMap.AddRef;
+begin
+  inc(fRefCount);
+end;
+
+procedure TPas2JSSrcMap.Release;
+begin
+  if fRefCount<0 then
+    raise Exception.Create('TPas2JSSrcMap.Release');
+  dec(fRefCount);
+  if fRefCount<0 then
+    Free;
+end;
+
+{ TPas2JSMapper }
+
+procedure TPas2JSMapper.SetSrcMap(const AValue: TPas2JSSrcMap);
+begin
+  if FSrcMap=AValue then Exit;
+  if FSrcMap<>nil then
+    FSrcMap.Release;
+  FSrcMap:=AValue;
+  if FSrcMap<>nil then
+    FSrcMap.AddRef;
+end;
+
+procedure TPas2JSMapper.SetCurElement(const AValue: TJSElement);
+begin
+  {$IFDEF VerboseSrcMap}
+  system.write('TPas2JSWriter.SetCurElement ',CurLine,',',CurColumn);
+  if AValue<>nil then
+    system.writeln(' ',AValue.ClassName,' src=',ExtractFileName(AValue.Source),' ',AValue.Line,',',AValue.Column)
+  else
+    system.writeln(' NIL');
+  {$ENDIF}
+  inherited SetCurElement(AValue);
+  if (AValue<>nil) and (AValue.Source<>'') then
+    begin
+    if (FSrcFilename<>AValue.Source)
+        or (FSrcLine<>AValue.Line)
+        or (FSrcColumn<>AValue.Column) then
+      begin
+      FNeedMapping:=true;
+      FSrcFilename:=AValue.Source;
+      FSrcLine:=AValue.Line;
+      FSrcColumn:=AValue.Column;
+      end;
+    end;
+  if FGeneratedStartLine<1 then
+    FGeneratedStartLine:=CurLine;
+end;
+
+procedure TPas2JSMapper.Writing;
+var
+  S: TJSString;
+  p: PWideChar;
+  Line: Integer;
+begin
+  inherited Writing;
+  if SrcMap=nil then exit;
+
+  if FGeneratedStartLine<1 then
+    FGeneratedStartLine:=CurLine;
+
+  if not FNeedMapping then exit;
+  if FSrcFilename='' then
+    exit; // built-in element -> do not add a mapping
+
+  FNeedMapping:=false;
+  //system.writeln('TPas2JSWriter.Writing Generated.Line=',CurLine,',Col=',CurColumn-1,
+  //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine,',Col=',FSrcColumn-1);
+
+  SrcMap.AddMapping(CurLine,Max(0,CurColumn-1),
+    FSrcFilename,FSrcLine,Max(0,FSrcColumn-1));
+
+  if (CurElement is TJSLiteral)
+      and (TJSLiteral(CurElement).Value.CustomValue<>'') then
+    begin
+    // possible multi line value, e.g. asm-block
+    S:=TJSLiteral(CurElement).Value.CustomValue;
+    p:=PWideChar(S);
+    Line:=0;
+    repeat
+      case p^ of
+      #0:
+        break;
+      #10,#13:
+        begin
+        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+          inc(p,2)
+        else
+          inc(p);
+        inc(Line);
+        // add a mapping for each line
+        //system.writeln('TPas2JSWriter.Writing Generated.Line=',CurLine+Line,',Col=',0,
+        //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine+Line,',Col=',0);
+        SrcMap.AddMapping(CurLine+Line,0,
+          FSrcFilename,FSrcLine+Line,0);
+        end;
+      else
+        inc(p);
+      end;
+    until false;
+    end;
+end;
+
+destructor TPas2JSMapper.Destroy;
+begin
+  SrcMap:=nil;
+  inherited Destroy;
+end;
+
+procedure TPas2JSMapper.WriteFile(Src, Filename: string);
+var
+  p, EndP, LineStart: PChar;
+begin
+  if Src='' then exit;
+  FSrcFilename:=Filename;
+  FSrcLine:=1;
+  FSrcColumn:=1;
+  p:=PChar(Src);
+  EndP:=p+length(Src);
+  repeat
+    LineStart:=p;
+    repeat
+      case p^ of
+      #0: if p=EndP then break;
+      #10,#13:
+        begin
+        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+          inc(p);
+        inc(p);
+        break;
+        end;
+      end;
+      inc(p);
+    until false;
+    FNeedMapping:=true;
+    Write(copy(Src,LineStart-PChar(Src)+1,p-LineStart));
+    inc(FSrcLine);
+  until p>=EndP;
+end;
+
+end.
+

+ 19 - 9
packages/pastojs/tests/tcmodules.pas

@@ -24,8 +24,10 @@ unit tcmodules;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testregistry, contnrs, fppas2js, pastree,
-  PScanner, PasResolver, PParser, PasResolveEval, jstree, jswriter, jsbase;
+  Classes, SysUtils, fpcunit, testregistry, contnrs,
+  jstree, jswriter, jsbase,
+  PasTree, PScanner, PasResolver, PParser, PasResolveEval,
+  FPPas2Js;
 
 
 const
 const
   // default parser+scanner options
   // default parser+scanner options
@@ -118,6 +120,7 @@ type
     procedure ConvertModule; virtual;
     procedure ConvertModule; virtual;
     procedure ConvertProgram; virtual;
     procedure ConvertProgram; virtual;
     procedure ConvertUnit; virtual;
     procedure ConvertUnit; virtual;
+    function ConvertJSModuleToString(El: TJSElement): string; virtual;
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
     procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
     function GetDottedIdentifier(El: TJSElement): string;
     function GetDottedIdentifier(El: TJSElement): string;
     procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
     procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
@@ -564,6 +567,7 @@ var
   aWriter: TBufferWriter;
   aWriter: TBufferWriter;
   aJSWriter: TJSWriter;
   aJSWriter: TJSWriter;
 begin
 begin
+  aJSWriter:=nil;
   aWriter:=TBufferWriter.Create(1000);
   aWriter:=TBufferWriter.Create(1000);
   try
   try
     aJSWriter:=TJSWriter.Create(aWriter);
     aJSWriter:=TJSWriter.Create(aWriter);
@@ -571,6 +575,7 @@ begin
     aJSWriter.WriteJS(El);
     aJSWriter.WriteJS(El);
     Result:=aWriter.AsAnsistring;
     Result:=aWriter.AsAnsistring;
   finally
   finally
+    aJSWriter.Free;
     aWriter.Free;
     aWriter.Free;
   end;
   end;
 end;
 end;
@@ -962,7 +967,7 @@ begin
     Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
     Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
 
 
   FJSSource:=TStringList.Create;
   FJSSource:=TStringList.Create;
-  FJSSource.Text:=JSToStr(JSModule);
+  FJSSource.Text:=ConvertJSModuleToString(JSModule);
   {$IFDEF VerbosePas2JS}
   {$IFDEF VerbosePas2JS}
   writeln('TTestModule.ConvertModule JS:');
   writeln('TTestModule.ConvertModule JS:');
   write(FJSSource.Text);
   write(FJSSource.Text);
@@ -1054,6 +1059,11 @@ begin
   ConvertModule;
   ConvertModule;
 end;
 end;
 
 
+function TCustomTestModule.ConvertJSModuleToString(El: TJSElement): string;
+begin
+  Result:=tcmodules.JSToStr(El);
+end;
+
 procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
 procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
   DottedName: string);
   DottedName: string);
 begin
 begin
@@ -1601,7 +1611,7 @@ procedure TTestModule.TestBaseTypeSingleFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var s: single;');
   Add('var s: single;');
-  SetExpectedPasResolverError('identifier not found "single"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "single"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
@@ -1609,7 +1619,7 @@ procedure TTestModule.TestBaseTypeExtendedFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var e: extended;');
   Add('var e: extended;');
-  SetExpectedPasResolverError('identifier not found "extended"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "extended"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
@@ -4163,7 +4173,7 @@ procedure TTestModule.TestBaseType_AnsiStringFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var s: AnsiString');
   Add('var s: AnsiString');
-  SetExpectedPasResolverError('identifier not found "AnsiString"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "AnsiString"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
@@ -4171,7 +4181,7 @@ procedure TTestModule.TestBaseType_UnicodeStringFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var s: UnicodeString');
   Add('var s: UnicodeString');
-  SetExpectedPasResolverError('identifier not found "UnicodeString"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "UnicodeString"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
@@ -4179,7 +4189,7 @@ procedure TTestModule.TestBaseType_ShortStringFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var s: ShortString');
   Add('var s: ShortString');
-  SetExpectedPasResolverError('identifier not found "ShortString"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "ShortString"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
@@ -4187,7 +4197,7 @@ procedure TTestModule.TestBaseType_RawByteStringFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add('var s: RawByteString');
   Add('var s: RawByteString');
-  SetExpectedPasResolverError('identifier not found "RawByteString"',nIdentifierNotFound);
+  SetExpectedPasResolverError('identifier not found "RawByteString"',PasResolveEval.nIdentifierNotFound);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 

+ 4 - 4
packages/pastojs/tests/tcoptimizations.pas

@@ -738,7 +738,7 @@ begin
   Add('begin');
   Add('begin');
   Add('  j:=3;');
   Add('  j:=3;');
   ConvertProgram;
   ConvertProgram;
-  ActualSrc:=JSToStr(JSModule);
+  ActualSrc:=ConvertJSModuleToString(JSModule);
   ExpectedSrc:=LinesToStr([
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system", "unit2"], function () {',
     'rtl.module("program", ["system", "unit2"], function () {',
     '  var $mod = this;',
     '  var $mod = this;',
@@ -762,7 +762,7 @@ begin
   Add('procedure DoPrivate; begin end;');
   Add('procedure DoPrivate; begin end;');
   Add('begin');
   Add('begin');
   ConvertProgram;
   ConvertProgram;
-  ActualSrc:=JSToStr(JSModule);
+  ActualSrc:=ConvertJSModuleToString(JSModule);
   ExpectedSrc:=LinesToStr([
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
     'rtl.module("program", ["system"], function () {',
     '  var $mod = this;',
     '  var $mod = this;',
@@ -796,7 +796,7 @@ begin
   Add('begin');
   Add('begin');
   Add('  C.PublicA:=nil;');
   Add('  C.PublicA:=nil;');
   ConvertProgram;
   ConvertProgram;
-  ActualSrc:=JSToStr(JSModule);
+  ActualSrc:=ConvertJSModuleToString(JSModule);
   ExpectedSrc:=LinesToStr([
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
     'rtl.module("program", ["system"], function () {',
     '  var $mod = this;',
     '  var $mod = this;',
@@ -841,7 +841,7 @@ begin
   Add('  A:=nil;');
   Add('  A:=nil;');
   Add('  p:=typeinfo(B);');
   Add('  p:=typeinfo(B);');
   ConvertProgram;
   ConvertProgram;
-  ActualSrc:=JSToStr(JSModule);
+  ActualSrc:=ConvertJSModuleToString(JSModule);
   ExpectedSrc:=LinesToStr([
   ExpectedSrc:=LinesToStr([
     'rtl.module("program", ["system"], function () {',
     'rtl.module("program", ["system"], function () {',
     '  var $mod = this;',
     '  var $mod = this;',

+ 241 - 0
packages/pastojs/tests/tcsrcmap.pas

@@ -0,0 +1,241 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2014 by Michael Van Canneyt
+
+    Unit tests for Pascal-to-Javascript source map.
+
+    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.
+
+ **********************************************************************
+
+ Examples:
+    ./testpas2js --suite=TTestSrcMap.TestEmptyProgram
+}
+unit tcsrcmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  jstree, jswriter, JSSrcMap,
+  FPPas2Js, FPPJsSrcMap,
+  tcmodules, PasResolveEval;
+
+type
+
+  { TCustomTestSrcMap }
+
+  TCustomTestSrcMap = class(TCustomTestModule)
+  private
+    FJS_Writer: TJSWriter;
+    FPas2JSMapper: TPas2JSMapper;
+    FSrcMap: TPas2JSSrcMap;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    function ConvertJSModuleToString(El: TJSElement): string; override;
+    procedure CheckSrcMap(const aTitle: string); virtual;
+    procedure WriteSrcMapLine(GeneratedLine: integer);
+  public
+    property Pas2JSMapper: TPas2JSMapper read FPas2JSMapper; // fills SrcMap
+    property SrcMap: TPas2JSSrcMap read FSrcMap; // map container
+    property JS_Writer: TJSWriter read FJS_Writer; // JS element to text
+  end;
+
+  { TTestSrcMap }
+
+  TTestSrcMap = class(TCustomTestSrcMap)
+  published
+    procedure TestEmptyProgram;
+    procedure TestEmptyUnit;
+    procedure TestIf;
+  end;
+
+implementation
+
+{ TCustomTestSrcMap }
+
+procedure TCustomTestSrcMap.SetUp;
+begin
+  FSrcMap:=TPas2JSSrcMap.Create('test1.js.map');
+  FPas2JSMapper:=TPas2JSMapper.Create(4096);
+  FPas2JSMapper.SrcMap:=SrcMap;
+  SrcMap.Release;// release the refcount from the Create
+  //SrcMap.SourceRoot:='';
+  //SrcMap.LocalFilename:='';
+  fJS_Writer:=TJSWriter.Create(Pas2JSMapper);
+  JS_Writer.IndentSize:=2;
+  inherited SetUp;
+end;
+
+procedure TCustomTestSrcMap.TearDown;
+begin
+  // Note: SrcMap is freed by freeing Pas2JSMapper
+  FreeAndNil(FJS_Writer);
+  FreeAndNil(FPas2JSMapper);
+  inherited TearDown;
+end;
+
+function TCustomTestSrcMap.ConvertJSModuleToString(El: TJSElement): string;
+begin
+  writeln('TCustomTestSrcMap.JSToStr ',GetObjName(El));
+  JS_Writer.WriteJS(El);
+  Result:=Pas2JSMapper.AsAnsistring;
+end;
+
+procedure TCustomTestSrcMap.CheckSrcMap(const aTitle: string);
+var
+  i: Integer;
+begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TCustomTestSrcMap.CheckSrcMap ',aTitle);
+  {$ENDIF}
+  for i:=0 to SrcMap.Count-1 do
+    begin
+    write('TCustomTestSrcMap.CheckSrcMap i=',i,' Gen=',
+      SrcMap[i].GeneratedLine,',',SrcMap[i].GeneratedColumn);
+    write(' Src=');
+    if SrcMap[i].SrcFileIndex>0 then
+      write(SrcMap.SourceFiles[SrcMap[i].SrcFileIndex],',');
+    writeln(SrcMap[i].SrcLine,',',SrcMap[i].SrcColumn);
+    end;
+  for i:=1 to JSSource.Count do
+    WriteSrcMapLine(i);
+  WriteSources(Filename,1,1);
+end;
+
+procedure TCustomTestSrcMap.WriteSrcMapLine(GeneratedLine: integer);
+var
+  JS, Origins, Addition: String;
+  GeneratedCol: integer; // 0-based
+  i, diff, GenColStep: Integer;
+  aSeg: TSourceMapSegment;
+begin
+  JS:=JSSource[GeneratedLine-1];
+  Origins:='';
+  GeneratedCol:=0;// 0-based
+  i:=SrcMap.IndexOfSegmentAt(GeneratedLine,GeneratedCol);
+  aSeg:=nil;
+  if i<0 then
+    begin
+    // no segment at line start
+    i:=0;
+    if (i=SrcMap.Count) then
+      aSeg:=nil
+    else
+      aSeg:=SrcMap[i];
+    if (aSeg=nil) or (aSeg.GeneratedLine>GeneratedLine) then
+      begin
+      // no segment in line
+      for i:=1 to length(JS) do Origins:=Origins+'?';
+      writeln(JS);
+      writeln(Origins);
+      exit;
+      end
+    else
+      begin
+      // show "?" til start of first segment
+      for i:=1 to aSeg.GeneratedColumn do Origins:=Origins+'?';
+      end;
+    end
+  else
+    aSeg:=SrcMap[i];
+
+  repeat
+    Addition:='';
+    if (aSeg.GeneratedLine=GeneratedLine) and (aSeg.GeneratedColumn=GeneratedCol) then
+      begin
+      // segment starts here  -> write "|line,col"
+      Addition:='|'+IntToStr(aSeg.SrcLine)+','+IntToStr(aSeg.SrcColumn);
+      Origins:=Origins+Addition;
+      end;
+    inc(i);
+    // skip segments at same GeneratedLine/Col
+    while (i<SrcMap.Count) do
+      begin
+      aSeg:=SrcMap[i];
+      if (aSeg.GeneratedLine=GeneratedLine) and (aSeg.GeneratedColumn=GeneratedCol) then
+        inc(i)
+      else
+        break;
+      end;
+    if (i=SrcMap.Count) then
+      aSeg:=nil
+    else
+      aSeg:=SrcMap[i];
+    if (aSeg=nil) or (aSeg.GeneratedLine>GeneratedLine) then
+      begin
+      // in the last segment
+      while length(Origins)<length(JS) do
+        Origins:=Origins+'.';
+      writeln(JS);
+      writeln(Origins);
+      exit;
+      end;
+    // there is another segment in this line
+    // -> align JS and Origins
+    GenColStep:=aSeg.GeneratedColumn-GeneratedCol;
+    diff:=GenColStep-length(Addition);
+    if diff<0 then
+      // for example:
+      //  JS:       if(~~e)~~~{
+      //  Origins:  |12,3|12,5|12,7
+      Insert(StringOfChar('~',-diff),JS,length(Origins)-length(Addition)+1+GenColStep)
+    else
+      while diff>0 do
+        begin
+        Origins:=Origins+'.';
+        dec(diff);
+        end;
+    GeneratedCol:=aSeg.GeneratedColumn;
+  until false;
+end;
+
+{ TTestSrcMap }
+
+procedure TTestSrcMap.TestEmptyProgram;
+begin
+  StartProgram(false);
+  Add('begin');
+  ConvertProgram;
+  CheckSrcMap('TestEmptyProgram');
+end;
+
+procedure TTestSrcMap.TestEmptyUnit;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'implementation'
+  ]);
+  ConvertUnit;
+  CheckSrcMap('TestEmptyUnit');
+end;
+
+procedure TTestSrcMap.TestIf;
+begin
+  StartProgram(false);
+  Add([
+  'var i: longint;',
+  'begin',
+  '  if true then',
+  '    i:=3',
+  '  else',
+  '    i:=5;',
+  '']);
+  ConvertProgram;
+  CheckSrcMap('TestEmptyProgram');
+end;
+
+Initialization
+  RegisterTests([TTestSrcMap]);
+
+end.
+

+ 11 - 1
packages/pastojs/tests/testpas2js.lpi

@@ -31,7 +31,7 @@
         <PackageName Value="FCL"/>
         <PackageName Value="FCL"/>
       </Item2>
       </Item2>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="5">
+    <Units Count="7">
       <Unit0>
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -43,6 +43,7 @@
       <Unit2>
       <Unit2>
         <Filename Value="../src/fppas2js.pp"/>
         <Filename Value="../src/fppas2js.pp"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="FPPas2Js"/>
       </Unit2>
       </Unit2>
       <Unit3>
       <Unit3>
         <Filename Value="tcmodules.pas"/>
         <Filename Value="tcmodules.pas"/>
@@ -52,6 +53,15 @@
         <Filename Value="tcoptimizations.pas"/>
         <Filename Value="tcoptimizations.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
       </Unit4>
       </Unit4>
+      <Unit5>
+        <Filename Value="tcsrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="../src/fppjssrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FPPJsSrcMap"/>
+      </Unit6>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 1 - 1
packages/pastojs/tests/testpas2js.pp

@@ -17,7 +17,7 @@ program testpas2js;
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
 
 
 uses
 uses
-  Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations;
+  Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap;
 
 
 type
 type