paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 20:29:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: implemented -Jpostproc cmd ; to call a post processor

Browse Source 
git-svn-id: trunk@40351 -
This commit is contained in:
Mattias Gaertner 2018-11-18 17:34:43 +00:00
parent ccb8e86560
commit d9f915964a
8 changed files with 469 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/fcl-js/src/jswriter.pp
View File

@ -109,7 +109,7 @@ Type
private
FBufPos,
FCapacity: Cardinal;
FBuffer : TBuffer;
FBuffer: TBuffer;
function GetAsString: TJSWriterString;
{$ifdef fpc}
function GetBuffer: Pointer;
@ -119,6 +119,7 @@ Type
{$ifdef FPC_HAS_CPSTRING}
function GetUnicodeString: UnicodeString;
{$endif}
procedure SetAsString(const AValue: TJSWriterString);
procedure SetCapacity(AValue: Cardinal);
Protected
Function DoWrite(Const S : TJSWriterString) : integer; override;
@ -136,7 +137,7 @@ Type
{$endif}
Property BufferLength : Integer Read GetBufferLength;
Property Capacity : Cardinal Read GetCapacity Write SetCapacity;
Property AsString : TJSWriterString Read GetAsString;
Property AsString : TJSWriterString Read GetAsString Write SetAsString;
{$ifdef FPC_HAS_CPSTRING}
Property AsAnsiString : AnsiString Read GetAsString; deprecated 'use AsString instead, fpc 3.3.1';
Property AsUnicodeString : UnicodeString Read GetUnicodeString;
@ -320,6 +321,16 @@ begin
end;
{$endif}
procedure TBufferWriter.SetAsString(const AValue: TJSWriterString);
begin
{$ifdef pas2js}
FBuffer:=TJSArray.new;
FCapacity:=0;
{$endif}
FBufPos:=0;
DoWrite(AValue);
end;
procedure TBufferWriter.SetCapacity(AValue: Cardinal);
begin
if FCapacity=AValue then Exit;
@ -328,7 +339,7 @@ begin
FBufPos:=Capacity;
end;
Function TBufferWriter.DoWrite(Const S: TJSWriterString): integer;
function TBufferWriter.DoWrite(const S: TJSWriterString): integer;
{$ifdef pas2js}
begin
Result:=Length(S)*2;
@ -358,7 +369,7 @@ end;
{$endif}
{$ifdef FPC_HAS_CPSTRING}
Function TBufferWriter.DoWrite(Const S: UnicodeString): integer;
function TBufferWriter.DoWrite(const S: UnicodeString): integer;
Var
DesLen,MinLen : Integer;
@ -379,14 +390,14 @@ begin
end;
{$endif}
Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
constructor TBufferWriter.Create(const ACapacity: Cardinal);
begin
inherited Create;
Capacity:=ACapacity;
end;
{$ifdef fpc}
Procedure TBufferWriter.SaveToFile(Const AFileName: String);
procedure TBufferWriter.SaveToFile(const AFileName: String);
Var
F : File;

2
packages/pastojs/src/fppas2js.pp
View File

@ -353,9 +353,11 @@ Works:
- dispose, new
- typecast byte(longword) -> value & $ff
- typecast TJSFunction(func)
- modeswitch OmitRTTI
ToDos:
- do not rename property Date
- cmd line param to set modeswitch
- bug: DoIt(typeinfo(i)) where DoIt is in another unit and has TTypeInfo
- bug:
v:=a[0] gives Local variable "a" is assigned but never used

489
packages/pastojs/src/pas2jscompiler.pp
View File

