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

DBG: Omit check for local files, when using GDB over ssh. Issue #0021834

Browse Source 
REQUIRES r 37097 to fix compilation

git-svn-id: trunk@37091 -
This commit is contained in:
martin 2012-04-29 18:39:54 +00:00
parent 815fe6af00
commit 537e40a7d9
5 changed files with 90 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
debugger/debugger.pp
View File

@ -2813,6 +2813,14 @@ type
class function GetProperties: TDebuggerProperties; // Get the current properties
class procedure SetProperties(const AProperties: TDebuggerProperties); // Set the current properties
(* TODO:
This method is a workaround for http://bugs.freepascal.org/view.php?id=21834
See main.pp 12188 function TMainIDE.DoInitProjectRun: TModalResult;
See debugmanager function TDebugManager.InitDebugger: Boolean;
Checks could be performed in SetFileName, invalidating debuggerstate
Errors should also be reported by debugger
*)
class function RequiresLocalExecutable: Boolean; virtual;
public
constructor Create(const AExternalDebugger: String); virtual;
destructor Destroy; override;
@ -6421,6 +6429,11 @@ begin
Props.Assign(AProperties);
end;
class function TDebugger.RequiresLocalExecutable: Boolean;
begin
Result := True;
end;
procedure TDebugger.SetState(const AValue: TDBGState);
var
OldState: TDBGState;

10
debugger/sshgdbmidebugger.pas
View File

