paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 05:20:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: Value handling / enum, set

Browse Source 
git-svn-id: trunk@43990 -
This commit is contained in:
martin 2014-02-10 12:36:06 +00:00
parent fbad9f7b85
commit da6195622e
4 changed files with 134 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
components/fpdebug/fpdbgdwarf.pas
View File

@ -598,6 +598,7 @@ type
function MemReader: TFpDbgMemReaderBase; inline;
function AddressSize: Byte; inline;
protected
procedure Reset; virtual;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function HasTypeCastInfo: Boolean;
function IsValidTypeCast: Boolean; virtual;
@ -641,6 +642,7 @@ type
FIntValue: Int64;
FEvaluated: set of (doneUInt, doneInt);
protected
procedure Reset; override;
function GetCardinalValue: QWord;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function IsValidTypeCast: Boolean; override;
@ -706,6 +708,7 @@ type
FMemberValueDone: Boolean;
procedure InitMemberIndex;
protected
procedure Reset; override;
//function IsValidTypeCast: Boolean; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetAsString: AnsiString; override;
@ -724,6 +727,13 @@ type
function IsValidTypeCast: Boolean; override;
end;
{ TDbgDwarfSymbolValueConstNumber }
TDbgDwarfSymbolValueConstNumber = class(TDbgSymbolValueConstNumber)
protected
procedure Update(AValue: QWord; ASigned: Boolean);
end;
{ TDbgDwarfSetSymbolValue }
TDbgDwarfSetSymbolValue = class(TDbgDwarfSizedSymbolValue)
@ -731,14 +741,18 @@ type
FMem: array of Byte;
FMemberCount: Integer;
FMemberMap: array of Integer;
FNumValue: TDbgDwarfSymbolValueConstNumber;
FTypedNumValue: TDbgSymbolValue;
procedure InitMap;
protected
procedure Reset; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetMemberCount: Integer; override;
function GetMember(AIndex: Integer): TDbgSymbolValue; override;
function GetAsCardinal: QWord; override; // only up to qmord
//function IsValidTypeCast: Boolean; override;
public
destructor Destroy; override;
end;
{ TDbgDwarfStructSymbolValue }
@ -748,6 +762,7 @@ type
FDataAddress: TDbgPtr;
FDataAddressDone: Boolean;
protected
procedure Reset; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetAsCardinal: QWord; override;
function GetDataAddress: TDbgPtr; override;
@ -763,6 +778,7 @@ type
FDataAddress: TDbgPtr;
FDataAddressDone: Boolean;
protected
procedure Reset; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetKind: TDbgSymbolKind; override;
function GetAsCardinal: QWord; override;
@ -998,6 +1014,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
procedure InitEnumIdx;
procedure ReadBounds;
protected
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;override;
function GetHasBounds: Boolean; override;
function GetOrdHighBound: Int64; override;
@ -1762,6 +1779,14 @@ begin
end;
end;
{ TDbgDwarfSymbolValueConstNumber }
procedure TDbgDwarfSymbolValueConstNumber.Update(AValue: QWord; ASigned: Boolean);
begin
Signed := ASigned;
Value := AValue;
end;
{ TDbgDwarfSetSymbolValue }
procedure TDbgDwarfSetSymbolValue.InitMap;
@ -1838,6 +1863,12 @@ begin
end;
procedure TDbgDwarfSetSymbolValue.Reset;
begin
inherited Reset;
SetLength(FMem, 0);
end;
function TDbgDwarfSetSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -1864,12 +1895,30 @@ begin
if t = nil then exit;
t := t.TypeInfo;
if t = nil then exit;
assert(t is TDbgDwarfTypeIdentifier, 'TDbgDwarfSetSymbolValue.GetMember t');
if t.Kind = skEnum then begin
Result := t.Member[FMemberMap[AIndex]].Value;
end
else begin
// typecast TDbgSymbolValueConstNumber
if (FNumValue = nil) or (FNumValue.RefCount > 1) then // refcount 1 by FTypedNumValue
FNumValue := TDbgDwarfSymbolValueConstNumber.Create(FMemberMap[AIndex] + t.OrdLowBound, t.Kind = skInteger)
else
begin
FNumValue.Update(FMemberMap[AIndex] + t.OrdLowBound, t.Kind = skInteger);
FNumValue.AddReference;
end;
if (FTypedNumValue = nil) or (FTypedNumValue.RefCount > 1) then begin
FTypedNumValue.ReleaseReference;
FTypedNumValue := t.TypeCastValue(FNumValue)
end
else
TDbgDwarfSymbolValue(FTypedNumValue).SetTypeCastInfo(TDbgDwarfTypeIdentifier(t), FNumValue); // update
FNumValue.ReleaseReference;
Assert((FTypedNumValue <> nil) and (TDbgDwarfSymbolValue(FTypedNumValue).IsValidTypeCast), 'TDbgDwarfSetSymbolValue.GetMember FTypedNumValue');
Assert((FNumValue <> nil) and (FNumValue.RefCount > 0), 'TDbgDwarfSetSymbolValue.GetMember FNumValue');
Result := FTypedNumValue;
end;
end;
@ -1880,6 +1929,12 @@ begin
move(FMem[0], Result, FSize);
end;
destructor TDbgDwarfSetSymbolValue.Destroy;
begin
FTypedNumValue.ReleaseReference;
inherited Destroy;
end;
{ TDbgDwarfSizedSymbolValue }
function TDbgDwarfSizedSymbolValue.ReadMemory(ADest: Pointer): Boolean;
@ -1985,6 +2040,12 @@ begin
FMemberValueDone := True;
end;
procedure TDbgDwarfEnumSymbolValue.Reset;
begin
inherited Reset;
FMemberValueDone := False;
end;
function TDbgDwarfEnumSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -2055,6 +2116,12 @@ end;
{ TDbgDwarfStructSymbolValue }
procedure TDbgDwarfStructSymbolValue.Reset;
begin
inherited Reset;
FDataAddressDone := False;
end;
function TDbgDwarfStructSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -2117,6 +2184,12 @@ end;
{ TDbgDwarfStructSymbolValue }
procedure TDbgDwarfStructTypeCastSymbolValue.Reset;
begin
inherited Reset;
FDataAddressDone := False;
end;
function TDbgDwarfStructTypeCastSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -2366,6 +2439,12 @@ end;
{ TDbgDwarfCardinalSymbolValue }
procedure TDbgDwarfNumericSymbolValue.Reset;
begin
inherited Reset;
FEvaluated := [];
end;
function TDbgDwarfNumericSymbolValue.GetCardinalValue: QWord;
begin
if (FSize <= 0) or (FSize > SizeOf(Result)) then begin
@ -2450,6 +2529,11 @@ begin
Result := FOwner.FCU.FAddressSize;
end;
procedure TDbgDwarfSymbolValue.Reset;
begin
//
end;
function TDbgDwarfSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin
Result := inherited GetFieldFlags;
@ -2580,6 +2664,8 @@ end;
function TDbgDwarfSymbolValue.SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier;
ASource: TDbgSymbolValue): Boolean;
begin
Reset;
if FTypeCastSourceValue <> ASource then begin
if FTypeCastSourceValue <> nil then
FTypeCastSourceValue.ReleaseReference;
@ -4661,6 +4747,17 @@ begin
end;
end;
function TDbgDwarfIdentifierSubRange.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
var
t: TDbgDwarfTypeIdentifier;
begin
t := NestedTypeInfo;
if t <> nil then
Result := t.GetTypedValueObject(ATypeCast)
else
Result := inherited GetTypedValueObject(ATypeCast);
end;
function TDbgDwarfIdentifierSubRange.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;
begin
Result := inherited DoGetNestedTypeInfo;

