1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Running external programs and parsing their output lines.
25 }
26 unit ExtTools;
27
28 {$mode objfpc}{$H+}
29
30 {off $DEFINE VerboseExtToolErrors}
31 {off $DEFINE VerboseExtToolAddOutputLines}
32 {off $DEFINE VerboseExtToolThread}
33
34 interface
35
36 uses
37 // RTL + FCL
38 Classes, SysUtils, math, process, Pipes, Laz_AVL_Tree,
39 // LazUtils
40 FileUtil, LazFileUtils, LazUtilities, LazLoggerBase, UTF8Process, LazUTF8,
41 UITypes, AvgLvlTree,
42 // IDEIntf
43 IDEExternToolIntf, BaseIDEIntf, MacroIntf, LazMsgDialogs,
44 // IDE
45 IDECmdLine, TransferMacros, LazarusIDEStrConsts;
46
47 type
48 TLMVToolState = (
49 lmvtsRunning,
50 lmvtsSuccess,
51 lmvtsFailed
52 );
53 TLMVToolStates = set of TLMVToolState;
54
55 { TLazExtToolView }
56
57 TLazExtToolView = class(TExtToolView)
58 private
59 FToolState: TLMVToolState;
60 protected
61 procedure SetToolState(AValue: TLMVToolState); virtual;
62 public
63 property ToolState: TLMVToolState read FToolState write SetToolState;
64 end;
65
66 TExternalTool = class;
67
68 { TExternalToolThread }
69
70 TExternalToolThread = class(TThread)
71 private
72 fLines: TStringList;
73 FTool: TExternalTool;
74 procedure SetTool(AValue: TExternalTool);
75 public
76 property Tool: TExternalTool read FTool write SetTool;
77 procedure Execute; override;
78 procedure DebuglnThreadLog(const Args: array of const);
79 destructor Destroy; override;
80 end;
81
82 { TExternalTool }
83
84 TExternalTool = class(TAbstractExternalTool)
85 private
86 FThread: TExternalToolThread;
87 fExecuteAfter: TFPList; // list of TExternalTool
88 fExecuteBefore: TFPList; // list of TExternalTool
89 fNeedAfterSync: boolean;
90 fOutputCountNotified: integer;
91 procedure ProcessRunning; // (worker thread) after Process.Execute
92 procedure ProcessStopped; // (worker thread) when process stopped
93 procedure AddOutputLines(Lines: TStringList); // (worker thread) when new output arrived
94 procedure NotifyHandlerStopped; // (main thread) called by ProcessStopped
95 procedure NotifyHandlerNewOutput; // (main thread) called by AddOutputLines
96 procedure SetThread(AValue: TExternalToolThread); // main or worker thread
97 procedure SynchronizedImproveMessages; // (main thread) called by AddOutputLines
98 procedure DoTerminate; // (main thread)
99 protected
100 procedure DoExecute; override; // (main thread)
101 procedure DoStart; // (main thread)
102 procedure CreateView; virtual; abstract; // (main thread)
GetExecuteAfternull103 function GetExecuteAfter(Index: integer): TAbstractExternalTool; override;
GetExecuteBeforenull104 function GetExecuteBefore(Index: integer): TAbstractExternalTool; override;
105 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
CanFreenull106 function CanFree: boolean; override;
107 procedure QueueAsyncAutoFree; virtual; abstract;
108 public
109 constructor Create(aOwner: TComponent); override;
110 destructor Destroy; override;
111 property Thread: TExternalToolThread read FThread write SetThread;
112 procedure Execute; override;
113 procedure Terminate; override;
114 procedure WaitForExit; override;
ResolveMacrosnull115 function ResolveMacros: boolean; override;
116
ExecuteAfterCountnull117 function ExecuteAfterCount: integer; override;
ExecuteBeforeCountnull118 function ExecuteBeforeCount: integer; override;
119 procedure RemoveExecuteBefore(Tool: TAbstractExternalTool); override;
IsExecutedBeforenull120 function IsExecutedBefore(Tool: TAbstractExternalTool): Boolean; override;
121 procedure AddExecuteBefore(Tool: TAbstractExternalTool); override;
CanStartnull122 function CanStart: boolean;
GetLongestEstimatedLoadnull123 function GetLongestEstimatedLoad: int64;
124 end;
125
126 TExternalToolClass = class of TExternalTool;
127
128 { TExternalTools }
129
130 TExternalTools = class(TExternalToolsBase)
131 private
132 FCritSec: TRTLCriticalSection;
133 fRunning: TFPList; // list of TExternalTool, needs Enter/LeaveCriticalSection
134 FMaxProcessCount: integer;
135 fParsers: TFPList; // list of TExtToolParserClass
GetRunningToolsnull136 function GetRunningTools(Index: integer): TExternalTool;
137 procedure AddRunningTool(Tool: TExternalTool); // (worker thread)
138 procedure RemoveRunningTool(Tool: TExternalTool); // (worker thread)
RunExtToolHandlernull139 function RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean;
RunToolAndDetachnull140 function RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean;
RunToolWithParsersnull141 function RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean;
142 protected
143 FToolClass: TExternalToolClass;
GetParsersnull144 function GetParsers(Index: integer): TExtToolParserClass; override;
145 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
146 public
147 constructor Create(aOwner: TComponent); override;
148 destructor Destroy; override;
Addnull149 function Add(Title: string): TAbstractExternalTool; override;
IndexOfnull150 function IndexOf(Tool: TAbstractExternalTool): integer; override;
151 property MaxProcessCount: integer read FMaxProcessCount write FMaxProcessCount;
152 procedure Work;
FindNextToolToStartnull153 function FindNextToolToStart: TExternalTool;
154 procedure Terminate(Tool: TExternalTool);
155 procedure TerminateAll; override;
156 procedure Clear; override;
RunningCountnull157 function RunningCount: integer;
158 property RunningTools[Index: integer]: TExternalTool read GetRunningTools;
159 procedure EnterCriticalSection; override;
160 procedure LeaveCriticalSection; override;
161 // parsers
ParserCountnull162 function ParserCount: integer; override;
163 procedure RegisterParser(Parser: TExtToolParserClass); override;
164 procedure UnregisterParser(Parser: TExtToolParserClass); override;
FindParserForToolnull165 function FindParserForTool(const SubTool: string): TExtToolParserClass; override;
FindParserWithNamenull166 function FindParserWithName(const ParserName: string): TExtToolParserClass;
167 override;
GetMsgToolnull168 function GetMsgTool(Msg: TMessageLine): TAbstractExternalTool; override;
169 end;
170
171 TExternalToolsClass = class of TExternalTools;
172
173 var
174 ExternalTools: TExternalTools = nil;
175
176 implementation
177
178 { TLazExtToolView }
179
180 procedure TLazExtToolView.SetToolState(AValue: TLMVToolState);
181 begin
182 if FToolState=AValue then Exit;
183 FToolState:=AValue;
184 end;
185
186 { TExternalTool }
187
188 procedure TExternalTool.ProcessRunning;
189 var
190 i: Integer;
191 begin
192 EnterCriticalSection;
193 try
194 if FStage<>etsStarting then exit;
195 FStage:=etsRunning;
196 finally
197 LeaveCriticalSection;
198 end;
199 for i:=0 to ParserCount-1 do
200 Parsers[i].InitReading;
201 end;
202
203 procedure TExternalTool.ProcessStopped;
204 var
205 i: Integer;
206 begin
207 {$IFDEF VerboseExtToolErrors}
208 if ErrorMessage<>'' then
209 DebuglnThreadLog(['TExternalTool.ThreadStopped ',Title,' ErrorMessage=',ErrorMessage]);
210 {$ENDIF}
211 EnterCriticalSection;
212 try
213 if (not Terminated) and (ErrorMessage='') then
214 begin
215 if ExitCode<>0 then
216 ErrorMessage:=Format(lisExitCode, [IntToStr(ExitCode)])
217 else if ExitStatus<>0 then
218 ErrorMessage:='ExitStatus '+IntToStr(ExitStatus);
219 end;
220 if FStage>=etsStopped then exit;
221 FStage:=etsStopped;
222 finally
223 LeaveCriticalSection;
224 end;
225 for i:=0 to ParserCount-1 do begin
226 try
227 Parsers[i].Done;
228 except
229 on E: Exception do begin
230 {$IFDEF VerboseExtToolErrors}
231 DebuglnThreadLog(['TExternalTool.ProcessStopped ',Title,' Error in ',DbgSName(Parsers[i]),': ',E.Message]);
232 {$ENDIF}
233 end;
234 end;
235 end;
236 try
237 if Tools<>nil then
238 TExternalTools(Tools).RemoveRunningTool(Self);
239 Thread.Synchronize(Thread,@NotifyHandlerStopped);
240 finally
241 fThread:=nil;
242 end;
243 end;
244
245 procedure TExternalTool.AddOutputLines(Lines: TStringList);
246 var
247 i: Integer;
248 Handled: Boolean;
249 Line: LongInt;
250 OldOutputCount: LongInt;
251 OldMsgCount: LongInt;
252 Parser: TExtToolParser;
253 NeedSynchronize: Boolean;
254 MsgLine: TMessageLine;
255 LineStr: String;
256 begin
257 {$IFDEF VerboseExtToolAddOutputLines}
258 DebuglnThreadLog(['TExternalTool.AddOutputLines ',Title,' Tick=',IntToStr(GetTickCount64),' Lines=',Lines.Count]);
259 {$ENDIF}
260 if (Lines=nil) or (Lines.Count=0) then exit;
261 NeedSynchronize:=false;
262 EnterCriticalSection;
263 try
264 OldOutputCount:=WorkerOutput.Count;
265 OldMsgCount:=WorkerMessages.Count;
266 WorkerOutput.AddStrings(Lines);
267 for i:=0 to ParserCount-1 do
268 Parsers[i].NeedSynchronize:=false;
269
270 // feed new lines into all parsers, converting raw lines into messages
271 for Line:=OldOutputCount to WorkerOutput.Count-1 do begin
272 Handled:=false;
273 LineStr:=WorkerOutput[Line];
274 for i:=0 to ParserCount-1 do begin
275 {$IFDEF VerboseExtToolAddOutputLines}
276 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parsers[i]),' Line="',WorkerOutput[Line],'" READLINE ...']);
277 {$ENDIF}
278 Parsers[i].ReadLine(LineStr,Line,Handled);
279 if Handled then break;
280 end;
281 if (not Handled) then begin
282 MsgLine:=WorkerMessages.CreateLine(Line);
283 MsgLine.Msg:=LineStr; // use raw output as default msg
284 MsgLine.Urgency:=mluDebug;
285 WorkerMessages.Add(MsgLine);
286 end;
287 end;
288
289 // let all parsers improve the new messages
290 if OldMsgCount<WorkerMessages.Count then begin
291 for i:=0 to ParserCount-1 do begin
292 Parser:=Parsers[i];
293 Parser.NeedSynchronize:=false;
294 Parser.NeedAfterSync:=false;
295 {$IFDEF VerboseExtToolAddOutputLines}
296 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after ReadLine ...']);
297 {$ENDIF}
298 Parser.ImproveMessages(etpspAfterReadLine);
299 if Parser.NeedSynchronize then
300 NeedSynchronize:=true;
301 end;
302 end;
303 finally
304 LeaveCriticalSection;
305 end;
306
307 // let all parsers improve the new messages
308 if NeedSynchronize then begin
309 {$IFDEF VerboseExtToolAddOutputLines}
310 DebuglnThreadLog(['TExternalTool.AddOutputLines SynchronizedImproveMessages ...']);
311 {$ENDIF}
312 Thread.Synchronize(Thread,@SynchronizedImproveMessages);
313 end;
314
315 EnterCriticalSection;
316 try
317 if fNeedAfterSync then begin
318 for i:=0 to ParserCount-1 do begin
319 Parser:=Parsers[i];
320 if not Parser.NeedAfterSync then continue;
321 {$IFDEF VerboseExtToolAddOutputLines}
322 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after sync ...']);
323 {$ENDIF}
324 Parser.ImproveMessages(etpspAfterSync);
325 end;
326 end;
327
328 // feed new messages into all viewers
329 if OldMsgCount<WorkerMessages.Count then begin
330 for i:=0 to ViewCount-1 do begin
331 {$IFDEF VerboseExtToolAddOutputLines}
332 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Views[i]),' "',Views[i].Caption,'" ProcessNewMessages ...']);
333 {$ENDIF}
334 Views[i].ProcessNewMessages(Thread);
335 end;
336 end;
337 finally
338 LeaveCriticalSection;
339 end;
340
341 // notify main thread handlers for new output
342 // Note: The IDE itself does not set such a handler
343 if {$IFDEF VerboseExtToolAddOutputLines}true{$ELSE}FHandlers[ethNewOutput].Count>0{$ENDIF}
344 then begin
345 {$IFDEF VerboseExtToolAddOutputLines}
346 DebuglnThreadLog(['TExternalTool.AddOutputLines NotifyHandlerNewOutput ...']);
347 {$ENDIF}
348 Thread.Synchronize(Thread,@NotifyHandlerNewOutput);
349 end;
350 fOutputCountNotified:=WorkerOutput.Count;
351 {$IFDEF VerboseExtToolAddOutputLines}
352 DebuglnThreadLog(['TExternalTool.AddOutputLines END']);
353 {$ENDIF}
354 end;
355
356 procedure TExternalTool.NotifyHandlerStopped;
357 var
358 i: Integer;
359 View: TExtToolView;
360 begin
361 DoCallNotifyHandler(ethStopped);
362
363 EnterCriticalSection;
364 try
365 for i:=ViewCount-1 downto 0 do begin
366 if i>=ViewCount then continue;
367 View:=Views[i];
368 if ErrorMessage<>'' then
369 View.SummaryMsg:=ErrorMessage
370 else
371 View.SummaryMsg:=lisSuccess;
372 View.InputClosed; // this might delete the view
373 end;
374 finally
375 LeaveCriticalSection;
376 end;
377
378 if Group<>nil then
379 Group.ToolExited(Self);
380
381 // process stopped => start next
382 if Tools<>nil then
383 TExternalTools(Tools).Work;
384 end;
385
386 procedure TExternalTool.NotifyHandlerNewOutput;
387 var
388 i: integer;
389 begin
390 if fOutputCountNotified>=WorkerOutput.Count then exit;
391 {$IFDEF VerboseExtToolAddOutputLines}
392 for i:=fOutputCountNotified to WorkerOutput.Count-1 do
393 debugln('IDE-DEBUG: ',WorkerOutput[i]);
394 {$ENDIF}
395 i:=FHandlers[ethNewOutput].Count;
396 while FHandlers[ethNewOutput].NextDownIndex(i) do
397 TExternalToolNewOutputEvent(FHandlers[ethNewOutput][i])(Self,fOutputCountNotified);
398 end;
399
400 procedure TExternalTool.SetThread(AValue: TExternalToolThread);
401 var
402 CallAutoFree: Boolean;
403 begin
404 // Note: in lazbuild ProcessStopped sets FThread:=nil, so SetThread is not called.
405 EnterCriticalSection;
406 try
407 if FThread=AValue then Exit;
408 FThread:=AValue;
409 CallAutoFree:=CanFree;
410 finally
411 LeaveCriticalSection;
412 end;
413 if CallAutoFree then begin
414 if MainThreadID=GetCurrentThreadId then
415 AutoFree
416 else
417 QueueAsyncAutoFree;
418 end;
419 end;
420
421 procedure TExternalTool.SynchronizedImproveMessages;
422 var
423 i: Integer;
424 Parser: TExtToolParser;
425 begin
426 EnterCriticalSection;
427 try
428 fNeedAfterSync:=false;
429 for i:=0 to ParserCount-1 do begin
430 Parser:=Parsers[i];
431 if not Parser.NeedSynchronize then continue;
432 {$IFDEF VerboseExtToolAddOutputLines}
433 //debugln(['TExternalTool.SynchronizedImproveMessages ',DbgSName(Parser),' ...']);
434 {$ENDIF}
435 Parser.ImproveMessages(etpspSynchronized);
436 Parser.NeedSynchronize:=false;
437 if Parser.NeedAfterSync then
438 fNeedAfterSync:=true;
439 end;
440 finally
441 LeaveCriticalSection;
442 end;
443 end;
444
445 constructor TExternalTool.Create(aOwner: TComponent);
446 begin
447 inherited Create(aOwner);
448 FWorkerOutput:=TStringList.Create;
449 FProcess:=TProcessUTF8.Create(nil);
450 FProcess.Options:= [poUsePipes{$IFDEF Windows},poStderrToOutPut{$ENDIF}];
451 FProcess.ShowWindow := swoHide;
452 fExecuteBefore:=TFPList.Create;
453 fExecuteAfter:=TFPList.Create;
454 end;
455
456 destructor TExternalTool.Destroy;
457 begin
458 //debugln(['TExternalTool.Destroy ',Title]);
459 EnterCriticalSection;
460 try
461 FStage:=etsDestroying;
462 if Thread is TExternalToolThread then
463 TExternalToolThread(Thread).Tool:=nil;
464 FreeAndNil(FProcess);
465 FreeAndNil(FWorkerOutput);
466 FreeAndNil(fExecuteBefore);
467 FreeAndNil(fExecuteAfter);
468 finally
469 LeaveCriticalSection;
470 end;
471 inherited Destroy;
472 end;
473
474 procedure TExternalTool.DoExecute;
475 // in main thread
476
CheckErrornull477 function CheckError: boolean;
478 begin
479 if (FStage>=etsStopped) then exit(true);
480 if (ErrorMessage='') then exit(false);
481 debugln(['Error: (lazarus) [TExternalTool.DoExecute.CheckError] Error=',ErrorMessage]);
482 EnterCriticalSection;
483 try
484 if FStage>=etsStopped then exit(true);
485 FStage:=etsStopped;
486 finally
487 LeaveCriticalSection;
488 end;
489 CreateView;
490 NotifyHandlerStopped;
491
492 Result:=true;
493 end;
494
495 var
496 ExeFile: String;
497 i: Integer;
498 aParser: TExtToolParser;
499 begin
500 if Terminated then exit;
501
502 // set Stage to etsInitializing
503 EnterCriticalSection;
504 try
505 if Stage<>etsInit then
506 raise Exception.Create('TExternalTool.Execute: already initialized');
507 FStage:=etsInitializing;
508 finally
509 LeaveCriticalSection;
510 end;
511
512 // resolve macros
513 if ResolveMacrosOnExecute then
514 begin
515 if not ResolveMacros then begin
516 if ErrorMessage='' then
517 ErrorMessage:=lisFailedToResolveMacros;
518 if CheckError then exit;
519 end;
520 end;
521
522 // init CurrentDirectory
523 Process.CurrentDirectory:=TrimFilename(Process.CurrentDirectory);
524 if not FilenameIsAbsolute(Process.CurrentDirectory) then
525 Process.CurrentDirectory:=AppendPathDelim(GetCurrentDirUTF8)+Process.CurrentDirectory;
526
527 // init Executable
528 Process.Executable:=TrimFilename(Process.Executable);
529 {$IFDEF VerboseExtToolThread}
530 debugln(['TExternalTool.DoExecute Exe=',Process.Executable]);
531 {$ENDIF}
532 if not FilenameIsAbsolute(Process.Executable) then begin
533 if ExtractFilePath(Process.Executable)<>'' then
534 Process.Executable:=AppendPathDelim(GetCurrentDirUTF8)+Process.Executable
535 else if Process.Executable='' then begin
536 ErrorMessage:=Format(lisToolHasNoExecutable, [Title]);
537 CheckError;
538 exit;
539 end else begin
540 ExeFile:=FindDefaultExecutablePath(Process.Executable,GetCurrentDirUTF8);
541 if ExeFile='' then begin
542 ErrorMessage:=Format(lisCanNotFindExecutable, [Process.Executable]);
543 CheckError;
544 exit;
545 end;
546 Process.Executable:=ExeFile;
547 end;
548 end;
549 ExeFile:=Process.Executable;
550 if not FileExistsUTF8(ExeFile) then begin
551 ErrorMessage:=Format(lisMissingExecutable, [ExeFile]);
552 CheckError;
553 exit;
554 end;
555 if DirectoryExistsUTF8(ExeFile) then begin
556 ErrorMessage:=Format(lisExecutableIsADirectory, [ExeFile]);
557 CheckError;
558 exit;
559 end;
560 if not FileIsExecutable(ExeFile) then begin
561 ErrorMessage:=Format(lisExecutableLacksThePermissionToRun, [ExeFile]);
562 CheckError;
563 exit;
564 end;
565
566 // init misc
567 WorkerMessages.BaseDirectory:=Process.CurrentDirectory;
568 WorkerDirectory:=WorkerMessages.BaseDirectory;
569 if EnvironmentOverrides.Count>0 then
570 AssignEnvironmentTo(Process.Environment,EnvironmentOverrides);
571
572 // init parsers
573 for i:=0 to ParserCount-1 do begin
574 aParser:=Parsers[i];
575 try
576 aParser.Init;
577 except
578 on E: Exception do begin
579 ErrorMessage:=Format(lisParser, [DbgSName(aParser), E.Message]);
580 CheckError;
581 exit;
582 end;
583 end;
584 end;
585
586 // set Stage to etsWaitingForStart
587 EnterCriticalSection;
588 try
589 if Stage<>etsInitializing then
590 raise Exception.Create('TExternalTool.Execute: bug in initialization');
591 FStage:=etsWaitingForStart;
592 finally
593 LeaveCriticalSection;
594 end;
595 end;
596
597 procedure TExternalTool.DoStart;
598 var
599 i: Integer;
600 begin
601 // set Stage to etsStarting
602 EnterCriticalSection;
603 try
604 if Stage<>etsWaitingForStart then
605 raise Exception.Create('TExternalTool.Execute: already started');
606 FStage:=etsStarting;
607 finally
608 LeaveCriticalSection;
609 end;
610
611 CreateView;
612
613 // mark running
614 if Tools<>nil then
615 TExternalTools(Tools).AddRunningTool(Self);
616
617 // start thread
618 if Thread=nil then begin
619 FThread:=TExternalToolThread.Create(true);
620 Thread.Tool:=Self;
621 FThread.FreeOnTerminate:=true;
622 end;
623 if ConsoleVerbosity>=-1 then begin
624 debugln(['Info: (lazarus) Execute Title="',Title,'"']);
625 debugln(['Info: (lazarus) Working Directory="',Process.CurrentDirectory,'"']);
626 debugln(['Info: (lazarus) Executable="',Process.Executable,'"']);
627 for i:=0 to Process.Parameters.Count-1 do
628 debugln(['Info: (lazarus) Param[',i,']="',Process.Parameters[i],'"']);
629 end;
630 Thread.Start;
631 end;
632
ExecuteBeforeCountnull633 function TExternalTool.ExecuteBeforeCount: integer;
634 begin
635 Result:=fExecuteBefore.Count;
636 end;
637
TExternalTool.ExecuteAfterCountnull638 function TExternalTool.ExecuteAfterCount: integer;
639 begin
640 Result:=fExecuteAfter.Count;
641 end;
642
GetExecuteAfternull643 function TExternalTool.GetExecuteAfter(Index: integer): TAbstractExternalTool;
644 begin
645 Result:=TAbstractExternalTool(fExecuteAfter[Index]);
646 end;
647
GetExecuteBeforenull648 function TExternalTool.GetExecuteBefore(Index: integer): TAbstractExternalTool;
649 begin
650 Result:=TAbstractExternalTool(fExecuteBefore[Index]);
651 end;
652
653 procedure TExternalTool.DoTerminate;
654 var
655 NeedProcTerminate: Boolean;
656 begin
657 NeedProcTerminate:=false;
658 EnterCriticalSection;
659 try
660 //debugln(['TExternalTool.DoTerminate ',Title,' Terminated=',Terminated,' Stage=',dbgs(Stage)]);
661 if Terminated then exit;
662 if Stage=etsStopped then exit;
663
664 if ErrorMessage='' then
665 ErrorMessage:=lisAborted;
666 fTerminated:=true;
667 if Stage=etsRunning then
668 NeedProcTerminate:=true;
669 if Stage<etsStarting then
670 FStage:=etsStopped
671 else if Stage<=etsRunning then
672 FStage:=etsWaitingForStop;
673 finally
674 LeaveCriticalSection;
675 end;
676 if NeedProcTerminate and (Process<>nil) then
677 Process.Terminate(AbortedExitCode);
678 end;
679
680 procedure TExternalTool.Notification(AComponent: TComponent; Operation: TOperation);
681 begin
682 inherited Notification(AComponent, Operation);
683 if Operation=opRemove then begin
684 if fExecuteBefore<>nil then
685 fExecuteBefore.Remove(AComponent);
686 if fExecuteAfter<>nil then
687 fExecuteAfter.Remove(AComponent);
688 end;
689 end;
690
TExternalTool.CanFreenull691 function TExternalTool.CanFree: boolean;
692 begin
693 Result:=(FThread=nil)
694 and inherited CanFree;
695 end;
696
IsExecutedBeforenull697 function TExternalTool.IsExecutedBefore(Tool: TAbstractExternalTool): Boolean;
698 var
699 Visited: TFPList;
700
Searchnull701 function Search(CurTool: TAbstractExternalTool): Boolean;
702 var
703 i: Integer;
704 begin
705 if CurTool=Tool then exit(true);
706 if Visited.IndexOf(CurTool)>=0 then exit(false);
707 Visited.Add(CurTool);
708 for i:=0 to CurTool.ExecuteBeforeCount-1 do
709 if Search(CurTool.ExecuteBefore[i]) then exit(true);
710 Result:=false;
711 end;
712
713 begin
714 Result:=false;
715 if Tool=Self then exit;
716 Visited:=TFPList.Create;
717 try
718 Result:=Search(Self);
719 finally
720 Visited.Free;
721 end;
722 end;
723
724 procedure TExternalTool.AddExecuteBefore(Tool: TAbstractExternalTool);
725 begin
726 //debugln(['TExternalTool.AddExecuteBefore Self=',Title,' Tool=',Tool.Title]);
727 if (Tool=Self) or (Tool.IsExecutedBefore(Self)) then
728 raise Exception.Create('TExternalTool.AddExecuteBefore: that would create a circle');
729 if (fExecuteBefore<>nil) and (fExecuteBefore.IndexOf(Tool)<0) then
730 fExecuteBefore.Add(Tool);
731 if (TExternalTool(Tool).fExecuteAfter<>nil)
732 and (TExternalTool(Tool).fExecuteAfter.IndexOf(Self)<=0) then
733 TExternalTool(Tool).fExecuteAfter.Add(Self);
734 end;
735
TExternalTool.CanStartnull736 function TExternalTool.CanStart: boolean;
737 var
738 i: Integer;
739 ExecBefore: TAbstractExternalTool;
740 begin
741 Result:=false;
742 //debugln(['TExternalTool.CanStart ',Title,' ',dbgs(Stage)]);
743 if Stage<>etsWaitingForStart then exit;
744 if Terminated then exit;
745 for i:=0 to ExecuteBeforeCount-1 do begin
746 ExecBefore:=ExecuteBefore[i];
747 if ord(ExecBefore.Stage)<ord(etsStopped) then exit;
748 if ExecBefore.ErrorMessage<>'' then exit;
749 end;
750 Result:=true;
751 end;
752
TExternalTool.GetLongestEstimatedLoadnull753 function TExternalTool.GetLongestEstimatedLoad: int64;
754 type
755 TInfo = record
756 Load: int64;
757 end;
758 PInfo = ^TInfo;
759 var
760 ToolToInfo: TPointerToPointerTree;
761
GetLoadnull762 function GetLoad(Tool: TExternalTool): int64;
763 var
764 Info: PInfo;
765 i: Integer;
766 begin
767 Info:=PInfo(ToolToInfo[Tool]);
768 if Info<>nil then
769 Result:=Info^.Load
770 else begin
771 New(Info);
772 Info^.Load:=1;
773 ToolToInfo[Tool]:=Info;
774 Result:=0;
775 for i:=0 to Tool.ExecuteAfterCount-1 do
776 Result:=Max(Result,GetLoad(TExternalTool(Tool.ExecuteAfter[i])));
777 inc(Result,Tool.EstimatedLoad);
778 Info^.Load:=Result;
779 end;
780 end;
781
782 var
783 Node: TAvlTreeNode;
784 Item: PPointerToPointerItem;
785 Info: PInfo;
786 begin
787 ToolToInfo:=TPointerToPointerTree.Create;
788 try
789 Result:=GetLoad(Self);
790 finally
791 Node:=ToolToInfo.Tree.FindLowest;
792 while Node<>nil do begin
793 Item:=PPointerToPointerItem(Node.Data);
794 Info:=PInfo(Item^.Value);
795 Dispose(Info);
796 Node:=ToolToInfo.Tree.FindSuccessor(Node);
797 end;
798 ToolToInfo.Free;
799 end;
800 end;
801
802 procedure TExternalTool.Execute;
803 begin
804 if Stage<>etsInit then
805 raise Exception.Create('TExternalTool.Execute "'+Title+'" already started');
806 DoExecute;
807 if Stage<>etsWaitingForStart then
808 exit;
809
810 if Tools<>nil then
811 TExternalTools(Tools).Work
812 else
813 DoStart;
814 end;
815
816 procedure TExternalTool.Terminate;
817 begin
818 if Tools<>nil then
819 TExternalTools(Tools).Terminate(Self)
820 else
821 DoTerminate;
822 end;
823
824 procedure TExternalTool.WaitForExit;
825 var
826 MyTools: TExternalToolsBase;
827 begin
828 MyTools:=Tools;
829 repeat
830 EnterCriticalSection;
831 try
832 if Stage=etsDestroying then exit;
833 if (Stage=etsStopped) and (FindUnfinishedView=nil) then exit;
834 finally
835 LeaveCriticalSection;
836 end;
837 // call synchronized tasks, this might free this tool
838 if MainThreadID=ThreadID then
839 begin
840 Assert(Owner is TExternalToolsBase, 'TExternalTool.WaitForExit: Owner is not TExternalToolsBase.');
841 TExternalToolsBase(Owner).HandleMesages;
842 end;
843 // check if this tool still exists
844 if MyTools.IndexOf(Self)<0 then exit;
845 // still running => wait
846 Sleep(10);
847 until false;
848 end;
849
TExternalTool.ResolveMacrosnull850 function TExternalTool.ResolveMacros: boolean;
851
Resolvenull852 function Resolve(const aValue: string; out NewValue: string): boolean;
853 begin
854 NewValue:=aValue;
855 Result:=IDEMacros.SubstituteMacros(NewValue);
856 if Result then exit;
857 if ErrorMessage='' then
858 ErrorMessage:=Format(lisInvalidMacrosIn, [aValue]);
859 LazMessageDialog(lisCCOErrorCaption, Format(lisInvalidMacrosInExternalTool,
860 [aValue, Title]),
861 mtError,[mbCancel]);
862 end;
863
864 var
865 i: Integer;
866 s: string;
867 begin
868 if IDEMacros=nil then exit(true);
869 Result:=false;
870
871 if not Resolve(Process.CurrentDirectory,s) then exit;
872 Process.CurrentDirectory:=s;
873
874 if not Resolve(Process.Executable,s) then exit;
875 Process.Executable:=s;
876
877 for i:=0 to Process.Parameters.Count-1 do begin
878 if not Resolve(Process.Parameters[i],s) then exit;
879 Process.Parameters[i]:=s;
880 end;
881
882 for i:=0 to EnvironmentOverrides.Count-1 do begin
883 if not Resolve(EnvironmentOverrides[i],s) then exit;
884 EnvironmentOverrides[i]:=s;
885 end;
886
887 Result:=true;
888 end;
889
890 procedure TExternalTool.RemoveExecuteBefore(Tool: TAbstractExternalTool);
891 begin
892 if fExecuteBefore<>nil then
893 fExecuteBefore.Remove(Tool);
894 if TExternalTool(Tool).fExecuteAfter<>nil then
895 TExternalTool(Tool).fExecuteAfter.Remove(Self);
896 end;
897
898 { TExternalTools }
899
RunExtToolHandlernull900 function TExternalTools.RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean;
901 begin
902 {$IFDEF VerboseExtToolThread}
903 debugln(['TExternalTools.RunExtToolHandler ',ToolOptions.Title,
904 ' exe="',ToolOptions.Executable,'" params="',ToolOptions.CmdLineParams,'"']);
905 {$ENDIF}
906 if ToolOptions.Parsers.Count=0 then
907 Result := RunToolAndDetach(ToolOptions)
908 else
909 Result := RunToolWithParsers(ToolOptions)
910 end;
911
RunToolAndDetachnull912 function TExternalTools.RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean;
913 // simply run and detach
914 var
915 i: Integer;
916 Proc: TProcessUTF8;
917 sl: TStringList;
918 s, Path: String;
919 begin
920 Result:=false;
921 Proc:=TProcessUTF8.Create(nil);
922 try
923 Proc.InheritHandles:=false;
924 // working directory
925 s:=ToolOptions.WorkingDirectory;
926 if ToolOptions.ResolveMacros then begin
927 if not GlobalMacroList.SubstituteStr(s) then begin
928 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of WorkerDirectory: "',ToolOptions.WorkingDirectory,'"']);
929 exit;
930 end;
931 end;
932 s:=ChompPathDelim(CleanAndExpandDirectory(s));
933 if not DirectoryExistsUTF8(s) then begin
934 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing directory "',s,'"']);
935 exit;
936 end;
937 Proc.CurrentDirectory:=s;
938
939 // environment
940 if ToolOptions.EnvironmentOverrides.Count>0 then
941 AssignEnvironmentTo(Proc.Environment,ToolOptions.EnvironmentOverrides);
942 if ToolOptions.ResolveMacros then begin
943 for i:=0 to Proc.Environment.Count-1 do begin
944 s:=Proc.Environment[i];
945 if not GlobalMacroList.SubstituteStr(s) then begin
946 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: environment override "',Proc.Environment,'"']);
947 exit;
948 end;
949 Proc.Environment[i]:=s;
950 end;
951 end;
952
953 // executable
954 s:=ToolOptions.Executable;
955 if ToolOptions.ResolveMacros then begin
956 if not GlobalMacroList.SubstituteStr(s) then begin
957 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of Executable: "',ToolOptions.Executable,'"']);
958 exit;
959 end;
960 end;
961 if not FilenameIsAbsolute(s) then begin
962 // search in PATH
963 if Proc.Environment.Count>0 then
964 Path:=Proc.Environment.Values['PATH']
965 else
966 Path:=GetEnvironmentVariableUTF8('PATH');
967 s:=SearchFileInPath(s,Proc.CurrentDirectory,
968 Path, PathSeparator,
969 []);
970 {$IFDEF Windows}
971 if (s='') and (ExtractFileExt(s)='') then begin
972 s:=SearchFileInPath(s+'.exe',Proc.CurrentDirectory,
973 Path, PathSeparator,
974 []);
975 end;
976 {$ENDIF}
977 if s='' then begin
978 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing executable "',ToolOptions.Executable,'"']);
979 exit;
980 end;
981 end;
982 if not ( FilenameIsAbsolute(s) and FileExistsUTF8(s) ) then begin
983 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing executable: "',s,'"']);
984 exit;
985 end;
986 if DirectoryExistsUTF8(s) {$IFDEF DARWIN}and (ExtractFileExt(s)<>'.app'){$ENDIF} then begin
987 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: executable is a directory: "',s,'"']);
988 exit;
989 end;
990 if {$IFDEF DARWIN}(ExtractFileExt(s)<>'.app') and{$ENDIF} not FileIsExecutable(s) then begin
991 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: executable lacks permission to run: "',s,'"']);
992 exit;
993 end;
994
995 {$IFDEF DARWIN}
996 if DirectoryExistsUTF8(s) then
997 begin
998 Proc.Executable:='/usr/bin/open';
999 s:=s+LineEnding+ToolOptions.CmdLineParams;
1000 end
1001 else
1002 {$ENDIF}
1003 begin
1004 Proc.Executable:=s;
1005 s:=ToolOptions.CmdLineParams;
1006 end;
1007
1008 // params
1009 if ToolOptions.ResolveMacros and not GlobalMacroList.SubstituteStr(s) then begin
1010 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,
1011 ' failed: macros in cmd line params "',ToolOptions.CmdLineParams,'"']);
1012 exit;
1013 end;
1014 sl:=TStringList.Create;
1015 try
1016 SplitCmdLineParams(s,sl);
1017 Proc.Parameters:=sl;
1018 finally
1019 sl.Free;
1020 end;
1021
1022 // run and detach
1023 if ToolOptions.ShowConsole then
1024 Proc.Options:=Proc.Options+[poNewConsole]-[poNoConsole]
1025 else
1026 Proc.Options:=Proc.Options-[poNewConsole]+[poNoConsole];
1027 if ToolOptions.HideWindow then
1028 Proc.ShowWindow:=swoHide
1029 else
1030 Proc.ShowWindow:=swoShow;
1031 try
1032 Proc.Execute;
1033 Result:=true;
1034 except
1035 end;
1036 finally
1037 Proc.Free;
1038 end;
1039 end;
1040
RunToolWithParsersnull1041 function TExternalTools.RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean;
1042 // run with parsers and messages
1043 var
1044 Tool: TAbstractExternalTool;
1045 i: Integer;
1046 begin
1047 {$IFDEF VerboseExtToolThread}
1048 debugln(['TExternalTools.RunToolWithParsers run with scanners ...']);
1049 {$ENDIF}
1050 Result:=false;
1051 Tool:=Add(ToolOptions.Title);
1052 Tool.Reference(Self,ClassName);
1053 try
1054 Tool.Hint:=ToolOptions.Hint;
1055 Tool.Process.CurrentDirectory:=ToolOptions.WorkingDirectory;
1056 Tool.Process.Executable:=ToolOptions.Executable;
1057 Tool.CmdLineParams:=ToolOptions.CmdLineParams;
1058 Tool.EnvironmentOverrides:=ToolOptions.EnvironmentOverrides;
1059 Assert(Assigned(ToolOptions.Parsers), 'TExternalTools.RunToolWithParsers: Parsers=Nil.');
1060 for i:=0 to ToolOptions.Parsers.Count-1 do
1061 Tool.AddParsers(ToolOptions.Parsers[i]);
1062 if ToolOptions.ShowConsole then
1063 Tool.Process.Options:=Tool.Process.Options+[poNewConsole]-[poNoConsole]
1064 else
1065 Tool.Process.Options:=Tool.Process.Options-[poNewConsole]+[poNoConsole];
1066 if ToolOptions.HideWindow then
1067 Tool.Process.ShowWindow:=swoHide
1068 else
1069 Tool.Process.ShowWindow:=swoShow;
1070 if ToolOptions.ResolveMacros and not Tool.ResolveMacros then begin
1071 debugln(['Error: (lazarus) [TExternalTools.RunToolWithParsers] failed to resolve macros']);
1072 exit;
1073 end;
1074 {$IFDEF VerboseExtToolThread}
1075 debugln(['TExternalTools.RunToolWithParsers Execute ',Tool.Title,' WD="',Tool.Process.CurrentDirectory,'" Exe="',Tool.Process.Executable,'" Params="',Tool.CmdLineParams,'" ...']);
1076 {$ENDIF}
1077 Tool.Execute;
1078 {$IFDEF VerboseExtToolThread}
1079 debugln(['TExternalTools.RunToolWithParsers WaitForExit ',Tool.Title,' ...']);
1080 {$ENDIF}
1081 Tool.WaitForExit;
1082 {$IFDEF VerboseExtToolThread}
1083 debugln(['TExternalTools.RunToolWithParsers Done ',Tool.Title]);
1084 {$ENDIF}
1085 Result:=(Tool.ErrorMessage='') and (not Tool.Terminated) and (Tool.ExitStatus=0);
1086 finally
1087 Tool.Release(Self);
1088 end;
1089 end;
1090
TExternalTools.GetRunningToolsnull1091 function TExternalTools.GetRunningTools(Index: integer): TExternalTool;
1092 begin
1093 EnterCriticalSection;
1094 try
1095 Result:=TExternalTool(fRunning[Index]);
1096 finally
1097 LeaveCriticalSection;
1098 end;
1099 end;
1100
1101 procedure TExternalTools.AddRunningTool(Tool: TExternalTool);
1102 begin
1103 EnterCriticalSection;
1104 try
1105 if fRunning.IndexOf(Tool)<0 then
1106 fRunning.Add(Tool);
1107 finally
1108 LeaveCriticalSection;
1109 end;
1110 end;
1111
1112 procedure TExternalTools.RemoveRunningTool(Tool: TExternalTool);
1113 begin
1114 EnterCriticalSection;
1115 try
1116 fRunning.Remove(Tool);
1117 finally
1118 LeaveCriticalSection;
1119 end;
1120 end;
1121
GetParsersnull1122 function TExternalTools.GetParsers(Index: integer): TExtToolParserClass;
1123 begin
1124 Result:=TExtToolParserClass(fParsers[Index]);
1125 end;
1126
1127 procedure TExternalTools.Notification(AComponent: TComponent; Operation: TOperation);
1128 begin
1129 inherited Notification(AComponent, Operation);
1130 if Operation=opRemove then begin
1131 EnterCriticalSection;
1132 try
1133 if fItems<>nil then
1134 fItems.Remove(AComponent);
1135 if fRunning<>nil then
1136 fRunning.Remove(AComponent);
1137 finally
1138 LeaveCriticalSection;
1139 end;
1140 end;
1141 end;
1142
1143 constructor TExternalTools.Create(aOwner: TComponent);
1144 begin
1145 inherited Create(aOwner);
1146 InitCriticalSection(FCritSec);
1147 fRunning:=TFPList.Create;
1148 fParsers:=TFPList.Create;
1149 MaxProcessCount:=DefaultMaxProcessCount;
1150 if ExternalToolList=nil then
1151 ExternalToolList:=Self;
1152 if ExternalTools=nil then
1153 ExternalTools:=Self;
1154 RunExternalTool := @RunExtToolHandler;
1155 end;
1156
1157 destructor TExternalTools.Destroy;
1158 begin
1159 RunExternalTool:=nil;
1160 TerminateAll;
1161 EnterCriticalSection;
1162 try
1163 if fRunning.Count>0 then
1164 raise Exception.Create('TExternalTools.Destroy some tools still running');
1165 if ExternalToolList=Self then
1166 ExternalToolList:=nil;
1167 if ExternalTools=Self then
1168 ExternalTools:=nil;
1169 inherited Destroy;
1170 FreeAndNil(fRunning);
1171 FreeAndNil(fParsers);
1172 finally
1173 LeaveCriticalSection;
1174 end;
1175 DoneCriticalsection(FCritSec);
1176 end;
1177
Addnull1178 function TExternalTools.Add(Title: string): TAbstractExternalTool;
1179 begin
1180 Result:=FToolClass.Create(Self);
1181 Result.Title:=Title;
1182 fItems.Add(Result);
1183 end;
1184
IndexOfnull1185 function TExternalTools.IndexOf(Tool: TAbstractExternalTool): integer;
1186 begin
1187 Result:=fItems.IndexOf(Tool);
1188 end;
1189
TExternalTools.ParserCountnull1190 function TExternalTools.ParserCount: integer;
1191 begin
1192 Result:=fParsers.Count;
1193 end;
1194
1195 procedure TExternalTools.Work;
1196 var
1197 Tool: TExternalTool;
1198 begin
1199 while RunningCount<MaxProcessCount do begin
1200 Tool:=FindNextToolToStart;
1201 if Tool=nil then exit;
1202 Tool.DoStart;
1203 end;
1204 end;
1205
TExternalTools.FindNextToolToStartnull1206 function TExternalTools.FindNextToolToStart: TExternalTool;
1207 var
1208 Tool: TExternalTool;
1209 CurLoad: Int64;
1210 Load: Int64;
1211 i: Integer;
1212 begin
1213 Result:=nil;
1214 Load:=0;
1215 for i:=0 to Count-1 do begin
1216 Tool:=TExternalTool(Items[i]);
1217 //debugln(['TExternalTools.FindNextToolToExec ',Tool.Title,' ',Tool.CanStart]);
1218 if not Tool.CanStart then continue;
1219 CurLoad:=Tool.GetLongestEstimatedLoad;
1220 if (Result<>nil) and (Load>=CurLoad) then Continue;
1221 Result:=Tool;
1222 Load:=CurLoad;
1223 end;
1224 end;
1225
1226 procedure TExternalTools.Terminate(Tool: TExternalTool);
1227 begin
1228 if Tool=nil then exit;
1229 Tool.DoTerminate;
1230 end;
1231
1232 procedure TExternalTools.TerminateAll;
1233 // terminate all current tools
1234 var
1235 i: Integer;
1236 begin
1237 for i:=Count-1 downto 0 do
1238 begin
1239 Assert(i<Count, 'TExternalTools.TerminateAll: xxx'); // if i>=Count then continue; <- why was this?
1240 Terminate(Items[i] as TExternalTool);
1241 end;
1242 end;
1243
1244 procedure TExternalTools.Clear;
1245 begin
1246 TerminateAll;
1247 while Count>0 do
1248 Items[0].Free;
1249 end;
1250
RunningCountnull1251 function TExternalTools.RunningCount: integer;
1252 begin
1253 Result:=fRunning.Count;
1254 end;
1255
1256 procedure TExternalTools.EnterCriticalSection;
1257 begin
1258 System.EnterCriticalsection(FCritSec);
1259 end;
1260
1261 procedure TExternalTools.LeaveCriticalSection;
1262 begin
1263 System.LeaveCriticalsection(FCritSec);
1264 end;
1265
1266 procedure TExternalTools.RegisterParser(Parser: TExtToolParserClass);
1267 begin
1268 if fParsers.IndexOf(Parser)>=0 then exit;
1269 fParsers.Add(Parser);
1270 end;
1271
1272 procedure TExternalTools.UnregisterParser(Parser: TExtToolParserClass);
1273 begin
1274 if fParsers=nil then exit;
1275 fParsers.Remove(Parser);
1276 end;
1277
TExternalTools.FindParserForToolnull1278 function TExternalTools.FindParserForTool(const SubTool: string): TExtToolParserClass;
1279 var
1280 i: Integer;
1281 begin
1282 for i:=0 to fParsers.Count-1 do begin
1283 Result:=TExtToolParserClass(fParsers[i]);
1284 if Result.CanParseSubTool(SubTool) then exit;
1285 end;
1286 Result:=nil;
1287 end;
1288
TExternalTools.FindParserWithNamenull1289 function TExternalTools.FindParserWithName(const ParserName: string): TExtToolParserClass;
1290 var
1291 i: Integer;
1292 begin
1293 for i:=0 to fParsers.Count-1 do begin
1294 Result:=TExtToolParserClass(fParsers[i]);
1295 if SameText(Result.GetParserName,ParserName) then exit;
1296 end;
1297 Result:=nil;
1298 end;
1299
GetMsgToolnull1300 function TExternalTools.GetMsgTool(Msg: TMessageLine): TAbstractExternalTool;
1301 var
1302 CurOwner: TObject;
1303 View: TExtToolView;
1304 begin
1305 Result:=nil;
1306 if (Msg=nil) or (Msg.Lines=nil) then exit;
1307 CurOwner:=Msg.Lines.Owner;
1308 if CurOwner=nil then exit;
1309 if CurOwner is TAbstractExternalTool then
1310 Result:=TAbstractExternalTool(CurOwner)
1311 else if CurOwner is TExtToolView then begin
1312 View:=TExtToolView(CurOwner);
1313 Result:=View.Tool;
1314 end;
1315 end;
1316
1317 { TExternalToolThread }
1318
1319 procedure TExternalToolThread.SetTool(AValue: TExternalTool);
1320 begin
1321 if FTool=AValue then Exit;
1322 if FTool<>nil then
1323 FTool.Thread:=nil;
1324 FTool:=AValue;
1325 if FTool<>nil then
1326 FTool.Thread:=Self;
1327 end;
1328
1329 procedure TExternalToolThread.Execute;
1330 type
1331 TErrorFrame = record
1332 Addr: Pointer;
1333 Line: shortstring;
1334 end;
1335 PErrorFrame = ^TErrorFrame;
1336
1337 var
1338 ErrorFrames: array[0..30] of TErrorFrame;
1339 ErrorFrameCount: integer;
1340
GetExceptionStackTracenull1341 function GetExceptionStackTrace: string;
1342 var
1343 FrameCount: LongInt;
1344 Frames: PPointer;
1345 Cnt: LongInt;
1346 f: PErrorFrame;
1347 i: Integer;
1348 begin
1349 Result:='';
1350 FrameCount:=ExceptFrameCount;
1351 Frames:=ExceptFrames;
1352 ErrorFrames[0].Addr:=ExceptAddr;
1353 ErrorFrames[0].Line:='';
1354 ErrorFrameCount:=1;
1355 Cnt:=FrameCount;
1356 for i:=1 to Cnt do begin
1357 ErrorFrames[i].Addr:=Frames[i-1];
1358 ErrorFrames[i].Line:='';
1359 ErrorFrameCount:=i+1;
1360 end;
1361 for i:=0 to ErrorFrameCount-1 do begin
1362 f:=@ErrorFrames[i];
1363 try
1364 f^.Line:=copy(BackTraceStrFunc(f^.Addr),1,255);
1365 except
1366 f^.Line:=copy(SysBackTraceStr(f^.Addr),1,255);
1367 end;
1368 end;
1369 for i:=0 to ErrorFrameCount-1 do begin
1370 Result+=ErrorFrames[i].Line+LineEnding;
1371 end;
1372 end;
1373
1374 var
1375 Buf: string;
1376
ReadInputPipenull1377 function ReadInputPipe(aStream: TInputPipeStream; var LineBuf: string): boolean;
1378 // true if some bytes have been read
1379 var
1380 Count: DWord;
1381 StartPos: Integer;
1382 i: DWord;
1383 begin
1384 Result:=false;
1385 if aStream=nil then exit;
1386 Count:=aStream.NumBytesAvailable;
1387 if Count=0 then exit;
1388 Count:=aStream.Read(Buf[1],Min(length(Buf),Count));
1389 if Count=0 then exit;
1390 Result:=true;
1391 StartPos:=1;
1392 i:=1;
1393 while i<=Count do begin
1394 if Buf[i] in [#10,#13] then begin
1395 LineBuf:=LineBuf+copy(Buf,StartPos,i-StartPos);
1396 fLines.Add(LineBuf);
1397 LineBuf:='';
1398 if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
1399 then
1400 inc(i);
1401 StartPos:=i+1;
1402 end;
1403 inc(i);
1404 end;
1405 LineBuf:=LineBuf+copy(Buf,StartPos,Count-StartPos+1);
1406 end;
1407
1408 const
1409 UpdateTimeDiff = 1000 div 5; // update five times a second, even if there is still work
1410 var
1411 {$IFDEF VerboseExtToolThread}
1412 Title: String;
1413 {$ENDIF}
1414 OutputLine, StdErrLine: String;
1415 LastUpdate: QWord;
1416 ErrMsg: String;
1417 ok: Boolean;
1418 HasOutput: Boolean;
1419 begin
1420 {$IFDEF VerboseExtToolThread}
1421 Title:=Tool.Title;
1422 {$ENDIF}
1423 SetLength(Buf,4096);
1424 ErrorFrameCount:=0;
1425 fLines:=TStringList.Create;
1426 try
1427 try
1428 if Tool.Stage<>etsStarting then begin
1429 {$IFDEF VerboseExtToolThread}
1430 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Tool.Stage=',dbgs(Tool.Stage),' aborting']);
1431 {$ENDIF}
1432 exit;
1433 end;
1434
1435 {$IFDEF VerboseExtToolThread}
1436 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' check executing "',Tool.Process.Executable,'" ...']);
1437 {$ENDIF}
1438
1439 if not FileIsExecutable(Tool.Process.Executable) then begin
1440 Tool.ErrorMessage:=Format(lisCanNotExecute, [Tool.Process.Executable]);
1441 Tool.ProcessStopped;
1442 exit;
1443 end;
1444 if not DirectoryExistsUTF8(ChompPathDelim(Tool.Process.CurrentDirectory))
1445 then begin
1446 Tool.ErrorMessage:=Format(lisMissingDirectory, [Tool.Process.
1447 CurrentDirectory]);
1448 Tool.ProcessStopped;
1449 exit;
1450 end;
1451
1452 // Under Unix TProcess uses fpFork, which means the current thread is
1453 // duplicated. One is the old thread and one runs fpExecve.
1454 // If fpExecve runs, then it will not return.
1455 // If fpExecve fails it returns via an exception and this thread runs twice.
1456 ok:=false;
1457 try
1458 {$IFDEF VerboseExtToolThread}
1459 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute ...']);
1460 {$ENDIF}
1461 // now execute
1462 Tool.Process.PipeBufferSize:=Max(Tool.Process.PipeBufferSize,64*1024);
1463 Tool.Process.Execute;
1464 {$IFDEF VerboseExtToolThread}
1465 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' executing ...']);
1466 {$ENDIF}
1467 ok:=true;
1468 except
1469 on E: Exception do begin
1470 // BEWARE: we are now either in the normal thread or in the failed forked thread
1471 {$IFDEF VerboseExtToolThread}
1472 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute failed: ',E.Message]);
1473 {$ENDIF}
1474 if Tool.ErrorMessage='' then
1475 Tool.ErrorMessage:=Format(lisUnableToExecute, [E.Message]);
1476 end;
1477 end;
1478 // BEWARE: we are now either in the normal thread or in the failed forked thread
1479 if not ok then begin
1480 Tool.ProcessStopped;
1481 exit;
1482 end;
1483 // we are now in the normal thread
1484 if Tool.Stage>=etsStopped then
1485 exit;
1486 {$IFDEF VerboseExtToolThread}
1487 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessRunning ...']);
1488 {$ENDIF}
1489 Tool.ProcessRunning;
1490 if Tool.Stage>=etsStopped then
1491 exit;
1492 {$IFDEF VerboseExtToolThread}
1493 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading ...']);
1494 {$ENDIF}
1495
1496 OutputLine:='';
1497 StdErrLine:='';
1498 LastUpdate:=GetTickCount64;
1499 while (Tool<>nil) and (Tool.Stage=etsRunning) do begin
1500 if Tool.ReadStdOutBeforeErr then begin
1501 HasOutput:=ReadInputPipe(Tool.Process.Output,OutputLine)
1502 or ReadInputPipe(Tool.Process.Stderr,StdErrLine);
1503 end else begin
1504 HasOutput:=ReadInputPipe(Tool.Process.Stderr,StdErrLine)
1505 or ReadInputPipe(Tool.Process.Output,OutputLine);
1506 end;
1507 if (not HasOutput) then begin
1508 // no more pending output
1509 if not Tool.Process.Running then break;
1510 end;
1511 if (fLines.Count>0)
1512 and (Abs(int64(GetTickCount64)-LastUpdate)>UpdateTimeDiff) then begin
1513 {$IFDEF VerboseExtToolThread}
1514 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ',TimeToStr(Now),' ',IntToStr(GetTickCount64),' AddOutputLines ...']);
1515 {$ENDIF}
1516 Tool.AddOutputLines(fLines);
1517 {$IFDEF VerboseExtToolThread}
1518 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' AddOutputLines ok']);
1519 {$ENDIF}
1520 fLines.Clear;
1521 LastUpdate:=GetTickCount64;
1522 end;
1523 if (not HasOutput) then begin
1524 // no more pending output and process is still running
1525 // => tool needs some time
1526 Sleep(10);
1527 end;
1528 end;
1529 {$IFDEF VerboseExtToolThread}
1530 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' end reading']);
1531 {$ENDIF}
1532 // add rest of output
1533 if (OutputLine<>'') then
1534 fLines.Add(OutputLine);
1535 if (StdErrLine<>'') then
1536 fLines.Add(StdErrLine);
1537 if (Tool<>nil) and (fLines.Count>0) then begin
1538 {$IFDEF VerboseExtToolThread}
1539 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ...']);
1540 {$ENDIF}
1541 Tool.AddOutputLines(fLines);
1542 {$IFDEF VerboseExtToolThread}
1543 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ok']);
1544 {$ENDIF}
1545 fLines.Clear;
1546 end;
1547 try
1548 if Tool.Stage>=etsStopped then begin
1549 {$IFDEF VerboseExtToolThread}
1550 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not reading exit status, because already stopped']);
1551 {$ENDIF}
1552 exit;
1553 end;
1554 {$IFDEF VerboseExtToolThread}
1555 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading exit status ...']);
1556 {$ENDIF}
1557 Tool.ExitStatus:=Tool.Process.ExitStatus;
1558 Tool.ExitCode:=Tool.Process.ExitCode;
1559 {$IFDEF VerboseExtToolThread}
1560 if Tool.ExitStatus<>0 then
1561 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' exit status=',Tool.ExitStatus,' ExitCode=',Tool.ExitCode]);
1562 {$ENDIF}
1563 except
1564 Tool.ErrorMessage:=lisUnableToReadProcessExitStatus;
1565 end;
1566 except
1567 on E: Exception do begin
1568 {$IFDEF VerboseExtToolThread}
1569 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' run: ',E.Message]);
1570 {$ENDIF}
1571 if (Tool<>nil) and (Tool.ErrorMessage='') then begin
1572 Tool.ErrorMessage:=E.Message;
1573 ErrMsg:=GetExceptionStackTrace;
1574 {$IFDEF VerboseExtToolErrors}
1575 DebuglnThreadLog(ErrMsg);
1576 {$ENDIF}
1577 Tool.ErrorMessage:=E.Message+LineEnding+ErrMsg;
1578 end;
1579 end;
1580 end;
1581 finally
1582 {$IFDEF VerboseExtToolThread}
1583 if fLines<>nil then
1584 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' cleaning up']);
1585 {$ENDIF}
1586 // clean up
1587 try
1588 FreeAndNil(fLines);
1589 except
1590 on E: Exception do begin
1591 {$IFDEF VerboseExtToolThread}
1592 DebuglnThreadLog(['TExternalToolThread.Execute adding pending messages: ',E.Message]);
1593 {$ENDIF}
1594 if Tool<>nil then
1595 Tool.ErrorMessage:=Format(lisFreeingBufferLines, [E.Message]);
1596 end;
1597 end;
1598 end;
1599 if Tool.Stage>=etsStopped then begin
1600 {$IFDEF VerboseExtToolThread}
1601 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not cleaning up']);
1602 {$ENDIF}
1603 exit;
1604 end;
1605 {$IFDEF VerboseExtToolThread}
1606 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessStopped ...']);
1607 {$ENDIF}
1608 if Tool<>nil then
1609 Tool.ProcessStopped;
1610 {$IFDEF VerboseExtToolThread}
1611 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Thread END']);
1612 {$ENDIF}
1613 end;
1614
1615 procedure TExternalToolThread.DebuglnThreadLog(const Args: array of const);
1616 begin
1617 debugln(Args);
1618 end;
1619
1620 destructor TExternalToolThread.Destroy;
1621 begin
1622 Tool:=nil;
1623 inherited Destroy;
1624 end;
1625
1626 end.
1627
1628