@ -41,6 +41,9 @@ uses
BaseDebugManager, Debugger, PropEdits, Graphics, LCLProc, LazarusIDEStrConsts;
type
{ TSSHGDBMIDebugger }
TSSHGDBMIDebugger = class(TGDBMIDebugger)
private
protected
@ -49,6 +52,8 @@ type
class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
class function Caption: String; override;
class function ExePaths: String; override;
(* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
class function RequiresLocalExecutable: Boolean; override;
end;
TSSHGDBMIDebuggerProperties = class(TGDBMIDebuggerProperties)
@ -138,6 +143,11 @@ begin
Result := '/usr/bin/ssh user@remote /usr/bin/gdb';
end;
class function TSSHGDBMIDebugger.RequiresLocalExecutable: Boolean;
begin
Result := False;
end;
function TSSHGDBMIDebugger.ParseInitialization: Boolean;
function CheckReadLine(var ALine: String): Boolean;

3
ide/basedebugmanager.pas
View File

@ -124,6 +124,7 @@ type
{$IFDEF DBG_WITH_DEBUGGER_DEBUG}
function GetDebugger: TDebugger; virtual; abstract;
{$ENDIF}
function GetCurrentDebuggerClass: TDebuggerClass; virtual; abstract; (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
public
procedure Reset; virtual; abstract;
@ -219,6 +220,8 @@ type
property Watches: TWatchesMonitor read FWatches;
property Threads: TThreadsMonitor read FThreads;
property Snapshots: TSnapshotManager read FSnapshots;
(* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
property DebuggerClass: TDebuggerClass read GetCurrentDebuggerClass;
{$IFDEF DBG_WITH_DEBUGGER_DEBUG}
property Debugger: TDebugger read GetDebugger;
{$ENDIF}

106
ide/debugmanager.pas
View File

@ -156,6 +156,7 @@ type
{$IFDEF DBG_WITH_DEBUGGER_DEBUG}
function GetDebugger: TDebugger; override;
{$ENDIF}
function GetCurrentDebuggerClass: TDebuggerClass; override; (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -2003,7 +2004,7 @@ function TDebugManager.InitDebugger: Boolean;
var
LaunchingCmdLine, LaunchingApplication, LaunchingParams: String;
NewWorkingDir: String;
DebuggerClass: TDebuggerClass;
NewDebuggerClass: TDebuggerClass;
begin
{$ifdef VerboseDebugger}
DebugLn('[TDebugManager.DoInitDebugger] A');
@ -2019,55 +2020,62 @@ begin
FUnitInfoProvider.Clear;
FIsInitializingDebugger:= True;
try
DebuggerClass := GetDebuggerClass;
NewDebuggerClass := GetDebuggerClass;
LaunchingCmdLine := BuildBoss.GetRunCommandLine;
SplitCmdLine(LaunchingCmdLine, LaunchingApplication, LaunchingParams);
if BuildBoss.GetProjectUsesAppBundle then
begin
// it is Application Bundle (darwin only)
(* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834
Se Debugger.RequiresLocalExecutable
*)
if NewDebuggerClass.RequiresLocalExecutable then begin
if not DirectoryExistsUTF8(LaunchingApplication) then
if BuildBoss.GetProjectUsesAppBundle then
begin
if MessageDlg(lisLaunchingApplicationInvalid,
Format(lisTheLaunchingApplicationBundleDoesNotExists,
[LaunchingCmdLine, #13, #13, #13, #13]),
mtError, [mbYes, mbNo, mbCancel], 0) = mrYes then
begin
if not BuildBoss.CreateProjectApplicationBundle then Exit;
end
else
Exit;
end;
// it is Application Bundle (darwin only)
if DebuggerClass = TProcessDebugger then
begin // use executable path inside Application Bundle (darwin only)
LaunchingApplication := LaunchingApplication + '/Contents/MacOS/' +
ExtractFileNameOnly(LaunchingApplication);
LaunchingParams := LaunchingParams;
end;
end
else
if not FileIsExecutable(LaunchingApplication)
if not DirectoryExistsUTF8(LaunchingApplication) then
begin
if MessageDlg(lisLaunchingApplicationInvalid,
Format(lisTheLaunchingApplicationBundleDoesNotExists,
[LaunchingCmdLine, #13, #13, #13, #13]),
mtError, [mbYes, mbNo, mbCancel], 0) = mrYes then
begin
if not BuildBoss.CreateProjectApplicationBundle then Exit;
end
else
Exit;
end;
if NewDebuggerClass = TProcessDebugger then
begin // use executable path inside Application Bundle (darwin only)
LaunchingApplication := LaunchingApplication + '/Contents/MacOS/' +
ExtractFileNameOnly(LaunchingApplication);
LaunchingParams := LaunchingParams;
end;
end
else
if not FileIsExecutable(LaunchingApplication)
then begin
MessageDlg(lisLaunchingApplicationInvalid,
Format(lisTheLaunchingApplicationDoesNotExistsOrIsNotExecuta, ['"',
LaunchingCmdLine, '"', #13, #13, #13]),
mtError, [mbOK],0);
Exit;
end;
//todo: this check depends on the debugger class
if (NewDebuggerClass <> TProcessDebugger)
and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename)
then begin
MessageDlg(lisLaunchingApplicationInvalid,
Format(lisTheLaunchingApplicationDoesNotExistsOrIsNotExecuta, ['"',
LaunchingCmdLine, '"', #13, #13, #13]),
mtError, [mbOK],0);
MessageDlg(lisDebuggerInvalid,
Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro, ['"',
EnvironmentOptions.DebuggerFilename, '"', #13, #13, #13]),
mtError,[mbOK],0);
Exit;
end;
//todo: this check depends on the debugger class
if (DebuggerClass <> TProcessDebugger)
and not FileIsExecutable(EnvironmentOptions.GetParsedDebuggerFilename)
then begin
MessageDlg(lisDebuggerInvalid,
Format(lisTheDebuggerDoesNotExistsOrIsNotExecutableSeeEnviro, ['"',
EnvironmentOptions.DebuggerFilename, '"', #13, #13, #13]),
mtError,[mbOK],0);
Exit;
end;
end; // if NewDebuggerClass.RequiresLocalExecutable then
if (dmsDebuggerObjectBroken in FManagerStates)
then begin
@ -2077,7 +2085,7 @@ begin
// check if debugger is already created with the right type
if (FDebugger <> nil)
and (not (FDebugger is DebuggerClass)
and (not (FDebugger is NewDebuggerClass)
or (FDebugger.ExternalDebugger <> EnvironmentOptions.GetParsedDebuggerFilename)
)
then begin
@ -2088,7 +2096,7 @@ begin
// create debugger object
if FDebugger = nil
then SetDebugger(DebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename));
then SetDebugger(NewDebuggerClass.Create(EnvironmentOptions.GetParsedDebuggerFilename));
if FDebugger = nil
then begin
@ -2096,7 +2104,7 @@ begin
Exit;
end;
EnvironmentOptions.LoadDebuggerProperties(DebuggerClass.ClassName, FDebugger.GetProperties);
EnvironmentOptions.LoadDebuggerProperties(NewDebuggerClass.ClassName, FDebugger.GetProperties);
ClearDebugOutputLog;
if EnvironmentOptions.DebuggerEventLogClearOnRun then
@ -2131,7 +2139,9 @@ begin
Project1.RunParameterOptions.AssignEnvironmentTo(FDebugger.Environment);
NewWorkingDir:=Project1.RunParameterOptions.WorkingDirectory;
GlobalMacroList.SubstituteStr(NewWorkingDir);
if (NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir)) then begin
if NewDebuggerClass.RequiresLocalExecutable and (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
(NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir))
then begin
MessageDlg(lisUnableToRun,
Format(lisTheWorkingDirectoryDoesNotExistPleaseCheckTheWorki, ['"',
NewWorkingDir, '"', #13]),
@ -2140,7 +2150,9 @@ begin
end;
if NewWorkingDir='' then begin
NewWorkingDir:=ExtractFilePath(BuildBoss.GetProjectTargetFilename(Project1));
if (NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir)) then begin
if NewDebuggerClass.RequiresLocalExecutable and (* TODO: workaround for http://bugs.freepascal.org/view.php?id=21834 *)
(NewWorkingDir<>'') and (not DirectoryExistsUTF8(NewWorkingDir))
then begin
MessageDlg(lisUnableToRun,
Format(lisTheDestinationDirectoryDoesNotExistPleaseCheckTheP, ['"',
NewWorkingDir, '"', #13]),
@ -2647,6 +2659,12 @@ function TDebugManager.GetDebugger: TDebugger;
begin
Result := FDebugger;
end;
function TDebugManager.GetCurrentDebuggerClass: TDebuggerClass;
begin
Result := GetDebuggerClass;
end;
{$ENDIF}
function TDebugManager.ShowBreakPointProperties(const ABreakpoint: TIDEBreakPoint): TModalresult;

3
ide/main.pp
View File

@ -12185,7 +12185,8 @@ begin
// Check project build
ProgramFilename := MainBuildBoss.GetProjectTargetFilename(Project1);
DebugLn(['TMainIDE.DoInitProjectRun ProgramFilename=',ProgramFilename]);
if not FileExistsUTF8(ProgramFilename)
if ((DebugBoss.DebuggerClass = nil) or DebugBoss.DebuggerClass.RequiresLocalExecutable)
and not FileExistsUTF8(ProgramFilename)
then begin
IDEMessageDialog(lisFileNotFound,
Format(lisNoProgramFileSFound, ['"', ProgramFilename, '"']),