IDE, FpDebug: evaluate more sub-items for Inspect Dialog.

components/fpdebug/fpwatchresultdata.pas

@@ -11,16 +11,25 @@ uses
 
 type
 
+  TDbgPtrList = specialize TFPGList<TDBGPtr>;
+
   { TFpWatchResultConvertor }
 
   TFpWatchResultConvertor = class
   private const
-    MAX_RECURSE_LVL = 32;
+    MAX_RECURSE_LVL = 10;
-    NEST_PTR_RECURSE_LVL = 6; // must be less-or-equal than MAX_RECURSE_LVL
+    MAX_RECURSE_LVL_ARRAY = 5;
+    MAX_RECURSE_LVL_PTR = 8; // max depth for a chain of pointers starting at the initial value
   private
     FContext: TFpDbgLocationContext;
-    FRecurseCnt, FRecurseInstanceCnt: integer;
+    FExtraDepth: Boolean;
-    FOuterArrayIdx: integer;
+    FRecurseCnt, FRecurseCntLow,
+    FRecursePointerCnt,
+    FRecurseInstanceCnt, FRecurseDynArray: integer;
+    FRecurseAddrList: TDbgPtrList;
+    FLastValueKind: TDbgSymbolKind;
+    FHasEmbeddedPointer: Boolean;
+    FOuterArrayIdx, FTotalArrayCnt: integer;
     FRepeatCount: Integer;
   protected
     function CheckError(AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf): boolean;
@@ -49,8 +58,13 @@ type
     function DoWriteWatchResultData(AnFpValue: TFpValue;
                                   AnResData: TLzDbgWatchDataIntf
                                  ): Boolean;
+    function DoWritePointerWatchResultData(AnFpValue: TFpValue;
+                                  AnResData: TLzDbgWatchDataIntf;
+                                  AnAddr: TDbgPtr
+                                 ): Boolean;
   public
     constructor Create(AContext: TFpDbgLocationContext);
+    destructor Destroy; override;
 
     function WriteWatchResultData(AnFpValue: TFpValue;
                                   AnResData: TLzDbgWatchDataIntf;
@@ -58,6 +72,7 @@ type
                                  ): Boolean;
 
     property Context: TFpDbgLocationContext read FContext write FContext;
+    property ExtraDepth: Boolean read FExtraDepth write FExtraDepth;
   end;
 
 
@@ -69,6 +84,9 @@ implementation
 function TFpWatchResultConvertor.CheckError(AnFpValue: TFpValue;
   AnResData: TLzDbgWatchDataIntf): boolean;
 begin
+  Result := AnFpValue = nil;
+  if Result then
+    exit;
   Result := IsError(AnFpValue.LastError);
   if Result then begin
     if AnResData <> nil then
@@ -98,14 +116,19 @@ function TFpWatchResultConvertor.PointerToResData(AnFpValue: TFpValue;
 var
   DerefRes: TLzDbgWatchDataIntf;
   DerefVal: TFpValue;
+  addr: QWord;
 begin
   Result := True;
-  AnResData.CreatePointerValue(AnFpValue.AsCardinal);
+  addr := AnFpValue.AsCardinal;
+  AnResData.CreatePointerValue(addr);
   AddTypeNameToResData(AnFpValue, AnResData);
 
   if CheckError(AnFpValue, AnResData) then
     exit;
 
+  if addr = 0 then
+    exit;
+
   if svfString in AnFpValue.FieldFlags then begin
     // PChar: Get zero-terminated string, rather than just one single char
     DerefRes := AnResData.SetDerefData;
@@ -140,21 +163,18 @@ begin
            - Pascal-String type
            - Any basic type (any type that has no reference or internal pointer)
              (skChar should not happen: Should be PChar above)
-           * NO pointer => pointer must check NEST_PTR_RECURSE_LVL
+           - Any other
-                        => pointer is NOT ALLOWED to ignore MAX_RECURSE_LVL
-           * NO struct, array, variant... => May include pointers or internal refs
         *)
         DerefRes := AnResData.SetDerefData;
         if DerefRes <> nil then begin
           // In case of nested pointer MAX_RECURSE_LVL may already be reached. Make an exception here, to allow one more.
           dec(FRecurseCnt);
