mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-25 01:51:41 +02:00
* Added patch from Darius Blaszijk to be less verbose by default
git-svn-id: trunk@16469 -
This commit is contained in:
parent
6954c0a598
commit
066a9330fb
@ -744,6 +744,7 @@ Type
|
|||||||
FStartDir : String;
|
FStartDir : String;
|
||||||
FForceCompile : Boolean;
|
FForceCompile : Boolean;
|
||||||
FListMode : Boolean;
|
FListMode : Boolean;
|
||||||
|
FVerbose : boolean;
|
||||||
{$ifdef HAS_UNIT_ZIPPER}
|
{$ifdef HAS_UNIT_ZIPPER}
|
||||||
FZipFile: TZipper;
|
FZipFile: TZipper;
|
||||||
{$endif HAS_UNIT_ZIPPER}
|
{$endif HAS_UNIT_ZIPPER}
|
||||||
@ -792,6 +793,9 @@ Type
|
|||||||
Public
|
Public
|
||||||
Constructor Create(AOwner : TComponent); override;
|
Constructor Create(AOwner : TComponent); override;
|
||||||
destructor Destroy;override;
|
destructor Destroy;override;
|
||||||
|
|
||||||
|
property Verbose : boolean read FVerbose write FVerbose;
|
||||||
|
|
||||||
// Public Copy/delete/Move/Archive/Mkdir Commands.
|
// Public Copy/delete/Move/Archive/Mkdir Commands.
|
||||||
Procedure ExecuteCommand(const Cmd,Args : String; IgnoreError : Boolean = False); virtual;
|
Procedure ExecuteCommand(const Cmd,Args : String; IgnoreError : Boolean = False); virtual;
|
||||||
Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
|
Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
|
||||||
@ -1141,6 +1145,87 @@ Const
|
|||||||
Helpers
|
Helpers
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|
||||||
|
function ExecuteFPC(Verbose: boolean; const Path: string; const ComLine: string): integer;
|
||||||
|
var
|
||||||
|
M: TMemoryStream;
|
||||||
|
P: TProcess;
|
||||||
|
BytesRead: longint;
|
||||||
|
|
||||||
|
function ReadFromStream: longint;
|
||||||
|
const
|
||||||
|
READ_BYTES = 2048;
|
||||||
|
var
|
||||||
|
n: longint;
|
||||||
|
BuffPos: longint;
|
||||||
|
sLine: string;
|
||||||
|
ch: char;
|
||||||
|
begin
|
||||||
|
// make sure we have room
|
||||||
|
M.SetSize(BytesRead + READ_BYTES);
|
||||||
|
|
||||||
|
// try reading it
|
||||||
|
n := P.Output.Read((M.Memory + BytesRead)^, READ_BYTES);
|
||||||
|
if n > 0 then
|
||||||
|
begin
|
||||||
|
Inc(BytesRead, n);
|
||||||
|
|
||||||
|
sLine := '';
|
||||||
|
BuffPos := M.Position;
|
||||||
|
|
||||||
|
//read lines from the stream
|
||||||
|
repeat
|
||||||
|
M.Read(ch,1);
|
||||||
|
|
||||||
|
if ch in [#10, #13] then
|
||||||
|
begin
|
||||||
|
if Verbose then
|
||||||
|
writeln(sLine)
|
||||||
|
else
|
||||||
|
if (Pos('Compiling', sLine) = 1) or (Pos('Linking', sLine) = 1) then
|
||||||
|
writeln(' ', sLine);
|
||||||
|
|
||||||
|
sLine := '';
|
||||||
|
BuffPos := M.Position;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
sLine := sLine + ch;
|
||||||
|
|
||||||
|
until M.Position = M.Size;
|
||||||
|
|
||||||
|
M.Position := BuffPos;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
// no data, wait 100 ms
|
||||||
|
Sleep(100);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result := n;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
M := TMemoryStream.Create;
|
||||||
|
BytesRead := 0;
|
||||||
|
|
||||||
|
P := TProcess.Create(nil);
|
||||||
|
P.CommandLine := Path + ' ' + ComLine;
|
||||||
|
P.Options := [poUsePipes];
|
||||||
|
|
||||||
|
//writeln('Execute: ', P.CommandLine);
|
||||||
|
|
||||||
|
P.Execute;
|
||||||
|
while P.Running do
|
||||||
|
ReadFromStream;
|
||||||
|
|
||||||
|
// read last part
|
||||||
|
repeat
|
||||||
|
until ReadFromStream = 0;
|
||||||
|
finally
|
||||||
|
P.Free;
|
||||||
|
M.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
Function QuoteXML(S : String) : string;
|
Function QuoteXML(S : String) : string;
|
||||||
|
|
||||||
@ -2907,6 +2992,7 @@ begin
|
|||||||
FBuildEngine:=TBuildEngine.Create(Self);
|
FBuildEngine:=TBuildEngine.Create(Self);
|
||||||
// FBuildEngine.Defaults:=Defaults;
|
// FBuildEngine.Defaults:=Defaults;
|
||||||
FBuildEngine.ListMode:=FListMode;
|
FBuildEngine.ListMode:=FListMode;
|
||||||
|
FBuildEngine.Verbose := (FLogLevels = AllMessages);
|
||||||
FBuildEngine.OnLog:=@Self.Log;
|
FBuildEngine.OnLog:=@Self.Log;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -3288,7 +3374,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
// We should check cmd for spaces, and move all after first space to args.
|
// We should check cmd for spaces, and move all after first space to args.
|
||||||
E:=ExecuteProcess(cmd,args);
|
E:=ExecuteFPC(Verbose, cmd, args);
|
||||||
If (E<>0) and (not IgnoreError) then
|
If (E<>0) and (not IgnoreError) then
|
||||||
Error(SErrExternalCommandFailed,[Cmd,E]);
|
Error(SErrExternalCommandFailed,[Cmd,E]);
|
||||||
end;
|
end;
|
||||||
@ -4679,6 +4765,9 @@ begin
|
|||||||
P:=Packages.PackageItems[i];
|
P:=Packages.PackageItems[i];
|
||||||
If PackageOK(P) then
|
If PackageOK(P) then
|
||||||
MaybeCompile(P);
|
MaybeCompile(P);
|
||||||
|
|
||||||
|
//show compile progress
|
||||||
|
writeln('[', (I + 1)/Packages.Count * 100:3:0, '%] Built target ', P.Name);
|
||||||
end;
|
end;
|
||||||
If Assigned(AfterCompile) then
|
If Assigned(AfterCompile) then
|
||||||
AfterCompile(Self);
|
AfterCompile(Self);
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user