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

LazDebuggerFp, FpDebug: Show an error message, if the debugger cannot run the application. Issue #0038167

Browse Source 
git-svn-id: trunk@64243 -
This commit is contained in:
martin 2020-12-19 22:39:00 +00:00
parent b5e8644836
commit fa5199045e
9 changed files with 88 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
components/fpdebug/fpdbgavrclasses.pas
View File

@ -18,7 +18,8 @@ uses
FpDbgLoader,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
LazLoggerBase, Maps,
FpDbgRsp, FpDbgCommon, FpdMemoryTools;
FpDbgRsp, FpDbgCommon, FpdMemoryTools,
FpErrorMessages;
const
// RSP commands
@ -101,12 +102,12 @@ type
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
// Not supported, returns false
//class function AttachToInstance(AFileName: string; APid: Integer
// ): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(target: TTargetDescriptor): boolean; override;
@ -533,7 +534,7 @@ end;
class function TDbgAvrProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager): TDbgProcess;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
var
AnExecutabeFilename: string;
dbg: TDbgAvrProcess;
@ -571,8 +572,8 @@ begin
end;
class function TDbgAvrProcess.AttachToInstance(AFileName: string;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager
): TDbgProcess;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
begin
result := nil;
end;

11
components/fpdebug/fpdbgclasses.pp
View File

@ -41,7 +41,7 @@ uses
Classes, SysUtils, Maps, FpDbgDwarf, FpDbgUtil, FpDbgLoader, FpDbgInfo,
FpdMemoryTools, LazLoggerBase, LazClasses, LazFileUtils, DbgIntfBaseTypes,
fgl, DbgIntfDebuggerBase, FpPascalBuilder, fpDbgSymTableContext,
FpDbgDwarfDataClasses, FpDbgCommon;
FpDbgDwarfDataClasses, FpDbgCommon, FpErrorMessages;
type
TFPDEvent = (
@ -570,8 +570,8 @@ type
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; virtual;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; virtual;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; virtual;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); virtual;
destructor Destroy; override;
@ -2100,14 +2100,15 @@ end;
class function TDbgProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager): TDbgProcess;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
result := nil;
end;
class function TDbgProcess.AttachToInstance(AFileName: string; APid: Integer;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Attach not supported');
Result := nil;

10
components/fpdebug/fpdbgcontroller.pas
View File

@ -16,7 +16,7 @@ uses
{$ifdef windows} FpDbgWinClasses, {$endif}
{$ifdef darwin} FpDbgDarwinClasses, {$endif}
{$ifdef linux} FpDbgLinuxClasses, {$endif}
FpDbgInfo, FpDbgDwarf, FpdMemoryTools;
FpDbgInfo, FpDbgDwarf, FpdMemoryTools, FpErrorMessages;
type
@ -253,6 +253,7 @@ type
TDbgController = class
private
FLastError: TFpError;
FMemManager: TFpDbgMemManager;
FDefaultContext: TFpDbgLocationContext;
FOnLibraryLoadedEvent: TOnLibraryLoadedEvent;
@ -316,6 +317,7 @@ type
property OsDbgClasses: TOSDbgClasses read FOsDbgClasses;
property MemManager: TFpDbgMemManager read FMemManager;
property DefaultContext: TFpDbgLocationContext read GetDefaultContext; // CurrentThread, TopStackFrame
property LastError: TFpError read FLastError;
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
property AttachToPid: Integer read FAttachToPid write FAttachToPid;
@ -1419,8 +1421,10 @@ end;
function TDbgController.Run: boolean;
var
Flags: TStartInstanceFlags;
Err: TFpError;
begin
result := False;
FLastError := NoError;
if assigned(FMainProcess) then
begin
DebugLn(DBG_WARNINGS, 'The debuggee is already running');
@ -1452,9 +1456,9 @@ begin
if RedirectConsoleOutput then Include(Flags, siRediretOutput);
if ForceNewConsoleWin then Include(Flags, siForceNewConsole);
if AttachToPid <> 0 then
FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager)
FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid, OsDbgClasses, MemManager, FLastError)
else
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager);
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags, OsDbgClasses, MemManager, FLastError);
if assigned(FCurrentProcess) then
begin
FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);

