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

* fixed environment handling to debuggee

Browse Source 
git-svn-id: trunk@4445 -
This commit is contained in:
marc 2003-08-02 00:20:20 +00:00
parent 9338a6c4f2
commit c4e8a6b79e
3 changed files with 136 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
debugger/cmdlinedebugger.pp
View File

@ -153,6 +153,15 @@ begin
Result := 0;
{$ENDIF}
end;
procedure SetPGid(APID, APGID: Integer);
var
sr: SyscallRegs;
begin
sr.reg2 := APID;
sr.reg3 := APGID;
SysCall(Syscall_nr_setpgid, sr);
end;
//////////////////////////////////////////////////
@ -175,9 +184,9 @@ begin
then begin
FDbgProcess := TProcess.Create(nil);
FDbgProcess.CommandLine := ExternalDebugger + ' ' + AOptions;
FDbgProcess.Options:= [poUsePipes, {poNoConsole,} poStdErrToOutPut];
FDbgProcess.Options:= [poUsePipes, {poNoConsole,} poStdErrToOutPut, poNewProcessGroup];
FDbgProcess.ShowWindow := swoNone;
FDbgProcess.Environment:=Environment;
FDbgProcess.Environment := DebuggerEnvironment;
end;
if not FDbgProcess.Running
then begin
@ -366,9 +375,15 @@ begin
SendCmdLn(ACommand);
end;
initialization
// setpgid(0, 0);
end.
{ =============================================================================
$Log$
Revision 1.18 2003/08/02 00:20:20 marc
* fixed environment handling to debuggee
Revision 1.17 2003/07/24 08:47:37 marc
+ Added SSHGDB debugger

107
debugger/debugger.pp
View File

@ -59,7 +59,8 @@ type
dcWatch,
dcLocal,
dcEvaluate,
dcModify
dcModify,
dcEnvironment
);
TDBGCommands = set of TDBGCommand;
@ -796,6 +797,8 @@ type
private
FArguments: String;
FBreakPoints: TDBGBreakPoints;
FDebuggerEnvironment: TStrings;
FCurEnvironment: TStrings;
FEnvironment: TStrings;
FExceptions: TDBGExceptions;
FExitCode: Integer;
@ -813,9 +816,12 @@ type
FOnDbgOutput: TDBGOutputEvent;
FOnState: TDebuggerStateChangedEvent;
FWorkingDir: String;
procedure DebuggerEnvironmentChanged(Sender: TObject);
procedure EnvironmentChanged(Sender: TObject);
function GetState: TDBGState;
function ReqCmd(const ACommand: TDBGCommand;
const AParams: array of const): Boolean;
procedure SetDebuggerEnvironment (const AValue: TStrings );
procedure SetEnvironment(const AValue: TStrings);
procedure SetFileName(const AValue: String);
protected
@ -857,8 +863,8 @@ type
procedure Stop; // quit debugging
procedure StepOver;
procedure StepInto;
procedure RunTo(const ASource: String; const ALine: Integer); virtual; // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); virtual; // No execute, only set exec point
procedure RunTo(const ASource: String; const ALine: Integer); // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); // No execute, only set exec point
function Evaluate(const AExpression: String; var AResult: String): Boolean; // Evaluates the given expression, returns true if valid
function Modify(const AExpression, AValue: String): Boolean; // Modifies the given expression, returns true if valid
@ -869,10 +875,12 @@ type
property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints
property CallStack: TDBGCallStack read FCallStack;
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property Environment: TStrings read FEnvironment write SetEnvironment;
property DebuggerEnvironment: TStrings read FDebuggerEnvironment
write SetDebuggerEnvironment; // The environment passed to the debugger process
property Environment: TStrings read FEnvironment write SetEnvironment; // The environment passed to the debuggee
property Exceptions: TDBGExceptions read FExceptions; // A list of exceptions we should ignore
property ExitCode: Integer read FExitCode;
property ExternalDebugger: String read FExternalDebugger;
property ExternalDebugger: String read FExternalDebugger; // The name of the debugger executable
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
property Locals: TDBGLocals read FLocals;
property Signals: TDBGSignals read FSignals; // A list of actions for signals we know
@ -902,7 +910,8 @@ const
'Watch',
'Local',
'Evaluate',
'Modify'
'Modify',
'Environment'
);
DBGStateNames: array[TDBGState] of string = (
@ -934,12 +943,12 @@ implementation
const
COMMANDMAP: array[TDBGState] of TDBGCommands = (
{dsNone } [],
{dsIdle } [],
{dsIdle } [dcEnvironment],
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch,
dcEvaluate],
dcEvaluate, dcEnvironment],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak,
dcWatch, dcLocal, dcEvaluate, dcModify],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch],
dcWatch, dcLocal, dcEvaluate, dcModify, dcEnvironment],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
{dsError} [dcStop]
);
@ -1016,6 +1025,8 @@ begin
end;
constructor TDebugger.Create(const AExternalDebugger: String);
var
list: TStringList;
begin
inherited Create;
FOnState := nil;
@ -1026,7 +1037,20 @@ begin
FArguments := '';
FFilename := '';
FExternalDebugger := AExternalDebugger;
FEnvironment := TStringList.Create;
list := TStringList.Create;
list.Sorted := True;
list.Duplicates := dupIgnore;
list.OnChange := @DebuggerEnvironmentChanged;
FDebuggerEnvironment := list;
list := TStringList.Create;
list.Sorted := True;
list.Duplicates := dupIgnore;
list.OnChange := @EnvironmentChanged;
FEnvironment := list;
FCurEnvironment := TStringList.Create;
FBreakPoints := CreateBreakPoints;
FLocals := CreateLocals;
FCallStack := CreateCallStack;
@ -1066,6 +1090,10 @@ begin
Result := TDBGWatches.Create(Self, TDBGWatch);
end;
procedure TDebugger.DebuggerEnvironmentChanged (Sender: TObject );
begin
end;
destructor TDebugger.Destroy;
begin
// don't call events
@ -1086,13 +1114,17 @@ begin
FreeAndNil(FLocals);
FreeAndNil(FCallStack);
FreeAndNil(FWatches);
FreeAndNil(FDebuggerEnvironment);
FreeAndNil(FEnvironment);
FreeAndNil(FCurEnvironment);
FreeAndNil(FSignals);
inherited;
end;
procedure TDebugger.Done;
begin
FEnvironment.Clear;
FCurEnvironment.Clear;
SetState(dsNone);
end;
@ -1124,6 +1156,41 @@ begin
if Assigned(FOnState) then FOnState(Self,OldState);
end;
procedure TDebugger.EnvironmentChanged(Sender: TObject);
var
n, idx: integer;
S: String;
Env: TStringList;
begin
// Createe local copy
Env := TStringList.Create;
try
Env.Assign(Environment);
// Check for nonexisting and unchanged vars
for n := 0 to FCurEnvironment.Count - 1 do
begin
S := FCurEnvironment[n];
idx := Env.IndexOfName(GetPart([], ['='], S, False, False));
if idx = -1
then ReqCmd(dcEnvironment, [S, False])
else begin
if Env[idx] = S
then Env.Delete(idx);
end;
end;
// Set the remaining
for n := 0 to Env.Count - 1 do
begin
ReqCmd(dcEnvironment, [Env[n], True]);
end;
finally
Env.Free;
end;
FCurEnvironment.Assign(FEnvironment);
end;
function TDebugger.Evaluate(const AExpression: String;
var AResult: String): Boolean;
begin
@ -1188,11 +1255,6 @@ begin
else Result := False;
end;
procedure TDebugger.SetEnvironment(const AValue: TStrings);
begin
FEnvironment.Assign(AValue);
end;
procedure TDebugger.Run;
begin
ReqCmd(dcRun, []);
@ -1203,6 +1265,16 @@ begin
ReqCmd(dcRunTo, [ASource, ALine]);
end;
procedure TDebugger.SetDebuggerEnvironment (const AValue: TStrings );
begin
FDebuggerEnvironment.Assign(AValue);
end;
procedure TDebugger.SetEnvironment(const AValue: TStrings);
begin
FEnvironment.Assign(AValue);
end;
procedure TDebugger.SetExitCode(const AValue: Integer);
begin
FExitCode := AValue;
@ -3027,6 +3099,9 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.49 2003/08/02 00:20:20 marc
* fixed environment handling to debuggee
Revision 1.48 2003/07/30 23:15:39 marc
* Added RegisterDebugger

