FpDebug: Improve reading char from "string[index]". Read only the char in question / Do not fail on MemLimit.MaxStringLen

components/fpdebug/fpdbgdwarf.pas

@@ -322,6 +322,10 @@ type
     function GetFieldFlags: TFpValueFieldFlags; override;
     function GetDataAddress: TFpDbgMemLocation; override;
     function GetDerefAddress: TFpDbgMemLocation; override;
+    function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString;
+      AIgnoreBounds: Boolean = False): Boolean; override;
+    function GetSubWideString(AStartIndex, ALen: Int64; out
+      ASubStr: WideString; AIgnoreBounds: Boolean = False): Boolean; override;
     function GetAsString: AnsiString; override;
     function GetAsWideString: WideString; override;
     function GetMember(AIndex: Int64): TFpValue; override;
@@ -2539,6 +2543,154 @@ begin
     Result := inherited;
 end;
 
+function TFpValueDwarfPointer.GetSubString(AStartIndex, ALen: Int64; out
+  ASubStr: AnsiString; AIgnoreBounds: Boolean): Boolean;
+var
+  t: TFpSymbol;
+  i: Cardinal;
+  Size: TFpDbgValueSize;
+  Addr: TFpDbgMemLocation;
+  WSubStr: WideString;
+begin
+  ASubStr := '';
+  Result := True;
+
+  t := TypeInfo;
+  if t = nil then
+    exit;
+  t := t.TypeInfo;
+  if t = nil then
+    exit;
+  if IsNilLoc(OrdOrDataAddr) then
+    exit;
+
+  // Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
+  if not t.ReadSize(nil, Size) then
+    exit;
+
+
+  if Size.Size = 2 then begin
+    Result := GetSubWideString(AStartIndex, ALen, WSubStr, AIgnoreBounds);
+    ASubStr := WSubStr;
+    exit;
+  end;
+
+  Addr := GetDerefAddress;
+  Result := (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(Addr);
+  if  Result then begin // pchar
+    if AIgnoreBounds then begin
+      if (MemManager.MemLimits.MaxStringLen > 0) and
+         (QWord(ALen) > MemManager.MemLimits.MaxStringLen)
+      then
+        ALen := MemManager.MemLimits.MaxStringLen;
+
+      {$PUSH}{$Q-}
+      Addr.Address := Addr.Address + AStartIndex - 1;
+      {$POP}
+      if not ( (MemManager.SetLength(ASubStr, ALen)) and
+               (Context.ReadMemory(Addr, SizeVal(ALen), @ASubStr[1])) )
+      then begin
+        ASubStr := '';
+        SetLastError(Context.LastMemError);
+      end;
+    end
+    else begin
+      if (AStartIndex < 1) then begin
+        Result := False;
+        AStartIndex := 1;
+      end;
+      if (MemManager.MemLimits.MaxStringLen > 0) and
+         (QWord(ALen) > MemManager.MemLimits.MaxNullStringSearchLen)
+      then
+        ALen := MemManager.MemLimits.MaxNullStringSearchLen;
+
+      if not MemManager.ReadPChar(Addr, ALen, ASubStr) then begin
+        ASubStr := '';
+        SetLastError(Context.LastMemError);
+      end
+      else
+      if AStartIndex > 1 then
+        Delete(ASubStr, 1, AStartIndex-1);
+    end;
+  end
+  else
+    SetLastError(CreateError(fpErrAnyError));
+end;
+
+function TFpValueDwarfPointer.GetSubWideString(AStartIndex, ALen: Int64; out
+  ASubStr: WideString; AIgnoreBounds: Boolean): Boolean;
+var
+  t: TFpSymbol;
+  i: Cardinal;
+  Size: TFpDbgValueSize;
+  Addr: TFpDbgMemLocation;
+  NSubStr: AnsiString;
+begin
+  ASubStr := '';
+  Result := True;
+
+  t := TypeInfo;
+  if t = nil then
+    exit;
+  t := t.TypeInfo;
+  if t = nil then
+    exit;
+  if IsNilLoc(OrdOrDataAddr) then
+    exit;
+
+  // Only test for hardcoded size. TODO: dwarf 3 could have variable size, but for char that is not expected
+  if not t.ReadSize(nil, Size) then
+    exit;
+
+
+  if Size.Size = 1 then begin
+    Result := GetSubString(AStartIndex, ALen, NSubStr, AIgnoreBounds);
+    ASubStr := NSubStr;
+    exit;
+  end;
+
+  Addr := GetDerefAddress;
+  Result := (MemManager <> nil) and (t <> nil) and (t.Kind = skChar) and IsReadableMem(Addr);
+  if  Result then begin // pchar
+    if AIgnoreBounds then begin
+      if (MemManager.MemLimits.MaxStringLen > 0) and
+         (QWord(ALen) > MemManager.MemLimits.MaxStringLen * 2)
+      then
+        ALen := MemManager.MemLimits.MaxStringLen * 2;
+
+      {$PUSH}{$Q-}
+      Addr.Address := Addr.Address + (AStartIndex - 1) * 2;
+      {$POP}
+      if not ( (MemManager.SetLength(ASubStr, ALen)) and
+               (Context.ReadMemory(Addr, SizeVal(ALen*2), @ASubStr[1])) )
+      then begin
+        ASubStr := '';
+        SetLastError(Context.LastMemError);
+      end;
+    end
+    else begin
+      if (AStartIndex < 1) then begin
+        Result := False;
+        AStartIndex := 1;
+      end;
+      if (MemManager.MemLimits.MaxStringLen > 0) and
+         (QWord(ALen) > MemManager.MemLimits.MaxNullStringSearchLen * 2)
+      then
+        ALen := MemManager.MemLimits.MaxNullStringSearchLen * 2;
+
+      if not MemManager.ReadPWChar(Addr, ALen, ASubStr) then begin
+        ASubStr := '';
+        SetLastError(Context.LastMemError);
+      end
+      else
+      if AStartIndex > 1 then
+        Delete(ASubStr, 1, AStartIndex-1);
+    end;
+  end
+  else
+    SetLastError(CreateError(fpErrAnyError));
+end;
+
 function TFpValueDwarfPointer.GetAsString: AnsiString;
 var
   t: TFpSymbol;

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -250,10 +250,16 @@ type
     function GetCodePage: TSystemCodePage;
     function ObtainDynamicCodePage(Addr: TFpDbgMemLocation; out Codepage: TSystemCodePage): Boolean;
     procedure CalcBounds;
+    // check if this is a string, and return bounds
+    function CheckTypeAndGetAddr(out AnAddr: TFpDbgMemLocation): boolean;
   protected
     function IsValidTypeCast: Boolean; override;
     procedure Reset; override;
     function GetFieldFlags: TFpValueFieldFlags; override;
+    function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString;
+      AIgnoreBounds: Boolean = False): Boolean; override;
+    function GetSubWideString(AStartIndex, ALen: Int64; out
+      ASubStr: WideString; AIgnoreBounds: Boolean = False): Boolean; override;
     function GetAsString: AnsiString; override;
     function GetAsWideString: WideString; override;
     procedure SetAsCardinal(AValue: QWord); override;