8
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -22,7 +22,8 @@ uses
FpDbgUtil,
UTF8Process,
LazLoggerBase,
FpDbgCommon, FpdMemoryTools;
FpDbgCommon, FpdMemoryTools,
FpErrorMessages;
type
x86_thread_state32_t = record
@ -146,7 +147,7 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateWatchPointData: TFpWatchPointData; override;
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override;
destructor Destroy; override;
@ -643,7 +644,8 @@ end;
class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager;
out AnError: TFpError): TDbgProcess;
var
PID: TPid;
AProcess: TProcessUTF8;

13
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -21,7 +21,8 @@ uses
FpDbgUtil,
UTF8Process,
LazLoggerBase, Maps,
FpDbgCommon, FpdMemoryTools;
FpDbgCommon, FpdMemoryTools,
FpErrorMessages;
type
user_regs_struct64 = record
@ -299,8 +300,8 @@ type
function CreateWatchPointData: TFpWatchPointData; override;
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError
): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager); override;
@ -820,7 +821,8 @@ end;
class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager;
out AnError: TFpError): TDbgProcess;
var
PID: TPid;
AProcess: TProcessUTF8;
@ -887,7 +889,8 @@ begin
end;
class function TDbgLinuxProcess.AttachToInstance(AFileName: string;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager;
out AnError: TFpError): TDbgProcess;
begin
Result := nil;
fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE));

33
components/fpdebug/fpdbgwinclasses.pas
View File

@ -119,7 +119,7 @@ uses
FpDbgLoader, FpDbgDisasX86,
DbgIntfBaseTypes, DbgIntfDebuggerBase,
LazLoggerBase, UTF8Process,
FpDbgCommon, FpdMemoryTools;
FpDbgCommon, FpdMemoryTools, FpErrorMessages;
type
@ -190,8 +190,11 @@ type
procedure Interrupt; // required by app/fpd
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager): TDbgProcess; override;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer;
AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess; override;
class function isSupported(ATargetInfo: TTargetDescriptor): boolean; override;
@ -636,9 +639,10 @@ end;
class function TDbgWinProcess.StartInstance(AFileName: string; AParams,
AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string;
AFlags: TStartInstanceFlags; AnOsClasses: TOSDbgClasses;
AMemManager: TFpDbgMemManager): TDbgProcess;
AMemManager: TFpDbgMemManager; out AnError: TFpError): TDbgProcess;
var
AProcess: TProcessUTF8;
LastErr: Integer;
begin
result := nil;
AProcess := TProcessUTF8.Create(nil);
@ -657,28 +661,37 @@ begin
except
on E: Exception do
begin
LastErr := Integer(GetLastError);
DebugLn(DBG_WARNINGS, 'Failed to start process "%s". Errormessage: "%s %d".',[AFileName, E.Message, LastErr]);
{$ifdef cpui386}
if (E is EProcess) and (GetLastError=50) then
begin
DebugLn(DBG_WARNINGS, 'Failed to start process "%s". Note that on Windows it is not possible to debug a 64-bit application with a 32-bit debugger.'+sLineBreak+'Errormessage: "%s".',[AFileName, E.Message]);
AnError := CreateError(fpErrCreateProcess, [AFileName, LastErr, E.Message, 'Note that on Windows it is not possible to debug a 64-bit application with a 32-bit debugger.'])
end
else
{$endif i386}
DebugLn(DBG_WARNINGS, 'Failed to start process "%s". Errormessage: "%s".',[AFileName, E.Message]);
AnError := CreateError(fpErrCreateProcess, [AFileName, LastErr, E.Message, '']);
AProcess.Free;
end;
end;
end;
class function TDbgWinProcess.AttachToInstance(AFileName: string;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager
): TDbgProcess;
APid: Integer; AnOsClasses: TOSDbgClasses; AMemManager: TFpDbgMemManager; out
AnError: TFpError): TDbgProcess;
var
LastErr: Integer;
begin
Result := nil;
if _DebugActiveProcess = nil then
if _DebugActiveProcess = nil then begin
AnError := CreateError(fpErrAttachProcess, [AFileName, 0, 'API unavailable', '']);
exit;
if not _DebugActiveProcess(APid) then
end;
if not _DebugActiveProcess(APid) then begin
LastErr := Integer(GetLastError);
AnError := CreateError(fpErrAttachProcess, [AFileName, LastErr, GetLastErrorText(LastErr), '']);
exit;
end;
result := TDbgWinProcess.Create(AFileName, APid, 0, AnOsClasses, AMemManager);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info