@ -24,7 +24,7 @@ uses
{$ELSE}
RtlConsts,
{$ENDIF}
Classes, SysUtils, contnrs,
Classes, SysUtils, contnrs, process,
jstree, jswriter, JSSrcMap,
PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
FPPas2Js, FPPJsSrcMap, Pas2jsFileUtils, Pas2jsLogger,
@ -81,6 +81,11 @@ const
nUnitFileNotFound = 136; sUnitFileNotFound = 'unit file not found %s';
nClassInterfaceStyleIs = 137; sClassInterfaceStyleIs = 'Class interface style is %s';
nMacroXSetToY = 138; sMacroXSetToY = 'Macro %s set to %s';
nPostProcessorX = 139; sPostProcessorX = 'Post processor: %s';
nPostProcessorRunX = 140; sPostProcessorRunX = 'Run post processor: %s';
nPostProcessorFailX = 141; sPostProcessorFailX = 'Post processor failed: %s';
nPostProcessorWarnX = 142; sPostProcessorWarnX = 'Post processor: %s';
nPostProcessorFinished = 143; sPostProcessorFinished = 'Post processor finished';
// Note: error numbers 201+ are used by Pas2jsFileCache
//------------------------------------------------------------------------------
@ -380,6 +385,12 @@ type
TPas2JSWPOptimizer = class(TPasAnalyzer)
end;
TPas2jsParamState = (
ppsSingle,
ppsPostProc
);
TPas2jsParamStates = set of TPas2jsParamState;
{ TPas2jsCompiler }
TPas2jsCompiler = class
@ -401,6 +412,8 @@ type
FMode: TP2jsMode;
FOptions: TP2jsCompilerOptions;
FParamMacros: TPas2jsMacroEngine;
FParamState: TPas2jsParamState;
FPostProcs: TObjectList;
FSrcMapSourceRoot: string;
FTargetPlatform: TPasToJsPlatform;
FTargetProcessor: TPasToJsProcessor;
@ -464,6 +477,7 @@ type
procedure LoadConfig(CfgFilename: string);
procedure LoadDefaultConfig;
procedure ParamFatal(Msg: string);
procedure CheckParamsClosed;
procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
procedure ReadSingleLetterOptions(const Param: string; p: integer;
const Allowed: string; out Enabled, Disabled: string);
@ -473,6 +487,8 @@ type
procedure RegisterMessages;
protected
// DoWriteJSFile: return false to use the default write function.
procedure CallPostProcessors(const JSFilename: String; aWriter: TPas2JSMapper); virtual;
function CallPostProcessor(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString; virtual;
function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; virtual;
procedure Compile(StartTime: TDateTime);
procedure ProcessQueue;
@ -516,9 +532,11 @@ type
procedure WriteVersionLine;
procedure WriteOptions;
procedure WriteDefines;
procedure WriteUsedTools;
procedure WriteFoldersAndSearchPaths;
procedure WriteInfo;
function GetShownMsgTypes: TMessageTypes;
function CmdListAsStr(CmdList: TStrings): string;
procedure AddDefine(const aName: String);
procedure AddDefine(const aName, Value: String);
@ -552,10 +570,12 @@ type
property Mode: TP2jsMode read FMode write SetMode;
property Options: TP2jsCompilerOptions read FOptions write SetOptions;
property ParamMacros: TPas2jsMacroEngine read FParamMacros;
property ParamState: TPas2jsParamState read FParamState;
{$IFDEF HasPas2jsFiler}
property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
{$ENDIF}
property PostProcs: TObjectList read FPostProcs; // list of TStrings
property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
property SrcMapEnable: boolean read GetSrcMapEnable write SetSrcMapEnable;
property SrcMapSourceRoot: string read FSrcMapSourceRoot write FSrcMapSourceRoot;
@ -2556,115 +2576,54 @@ begin
if aFile.IsMainFile and (TargetPlatform=PlatformNodeJS) then
aFileWriter.WriteFile('rtl.run();'+LineEnding,aFile.PasFilename);
// Give chance to descendants to write file
if DoWriteJSFile(aFile.JSFilename,aFileWriter) then
exit;// descendant has written -> finished
if (aFile.JSFilename='') and (FileCache.MainJSFile='.') then
if FreeWriter then
begin
// write to stdout
if FreeWriter then
CallPostProcessors(aFile.JSFilename,aFileWriter);
// Give chance to descendants to write file
if DoWriteJSFile(aFile.JSFilename,aFileWriter) then
exit;// descendant has written -> finished
if (aFile.JSFilename='') and (FileCache.MainJSFile='.') then
begin
{$IFDEF HasStdErr}
Log.WriteMsgToStdErr:=false;
{$ENDIF}
try
Log.LogRaw(aFileWriter.AsString);
finally
// write to stdout
if FreeWriter then
begin
{$IFDEF HasStdErr}
Log.WriteMsgToStdErr:=coWriteMsgToStdErr in Options;
Log.WriteMsgToStdErr:=false;
{$ENDIF}
end;
end;
end else if FreeWriter then
begin
// write to file
//writeln('TPas2jsCompiler.WriteJSFiles ',aFile.PasFilename,' ',aFile.JSFilename);
Log.LogMsg(nWritingFile,[QuoteStr(FileCache.FormatPath(DestFilename))],'',0,0,
not (coShowLineNumbers in Options));
// check output directory
DestDir:=ChompPathDelim(ExtractFilePath(DestFilename));
if (DestDir<>'') and not DirectoryExists(DestDir) then
begin
Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(FileCache.FormatPath(DestDir))]);
Terminate(ExitCodeFileNotFound);
end;
if DirectoryExists(DestFilename) then
begin
Log.LogMsg(nFileIsFolder,[QuoteStr(FileCache.FormatPath(DestFilename))]);
Terminate(ExitCodeWriteError);
end;
MapFilename:=DestFilename+'.map';
// write js
try
{$IFDEF Pas2js}
buf:=TJSArray.new;
{$ELSE}
buf:=TMemoryStream.Create;
{$ENDIF}
try
{$IFDEF FPC_HAS_CPSTRING}
// UTF8-BOM
if (Log.Encoding='') or (Log.Encoding='utf8') then
begin
Src:=String(UTF8BOM);
buf.Write(Src[1],length(Src));
end;
{$ENDIF}
// JS source
{$IFDEF Pas2js}
buf:=TJSArray(aFileWriter.Buffer).slice();
{$ELSE}
buf.Write(aFileWriter.Buffer^,aFileWriter.BufferLength);
{$ENDIF}
// source map comment
if aFileWriter.SrcMap<>nil then
begin
Src:='//# sourceMappingURL='+ExtractFilename(MapFilename)+LineEnding;
{$IFDEF Pas2js}
buf.push(Src);
{$ELSE}
buf.Write(Src[1],length(Src));
try
Log.LogRaw(aFileWriter.AsString);
finally
{$IFDEF HasStdErr}
Log.WriteMsgToStdErr:=coWriteMsgToStdErr in Options;
{$ENDIF}
end;
{$IFDEF Pas2js}
{$ELSE}
buf.Position:=0;
{$ENDIF}
FileCache.SaveToFile(buf,DestFilename);
finally
{$IFDEF Pas2js}
buf:=nil;
{$ELSE}
buf.Free;
{$ENDIF}
end;
except
on E: Exception do begin
if ShowDebug then
Log.LogExceptionBackTrace(E);
{$IFDEF FPC}
if E.Message<>SafeFormat(SFCreateError,[DestFileName]) then
{$ENDIF}
Log.LogPlain('Error: '+E.Message);
Log.LogMsg(nUnableToWriteFile,[QuoteStr(FileCache.FormatPath(DestFilename))]);
Terminate(ExitCodeWriteError);
end
{$IFDEF Pas2js}
else HandleJSException('[20181031190637] TPas2jsCompiler.WriteJSFiles',JSExceptValue,true);
{$ENDIF}
end;
// write source map
if aFileWriter.SrcMap<>nil then
end else if FreeWriter then
begin
Log.LogMsg(nWritingFile,[QuoteStr(FileCache.FormatPath(MapFilename))],'',0,0,
// write to file
//writeln('TPas2jsCompiler.WriteJSFiles ',aFile.PasFilename,' ',aFile.JSFilename);
Log.LogMsg(nWritingFile,[QuoteStr(FileCache.FormatPath(DestFilename))],'',0,0,
not (coShowLineNumbers in Options));
FinishSrcMap(aFileWriter.SrcMap);
// check output directory
DestDir:=ChompPathDelim(ExtractFilePath(DestFilename));
if (DestDir<>'') and not DirectoryExists(DestDir) then
begin
Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(FileCache.FormatPath(DestDir))]);
Terminate(ExitCodeFileNotFound);
end;
if DirectoryExists(DestFilename) then
begin
Log.LogMsg(nFileIsFolder,[QuoteStr(FileCache.FormatPath(DestFilename))]);
Terminate(ExitCodeWriteError);
end;
MapFilename:=DestFilename+'.map';
// write js
try
{$IFDEF Pas2js}
buf:=TJSArray.new;
@ -2672,13 +2631,35 @@ begin
buf:=TMemoryStream.Create;
{$ENDIF}
try
// Note: No UTF-8 BOM in source map, Chrome 59 gives an error
aFileWriter.SrcMap.SaveToStream(buf);
{$IFDEF FPC_HAS_CPSTRING}
// UTF8-BOM
if (Log.Encoding='') or (Log.Encoding='utf8') then
begin
Src:=String(UTF8BOM);
buf.Write(Src[1],length(Src));
end;
{$ENDIF}
// JS source
{$IFDEF Pas2js}
buf:=TJSArray(aFileWriter.Buffer).slice();
{$ELSE}
buf.Write(aFileWriter.Buffer^,aFileWriter.BufferLength);
{$ENDIF}
// source map comment
if aFileWriter.SrcMap<>nil then
begin
Src:='//# sourceMappingURL='+ExtractFilename(MapFilename)+LineEnding;
{$IFDEF Pas2js}
buf.push(Src);
{$ELSE}
buf.Write(Src[1],length(Src));
{$ENDIF}
end;
{$IFDEF Pas2js}
{$ELSE}
buf.Position:=0;
{$ENDIF}
FileCache.SaveToFile(buf,MapFilename);
FileCache.SaveToFile(buf,DestFilename);
finally
{$IFDEF Pas2js}
buf:=nil;
@ -2694,13 +2675,57 @@ begin
if E.Message<>SafeFormat(SFCreateError,[DestFileName]) then
{$ENDIF}
Log.LogPlain('Error: '+E.Message);
Log.LogMsg(nUnableToWriteFile,[QuoteStr(FileCache.FormatPath(MapFilename))]);
Log.LogMsg(nUnableToWriteFile,[QuoteStr(FileCache.FormatPath(DestFilename))]);
Terminate(ExitCodeWriteError);
end
{$IFDEF Pas2js}
else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
else HandleJSException('[20181031190637] TPas2jsCompiler.WriteJSFiles',JSExceptValue,true);
{$ENDIF}
end;
// write source map
if aFileWriter.SrcMap<>nil then
begin
Log.LogMsg(nWritingFile,[QuoteStr(FileCache.FormatPath(MapFilename))],'',0,0,
not (coShowLineNumbers in Options));
FinishSrcMap(aFileWriter.SrcMap);
try
{$IFDEF Pas2js}
buf:=TJSArray.new;
{$ELSE}
buf:=TMemoryStream.Create;
{$ENDIF}
try
// Note: No UTF-8 BOM in source map, Chrome 59 gives an error
aFileWriter.SrcMap.SaveToStream(buf);
{$IFDEF Pas2js}
{$ELSE}
buf.Position:=0;
{$ENDIF}
FileCache.SaveToFile(buf,MapFilename);
finally
{$IFDEF Pas2js}
buf:=nil;
{$ELSE}
buf.Free;
{$ENDIF}
end;
except
on E: Exception do begin
if ShowDebug then
Log.LogExceptionBackTrace(E);
{$IFDEF FPC}
if E.Message<>SafeFormat(SFCreateError,[DestFileName]) then
{$ENDIF}
Log.LogPlain('Error: '+E.Message);
Log.LogMsg(nUnableToWriteFile,[QuoteStr(FileCache.FormatPath(MapFilename))]);
Terminate(ExitCodeWriteError);
end
{$IFDEF Pas2js}
else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
{$ENDIF}
end;
end;
end;
end;
@ -3216,11 +3241,13 @@ begin
ReadParam(Line,false,false);
end;
end;
CheckParamsClosed;
finally
FCurrentCfgFilename:=OldCfgFilename;
FCurrentCfgLineNumber:=OldCfgLineNumber;
aFile.Free;
end;
if ParamState<>ppsSingle then
if ShowTriedUsedFiles then
Log.LogMsgIgnoreFilter(nEndOfReadingConfigFile,[QuoteStr(CfgFilename)]);
end;
@ -3269,10 +3296,27 @@ end;
procedure TPas2jsCompiler.ParamFatal(Msg: string);
begin
Log.LogPlain(['Fatal: ',Msg]);
if CurrentCfgFilename<>'' then
Log.Log(mtFatal,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0)
else
Log.LogPlain(['Fatal: ',Msg]);
Terminate(ExitCodeErrorInParams);
end;
procedure TPas2jsCompiler.CheckParamsClosed;
begin
case ParamState of
ppsSingle: ;
ppsPostProc:
if CurrentCfgFilename<>'' then
ParamFatal('-Jpostproc requires a line with a single ; at the end')
else
ParamFatal('-Jpostproc requires a single ; at the end');
else
ParamFatal('multi argument option needs closing');
end;
end;
procedure TPas2jsCompiler.ReadParam(Param: string; Quick, FromCmdLine: boolean);
procedure UnknownParam;
@ -3297,6 +3341,7 @@ var
{$IFDEF HasPas2jsFiler}
Found: Boolean;
PF: TPas2JSPrecompileFormat;
PostProc: TStringList;
{$ENDIF}
begin
//writeln('TPas2jsCompiler.ReadParam ',Param,' ',Quick,' ',FromCmdLine);
@ -3317,6 +3362,36 @@ begin
l:=length(Param);
p:=1;
case ParamState of
ppsPostProc:
begin
// parse multi arguments of -Jpostproc command ;
if Quick then
PostProc:=nil
else
PostProc:=TStringList(PostProcs[PostProcs.Count-1]);
if Param=';' then
begin
if (PostProc<>nil) and (PostProc.Count=0) then
ParamFatal('-Jpostproc needs command');
FParamState:=ppsSingle;
end else if PostProc<>nil then
begin
if PostProc.Count=0 then
begin
// check executable
Value:=FileCache.ExpandExecutable(Param,'');
if Value='' then
ParamFatal('-Jpostproc executable "'+Param+'" not found');
Param:=Value;
end;
PostProc.Add(Param);
end;
exit;
end;
end;
case Param[p] of
'-':
begin
@ -3584,6 +3659,21 @@ begin
else
UnknownParam;
end;
'p':
begin
// -J<p...>
Identifier:=copy(Param,p-1,length(Param));
case Identifier of
'postproc':
begin
FParamState:=ppsPostProc;
if not Quick then
PostProcs.Add(TStringList.Create);
end;
else
UnknownParam;
end;
end;
'u':
if not Quick then
if not FileCache.AddSrcUnitPaths(copy(Param,p,length(Param)),FromCmdLine,ErrorMsg) then
@ -3999,9 +4089,158 @@ begin
r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
r(mtInfo,nMacroXSetToY,sMacroXSetToY);
r(mtInfo,nPostProcessorX,sPostProcessorX);
r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
r(mtError,nPostProcessorFailX,sPostProcessorFailX);
r(mtWarning,nPostProcessorWarnX,sPostProcessorWarnX);
r(mtInfo,nPostProcessorFinished,sPostProcessorFinished);
Pas2jsPParser.RegisterMessages(Log);
end;
procedure TPas2jsCompiler.CallPostProcessors(const JSFilename: String;
aWriter: TPas2JSMapper);
var
i: Integer;
JS, OrigJS: TJSWriterString;
begin
if PostProcs.Count=0 then exit;
OrigJS:=aWriter.AsString;
JS:=OrigJS;
for i:=0 to PostProcs.Count-1 do
JS:=CallPostProcessor(JSFilename,TStringList(PostProcs[i]),JS);
if JS<>OrigJS then
begin
aWriter.AsString:=JS;
if aWriter.SrcMap<>nil then
aWriter.SrcMap.Clear;
end;
end;
function TPas2jsCompiler.CallPostProcessor(const JSFilename: String;
Cmd: TStringList; JS: TJSWriterString): TJSWriterString;
const
BufSize = 65536;
var
Exe: String;
TheProcess: TProcess;
WrittenBytes, ReadBytes: LongInt;
Buf, s, ErrBuf: string;
OutputChunks: TStringList;
CurExitCode, i, InPos: Integer;
begin
Result:='';
Exe:=Cmd[0];
if ShowUsedTools then
Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]);
if DirectoryCache.DirectoryExists(Exe) then
raise EFOpenError.Create('post processor "'+Exe+'" is a directory');
if not FileIsExecutable(Exe) then
raise EFOpenError.Create('post processor "'+Exe+'" is a not executable');
try
TheProcess := TProcess.Create(nil);
OutputChunks:=TStringList.Create;
try
TheProcess.Executable := Exe;
for i:=1 to Cmd.Count-1 do
TheProcess.Parameters.Add(Cmd[i]);
TheProcess.Options:= [poUsePipes];
TheProcess.ShowWindow := swoHide;
//TheProcess.CurrentDirectory:=WorkingDirectory;
TheProcess.Execute;
ErrBuf:='';
SetLength(Buf,BufSize);
InPos:=1;
repeat
// read stderr and log immediately as warnings
repeat
if TheProcess.Stderr.NumBytesAvailable=0 then break;
ReadBytes:=TheProcess.Stderr.Read(Buf[1],BufSize);
if ReadBytes=0 then break;
ErrBuf+=LeftStr(Buf,ReadBytes);
repeat
i:=1;
while (i<=length(ErrBuf)) and (i<128) and not (ErrBuf[i] in [#10,#13]) do
inc(i);
if i>length(ErrBuf) then break;
Log.LogMsg(nPostProcessorWarnX,[LeftStr(ErrBuf,i)]);
if (i<=length(ErrBuf)) and (ErrBuf[i] in [#10,#13]) then
begin
// skip linebreak
if (i<length(ErrBuf)) and (ErrBuf[i+1] in [#10,#13])
and (ErrBuf[i]<>ErrBuf[i+1]) then
inc(i,2)
else
inc(i);
end;
Delete(ErrBuf,1,i-1);
until false;
until false;
// write to stdin
if InPos<length(JS) then
begin
i:=length(JS)-InPos+1;
if i>BufSize then i:=BufSize;
WrittenBytes:=TheProcess.Input.Write(JS[InPos],i);
inc(InPos,WrittenBytes);
if InPos>length(JS) then
TheProcess.CloseInput;
end else
WrittenBytes:=0;
// read stdout
if TheProcess.Output.NumBytesAvailable=0 then
ReadBytes:=0
else
ReadBytes:=TheProcess.Output.Read(Buf[1],BufSize);
if ReadBytes>0 then
OutputChunks.Add(LeftStr(Buf,ReadBytes));
if (WrittenBytes=0) and (ReadBytes=0) then
begin
if not TheProcess.Running then break;
Sleep(10); // give tool some time
end;
until false;
TheProcess.WaitOnExit;
CurExitCode:=TheProcess.ExitCode;
// concatenate output chunks
ReadBytes:=0;
for i:=0 to OutputChunks.Count-1 do
inc(ReadBytes,length(OutputChunks[i]));
SetLength(Result,ReadBytes);
ReadBytes:=0;
for i:=0 to OutputChunks.Count-1 do
begin
s:=OutputChunks[i];
if s='' then continue;
System.Move(s[1],Result[ReadBytes+1],length(s));
inc(ReadBytes,length(s));
end;
finally
OutputChunks.Free;
TheProcess.Free;
end;
except
on E: Exception do begin
if ShowDebug then
Log.LogExceptionBackTrace(E);
Log.LogPlain('Error: '+E.Message);
Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
Terminate(ExitCodeToolError);
end
{$IFDEF Pas2js}
else HandleJSException('[20181118170506] TPas2jsCompiler.CallPostProcessor Cmd: '+CmdListAsStr(Cmd),JSExceptValue,true);
{$ENDIF}
end;
if CurExitCode<>0 then
begin
Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
Terminate(ExitCodeToolError);
end;
if ShowUsedTools then
Log.LogMsgIgnoreFilter(nPostProcessorFinished,[]);
end;
constructor TPas2jsCompiler.Create;
begin
FOptions:=DefaultP2jsCompilerOptions;
@ -4014,6 +4253,7 @@ begin
FFileCacheAutoFree:=true;
FDirectoryCache:=FFileCache.DirectoryCache;
FLog.OnFormatPath:=@FileCache.FormatPath;
FPostProcs:=TObjectList.Create(true);
FDefines:=TStringList.Create;
// Done by Reset: TStringList(FDefines).Sorted:=True;
@ -4059,6 +4299,7 @@ destructor TPas2jsCompiler.Destroy;
FreeAndNil(FDefines);
FreeAndNil(FConditionEval);
FreeAndNil(FPostProcs);
FLog.OnFormatPath:=nil;
if FFileCacheAutoFree then
FreeAndNil(FFileCache)
@ -4168,6 +4409,7 @@ begin
FReadingModules.Clear;
FFiles.FreeItems;
FPostProcs.Clear;
FCompilerExe:='';
FOptions:=DefaultP2jsCompilerOptions;
FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
@ -4232,6 +4474,7 @@ begin
// quick check command line params
for i:=0 to ParamList.Count-1 do
ReadParam(ParamList[i],true,true);
CheckParamsClosed;
if WriteDebugLog then
Log.OpenDebugLog;
if ShowLogo then
@ -4244,6 +4487,7 @@ begin
// read command line parameters
for i:=0 to ParamList.Count-1 do
ReadParam(ParamList[i],false,true);
CheckParamsClosed;
// now we know, if the logo can be displayed
if ShowLogo then
@ -4255,6 +4499,8 @@ begin
WriteOptions;
WriteDefines;
end;
if ShowDebug or ShowUsedTools then
WriteUsedTools;
if ShowDebug or ShowTriedUsedFiles then
WriteFoldersAndSearchPaths;
@ -4272,13 +4518,14 @@ begin
on E: Exception do begin
if ShowDebug then
Log.LogExceptionBackTrace(E);
raise; // reraise unexpected exception
end else begin
if ShowDebug then
Log.LogExceptionBackTrace(nil);
{$IFDEF Pas2js}
HandleJSException('[20181031190933] TPas2jsCompiler.Run',JSExceptValue,false);
{$ENDIF}
raise;
raise; // reraise unexpected exception
end;
end;
end;
@ -4416,6 +4663,7 @@ begin
w(' -JoCheckVersion=main : insert rtl version check into main.');
w(' -JoCheckVersion=system : insert rtl version check into system unit init.');
w(' -JoCheckVersion=unit : insert rtl version check into every unit init.');
w(' -Jpostproc command ; : Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. Depending on the used shell you have to escape the ending ; with a ''\''. This option can be added multiple times to call several postprocessors in succession.');
w(' -Ju<x> : Add <x> to foreign unit paths. Foreign units are not compiled.');
{$IFDEF HasPas2jsFiler}
if PrecompileFormats.Count>0 then
@ -4559,6 +4807,19 @@ begin
end;
end;
procedure TPas2jsCompiler.WriteUsedTools;
var
i: Integer;
PostProc: TStringList;
begin
// post processors
for i:=0 to PostProcs.Count-1 do
begin
PostProc:=TStringList(PostProcs[i]);
Log.LogMsgIgnoreFilter(nPostProcessorX,[CmdListAsStr(PostProc)]);
end;
end;
procedure TPas2jsCompiler.WriteFoldersAndSearchPaths;
procedure WriteFolder(aName, Folder: string);
@ -4633,6 +4894,18 @@ begin
if coShowDebug in FOptions then Include(Result,mtDebug);
end;
function TPas2jsCompiler.CmdListAsStr(CmdList: TStrings): string;
var
i: Integer;
begin
Result:='';
for i:=0 to CmdList.Count-1 do
begin
if Result<>'' then Result+=' ';
Result+=QuoteStr(CmdList[i]);
end;
end;
procedure TPas2jsCompiler.SetOption(Flag: TP2jsCompilerOption; Enable: boolean);
begin
if Enable then

55
packages/pastojs/src/pas2jsfilecache.pp
View File

@ -342,6 +342,7 @@ type
procedure RaiseDuplicateFile(aFilename: string);
procedure SaveToFile(ms: TFPJSStream; Filename: string);
function ExpandDirectory(const Filename, BaseDir: string): string;
function ExpandExecutable(const Filename, BaseDir: string): string;
public
property AllJSIntoMainJS: Boolean read GetAllJSIntoMainJS write SetAllJSIntoMainJS;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
@ -2216,9 +2217,9 @@ begin
i:=GetLastOSError;
if i<>0 then
Log.LogPlain('Note: '+SysErrorMessage(i));
if not SysUtils.DirectoryExists(ChompPathDelim(ExtractFilePath(Filename))) then
if not DirectoryCache.DirectoryExists(ChompPathDelim(ExtractFilePath(Filename))) then
Log.LogPlain('Note: file cache inconsistency: folder does not exist "'+ChompPathDelim(ExtractFilePath(Filename))+'"');
if SysUtils.FileExists(Filename) and not FileIsWritable(Filename) then
if DirectoryCache.FileExists(Filename) and not FileIsWritable(Filename) then
Log.LogPlain('Note: file is not writable "'+Filename+'"');
raise;
end;
@ -2239,5 +2240,55 @@ begin
Result:=IncludeTrailingPathDelimiter(Result);
end;
function TPas2jsFilesCache.ExpandExecutable(const Filename, BaseDir: string
): string;
function TryFile(CurFilename: string): boolean;
begin
Result:=false;
CurFilename:=ResolveDots(CurFilename);
if not DirectoryCache.FileExists(CurFilename) then exit;
ExpandExecutable:=CurFilename;
Result:=true;
end;
var
PathVar, CurPath: String;
p, StartPos: Integer;
begin
if Filename='' then exit('');
if ExtractFilePath(Filename)='' then
begin
// no file path -> search
{$IFDEF Windows}
// search in BaseDir
if BaseDir<>'' then
begin
if TryFile(IncludeTrailingPathDelimiter(BaseDir)+Filename) then exit;
end else if BaseDirectory<>'' then
begin
if TryFile(IncludeTrailingPathDelimiter(BaseDirectory)+Filename) then exit;
end;
{$ENDIF}
// search in PATH
PathVar:=GetEnvironmentVariablePJ('PATH');
p:=1;
while p<=length(PathVar) do
begin
while (p<=length(PathVar)) and (PathVar[p]=PathSeparator) do inc(p);
StartPos:=p;
while (p<=length(PathVar)) and (PathVar[p]<>PathSeparator) do inc(p);
CurPath:=copy(PathVar,StartPos,p-StartPos);
if CurPath='' then continue;
CurPath:=ExpandFileNamePJ(CurPath);
if CurPath='' then continue;
if TryFile(IncludeTrailingPathDelimiter(CurPath)+Filename) then exit;
end;
end else if BaseDir<>'' then
Result:=ExpandFileNamePJ(Filename,BaseDir)
else
Result:=ExpandFileNamePJ(Filename,BaseDirectory);
end;
end.

1
packages/pastojs/src/pas2jsfileutils.pp
View File

@ -58,6 +58,7 @@ function ResolveSymLinks(const Filename: string;
{%H-}ExceptionOnError: boolean): string; // if a link is broken returns ''
function MatchGlobbing(Mask, Name: string): boolean;
function FileIsWritable(const AFilename: string): boolean;
function FileIsExecutable(const AFilename: string): boolean;
function GetEnvironmentVariableCountPJ: Integer;
function GetEnvironmentStringPJ(Index: Integer): string;

9
packages/pastojs/src/pas2jsfileutilsunix.inc
View File

@ -148,6 +148,15 @@ begin
Result := BaseUnix.FpAccess(AFilename, BaseUnix.W_OK) = 0;
end;
function FileIsExecutable(const AFilename: string): boolean;
var
Info : Stat;
begin
// first check AFilename is not a directory and then check if executable
Result:= (FpStat(AFilename,info{%H-})<>-1) and FPS_ISREG(info.st_mode) and
(BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0);
end;
function GetEnvironmentVariableCountPJ: Integer;
begin
Result:=GetEnvironmentVariableCount;

5
packages/pastojs/src/pas2jsfileutilswin.inc
View File

@ -421,6 +421,11 @@ begin
Result:=((FileGetAttrUTF8(AFilename) and faReadOnly) = 0);
end;
function FileIsWritable(const AFilename: string): boolean;
begin
Result:=FileExists(AFilename);
end;
function GetEnvironmentVariableCountPJ: Integer;
var
hp,p : PWideChar;

1
packages/pastojs/src/pas2jslogger.pp
View File

@ -42,6 +42,7 @@ const
ExitCodeSyntaxError = 6;
ExitCodeConverterError = 7;
ExitCodePCUError = 8;
ExitCodeToolError = 9;
const
DefaultLogMsgTypes = [mtFatal..mtDebug]; // by default show everything