-          DoWriteWatchResultData(DerefVal, DerefRes);
+          DoWritePointerWatchResultData(DerefVal, DerefRes, addr);
           inc(FRecurseCnt);
         end;
       end
       else
       if (DerefVal.Kind =skPointer) and (svfString in DerefVal.FieldFlags) then begin
-        // PPChar / Pointer to PChar: Ignore NEST_PTR_RECURSE_LVL
         DerefRes := AnResData.SetDerefData;
         if DerefRes <> nil then begin
           DerefRes.CreateString(DerefVal.AsString);
@@ -163,22 +183,17 @@ begin
       end
       else
       if (DerefVal.Kind =skPointer) and (svfWideString in DerefVal.FieldFlags) then begin
-        // PPWideChar / Pointer to PWideChar: Ignore NEST_PTR_RECURSE_LVL
         DerefRes := AnResData.SetDerefData;
         if DerefRes <> nil then begin
           DerefRes.CreateWideString(DerefVal.AsString);
           AddTypeNameToResData(DerefVal, DerefRes, True);
         end;
       end
-      else
+      else begin
-      if (DerefVal.Kind =skPointer) and (FRecurseCnt <= NEST_PTR_RECURSE_LVL) then begin
-        // Nested Pointer
         DerefRes := AnResData.SetDerefData;
-        if DerefRes <> nil then begin
+        if DerefRes <> nil then
-          DoWriteWatchResultData(DerefVal, DerefRes);
+          DoWritePointerWatchResultData(DerefVal, DerefRes, addr);
-        end;
       end;
-      // Currently do NOT deref for struct, array, ...
 
       CheckError(DerefVal, DerefRes);
       DerefVal.ReleaseReference;
@@ -291,8 +306,11 @@ end;
 
 function TFpWatchResultConvertor.ArrayToResData(AnFpValue: TFpValue;
   AnResData: TLzDbgWatchDataIntf): Boolean;
+const
+  MAX_TOTAL_ARRAY_CNT = 5000;
+  MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH = 3500; // reset
 var
-  Cnt, i, RecurseInst, OuterIdx: Integer;
+  Cnt, i, CurRecurseDynArray, OuterIdx: Integer;
   LowBnd: Int64;
   Addr: TDBGPtr;
   ti: TFpSymbol;
@@ -300,16 +318,15 @@ var
   MemberValue: TFpValue;
 begin
   Result := True;
-  if FRecurseCnt > NEST_PTR_RECURSE_LVL then
-    exit;
 
   Cnt := AnFpValue.MemberCount;
-  RecurseInst := FRecurseInstanceCnt;
+  CurRecurseDynArray := FRecurseDynArray;
   OuterIdx := FOuterArrayIdx;
 
   if (AnFpValue.IndexTypeCount = 0) or (not AnFpValue.IndexType[0].GetValueLowBound(AnFpValue, LowBnd)) then
     LowBnd := 0;
 
+  Addr := 0;
   ti := AnFpValue.TypeInfo;
   if (ti = nil) or (ti.Flags * [sfDynArray, sfStatArray] = []) then begin
     EntryRes := AnResData.CreateArrayValue(datUnknown, Cnt, LowBnd);
@@ -317,7 +334,6 @@ begin
   else
   if (sfDynArray in ti.Flags) or (LowBnd = 0) then begin // LowBnd = 0 => there is some bug, reporting some dyn arrays as stat.
     EntryRes := AnResData.CreateArrayValue(datDynArray, Cnt, 0);
-    Addr := 0;
     if AnFpValue.FieldFlags * [svfInteger, svfCardinal] <> [] then
       Addr := AnFpValue.AsCardinal
     else
@@ -325,7 +341,8 @@ begin
       Addr := AnFpValue.DataAddress.Address;
     AnResData.SetDataAddress(Addr);
 
-    inc(FRecurseInstanceCnt);
+    if FRecurseCnt >= 0 then
+      inc(FRecurseDynArray);
   end
   else begin
     EntryRes := AnResData.CreateArrayValue(datStatArray, Cnt, LowBnd);
