paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-11 20:50:57 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Made logging thread-safe. Handle the indenting of the log separate for each

Browse Source 
thread.
 * Log deleting files

git-svn-id: trunk@19886 -
This commit is contained in:
joost 2011-12-23 21:38:35 +00:00
parent d15b70d46f
commit ad5d37fa25
1 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
packages/fpmkunit/src/fpmkunit.pp
View File

@ -808,8 +808,6 @@ Type
FZipFile: TZipper; FZipFile: TZipper;
{$endif HAS_UNIT_ZIPPER} {$endif HAS_UNIT_ZIPPER}
FExternalPackages : TPackages; FExternalPackages : TPackages;
// Logging
FLogPrefix : String;
// Events // Events
FOnLog: TLogEvent; FOnLog: TLogEvent;
FAfterArchive: TNotifyEvent; FAfterArchive: TNotifyEvent;
@ -908,8 +906,8 @@ Type
procedure Manifest(Packages: TPackages); procedure Manifest(Packages: TPackages);
Procedure Clean(Packages : TPackages; AllTargets: boolean); Procedure Clean(Packages : TPackages; AllTargets: boolean);
Procedure Log(Level : TVerboseLevel; Const Msg : String); Procedure Log(Level : TVerboseLevel; Msg : String);
Procedure Log(Level : TVerboseLevel; Const Fmt : String; const Args : Array Of Const); Procedure Log(Level : TVerboseLevel; Fmt : String; const Args : Array Of Const);
Property ListMode : Boolean Read FListMode Write FListMode; Property ListMode : Boolean Read FListMode Write FListMode;
Property ForceCompile : Boolean Read FForceCompile Write FForceCompile; Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
@ -1072,6 +1070,9 @@ var
CustomFpmakeCommandlineOptions: TStrings; CustomFpmakeCommandlineOptions: TStrings;
CustomFpMakeCommandlineValues: TStrings; CustomFpMakeCommandlineValues: TStrings;
threadvar
GLogPrefix : string;
ResourceString ResourceString
SErrInvalidCPU = 'Invalid CPU name "%s"'; SErrInvalidCPU = 'Invalid CPU name "%s"';
SErrInvalidOS = 'Invalid OS name "%s"'; SErrInvalidOS = 'Invalid OS name "%s"';
@ -1130,6 +1131,7 @@ ResourceString
SInfoCleaningPackage = 'Cleaning package %s'; SInfoCleaningPackage = 'Cleaning package %s';
SInfoManifestPackage = 'Creating manifest for package %s'; SInfoManifestPackage = 'Creating manifest for package %s';
SInfoCopyingFile = 'Copying file "%s" to "%s"'; SInfoCopyingFile = 'Copying file "%s" to "%s"';
SInfoDeletingFile = 'Deleting file "%s"';
SInfoSourceNewerDest = 'Source file "%s" (%s) is newer than destination "%s" (%s).'; SInfoSourceNewerDest = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
SInfoFallbackBuildmode = 'Buildmode not spported by package, falling back to one by one unit compilation'; SInfoFallbackBuildmode = 'Buildmode not spported by package, falling back to one by one unit compilation';
@ -1284,7 +1286,7 @@ var
if ch in [#10, #13] then if ch in [#10, #13] then
begin begin
if Verbose then if Verbose then
writeln(sLine) installer.log(vlInfo,sLine)
else else
begin begin
for msg := Low(TMessages) to High(TMessages) do for msg := Low(TMessages) to High(TMessages) do
@ -1292,7 +1294,7 @@ var
snum := Format('(%d)', [MsgNum[msg]]); snum := Format('(%d)', [MsgNum[msg]]);
ipos := Pos(snum, sLine); ipos := Pos(snum, sLine);
if ipos = 1 then if ipos = 1 then
writeln(' ', Copy(sLine, ipos + Length(snum), Length(sLine) - ipos - Length(snum) + 1)); installer.log(vlCommand,' '+ Copy(sLine, ipos + Length(snum), Length(sLine) - ipos - Length(snum) + 1));
end; end;
end; end;
@ -3235,10 +3237,13 @@ begin
result := FPackages; result := FPackages;
end; end;
procedure TCustomInstaller.Log(Level: TVerboseLevel; const Msg: String); procedure TCustomInstaller.Log(Level: TVerboseLevel; Const Msg: String);
begin begin
If Level in FLogLevels then If Level in FLogLevels then
Writeln(StdOut,Msg); begin
Writeln(StdOut, Msg);
Flush(StdOut);
end;
end; end;
@ -3764,13 +3769,14 @@ end;
procedure TBuildEngine.SysDeleteFile(Const AFileName : String); procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
begin begin
Log(vlInfo,SInfoDeletingFile,[AFileName]);
if not FileExists(AFileName) then if not FileExists(AFileName) then
Log(vldebug,SDbgFileDoesNotExist,[AFileName]) Log(vldebug,SDbgFileDoesNotExist,[AFileName])
else If Not DeleteFile(AFileName) then else If Not DeleteFile(AFileName) then
Error(SErrDeletingFile,[AFileName]); Error(SErrDeletingFile,[AFileName]);
end; end;
procedure TBuildEngine.SysDeleteDirectory(const ADirectoryName: String); procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);
begin begin
if not DirectoryExists(ADirectoryName) then if not DirectoryExists(ADirectoryName) then
Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName]) Log(vldebug,SDbgDirectoryDoesNotExist,[ADirectoryName])
@ -3833,29 +3839,29 @@ end;
procedure TBuildEngine.LogIndent; procedure TBuildEngine.LogIndent;
begin begin
FLogPrefix:=FLogPrefix+' '; GLogPrefix:=GLogPrefix+' ';
end; end;
procedure TBuildEngine.LogUnIndent; procedure TBuildEngine.LogUnIndent;
begin begin
Delete(FLogPrefix,1,2); Delete(GLogPrefix,1,2);
end; end;
procedure TBuildEngine.Log(Level: TVerboseLevel; const Msg: String); procedure TBuildEngine.Log(Level: TVerboseLevel; Msg: String);
begin begin
If Assigned(FOnLog) then If Assigned(FOnLog) then
begin begin
if Level in [vlInfo,vlDebug] then if Level in [vlInfo,vlDebug] then
FOnLog(Level,FLogPrefix+Msg) FOnLog(Level,GLogPrefix+Msg)
else else
FOnLog(Level,Msg); FOnLog(Level,Msg);
end; end;
end; end;
procedure TBuildEngine.Log(Level: TVerboseLevel; const Fmt: String;const Args: array of const); procedure TBuildEngine.Log(Level: TVerboseLevel; Fmt: String;const Args: array of const);
begin begin
Log(Level,Format(Fmt,Args)); Log(Level,Format(Fmt,Args));
end; end;