mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 21:43:42 +02:00
676 lines
19 KiB
ObjectPascal
676 lines
19 KiB
ObjectPascal
unit FpPascalBuilder;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, DbgIntfBaseTypes, FpDbgInfo, FpdMemoryTools, FpErrorMessages,
|
|
LazLoggerBase;
|
|
|
|
type
|
|
TTypeNameFlag = (
|
|
tnfOnlyDeclared, // do not return a substitute with ^ symbol
|
|
tnfIncludeOneRef // If it is a pointer, and the pointed-to name is known, return ^TXxx
|
|
// without tnfOnlyDeclared, may return ^^^TXxx if needed
|
|
|
|
);
|
|
TTypeNameFlags = set of TTypeNameFlag;
|
|
|
|
TTypeDeclarationFlag = (
|
|
tdfNoFirstLineIndent,
|
|
tdfIncludeVarName, // like i: Integer
|
|
tdfSkipClassBody, // shorten class
|
|
tdfSkipRecordBody, // shorten class
|
|
|
|
tdfDynArrayWithPointer, // TODO, temp, act like gdb
|
|
tdfStopAfterPointer
|
|
);
|
|
TTypeDeclarationFlags = set of TTypeDeclarationFlag;
|
|
|
|
TFpPrettyPrintValueFlag = (
|
|
ppvSkipClassBody, ppvSkipRecordBody
|
|
);
|
|
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;
|
|
|
|
implementation
|
|
|
|
function GetTypeName(out ATypeName: String; ADbgSymbol: TFpDbgSymbol;
|
|
AFlags: TTypeNameFlags): Boolean;
|
|
var
|
|
s: String;
|
|
begin
|
|
ATypeName := '';
|
|
Result := ADbgSymbol <> nil;
|
|
if not Result then
|
|
exit;
|
|
if ADbgSymbol.SymbolType = stValue then begin
|
|
ADbgSymbol := ADbgSymbol.TypeInfo;
|
|
Result := ADbgSymbol <> nil;
|
|
if not Result then
|
|
exit;
|
|
end;
|
|
|
|
ATypeName := ADbgSymbol.Name;
|
|
Result := ATypeName <> '';
|
|
|
|
if (tnfIncludeOneRef in AFlags) or
|
|
((not Result) and (not (tnfOnlyDeclared in AFlags)))
|
|
then begin
|
|
ATypeName := '^';
|
|
while ADbgSymbol.Kind = skPointer do begin
|
|
ADbgSymbol := ADbgSymbol.TypeInfo;
|
|
s := ADbgSymbol.Name;
|
|
if s <> '' then begin
|
|
ATypeName := ATypeName + s;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
if (tnfOnlyDeclared in AFlags) then // only one level
|
|
exit;
|
|
ATypeName := ATypeName + '^';
|
|
end;
|
|
|
|
ATypeName := '';
|
|
Result := False;
|
|
end;
|
|
|
|
end;
|
|
|
|
function GetTypeAsDeclaration(out ATypeDeclaration: String; ADbgSymbol: TFpDbgSymbol;
|
|
AFlags: TTypeDeclarationFlags; AnIndent: Integer): Boolean;
|
|
var
|
|
IndentString: String;
|
|
|
|
function GetIndent: String;
|
|
begin
|
|
if (IndentString = '') and (AnIndent > 0) then
|
|
IndentString := StringOfChar(' ', AnIndent);
|
|
Result := IndentString;
|
|
end;
|
|
|
|
function NeedBracket(S: String): Boolean;
|
|
var
|
|
i, l: Integer;
|
|
begin
|
|
l := 0;
|
|
i := length(s);
|
|
while (i > 0) do begin
|
|
case s[i] of
|
|
'a'..'z', 'A'..'Z', '0'..'9', '_', '$', '^': ;
|
|
'(': dec(l);
|
|
')': inc(l);
|
|
else
|
|
if l = 0 then break;
|
|
end;
|
|
dec(i);
|
|
end;
|
|
Result := i > 0;
|
|
end;
|
|
|
|
Function MembersAsGdbText(out AText: String; WithVisibilty: Boolean; AFlags: TTypeDeclarationFlags = []): Boolean;
|
|
var
|
|
CurVis: TDbgSymbolMemberVisibility;
|
|
|
|
procedure AddVisibility(AVis: TDbgSymbolMemberVisibility; AFirst: Boolean);
|
|
begin
|
|
if not (WithVisibilty and ((CurVis <> AVis) or AFirst)) then
|
|
exit;
|
|
CurVis := AVis;
|
|
case AVis of
|
|
svPrivate: AText := AText + GetIndent + ' private' + LineEnding;
|
|
svProtected: AText := AText + GetIndent + ' protected' + LineEnding;
|
|
svPublic: AText := AText + GetIndent + ' public' + LineEnding;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
c, i: Integer;
|
|
m: TFpDbgSymbol;
|
|
s: String;
|
|
begin
|
|
Result := True;
|
|
AText := '';
|
|
c := ADbgSymbol.MemberCount;
|
|
i := 0;
|
|
while (i < c) and Result do begin
|
|
m := ADbgSymbol.Member[i];
|
|
AddVisibility(m.MemberVisibility, i= 0);
|
|
if tdfStopAfterPointer in AFlags then
|
|
Result := GetTypeName(s, m)
|
|
else
|
|
Result := GetTypeAsDeclaration(s, m, [tdfIncludeVarName, tdfStopAfterPointer] + AFlags, AnIndent + 4);
|
|
if Result then
|
|
AText := AText + GetIndent + s + ';' + LineEnding;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
|
|
function GetPointerType(out ADeclaration: String): Boolean;
|
|
var
|
|
s: String;
|
|
begin
|
|
s := '';
|
|
while ADbgSymbol.Kind = skPointer do begin
|
|
ADbgSymbol := ADbgSymbol.TypeInfo;
|
|
s := s + '^';
|
|
end;
|
|
if (tdfStopAfterPointer in AFlags) then begin
|
|
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
|
|
end
|
|
else begin
|
|
Result := GetTypeAsDeclaration(ADeclaration, ADbgSymbol, AFlags + [tdfStopAfterPointer]);
|
|
if not Result then
|
|
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
|
|
end;
|
|
if NeedBracket(ADeclaration)
|
|
then ADeclaration := s + '(' + ADeclaration + ')'
|
|
else ADeclaration := s + ADeclaration;
|
|
end;
|
|
|
|
function GetBaseType(out ADeclaration: String): Boolean;
|
|
var
|
|
s1, s2: String;
|
|
begin
|
|
if sfSubRange in ADbgSymbol.Flags then begin
|
|
case ADbgSymbol.Kind of
|
|
// TODO: check bound are in size
|
|
skInteger: begin
|
|
Result := ADbgSymbol.HasBounds;
|
|
if Result then ADeclaration := Format('%d..%d', [ADbgSymbol.OrdLowBound, ADbgSymbol.OrdHighBound]);
|
|
end;
|
|
skCardinal: begin
|
|
Result := ADbgSymbol.HasBounds;
|
|
if Result then ADeclaration := Format('%u..%u', [QWord(ADbgSymbol.OrdLowBound), QWord(ADbgSymbol.OrdHighBound)]);
|
|
end;
|
|
skChar: begin
|
|
Result := ADbgSymbol.HasBounds;
|
|
if (ADbgSymbol.OrdLowBound >= 32) and (ADbgSymbol.OrdLowBound <= 126)
|
|
then s1 := '''' + chr(ADbgSymbol.OrdLowBound) + ''''
|
|
else s1 := '#'+IntToStr(ADbgSymbol.OrdLowBound);
|
|
if (ADbgSymbol.OrdHighBound >= 32) and (ADbgSymbol.OrdHighBound <= 126)
|
|
then s2 := '''' + chr(ADbgSymbol.OrdHighBound) + ''''
|
|
else s2 := '#'+IntToStr(ADbgSymbol.OrdHighBound);
|
|
if Result then ADeclaration := Format('%s..%s', [s1, s2]);
|
|
end;
|
|
else
|
|
Result := False; // not sure how to show a subrange of skFloat, skBoolean, :
|
|
end;
|
|
end
|
|
else
|
|
Result := GetTypeName(ADeclaration, ADbgSymbol, []);
|
|
end;
|
|
|
|
function GetFunctionType(out ADeclaration: String): Boolean;
|
|
var
|
|
s: String;
|
|
begin
|
|
// Todo param
|
|
GetTypeAsDeclaration(s, ADbgSymbol.TypeInfo, AFlags);
|
|
ADeclaration := 'function ' + ADbgSymbol.Name + ' () : ' + s + '';
|
|
if sfVirtual in ADbgSymbol.Flags then ADeclaration := ADeclaration + '; virtual';
|
|
Result := true;
|
|
end;
|
|
|
|
function GetProcedureType(out ADeclaration: String): Boolean;
|
|
begin
|
|
// Todo param
|
|
ADeclaration := 'procedure ' + ADbgSymbol.Name + ' ()';
|
|
if sfVirtual in ADbgSymbol.Flags then ADeclaration := ADeclaration + '; virtual';
|
|
Result := true;
|
|
end;
|
|
|
|
function GetClassType(out ADeclaration: String): Boolean;
|
|
var
|
|
s, s2: String;
|
|
begin
|
|
Result := tdfSkipClassBody in AFlags;
|
|
if Result then begin
|
|
GetTypeName(s, ADbgSymbol);
|
|
ADeclaration := s + ' {=class}';
|
|
exit;
|
|
end;
|
|
Result := MembersAsGdbText(s, True, [tdfSkipClassBody]);
|
|
if not GetTypeName(s2, ADbgSymbol.TypeInfo) then
|
|
s2 := '';
|
|
if Result then
|
|
ADeclaration := Format('class(%s)%s%s%send',
|
|
[s2, LineEnding, s, GetIndent]);
|
|
end;
|
|
|
|
function GetRecordType(out ADeclaration: String): Boolean;
|
|
var
|
|
s: String;
|
|
begin
|
|
if tdfSkipRecordBody in AFlags then begin
|
|
Result := True;
|
|
if GetTypeName(s, ADbgSymbol) then
|
|
ADeclaration := s + ' {=record}'
|
|
else
|
|
ADeclaration := Format('record {...};%s%send', [LineEnding, GetIndent]);
|
|
exit;
|
|
end;
|
|
Result := MembersAsGdbText(s, False);
|
|
if Result then
|
|
ADeclaration := Format('record%s%s%send', [LineEnding, s, GetIndent]);
|
|
end;
|
|
|
|
function GetEnumType(out ADeclaration: String): Boolean;
|
|
var
|
|
i, j, val: Integer;
|
|
m: TFpDbgSymbol;
|
|
begin
|
|
// TODO assigned value (a,b:=3,...)
|
|
Result := True;
|
|
ADeclaration := '(';
|
|
j := 0;
|
|
for i := 0 to ADbgSymbol.MemberCount - 1 do begin
|
|
m := ADbgSymbol.Member[i];
|
|
if i > 0 then ADeclaration := ADeclaration + ', ';
|
|
ADeclaration := ADeclaration + m.Name;
|
|
if m.HasOrdinalValue then begin
|
|
val := m.OrdinalValue;
|
|
if j <> val then begin
|
|
ADeclaration := ADeclaration + ' := ' + IntToStr(val);
|
|
j := val;
|
|
continue;
|
|
end;
|
|
end;
|
|
inc(j);
|
|
end;
|
|
ADeclaration := ADeclaration + ')'
|
|
end;
|
|
|
|
function GetSetType(out ADeclaration: String): Boolean;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
s: String;
|
|
begin
|
|
// TODO assigned value (a,b:=3,...)
|
|
t := ADbgSymbol.TypeInfo;
|
|
Result := t <> nil;
|
|
if not Result then exit;
|
|
|
|
case t.Kind of
|
|
skInteger: begin
|
|
Result := t.HasBounds;
|
|
ADeclaration := format('set of %d..%d', [t.OrdLowBound, t.OrdHighBound]);
|
|
end;
|
|
skCardinal: begin
|
|
Result := t.HasBounds;
|
|
ADeclaration := format('set of %u..%u', [QWord(t.OrdLowBound), QWord(t.OrdHighBound)]);
|
|
end;
|
|
skEnum: begin
|
|
if t.Name <> '' then begin
|
|
Result := True;
|
|
s := t.Name;
|
|
end
|
|
else
|
|
Result := GetTypeAsDeclaration(s, t, AFlags);
|
|
ADeclaration := 'set of ' + s;
|
|
end;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function GetArrayType(out ADeclaration: String): Boolean;
|
|
var
|
|
t: TFpDbgSymbol;
|
|
s: String;
|
|
i: Integer;
|
|
begin
|
|
// TODO assigned value (a,b:=3,...)
|
|
t := ADbgSymbol.TypeInfo;
|
|
Result := (t <> nil);
|
|
if not Result then exit;
|
|
|
|
s := t.Name;
|
|
if s = '' then begin
|
|
if tdfStopAfterPointer in AFlags then
|
|
Result := GetTypeName(s, t)
|
|
else
|
|
Result := GetTypeAsDeclaration(s, t, [tdfNoFirstLineIndent, tdfStopAfterPointer] + AFlags, AnIndent + 4); // no class ?
|
|
if not Result then exit;
|
|
end;
|
|
|
|
|
|
if sfDynArray in ADbgSymbol.Flags then begin //supprts only one level
|
|
ADeclaration := 'array of ' + s;
|
|
if tdfDynArrayWithPointer in AFlags then
|
|
ADeclaration := '^(' + ADeclaration + ')';
|
|
end
|
|
else begin
|
|
ADeclaration := 'array [';
|
|
for i := 0 to ADbgSymbol.MemberCount - 1 do begin
|
|
if i > 0 then
|
|
ADeclaration := ADeclaration + ', ';
|
|
t := ADbgSymbol.Member[i];
|
|
if t.Kind = skCardinal
|
|
then ADeclaration := ADeclaration + Format('%u..%u', [QWord(t.OrdLowBound), QWord(t.OrdHighBound)])
|
|
else ADeclaration := ADeclaration + Format('%d..%d', [t.OrdLowBound, t.OrdHighBound]);
|
|
end;
|
|
ADeclaration := ADeclaration + '] of ' + s;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
VarName: String;
|
|
begin
|
|
Result := ADbgSymbol <> nil;
|
|
if not Result then
|
|
exit;
|
|
VarName := '';
|
|
if (ADbgSymbol.SymbolType = stValue) and
|
|
not((ADbgSymbol.Kind = skProcedure) or (ADbgSymbol.Kind = skFunction))
|
|
then begin
|
|
if tdfIncludeVarName in AFlags then
|
|
VarName := ADbgSymbol.Name;
|
|
ADbgSymbol := ADbgSymbol.TypeInfo;
|
|
Result := ADbgSymbol <> nil;
|
|
if not Result then
|
|
exit;
|
|
end;
|
|
|
|
case ADbgSymbol.Kind of
|
|
skPointer: Result := GetPointerType(ATypeDeclaration);
|
|
skInteger, skCardinal, skBoolean, skChar, skFloat:
|
|
Result := GetBaseType(ATypeDeclaration);
|
|
skFunction: Result := GetFunctionType(ATypeDeclaration);
|
|
skProcedure: Result := GetProcedureType(ATypeDeclaration);
|
|
skClass: Result := GetClassType(ATypeDeclaration);
|
|
skRecord: Result := GetRecordType(ATypeDeclaration);
|
|
skEnum: Result := GetEnumType(ATypeDeclaration);
|
|
skset: Result := GetSetType(ATypeDeclaration);
|
|
skArray: Result := GetArrayType(ATypeDeclaration);
|
|
end;
|
|
|
|
if VarName <> '' then
|
|
ATypeDeclaration := VarName + ': ' + ATypeDeclaration;
|
|
if (AnIndent <> 0) and not(tdfNoFirstLineIndent in AFlags) then
|
|
ATypeDeclaration := GetIndent + ATypeDeclaration;
|
|
end;
|
|
|
|
{ TFpPascalPrettyPrinter }
|
|
|
|
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
|
AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
|
|
ANestLevel: Integer; AnIndent: String): Boolean;
|
|
|
|
|
|
function ResTypeName: String;
|
|
begin
|
|
if not((AValue.TypeInfo<> nil) and
|
|
GetTypeName(Result, AValue.TypeInfo, []))
|
|
then
|
|
Result := '';
|
|
end;
|
|
|
|
procedure DoPointer;
|
|
var
|
|
s: String;
|
|
v: QWord;
|
|
begin
|
|
s := ResTypeName;
|
|
v := AValue.AsCardinal;
|
|
if v = 0 then
|
|
APrintedValue := 'nil'
|
|
else
|
|
APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize);
|
|
if s <> '' then
|
|
APrintedValue := s + '(' + APrintedValue + ')';
|
|
|
|
if svfString in AValue.FieldFlags then
|
|
APrintedValue := APrintedValue + ' ' + AValue.AsString;
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoInt;
|
|
begin
|
|
APrintedValue := IntToStr(AValue.AsInteger);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoCardinal;
|
|
begin
|
|
APrintedValue := IntToStr(AValue.AsCardinal);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoBool;
|
|
begin
|
|
if AValue.AsBool then begin
|
|
APrintedValue := 'True';
|
|
if AValue.AsCardinal <> 1 then
|
|
APrintedValue := APrintedValue + '(' + IntToStr(AValue.AsCardinal) + ')';
|
|
end
|
|
else
|
|
APrintedValue := 'False';
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoChar;
|
|
begin
|
|
APrintedValue := '''' + AValue.AsString + ''''; // Todo escape
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoFloat;
|
|
begin
|
|
APrintedValue := FloatToStr(AValue.AsFloat);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoEnum;
|
|
var
|
|
s: String;
|
|
begin
|
|
APrintedValue := AValue.AsString;
|
|
if APrintedValue = '' then begin
|
|
s := ResTypeName;
|
|
APrintedValue := s + '(' + IntToStr(AValue.AsCardinal) + ')';
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoEnumVal;
|
|
begin
|
|
APrintedValue := AValue.AsString;
|
|
if APrintedValue <> '' then
|
|
APrintedValue := APrintedValue + ':=';
|
|
APrintedValue := APrintedValue+ IntToStr(AValue.AsCardinal);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure DoSet;
|
|
var
|
|
s: String;
|
|
i: Integer;
|
|
m: TFpDbgValue;
|
|
begin
|
|
APrintedValue := '';
|
|
for i := 0 to AValue.MemberCount-1 do begin
|
|
m := AValue.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: TFpDbgValue;
|
|
fl: TFpPrettyPrintValueFlags;
|
|
begin
|
|
if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin
|
|
APrintedValue := 'nil';
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
|
|
( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
|
|
then begin
|
|
APrintedValue := ResTypeName;
|
|
case AValue.Kind of
|
|
skRecord: APrintedValue := '{record:}' + APrintedValue;
|
|
skObject: APrintedValue := '{object:}' + APrintedValue;
|
|
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize) + ')';
|
|
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 AValue.MemberCount-1 do begin
|
|
m := AValue.Member[i];
|
|
if (m = nil) or (m.Kind in [skProcedure, skFunction]) then
|
|
continue;
|
|
s := '';
|
|
InternalPrintValue(s, m, AnAddressSize, fl, ANestLevel+1, AnIndent);
|
|
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;
|
|
|
|
procedure DoArray;
|
|
var
|
|
s: String;
|
|
i: Integer;
|
|
m: TFpDbgValue;
|
|
c, d: Integer;
|
|
begin
|
|
APrintedValue := '';
|
|
c := AValue.MemberCount;
|
|
if (c = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array
|
|
APrintedValue := 'nil';
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
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 (AValue.IndexTypeCount > 0) and AValue.IndexType[0].HasBounds then
|
|
d := AValue.IndexType[0].OrdLowBound;
|
|
for i := d to d + c - 1 do begin
|
|
m := AValue.Member[i];
|
|
if m <> nil then
|
|
InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent)
|
|
else
|
|
s := '{error}';
|
|
if APrintedValue = ''
|
|
then APrintedValue := s
|
|
else APrintedValue := APrintedValue + ', ' + s;
|
|
end;
|
|
if c < AValue.MemberCount then
|
|
APrintedValue := APrintedValue + ', ...';
|
|
APrintedValue := '(' + APrintedValue + ')';
|
|
Result := True;
|
|
end;
|
|
begin
|
|
if ANestLevel > 0 then begin
|
|
AnIndent := AnIndent + ' ';
|
|
end;
|
|
|
|
Result := False;
|
|
case AValue.Kind of
|
|
skUnit: ;
|
|
skProcedure: ;
|
|
skFunction: ;
|
|
skPointer: DoPointer;
|
|
skInteger: DoInt;
|
|
skCardinal: DoCardinal;
|
|
skBoolean: DoBool;
|
|
skChar: DoChar;
|
|
skFloat: DoFloat;
|
|
skString: ;
|
|
skAnsiString: ;
|
|
skCurrency: ;
|
|
skVariant: ;
|
|
skWideString: ;
|
|
skEnum: DoEnum;
|
|
skEnumValue: DoEnumVal;
|
|
skSet: DoSet;
|
|
skRecord: DoStructure;
|
|
skObject: DoStructure;
|
|
skClass: DoStructure;
|
|
skInterface: ;
|
|
skArray: DoArray;
|
|
end;
|
|
|
|
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.
|
|
|