mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-14 15:39:20 +02:00
Debugger, LazDebuggerIntf: Introduce SetNumValue and SetTypeName
This commit is contained in:
parent
442f57cf49
commit
8e3c816593
@ -14615,7 +14615,9 @@ var
|
|||||||
var
|
var
|
||||||
S: String;
|
S: String;
|
||||||
ResultList: TGDBMINameValueList;
|
ResultList: TGDBMINameValueList;
|
||||||
frameidx: Integer;
|
frameidx, n: Integer;
|
||||||
|
NumVal: QWord;
|
||||||
|
NumFlags: TNumValueFlags;
|
||||||
{$IFDEF DBG_WITH_GDB_WATCHES} R: TGDBMIExecResult; {$ENDIF}
|
{$IFDEF DBG_WITH_GDB_WATCHES} R: TGDBMIExecResult; {$ENDIF}
|
||||||
begin
|
begin
|
||||||
SelectContext;
|
SelectContext;
|
||||||
@ -14675,6 +14677,36 @@ begin
|
|||||||
finally
|
finally
|
||||||
UnSelectContext;
|
UnSelectContext;
|
||||||
if FWatchValue <> nil then begin
|
if FWatchValue <> nil then begin
|
||||||
|
if (FTypeInfo <> nil) and (FTypeInfo.Kind in [skSimple, skPointer, skInteger, skCardinal]) and
|
||||||
|
(FWatchValue.RepeatCount <= 0)
|
||||||
|
then begin
|
||||||
|
NumFlags := [];
|
||||||
|
n := 0;
|
||||||
|
if (FTypeInfo.Kind = skPointer) then begin
|
||||||
|
NumFlags := [nvfAddrType];
|
||||||
|
n := TargetInfo^.TargetPtrSize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FTextValue := Trim(FTextValue);
|
||||||
|
if (FTypeInfo.Kind = skInteger) or ((FTextValue <> '') and (FTextValue[1]='-')) then begin
|
||||||
|
if TryStrToInt64(FTextValue, Int64(NumVal)) then begin
|
||||||
|
FWatchValue.SetNumValue(NumVal, n, NumFlags);
|
||||||
|
FWatchValue.SetTypeName(FTypeInfo.TypeName);
|
||||||
|
FWatchValue.Validity := FValidity;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
Include(NumFlags, nvfUnsigned);
|
||||||
|
if TryStrToQWord(FTextValue, NumVal) then begin
|
||||||
|
FWatchValue.SetNumValue(NumVal, n, NumFlags);
|
||||||
|
FWatchValue.SetTypeName(FTypeInfo.TypeName);
|
||||||
|
FWatchValue.Validity := FValidity;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
FWatchValue.Value := FTextValue;
|
FWatchValue.Value := FTextValue;
|
||||||
FWatchValue.TypeInfo := TypeInfo;
|
FWatchValue.TypeInfo := TypeInfo;
|
||||||
FWatchValue.Validity := FValidity;
|
FWatchValue.Validity := FValidity;
|
||||||
|
@ -950,7 +950,7 @@ var
|
|||||||
APasExpr, PasExpr2: TFpPascalExpression;
|
APasExpr, PasExpr2: TFpPascalExpression;
|
||||||
PrettyPrinter: TFpPascalPrettyPrinter;
|
PrettyPrinter: TFpPascalPrettyPrinter;
|
||||||
ResValue: TFpValue;
|
ResValue: TFpValue;
|
||||||
CastName, ResText2: String;
|
CastName, ResText2, t: String;
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
AResText := '';
|
AResText := '';
|
||||||
@ -1019,6 +1019,34 @@ begin
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
if (FWatchValue <> nil) and (ADispFormat <> wdfMemDump) and (FWatchValue.RepeatCount <= 0) and
|
||||||
|
(ResValue <> nil) and (not IsError(ResValue.LastError))
|
||||||
|
then begin
|
||||||
|
t := '';
|
||||||
|
if ResValue.TypeInfo <> nil then
|
||||||
|
GetTypeName(t, ResValue.TypeInfo, []);
|
||||||
|
case ResValue.Kind of
|
||||||
|
skPointer: begin
|
||||||
|
if ResValue.FieldFlags * [svfString, svfWideString] = [] then begin
|
||||||
|
FWatchValue.SetNumValue(ResValue.AsCardinal, SizeToFullBytes(ResValue.DataSize), [nvfUnsigned, nvfAddrType]);
|
||||||
|
FWatchValue.SetTypeName(t);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
skInteger: begin
|
||||||
|
FWatchValue.SetNumValue(QWord(ResValue.AsInteger), SizeToFullBytes(ResValue.DataSize), []);
|
||||||
|
FWatchValue.SetTypeName(t);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
skCardinal: begin
|
||||||
|
FWatchValue.SetNumValue(ResValue.AsCardinal, SizeToFullBytes(ResValue.DataSize), [nvfUnsigned]);
|
||||||
|
FWatchValue.SetTypeName(t);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
PrettyPrinter := TFpPascalPrettyPrinter.Create(FExpressionScope.SizeOfAddress);
|
PrettyPrinter := TFpPascalPrettyPrinter.Create(FExpressionScope.SizeOfAddress);
|
||||||
PrettyPrinter.Context := FExpressionScope.LocationContext;
|
PrettyPrinter.Context := FExpressionScope.LocationContext;
|
||||||
|
|
||||||
|
@ -150,6 +150,15 @@ type
|
|||||||
TDBGTypeBase = class(TObject)
|
TDBGTypeBase = class(TObject)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
TNumValueFlag = (
|
||||||
|
nvfUnsigned,
|
||||||
|
//nvfUnknownSize, // same as size = 0
|
||||||
|
nvfAddrType // default to hex display (Pointer)
|
||||||
|
);
|
||||||
|
TNumValueFlags = set of TNumValueFlag;
|
||||||
|
|
||||||
{ TWatchValueIntf }
|
{ TWatchValueIntf }
|
||||||
|
|
||||||
TWatchValueIntf = interface(TDbgDataRequestIntf)
|
TWatchValueIntf = interface(TDbgDataRequestIntf)
|
||||||
@ -182,6 +191,9 @@ type
|
|||||||
procedure AddNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
|
procedure AddNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
|
||||||
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
|
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
|
||||||
|
|
||||||
|
procedure SetNumValue(ANumValue: QWord; AByteSize: Integer = 0; AFlags: TNumValueFlags = []);
|
||||||
|
procedure SetTypeName(ATypeName: String);
|
||||||
|
|
||||||
function GetDisplayFormat: TWatchDisplayFormat;
|
function GetDisplayFormat: TWatchDisplayFormat;
|
||||||
function GetEvaluateFlags: TWatcheEvaluateFlags;
|
function GetEvaluateFlags: TWatcheEvaluateFlags;
|
||||||
function GetExpression: String;
|
function GetExpression: String;
|
||||||
|
@ -42,9 +42,9 @@ uses
|
|||||||
{$ifdef Windows} ActiveX, {$else} laz.FakeActiveX, {$endif}
|
{$ifdef Windows} ActiveX, {$else} laz.FakeActiveX, {$endif}
|
||||||
IDEWindowIntf, Menus, ComCtrls, ActnList, ExtCtrls, StdCtrls, LCLType,
|
IDEWindowIntf, Menus, ComCtrls, ActnList, ExtCtrls, StdCtrls, LCLType,
|
||||||
IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
|
IDEImagesIntf, LazarusIDEStrConsts, DebuggerStrConst, Debugger,
|
||||||
DebuggerTreeView, DebuggerDlg, DbgIntfBaseTypes, DbgIntfDebuggerBase,
|
DebuggerTreeView, IdeDebuggerBase, DebuggerDlg, DbgIntfBaseTypes,
|
||||||
DbgIntfMiscClasses, SynEdit, laz.VirtualTrees, LazDebuggerIntf,
|
DbgIntfDebuggerBase, DbgIntfMiscClasses, SynEdit, laz.VirtualTrees,
|
||||||
BaseDebugManager, EnvironmentOpts;
|
LazDebuggerIntf, BaseDebugManager, EnvironmentOpts;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -1018,12 +1018,19 @@ begin
|
|||||||
if (WatchValue <> nil) and
|
if (WatchValue <> nil) and
|
||||||
( (GetSelectedSnapshot = nil) or not(WatchValue.Validity in [ddsUnknown, ddsEvaluating, ddsRequested]) )
|
( (GetSelectedSnapshot = nil) or not(WatchValue.Validity in [ddsUnknown, ddsEvaluating, ddsRequested]) )
|
||||||
then begin
|
then begin
|
||||||
WatchValueStr := ClearMultiline(DebugBoss.FormatValue(WatchValue.TypeInfo, WatchValue.Value));
|
if (vtNumVal in WatchValue.ValidTypes) and
|
||||||
if (WatchValue.TypeInfo <> nil) and
|
not(AWatch.DisplayFormat in [wdfMemDump, wdfChar, wdfString, wdfFloat])
|
||||||
(WatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and
|
then begin
|
||||||
(WatchValue.TypeInfo.Len >= 0)
|
tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := WatchValue.NumValue[AWatch.DisplayFormat];
|
||||||
then tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := Format(drsLen, [WatchValue.TypeInfo.Len]) + WatchValueStr
|
end
|
||||||
else tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := WatchValueStr;
|
else begin
|
||||||
|
WatchValueStr := ClearMultiline(DebugBoss.FormatValue(WatchValue.TypeInfo, WatchValue.Value));
|
||||||
|
if (WatchValue.TypeInfo <> nil) and
|
||||||
|
(WatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and
|
||||||
|
(WatchValue.TypeInfo.Len >= 0)
|
||||||
|
then tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := Format(drsLen, [WatchValue.TypeInfo.Len]) + WatchValueStr
|
||||||
|
else tvWatches.NodeText[VNode, COL_WATCH_VALUE-1] := WatchValueStr;
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '<not evaluated>';
|
tvWatches.NodeText[VNode, COL_WATCH_VALUE-1]:= '<not evaluated>';
|
||||||
|
@ -6,12 +6,15 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, DbgIntfDebuggerBase, DbgIntfMiscClasses, LazClasses,
|
Classes, SysUtils, DbgIntfDebuggerBase, DbgIntfMiscClasses, LazClasses,
|
||||||
LazLoggerBase, LazDebuggerIntf, LazDebuggerTemplate;
|
LazLoggerBase, StrUtils, LazDebuggerIntf, LazDebuggerTemplate;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
TWatch = class;
|
TWatch = class;
|
||||||
|
|
||||||
|
TWatchValueTypeFlag = (vtTypeName, vtNumVal);
|
||||||
|
TWatchValueTypeFlags = set of TWatchValueTypeFlag;
|
||||||
|
|
||||||
{ TWatchValue }
|
{ TWatchValue }
|
||||||
|
|
||||||
TWatchValue = class(TRefCountedObject)
|
TWatchValue = class(TRefCountedObject)
|
||||||
@ -21,6 +24,13 @@ type
|
|||||||
FValue: String;
|
FValue: String;
|
||||||
FValidity: TDebuggerDataState;
|
FValidity: TDebuggerDataState;
|
||||||
|
|
||||||
|
FValidTypes: TWatchValueTypeFlags;
|
||||||
|
FNumValue: QWord;
|
||||||
|
FNumByteSize: Integer;
|
||||||
|
FNumFlags: TNumValueFlags;
|
||||||
|
FTypeName: String;
|
||||||
|
function GetNumValue(ADispFormat: TWatchDisplayFormat): String;
|
||||||
|
|
||||||
protected
|
protected
|
||||||
procedure SetWatch(AValue: TWatch); virtual;
|
procedure SetWatch(AValue: TWatch); virtual;
|
||||||
function GetDisplayFormat: TWatchDisplayFormat;
|
function GetDisplayFormat: TWatchDisplayFormat;
|
||||||
@ -33,6 +43,9 @@ type
|
|||||||
procedure SetValue(AValue: String);
|
procedure SetValue(AValue: String);
|
||||||
procedure SetTypeInfo(AValue: TDBGType);
|
procedure SetTypeInfo(AValue: TDBGType);
|
||||||
procedure SetTypeInfo(AValue: TDBGTypeBase);
|
procedure SetTypeInfo(AValue: TDBGTypeBase);
|
||||||
|
|
||||||
|
procedure SetNumValue(ANumValue: QWord; AByteSize: Integer = 0; AFlags: TNumValueFlags = []);
|
||||||
|
procedure SetTypeName(ATypeName: String);
|
||||||
protected
|
protected
|
||||||
FDisplayFormat: TWatchDisplayFormat;
|
FDisplayFormat: TWatchDisplayFormat;
|
||||||
FEvaluateFlags: TWatcheEvaluateFlags;
|
FEvaluateFlags: TWatcheEvaluateFlags;
|
||||||
@ -54,11 +67,18 @@ type
|
|||||||
property ThreadId: Integer read GetThreadId;
|
property ThreadId: Integer read GetThreadId;
|
||||||
property StackFrame: Integer read GetStackFrame;
|
property StackFrame: Integer read GetStackFrame;
|
||||||
property Expression: String read GetExpression;
|
property Expression: String read GetExpression;
|
||||||
|
public
|
||||||
|
property ValidTypes: TWatchValueTypeFlags read FValidTypes;
|
||||||
public
|
public
|
||||||
property Watch: TWatch read FWatch write SetWatch;
|
property Watch: TWatch read FWatch write SetWatch;
|
||||||
property Validity: TDebuggerDataState read GetValidity write SetValidity;
|
property Validity: TDebuggerDataState read GetValidity write SetValidity;
|
||||||
property Value: String read GetValue write SetValue;
|
property Value: String read GetValue write SetValue;
|
||||||
property TypeInfo: TDBGType read GetTypeInfo write SetTypeInfo;
|
property TypeInfo: TDBGType read GetTypeInfo write SetTypeInfo;
|
||||||
|
|
||||||
|
property NumValue[ADispFormat: TWatchDisplayFormat]: String read GetNumValue;
|
||||||
|
property NumValueRaw: QWord read FNumValue;
|
||||||
|
property TypeName: String read FTypeName;
|
||||||
|
property NumFlags: TNumValueFlags read FNumFlags;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TWatchValueList }
|
{ TWatchValueList }
|
||||||
@ -185,6 +205,89 @@ begin
|
|||||||
Result := FEvaluateFlags;
|
Result := FEvaluateFlags;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TWatchValue.GetNumValue(ADispFormat: TWatchDisplayFormat): String;
|
||||||
|
function HexDigicCount(ANum: QWord; AForceAddr: Boolean = False): integer;
|
||||||
|
begin
|
||||||
|
if (FNumValue > high(DWord)) then
|
||||||
|
Result := 16
|
||||||
|
else
|
||||||
|
if (FNumValue > high(Word)) then
|
||||||
|
Result := 8
|
||||||
|
else
|
||||||
|
if (FNumValue > high(Byte)) then
|
||||||
|
Result := 4
|
||||||
|
else
|
||||||
|
Result := 2;
|
||||||
|
|
||||||
|
if FNumByteSize*2 > Result then
|
||||||
|
Result := FNumByteSize*2;
|
||||||
|
|
||||||
|
if AForceAddr or ( (nvfAddrType in FNumFlags) and (FNumByteSize = 0) ) then begin
|
||||||
|
// Fallback / TODO: Use Target-AddrSize
|
||||||
|
if Result < SizeOf(Pointer)*2 then
|
||||||
|
Result := 16;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
n: Integer;
|
||||||
|
t: String;
|
||||||
|
begin
|
||||||
|
if (Validity <> ddsValid) or not(vtNumVal in FValidTypes) then
|
||||||
|
exit(Value);
|
||||||
|
|
||||||
|
if (nvfAddrType in FNumFlags) and (FTypeName <> '') and
|
||||||
|
(ADispFormat in [wdfDefault, wdfStructure])
|
||||||
|
then
|
||||||
|
t := FTypeName;
|
||||||
|
|
||||||
|
if ( ((nvfAddrType in FNumFlags) and (ADispFormat in [wdfDefault, wdfStructure])) or
|
||||||
|
(ADispFormat = wdfPointer)
|
||||||
|
) and
|
||||||
|
(FNumValue = 0)
|
||||||
|
then begin
|
||||||
|
Result := 'nil';
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
if not (ADispFormat in [wdfDecimal, wdfUnsigned, wdfHex, wdfBinary, wdfPointer]) then begin
|
||||||
|
//wdfDefault, wdfStructure, wdfChar, wdfString, wdfFloat
|
||||||
|
if nvfAddrType in FNumFlags then
|
||||||
|
ADispFormat := wdfPointer
|
||||||
|
else
|
||||||
|
if nvfUnsigned in FNumFlags then
|
||||||
|
ADispFormat := wdfUnsigned
|
||||||
|
else
|
||||||
|
ADispFormat := wdfDecimal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case ADispFormat of
|
||||||
|
wdfUnsigned: begin
|
||||||
|
Result := IntToStr(QWord(FNumValue))
|
||||||
|
end;
|
||||||
|
wdfHex: begin
|
||||||
|
n := HexDigicCount(FNumValue);
|
||||||
|
Result := '$'+IntToHex(QWord(FNumValue), n);
|
||||||
|
end;
|
||||||
|
wdfBinary: begin
|
||||||
|
n := HexDigicCount(FNumValue);
|
||||||
|
Result := '%'+IntToBin(Int64(FNumValue), n*4);
|
||||||
|
end;
|
||||||
|
wdfPointer: begin
|
||||||
|
n := HexDigicCount(FNumValue, True);
|
||||||
|
Result := '$'+IntToHex(QWord(FNumValue), n);
|
||||||
|
end;
|
||||||
|
else begin // wdfDecimal
|
||||||
|
if nvfUnsigned in FNumFlags then
|
||||||
|
Result := IntToStr(QWord(FNumValue))
|
||||||
|
else
|
||||||
|
Result := IntToStr(Int64(FNumValue));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if t <> '' then
|
||||||
|
Result := t + '(' + Result + ')';
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TWatchValue.SetWatch(AValue: TWatch);
|
procedure TWatchValue.SetWatch(AValue: TWatch);
|
||||||
begin
|
begin
|
||||||
if FWatch = AValue then Exit;
|
if FWatch = AValue then Exit;
|
||||||
@ -225,9 +328,27 @@ begin
|
|||||||
SetTypeInfo(TDBGType(AValue));
|
SetTypeInfo(TDBGType(AValue));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TWatchValue.SetNumValue(ANumValue: QWord; AByteSize: Integer;
|
||||||
|
AFlags: TNumValueFlags);
|
||||||
|
begin
|
||||||
|
assert(not(vtNumVal in FValidTypes), 'TWatchValue.SetNumValue: not(vtNumVal in FValidTypes)');
|
||||||
|
Include(FValidTypes, vtNumVal);
|
||||||
|
FNumValue := ANumValue;
|
||||||
|
FNumByteSize := AByteSize;
|
||||||
|
FNumFlags := AFlags;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TWatchValue.SetTypeName(ATypeName: String);
|
||||||
|
begin
|
||||||
|
assert(not(vtTypeName in FValidTypes), 'TWatchValue.SetTypeName: not(vtTypeName in FValidTypes)');
|
||||||
|
Include(FValidTypes, vtTypeName);
|
||||||
|
FTypeName := ATypeName;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TWatchValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
|
procedure TWatchValue.DoDataValidityChanged(AnOldValidity: TDebuggerDataState);
|
||||||
begin
|
begin
|
||||||
|
//
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TWatchValue.GetExpression: String;
|
function TWatchValue.GetExpression: String;
|
||||||
@ -272,6 +393,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
FValue := AnOther.FValue;
|
FValue := AnOther.FValue;
|
||||||
FValidity := AnOther.FValidity;
|
FValidity := AnOther.FValidity;
|
||||||
|
|
||||||
|
FValidTypes := AnOther.FValidTypes;
|
||||||
|
FNumValue := AnOther.FNumValue;
|
||||||
|
FNumByteSize := AnOther.FNumByteSize;
|
||||||
|
FNumFlags := AnOther.FNumFlags;
|
||||||
|
FTypeName := AnOther.FTypeName;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TWatch }
|
{ TWatch }
|
||||||
@ -435,7 +562,11 @@ begin
|
|||||||
while i >= 0 do begin
|
while i >= 0 do begin
|
||||||
Result := TWatchValue(FList[i]);
|
Result := TWatchValue(FList[i]);
|
||||||
if (Result.ThreadId = AThreadId) and (Result.StackFrame = AStackFrame) and
|
if (Result.ThreadId = AThreadId) and (Result.StackFrame = AStackFrame) and
|
||||||
(Result.DisplayFormat = FWatch.DisplayFormat) and
|
( ( (vtNumVal in Result.ValidTypes) and
|
||||||
|
not(FWatch.DisplayFormat in [wdfMemDump, wdfChar, wdfString, wdfFloat])
|
||||||
|
) or
|
||||||
|
(Result.DisplayFormat = FWatch.DisplayFormat)
|
||||||
|
) and
|
||||||
(Result.RepeatCount = FWatch.RepeatCount) and
|
(Result.RepeatCount = FWatch.RepeatCount) and
|
||||||
(Result.EvaluateFlags = FWatch.EvaluateFlags)
|
(Result.EvaluateFlags = FWatch.EvaluateFlags)
|
||||||
then
|
then
|
||||||
|
Loading…
Reference in New Issue
Block a user