@@ -334,25 +351,31 @@ begin
   AddTypeNameToResData(AnFpValue, AnResData);
 
   try
-    if Cnt <= 0 then
+    if (Cnt <= 0) or
+       (FHasEmbeddedPointer) or
+       (FRecurseCnt > MAX_RECURSE_LVL_ARRAY) or
+       ( (FRecurseCnt > 0) and (FTotalArrayCnt > MAX_TOTAL_ARRAY_CNT) )
+    then
       exit;
 
     if (Context.MemManager.MemLimits.MaxArrayLen > 0) and (Cnt > Context.MemManager.MemLimits.MaxArrayLen) then
       Cnt := Context.MemManager.MemLimits.MaxArrayLen;
 
-    If (FOuterArrayIdx < 0) and (FRepeatCount > 0) then Cnt := FRepeatCount
+    If (FOuterArrayIdx < 0) and (FRecurseCnt = FRecurseCntLow) and (FRepeatCount > 0) then Cnt := FRepeatCount
-    else if (FRecurseCnt > 1) and (FOuterArrayIdx <   5) and (Cnt >    5) then Cnt := 5
+    else if (FRecurseCnt > 1) and (FOuterArrayIdx >  10) and (Cnt >   10) then Cnt := 10
-    else if (FRecurseCnt > 1)                            and (Cnt >    3) then Cnt := 3
+    else if (FRecurseCnt > 1) and (FOuterArrayIdx >   1) and (Cnt >   20) then Cnt := 20
-    else if (FRecurseCnt > 0) and (FOuterArrayIdx <  25) and (Cnt >   50) then Cnt := 50
+    else if (FRecurseCnt > 0) and (FOuterArrayIdx > 100) and (Cnt >   10) then Cnt := 10
-    else if (FRecurseCnt > 0) and (FOuterArrayIdx < 100) and (Cnt >   10) then Cnt := 10
+    else if (FRecurseCnt > 0) and (FOuterArrayIdx >   1) and (Cnt >   50) then Cnt := 50
-    else if (FRecurseCnt > 0)                            and (Cnt >    5) then Cnt := 5
     else if (Cnt > 1000) then Cnt := 1000;
 
     /////////////////////
     // add mem read cache ??
     // Bound types
 
+    inc(FTotalArrayCnt, Cnt);
     for i := 0 to Cnt - 1 do begin
+      if (FRecurseCnt < 0) and (FTotalArrayCnt > MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH) then
+        FTotalArrayCnt := MAX_TOTAL_ARRAY_CNT_EXTRA_DEPTH;
       if i > FOuterArrayIdx then
         FOuterArrayIdx := i;
       MemberValue := AnFpValue.Member[i+LowBnd];
@@ -360,12 +383,12 @@ begin
       if MemberValue = nil then
         EntryRes.CreateError('Error: Could not get member')
       else
-        DoWriteWatchResultData(MemberValue, EntryRes);
+        DoWritePointerWatchResultData(MemberValue, EntryRes, Addr);
       MemberValue.ReleaseReference;
     end;
 
   finally
-    FRecurseInstanceCnt := RecurseInst;
+    FRecurseDynArray := CurRecurseDynArray;
     FOuterArrayIdx := OuterIdx;
   end
 end;
@@ -378,7 +401,7 @@ var
   vt: TLzDbgStructType;
   Cache: TFpDbgMemCacheBase;
   AnchestorMap: TAnchestorMap;
-  i, j: Integer;
+  i, j, WasRecurseInstanceCnt: Integer;
   MemberValue: TFpValue;
   ti, sym: TFpSymbol;
   ResAnch, ResField, TopAnch, UnkAnch: TLzDbgWatchDataIntf;
@@ -413,7 +436,13 @@ begin
   AnResData.CreateStructure(vt, Addr);
   AddTypeNameToResData(AnFpValue, AnResData);
 