@@ -1574,14 +1580,120 @@ begin
   end;
 end;
 
+function TFpValueDwarfV3FreePascalString.GetSubString(AStartIndex, ALen: Int64;
+  out ASubStr: AnsiString; AIgnoreBounds: Boolean): Boolean;
+var
+  Addr: TFpDbgMemLocation;
+  FullLen: Int64;
+  t: TFpSymbol;
+  WResult: WideString;
+  RResult: RawByteString;
+  Codepage: TSystemCodePage;
+begin
+  Result := True;
+  ASubStr := '';
+
+  if AStartIndex < 1 then begin // not supported, return partial
+    Result := AIgnoreBounds;
+    ALen := ALen + AStartIndex - 1;
+    AStartIndex := 1;
+  end;
+
+  // get length
+  CalcBounds;
+  if FHighBound < FLowBound then
+    exit; // empty string
+  {$PUSH}{$Q-}
+  FullLen := FHighBound-FLowBound+1;
+  {$POP}
+
+  if AStartIndex - 1 + ALen > FullLen then begin
+    Result := AIgnoreBounds;
+    ALen := FullLen - (AStartIndex - 1);
+
+    if AStartIndex = 1 then begin
+      ASubStr := AsString;  // get the full string
+      exit;
+    end;
+  end;
+
+  if FullLen < 256 then
+    AsString; // prefer to cache
+
+  if FValueDone and (AStartIndex + ALen <= Length(FValue)) then begin
+    ASubStr := Copy(FValue, AStartIndex, ALen);
+    exit;
+  end;
+
+  if not CheckTypeAndGetAddr(Addr) then
+    exit(False);
+
+
+  if (MemManager.MemLimits.MaxStringLen > 0) and
+     (QWord(ALen) > MemManager.MemLimits.MaxStringLen)
+  then
+    ALen := MemManager.MemLimits.MaxStringLen;
+
+
+  t := TypeInfo;
+  if t.Kind = skWideString then begin
+    {$PUSH}{$Q-}
+    Addr.Address := Addr.Address + (AStartIndex - 1) * 2;
+    {$POP}
+    if not ( (MemManager.SetLength(WResult, ALen)) and
+             (Context.ReadMemory(Addr, SizeVal(ALen*2), @WResult[1])) )
+    then
+      SetLastError(Context.LastMemError)
+    else
+      ASubStr := WResult;
+  end else
+  if Addr.Address = Address.Address + 1 then begin
+    // shortstring
+    {$PUSH}{$Q-}
+    Addr.Address := Addr.Address + AStartIndex - 1;
+    {$POP}
+    if not ( (MemManager.SetLength(ASubStr, ALen)) and
+             (Context.ReadMemory(Addr, SizeVal(ALen), @ASubStr[1])) )
+    then begin
+      ASubStr := '';
+      SetLastError(Context.LastMemError);
+    end;
+  end
+  else begin
+    {$PUSH}{$Q-}
+    Addr.Address := Addr.Address + AStartIndex - 1;
+    {$POP}
+    if not ( (MemManager.SetLength(RResult, ALen)) and
+             (Context.ReadMemory(Addr, SizeVal(ALen), @RResult[1])) )
+    then begin
+      SetLastError(Context.LastMemError);
+    end else begin
+      if ObtainDynamicCodePage(Addr, Codepage) then
+        begin
+        SetCodePage(RResult, Codepage, False);
+        FDynamicCodePage:=Codepage;
+        end;
+      ASubStr := RResult;
+    end;
+  end;
+end;
+
+function TFpValueDwarfV3FreePascalString.GetSubWideString(AStartIndex,
+  ALen: Int64; out ASubStr: WideString; AIgnoreBounds: Boolean): Boolean;
+var
+  WSubStr: AnsiString;
+begin
+  Result := GetSubString(AStartIndex, ALen, WSubStr, AIgnoreBounds);
+  ASubStr := WSubStr;
+end;
+
 function TFpValueDwarfV3FreePascalString.GetAsString: AnsiString;
 var
   t: TFpSymbol;
-  LowBound, HighBound, i: Int64;
-  Addr, Addr2: TFpDbgMemLocation;
+  Len: Int64;
+  Addr: TFpDbgMemLocation;
   WResult: WideString;
   RResult: RawByteString;
-  AttrData: TDwarfAttribData;
   Codepage: TSystemCodePage;
 begin
   if FValueDone then
@@ -1592,68 +1704,45 @@ begin
   Result := '';
   FValueDone := True;
 
+  if not CheckTypeAndGetAddr(Addr) then
+    exit;
+
   // get length
-  t := TypeInfo;
-  if t.NestedSymbolCount < 1 then // subrange type
-    exit;
-
-  GetDwarfDataAddress(Addr);
-  if (not IsValidLoc(Addr)) and
-     (HasTypeCastInfo) and
-     (svfOrdinal in TypeCastSourceValue.FieldFlags)
-  then
-    Addr := TargetLoc(TypeCastSourceValue.AsCardinal);
-  if not IsReadableLoc(Addr) then
-    exit;
-
-
   CalcBounds;
-  LowBound  := FLowBound;
-  HighBound := FHighBound;
-
-  if HighBound < LowBound then
+  if FHighBound < FLowBound then
     exit; // empty string
+  {$PUSH}{$Q-}
+  Len := FHighBound-FLowBound+1;
+  {$POP}
 