6
components/fpdebug/fpdbginfo.pas
View File

@ -163,6 +163,8 @@ type
function GetTypeInfo: TDbgSymbol; virtual;
public
constructor Create;
property RefCount;
// Kind: determines which types of value are available
property Kind: TDbgSymbolKind read GetKind;
property FieldFlags: TDbgSymbolValueFieldFlags read GetFieldFlags;
@ -205,12 +207,14 @@ type
FValue: QWord;
FSigned: Boolean;
protected
property Value: QWord read FValue write FValue;
property Signed: Boolean read FSigned write FSigned;
function GetKind: TDbgSymbolKind; override;
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetAsCardinal: QWord; override;
function GetAsInteger: Int64; override;
public
constructor Create(AValue: QWord; ASigned: Boolean = False);
constructor Create(AValue: QWord; ASigned: Boolean = True);
end;
{ TDbgSymbol }

2
components/fpdebug/fppascalparser.pas
View File

@ -1168,7 +1168,7 @@ end;
function TFpPascalExpressionPartConstantNumber.DoGetResultValue: TDbgSymbolValue;
begin
Result := TDbgSymbolValueConstNumber.Create(StrToQWordDef(GetText, 0));
Result := TDbgSymbolValueConstNumber.Create(StrToQWordDef(GetText, 0), False);
{$IFDEF WITH_REFCOUNT_DEBUG}Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF};
end;

