DBG: Small optimizations for array watches (test)

git-svn-id: trunk@39464 -

debugger/test/Gdbmi/TestApps/WatchesPrgStruct.inc

@@ -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;

debugger/test/Gdbmi/testgdbtype.pas

@@ -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;

debugger/test/Gdbmi/testwatches.pas

@@ -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 * }