From 649eb4e059178b32c7a5dca4d397d1bc2943eb5e Mon Sep 17 00:00:00 2001 From: martin Date: Wed, 23 Oct 2013 13:26:43 +0000 Subject: [PATCH] FPDebug: refactor / more ptype for gdb git-svn-id: trunk@43305 - --- components/fpdebug/fpdbgclasses.pp | 41 ++++- components/fpdebug/fpdbgdwarf.pas | 254 ++++++++++++++++++-------- components/fpdebug/fppascalparser.pas | 1 + debugger/fpgdbmidebugger.pp | 189 ++++++++++++++++--- 4 files changed, 380 insertions(+), 105 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 3b7af45fa3..1d1c695e6f 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -108,7 +108,14 @@ type //-------------------------------------------------------------------------- ); + TDbgSymbolMemberVisibility =( + svPrivate, + svProtected, + svPublic + ); + TDbgSymbolFlag =( + sfInternalRef, // Internal ref/pointer e.g. var/constref parameters //sfPointer, // The sym is a pointer to the reference sfConst, // The sym is a constant and cannot be modified sfVar, @@ -120,7 +127,8 @@ type TDbgSymbolFlags = set of TDbgSymbolFlag; TDbgSymbolField = ( - sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize, sfiTypeInfo + sfiName, sfiKind, sfiSymType, sfiAddress, sfiSize, + sfiTypeInfo, sfiMemberVisibility ); TDbgSymbolFields = set of TDbgSymbolField; @@ -137,6 +145,7 @@ type FAddress: TDbgPtr; FSize: Integer; FTypeInfo: TDbgSymbol; + FMemberVisibility: TDbgSymbolMemberVisibility; function GetSymbolType: TDbgSymbolType; //inline; function GetKind: TDbgSymbolKind; //inline; @@ -144,6 +153,7 @@ type function GetSize: Integer; function GetAddress: TDbgPtr; function GetTypeInfo: TDbgSymbol; + function GetMemberVisibility: TDbgSymbolMemberVisibility; protected // NOT cached fields function GetChild(AIndex: Integer): TDbgSymbol; virtual; @@ -167,6 +177,7 @@ type procedure SetAddress(AValue: TDbgPtr); procedure SetSize(AValue: Integer); procedure SetTypeInfo(AValue: TDbgSymbol); + procedure SetMemberVisibility(AValue: TDbgSymbolMemberVisibility); procedure KindNeeded; virtual; procedure NameNeeded; virtual; @@ -174,6 +185,7 @@ type procedure AddressNeeded; virtual; procedure SizeNeeded; virtual; procedure TypeInfoNeeded; virtual; + procedure MemberVisibilityNeeded; virtual; //procedure Needed; virtual; public constructor Create(const AName: String); @@ -186,14 +198,15 @@ type // Memory; Size is also part of type (byte vs word vs ...) property Address: TDbgPtr read GetAddress; property Size: Integer read GetSize; // In Bytes - // Location - property FileName: String read GetFile; - property Line: Cardinal read GetLine; - property Column: Cardinal read GetColumn; // TypeInfo used by // stValue (Variable): Type // stType: Pointer: type pointed to / Array: Element Type / Func: Result / Class: itheritance property TypeInfo: TDbgSymbol read GetTypeInfo; + property MemberVisibility: TDbgSymbolMemberVisibility read GetMemberVisibility; + // Location + property FileName: String read GetFile; + property Line: Cardinal read GetLine; + property Column: Cardinal read GetColumn; // Methods for structures (record / class) property MemberCount: Integer read GetMemberCount; // inherited NOT included property Member[AIndex: Integer]: TDbgSymbol read GetMember; @@ -956,6 +969,13 @@ begin Result := FTypeInfo; end; +function TDbgSymbol.GetMemberVisibility: TDbgSymbolMemberVisibility; +begin + if not(sfiMemberVisibility in FEvaluatedFields) then + MemberVisibilityNeeded; + Result := FMemberVisibility; +end; + function TDbgSymbol.GetKind: TDbgSymbolKind; begin if not(sfiKind in FEvaluatedFields) then @@ -1032,6 +1052,12 @@ begin FTypeInfo.AddReference; end; +procedure TDbgSymbol.SetMemberVisibility(AValue: TDbgSymbolMemberVisibility); +begin + FMemberVisibility := AValue; + Include(FEvaluatedFields, sfiMemberVisibility); +end; + procedure TDbgSymbol.SetName(AValue: String); begin FName := AValue; @@ -1108,6 +1134,11 @@ begin SetTypeInfo(nil); end; +procedure TDbgSymbol.MemberVisibilityNeeded; +begin + SetMemberVisibility(svPrivate); +end; + {$ifdef windows} { TDbgBreak } diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index db4ee5a128..c7524be951 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -514,6 +514,7 @@ type function GetNestedTypeInfo: TDbgDwarfTypeIdentifier; protected function ReadName(out AName:String): Boolean; + function ReadMemberVisibility(out AMemberVisibility: TDbgSymbolMemberVisibility): Boolean; procedure NameNeeded; override; procedure TypeInfoNeeded; override; @@ -543,6 +544,7 @@ type TDbgDwarfValueIdentifier = class(TDbgDwarfIdentifier) // var, const, member, ... protected procedure KindNeeded; override; + procedure MemberVisibilityNeeded; override; procedure Init; override; end; @@ -594,6 +596,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier) protected procedure Init; override; + procedure MemberVisibilityNeeded; override; public class function CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier; end; @@ -614,16 +617,31 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line procedure KindNeeded; override; procedure NameNeeded; override; procedure TypeInfoNeeded; override; // forward + procedure MemberVisibilityNeeded; override; function GetMember(AIndex: Integer): TDbgSymbol; override; function GetMemberByName(AIndex: String): TDbgSymbol; override; function GetMemberCount: Integer; override; end; + { TDbgDwarfTypeIdentifierRef } + + TDbgDwarfTypeIdentifierRef = class(TDbgDwarfTypeIdentifierModifier) + protected + function GetFlags: TDbgSymbolFlags; override; + end; + { TDbgDwarfTypeIdentifierDeclaration } TDbgDwarfTypeIdentifierDeclaration = class(TDbgDwarfTypeIdentifierModifier) protected + procedure KindNeeded; override; + // fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers) + // typedef > pointer > srtuct + // while a pointer to class/object: pointer > typedef > .... + function GetMember(AIndex: Integer): TDbgSymbol; override; + function GetMemberByName(AIndex: String): TDbgSymbol; override; + function GetMemberCount: Integer; override; end; { TDbgDwarfTypeIdentifierPointer } @@ -631,10 +649,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TDbgDwarfTypeIdentifierPointer = class(TDbgDwarfTypeIdentifier) protected procedure KindNeeded; override; - // fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers) - function GetMember(AIndex: Integer): TDbgSymbol; override; - function GetMemberByName(AIndex: String): TDbgSymbol; override; - function GetMemberCount: Integer; override; end; TDbgDwarfIdentifierMember = class(TDbgDwarfValueIdentifier) @@ -673,7 +687,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line { TDbgDwarfProcSymbol } - TDbgDwarfProcSymbol = class(TDbgDwarfIdentifier) + TDbgDwarfProcSymbol = class(TDbgDwarfValueIdentifier) private //FCU: TDwarfCompilationUnit; FAddress: TDbgPtr; @@ -1203,6 +1217,80 @@ begin end; end; +{ TDbgDwarfTypeIdentifierRef } + +function TDbgDwarfTypeIdentifierRef.GetFlags: TDbgSymbolFlags; +begin + Result := (inherited GetFlags) + [sfInternalRef]; +end; + +{ TDbgDwarfTypeIdentifierPointer } + +procedure TDbgDwarfTypeIdentifierPointer.KindNeeded; +begin + SetKind(skPointer); +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; +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.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] + 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 + else + Result := inherited GetMemberCount; +end; + { TDbgDwarfValueIdentifier } procedure TDbgDwarfValueIdentifier.KindNeeded; @@ -1216,6 +1304,19 @@ begin SetKind(t.Kind); end; +procedure TDbgDwarfValueIdentifier.MemberVisibilityNeeded; +var + Val: TDbgSymbolMemberVisibility; +begin + if ReadMemberVisibility(Val) then + SetMemberVisibility(Val) + else + if TypeInfo <> nil then + SetMemberVisibility(TypeInfo.MemberVisibility) + else + inherited MemberVisibilityNeeded; +end; + procedure TDbgDwarfValueIdentifier.Init; begin inherited Init; @@ -1317,6 +1418,7 @@ procedure TDbgDwarfIdentifierStructure.CreateMembers; var Info: TDwarfInformationEntry; Info2: TDwarfInformationEntry; + sym: TDbgDwarfIdentifier; begin if FMembers <> nil then exit; @@ -1325,9 +1427,13 @@ begin Info.GoChild; while Info.HasValidScope do begin - Info2 := Info.Clone; - FMembers.Add(TDbgDwarfIdentifier.CreateSubClass('', Info2)); - Info2.ReleaseReference; + if (Info.Abbrev.tag = DW_TAG_member) or (Info.Abbrev.tag = DW_TAG_subprogram) then begin + Info2 := Info.Clone; + sym := TDbgDwarfIdentifier.CreateSubClass('', Info2); + FMembers.Add(sym); + sym.ReleaseReference; + Info2.ReleaseReference; + end; Info.GoNext; end; @@ -1339,7 +1445,15 @@ begin if (FInformationEntry.Abbrev.tag = DW_TAG_class_type) then SetKind(skClass) else - SetKind(skRecord); + begin + if TypeInfo <> nil then + SetKind(skClass) + else + if MemberByName['_vptr$OBJECT'] <> nil then + SetKind(skClass) + else + SetKind(skRecord); + end; end; procedure TDbgDwarfIdentifierStructure.TypeInfoNeeded; @@ -1358,7 +1472,9 @@ begin ti.SearchScope; DebugLn(FPDBG_DWARF_SEARCH, ['Inherited from ', dbgs(ti.FScope, FwdCompUint) ]); end; - SetTypeInfo(TDbgDwarfIdentifier.CreateSubClass('', ti)); + if ti = nil + then SetTypeInfo(nil) + else SetTypeInfo(TDbgDwarfIdentifier.CreateSubClass('', ti)); ReleaseRefAndNil(NewInfo); ReleaseRefAndNil(ti); end; @@ -1400,6 +1516,19 @@ begin else SetTypeInfo(nil); end; +procedure TDbgDwarfTypeIdentifierModifier.MemberVisibilityNeeded; +var + Val: TDbgSymbolMemberVisibility; +begin + if ReadMemberVisibility(Val) then + SetMemberVisibility(Val) + else + if NestedTypeInfo <> nil then + SetMemberVisibility(NestedTypeInfo.MemberVisibility) + else + inherited MemberVisibilityNeeded; +end; + function TDbgDwarfTypeIdentifierModifier.GetMember(AIndex: Integer): TDbgSymbol; var ti: TDbgSymbol; @@ -1439,62 +1568,6 @@ begin Result := inherited GetMemberCount; end; -{ TDbgDwarfTypeIdentifierPointer } - -procedure TDbgDwarfTypeIdentifierPointer.KindNeeded; -var - ti: TDbgSymbol; -begin - ti := TypeInfo; - // todo if ti.kind = skclass.... but not if it is another pointer. - // fpc encodes classes as pointer, not ref (so Obj1 = obj2 compares the pointers) - if (ti <> nil) and (ti is TDbgDwarfIdentifierStructure) - // and (TDbgDwarfTypeIdentifier(ti).InformationEntry.Abbrev.tag = DW_TAG_class_type) - then - SetKind(skClass) - else - SetKind(skPointer); -end; - -function TDbgDwarfTypeIdentifierPointer.GetMember(AIndex: Integer): TDbgSymbol; -var - ti: TDbgSymbol; -begin - ti := nil; - if (Kind = skClass) then - ti := TypeInfo; - if ti <> nil then - Result := ti.Member[AIndex] - else - Result := inherited GetMember(AIndex); -end; - -function TDbgDwarfTypeIdentifierPointer.GetMemberByName(AIndex: String): TDbgSymbol; -var - ti: TDbgSymbol; -begin - ti := nil; - if (Kind = skClass) then - ti := TypeInfo; - if ti <> nil then - Result := ti.MemberByName[AIndex] - else - Result := inherited GetMemberByName(AIndex); -end; - -function TDbgDwarfTypeIdentifierPointer.GetMemberCount: Integer; -var - ti: TDbgSymbol; -begin - ti := nil; - if (Kind = skClass) then - ti := TypeInfo; - if ti <> nil then - Result := ti.MemberCount - else - Result := inherited GetMemberCount; -end; - { TDbgDwarfBaseTypeIdentifier } procedure TDbgDwarfBaseIdentifierBase.KindNeeded; @@ -1541,6 +1614,16 @@ begin SetSymbolType(stType); end; +procedure TDbgDwarfTypeIdentifier.MemberVisibilityNeeded; +var + Val: TDbgSymbolMemberVisibility; +begin + if ReadMemberVisibility(Val) then + SetMemberVisibility(Val) + else + inherited MemberVisibilityNeeded; +end; + class function TDbgDwarfTypeIdentifier.CreateTybeSubClass(AName: String; AnInformationEntry: TDwarfInformationEntry): TDbgDwarfTypeIdentifier; var @@ -1916,6 +1999,27 @@ begin Result := FInformationEntry.ReadValue(DW_AT_name, AName); end; +function TDbgDwarfIdentifier.ReadMemberVisibility(out + AMemberVisibility: TDbgSymbolMemberVisibility): Boolean; +var + Val: Integer; +begin + Result := FInformationEntry.ReadValue(DW_AT_external, Val); + if Result and (Val <> 0) then begin + AMemberVisibility := svPublic; + exit; + end; + + Result := FInformationEntry.ReadValue(DW_AT_accessibility, Val); + if not Result then exit; + case Val of + DW_ACCESS_private: AMemberVisibility := svPrivate; + DW_ACCESS_protected: AMemberVisibility := svProtected; + DW_ACCESS_public: AMemberVisibility := svPublic; + else AMemberVisibility := svPrivate; + end; +end; + procedure TDbgDwarfIdentifier.NameNeeded; var AName: String; @@ -1943,18 +2047,20 @@ begin DW_TAG_base_type: Result := TDbgDwarfBaseIdentifierBase; DW_TAG_typedef: Result := TDbgDwarfTypeIdentifierDeclaration; DW_TAG_pointer_type: Result := TDbgDwarfTypeIdentifierPointer; + DW_TAG_reference_type: Result := TDbgDwarfTypeIdentifierRef; DW_TAG_packed_type, DW_TAG_const_type, DW_TAG_volatile_type: Result := TDbgDwarfTypeIdentifierModifier; - DW_TAG_reference_type, DW_TAG_string_type, - DW_TAG_enumeration_type, DW_TAG_subroutine_type, + DW_TAG_enumeration_type, DW_TAG_union_type, DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type, DW_TAG_file_type, DW_TAG_thrown_type: Result := TDbgDwarfTypeIdentifier; DW_TAG_structure_type, DW_TAG_class_type: Result := TDbgDwarfIdentifierStructure; DW_TAG_array_type: Result := TDbgDwarfIdentifierArray; + DW_TAG_subroutine_type: Result := TDbgDwarfTypeIdentifier; + DW_TAG_subprogram: Result := TDbgDwarfProcSymbol; else Result := TDbgDwarfIdentifier; @@ -2786,17 +2892,15 @@ begin inherited Create( String(FAddressInfo^.Name), - InfoEntry, - skProcedure, //todo: skFunction - FAddressInfo^.StartPC + InfoEntry ); + SetAddress(FAddressInfo^.StartPC); + InfoEntry.ReleaseReference; //BuildLineInfo( // AFile: String = ''; ALine: Integer = -1; AFlags: TDbgSymbolFlags = []; const AReference: TDbgSymbol = nil); - - end; destructor TDbgDwarfProcSymbol.Destroy; @@ -2886,7 +2990,7 @@ end; procedure TDbgDwarfProcSymbol.KindNeeded; begin - if NestedTypeInfo <> nil then + if TypeInfo <> nil then SetKind(skFunction) else SetKind(skProcedure); @@ -3009,7 +3113,7 @@ begin if InfoEntry.GoNamedChild(AName) then begin Result := TDbgDwarfIdentifier.CreateSubClass(AName, InfoEntry); - DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier faund ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]); + DebugLn(FPDBG_DWARF_SEARCH, ['TDbgDwarf.FindIdentifier found ', dbgs(InfoEntry.FScope, CU), DbgSName(Result)]); break; end; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 73c1601eeb..e97e7ecb4f 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -1442,6 +1442,7 @@ begin if Count <> 2 then exit; tmp := Items[0].ResultType; + if tmp = nil then exit; // Todo unit if (tmp.Kind = skClass) or (tmp.Kind = skRecord) then begin tmp := tmp.MemberByName[Items[1].GetText]; diff --git a/debugger/fpgdbmidebugger.pp b/debugger/fpgdbmidebugger.pp index 50303bcd2d..541cbfb227 100644 --- a/debugger/fpgdbmidebugger.pp +++ b/debugger/fpgdbmidebugger.pp @@ -148,6 +148,76 @@ const GdbCmdPType = 'ptype '; GdbCmdWhatIs = 'whatis '; + Function MembersAsGdbText(AStructType: TDbgSymbol; WithVisibilty: Boolean; out AText: String): Boolean; + var + CurVis: TDbgSymbolMemberVisibility; + + procedure AddVisibility(AVis: TDbgSymbolMemberVisibility); + begin + CurVis := AVis; + if not WithVisibilty then + exit; + case AVis of + svPrivate: AText := AText + ' private' + LineEnding; + svProtected: AText := AText + ' protected' + LineEnding; + svPublic: AText := AText + ' public' + LineEnding; + end; + end; + + procedure AddMember(AMember: TDbgSymbol); + var + ti: TDbgSymbol; + s: String; + begin +//todo: functions / virtual / array ... + if AMember.Kind = FpDbgClasses.skProcedure then begin + AText := AText + ' procedure ' + AMember.Name + ' ();' + LineEnding; + exit + end; + + ti := AMember.TypeInfo; + if ti = nil then begin + Result := False; + exit; + end; + s := ti.Name; + if s = '' then begin + Result := False; + exit; + end; + + if AMember.Kind = FpDbgClasses.skFunction then begin + AText := AText + ' function ' + AMember.Name + ' () : '+s+';' + LineEnding; + end + else + begin + AText := AText + ' ' + AMember.Name + ' : ' + s + LineEnding; + end; + end; + + var + c: Integer; + i: Integer; + m: TDbgSymbol; + begin + Result := True; + AText := ''; + c := AStructType.MemberCount; + if c = 0 then + exit; + i := 0; + m := AStructType.Member[i]; + AddVisibility(m.MemberVisibility); + while true do begin + if m.MemberVisibility <> CurVis then + AddVisibility(m.MemberVisibility); + AddMember(m); + inc(i); + if (i >= c) or (not Result) then break; + m := AStructType.Member[i]; + end; + end; + procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String); var AReq: TGDBPTypeRequest; @@ -161,54 +231,123 @@ const end; end; + procedure AddClassType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean; + ABaseTypeName, ASrcTypeName, ADeRefTypeName: String; + ASrcType, ABaseType: TDbgSymbol); + var + s, ParentName, RefToken: String; + s2: String; + begin + if not AIsPointerType then begin + ABaseType := ASrcType; + ABaseTypeName := ASrcTypeName; + ADeRefTypeName := ASrcTypeName; + end; + if (ABaseType = nil) or (ABaseType.TypeInfo = nil) then + exit; + ParentName := ABaseType.TypeInfo.Name; + if not MembersAsGdbText(ABaseType, True, s2) then + exit; + + s := Format('type = ^%s = class : public %s %s%send%s', [ABaseTypeName, ParentName, LineEnding, s2, LineEnding]); + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s); + + s := Format('type = %s%s', [ASrcTypeName, LineEnding]); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s); + + + ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^'; + if AIsPointerType + then RefToken := '^' + else RefToken := ''; + s := Format('type = %s%s = class : public %s %s%send%s', [RefToken, ABaseTypeName, ParentName, LineEnding, s2, LineEnding]); + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s); + + s := Format('type = %s%s', [ADeRefTypeName, LineEnding]); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s); + end; + + procedure AddRecordType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean; + ABaseTypeName, ASrcTypeName, ADeRefTypeName: String; + ASrcType, ABaseType: TDbgSymbol); + begin + end; + + procedure AddBaseType(ASourceExpr: string; AIsPointerType, AisPointerPointer: Boolean; + ABaseTypeName, ASrcTypeName, ADeRefTypeName: String; + ASrcType, ABaseType: TDbgSymbol +); + begin + if AIsPointerType then begin + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [ABaseTypeName])); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ASrcTypeName])); + ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr); + if AIsPointerPointer then begin + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [ABaseTypeName])); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ADeRefTypeName])); + end + else begin + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [ABaseTypeName])); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ABaseTypeName])); + end; + end + else begin + MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [ABaseTypeName])); + MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ABaseTypeName])); + end; + end; + procedure AddType(ASourceExpr: string; ATypeIdent: TDbgSymbol); var - TypeName, PointedName, PointedName2: String; + SrcTypeName, // The expressions own type name + DeRefTypeName, // one levvel of pointer followed + BaseTypeName: String; // all poiters followed IsPointerPointer: Boolean; IsPointerType: Boolean; + SrcType: TDbgSymbol; begin if (ASourceExpr = '') or (ATypeIdent = nil) then exit; IsPointerType := ATypeIdent.Kind = FpDbgClasses.skPointer; - PointedName := ATypeIdent.Name; + IsPointerPointer := False; + SrcTypeName := ATypeIdent.Name; + SrcType := ATypeIdent; if IsPointerType and (ATypeIdent.TypeInfo <> nil) then begin ATypeIdent := ATypeIdent.TypeInfo; if ATypeIdent = nil then exit; // resolved 1st pointer - if PointedName = '' then - PointedName := '^'+ATypeIdent.Name; + if SrcTypeName = '' then + SrcTypeName := '^'+ATypeIdent.Name; IsPointerPointer := ATypeIdent.Kind = FpDbgClasses.skPointer; - PointedName2 := ATypeIdent.Name; + DeRefTypeName := ATypeIdent.Name; while (ATypeIdent.Kind = FpDbgClasses.skPointer) and (ATypeIdent.TypeInfo <> nil) do begin ATypeIdent := ATypeIdent.TypeInfo; - if PointedName = '' then PointedName := '^'+ATypeIdent.Name; - if PointedName2 = '' then PointedName2 := '^'+ATypeIdent.Name; + if SrcTypeName = '' then SrcTypeName := '^'+ATypeIdent.Name; + if DeRefTypeName = '' then DeRefTypeName := '^'+ATypeIdent.Name; end; if ATypeIdent = nil then exit; end; - TypeName := ATypeIdent.Name; + BaseTypeName := ATypeIdent.Name; +DebugLn(['--------------'+dbgs(ATypeIdent.Kind), ' ', dbgs(IsPointerType)]); if ATypeIdent.Kind in [skInteger, skCardinal, skBoolean, skChar, skFloat] then begin - if IsPointerType then begin - MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [TypeName])); - MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [PointedName])); - ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr); - if IsPointerPointer then begin - MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [TypeName])); - MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [PointedName2])); - end - else begin - MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [TypeName])); - MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [TypeName])); - end; - end - else begin - MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [TypeName])); - MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [TypeName])); - end; + AddBaseType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName, + SrcTypeName, DeRefTypeName, SrcType, ATypeIdent); + end + else + if ATypeIdent.Kind in [FpDbgClasses.skClass] + then begin + AddClassType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName, + SrcTypeName, DeRefTypeName, SrcType, ATypeIdent); + end + else + if ATypeIdent.Kind in [FpDbgClasses.skRecord] + then begin + AddRecordType(ASourceExpr, IsPointerType, IsPointerPointer, BaseTypeName, + SrcTypeName, DeRefTypeName, SrcType, ATypeIdent); end; end;