paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 11:19:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Fixed Array of String for dwarf-3

Browse Source 
git-svn-id: trunk@59872 -
This commit is contained in:
martin 2018-12-20 01:11:42 +00:00
parent 4d4aa06706
commit 78ffec8934
2 changed files with 73 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
components/fpdebug/fpdbgdwarf.pas
View File

@ -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;

51
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -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;