34
components/fpdebug/test/testtypeinfo.pas
View File

@ -25,6 +25,8 @@ type
FImageLoader: TTestDummyImageLoader;
FMemReader: TTestMemReader;
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
procedure ExpTestFlags(AVal: TDbgSymbolValue; ATestFlags: TTestFlags = []);
procedure ExpKind(AVal: TDbgSymbolValue; AExpKind: TDbgSymbolKind; TestFlags: TTestFlags = []);
procedure ExpFlags(AVal: TDbgSymbolValue; AExpFlags: TDbgSymbolValueFieldFlags; ExpNotFlags: TDbgSymbolValueFieldFlags = []);
@ -59,6 +61,11 @@ type
implementation
procedure TTestTypeInfo.AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
begin
AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
end;
procedure TTestTypeInfo.ExpTestFlags(AVal: TDbgSymbolValue; ATestFlags: TTestFlags);
var
i: TTestFlag;
@ -146,10 +153,6 @@ end;
procedure TTestTypeInfo.ExpResult(AVal: TDbgSymbolValue; Field: TDbgSymbolValueFieldFlag;
ExpValue: QWord);
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
begin
AssertTrue(AMessage + ComparisonMsg(IntToStr(Expected), IntToStr(Actual)), Expected = Actual);
end;
var
s: string;
begin
@ -939,10 +942,24 @@ procedure TTestTypeInfo.TestExpressionEnumAndSet;
end;
end;
procedure ExpSetOrd(AnIdentList: array of QWord);
var
i: Integer;
m: TDbgSymbolValue;
begin
for i := low(AnIdentList) to high(AnIdentList) do begin
m := FExpression.ResultValue.Member[i];
AssertTrue(FCurrentTestName + 'has member at pos (ord)'+IntToStr(i), m <> nil);
AssertTrue(FCurrentTestName + 'member at pos fieldflag (ord)'+IntToStr(i), svfOrdinal in m.FieldFlags);
AssertEqualsQW(FCurrentTestName + 'member at pos value ord'+IntToStr(i), AnIdentList[i], m.AsCardinal);
end;
end;
var
sym: TDbgSymbol;
ImgLoader: TTestLoaderSetupBasic;
TmpResVal: TDbgSymbolValue;
begin
InitDwarf(TTestLoaderSetupBasic);
ImgLoader := TTestLoaderSetupBasic(FImageLoader);
@ -1090,6 +1107,7 @@ begin
StartTest('VarSet2', skSet, [ttHasType]);
ExpSetVal(3, QWord(Cardinal(ImgLoader.GlobalVar.VarSet2)), TDbgPtr(@ImgLoader.GlobalVar.VarSet2), SizeOf(ImgLoader.GlobalVar.VarSet2));
ExpSetIdent(['e2b', 'e2d', 'e2e']);
ExpSetOrd([1,3,4]);
ImgLoader.GlobalVar.VarSet2 := [];
StartTest('VarSet2', skSet, [ttHasType]);
@ -1111,6 +1129,14 @@ begin
ImgLoader.GlobalVar.VarSetB2 := [5,80];
StartTest('VarSetB2', skSet, [ttHasType], '5,80');
ExpSetVal(2, TDbgPtr(@ImgLoader.GlobalVar.VarSetB2), SizeOf(ImgLoader.GlobalVar.VarSetB2));
ExpSetOrd([5,80]);
TmpResVal := FExpression.ResultValue.Member[0];
AssertEqualsQW(FCurrentTestName + 'TmpResVal', 5, TmpResVal.AsCardinal);
TmpResVal.AddReference;
FExpression.ResultValue.Member[1];
AssertEqualsQW(FCurrentTestName + 'TmpResVal', 5, TmpResVal.AsCardinal);
TmpResVal.ReleaseReference;
ImgLoader.GlobalVar.VarSetB2 := [5..80];
StartTest('VarSetB2', skSet, [ttHasType], '5..80');