paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 14:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Make the TDbgProcess instance available as soon as the filename is set. E.g. to allow setting properties on the process before calling StartInstance.

Browse Source
This commit is contained in:
Martin 2024-01-27 12:47:07 +01:00
parent b69afbdd4f
commit 5fca66cad9
1 changed files with 51 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
components/fpdebug/fpdbgcontroller.pas
View File

@ -292,6 +292,7 @@ type
FWorkingDirectory: string;
// This only holds a reference to the LazDebugger instance
FProcessConfig: TDbgProcessConfig;
function GetCurrentProcess: TDbgProcess;
function GetCurrentThreadId: Integer;
function GetDefaultContext: TFpDbgLocationContext;
procedure SetCurrentThreadId(AValue: Integer);
@ -308,6 +309,7 @@ type
FCurrentThread: TDbgThread;
FCommand, FCommandToBeFreed: TDbgControllerCmd;
function GetProcess(const AProcessIdentifier: THandle; out AProcess: TDbgProcess): Boolean;
function CreateDbgProcess: TDbgProcess;
public
constructor Create(AMemManager: TFpDbgMemManager; AMemModel: TFpDbgMemModel); virtual;
destructor Destroy; override;
@ -338,7 +340,7 @@ type
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
property AttachToPid: Integer read FAttachToPid write FAttachToPid;
property CurrentProcess: TDbgProcess read FCurrentProcess;
property CurrentProcess: TDbgProcess read GetCurrentProcess;
property CurrentThread: TDbgThread read FCurrentThread;
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
property MainProcess: TDbgProcess read FMainProcess;
@ -1520,8 +1522,12 @@ end;
procedure TDbgController.SetExecutableFilename(const AValue: string);
begin
if assigned(FMainProcess) then
raise Exception.Create('ExecutableFilename can not be changed while running');
if FExecutableFilename=AValue then Exit;
FExecutableFilename:=AValue;
FreeAndNil(FCurrentProcess);
end;
procedure TDbgController.SetEnvironment(AValue: TStrings);
@ -1535,6 +1541,14 @@ begin
Result := FCurrentThread.ID;
end;
function TDbgController.GetCurrentProcess: TDbgProcess;
begin
if (FCurrentProcess = nil) and (FMainProcess = nil) then
FCurrentProcess := CreateDbgProcess;
Result := FCurrentProcess;
end;
function TDbgController.GetDefaultContext: TFpDbgLocationContext;
begin
Result := FStoredDefaultContext;
@ -1631,43 +1645,20 @@ var
begin
result := False;
FLastError := NoError;
if assigned(FMainProcess) then
begin
if assigned(FMainProcess) then begin
DebugLn(DBG_WARNINGS, 'The debuggee is already running');
Exit;
end;
end;
if FExecutableFilename = '' then
begin
DebugLn(DBG_WARNINGS, 'No filename given to execute.');
if FCurrentProcess = nil then
FCurrentProcess := CreateDbgProcess;
if not Assigned(FCurrentProcess) then
Exit;
end;
if not FileExists(FExecutableFilename) then
begin
DebugLn(DBG_WARNINGS, 'File %s does not exist.',[FExecutableFilename]);
Exit;
end;
// Get exe info, load classes
CheckExecutableAndLoadClasses;
if not Assigned(OsDbgClasses) then
begin
result := false;
DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target');
Exit;
end;
Flags := [];
if RedirectConsoleOutput then Include(Flags, siRediretOutput);
if ForceNewConsoleWin then Include(Flags, siForceNewConsole);
FCurrentProcess := OSDbgClasses.DbgProcessClass.Create(FExecutableFilename, OsDbgClasses, MemManager, MemModel, ProcessConfig);
if not Assigned(FCurrentProcess) then
begin
Result := false;
DebugLn(DBG_WARNINGS, 'Error - could not create TDbgProcess');
Exit;
end;
if AttachToPid <> 0 then
Result := FCurrentProcess.AttachToInstance(AttachToPid, FLastError)
@ -2107,6 +2098,36 @@ begin
Result := FProcessMap.GetData(AProcessIdentifier, AProcess) and (AProcess <> nil);
end;
function TDbgController.CreateDbgProcess: TDbgProcess;
begin
Result := nil;
assert(FMainProcess = nil, 'TDbgController.CreateDbgProcess: FMainProcess = nil');
if FExecutableFilename = '' then begin
DebugLn(DBG_WARNINGS, 'No filename given to execute.');
Exit;
end;
if not FileExists(FExecutableFilename) then begin
DebugLn(DBG_WARNINGS, 'File %s does not exist.',[FExecutableFilename]);
Exit;
end;
// Get exe info, load classes
CheckExecutableAndLoadClasses;
if not Assigned(OsDbgClasses) then begin
DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target');
Exit;
end;
Result := OSDbgClasses.DbgProcessClass.Create(
FExecutableFilename, OsDbgClasses, MemManager, MemModel, ProcessConfig);
if not Assigned(Result) then begin
DebugLn(DBG_WARNINGS, 'Error - could not create TDbgProcess');
Exit;
end;
end;
constructor TDbgController.Create(AMemManager: TFpDbgMemManager;
AMemModel: TFpDbgMemModel);
begin