-  if (AnFpValue.Kind in [skClass, skInterface]) and (Addr = 0) then
+  if (AnFpValue.Kind in [skClass, skInterface]) and
+     ( (Addr = 0) or
+       (FRecurseInstanceCnt >= 1) or (FRecurseDynArray >= 2)
+     )
+  then
+    exit;
+  if FHasEmbeddedPointer then
     exit;
 
   if Context.MemManager.CacheManager <> nil then
@@ -422,15 +451,10 @@ begin
     Cache := nil;
 
   AnchestorMap := TAnchestorMap.Create;
-  if (AnFpValue.Kind in [skClass, skInterface]) then
+  WasRecurseInstanceCnt := FRecurseInstanceCnt;
+  if (AnFpValue.Kind in [skClass, skInterface]) and (FRecurseCnt >= 0) then
     inc(FRecurseInstanceCnt);
   try
-    if (AnFpValue.Kind in [skClass, skObject]) and (FRecurseCnt > NEST_PTR_RECURSE_LVL) then
-      exit;
-    if (AnFpValue.Kind in [skClass, skInterface]) and (FRecurseInstanceCnt >= 2) then
-      exit;
-
-
     TopAnch := AnResData;
     UnkAnch := nil;
     ti := AnFpValue.TypeInfo;
@@ -496,14 +520,13 @@ begin
       end;
 
       ResField := ResAnch.AddField(MbName, MBVis, []);
-      if not DoWriteWatchResultData(MemberValue, ResField) then
+      if not DoWritePointerWatchResultData(MemberValue, ResField, Addr) then
         ResField.CreateError('Unknown');
 
       MemberValue.ReleaseReference;
     end;
   finally
-    if (AnFpValue.Kind in [skClass, skInterface]) then
+    FRecurseInstanceCnt := WasRecurseInstanceCnt;
-      dec(FRecurseInstanceCnt);
     AnchestorMap.Free;
     if Cache <> nil then
       Context.MemManager.CacheManager.RemoveCache(Cache)
