From 78ffec8934c08f0c750983eec003318306481a09 Mon Sep 17 00:00:00 2001
From: martin <laz.git@mfriebe.de>
Date: Thu, 20 Dec 2018 01:11:42 +0000
Subject: [PATCH] FpDebug: Fixed Array of String for dwarf-3

git-svn-id: trunk@59872 -
---
 components/fpdebug/fpdbgdwarf.pas           | 27 +++++++++++
 components/fpdebug/fpdbgdwarffreepascal.pas | 51 +++++++++++++++++++--
 2 files changed, 73 insertions(+), 5 deletions(-)

diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas
index 3ce2a49a60..153a842f2b 100644
--- a/components/fpdebug/fpdbgdwarf.pas
+++ b/components/fpdebug/fpdbgdwarf.pas
@@ -592,6 +592,19 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
     function TypeCastValue(AValue: TFpDbgValue): TFpDbgValue; override;
     // TODO: flag bounds as cardinal if needed
     function GetValueBounds({%H-}AValueObj: TFpDwarfValue; out ALowBound, AHighBound: Int64): Boolean; virtual;
+
+    (*TODO: workaround / quickfix // only partly implemented
+      When reading several elements of an array (dyn or stat), the typeinfo is always the same instance (type of array entry)
+      But once that instance has read data (like bounds / dwarf3 bounds are read from app mem), this is cached.
+      So all consecutive entries get the same info...
+        array of string
+        array of shortstring
+        array of {dyn} array
+      This works similar to "Init", but should only clear data that is not static / depends on memory reads
+
+      Bounds (and maybe all such data) should be stored on the value object)
+    *)
+    procedure ResetValueBounds; virtual;
   end;
 
   { TFpDwarfSymbolTypeBasic }
@@ -670,6 +683,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
   public
     function GetValueBounds(AValueObj: TFpDwarfValue; out ALowBound,
       AHighBound: Int64): Boolean; override;
+    procedure ResetValueBounds; override;
   end;
 
   { TFpDwarfSymbolTypePointer }
@@ -3307,6 +3321,11 @@ begin
   AHighBound := OrdHighBound;
 end;
 
+procedure TFpDwarfSymbolType.ResetValueBounds;
+begin
+  //
+end;
+
 class function TFpDwarfSymbolType.CreateTypeSubClass(AName: String;
   AnInformationEntry: TDwarfInformationEntry): TFpDwarfSymbolType;
 var
@@ -3741,6 +3760,14 @@ begin
   Result := inherited GetValueBounds(AValueObj, ALowBound, AHighBound);
 end;
 
+procedure TFpDwarfSymbolTypeSubRange.ResetValueBounds;
+begin
+  inherited ResetValueBounds;
+  FLowBoundState := rfNotRead;
+  FHighBoundState := rfNotRead;
+  FCountState := rfNotRead;
+end;
+
 procedure TFpDwarfSymbolTypeSubRange.Init;
 begin
   FLowBoundState := rfNotRead;
diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas
index c8c6f0fe87..8c11527072 100644
--- a/components/fpdebug/fpdbgdwarffreepascal.pas
+++ b/components/fpdebug/fpdbgdwarffreepascal.pas
@@ -138,6 +138,8 @@ type
     FValue: String;
     FValueDone: Boolean;
   protected
+    function IsValidTypeCast: Boolean; override;
+    procedure Reset; override;
     function GetFieldFlags: TFpDbgValueFieldFlags; override;
     function GetAsString: AnsiString; override;
     function GetAsWideString: WideString; override;
@@ -629,6 +631,47 @@ end;
 
 { TFpDwarfV3ValueFreePascalString }
 
+function TFpDwarfV3ValueFreePascalString.IsValidTypeCast: Boolean;
+var
+  f: TFpDbgValueFieldFlags;
+begin
+  Result := HasTypeCastInfo;
+  If not Result then
+    exit;
+
+  assert(TypeCastTargetType.Kind = skString, 'TFpDwarfValueArray.IsValidTypeCast: TypeCastTargetType.Kind = skArray');
+
+  f := TypeCastSourceValue.FieldFlags;
+  if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
+    exit;
+
+  //if sfDynArray in TypeCastTargetType.Flags then begin
+  //  // dyn array
+  //  if (svfOrdinal in f)then
+  //    exit;
+  //  if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
+  //     (TypeCastSourceValue.Size = FOwner.CompilationUnit.AddressSize)
+  //  then
+  //    exit;
+  //  if (f * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) then
+  //    exit;
+  //end
+  //else begin
+  //  // stat array
+  //  if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
+  //     (TypeCastSourceValue.Size = TypeCastTargetType.Size)
+  //  then
+  //    exit;
+  //end;
+  Result := False;
+end;
+
+procedure TFpDwarfV3ValueFreePascalString.Reset;
+begin
+  inherited Reset;
+  FValueDone := False;
+end;
+
 function TFpDwarfV3ValueFreePascalString.GetFieldFlags: TFpDbgValueFieldFlags;
 begin
   Result := inherited GetFieldFlags;
@@ -644,11 +687,6 @@ begin
   if FValueDone then
     exit(FValue);
 
-  if HasTypeCastInfo then begin
-    FLastError := CreateError(fpErrAnyError);
-    exit('');
-  end;
-
   // TODO: error handling
   FValue := '';
   Result := '';
@@ -658,7 +696,10 @@ begin
   t := TypeInfo;
   if t.MemberCount < 1 then // subrange type
     exit;
+
   t2 := t.Member[0]; // subrange type
+  if HasTypeCastInfo then
+    TFpDwarfSymbolType(t2).ResetValueBounds;
   if not( (t2 is TFpDwarfSymbolType) and TFpDwarfSymbolType(t2).GetValueBounds(self, LowBound, HighBound) )
   then
     exit;