-  if MemManager.MemLimits.MaxStringLen > 0 then begin
-    {$PUSH}{$Q-}
-    if QWord(HighBound - LowBound) > MemManager.MemLimits.MaxStringLen then
-      HighBound := LowBound + MemManager.MemLimits.MaxStringLen;
-    {$POP}
-  end;
+  if (MemManager.MemLimits.MaxStringLen > 0) and
+     (QWord(Len) > MemManager.MemLimits.MaxStringLen)
+  then
+      Len := MemManager.MemLimits.MaxStringLen;
 
+
+  t := TypeInfo;
   if t.Kind = skWideString then begin
-    if not MemManager.SetLength(WResult, HighBound-LowBound+1) then begin
-      WResult := '';
-      SetLastError(MemManager.LastError);
-    end
+    if not ( (MemManager.SetLength(WResult, Len)) and
+             (Context.ReadMemory(Addr, SizeVal(Len*2), @WResult[1])) )
+    then
+      SetLastError(Context.LastMemError)
     else
-    if not Context.ReadMemory(Addr, SizeVal((HighBound-LowBound+1)*2), @WResult[1]) then begin
-      WResult := '';
-      SetLastError(Context.LastMemError);
-    end;
-
-    Result := WResult;
+      Result := WResult;
   end else
   if Addr.Address = Address.Address + 1 then begin
     // shortstring
-    if not MemManager.SetLength(Result, HighBound-LowBound+1) then begin
-      Result := '';
-      SetLastError(MemManager.LastError);
-    end
-    else
-    if not Context.ReadMemory(Addr, SizeVal(HighBound-LowBound+1), @Result[1]) then begin
+    if not ( (MemManager.SetLength(Result, Len)) and
+             (Context.ReadMemory(Addr, SizeVal(Len), @Result[1])) )
+    then begin
       Result := '';
       SetLastError(Context.LastMemError);
     end;
   end
   else begin
-    if not MemManager.SetLength(RResult, HighBound-LowBound+1) then begin
-      Result := '';
-      SetLastError(MemManager.LastError);
-    end
-    else
-    if not Context.ReadMemory(Addr, SizeVal(HighBound-LowBound+1), @RResult[1]) then begin
-      Result := '';
+    if not ( (MemManager.SetLength(RResult, Len)) and
+             (Context.ReadMemory(Addr, SizeVal(Len), @RResult[1])) )
+    then begin
       SetLastError(Context.LastMemError);
     end else begin
       if ObtainDynamicCodePage(Addr, Codepage) then
@@ -1811,6 +1900,28 @@ begin
   end;
 end;
 
+function TFpValueDwarfV3FreePascalString.CheckTypeAndGetAddr(out
+  AnAddr: TFpDbgMemLocation): boolean;
+var
+  t: TFpSymbolDwarfType;
+begin
+  Result := False;
+  t := TypeInfo;
+  if t.NestedSymbolCount < 1 then // subrange type
+    exit;
+
+  GetDwarfDataAddress(AnAddr);
+  if (not IsValidLoc(AnAddr)) and
+     (HasTypeCastInfo) and
+     (svfOrdinal in TypeCastSourceValue.FieldFlags)
+  then
+    AnAddr := TargetLoc(TypeCastSourceValue.AsCardinal);
+  if not IsReadableLoc(AnAddr) then
+    exit;
+
+  Result := True;
+end;
+
 { TFpSymbolDwarfFreePascalDataProc }
 
 function TFpSymbolDwarfFreePascalDataProc.GetLine: Cardinal;

components/fpdebug/fpdbginfo.pas

@@ -111,6 +111,7 @@ type
     FEvalFlags: set of (efSizeDone, efSizeUnavail);
     FLastError: TFpError;
     FSize: TFpDbgValueSize;
+    procedure SetAsString(AStartIndex, ALen: Int64; AValue: AnsiString);
   protected
     procedure Reset; virtual; // keeps lastmember and structureninfo
     procedure SetLastError(ALastError: TFpError);
@@ -160,6 +161,17 @@ type
 
     function GetSize(out ASize: TFpDbgValueSize): Boolean; inline;
 