@@ -563,23 +586,34 @@ function TFpWatchResultConvertor.DoWriteWatchResultData(AnFpValue: TFpValue;
 var
   PrettyPrinter: TFpPascalPrettyPrinter;
   s: String;
+  DidHaveEmbeddedPointer: Boolean;
 begin
   // FRecurseCnt should be handled by the caller
-  Result := FRecurseCnt > MAX_RECURSE_LVL;
+  Result := (FRecurseCnt > MAX_RECURSE_LVL) or (AnFpValue = nil);
   if Result then
     exit;
 
-  Result := True;
+  Result := False;
-  if AnResData = nil then
-    exit;
 
-  if AnFpValue = nil then begin
+  DidHaveEmbeddedPointer := FHasEmbeddedPointer;
-    AnResData.CreateError('No Data');
+  if (FRecurseCnt <= 0) and
-    exit;
+     ( (FLastValueKind = skPointer) or (FRecurseCnt=-1) ) and
+     (AnFpValue.Kind = skPointer) and
+     (FRecursePointerCnt < MAX_RECURSE_LVL_PTR)
+  then begin
+    inc(FRecursePointerCnt);
+  end
+  else begin
+    inc(FRecurseCnt);
+    if (AnFpValue.Kind = skPointer) then
+      FHasEmbeddedPointer := True
+    else
+    if FHasEmbeddedPointer and (FLastValueKind <> skPointer) then
+      exit;
+      // Allow only one level, after an embedded pointer (pointer nested in other data-type)
   end;
 
-  Result := False;
+  FLastValueKind := AnFpValue.Kind;
-  inc(FRecurseCnt);
   try
     case AnFpValue.Kind of
       skPointer:  Result := PointerToResData(AnFpValue, AnResData);
@@ -628,26 +662,67 @@ begin
       Result := True;
     end;
   finally
-    dec(FRecurseCnt);
+    if FRecursePointerCnt > 0 then
+      dec(FRecursePointerCnt)
+    else
+      dec(FRecurseCnt);
+    FHasEmbeddedPointer := DidHaveEmbeddedPointer;
   end;
 end;
 
+function TFpWatchResultConvertor.DoWritePointerWatchResultData(
+  AnFpValue: TFpValue; AnResData: TLzDbgWatchDataIntf; AnAddr: TDbgPtr
+  ): Boolean;
+begin
+  if FRecurseAddrList.IndexOf(AnAddr) >= 0 then
+    exit;
+  if AnAddr <> 0 then
+    FRecurseAddrList.Add(AnAddr);
+  DoWriteWatchResultData(AnFpValue, AnResData);
+  if AnAddr <> 0 then
+    FRecurseAddrList.Remove(AnAddr);
+end;
+
 constructor TFpWatchResultConvertor.Create(AContext: TFpDbgLocationContext);
 begin
   inherited Create;
+  FRecurseAddrList := TDbgPtrList.Create;
   FContext := AContext;
 end;
 
+destructor TFpWatchResultConvertor.Destroy;
+begin
+  inherited Destroy;
+  FRecurseAddrList.Free;
+end;
+
 function TFpWatchResultConvertor.WriteWatchResultData(AnFpValue: TFpValue;
   AnResData: TLzDbgWatchDataIntf; ARepeatCount: Integer): Boolean;
 begin
+  Result := False;
+  if AnResData = nil then
+    exit;
+  if AnFpValue = nil then begin
+    AnResData.CreateError('No Data');
+    exit;
+  end;
   if CheckError(AnFpValue, AnResData) then
     exit;
 
+  FRecurseAddrList.Clear;
   FRepeatCount := ARepeatCount;
-  FRecurseCnt := -1;
+  FRecurseCnt         := -1;
-  FRecurseInstanceCnt := 0;
+  if FExtraDepth then
+    FRecurseCnt         := -2;
+  FRecurseInstanceCnt :=  0;
+  FRecurseDynArray    :=  0;
+  FRecursePointerCnt := 0;
+  FRecurseCntLow := FRecurseCnt+1;
   FOuterArrayIdx := -1;
+  FTotalArrayCnt :=  0;
+
+  FLastValueKind := AnFpValue.Kind;
+  FHasEmbeddedPointer := False;
   Result := DoWriteWatchResultData(AnFpValue, AnResData);
 end;
 

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas

@@ -1025,6 +1025,7 @@ begin
        (ADispFormat <> wdfMemDump)   // TODO
     then begin
       WatchResConv := TFpWatchResultConvertor.Create(FExpressionScope.LocationContext);
+      WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags;
       ResData := FWatchValue.ResData;
       Result := WatchResConv.WriteWatchResultData(ResValue, ResData, FWatchValue.RepeatCount);
 

components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas

@@ -82,11 +82,14 @@ type
     );
 
   TWatcheEvaluateFlag =
-    (defNoTypeInfo,        // No Typeinfo object will be returned // for structures that means a printed value will be returned
+    ( defClassAutoCast,     // Find real class of instance, and use, instead of declared class of variable
-     defSimpleTypeInfo,    // Returns: Kind (skSimple, skClass, ..); TypeName (but does make no attempt to avoid an alias)
+      defAllowFunctionCall, //
-     defFullTypeInfo,      // Get all typeinfo, resolve all anchestors
+      defExtraDepth,        // Evaluate 1 extra level of sub-elements => i.e., evaluate each nested sub-item
-     defClassAutoCast,     // Find real class of instance, and use, instead of declared class of variable
+
-     defAllowFunctionCall//,
+      // deprecated
+      defNoTypeInfo,        // No Typeinfo object will be returned // for structures that means a printed value will be returned
+      defSimpleTypeInfo,    // Returns: Kind (skSimple, skClass, ..); TypeName (but does make no attempt to avoid an alias)
+      defFullTypeInfo      // Get all typeinfo, resolve all anchestors
 //     defRawMemory,         // returns Array of bytes for hex dump
 //     defNoValue            // Skip the value, if returning raw mem
     );

debugger/inspectdlg.pas

@@ -1372,7 +1372,7 @@ begin
   if stack <> nil then
     idx := stack.CurrentIndex;
 
-  Opts := [defFullTypeInfo];
+  Opts := [defExtraDepth, defFullTypeInfo];
   if btnUseInstance.Down then
     include(Opts, defClassAutoCast);