diff --git a/components/debuggerintf/dbgintfdebuggerbase.pp b/components/debuggerintf/dbgintfdebuggerbase.pp index db1f5f49e5..ae966a07d7 100644 --- a/components/debuggerintf/dbgintfdebuggerbase.pp +++ b/components/debuggerintf/dbgintfdebuggerbase.pp @@ -492,6 +492,8 @@ type { TDBGType } TDBGType = class(TObject) + private + function GetFields: TDBGFields; protected FAncestor: String; FResult: TDBGType; @@ -515,7 +517,7 @@ type destructor Destroy; override; property Ancestor: String read FAncestor; property Arguments: TDBGTypes read FArguments; - property Fields: TDBGFields read FFields; + property Fields: TDBGFields read GetFields; property Kind: TDBGSymbolKind read FKind; property Attributes: TDBGSymbolAttributes read FAttributes; property TypeName: String read FTypeName; // Name/Alias as in type section. One pascal token, or empty @@ -2482,6 +2484,13 @@ end; { TDBGPType } +function TDBGType.GetFields: TDBGFields; +begin + if FFields = nil then + FFields := TDBGFields.Create; + Result := FFields; +end; + procedure TDBGType.Init; begin // diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index e9b03f3a73..01faf8d309 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -1191,6 +1191,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line procedure TypeInfoNeeded; override; // nil or inherited function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override; + // GetMember, if AIndex > Count then parent function GetMember(AIndex: Integer): TDbgSymbol; override; function GetMemberByName(AIndex: String): TDbgSymbol; override; function GetMemberCount: Integer; override; @@ -2653,7 +2654,7 @@ begin if FSize <> 1 then Result := inherited GetAsString else - Result := char(byte(GetAsCardinal)); + Result := SysToUTF8(char(byte(GetAsCardinal))); end; function TDbgDwarfCharSymbolValue.GetAsWideString: WideString; @@ -5575,8 +5576,15 @@ var ti: TDbgSymbol; begin ti := TypeInfo; - if ti <> nil then - Result := ti.MemberCount + if ti <> nil then begin + Result := ti.MemberCount; + //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 else Result := inherited GetMemberCount; end; @@ -5948,9 +5956,17 @@ begin end; function TDbgDwarfIdentifierStructure.GetMember(AIndex: Integer): TDbgSymbol; +var + ti: TDbgSymbol; begin CreateMembers; - Result := TDbgSymbol(FMembers[AIndex]); + if AIndex >= FMembers.Count then begin + ti := TypeInfo; + if ti <> nil then + Result := ti.Member[AIndex - FMembers.Count]; + end + else + Result := TDbgSymbol(FMembers[AIndex]); end; destructor TDbgDwarfIdentifierStructure.Destroy; diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 8627c8e719..ed90b76e40 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -148,7 +148,7 @@ type (* Member: * skClass, skStructure: stType: it excludes BaseClass (TODO: decide?) - stValue: ??? + stValue: includes * skSet stType: all members stValue: only members set in value (Only impremented for DbgSymbolValue) @@ -293,7 +293,7 @@ type (* Member: * skClass, skStructure: stType: it excludes BaseClass (TODO: decide?) - stValue: ??? + includes * skSet stType: all members stValue: only members set in value (Only impremented for DbgSymbolValue) diff --git a/components/fpdebug/fppascalbuilder.pas b/components/fpdebug/fppascalbuilder.pas index b3f2c23012..b46d49ba39 100644 --- a/components/fpdebug/fppascalbuilder.pas +++ b/components/fpdebug/fppascalbuilder.pas @@ -5,7 +5,7 @@ unit FpPascalBuilder; interface uses - Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo; + Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, LazLoggerBase; type TTypeNameFlag = ( @@ -27,7 +27,9 @@ type ); TTypeDeclarationFlags = set of TTypeDeclarationFlag; - TPrintPasValFlag = (dummyx1); + TPrintPasValFlag = ( + ppvSkipClassBody, ppvSkipRecordBody + ); TPrintPasValFlags = set of TPrintPasValFlag; function GetTypeName(out ATypeName: String; ADbgSymbol: TDbgSymbol; AFlags: TTypeNameFlags = []): Boolean; @@ -474,16 +476,69 @@ function PrintPasValue(out APrintedValue: String; AResValue: TDbgSymbolValue; var s: String; i: Integer; + m: TDbgSymbolValue; begin APrintedValue := ''; - for i := 0 to AResValue.MemberCount-1 do - if i = 0 - then APrintedValue := AResValue.Member[i].AsString - else APrintedValue := APrintedValue + ', ' + AResValue.Member[i].AsString; + for i := 0 to AResValue.MemberCount-1 do begin + m := AResValue.Member[i]; + if svfIdentifier in m.FieldFlags then + s := m.AsString + else + if svfOrdinal in m.FieldFlags then // set of byte + s := IntToStr(m.AsCardinal) + else + Continue; // Todo: missing member + if APrintedValue = '' + then APrintedValue := s + else APrintedValue := APrintedValue + ', ' + s; + end; APrintedValue := '[' + APrintedValue + ']'; Result := True; end; + procedure DoStructure; + var + s, s2: String; + i: Integer; + m: TDbgSymbolValue; + fl: TPrintPasValFlags; + begin + if ( (AResValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or + ( (AResValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) ) + then begin + APrintedValue := ResTypeName; + case AResValue.Kind of + skRecord: APrintedValue := '{record:}' + APrintedValue; + skObject: APrintedValue := '{object:}' + APrintedValue; + skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AResValue.AsCardinal, AnAddrSize) + ')'; + end; + Result := True; + exit; + end; + + s2 := LineEnding; + if AFlags <> [] then s2 := ' ';; + fl := [ppvSkipClassBody]; + if ppvSkipClassBody in AFlags then + fl := [ppvSkipClassBody, ppvSkipRecordBody]; + + APrintedValue := ''; + for i := 0 to AResValue.MemberCount-1 do begin + m := AResValue.Member[i]; + if (m = nil) or (m.Kind in [skProcedure, skFunction]) then + continue; + s := ''; + PrintPasValue(s, m, AnAddrSize, fl); + if m.DbgSymbol <> nil then + s := m.DbgSymbol.Name + ' = ' + s; + if APrintedValue = '' + then APrintedValue := s + else APrintedValue := APrintedValue + '; ' + s2 + s; + end; + APrintedValue := '(' + APrintedValue + ')'; + Result := True; + end; + begin Result := False; case AResValue.Kind of @@ -504,9 +559,9 @@ begin skEnum: DoEnum; skEnumValue: DoEnumVal; skSet: DoSet; - skRecord: ; - skObject: ; - skClass: ; + skRecord: DoStructure; + skObject: DoStructure; + skClass: DoStructure; skInterface: ; skArray: ; end; diff --git a/components/lazdebuggerfp/fpgdbmidebugger.pp b/components/lazdebuggerfp/fpgdbmidebugger.pp index ecf2a98f7d..b193324dcc 100644 --- a/components/lazdebuggerfp/fpgdbmidebugger.pp +++ b/components/lazdebuggerfp/fpgdbmidebugger.pp @@ -226,7 +226,7 @@ begin ADest, ASize, BytesRead) and (BytesRead = ASize); -DebugLn(['*&*&*&*& ReadMem ', dbgs(Result), ' at ', AnAddress, ' Size ',ASize, ' br=',BytesRead, ' b1',PBYTE(ADest)^]); +//DebugLn(['*&*&*&*& ReadMem ', dbgs(Result), ' at ', AnAddress, ' Size ',ASize, ' br=',BytesRead, ' b1',PBYTE(ADest)^]); {$ELSE} Result := inherited ReadMemory(AnAddress, ASize, ADest); {$ENDIF} @@ -886,10 +886,11 @@ var Result := (FWatchEvalList.Count > 0) and (FWatchEvalList[0] = Pointer(WatchValue)); end; - function ResTypeName: String; + function ResTypeName(v: TDbgSymbolValue = nil): String; begin - if not((ResValue.TypeInfo<> nil) and - GetTypeName(Result, ResValue.TypeInfo, [])) + if v = nil then v := ResValue; + if not((v.TypeInfo<> nil) and + GetTypeName(Result, v.TypeInfo, [])) then Result := ''; end; @@ -898,7 +899,7 @@ var begin if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then exit; - ResTypeInfo := TDBGType.Create(skSimple, ResTypeName); // TODO, IDE must learn pointer + ResTypeInfo := TDBGType.Create(skPointer, ResTypeName); ResTypeInfo.Value.AsString := ResText; //ResTypeInfo.Value.AsPointer := ; // ??? end; @@ -927,6 +928,57 @@ var ResTypeInfo.Value.AsString := ResText; end; + procedure DoRecord; + begin + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skRecord, ResTypeName); + ResTypeInfo.Value.AsString := ResText; + end; + + procedure DoObject; + begin + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skObject, ResTypeName); + ResTypeInfo.Value.AsString := ResText; + end; + + procedure DoClass; + var + m: TDbgSymbolValue; + s, s2, n: String; + DBGType: TGDBType; + f: TDBGField; + i: Integer; + begin + if not PrintPasValue(ResText, ResValue, ctx.SizeOfAddress, []) then + exit; + ResTypeInfo := TDBGType.Create(skClass, ResTypeName); + ResTypeInfo.Value.AsString := ResText; + + if not(defFullTypeInfo in WatchValue.EvaluateFlags) then exit; + s := ResTypeName; + for i := 0 to ResValue.MemberCount - 1 do begin + m := ResValue.Member[i]; + if m = nil then Continue; // Todo: procedures. + case m.Kind of + skProcedure, skFunction: ; // DBGType := TGDBType.Create(skProcedure, TGDBTypes.CreateFromCSV(Params)) + else + begin + DBGType := TGDBType.Create(skSimple, ResTypeName(m)); + PrintPasValue(s2, m, ctx.SizeOfAddress, []); + DBGType.Value.AsString := s2; + n := ''; + if m.DbgSymbol <> nil then n := m.DbgSymbol.Name; +// TODO visibility // flags virtual, constructor + f := TDBGField.Create(n, DBGType, flPublic, [], s); //todo parent class,, instead of s + ResTypeInfo.Fields.Add(f); + end; + end; + end; + end; + begin if FNeedRegValues then begin FNeedRegValues := False; @@ -979,9 +1031,9 @@ begin skEnum: DoEnum; skEnumValue: DoSimple; skSet: DoSet; - skRecord: ; - skObject: ; - skClass: ; + skRecord: DoRecord; + skObject: DoObject; + skClass: DoClass; skInterface: ; skArray: ; end; @@ -1248,7 +1300,27 @@ var t: TCallStackEntryBase; s: TCallStackBase; f: TCallStackEntryBase; + //Instr: TGDBMIDebuggerInstruction; begin +(* + Instr := TGDBMIDebuggerInstruction.Create(Format('-stack-list-frames %d %d', [AStackFrame, AStackFrame]), AThreadId, [], 0); + Instr.AddReference; + Instr.Cmd := TGDBMIDebuggerCommand.Create(Self); + FTheDebugger.FInstructionQueue.RunInstruction(Instr); + ok := Instr.IsSuccess and Instr.FHasResult; + AResult := Instr.ResultData; + Instr.Cmd.ReleaseReference; + Instr.Cmd := nil; + Instr.ReleaseReference; + + if ok then begin + List := TGDBMINameValueList.Create(R, ['stack']); + Result := List.Values['frame']; + List.Free; + end; +*) + + Result := 0; if (AThreadId <= 0) then begin GetCurrentContext(AThreadId, AStackFrame);