FpDebug: pointer deref with index / tests

git-svn-id: trunk@44563 -

components/fpdebug/fpdbgdwarf.pas

@@ -2242,10 +2242,10 @@ begin
   if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
     exit;
 
-  //if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
+  if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
-  //   (FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
+     (FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
-  //then
+  then
-  //  exit;
+    exit;
 
   Result := False;
 end;

components/fpdebug/fppascalparser.pas

@@ -487,12 +487,15 @@ type
     procedure IncRefLevel;
   end;
 
-  { TFpPasParserValueDerefPointer }
+  { TFpPasParserValueDerefPointer
+    Used as address source in typecast
+  }
 
   TFpPasParserValueDerefPointer = class(TFpPasParserValue)
   private
     FValue: TFpDbgValue;
     FExpression: TFpPascalExpression; // MemReader / AddrSize
+    FAddressOffset: Int64; // Add to address
     FCardinal: QWord; // todo: TFpDbgMemLocation ?
     FCardinalRead: Boolean;
   protected
@@ -502,9 +505,10 @@ type
     function GetAddress: TFpDbgMemLocation; override;
     function GetSize: Integer; override;
     function GetAsCardinal: QWord; override; // reads men
-    function GetTypeInfo: TFpDbgSymbol; override;
+    function GetTypeInfo: TFpDbgSymbol; override; // TODO: Cardinal? Why? // TODO: does not handle AOffset
   public
     constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression);
+    constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression; AOffset: Int64);
     destructor Destroy; override;
   end;
 
@@ -679,6 +683,13 @@ end;
 function TFpPasParserValueDerefPointer.GetAddress: TFpDbgMemLocation;
 begin
   Result := FValue.DataAddress;
+  if FAddressOffset <> 0 then begin
+    assert(IsTargetAddr(Result ), 'TFpPasParserValueDerefPointer.GetAddress: TargetLoc(Result)');
+    if IsTargetAddr(Result) then
+      Result.Address := Result.Address + FAddressOffset
+    else
+      Result := InvalidLoc;
+  end;
 end;
 
 function TFpPasParserValueDerefPointer.GetSize: Integer;
@@ -733,11 +744,18 @@ end;
 
 constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
   AExpression: TFpPascalExpression);
+begin
+  Create(AValue, AExpression, 0);
+end;
+
+constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
+  AExpression: TFpPascalExpression; AOffset: Int64);
 begin
   inherited Create;
   FValue := AValue;
   FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserDerefPointerSymbolValue'){$ENDIF};
   FExpression := AExpression;
+  FAddressOffset := AOffset;
 end;
 
 destructor TFpPasParserValueDerefPointer.Destroy;
@@ -921,8 +939,10 @@ end;
 
 function TFpPascalExpressionPartBracketIndex.DoGetResultValue: TFpDbgValue;
 var
-  TmpVal, TmpVal2, TmpIndex: TFpDbgValue;
+  TmpVal, TmpVal2, TmpIndex, TmpDeref: TFpDbgValue;
   i: Integer;
+  Offs: Int64;
+  ti: TFpDbgSymbol;
 begin
   Result := nil;
   assert(Count >= 2, 'TFpPascalExpressionPartBracketIndex.DoGetResultValue: Count >= 2');
@@ -945,7 +965,7 @@ begin
         TmpVal2 := TmpVal.Member[TmpIndex.AsInteger]
       else
       if (svfOrdinal in TmpIndex.FieldFlags) and
-         (TmpIndex.AsCardinal <= high(Integer))
+         (TmpIndex.AsCardinal <= high(Int64))
       then
         TmpVal2 := TmpVal.Member[TmpIndex.AsCardinal]
       else
@@ -954,13 +974,37 @@ begin
         TmpVal.ReleaseReference;
         exit;
       end;
+      if TmpVal2 <> nil then TmpVal2.AddReference;
     end // Kind = skArray
     else
     if (TmpVal.Kind = skPointer) then begin
-      //Result := TmpVal.TypeInfo;
+      if (TmpVal.TypeInfo = nil) or (TmpVal.TypeInfo.TypeInfo = nil) or
-      SetError('Not implemented');
+         (TmpVal.TypeInfo.TypeInfo.Size <= 0)
-      TmpVal.ReleaseReference;
+      then begin
-      exit;
+        SetError('Can not dereference an untyped pointer');
+        TmpVal.ReleaseReference;
+        exit;
+      end;
+      // TODO: check svfDataAddress / readable ? (see normal pointer deref);
+      ti := TmpVal.TypeInfo.TypeInfo;
+      if (svfInteger in TmpIndex.FieldFlags) then
+        Offs := TmpIndex.AsInteger
+      else
+      if (svfOrdinal in TmpIndex.FieldFlags) and (TmpIndex.AsCardinal <= high(Int64))
+      then
+        Offs := Int64(TmpIndex.AsCardinal)
+      else
+      begin
+        SetError('Can not calculate Index');
+        TmpVal.ReleaseReference;
+        exit;
+      end;
+      {$PUSH}{$R-}{$Q-} // TODO: check overflow
+      Offs := Offs * ti.Size;
+      {$POP}
+      TmpDeref := TFpPasParserValueDerefPointer.Create(TmpVal, Expression, Offs);
+      TmpVal2 := ti.TypeCastValue(TmpDeref);
+      TmpDeref.ReleaseReference;
     end
     else
     if (TmpVal.Kind = skString) then begin
@@ -981,7 +1025,6 @@ begin
       TmpVal.ReleaseReference;
       exit;
     end;
-    TmpVal2.AddReference;
     TmpVal.ReleaseReference;
     TmpVal := TmpVal2;
   end;

components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas

@@ -355,6 +355,8 @@ var
 
   // dummy, ensure "pointer" is in debug info
   ArrayGlob_DummyPointer: Pointer;
+  ArrayGlob_DummyPInteger: PInteger;
+
 procedure Test1;
 
 implementation

components/lazdebuggerfp/test/testwatches.pas

@@ -14,7 +14,7 @@ const
   BREAK_LINE_TestWatchesUnitSimple_2 = 570;
   BREAK_LINE_TestWatchesUnitSimple_3 = 578;
 
-  BREAK_LINE_TestWatchesUnitArray = 840;
+  BREAK_LINE_TestWatchesUnitArray = 842;
 
 type
 
@@ -662,6 +662,16 @@ if not (i in [2,3]) then // open array / TODO
 
   end; // i
   {%endregion  Fields }
+
+//TODO
+  AddSimpleInt('PInteger(Field_DynInt1)[0]',  5511, M_Int);
+  AddSimpleInt('PInteger(Field_DynInt1)[1]',  5512, M_Int);
+  AddSimpleInt('PInteger(Field_DynInt1)[2]',  5513, M_Int);
+
+  AddSimpleInt('^LongInt(Field_DynInt1)[0]',  5511, M_Int);
+  AddSimpleInt('^LongInt(Field_DynInt1)[1]',  5512, M_Int);
+  AddSimpleInt('^LongInt(Field_DynInt1)[2]',  5513, M_Int);
+
 end;
 
 procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts: String;