pastojs: added test for generating sourcemap

git-svn-id: trunk@37236 -
This commit is contained in:
Mattias Gaertner 2017-09-17 19:58:59 +00:00
parent 1f92f3c754
commit 49115a4199
9 changed files with 501 additions and 32 deletions

2
.gitattributes vendored
View File

@ -6834,9 +6834,11 @@ packages/pastojs/Makefile svneol=native#text/plain
packages/pastojs/Makefile.fpc svneol=native#text/plain
packages/pastojs/fpmake.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/tcmodules.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.pp svneol=native#text/plain
packages/pastojs/todo.txt svneol=native#text/plain

View File

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

View File

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

View File

@ -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.

View File

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

View File

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

View File

@ -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.

View File

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

View File

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