30
debugger/gdbmidebugger.pp
View File

@ -48,7 +48,12 @@ type
SignalText: String; // Signal text if we hit one
end;
TGDBMICmdFlags = set of (cfNoMiCommand, cfIgnoreState, cfIgnoreError, cfExternal);
TGDBMICmdFlags = set of (
cfNoMiCommand, // the command is not a MI command
cfIgnoreState, // ignore the result state of the command
cfIgnoreError, // ignore errors
cfExternal // the command is a result from a user action
);
TGDBMICallback = procedure(var AResultState: TDBGState; var AResultValues: String; const ATag: Integer) of object;
TGDBMIPauseWaitState = (pwsNone, pwsInternal, pwsExternal);
@ -65,6 +70,7 @@ type
FPauseWaitState: TGDBMIPauseWaitState;
FInExecuteCount: Integer;
// Implementation of external functions
function GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
function GDBEvaluate(const AExpression: String; var AResult: String): Boolean;
function GDBRun: Boolean;
function GDBPause(const AInternal: Boolean): Boolean;
@ -565,6 +571,22 @@ begin
Result := nil;
end;
function TGDBMIDebugger.GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
var
S: String;
begin
Result := True;
if State = dsRun
then GDBPause(True);
if ASet
then ExecuteCommand('-gdb-set env %s', [AVariable], [cfIgnoreState, cfExternal])
else begin
S := AVariable;
ExecuteCommand('unset env %s', [GetPart([], ['='], S, False, False)], [cfNoMiCommand, cfIgnoreState, cfExternal]);
end;
end;
function TGDBMIDebugger.GDBEvaluate(const AExpression: String;
var AResult: String): Boolean;
var
@ -789,7 +811,7 @@ end;
function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto,
dcBreak{, dcWatch}, dcLocal, dcEvaluate, dcModify]
dcBreak{, dcWatch}, dcLocal, dcEvaluate, dcModify, dcEnvironment]
end;
procedure TGDBMIDebugger.Init;
@ -1256,6 +1278,7 @@ begin
dcRunTo: Result := GDBRunTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcJumpto: Result := GDBJumpTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
dcEvaluate: Result := GDBEvaluate(String(APArams[0].VAnsiString), String(APArams[1].VPointer^));
dcEnvironment: Result := GDBEnvironment(String(APArams[0].VAnsiString), AParams[1].VBoolean);
end;
end;
@ -2025,6 +2048,9 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.35 2003/08/02 00:20:20 marc
* fixed environment handling to debuggee
Revision 1.34 2003/07/30 23:15:39 marc
* Added RegisterDebugger