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

DBG: Small optimizations for array watches (test)

Browse Source 
git-svn-id: trunk@39464 -
This commit is contained in:
martin 2012-12-06 16:48:53 +00:00
parent b4c7cffa66
commit 97c63bee5e
3 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -308,7 +308,7 @@
{$IFDEF Global_Type}
//type
TClassTCast = class public b: Integer; end;
TClassTCastObject = class(TObject) public b: Integer; end;
TClassTCastObject = class(TObject) public b: Integer; l: Array of Integer; end;
TClassTCastComponent = class(TComponent) public b: Integer; end;
{$IFDEF USE_W1}
@ -359,6 +359,8 @@
// Declared TObject
VarOTestTCast := TClassTCast.Create;
VarOTestTCastObj := TClassTCastObject.Create;
SetLength(TClassTCastObject(VarOTestTCastObj).l, 3);
TClassTCastObject(VarOTestTCastObj).l[1] := 1144;
VarOTestTCastComp := TClassTCastComponent.Create(nil);
VarOTestTCast2 := TClassTCast.Create;
VarNOTestTCast := nil;

12
debugger/test/Gdbmi/testgdbtype.pas
View File

@ -606,14 +606,16 @@ end;
procedure TTestGdbType.TestExpressionBreaker;
procedure InitExpr(e: String; var b: TGDBExpression; out r: PGDBPTypeRequest; out v: Boolean);
procedure InitExpr(e: String; var b: TGDBExpression; out r: PGDBPTypeRequest; out v: Boolean; rewritten: string = '');
begin
FreeAndNil(b);
r := nil;
b := TGDBExpression.Create(e);
debugln('##### '+e);
DumpGExp(b);
AssertEquals(e+' as text', e, b.Text);
if rewritten <> ''
then AssertEquals(e+' as text', rewritten, b.Text)
else AssertEquals(e+' as text', e, b.Text);
v := b.NeedValidation(r);
if r <> nil then DumpReq(r);
debugln;
@ -799,13 +801,13 @@ begin
InitExpr(n, b, r, v);
n := 'abc[1,2,3].x[1]';
InitExpr(n, b, r, v);
InitExpr(n, b, r, v, 'abc[1][2][3].x[1]');
n := 'abc[1,2,3].x and abc[1,2][3].y';
InitExpr(n, b, r, v);
InitExpr(n, b, r, v, 'abc[1][2][3].x and abc[1][2][3].y');
n := '1+abc[1,2,3].x and b . cc [ 1 , 2 or x ]';
InitExpr(n, b, r, v);
InitExpr(n, b, r, v, '1+abc[1][2][3].x and b . cc [ 1 ][ 2 or x ]');
b.Free;

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

@ -726,7 +726,6 @@ begin
{%region * Classes * }
AddFmtDef('ArgTFoo', Match_ArgTFoo, skClass, 'TFoo', []);
AddFmtDef('TFoo(ArgTFoo)',Match_ArgTFoo, skClass, 'TFoo', []);
AddFmtDef('@ArgTFoo', '(P|\^T)Foo\('+Match_Pointer, skPointer, '(P|\^T)Foo', [fTpMtch]);
// Only with brackets...
AddFmtDef('(@ArgTFoo)^', Match_ArgTFoo, skClass, 'TFoo', []);
@ -742,7 +741,6 @@ begin
AddFmtDef('VArgTFoo', Match_ArgTFoo, skClass, 'TFoo', []);
AddFmtDef('TFoo(VArgTFoo)',Match_ArgTFoo, skClass, 'TFoo', []);
AddFmtDef('@VArgTFoo', '(P|\^T)Foo\('+Match_Pointer, skPointer, '(P|\^T)Foo', [fTpMtch]);
AddFmtDef('(@VArgTFoo)^', Match_ArgTFoo, skClass, 'TFoo', []);
@ -776,6 +774,16 @@ begin
Add('ArgTFoo', wdfPointer, Match_Pointer, skClass, 'TFoo', []);
Add('ArgTFoo', wdfMemDump, ':.*?6D 65 6D 20 6F 66 20 54 46 6F 6F', skClass, 'TFoo', []);
{%region * Classes * typecasts }
// typecast does not change class
AddFmtDef('TFoo(ArgTFoo)',Match_ArgTFoo, skClass, 'TFoo', []);
AddFmtDef('TFoo(VArgTFoo)',Match_ArgTFoo, skClass, 'TFoo', []);
// typecast does change class
AddFmtDef('TObject(ArgTFoo)', '<TObject> = \{.*(<|vptr\$)', skClass, 'TObject', []);
AddFmtDef('TObject(VArgTFoo)', '<TObject> = \{.*(<|vptr\$)', skClass, 'TObject', []);
{%endregion * Classes * typecasts}
(*
AddFmtDef('ArgTSamePFoo', '', sk, 'TSamePFoo', []);
@ -827,7 +835,7 @@ begin
//AddFmtDef('not(ArgTFoo=nil)', 'True', skSimple, 'bool', []);
//AddFmtDef('ArgTFoo<>nil', 'True', skSimple, 'bool', []);
{ casting }
{%region * Classes * typecasts }
{ gdb below 6.7.50 with stabs may fail }
r := AddFmtDef('VarOTestTCast2', [defFullTypeInfo],
MatchClass('TObject'), skClass, 'TObject', []);
@ -878,6 +886,12 @@ begin
//if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then
UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
// access dyn array in casted object
{%endregion * Classes * typecasts}
r := AddFmtDef('TClassTCastObject(VarOTestTCastObj).l[1]', [], '1144', skSimple, 'Integer|LongInt', [fTpMtch]);
// if (DebuggerInfo.Version > 0) and (DebuggerInfo.Version < 060750) then UpdRes(r, stStabs, '.', skClass, '.', [fTpMtch]);
{%endregion * Classes * }