mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-15 11:16:03 +02:00
FpGdbmiDebugger, FPDebug: move code for watches dbginfo
git-svn-id: trunk@44974 -
This commit is contained in:
martin
parent
f35d89328d
commit
89d29e376f
@ -29,10 +29,17 @@ type
|
||||
TTypeDeclarationFlags = set of TTypeDeclarationFlag;
|
||||
|
||||
TFpPrettyPrintValueFlag = (
|
||||
ppvCreateDbgType,
|
||||
ppvSkipClassBody, ppvSkipRecordBody
|
||||
);
|
||||
TFpPrettyPrintValueFlags = set of TFpPrettyPrintValueFlag;
|
||||
|
||||
const
|
||||
PV_FORWARD_FLAGS = [ppvSkipClassBody, ppvSkipRecordBody];
|
||||
|
||||
type
|
||||
|
||||
PDBGType = ^TDBGType;
|
||||
|
||||
{ TFpPascalPrettyPrinter }
|
||||
|
||||
@ -46,7 +53,8 @@ type
|
||||
AFlags: TFpPrettyPrintValueFlags;
|
||||
ANestLevel: Integer; AnIndent: String;
|
||||
ADisplayFormat: TWatchDisplayFormat;
|
||||
ARepeatCount: Integer = -1
|
||||
ARepeatCount: Integer = -1;
|
||||
ADBGTypeInfo: PDBGType = nil
|
||||
): Boolean;
|
||||
public
|
||||
constructor Create(AnAddressSize: Integer);
|
||||
@ -55,6 +63,12 @@ type
|
||||
ADisplayFormat: TWatchDisplayFormat = wdfDefault;
|
||||
ARepeatCount: Integer = -1
|
||||
): Boolean;
|
||||
function PrintValue(out APrintedValue: String;
|
||||
out ADBGTypeInfo: TDBGType;
|
||||
AValue: TFpDbgValue;
|
||||
ADisplayFormat: TWatchDisplayFormat = wdfDefault;
|
||||
ARepeatCount: Integer = -1
|
||||
): Boolean;
|
||||
property AddressSize: Integer read FAddressSize write FAddressSize;
|
||||
property MemManager: TFpDbgMemManager read FMemManager write FMemManager;
|
||||
end;
|
||||
@ -429,7 +443,7 @@ end;
|
||||
function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
AValue: TFpDbgValue; AnAddressSize: Integer; AFlags: TFpPrettyPrintValueFlags;
|
||||
ANestLevel: Integer; AnIndent: String; ADisplayFormat: TWatchDisplayFormat;
|
||||
ARepeatCount: Integer): Boolean;
|
||||
ARepeatCount: Integer; ADBGTypeInfo: PDBGType): Boolean;
|
||||
|
||||
|
||||
function ResTypeName: String;
|
||||
@ -439,6 +453,13 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
then
|
||||
Result := '';
|
||||
end;
|
||||
function ResTypeName(AVal : TFpDbgValue): String;
|
||||
begin
|
||||
if not((AVal.TypeInfo<> nil) and
|
||||
GetTypeName(Result, AVal.TypeInfo, []))
|
||||
then
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure DoPointer;
|
||||
var
|
||||
@ -452,6 +473,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
else
|
||||
s := '';
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skPointer, s);
|
||||
ADBGTypeInfo^.Value.AsPointer := Pointer(AValue.AsCardinal); // TODO: no cut off
|
||||
end;
|
||||
|
||||
v := AValue.AsCardinal;
|
||||
case ADisplayFormat of
|
||||
wdfDecimal, wdfUnsigned: APrintedValue := IntToStr(AValue.AsCardinal);
|
||||
@ -495,6 +521,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
else
|
||||
APrintedValue := IntToStr(AValue.AsInteger);
|
||||
end;
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
//ADBGTypeInfo^.Value.As64Bits := QWord(AValue.AsInteger); // TODO: no cut off
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -519,6 +550,11 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
else
|
||||
APrintedValue := IntToStr(AValue.AsCardinal);
|
||||
end;
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
//ADBGTypeInfo^.Value.As64Bits := QWord(AValue.AsiCardinal); // TODO: no cut off
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -531,18 +567,28 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
end
|
||||
else
|
||||
APrintedValue := 'False';
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure DoChar;
|
||||
begin
|
||||
APrintedValue := '''' + AValue.AsString + ''''; // Todo escape
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure DoFloat;
|
||||
begin
|
||||
APrintedValue := FloatToStr(AValue.AsFloat);
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -554,6 +600,12 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
if APrintedValue = '' then begin
|
||||
s := ResTypeName;
|
||||
APrintedValue := s + '(' + IntToStr(AValue.AsCardinal) + ')';
|
||||
end
|
||||
else if (ppvCreateDbgType in AFlags) then
|
||||
s := ResTypeName;
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skEnum, s);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
@ -564,6 +616,10 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
if APrintedValue <> '' then
|
||||
APrintedValue := APrintedValue + ':=';
|
||||
APrintedValue := APrintedValue+ IntToStr(AValue.AsCardinal);
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
@ -588,30 +644,50 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
else APrintedValue := APrintedValue + ', ' + s;
|
||||
end;
|
||||
APrintedValue := '[' + APrintedValue + ']';
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSet, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure DoStructure;
|
||||
var
|
||||
s, s2: String;
|
||||
s, s2, MbName, MbVal: String;
|
||||
i: Integer;
|
||||
m: TFpDbgValue;
|
||||
fl: TFpPrettyPrintValueFlags;
|
||||
f: TDBGField;
|
||||
begin
|
||||
if (AValue.Kind = skClass) and (AValue.AsCardinal = 0) then begin
|
||||
APrintedValue := 'nil';
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skSimple, ResTypeName);
|
||||
end;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
s := ResTypeName;
|
||||
case AValue.Kind of
|
||||
skRecord: ADBGTypeInfo^ := TDBGType.Create(skRecord, s);
|
||||
skObject: ADBGTypeInfo^ := TDBGType.Create(skClass, s);
|
||||
skClass: ADBGTypeInfo^ := TDBGType.Create(skClass, s);
|
||||
end;
|
||||
end;
|
||||
|
||||
if ADisplayFormat = wdfPointer then begin
|
||||
if not (ppvCreateDbgType in AFlags) then
|
||||
s := ResTypeName;
|
||||
APrintedValue := '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2);
|
||||
if s <> '' then
|
||||
APrintedValue := s + '(' + APrintedValue + ')';
|
||||
Result := True;
|
||||
if not (ppvCreateDbgType in AFlags) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
end
|
||||
else
|
||||
if ( (AValue.Kind in [skClass, skObject]) and (ppvSkipClassBody in AFlags) ) or
|
||||
( (AValue.Kind in [skRecord]) and (ppvSkipRecordBody in AFlags) )
|
||||
then begin
|
||||
@ -622,6 +698,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
skClass: APrintedValue := '{class:}' + APrintedValue + '(' + '$'+IntToHex(AValue.AsCardinal, AnAddressSize*2) + ')';
|
||||
end;
|
||||
Result := True;
|
||||
if not (ppvCreateDbgType in AFlags) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -631,19 +708,38 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
//if ppvSkipClassBody in AFlags then
|
||||
// fl := [ppvSkipClassBody, ppvSkipRecordBody];
|
||||
|
||||
if not Result then
|
||||
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, ADisplayFormat);
|
||||
if m.DbgSymbol <> nil then
|
||||
s := m.DbgSymbol.Name + ' = ' + s;
|
||||
InternalPrintValue(MbVal, m, AnAddressSize, fl, ANestLevel+1, AnIndent, ADisplayFormat);
|
||||
if m.DbgSymbol <> nil then begin
|
||||
MbName := m.DbgSymbol.Name;
|
||||
s := MbName + ' = ' + MbVal;
|
||||
end
|
||||
else begin
|
||||
MbName := '';
|
||||
s := MbVal;
|
||||
end;
|
||||
|
||||
if not Result then begin
|
||||
if APrintedValue = ''
|
||||
then APrintedValue := s
|
||||
else APrintedValue := APrintedValue + '; ' + s2 + s;
|
||||
end;
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
s := '';
|
||||
if m.ContextTypeInfo <> nil then s := m.ContextTypeInfo.Name;
|
||||
f := TDBGField.Create(MbName, TDBGType.Create(skSimple, ResTypeName(m)),
|
||||
flPublic, [], s);
|
||||
f.DBGType.Value.AsString := MbVal;
|
||||
ADBGTypeInfo^.Fields.Add(f);
|
||||
end;
|
||||
end;
|
||||
if not Result then
|
||||
APrintedValue := '(' + APrintedValue + ')';
|
||||
Result := True;
|
||||
end;
|
||||
@ -656,6 +752,14 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
Cnt, FullCnt, d: Integer;
|
||||
begin
|
||||
APrintedValue := '';
|
||||
|
||||
if (ppvCreateDbgType in AFlags) then begin
|
||||
ADBGTypeInfo^ := TDBGType.Create(skArray, ResTypeName);
|
||||
//ATypeInfo.Len;
|
||||
//ATypeInfo.BoundLow;
|
||||
//ATypeInfo.BoundHigh;
|
||||
end;
|
||||
|
||||
Cnt := AValue.MemberCount;
|
||||
FullCnt := Cnt;
|
||||
if (Cnt = 0) and (svfOrdinal in AValue.FieldFlags) then begin // dyn array
|
||||
@ -680,7 +784,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
for i := d to d + Cnt - 1 do begin
|
||||
m := AValue.Member[i];
|
||||
if m <> nil then
|
||||
InternalPrintValue(s, m, AnAddressSize, AFlags, ANestLevel+1, AnIndent, ADisplayFormat)
|
||||
InternalPrintValue(s, m, AnAddressSize, AFlags * PV_FORWARD_FLAGS, ANestLevel+1, AnIndent, ADisplayFormat)
|
||||
else
|
||||
s := '{error}';
|
||||
if APrintedValue = ''
|
||||
@ -698,6 +802,7 @@ var
|
||||
MemDest: array of Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
if ADBGTypeInfo <> nil then ADBGTypeInfo^ := nil;
|
||||
if ANestLevel > 0 then begin
|
||||
AnIndent := AnIndent + ' ';
|
||||
end;
|
||||
@ -770,6 +875,9 @@ begin
|
||||
skArray: DoArray;
|
||||
end;
|
||||
|
||||
if (ADBGTypeInfo <> nil) and (ADBGTypeInfo^ <> nil) then
|
||||
ADBGTypeInfo^.Value.AsString := APrintedValue;
|
||||
|
||||
if IsError(AValue.LastError) then
|
||||
APrintedValue := ErrorHandler.ErrorAsString(AValue.LastError);
|
||||
end;
|
||||
@ -781,12 +889,18 @@ end;
|
||||
|
||||
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; AValue: TFpDbgValue;
|
||||
ADisplayFormat: TWatchDisplayFormat; ARepeatCount: Integer): Boolean;
|
||||
var
|
||||
x: QWord;
|
||||
begin
|
||||
x:= GetTickCount64;
|
||||
Result := InternalPrintValue(APrintedValue, AValue, AddressSize, [], 0, '', ADisplayFormat, ARepeatCount);
|
||||
debugln([' TFpPascalPrettyPrinter.PrintValue ', (GetTickCount64-x)/1000]);
|
||||
Result := InternalPrintValue(APrintedValue, AValue,
|
||||
AddressSize, [], 0, '', ADisplayFormat, ARepeatCount);
|
||||
end;
|
||||
|
||||
function TFpPascalPrettyPrinter.PrintValue(out APrintedValue: String; out
|
||||
ADBGTypeInfo: TDBGType; AValue: TFpDbgValue; ADisplayFormat: TWatchDisplayFormat;
|
||||
ARepeatCount: Integer): Boolean;
|
||||
begin
|
||||
Result := InternalPrintValue(APrintedValue, AValue,
|
||||
AddressSize, [ppvCreateDbgType], 0, '',
|
||||
ADisplayFormat, ARepeatCount, @ADBGTypeInfo);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -96,7 +96,7 @@ type
|
||||
procedure DoWatchFreed(Sender: TObject);
|
||||
function EvaluateExpression(AWatchValue: TWatchValue;
|
||||
AExpression: String;
|
||||
var AResText: String;
|
||||
out AResText: String;
|
||||
out ATypeInfo: TDBGType;
|
||||
EvalFlags: TDBGEvaluateFlags = []): Boolean;
|
||||
property CurrentThreadId;
|
||||
@ -112,6 +112,9 @@ procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
FPGDBDBG_VERBOSE, FPGDBDBG_ERROR: PLazLoggerLogGroup;
|
||||
|
||||
type
|
||||
|
||||
{ TFpGDBMIDebuggerCommandStartDebugging }
|
||||
@ -383,7 +386,7 @@ end;
|
||||
procedure TFpGDBMIAndWin32DbgMemReader.OpenProcess(APid: Cardinal);
|
||||
begin
|
||||
{$IFdef MSWindows}
|
||||
debugln(['OPEN process ',APid]);
|
||||
debugln(FPGDBDBG_VERBOSE, ['OPEN process ',APid]);
|
||||
if APid <> 0 then
|
||||
hProcess := windows.OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, APid);
|
||||
{$ENDIF}
|
||||
@ -435,7 +438,7 @@ begin
|
||||
MemDump.Free;
|
||||
Result := True;
|
||||
|
||||
debugln(['TFpGDBMIDbgMemReader.ReadMemory ', dbgs(AnAddress), ' ', dbgMemRange(ADest, ASize)]);
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadMemory ', dbgs(AnAddress), ' ', dbgMemRange(ADest, ASize)]);
|
||||
end;
|
||||
|
||||
function TFpGDBMIDbgMemReader.ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr;
|
||||
@ -503,7 +506,7 @@ begin
|
||||
else
|
||||
v := '';
|
||||
if pos(' ', v) > 1 then v := copy(v, 1, pos(' ', v)-1);
|
||||
debugln(['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDbgMemReader.ReadRegister ',rname, ' ', v]);
|
||||
Result := true;
|
||||
try
|
||||
AValue := StrToQWord(v);
|
||||
@ -738,7 +741,7 @@ end;
|
||||
procedure TFpGDBMIDebugger.LoadDwarf;
|
||||
begin
|
||||
UnLoadDwarf;
|
||||
debugln(['TFpGDBMIDebugger.LoadDwarf ']);
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDebugger.LoadDwarf ']);
|
||||
FImageLoader := TDbgImageLoader.Create(FileName);
|
||||
if not FImageLoader.IsValid then begin
|
||||
FreeAndNil(FImageLoader);
|
||||
@ -759,7 +762,7 @@ end;
|
||||
|
||||
procedure TFpGDBMIDebugger.UnLoadDwarf;
|
||||
begin
|
||||
debugln(['TFpGDBMIDebugger.UnLoadDwarf ']);
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFpGDBMIDebugger.UnLoadDwarf ']);
|
||||
FreeAndNil(FDwarfInfo);
|
||||
FreeAndNil(FImageLoader);
|
||||
FreeAndNil(FMemReader);
|
||||
@ -851,7 +854,7 @@ begin
|
||||
|
||||
t := Threads.CurrentThreads.EntryById[AThreadId];
|
||||
if t = nil then begin
|
||||
DebugLn(['NO Threads']);
|
||||
DebugLn(FPGDBDBG_ERROR, ['NO Threads']);
|
||||
exit;
|
||||
end;
|
||||
if AStackFrame = 0 then begin
|
||||
@ -862,12 +865,12 @@ begin
|
||||
|
||||
s := CallStack.CurrentCallStackList.EntriesForThreads[AThreadId];
|
||||
if s = nil then begin
|
||||
DebugLn(['NO Stackframe list for thread']);
|
||||
DebugLn(FPGDBDBG_ERROR, ['NO Stackframe list for thread']);
|
||||
exit;
|
||||
end;
|
||||
f := s.Entries[AStackFrame];
|
||||
if f = nil then begin
|
||||
DebugLn(['NO Stackframe']);
|
||||
DebugLn(FPGDBDBG_ERROR, ['NO Stackframe']);
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -909,7 +912,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
DebugLn(['* FDwarfInfo.FindContext ', dbgs(Addr)]);
|
||||
DebugLn(FPGDBDBG_VERBOSE, ['* FDwarfInfo.FindContext ', dbgs(Addr)]);
|
||||
Result := FDwarfInfo.FindContext(AThreadId, AStackFrame, Addr);
|
||||
|
||||
FLastThread := AThreadId;
|
||||
@ -929,9 +932,8 @@ begin
|
||||
FWatchEvalList.Remove(pointer(Sender));
|
||||
end;
|
||||
|
||||
function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue;
|
||||
AExpression: String; var AResText: String; out ATypeInfo: TDBGType;
|
||||
EvalFlags: TDBGEvaluateFlags): Boolean;
|
||||
function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue; AExpression: String;
|
||||
out AResText: String; out ATypeInfo: TDBGType; EvalFlags: TDBGEvaluateFlags): Boolean;
|
||||
var
|
||||
Ctx: TFpDbgInfoContext;
|
||||
PasExpr: TFpPascalExpression;
|
||||
@ -949,171 +951,11 @@ var
|
||||
);
|
||||
end;
|
||||
|
||||
function ResTypeName(v: TFpDbgValue = nil): String;
|
||||
begin
|
||||
if v = nil then v := ResValue;
|
||||
if not((v.TypeInfo<> nil) and
|
||||
GetTypeName(Result, v.TypeInfo, []))
|
||||
then
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
procedure DoPointer;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skPointer, ResTypeName);
|
||||
ATypeInfo.Value.AsPointer := Pointer(ResValue.AsCardinal); // TODO: no cut off
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
end;
|
||||
|
||||
procedure DoSimple;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
end;
|
||||
|
||||
procedure DoEnum;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skEnum, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
end;
|
||||
|
||||
procedure DoSet;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skSet, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
end;
|
||||
|
||||
procedure DoRecord;
|
||||
var
|
||||
s2, n: String;
|
||||
m: TFpDbgValue;
|
||||
i: Integer;
|
||||
DBGType: TGDBType;
|
||||
f: TDBGField;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skRecord, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
|
||||
if not(defFullTypeInfo in EvalFlags) then exit;
|
||||
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));
|
||||
FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
|
||||
DBGType.Value.AsString := s2;
|
||||
n := '';
|
||||
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
|
||||
f := TDBGField.Create(n, DBGType, flPublic);
|
||||
ATypeInfo.Fields.Add(f);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoClass;
|
||||
var
|
||||
m: TFpDbgValue;
|
||||
s, s2, n, CastName: String;
|
||||
DBGType: TGDBType;
|
||||
f: TDBGField;
|
||||
i: Integer;
|
||||
ClassAddr, CNameAddr: TFpDbgMemLocation;
|
||||
NameLen: QWord;
|
||||
PasExpr2: TFpPascalExpression;
|
||||
begin
|
||||
if (ResValue.Kind = skClass) and (ResValue.AsCardinal = 0) then begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skSimple, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
Result := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
CastName := '';
|
||||
if (defClassAutoCast in EvalFlags) and (ResValue.Kind = skClass) then begin
|
||||
if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin
|
||||
ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress;
|
||||
if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin
|
||||
if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then
|
||||
if NameLen > 0 then begin
|
||||
SetLength(CastName, NameLen);
|
||||
CNameAddr.Address := CNameAddr.Address + 1;
|
||||
FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]);
|
||||
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
|
||||
if PasExpr2.Valid and (PasExpr2.ResultValue <> nil) then begin
|
||||
PasExpr.Free;
|
||||
PasExpr := PasExpr2;
|
||||
ResValue := PasExpr.ResultValue;
|
||||
end
|
||||
else
|
||||
PasExpr2.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
if CastName <> '' then AResText := CastName + AResText;
|
||||
//if PasExpr.ResultValue.Kind = skObject then
|
||||
// ATypeInfo := TDBGType.Create(skObject, ResTypeName)
|
||||
//else
|
||||
ATypeInfo := TDBGType.Create(skClass, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
|
||||
if not(defFullTypeInfo in EvalFlags) then exit;
|
||||
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));
|
||||
FPrettyPrinter.PrintValue(s2, m, DispFormat, RepeatCnt);
|
||||
DBGType.Value.AsString := s2;
|
||||
n := '';
|
||||
if m.DbgSymbol <> nil then n := m.DbgSymbol.Name;
|
||||
s := '';
|
||||
if m.ContextTypeInfo <> nil then s := m.ContextTypeInfo.Name;
|
||||
// TODO visibility // flags virtual, constructor
|
||||
f := TDBGField.Create(n, DBGType, flPublic, [], s);
|
||||
ATypeInfo.Fields.Add(f);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoArray;
|
||||
begin
|
||||
if not FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt) then
|
||||
exit;
|
||||
ATypeInfo := TDBGType.Create(skArray, ResTypeName);
|
||||
ATypeInfo.Value.AsString := AResText;
|
||||
//ATypeInfo.Len;
|
||||
//ATypeInfo.BoundLow;
|
||||
//ATypeInfo.BoundHigh;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
ATypeInfo := nil;
|
||||
AResText := '';
|
||||
if AWatchValue <> nil then begin
|
||||
EvalFlags := AWatchValue.EvaluateFlags;
|
||||
AExpression := AWatchValue.Expression;
|
||||
@ -1148,7 +990,7 @@ begin
|
||||
if not IsWatchValueAlive then exit;
|
||||
|
||||
if not PasExpr.Valid then begin
|
||||
DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
|
||||
DebugLn(FPGDBDBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
|
||||
if ErrorCode(PasExpr.Error) <> fpErrAnyError then begin
|
||||
Result := True;
|
||||
AResText := ErrorHandler.ErrorAsString(PasExpr.Error);;
|
||||
@ -1167,28 +1009,6 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
|
||||
ResValue := PasExpr.ResultValue;
|
||||
|
||||
case ResValue.Kind of
|
||||
skUnit: ;
|
||||
skProcedure: ;
|
||||
skFunction: ;
|
||||
skPointer: DoPointer;
|
||||
skInteger: DoSimple;
|
||||
skCardinal: DoSimple;
|
||||
skBoolean: DoSimple;
|
||||
skChar: DoSimple;
|
||||
skFloat: DoSimple;
|
||||
skString: ;
|
||||
skAnsiString: ;
|
||||
skCurrency: ;
|
||||
skVariant: ;
|
||||
skWideString: ;
|
||||
skEnum: DoEnum;
|
||||
skEnumValue: DoSimple;
|
||||
skSet: DoSet;
|
||||
skRecord: DoRecord;
|
||||
skObject: DoClass;
|
||||
skClass: DoClass;
|
||||
skInterface: ;
|
||||
skArray: DoArray;
|
||||
skNone: begin
|
||||
// maybe type
|
||||
TiSym := ResValue.DbgSymbol;
|
||||
@ -1206,6 +1026,13 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
if defNoTypeInfo in EvalFlags then
|
||||
FPrettyPrinter.PrintValue(AResText, ResValue, DispFormat, RepeatCnt)
|
||||
else
|
||||
FPrettyPrinter.PrintValue(AResText, ATypeInfo, ResValue, DispFormat, RepeatCnt);
|
||||
end;
|
||||
end;
|
||||
if not IsWatchValueAlive then exit;
|
||||
|
||||
@ -1219,10 +1046,10 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
|
||||
AResText := 'PChar: '+AResText+ LineEnding + 'String: '+s;
|
||||
end;
|
||||
|
||||
if ATypeInfo <> nil then begin
|
||||
if (ATypeInfo <> nil) or (AResText <> '') then begin
|
||||
Result := True;
|
||||
debugln(['TFPGDBMIWatches.InternalRequestData GOOOOOOD ', AExpression]);
|
||||
if AWatchValue <> nil then begin;
|
||||
debugln(FPGDBDBG_VERBOSE, ['TFPGDBMIWatches.InternalRequestData GOOOOOOD ', AExpression]);
|
||||
if AWatchValue <> nil then begin
|
||||
AWatchValue.Value := AResText;
|
||||
AWatchValue.TypeInfo := ATypeInfo;
|
||||
if IsError(ResValue.LastError) then
|
||||
@ -1289,5 +1116,8 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
initialization
|
||||
FPGDBDBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('FPGDBDBG_VERBOSE' {$IFDEF FPGDBDBG_VERBOSE} , True {$ENDIF} );
|
||||
FPGDBDBG_ERROR := DebugLogger.FindOrRegisterLogGroup('FPGDBDBG_ERROR' {$IFDEF FPGDBDBG_ERROR} , True {$ENDIF} );
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user