paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 15:10:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Debugger: fixed line-end search, issue #16155

Browse Source 
git-svn-id: trunk@24479 -
This commit is contained in:
marc 2010-04-06 22:28:18 +00:00
parent 906b3f9819
commit 02601577f5
1 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
debugger/cmdlinedebugger.pp
View File

@ -39,7 +39,7 @@ unit CmdLineDebugger;
interface interface
uses uses
Classes, Process, FileUtil, Debugger, LCLProc, Forms, LazConf, DebugUtils; Classes, Types, Process, FileUtil, Debugger, LCLProc, Forms, LazConf, DebugUtils;
type type
@ -48,7 +48,7 @@ type
TCmdLineDebugger = class(TDebugger) TCmdLineDebugger = class(TDebugger)
private private
FDbgProcess: TProcess; // The process used to call the debugger FDbgProcess: TProcess; // The process used to call the debugger
FLineEnds: TStringList; // List of strings considered as lineends FLineEnds: TStringDynArray; // List of strings considered as lineends
FOutputBuf: String; FOutputBuf: String;
FReading: Boolean; // Set if we are in the ReadLine loop FReading: Boolean; // Set if we are in the ReadLine loop
FFlushAfterRead: Boolean;// Set if we should flush after finished reading FFlushAfterRead: Boolean;// Set if we should flush after finished reading
@ -62,6 +62,7 @@ type
function ReadLine(const APeek: Boolean): String; overload; function ReadLine(const APeek: Boolean): String; overload;
procedure SendCmdLn(const ACommand: String); overload; procedure SendCmdLn(const ACommand: String); overload;
procedure SendCmdLn(const ACommand: String; Values: array of const); overload; procedure SendCmdLn(const ACommand: String; Values: array of const); overload;
procedure SetLineEnds(ALineEnds: TStringDynArray);
public public
constructor Create(const AExternalDebugger: String); override; constructor Create(const AExternalDebugger: String); override;
destructor Destroy; override; destructor Destroy; override;
@ -69,7 +70,6 @@ type
public public
property DebugProcess: TProcess read FDbgProcess; property DebugProcess: TProcess read FDbgProcess;
property DebugProcessRunning: Boolean read GetDebugProcessRunning; property DebugProcessRunning: Boolean read GetDebugProcessRunning;
property LineEnds: TStringList read FLineEnds;
end; end;
@ -211,8 +211,8 @@ end;
constructor TCmdLineDebugger.Create(const AExternalDebugger: String); constructor TCmdLineDebugger.Create(const AExternalDebugger: String);
begin begin
FDbgProcess := nil; FDbgProcess := nil;
FLineEnds := TStringList.Create; SetLength(FLineEnds, 1);
FLineEnds.Add(LineEnding); FLineEnds[0] := LineEnding;
FReading := False; FReading := False;
FFlushAfterRead := False; FFlushAfterRead := False;
FPeekOffset := 0; FPeekOffset := 0;
@ -251,7 +251,6 @@ begin
except except
on E: Exception do DebugLn('Exeption while freeing debugger: ', E.Message); on E: Exception do DebugLn('Exeption while freeing debugger: ', E.Message);
end; end;
FreeAndNil(FLineEnds);
end; end;
procedure TCmdLineDebugger.Flush; procedure TCmdLineDebugger.Flush;
@ -308,12 +307,14 @@ begin
if FOutputBuf <> '' if FOutputBuf <> ''
then begin then begin
MinIdx := MaxInt; MinIdx := MaxInt;
for n := 0 to FLineEnds.Count - 1 do for n := Low(FLineEnds) to High(FLineEnds) do
begin begin
LineEndMatch := FLineEnds[n]; idx := Pos(FLineEnds[n], FOutputBuf);
Idx := Pos(LineEndMatch, FOutputBuf);
if (idx > 0) and (idx < MinIdx) if (idx > 0) and (idx < MinIdx)
then MinIdx := idx; then begin
MinIdx := idx;
LineEndMatch := FLineEnds[n];
end;
end; end;
if MinIdx < MaxInt if MinIdx < MaxInt
@ -398,6 +399,16 @@ begin
SendCmdLn(Format(ACommand, Values)); SendCmdLn(Format(ACommand, Values));
end; end;
procedure TCmdLineDebugger.SetLineEnds(ALineEnds: TStringDynArray);
begin
if Length(ALineEnds) = 0
then begin
SetLength(FLineEnds, 1);
FLineEnds[0] := LineEnding;
end
else FLineEnds := ALineEnds;
end;
procedure TCmdLineDebugger.TestCmd(const ACommand: String); procedure TCmdLineDebugger.TestCmd(const ACommand: String);
begin begin
SendCmdLn(ACommand); SendCmdLn(ACommand);