+    (* AsString[AStartIndex, ALen: Int64]
+       - AStartIndex is 1-based
+       - AIgnoreBounds may not be supported by all data types
+       - If AStartIndex/ALen are out of bounds then
+         - Result will be false / LastError will NOT be set
+         - SubStr will contain any part that was in bounds
+       - If Result is false, AND LastError is set: no data was retrieved
+    *)
+    function GetSubString(AStartIndex, ALen: Int64; out ASubStr: AnsiString; AIgnoreBounds: Boolean = False): Boolean; virtual;
+    function GetSubWideString(AStartIndex, ALen: Int64; out ASubStr: WideString; AIgnoreBounds: Boolean = False): Boolean; virtual;
+
     // Kind: determines which types of value are available
     property Kind: TDbgSymbolKind read GetKind;
     property FieldFlags: TFpValueFieldFlags read GetFieldFlags;
@@ -1072,6 +1084,59 @@ begin
   Result := InvalidLoc;
 end;
 
+function TFpValue.GetSubString(AStartIndex, ALen: Int64; out
+  ASubStr: AnsiString; AIgnoreBounds: Boolean): Boolean;
+begin
+  Result := AIgnoreBounds;
+  ASubStr := '';
+  If (ALen < 1) or (AStartIndex < 1) then
+    exit;
+
+  ASubStr := AsString;
+  If ALen = 1 then begin
+    Result := AStartIndex <= Length(ASubStr);
+    if Result then
+      ASubStr := ASubStr[AStartIndex]
+    else
+      ASubStr := '';
+  end
+  else begin
+    Result := AStartIndex + ALen <= Length(ASubStr);
+    ASubStr := Copy(ASubStr, AStartIndex, ALen);
+  end;
+  if AIgnoreBounds then
+    Result := True;
+end;
+
+function TFpValue.GetSubWideString(AStartIndex, ALen: Int64; out
+  ASubStr: WideString; AIgnoreBounds: Boolean): Boolean;
+begin
+  Result := AIgnoreBounds;
+  ASubStr := '';
+  If (ALen < 1) or (AStartIndex < 1) then
+    exit;
+
+  ASubStr := AsWideString;
+  If ALen = 1 then begin
+    Result := AStartIndex <= Length(ASubStr);
+    if Result then
+      ASubStr := ASubStr[AStartIndex]
+    else
+      ASubStr := '';
+  end
+  else begin
+    Result := AStartIndex + ALen <= Length(ASubStr);
+    ASubStr := Copy(ASubStr, AStartIndex, ALen);
+  end;
+  if AIgnoreBounds then
+    Result := True;
+end;
+
+procedure TFpValue.SetAsString(AStartIndex, ALen: Int64; AValue: AnsiString);
+begin
+
+end;
+
 procedure TFpValue.Reset;
 begin
   FEvalFlags := [];

components/fpdebug/fppascalparser.pas

@@ -1510,14 +1510,13 @@ begin
             exit;
           end;
 
-          v := TmpVal.AsString;
-          if (Offs < 1) or (Offs > Length(v)) then begin
+          if (not TmpVal.GetSubString(Offs, 1, v)) or (v = '') then begin
             SetError('Index out of range');
             TmpVal.ReleaseReference;
             exit;
           end;
 
-          TmpVal2 := TFpValueConstChar.Create(v[Offs]);
+          TmpVal2 := TFpValueConstChar.Create(v[1]);
           if TmpVal.TypeInfo <> nil then
             TFpValueConstChar(TmpVal2).SetType(TmpVal.TypeInfo.TypeInfo);
           a := TmpVal.DataAddress;
@@ -1539,14 +1538,13 @@ begin
             exit;
           end;
 
-          w := TmpVal.AsWideString;
-          if (Offs < 1) or (Offs > Length(w)) then begin
+          if (not TmpVal.GetSubWideString(Offs, 1, w)) or (w='') then begin
             SetError('Index out of range');
             TmpVal.ReleaseReference;
             exit;
           end;
 
-          TmpVal2 := TFpValueConstWideChar.Create(w[Offs]);
+          TmpVal2 := TFpValueConstWideChar.Create(w[1]);
           a := TmpVal.DataAddress;
           if IsTargetAddr(a) and IsReadableMem(a) then
             TFpValueConstWideChar(TmpVal2).SetAddress(a + (Offs-1)*2);