paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-13 12:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Fix attaching to a process, if the project does not provide the filename of the (host) executable. Issue #41201

Browse Source 
(cherry picked from commit 7f0a0f7ea6)
This commit is contained in:
Martin 2025-06-22 15:31:05 +02:00
parent 59d8be35fd
commit c52a98dba2
2 changed files with 38 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/fpdebug/fpdbgcontroller.pas
View File

@ -305,6 +305,7 @@ type
procedure SetParams(AValue: TStringList);
procedure CheckExecutableAndLoadClasses(out ATargetInfo: TTargetDescriptor);
procedure InitForDefaultTargetAndLoadClasses(out ATargetInfo: TTargetDescriptor);
protected
FMainProcess: TDbgProcess;
FCurrentProcess: TDbgProcess;
@ -1554,6 +1555,13 @@ begin
FOsDbgClasses := FpDbgClasses.GetDbgProcessClass(ATargetInfo);
end;
procedure TDbgController.InitForDefaultTargetAndLoadClasses(out ATargetInfo: TTargetDescriptor);
begin
ATargetInfo := hostDescriptor;
FOsDbgClasses := FpDbgClasses.GetDbgProcessClass(ATargetInfo);
end;
procedure TDbgController.SetExecutableFilename(const AValue: string);
begin
if assigned(FMainProcess) then
@ -2163,19 +2171,26 @@ begin
Result := nil;
assert(FMainProcess = nil, 'TDbgController.CreateDbgProcess: FMainProcess = nil');
if FExecutableFilename = '' then begin
DebugLn(DBG_WARNINGS, 'No filename given to execute.');
FLastError := CreateError(fpInternalErr, ['No filename given to execute.']);
Exit;
end;
if not FileExists(FExecutableFilename) then begin
DebugLn(DBG_WARNINGS, 'File %s does not exist.',[FExecutableFilename]);
FLastError := CreateError(fpInternalErr, ['File does not exist: ' + FExecutableFilename]);
Exit;
if AttachToPid = 0 then begin
if FExecutableFilename = '' then begin
DebugLn(DBG_WARNINGS, 'No filename given to execute.');
FLastError := CreateError(fpInternalErr, ['No filename given to execute.']);
Exit;
end;
if not FileExists(FExecutableFilename) then begin
DebugLn(DBG_WARNINGS, 'File %s does not exist.',[FExecutableFilename]);
FLastError := CreateError(fpInternalErr, ['File does not exist: ' + FExecutableFilename]);
Exit;
end;
// Get exe info, load classes
CheckExecutableAndLoadClasses(TargetDescriptor);
end
else begin
// Attach, get debug classes for the host system
InitForDefaultTargetAndLoadClasses(TargetDescriptor);
end;
// Get exe info, load classes
CheckExecutableAndLoadClasses(TargetDescriptor);
if not Assigned(OsDbgClasses) then begin
DebugLn(DBG_WARNINGS, 'Error - No support registered for debug target');
FLastError := CreateError(fpInternalErr, ['Unsupported target for file: ' + FExecutableFilename+'.'#13#10 +

21
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -4157,7 +4157,19 @@ begin
{$ifdef windows}
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
{$endif windows}
FDbgController.AttachToPid := 0;
if ACommand = dcAttach then begin
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
Result := FDbgController.AttachToPid <> 0;
if not Result then begin
FileName := '';
Exit;
end;
end;
// Check if CreateDbgProcess returns a valid TDbgProcess
// if ACommand <> dcAttach then begin
if Assigned(FDbgController.CurrentProcess) then begin
FDbgController.CurrentProcess.Config.UseConsoleWinPos := FUseConsoleWinPos;
FDbgController.CurrentProcess.Config.UseConsoleWinSize := FUseConsoleWinSize;
@ -4175,15 +4187,6 @@ begin
FDbgController.CurrentProcess.Config.BreakpointSearchMaxLines := TFpDebugDebuggerProperties(GetProperties).BreakpointSearchMaxLines;
FDbgController.AttachToPid := 0;
if ACommand = dcAttach then begin
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
Result := FDbgController.AttachToPid <> 0;
if not Result then begin
FileName := '';
Exit;
end;
end;
FWorkQueue.Clear;
FWorkQueue.ThreadCount := 1;
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := FWorkQueue.Threads[0].ThreadID;{$ENDIF}