12
components/fpdebug/fperrormessages.pas
View File

@ -44,6 +44,10 @@ resourcestring
MsgfpErrLocationParserMinStack = 'Not enough elements on stack.'; // internally used
MsgfpErrLocationParserNoAddressOnStack = 'Not an address on stack'; // internally used
// 10000 Process/Control errors
MsgfpErrCreateProcess = 'Failed to start process "%1:s".%0:s Errormessage: %2:d "%3:s". %0:s%4:s';
MsgfpErrAttachProcess = 'Failed to attach to process "%1:s".%0:s Errormessage: %2:d "%3:s". %0:s%4:s';
const
fpErrNoError = TFpErrorCode(0); // not an error
fpErrAnyError = TFpErrorCode(1);
@ -79,6 +83,11 @@ const
fpErrLocationParserInit = TFpErrorCode(202);
fpErrLocationParserMinStack = TFpErrorCode(203);
fpErrLocationParserNoAddressOnStack = TFpErrorCode(204);
// 10000 Process/Control errors
fpErrCreateProcess = TFpErrorCode(10000);
fpErrAttachProcess = TFpErrorCode(10001);
type
TFpError = array of record
@ -219,6 +228,9 @@ begin
fpErrLocationParserInit: Result := MsgfpErrLocationParserInit;
fpErrLocationParserMinStack: Result := MsgfpErrLocationParserMinStack;
fpErrLocationParserNoAddressOnStack: Result := MsgfpErrLocationParserNoAddressOnStack;
fpErrCreateProcess: Result := MsgfpErrCreateProcess;
fpErrAttachProcess: Result := MsgfpErrAttachProcess;
end;
end;

10
components/fpdebug/languages/fperrormessages.pot
View File

@ -10,6 +10,11 @@ msgstr ""
msgid "%1:s"
msgstr ""
#: fperrormessages.msgfperrattachprocess
#, object-pascal-format
msgid "Failed to attach to process \"%1:s\".%0:s Errormessage: %2:d \"%3:s\". %0:s%4:s"
msgstr ""
#: fperrormessages.msgfperrcannotdereferencetype
#, object-pascal-format
msgid "Cannot dereference Expression \"%1:s\""
@ -31,6 +36,11 @@ msgstr ""
msgid "Changing the value of this variable is not supported"
msgstr ""
#: fperrormessages.msgfperrcreateprocess
#, object-pascal-format
msgid "Failed to start process \"%1:s\".%0:s Errormessage: %2:d \"%3:s\". %0:s%4:s"
msgstr ""
#: fperrormessages.msgfperrfailedreadregiseter
msgid "Failed to read data from register"
msgstr ""

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

@ -3937,7 +3937,7 @@ begin
{$ifdef windows}
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
{$endif windows}
//FDbgController.AttachToPid := 0;
FDbgController.AttachToPid := 0;
if ACommand = dcAttach then begin
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
Result := FDbgController.AttachToPid <> 0;
@ -3954,16 +3954,22 @@ begin
Result := WorkItem.StartSuccesfull;
FWorkerThreadId := WorkItem.WorkerThreadId;
WorkItem.DecRef;
if not result then
begin
if not result then begin
// TDebuggerIntf.SetFileName has set the state to dsStop, to make sure
// that dcRun could be requested. Reset the filename so that the state
// is set to dsIdle again and is set to dsStop on the next try
// to run.
FileName := '';
FreeDebugThread;
if not IsError(FDbgController.LastError) then
ResText := 'Error starting process in debugger'
else
ResText := GetFpErrorHandler.ErrorAsString(FDbgController.LastError);
DoDbgEvent(ecProcess, etProcessExit, ResText); // or ecDebugger?
OnFeedback(self, ResText, '', ftError, [frOk]);
Exit;
end;
end;
// TODO: any step commond should run to "main" or "pascalmain"
// Currently disabled in TFpDebugDebugger.GetSupportedCommands
FStartupCommand := ACommand;