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

FpDebug: start pretty-printer class

Browse Source 
git-svn-id: trunk@44564 -
This commit is contained in:
martin 2014-03-31 17:41:22 +00:00
parent 8d1b5eeea4
commit 4afbc6b24d
3 changed files with 107 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpdebug/fpdbgdwarf.pas
View File

@ -6166,6 +6166,7 @@ begin
Offs := 0;
Factor := 1;
{$PUSH}{$R-}{$Q-} // TODO: check range of index
bsize := FStrideInBits div 8;
if FRowMajor then begin
for i := Length(AIndex) - 1 downto 0 do begin
@ -6205,6 +6206,7 @@ begin
assert(IsTargetAddr(Result), 'DwarfArray MemberAddress');
Result.Address := Result.Address + Offs;
{$POP}
end;
destructor TDbgDwarfIdentifierArray.Destroy;

139
components/fpdebug/fppascalbuilder.pas
View File

@ -28,18 +28,37 @@ type
);
TTypeDeclarationFlags = set of TTypeDeclarationFlag;
TPrintPasValFlag = (
TFpPrettyPrintValueFlag = (
ppvSkipClassBody, ppvSkipRecordBody
);
TPrintPasValFlags = set of TPrintPasValFlag;
TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag;
{ TFpPascalPrettyPrinter }
TFpPascalPrettyPrinter = class
private
FAddressSize: Integer;
function InternalPrintValue(out APrintedValue: String;
AValue: TFpDbgValue;
AnAddressSize: Integer;
AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String
): Boolean;
public
constructor Create(AnAddressSize: Integer);
function PrintValue(out APrintedValue: String;
AValue: TFpDbgValue;
AFlags: TFpPrettyPrintValueFlags = []): Boolean;
property AddressSize: Integer read FAddressSize write FAddressSize;
end;
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol; AFlags: TTypeNameFlags = []): Boolean;
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpDbgSymbol;
AFlags: TTypeDeclarationFlags = []; AnIndent: Integer = 0): Boolean;
function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
AnAddrSize: Integer; AFlags: TPrintPasValFlags = []): Boolean;
implementation
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol;
@ -395,13 +414,17 @@ begin
ATypeDeclaration := GetIndent + ATypeDeclaration;
end;
function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
AnAddrSize: Integer; AFlags: TPrintPasValFlags): Boolean;
{ TFpPascalPrettyPrinter }
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
ANestLevel: Integer; AnIndent: String): Boolean;
function ResTypeName: String;
begin
if not((AResValue.TypeInfo<> nil) and
GetTypeName(Result, AResValue.TypeInfo, []))
if not((AValue.TypeInfo<> nil) and
GetTypeName(Result, AValue.TypeInfo, []))
then
Result := '';
end;
@ -412,38 +435,38 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
v: QWord;
begin
s := ResTypeName;
v := AResValue.AsCardinal;
v := AValue.AsCardinal;
if v = 0 then
APrintedValue := 'nil'
else
APrintedValue := '$'+IntToHex(AResValue.AsCardinal, AnAddrSize);
APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize);
if s <> '' then
APrintedValue := s + '(' + APrintedValue + ')';
if svfString in AResValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + AResValue.AsString;
if svfString in AValue.FieldFlags then
APrintedValue := APrintedValue + ' ' + AValue.AsString;
Result := True;
end;
procedure DoInt;
begin
APrintedValue := IntToStr(AResValue.AsInteger);
APrintedValue := IntToStr(AValue.AsInteger);
Result := True;
end;
procedure DoCardinal;
begin
APrintedValue := IntToStr(AResValue.AsCardinal);
APrintedValue := IntToStr(AValue.AsCardinal);
Result := True;
end;
procedure DoBool;
begin
if AResValue.AsBool then begin
if AValue.AsBool then begin
APrintedValue := 'True';
if AResValue.AsCardinal <> 1 then
APrintedValue := APrintedValue + '(' + IntToStr(AResValue.AsCardinal) + ')';
if AValue.AsCardinal <> 1 then
APrintedValue := APrintedValue + '(' + IntToStr(AValue.AsCardinal) + ')';
end
else
APrintedValue := 'False';
@ -452,13 +475,13 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
procedure DoChar;
begin
APrintedValue := '''' + AResValue.AsString + ''''; // Todo escape
APrintedValue := '''' + AValue.AsString + ''''; // Todo escape
Result := True;
end;
procedure DoFloat;
begin
APrintedValue := FloatToStr(AResValue.AsFloat);
APrintedValue := FloatToStr(AValue.AsFloat);
Result := True;
end;
@ -466,20 +489,20 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
var
s: String;
begin
APrintedValue := AResValue.AsString;
APrintedValue := AValue.AsString;
if APrintedValue = '' then begin
s := ResTypeName;
APrintedValue := s + '(' + IntToStr(AResValue.AsCardinal) + ')';
APrintedValue := s + '(' + IntToStr(AValue.AsCardinal) + ')';
end;
Result := True;
end;
procedure DoEnumVal;
begin
APrintedValue := AResValue.AsString;
APrintedValue := AValue.AsString;
if APrintedValue <> '' then
APrintedValue := APrintedValue + ':=';
APrintedValue := APrintedValue+ IntToStr(AResValue.AsCardinal);
APrintedValue := APrintedValue+ IntToStr(AValue.AsCardinal);
Result := True;
end;
@ -490,8 +513,8 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
m: TFpDbgValue;
begin
APrintedValue := '';
for i := 0 to AResValue.MemberCount-1 do begin
m := AResValue.Member[i];
for i := 0 to AValue.MemberCount-1 do begin
m := AValue.Member[i];
if svfIdentifier in m.FieldFlags then
s := m.AsString
else
@ -512,22 +535,22 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
s, s2: String;
i: Integer;
m: TFpDbgValue;
fl: TPrintPasValFlags;
fl: TFpPrettyPrintValueFlags;
begin
if (AResValue.Kind = skClass) and (AResValue.AsCardinal = 0) then begin
if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin
APrintedValue := 'nil';
Result := True;
exit;
end;
if ( (AResValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
( (AResValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
then begin
APrintedValue := ResTypeName;
case AResValue.Kind of
case AValue.Kind of
skRecord: APrintedValue := '{record:}' + APrintedValue;
skObject: APrintedValue := '{object:}' + APrintedValue;
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AResValue.AsCardinal, AnAddrSize) + ')';
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize) + ')';
end;
Result := True;
exit;
@ -540,12 +563,12 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
// fl := [ppvSkipClassBody, ppvSkipRecordBody];
APrintedValue := '';
for i := 0 to AResValue.MemberCount-1 do begin
m := AResValue.Member[i];
for i := 0 to AValue.MemberCount-1 do begin
m := AValue.Member[i];
if (m = nil) or (m.Kind in [skProcedure, skFunction]) then
continue;
s := '';
PrintPasValue(s, m, AnAddrSize, fl);
InternalPrintValue(s, m, AnAddressSize, fl, ANestLevel+1, AnIndent);
if m.DbgSymbol <> nil then
s := m.DbgSymbol.Name + ' = ' + s;
if APrintedValue = ''
@ -564,36 +587,47 @@ function PrintPasValue(out APrintedValue: String; AResValue: TFpDbgValue;
c, d: Integer;
begin
APrintedValue := '';
c := AResValue.MemberCount;
if (c = 0) and (svfOrdinal in AResValue.FieldFlags) then begin // dyn array
c := AValue.MemberCount;
if (c = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array
APrintedValue := 'nil';
Result := True;
exit;
end;
if c > 500 then c := 500;
if (ANestLevel > 2) then begin
s := ResTypeName;
APrintedValue := s+'(...)'; // TODO len and addr (dyn array)
Result := True;
exit;
end;
if (ANestLevel > 1) and (c > 5) then c := 5
else if (ANestLevel > 0) and (c > 15) then c := 15
else if (c > 500) then c := 500;
d := 0;
// TODO: use valueobject for bounds
if (AResValue.IndexTypeCount > 0) and AResValue.IndexType[0].HasBounds then
d := AResValue.IndexType[0].OrdLowBound;
if (AValue.IndexTypeCount > 0) and AValue.IndexType[0].HasBounds then
d := AValue.IndexType[0].OrdLowBound;
for i := d to d + c - 1 do begin
m := AResValue.Member[i];
m := AValue.Member[i];
if m <> nil then
PrintPasValue(s, m, AnAddrSize, AFlags)
InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent)
else
s := '{error}';
if APrintedValue = ''
then APrintedValue := s
else APrintedValue := APrintedValue + ', ' + s;
end;
if c < AResValue.MemberCount then
if c < AValue.MemberCount then
APrintedValue := APrintedValue + ', ...';
APrintedValue := '(' + APrintedValue + ')';
Result := True;
end;
begin
if ANestLevel > 0 then begin
AnIndent := AnIndent + ' ';
end;
Result := False;
case AResValue.Kind of
case AValue.Kind of
skUnit: ;
skProcedure: ;
skFunction: ;
@ -618,11 +652,20 @@ begin
skArray: DoArray;
end;
if IsError(AResValue.LastError) then
APrintedValue := ErrorHandler.ErrorAsString(AResValue.LastError);
if IsError(AValue.LastError) then
APrintedValue := ErrorHandler.ErrorAsString(AValue.LastError);
end;
constructor TFpPascalPrettyPrinter.Create(AnAddressSize: Integer);
begin
FAddressSize := AnAddressSize;
end;
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue;
AFlags: TFpPrettyPrintValueFlags): Boolean;
begin
InternalPrintValue(APrintedValue, AValue, AddressSize, AFlags, 0, '');
end;
end.

24
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -76,6 +76,7 @@ type
FWatchEvalList: TList;
FImageLoader: TDbgImageLoader;
FDwarfInfo: TDbgDwarf;
FPrettyPrinter: TFpPascalPrettyPrinter;
FMemReader: TFpGDBMIDbgMemReader;
FMemManager: TFpDbgMemManager;
// cache last context
@ -1133,6 +1134,7 @@ begin
FDwarfInfo := TDbgDwarf.Create(FImageLoader);
FDwarfInfo.MemManager := FMemManager;
FDwarfInfo.LoadCompilationUnits;
FPrettyPrinter := TFpPascalPrettyPrinter.Create(SizeOf(Pointer));
end;
procedure TFpGDBMIDebugger.UnLoadDwarf;
@ -1144,6 +1146,7 @@ begin
if FMemManager <> nil then
FMemManager.TargetMemConvertor.Free;
FreeAndNil(FMemManager);
FreeAndNil(FPrettyPrinter);
end;
function TFpGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand;
@ -1329,7 +1332,7 @@ var
procedure DoPointer;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skPointer, ResTypeName);
ATypeInfo.Value.AsPointer := Pointer(ResValue.AsCardinal); // TODO: no cut off
@ -1338,7 +1341,7 @@ var
procedure DoSimple;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1346,7 +1349,7 @@ var
procedure DoEnum;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skEnum, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1354,7 +1357,7 @@ var
procedure DoSet;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skSet, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1368,7 +1371,7 @@ var
DBGType: TGDBType;
f: TDBGField;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skRecord, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1382,7 +1385,7 @@ var
else
begin
DBGType := TGDBType.Create(skSimple, ResTypeName(m));
PrintPasValue(s2, m, ctx.SizeOfAddress, []);
FPrettyPrinter.PrintValue(s2, m, []);
DBGType.Value.AsString := s2;
n := '';
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
@ -1405,7 +1408,7 @@ var
PasExpr2: TFpPascalExpression;
begin
if (ResValue.Kind = skClass) and (ResValue.AsCardinal = 0) then begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1437,7 +1440,7 @@ var
end;
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
if CastName <> '' then AResText := CastName + AResText;
//if PasExpr.ResultValue.Kind = skObject then
@ -1455,7 +1458,7 @@ var
else
begin
DBGType := TGDBType.Create(skSimple, ResTypeName(m));
PrintPasValue(s2, m, ctx.SizeOfAddress, []);
FPrettyPrinter.PrintValue(s2, m, []);
DBGType.Value.AsString := s2;
n := '';
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
@ -1471,7 +1474,7 @@ var
procedure DoArray;
begin
if not PrintPasValue(AResText, ResValue, ctx.SizeOfAddress, []) then
if not FPrettyPrinter.PrintValue(AResText, ResValue, []) then
exit;
ATypeInfo := TDBGType.Create(skArray, ResTypeName);
ATypeInfo.Value.AsString := AResText;
@ -1499,6 +1502,7 @@ begin
else
Ctx := GetInfoContextForContext(CurrentThreadId, CurrentStackFrame);
if Ctx = nil then exit;
FPrettyPrinter.AddressSize := ctx.SizeOfAddress;
PasExpr := TFpPascalExpression.Create(AExpression, Ctx);
try