Debugger: improve SysVarToLStr - Improve error handling

components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas

@@ -5,8 +5,9 @@ unit FpDebuggerResultData;
 interface
 
 uses
-  Classes, SysUtils, FpWatchResultData, FpDbgInfo, DbgIntfBaseTypes,
+  Classes, SysUtils, FpWatchResultData, FpDbgInfo, FpdMemoryTools,
-  FpDebugValueConvertors, FpDebugDebuggerBase, LazDebuggerIntf;
+  DbgIntfBaseTypes, FpDebugValueConvertors, FpDebugDebuggerBase,
+  LazDebuggerIntf;
 
 type
 
@@ -20,11 +21,13 @@ type
     FValConfig: TFpDbgConverterConfig;
 
     FOuterKind: TDbgSymbolKind;
+    FOuterKindLvl: Integer;
     FMainValueIsArray: Boolean;
     FArrayItemConv: TFpDbgValueConverter;
 
     function GetValConv(AnFpValue: TFpValue): TFpDbgValueConverter; inline;
   public
+    constructor Create(AContext: TFpDbgLocationContext);
     destructor Destroy; override;
 
     function DoValueToResData(AnFpValue: TFpValue;
@@ -67,6 +70,13 @@ begin
   end;
 end;
 
+constructor TFpLazDbgWatchResultConvertor.Create(AContext: TFpDbgLocationContext
+  );
+begin
+  inherited Create(AContext);
+  FOuterKindLvl := -99
+end;
+
 destructor TFpLazDbgWatchResultConvertor.Destroy;
 begin
   inherited Destroy;
@@ -76,18 +86,21 @@ end;
 function TFpLazDbgWatchResultConvertor.DoValueToResData(AnFpValue: TFpValue;
   AnResData: TLzDbgWatchDataIntf): Boolean;
 var
-  NewRes: TFpValue;
+  NewFpVal: TFpValue;
   CurConv: TFpDbgValueConverter;
+  AnResFld: TLzDbgWatchDataIntf;
 begin
-  NewRes := nil;
   Result := False;
-  if RecurseCnt = 0 then
+  if RecurseCnt <= 0 then begin
     FOuterKind := AnFpValue.Kind;
+    FOuterKindLvl := RecurseCnt + 1;
+  end;
 
   if (RecurseCnt =-1) and (AnFpValue.Kind in [skArray]) then
     FMainValueIsArray := True;
 
   CurConv := nil;
+  NewFpVal := nil;
   try
     if (RecurseCnt = 0) and (FMainValueIsArray) then begin
       if FArrayItemConv = nil then
@@ -96,31 +109,35 @@ begin
     end
     else
     if (not FMainValueIsArray) and
-       ( (RecurseCnt = 0) or
+       ( (RecurseCnt <= 0) or
-         ( (RecurseCnt = 1) and (FOuterKind in [skClass, skRecord, skObject, skInstance, skInterface]) )
+         ( (RecurseCnt = FOuterKindLvl) and (FOuterKind in [skClass, skRecord, skObject, skInstance, skInterface]) )
        )
     then begin
       CurConv := GetValConv(AnFpValue);
     end;
 
     if (CurConv <> nil) then begin
-      NewRes := CurConv.ConvertValue(AnFpValue, Debugger, ExpressionScope);
+      AnResData.CreateStructure(dstInternal);
-      if NewRes <> nil then
+      AnResFld := AnResData.AddField('', dfvUnknown, []);
-        AnFpValue := NewRes
+
-      else
+      NewFpVal := CurConv.ConvertValue(AnFpValue, Debugger, ExpressionScope);
-      if FMainValueIsArray then begin
+      if NewFpVal <> nil then begin
-        AnResData.CreateError('Conversion failed');
+        Result := inherited DoValueToResData(NewFpVal, AnResFld);
+      end
+      else begin
+        AnResFld.CreateError('Conversion failed');
         Result := True;
-        exit;
       end;
+      AnResData := AnResData.AddField('', dfvUnknown, []);
     end;
+  finally
     if CurConv <> FArrayItemConv then
       CurConv.ReleaseReference;
-
+    NewFpVal.ReleaseReference;
-    Result := inherited DoValueToResData(AnFpValue, AnResData);
-  finally
-    NewRes.ReleaseReference;
   end;
+
+  if inherited DoValueToResData(AnFpValue, AnResData) then
+    Result := True;
 end;
 
 end.

components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas

@@ -292,18 +292,28 @@ function TFpDbgValueConverterVariantToLStr.ConvertValue(ASourceValue: TFpValue;
   AnFpDebugger: TFpDebugDebuggerBase; AnExpressionScope: TFpDbgSymbolScope
   ): TFpValue;
 var
-  NewResult, ProcVal: TFpValue;
+  NewResult, ProcVal, m: TFpValue;
   ProcSym, StringDecRefSymbol: TFpSymbol;
   CallContext: TFpDbgInfoCallContext;
   StringAddr, ProcAddr: TDbgPtr;
   ProcLoc: TFpDbgMemLocation;
+  r: Boolean;
 begin
   Result := nil;
-  if (ASourceValue.Kind <> skRecord) //or
+  if not (
-     //(ASourceValue.MemberCount <> 2) or
+    (ASourceValue.Kind = skRecord) and
-     //(SizeToFullBytes(ASourceValue.Member[0].DataSize) <> 2)
+    ( (ASourceValue.MemberCount = 0) or
+      (ASourceValue.MemberCount >= 2)
+  ) )
   then
     exit;
+  if (ASourceValue.MemberCount >= 2) then begin
+    m := ASourceValue.Member[0];
+    r := SizeToFullBytes(m.DataSize) <> 2;
+    m.ReleaseReference;
+    if r then
+      exit;
+  end;
 
   ProcVal := nil;
   ProcSym := nil;
@@ -349,7 +359,7 @@ begin
     try
       CallContext.AddStringResult;
       CallContext.FinalizeParams; // force the string as first param (32bit) // TODO
-      CallContext.AddOrdinalParam(nil, ASourceValue.Address.Address);
+      CallContext.AddOrdinalParam(nil, ASourceValue.DataAddress.Address);
       AnFpDebugger.DbgController.ProcessLoop;
 
       if not CallContext.IsValid then

components/lazdebuggers/lazdebuggerfp/test/testwatches.pas

@@ -1980,6 +1980,7 @@ var
   Src: TCommonSource;
   BrkPrg: TDBGBreakPoint;
   obj: TFpDbgConverterConfig;
+  i, c: Integer;
 begin
   if SkipTest then exit;
   if not TestControlCanTest(ControlTestWatchFunctVariant) then exit;
@@ -2014,9 +2015,39 @@ begin
     ValueConverterConfigList.Add(obj);
 
     t.Clear;
-    t.Add('variant to lstr', 'variant1',    weAnsiStr('102'))
+    t.Add('variant1 to lstr', 'variant1',    weAnsiStr('102'));
-      .IgnTypeName
+    t.Add('variant2 to lstr', 'variant2',    weAnsiStr('True'));
-      .IgnData([], Compiler.Version < 029999);
+
+    t.Add('rec variant1 to lstr', 'v_rec.variant1',    weAnsiStr('103'));
+    t.Add('rec variant2 to lstr', 'v_rec.variant2',    weAnsiStr('False'));
+
+    t.Add('array variant1 to lstr', 'v_array[3]',    weAnsiStr('104'));
+    t.Add('array variant2 to lstr', 'v_array[4]',    weAnsiStr('True'));
+
+
+    c := t.Count;
+    t.Add('Extra-depth: variant1 to lstr', 'variant1',    weAnsiStr('102'));
+    t.Add('Extra-depth: variant2 to lstr', 'variant2',    weAnsiStr('True'));
+
+    t.Add('Extra-depth: rec variant1 to lstr', 'v_rec.variant1',    weAnsiStr('103'));
+    t.Add('Extra-depth: rec variant2 to lstr', 'v_rec.variant2',    weAnsiStr('False'));
+
+    t.Add('Extra-depth: array variant1 to lstr', 'v_array[3]',    weAnsiStr('104'));
+    t.Add('Extra-depth: array variant2 to lstr', 'v_array[4]',    weAnsiStr('True'));
+
+    for i := c to t.Count-1 do
+      t.Tests[i]^.TstWatch.EvaluateFlags := t.Tests[i]^.TstWatch.EvaluateFlags + [defExtraDepth];
+
+
+    for i := 0 to t.Count-1 do
+      t.Tests[i].AddFlag(ehNoTypeInfo);
+
+    if Compiler.Version < 029999 then
+      for i := 0 to t.Count-1 do
+        t.Tests[i]
+          .IgnTypeName
+          .IgnData([], Compiler.Version < 029999);
+
     t.EvaluateWatches;
     t.CheckResults;
 

components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas

@@ -108,7 +108,7 @@ type
 
   TLzDbgFloatPrecission = (dfpSingle, dfpDouble, dfpExtended);
 //  TLzDbgSetData = bitpacked array [0..255] of boolean;
-  TLzDbgStructType      = (dstUnknown, dstRecord, dstObject, dstClass, dstInterface);
+  TLzDbgStructType      = (dstUnknown, dstRecord, dstObject, dstClass, dstInterface, dstInternal);
   TLzDbgArrayType       = (datUnknown, datDynArray, datStatArray);
   TLzDbgFieldVisibility = (dfvUnknown, dfvPrivate, dfvProtected, dfvPublic, dfvPublished);
   TLzDbgFieldFlag  = (dffClass, dffAbstract, dffVirtual, dffOverwritten, dffConstructor, dffDestructor);

components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas

@@ -76,6 +76,12 @@ var
   InterfacedObject, InterfacedObject2: TInterfacedObject;
 
   variant1: variant;
+  variant2: variant;
+  v_rec: record
+    variant1: variant;
+    variant2: variant;
+  end;
+  v_array: array [3..4] of variant;
 
 type
   TClass1 = class;
@@ -881,6 +887,12 @@ begin
   FuncIntAdd(1,1);
   FuncTooManyArg(1,1,1,1,1,1,1,1,1,1,1,1);
   variant1 := 102;
+  variant2 := True;
+  v_rec.variant1 := 103;
+  v_rec.variant2 := False;
+  v_array[3] := 104;
+  v_array[4] := True;
+
   {$if FPC_FULLVERSION >= 30000}
   dummy1 := nil;
   {$ENDIF}
@@ -1090,6 +1102,8 @@ begin
   MyClass1.MethFoo();
 
   MyClass2.BaseMethFoo();
+  variant1 := 102;
+  variant2 := True;
 
 end.
 

components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas

@@ -1366,6 +1366,13 @@ begin
       Stack  := TstStackFrame;
       WatchVal := TstWatch.Values[Thread, Stack];
       Context.WatchRes := WatchVal.ResultData;
+      if (Context.WatchRes <> nil) and
+         (Context.WatchRes.ValueKind = rdkStruct) and
+         (Context.WatchRes.StructType = dstInternal) and
+         (Context.WatchRes.FieldCount > 0)
+      then
+        Context.WatchRes := Context.WatchRes.Fields[0].Field;
+
       Context.WatchTpInf := WatchVal.TypeInfo;
 
       if not VerifyDebuggerState then

debugger/inspectdlg.pas

@@ -109,6 +109,7 @@ type
     FWatchPrinter: TWatchResultPrinter;
     FInspectWatches: TCurrentWatches;
     FCurrentWatchValue: TIdeWatchValue;
+    FCurrentResData: TWatchResultData;
     FHumanReadable: ansistring;
     FGridData: TStringGrid;
     FGridMethods: TStringGrid;
@@ -231,7 +232,7 @@ var
   Res: TWatchResultData;
   v: String;
 begin
-  Res := FCurrentWatchValue.ResultData;
+  Res := FCurrentResData;
 
   DataPage.TabVisible:=true;
   PropertiesPage.TabVisible:=false;
@@ -259,7 +260,7 @@ var
   Res: TWatchResultData;
   v: String;
 begin
-  Res := FCurrentWatchValue.ResultData;
+  Res := FCurrentResData;
   DataPage.TabVisible:=true;
   PropertiesPage.TabVisible:=false;
   MethodsPage.TabVisible:=false;
@@ -295,7 +296,7 @@ var
   Res: TWatchResultData;
   v: String;
 begin
-  Res := FCurrentWatchValue.ResultData;
+  Res := FCurrentResData;
 
   DataPage.TabVisible:=true;
   PropertiesPage.TabVisible:=false;
@@ -345,7 +346,7 @@ begin
   btnColType.Enabled := True;
   btnColVisibility.Enabled := False;
 
-  Res := FCurrentWatchValue.ResultData;
+  Res := FCurrentResData;
   StatusBar1.SimpleText:=ShortenedExpression+': '+Res.TypeName + '  Len: ' + IntToStr(Res.ArrayLength);
 
   LowBnd := Res.LowBound;
@@ -403,7 +404,7 @@ var
   FldInfo: TWatchResultDataFieldInfo;
   AnchType: String;
 begin
-  Res := FCurrentWatchValue.ResultData;
+  Res := FCurrentResData;
 
   FGridData.Columns[0].Visible := (Res.StructType in [dstClass, dstObject]) and btnColClass.Down; // anchestor
   FGridData.Columns[2].Visible := btnColType.Down; // typename
@@ -540,6 +541,7 @@ end;
 procedure TIDEInspectDlg.FormShow(Sender: TObject);
 begin
   ReleaseRefAndNil(FCurrentWatchValue);
+  FCurrentResData := nil;
   FInspectWatches.Clear;
   UpdateData;
 end;
@@ -618,8 +620,8 @@ begin
 
   end
   else
-  if FCurrentWatchValue.ResultData <> nil then begin
+  if FCurrentResData <> nil then begin
-    case FCurrentWatchValue.ResultData.ValueKind of
+    case FCurrentResData.ValueKind of
       rdkPointerVal: begin
           i := FGridData.Row;
           if (i < 1) or (i >= FGridData.RowCount) then exit;
@@ -640,7 +642,7 @@ begin
           if (i < 1) or (i >= FGridData.RowCount) then exit;
           s := FGridData.Cells[1, i];
 
-          if btnUseInstance.Down and (FCurrentWatchValue.ResultData.StructType in [dstClass, dstObject]) then
+          if btnUseInstance.Down and (FCurrentResData.StructType in [dstClass, dstObject]) then
             Execute(FGridData.Cells[0, i] + '(' + FExpression + ').' + s)
           else
             Execute(FExpression + '.' + s);
@@ -657,7 +659,7 @@ begin
   if ( (FCurrentWatchValue.TypeInfo <> nil) and
        (FCurrentWatchValue.TypeInfo.Kind = skClass)
      ) or
-     ( FCurrentWatchValue.ResultData.StructType in [dstClass, dstObject] )
+     ( FCurrentResData.StructType in [dstClass, dstObject] )
   then begin
     FGridData.Columns[0].Visible := btnColClass.Down;
     FGridData.Columns[4].Visible := btnColVisibility.Down;
@@ -677,6 +679,7 @@ begin
   then begin
     btnPower.ImageIndex := FPowerImgIdx;
     ReleaseRefAndNil(FCurrentWatchValue);
+    FCurrentResData := nil;
     FInspectWatches.Clear;
     UpdateData;
   end
@@ -1261,6 +1264,7 @@ begin
   DebugBoss.UnregisterStateChangeHandler(@DoDebuggerState);
   DebugBoss.UnregisterWatchesInvalidatedHandler(@DoWatchesInvalidated);
   ReleaseRefAndNil(FCurrentWatchValue);
+  FCurrentResData := nil;
   FreeAndNil(FHistory);
   FreeAndNil(FWatchPrinter);
   //FreeAndNil(FDataGridHook);
@@ -1347,9 +1351,10 @@ begin
 
   TimerClearData.Enabled := False;
 
+  FCurrentResData := nil;
   FAlternateExpression := '';
   FExpressionWasEvaluated := True;
-  FHumanReadable := FWatchPrinter.PrintWatchValue(FCurrentWatchValue.ResultData, wdfStructure);
+  FHumanReadable := FWatchPrinter.PrintWatchValue(FCurrentResData, wdfStructure);
 
   if FCurrentWatchValue.Validity = ddsValid then begin
       ArrayNavigationBar1.Visible := False;
@@ -1378,9 +1383,27 @@ begin
       end;
     end
     else begin
+      FCurrentResData := FCurrentWatchValue.ResultData;
     // resultdata
-      ArrayNavigationBar1.Visible := FCurrentWatchValue.ResultData.ValueKind = rdkArray;
+
-      case FCurrentWatchValue.ResultData.ValueKind of
+      if (FCurrentResData.ValueKind = rdkStruct) and
+         (FCurrentResData.StructType = dstInternal)
+      then begin
+        if (FCurrentResData.FieldCount > 0) then
+        //if (FCurrentResData.FieldCount = 1) then
+          FCurrentResData := FCurrentResData.Fields[0].Field;
+
+        if (FCurrentResData.FieldCount > 1) and
+           ( (FCurrentResData.Fields[0].Field = nil) or
+             (FCurrentResData.Fields[0].Field.ValueKind = rdkError)
+           )
+        then
+          FCurrentResData := FCurrentResData.Fields[1].Field;
+      end;
+
+
+      ArrayNavigationBar1.Visible := FCurrentResData.ValueKind = rdkArray;
+      case FCurrentResData.ValueKind of
         //rdkError: ;
         rdkPrePrinted,
         rdkString,
@@ -1425,6 +1448,7 @@ begin
   if (not btnPower.Down) or (not Visible) then exit;
   if (ADebugger.State = dsPause) and (AnOldState <> dsPause) then begin
     ReleaseRefAndNil(FCurrentWatchValue);
+    FCurrentResData := nil;
     FInspectWatches.Clear;
     UpdateData;
   end;
@@ -1440,6 +1464,7 @@ procedure TIDEInspectDlg.DoWatchesInvalidated(Sender: TObject);
 begin
   if (not btnPower.Down) or (not Visible) then exit;
   ReleaseRefAndNil(FCurrentWatchValue);
+  FCurrentResData := nil;
   FInspectWatches.Clear;
   UpdateData;
 end;
@@ -1459,6 +1484,7 @@ begin
   expr := trim(FExpression);
   if expr = '' then begin
     ReleaseRefAndNil(FCurrentWatchValue);
+    FCurrentResData := nil;
     Clear;
     StatusBar1.SimpleText := '';
     exit;
@@ -1496,6 +1522,7 @@ begin
   end;
 
   ReleaseRefAndNil(FCurrentWatchValue);
+  FCurrentResData := nil;
 
   FInspectWatches.BeginUpdate;
   AWatch := FInspectWatches.Find(expr);
@@ -1510,6 +1537,7 @@ begin
   FInspectWatches.EndUpdate;
   FCurrentWatchValue := AWatch.Values[tid, idx];
   if FCurrentWatchValue <> nil then begin
+    FCurrentResData := FCurrentWatchValue.ResultData;
     FCurrentWatchValue.AddReference;
     FCurrentWatchValue.Value;
   end;

debugger/watchesdlg.pp

@@ -1276,7 +1276,8 @@ begin
 
         HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or
                        ( (WatchValue.ResultData <> nil) and
-                         ( (WatchValue.ResultData.FieldCount > 0) or
+                         ( ( (WatchValue.ResultData.FieldCount > 0) and (WatchValue.ResultData.StructType <> dstInternal) )
+                           or
                            ( (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) )
                        ) );
         tvWatches.HasChildren[VNode] := HasChildren;
@@ -1413,7 +1414,9 @@ var
 begin
   ChildCount := 0;
 
-  if (AWatchValue.ResultData <> nil) and (AWatchValue.ResultData.FieldCount > 0) then begin
+  if (AWatchValue.ResultData <> nil) and (AWatchValue.ResultData.FieldCount > 0) and
+     (AWatchValue.ResultData.StructType <> dstInternal)
+  then begin
     ResData := AWatchValue.ResultData;
     ChildCount := ResData.FieldCount;
     AWatch := AWatchValue.Watch;

ide/packages/idedebugger/idedebuggerwatchresprinter.pas

@@ -142,6 +142,32 @@ var
 begin
   Result := '';
 
+  if (AResValue.ValueKind = rdkStruct) and
+     (AResValue.StructType = dstInternal)
+  then begin
+    if AResValue.FieldCount = 0 then
+      exit('Error: No result');
+
+    if (AResValue.FieldCount = 1) or
+       ( (AResValue.Fields[0].Field <> nil) and
+         ((AResValue.Fields[0].Field.ValueKind <> rdkError))
+       )
+    then begin
+      Result := PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl);
+      exit;
+    end;
+
+    if (AResValue.FieldCount > 1) then begin
+      Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl);
+      Result := Result + ' { '
+        + PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl)
+        + ' }';
+      exit;
+    end;
+
+    exit('Error: No result');
+  end;
+
   if (AResValue.StructType in [dstClass, dstInterface])
   then begin
     tn := AResValue.TypeName;