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

DBG deal with spaces in watches

Browse Source 
git-svn-id: trunk@36193 -
This commit is contained in:
martin 2012-03-21 19:13:34 +00:00
parent 05d5494484
commit 7a72cee2cf
7 changed files with 120 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
debugger/debugutils.pp
View File

@ -71,6 +71,7 @@ function ConvertPathDelims(const AFileName: String): String;
function DeleteEscapeChars(const AValue: String; const AEscapeChar: Char = '\'): String;
function UnEscapeBackslashed(const AValue: String; AFlags: TGdbUnEscapeFlags = [uefOctal]; ATabWidth: Integer = 0): String;
function UnQuote(const AValue: String): String;
function Quote(const AValue: String; AForce: Boolean=False): String;
function ConvertGdbPathAndFile(const AValue: String): String; // fix path, delim, unescape, and to utf8
function ParseGDBString(const AValue: String): String; // remove quotes(') and convert #dd chars: #9'ab'#9'x'
@ -298,6 +299,13 @@ begin
else Result := AValue;
end;
function Quote(const AValue: String; AForce: Boolean): String;
begin
if (pos(' ', AValue) < 1) and (pos(#9, AValue) < 1) and (not AForce) then
exit(AValue);
Result := '"' + StringReplace(AValue, '"', '\"', [rfReplaceAll]) + '"';
end;
function ConvertGdbPathAndFile(const AValue: String): String;
begin
Result := AnsiToUtf8(ConvertPathDelims(UnEscapeBackslashed(AValue, [uefOctal])));

6
debugger/gdbmidebugger.pp
View File

@ -7673,7 +7673,7 @@ begin
Result := Result and (R.State <> dsError);
if not Result then exit;
WatchDecl := PCLenToString(ParseTypeFromGdb(R.Values).Name);
Result := ExecuteCommand('-data-evaluate-expression @%s', [WatchExpr], R);
Result := ExecuteCommand('-data-evaluate-expression %s', [Quote('@'+WatchExpr)], R);
Result := Result and (R.State <> dsError);
if not Result then exit;
WatchAddr := StripLN(GetPart('value="', '"', R.Values));
@ -9332,7 +9332,7 @@ begin
Exit(True);
end;
Result := ADebuggerCommand.ExecuteCommand('-data-evaluate-expression %s', [AText], R)
Result := ADebuggerCommand.ExecuteCommand('-data-evaluate-expression %s', [Quote(AText)], R)
and (R.State <> dsError);
ResultList := TGDBMINameValueList.Create(R);
@ -12116,7 +12116,7 @@ var
case FDisplayFormat of
wdfStructure:
begin
Result := ExecuteCommand('-data-evaluate-expression %s', [AnExpression], R);
Result := ExecuteCommand('-data-evaluate-expression %s', [Quote(AnExpression)], R);
Result := Result and (R.State <> dsError);
if (not Result) then begin
ParseLastError;

16
debugger/gdbtypeinfo.pp
View File

@ -982,7 +982,7 @@ end;
procedure TGDBExpressionPartArrayIdx.InitIndexReq(var AReqPtr: PGDBPTypeRequest);
begin
FPTypeIndexReq.Request := '-data-evaluate-expression ' + GetPlainText;
FPTypeIndexReq.Request := '-data-evaluate-expression ' + Quote(GetPlainText);
FPTypeIndexReq.Error := '';
FPTypeIndexReq.ReqType := gcrtEvalExpr;
FPTypeIndexReq.Next := AReqPtr;
@ -1824,15 +1824,15 @@ function TGDBType.RequireRequests(ARequired: TGDBTypeProcessRequests; ACustomDat
gptrPTypeOfWhatis: Result := 'ptype ' + PCLenToString(FReqResults[gptrWhatisExpr].Result.BaseName);
gptrPTypeExprDeRef: Result := 'ptype ' + ApplyBrackets(FExpression) + '^';
gptrPTypeExprDeDeRef: Result := 'ptype ' + ApplyBrackets(FExpression) + '^^';
gptrEvalExpr: Result := '-data-evaluate-expression '+FExpression;
gptrEvalExprDeRef: Result := '-data-evaluate-expression '+FExpression+'^';
gptrEvalExprCast: Result := '-data-evaluate-expression '+InternalTypeName+'('+FExpression+')';
gptrEvalExpr2: Result := '-data-evaluate-expression '+ACustomData;
gptrEvalExprDeRef2: Result := '-data-evaluate-expression '+ACustomData+'^';
gptrEvalExprCast2: Result := '-data-evaluate-expression '+InternalTypeName+'('+ACustomData+')';
gptrEvalExpr: Result := '-data-evaluate-expression '+Quote(FExpression);
gptrEvalExprDeRef: Result := '-data-evaluate-expression '+Quote(FExpression+'^');
gptrEvalExprCast: Result := '-data-evaluate-expression '+Quote(InternalTypeName+'('+FExpression+')');
gptrEvalExpr2: Result := '-data-evaluate-expression '+Quote(ACustomData);
gptrEvalExprDeRef2: Result := '-data-evaluate-expression '+Quote(ACustomData+'^');
gptrEvalExprCast2: Result := '-data-evaluate-expression '+Quote(InternalTypeName+'('+ACustomData+')');
gptrPtypeCustomFixCast, gptrPtypeCustomAutoCast, gptrPtypeCustomAutoCast2:
Result := 'ptype ' + ACustomData;
gptrInstanceClassName: Result := '-data-evaluate-expression (^^^char('+FExpression+')^+3)^';
gptrInstanceClassName: Result := '-data-evaluate-expression '+Quote('(^^^char('+FExpression+')^+3)^');
end;
end;

59
debugger/test/Gdbmi/TestApps/WatchesPrgStruct.inc
View File

@ -305,7 +305,6 @@
{* ******************** CLASSES ******************** *}
{%region CLASSES TypeCast }
{%region TYPE}
{$IFDEF Global_Type}
//type
TClassTCast = class public b: Integer; end;
@ -701,3 +700,61 @@
{$ENDIF}
{%endregion GLOBAL}
{%region CLASSES Auto-TypeCast }
{$IFDEF Global_Type}
//type
TAutoCastClassBase = class
public
b: Integer;
end;
TAutoCastClass = class(TAutoCastClassBase)
public
C: Integer;
N1: TAutoCastClass;
N2, VarAutoCastClassBase1: TAutoCastClassBase;
end;
{$ENDIF}
{$IFDEF FooFunc_LocalVar}
// VarO..., VarNO... : TObject; // cast to real class
VarAutoCastClassBase1: TAutoCastClassBase;
VarAutoCastClassBaseArr: Array [1..4] of TAutoCastClassBase;
{$ENDIF}
{$IFDEF FooFunc_Body}
VarAutoCastClassBase1 := TAutoCastClass.Create;
TAutoCastClass(VarAutoCastClassBase1).b := 2;
TAutoCastClass(VarAutoCastClassBase1).C := 3;
TAutoCastClass(VarAutoCastClassBase1).N1 := TAutoCastClass.Create;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).N1).b := 105;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).N1).c := 1;
TAutoCastClass(VarAutoCastClassBase1).N2 := TAutoCastClass.Create;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).N2).b := 101;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).N2).c := 1;
TAutoCastClass(VarAutoCastClassBase1).VarAutoCastClassBase1 := TAutoCastClass.Create;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).VarAutoCastClassBase1).b := 104;
TAutoCastClass(TAutoCastClass(VarAutoCastClassBase1).VarAutoCastClassBase1).c := 4;
VarAutoCastClassBaseArr[1] := TAutoCastClass.Create;
TAutoCastClass(VarAutoCastClassBaseArr[1]).b := 11;
TAutoCastClass(VarAutoCastClassBaseArr[1]).c := 111;
VarAutoCastClassBaseArr[2] := TAutoCastClass.Create;
TAutoCastClass(VarAutoCastClassBaseArr[1]).b := 12;
TAutoCastClass(VarAutoCastClassBaseArr[1]).c := 112;
VarAutoCastClassBaseArr[3] := TAutoCastClass.Create;
TAutoCastClass(VarAutoCastClassBaseArr[1]).b := 13;
TAutoCastClass(VarAutoCastClassBaseArr[1]).c := 113;
VarAutoCastClassBaseArr[4] := TAutoCastClass.Create;
TAutoCastClass(VarAutoCastClassBaseArr[1]).b := 14;
TAutoCastClass(VarAutoCastClassBaseArr[1]).c := 114;
{$ENDIF}
{%endregion CLASSES Auto-TypeCast}

19
debugger/test/Gdbmi/testbase.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, fpcunit, testutils, testregistry,
EnvironmentOpts, LCLProc, CompileHelpers, Dialogs, ExtToolDialog,
EnvironmentOpts, LCLProc, LazLogger, CompileHelpers, Dialogs, ExtToolDialog,
Debugger, GDBMIDebugger;
(*
@ -224,6 +224,8 @@ type
function GetCompilerInfo: TCompilerInfo;
function GetDebuggerInfo: TDebuggerInfo;
function GetSymbolType: TSymbolType;
procedure DoDbgOut(Sender: TObject; S: string; var Handled: Boolean);
procedure DoDebugln(Sender: TObject; S: string; var Handled: Boolean);
protected
function CreateResult: TTestResult; override;
function GetLogActive: Boolean;
@ -383,6 +385,16 @@ begin
Result := TGDBMIDebugger;
end;
procedure TGDBTestCase.DoDbgOut(Sender: TObject; S: string; var Handled: Boolean);
begin
LogToFile('# '+S);
end;
procedure TGDBTestCase.DoDebugln(Sender: TObject; S: string; var Handled: Boolean);
begin
LogToFile('# '+S);
end;
function TGDBTestCase.GetCompilerInfo: TCompilerInfo;
begin
Result := Parent.CompilerInfo;
@ -437,6 +449,9 @@ begin
AssignFile(FLogFile, FLogFileName);
Rewrite(FLogFile);
FLogFileCreated := True;
DebugLogger.OnDbgOut := @DoDbgOut;
DebugLogger.OnDebugLn := @DoDebugln;
//end;
end;
@ -453,6 +468,8 @@ end;
procedure TGDBTestCase.TearDown;
begin
inherited TearDown;
DebugLogger.OnDbgOut := nil;
DebugLogger.OnDebugLn := nil;
if FLogFileCreated then begin
CloseFile(FLogFile);

14
debugger/test/Gdbmi/testbreakpoint.pas
View File

@ -60,6 +60,7 @@ var
dbg: TGDBMIDebugger;
TestExeName, s: string;
i: TGDBMIDebuggerStartBreak;
IgnoreRes: String;
begin
if SkipTest then exit;
if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestBreakPoint')] then exit;
@ -82,8 +83,16 @@ begin
end;
dbg.Run;
TestTrue(s+' not in error state 1', dbg.State <> dsError);
TestTrue(s+' at break', FCurLine = BREAK_LINE_FOOFUNC);
IgnoreRes := '';
case DebuggerInfo.Version of
070400..070499: if i = gdsbAddZero then IgnoreRes:= 'gdb 7.4.x does not work with gdsbAddZero';
end;
TestTrue(s+' not in error state 1', dbg.State <> dsError, 0, IgnoreRes);
TestTrue(s+' at break', FCurLine = BREAK_LINE_FOOFUNC, 0, IgnoreRes);
TGDBMIDebuggerProperties(dbg.GetProperties).InternalStartBreak := gdsbDefault;
finally
dbg.Done;
CleanGdb;
@ -397,6 +406,7 @@ begin
// 7.1.x seems to always pass
// 7.2.x seems to always pass
070300..070399: IgnoreRes:= 'gdb 7.3.x may or may not fail';
070400..070499: IgnoreRes:= 'gdb 7.4.x may or may not fail';
end;
TestEquals('Passed none-pause run', '', Err, 0, IgnoreRes);

13
debugger/test/Gdbmi/testwatches.pas
View File

@ -1121,6 +1121,12 @@ begin
AddFmtDef('ArgPInt64', '', sk, 'PInt64', []);
AddFmtDef('VArgPInt64', '', sk, 'PInt64', []);
*)
// spaces
AddFmtDef('ArgWord + 1', '^27$', skSimple, 'Word|long', [fTpMtch]);
AddFmtDef('ArgWord or 64', '^90$', skSimple, 'Word|long', [fTpMtch]);
AddFmtDef('ArgWord and 67', '^2$', skSimple, 'Word|long', [fTpMtch]);
{%endregion * Simple * }
{%region * Enum/Set * }
@ -1301,6 +1307,13 @@ begin
//TDynDynArrayPRec2 = array of array of ^TRecForArray2;
//TDynStatArrayTRec2 = array of array [3..5] of TRecForArray2;
//TDynStatArrayPRec2 = array of array [3..5] of ^TRecForArray2;
(* Array in expression*)
//Add(v+'ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int, [fTpMtch] );
//Add(v+'ArgTDynArrayTRec1[0].a+'+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int, [fTpMtch] );
//Add('ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int, [fTpMtch] );
//Add(v+'ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int, [fTpMtch] );
{%endregion DYN ARRAY (norm)}
{%region DYN ARRAY (VAR)}