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

FPDebug: all class members in values / nil in class

Browse Source 
git-svn-id: trunk@44171 -
This commit is contained in:
martin 2014-02-19 17:56:29 +00:00
parent 1c1300939f
commit 9968ee0c14
4 changed files with 57 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
components/fpdebug/fpdbgdwarf.pas
View File

@ -783,7 +783,6 @@ type
function GetDataAddress: TFpDbgMemLocation; override;
function GetDataSize: Integer; override;
function GetSize: Integer; override;
function GetMemberCount: Integer; override;
end;
{ TDbgDwarfStructTypeCastSymbolValue }
@ -2029,7 +2028,7 @@ begin
if i2 < Cnt then begin
FMemberCount := i2;
debugln(['TDbgDwarfSetSymbolValue.InitMap not enough members']);
debugln(FPDBG_DWARF_WARNINGS, ['TDbgDwarfSetSymbolValue.InitMap not enough members']);
end;
end
else begin
@ -2448,15 +2447,6 @@ begin
Result := -1;
end;
function TDbgDwarfStructSymbolValue.GetMemberCount: Integer;
begin
Result := 0;
if (Kind=skClass) and (GetAsCardinal = 0) then
exit;
Result := inherited GetMemberCount;
end;
{ TDbgDwarfStructSymbolValue }
procedure TDbgDwarfStructTypeCastSymbolValue.Reset;
@ -2627,15 +2617,22 @@ begin
end;
function TDbgDwarfStructTypeCastSymbolValue.GetMemberCount: Integer;
var
ti: TDbgSymbol;
begin
Result := 0;
if not HasTypeCastInfo then
exit;
if (Kind=skClass) and (GetAsCardinal = 0) then
exit;
Result := FTypeCastTargetType.MemberCount;
ti := FTypeCastTargetType;
//TODO: cache result
if ti.Kind in [skClass, skObject] then
while ti.TypeInfo <> nil do begin
ti := ti.TypeInfo;
Result := Result + ti.MemberCount;
end;
end;
{ TDbgDwarfBooleanSymbolValue }
@ -6081,7 +6078,7 @@ begin
FInheritanceInfo.ReadReference(DW_AT_type, FwdInfoPtr, FwdCompUint)
then begin
ParentInfo := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ParentInfo.FInformationEntry, FwdCompUint) ]);
//DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ParentInfo.FInformationEntry, FwdCompUint) ]);
ti := TDbgDwarfIdentifier.CreateSubClass('', ParentInfo);
ParentInfo.ReleaseReference;
end;
@ -8236,6 +8233,7 @@ else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
CU2 := FDwarf.CompilationUnits[i];
if CU2 = CU then
continue;
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier search UNIT Name=', CU2.FileName]);
InfoEntry.ReleaseReference;
InfoEntry := TDwarfInformationEntry.Create(CU2, nil);
@ -8258,6 +8256,8 @@ else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
// only variables are marked "external", but types not / so we may need all top level
Result.ReleaseReference;
Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry);
//DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier MAYBE FOUND Name=', CU2.FileName]);
// DW_AT_visibility ?
if InfoEntry.ReadValue(DW_AT_external, ExtVal) then
if ExtVal <> 0 then
@ -8271,7 +8271,7 @@ else debugln(['TDbgDwarfInfoAddressContext.FindSymbol XXXXXXXXXXXXX no self']);
finally
if (Result = nil) or (InfoEntry = nil)
then DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier NOT found Name=', AName])
else DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found Scope=', dbgs(InfoEntry.FScope, TDbgDwarfIdentifier(Result).FCU), ' Result=', DbgSName(Result), ' ', Result.Name]);
else DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier(',AName,') found Scope=', dbgs(TDbgDwarfIdentifier(Result).FInformationEntry.FScope, TDbgDwarfIdentifier(Result).FCU), ' Result=', DbgSName(Result), ' ', Result.Name, ' in ', TDbgDwarfIdentifier(Result).FCU.FileName]);
ReleaseRefAndNil(InfoEntry);
end;
end;

1
components/fpdebug/fpdmemorytools.pas
View File

@ -201,6 +201,7 @@ type
function ReadAddress(const ALocation: TFpDbgMemLocation; ASize: Cardinal): TFpDbgMemLocation;
function ReadAddressEx(const ALocation: TFpDbgMemLocation; AnAddressSpace: TDbgPtr; ASize: Cardinal): TFpDbgMemLocation;
// ALocation and AnAddress MUST NOT be the same variable on the callers side
function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal;
out AnAddress: TFpDbgMemLocation): Boolean; inline;
//function ReadAddress (const ALocation: TFpDbgMemLocation; ASize: Cardinal;

4
components/fpdebug/fppascalbuilder.pas
View File

@ -525,8 +525,8 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue;
s2 := LineEnding;
if AFlags <> [] then s2 := ' ';;
fl := [ppvSkipClassBody];
if ppvSkipClassBody in AFlags then
fl := [ppvSkipClassBody, ppvSkipRecordBody];
//if ppvSkipClassBody in AFlags then
// fl := [ppvSkipClassBody, ppvSkipRecordBody];
APrintedValue := '';
for i := 0 to AResValue.MemberCount-1 do begin

39
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -1354,13 +1354,50 @@ var
procedure DoClass;
var
m: TDbgSymbolValue;
s, s2, n: String;
s, s2, n, CastName: String;
DBGType: TGDBType;
f: TDBGField;
i: Integer;
ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord;
PasExpr2: TFpPascalExpression;
begin
if (ResValue.Kind = skClass) and (ResValue.AsCardinal = 0) then begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
exit;
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
ATypeInfo.Value.AsString := AResText;
Result := True;
exit;
end;
CastName := '';
if (defClassAutoCast in EvalFlags) then begin
if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin
ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress;
if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin
if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then
if NameLen > 0 then begin
SetLength(CastName, NameLen);
CNameAddr.Address := CNameAddr.Address + 1;
FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]);
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
if PasExpr2.Valid and (PasExpr2.ResultValue <> nil) then begin
PasExpr.Free;
PasExpr := PasExpr2;
ResValue := PasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
end;
end;
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
exit;
if CastName <> '' then AResText := CastName + AResText;
//if PasExpr.ResultValue.Kind = skObject then
// ATypeInfo := TDBGType.Create(skObject, ResTypeName)
//else