mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 09:47:25 +01:00
pastojs: added test for generating sourcemap
git-svn-id: trunk@37236 -
This commit is contained in:
parent
1f92f3c754
commit
49115a4199
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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';
|
||||
|
||||
|
||||
212
packages/pastojs/src/fppjssrcmap.pp
Normal file
212
packages/pastojs/src/fppjssrcmap.pp
Normal 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.
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;',
|
||||
|
||||
241
packages/pastojs/tests/tcsrcmap.pas
Normal file
241
packages/pastojs/tests/tcsrcmap.pas
Normal 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.
|
||||
|
||||
@ -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>
|
||||
|
||||
@ -17,7 +17,7 @@ program testpas2js;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations;
|
||||
Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap;
|
||||
|
||||
type
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user