paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-05 22:40:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

FPDebug: refactor / more ptype for gdb

Browse Source 
git-svn-id: trunk@43310 -
This commit is contained in:
martin 2013-10-23 22:18:09 +00:00
parent 89a45ba046
commit 5784fea1bb
2 changed files with 63 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
components/fpdebug/fpdbgdwarf.pas
View File

@ -635,6 +635,8 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
{ TDbgDwarfTypeIdentifierDeclaration }
TDbgDwarfTypeIdentifierDeclaration = class(TDbgDwarfTypeIdentifierModifier)
private
function IsClass: Boolean;
protected
procedure KindNeeded; override;
// fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers)
@ -1248,60 +1250,48 @@ end;
{ TDbgDwarfTypeIdentifierDeclaration }
procedure TDbgDwarfTypeIdentifierDeclaration.KindNeeded;
var
ti: TDbgDwarfTypeIdentifier;
ti2: TDbgSymbol;
begin
ti := NestedTypeInfo;
if (ti <> nil) and (ti.Kind = skPointer) then begin
// maybe a class
ti2 := TypeInfo;
// only if ti2 is NOT a declaration
if (ti2 <> nil) and (ti2 is TDbgDwarfIdentifierStructure) then begin
SetKind(skClass);
exit;
end;
end;
inherited KindNeeded;
end;
function TDbgDwarfTypeIdentifierDeclaration.GetMember(AIndex: Integer): TDbgSymbol;
function TDbgDwarfTypeIdentifierDeclaration.IsClass: Boolean;
var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then // this has a nested pointer, to a class
Result := False;
ti := NestedTypeInfo;
if (ti <> nil) and (ti.Kind = skPointer) then begin
ti := TypeInfo;
if ti <> nil then
Result := ti.Member[AIndex]
// only if it is NOT a declaration
if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure) then
Result := True;
end;
end;
procedure TDbgDwarfTypeIdentifierDeclaration.KindNeeded;
begin
if IsClass then
SetKind(skClass)
else
inherited KindNeeded;
end;
function TDbgDwarfTypeIdentifierDeclaration.GetMember(AIndex: Integer): TDbgSymbol;
begin
if IsClass then
Result := TypeInfo.Member[AIndex]
else
Result := inherited GetMember(AIndex);
end;
function TDbgDwarfTypeIdentifierDeclaration.GetMemberByName(AIndex: String): TDbgSymbol;
var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then // this has a nested pointer, to a class
ti := TypeInfo;
if ti <> nil then
Result := ti.MemberByName[AIndex]
if IsClass then
Result := TypeInfo.MemberByName[AIndex]
else
Result := inherited GetMemberByName(AIndex);
end;
function TDbgDwarfTypeIdentifierDeclaration.GetMemberCount: Integer;
var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then // this has a nested pointer, to a class
ti := TypeInfo;
if ti <> nil then
Result := ti.MemberCount
if IsClass then
Result := TypeInfo.MemberCount
else
Result := inherited GetMemberCount;
end;
@ -1548,7 +1538,7 @@ var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then
if (Kind = skClass) or (Kind = skRecord) then
ti := NestedTypeInfo;
if ti <> nil then
Result := ti.Member[AIndex]
@ -1561,7 +1551,7 @@ var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then
if (Kind = skClass) or (Kind = skRecord) then
ti := NestedTypeInfo;
if ti <> nil then
Result := ti.MemberByName[AIndex]
@ -1574,7 +1564,7 @@ var
ti: TDbgSymbol;
begin
ti := nil;
if (Kind = skClass) then
if (Kind = skClass) or (Kind = skRecord) then
ti := NestedTypeInfo;
if ti <> nil then
Result := ti.MemberCount

33
debugger/fpgdbmidebugger.pp
View File

@ -191,7 +191,7 @@ const
end
else
begin
AText := AText + ' ' + AMember.Name + ' : ' + s + LineEnding;
AText := AText + ' ' + AMember.Name + ' : ' + s + ';' + LineEnding;
end;
end;
@ -270,7 +270,38 @@ const
procedure AddRecordType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean;
ABaseTypeName, ASrcTypeName, ADeRefTypeName: String;
ASrcType, ABaseType: TDbgSymbol);
var
s, RefToken: String;
s2: String;
begin
if not AIsPointerType then begin
ABaseType := ASrcType;
ABaseTypeName := ASrcTypeName;
ADeRefTypeName := ASrcTypeName;
end;
if (ABaseType = nil) then
exit;
if not MembersAsGdbText(ABaseType, False, s2) then
exit;
if AIsPointerType
then RefToken := '^'
else RefToken := '';
s := Format('type = %s%s = record %s%send%s', [RefToken, ABaseTypeName, LineEnding, s2, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
if AIsPointerType then begin
s := Format('type = %s%s', [ASrcTypeName, LineEnding]);
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
//ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
//if AisPointerPointer
//then RefToken := '^'
//else RefToken := '';
//s := Format('type = %s%s = record %s%send%s', [RefToken, ABaseTypeName, LineEnding, s2, LineEnding]);
//MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
end;
end;
procedure AddBaseType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean;