mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 01:11:29 +01: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; | ||||
|     FForceCompile : Boolean; | ||||
|     FListMode : Boolean; | ||||
|     FVerbose : boolean; | ||||
| {$ifdef HAS_UNIT_ZIPPER} | ||||
|     FZipFile: TZipper; | ||||
| {$endif HAS_UNIT_ZIPPER} | ||||
| @ -792,6 +793,9 @@ Type | ||||
|   Public | ||||
|     Constructor Create(AOwner : TComponent); override; | ||||
|     destructor Destroy;override; | ||||
| 
 | ||||
|     property Verbose : boolean read FVerbose write FVerbose; | ||||
| 
 | ||||
|     // Public Copy/delete/Move/Archive/Mkdir Commands. | ||||
|     Procedure ExecuteCommand(const Cmd,Args : String; IgnoreError : Boolean = False); virtual; | ||||
|     Procedure CmdCopyFiles(List : TStrings; Const DestDir : String); | ||||
| @ -1141,6 +1145,87 @@ Const | ||||
|                                 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; | ||||
| 
 | ||||
| @ -2907,6 +2992,7 @@ begin | ||||
|   FBuildEngine:=TBuildEngine.Create(Self); | ||||
| //  FBuildEngine.Defaults:=Defaults; | ||||
|   FBuildEngine.ListMode:=FListMode; | ||||
|   FBuildEngine.Verbose := (FLogLevels = AllMessages); | ||||
|   FBuildEngine.OnLog:=@Self.Log; | ||||
| end; | ||||
| 
 | ||||
| @ -3288,7 +3374,7 @@ begin | ||||
|   else | ||||
|     begin | ||||
|       // 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 | ||||
|         Error(SErrExternalCommandFailed,[Cmd,E]); | ||||
|     end; | ||||
| @ -4679,6 +4765,9 @@ begin | ||||
|       P:=Packages.PackageItems[i]; | ||||
|       If PackageOK(P) then | ||||
|         MaybeCompile(P); | ||||
| 
 | ||||
|       //show compile progress | ||||
|       writeln('[', (I + 1)/Packages.Count * 100:3:0, '%] Built target ', P.Name); | ||||
|     end; | ||||
|   If Assigned(AfterCompile) then | ||||
|     AfterCompile(Self); | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 michael
						michael