mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 18:02:44 +02:00
DBG: initial implementation of display-styles for watches
git-svn-id: trunk@28468 -
This commit is contained in:
martin
parent
6aa94b7db4
commit
795b3b3fb5
@ -562,34 +562,60 @@ type
|
||||
(******************************************************************************)
|
||||
(******************************************************************************)
|
||||
|
||||
TWatchDisplayFormat =
|
||||
(wdfDefault,
|
||||
wdfStructure,
|
||||
wdfChar, wdfString,
|
||||
wdfDecimal, wdfUnsigned, wdfFloat, wdfHex,
|
||||
wdfPointer,
|
||||
wdfMemDump
|
||||
);
|
||||
|
||||
const
|
||||
TWatchDisplayFormatNames: array [TWatchDisplayFormat] of string =
|
||||
('wdfDefault',
|
||||
'wdfStructure',
|
||||
'wdfChar', 'wdfString',
|
||||
'wdfDecimal', 'wdfUnsigned', 'wdfFloat', 'wdfHex',
|
||||
'wdfPointer',
|
||||
'wdfMemDump'
|
||||
);
|
||||
|
||||
type
|
||||
|
||||
{ TBaseWatch }
|
||||
|
||||
TBaseWatch = class(TDelayedUdateItem)
|
||||
private
|
||||
FEnabled: Boolean;
|
||||
FExpression: String;
|
||||
FDisplayFormat: TWatchDisplayFormat;
|
||||
FValid: TValidState;
|
||||
function GetEnabled: Boolean;
|
||||
protected
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
procedure DoEnableChange; virtual;
|
||||
procedure DoExpressionChange; virtual;
|
||||
procedure DoDisplayFormatChanged; virtual;
|
||||
procedure SetValid(const AValue: TValidState);
|
||||
|
||||
protected
|
||||
// virtual properties
|
||||
function GetExpression: String; virtual;
|
||||
function GetDisplayFormat: TWatchDisplayFormat; virtual;
|
||||
function GetValid: TValidState; virtual;
|
||||
function GetValue: String; virtual;
|
||||
function GetTypeInfo: TDBGType; virtual;
|
||||
|
||||
procedure SetEnabled(const AValue: Boolean); virtual;
|
||||
procedure SetExpression(const AValue: String); virtual;
|
||||
procedure SetDisplayFormat(const AValue: TWatchDisplayFormat); virtual;
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
public
|
||||
property Enabled: Boolean read GetEnabled write SetEnabled;
|
||||
property Expression: String read GetExpression write SetExpression;
|
||||
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat write SetDisplayFormat;
|
||||
property Valid: TValidState read GetValid;
|
||||
property Value: String read GetValue;
|
||||
property TypeInfo: TDBGType read GetTypeInfo;
|
||||
@ -3356,6 +3382,7 @@ begin
|
||||
then begin
|
||||
TBaseWatch(Dest).SetExpression(FExpression);
|
||||
TBaseWatch(Dest).SetEnabled(FEnabled);
|
||||
TBaseWatch(Dest).SetDisplayFormat(FDisplayFormat);
|
||||
end
|
||||
else inherited;
|
||||
end;
|
||||
@ -3378,11 +3405,28 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TBaseWatch.DoDisplayFormatChanged;
|
||||
begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
function TBaseWatch.GetEnabled: Boolean;
|
||||
begin
|
||||
Result := FEnabled;
|
||||
end;
|
||||
|
||||
function TBaseWatch.GetDisplayFormat: TWatchDisplayFormat;
|
||||
begin
|
||||
Result := FDisplayFormat;
|
||||
end;
|
||||
|
||||
procedure TBaseWatch.SetDisplayFormat(const AValue: TWatchDisplayFormat);
|
||||
begin
|
||||
if AValue = FDisplayFormat then exit;
|
||||
FDisplayFormat := AValue;
|
||||
DoDisplayFormatChanged;
|
||||
end;
|
||||
|
||||
function TBaseWatch.GetExpression: String;
|
||||
begin
|
||||
Result := FExpression;
|
||||
@ -3456,15 +3500,25 @@ begin
|
||||
end;
|
||||
|
||||
procedure TIDEWatch.LoadFromXMLConfig(const AConfig: TXMLConfig; const APath: string);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Expression := AConfig.GetValue(APath + 'Expression/Value', '');
|
||||
Enabled := AConfig.GetValue(APath + 'Enabled/Value', true);
|
||||
i := StringCase
|
||||
(AConfig.GetValue(APath + 'DisplayStyle/Value', TWatchDisplayFormatNames[wdfDefault]),
|
||||
TWatchDisplayFormatNames);
|
||||
if i >= 0
|
||||
then DisplayFormat := TWatchDisplayFormat(i)
|
||||
else DisplayFormat := wdfDefault;
|
||||
end;
|
||||
|
||||
procedure TIDEWatch.SaveToXMLConfig(const AConfig: TXMLConfig; const APath: string);
|
||||
begin
|
||||
AConfig.SetDeleteValue(APath + 'Expression/Value', Expression, '');
|
||||
AConfig.SetDeleteValue(APath + 'Enabled/Value', Enabled, true);
|
||||
AConfig.SetDeleteValue(APath + 'DisplayStyle/Value',
|
||||
TWatchDisplayFormatNames[DisplayFormat], TWatchDisplayFormatNames[wdfDefault]);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -162,6 +162,7 @@ type
|
||||
FState : TGDBMIDebuggerCommandState;
|
||||
FSeenStates: TGDBMIDebuggerCommandStates;
|
||||
FTheDebugger: TGDBMIDebugger; // Set during Execute
|
||||
FLastExecResult: TGDBMIExecResult;
|
||||
function GetDebuggerState: TDBGState;
|
||||
function GetTargetInfo: PGDBMITargetInfo;
|
||||
procedure SetKeepFinished(const AValue: Boolean);
|
||||
@ -201,6 +202,8 @@ type
|
||||
function GetFrame(const AIndex: Integer): String;
|
||||
function GetText(const ALocation: TDBGPtr): String; overload;
|
||||
function GetText(const AExpression: String; const AValues: array of const): String; overload;
|
||||
function GetChar(const AExpression: String; const AValues: array of const): String; overload;
|
||||
function GetFloat(const AExpression: String; const AValues: array of const): String;
|
||||
function GetWideText(const ALocation: TDBGPtr): String;
|
||||
function GetGDBTypeInfo(const AExpression: String): TGDBType;
|
||||
function GetClassName(const AClass: TDBGPtr): String; overload;
|
||||
@ -211,10 +214,11 @@ type
|
||||
function GetData(const AExpression: String; const AValues: array of const): TDbgPtr; overload;
|
||||
function GetStrValue(const AExpression: String; const AValues: array of const): String;
|
||||
function GetIntValue(const AExpression: String; const AValues: array of const): Integer;
|
||||
function GetPtrValue(const AExpression: String; const AValues: array of const): TDbgPtr;
|
||||
function GetPtrValue(const AExpression: String; const AValues: array of const; ConvertNegative: Boolean = False): TDbgPtr;
|
||||
procedure ProcessFrame(const AFrame: String = '');
|
||||
procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AText: String);
|
||||
property TargetInfo: PGDBMITargetInfo read GetTargetInfo;
|
||||
property LastExecResult: TGDBMIExecResult read FLastExecResult;
|
||||
public
|
||||
constructor Create(AOwner: TGDBMIDebugger);
|
||||
destructor Destroy; override;
|
||||
@ -436,6 +440,7 @@ type
|
||||
TGDBMIMemoryDumpResultList = class(TGDBMINameValueBasedList)
|
||||
private
|
||||
FAddr: TDBGPtr;
|
||||
function GetItem(Index: Integer): TPCharWithLen;
|
||||
function GetItemNum(Index: Integer): Integer;
|
||||
function GetItemTxt(Index: Integer): string;
|
||||
protected
|
||||
@ -443,9 +448,11 @@ type
|
||||
public
|
||||
// Expected input format: 1 row with hex values
|
||||
function Count: Integer;
|
||||
property Item[Index: Integer]: TPCharWithLen read GetItem;
|
||||
property ItemTxt[Index: Integer]: string read GetItemTxt;
|
||||
property ItemNum[Index: Integer]: Integer read GetItemNum;
|
||||
property Addr: TDBGPtr read FAddr;
|
||||
function AsText(AStartOffs, ACount: Integer; AAddrWidth: Integer): string;
|
||||
end;
|
||||
|
||||
{%endregion *^^^* TGDBMINameValueList and Parsers *^^^* }
|
||||
@ -783,14 +790,17 @@ type
|
||||
TGDBMIDebuggerCommandEvaluate = class(TGDBMIDebuggerCommand)
|
||||
private
|
||||
FExpression: String;
|
||||
FDisplayFormat: TWatchDisplayFormat;
|
||||
FTextValue: String;
|
||||
FTypeInfo: TGDBType;
|
||||
protected
|
||||
function DoExecute: Boolean; override;
|
||||
public
|
||||
constructor Create(AOwner: TGDBMIDebugger;const AExpression: String);
|
||||
constructor Create(AOwner: TGDBMIDebugger; const AExpression: String;
|
||||
const ADisplayFormat: TWatchDisplayFormat);
|
||||
function DebugText: String; override;
|
||||
property Expression: String read FExpression;
|
||||
property DisplayFormat: TWatchDisplayFormat read FDisplayFormat;
|
||||
property TextValue: String read FTextValue;
|
||||
property TypeInfo: TGDBType read FTypeInfo;
|
||||
end;
|
||||
@ -812,6 +822,7 @@ type
|
||||
protected
|
||||
procedure DoEnableChange; override;
|
||||
procedure DoExpressionChange; override;
|
||||
procedure DoDisplayFormatChanged; override;
|
||||
procedure DoChange; override;
|
||||
procedure DoStateChange(const AOldState: TDBGState); override;
|
||||
function GetValue: String; override;
|
||||
@ -1237,6 +1248,17 @@ begin
|
||||
Result := '"' + Result + '"';
|
||||
end;
|
||||
|
||||
function PCLenPartToString(const AVal: TPCharWithLen; AStartOffs, ALen: Integer): String;
|
||||
begin
|
||||
if AStartOffs + ALen > AVal.Len
|
||||
then ALen := AVal.Len - AStartOffs;
|
||||
if ALen <= 0
|
||||
then exit('');
|
||||
|
||||
SetLength(Result, ALen);
|
||||
Move((AVal.Ptr+AStartOffs)^, Result[1], aLen)
|
||||
end;
|
||||
|
||||
function PCLenToString(const AVal: TPCharWithLen; UnQuote: Boolean = False): String;
|
||||
begin
|
||||
if UnQuote and (AVal.Len >= 2) and (AVal.Ptr[0] = '"') and (AVal.Ptr[AVal.Len-1] = '"')
|
||||
@ -1629,6 +1651,11 @@ begin
|
||||
Result := PCLenToInt(FNameValueList.Items[Index]^.Name, 0);
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetItem(Index: Integer): TPCharWithLen;
|
||||
begin
|
||||
Result := FNameValueList.Items[Index]^.Name;
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.GetItemTxt(Index: Integer): string;
|
||||
begin
|
||||
Result := PCLenToString(FNameValueList.Items[Index]^.Name, True);
|
||||
@ -1648,6 +1675,20 @@ begin
|
||||
Result := FNameValueList.Count;
|
||||
end;
|
||||
|
||||
function TGDBMIMemoryDumpResultList.AsText(AStartOffs, ACount: Integer;
|
||||
AAddrWidth: Integer): string;
|
||||
var
|
||||
i: LongInt;
|
||||
begin
|
||||
if AAddrWidth > 0
|
||||
then Result := IntToHex(addr + AStartOffs, AAddrWidth) + ':'
|
||||
else Result := '';
|
||||
for i := AStartOffs to AStartOffs + ACount do begin
|
||||
if i >= ACount then exit;
|
||||
Result := Result + ' ' + PCLenPartToString(Item[i], 3, 2);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TGDBMIDisassembler }
|
||||
|
||||
procedure TGDBMIDisassembler.DoDisassembleDestroyed(Sender: TObject);
|
||||
@ -4854,7 +4895,7 @@ function TGDBMIDebugger.GDBEvaluate(const AExpression: String; var AResult: Stri
|
||||
var
|
||||
CommandObj: TGDBMIDebuggerCommandEvaluate;
|
||||
begin
|
||||
CommandObj := TGDBMIDebuggerCommandEvaluate.Create(Self, AExpression);
|
||||
CommandObj := TGDBMIDebuggerCommandEvaluate.Create(Self, AExpression, wdfDefault);
|
||||
CommandObj.KeepFinished := True;
|
||||
QueueCommand(CommandObj);
|
||||
Result := CommandObj.State in [dcsExecuting, dcsFinished];
|
||||
@ -6459,6 +6500,12 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TGDBMIWatch.DoDisplayFormatChanged;
|
||||
begin
|
||||
CancelEvaluation;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TGDBMIWatch.DoChange;
|
||||
begin
|
||||
Changed;
|
||||
@ -6512,7 +6559,8 @@ begin
|
||||
FEvaluatedState := esRequested;
|
||||
ClearOwned;
|
||||
SetValid(vsValid);
|
||||
FEvaluationCmdObj := TGDBMIDebuggerCommandEvaluate.Create(TGDBMIDebugger(Debugger), Expression);
|
||||
FEvaluationCmdObj := TGDBMIDebuggerCommandEvaluate.Create
|
||||
(TGDBMIDebugger(Debugger), Expression, DisplayFormat);
|
||||
FEvaluationCmdObj.OnExecuted := @DoEvaluationFinished;
|
||||
FEvaluationCmdObj.OnDestroy := @DoEvaluationDestroyed;
|
||||
TGDBMIDebugger(Debugger).QueueCommand(FEvaluationCmdObj);
|
||||
@ -7774,6 +7822,7 @@ begin
|
||||
|
||||
FTheDebugger.SendCmdLn(ACommand);
|
||||
Result := ProcessResult(AResult);
|
||||
FLastExecResult := AResult;
|
||||
|
||||
if not Result
|
||||
then begin
|
||||
@ -8084,6 +8133,32 @@ begin
|
||||
Result := ProcessGDBResultText(StripLN(R.Values));
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetChar(const AExpression: String;
|
||||
const AValues: array of const): String;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
begin
|
||||
if not ExecuteCommand('x/c ' + AExpression, AValues, R)
|
||||
then begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
Result := ProcessGDBResultText(StripLN(R.Values));
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetFloat(const AExpression: String;
|
||||
const AValues: array of const): String;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
begin
|
||||
if not ExecuteCommand('x/f ' + AExpression, AValues, R)
|
||||
then begin
|
||||
Result := '';
|
||||
Exit;
|
||||
end;
|
||||
Result := ProcessGDBResultText(StripLN(R.Values));
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetWideText(const ALocation: TDBGPtr): String;
|
||||
|
||||
function GetWideChar(const ALocation: TDBGPtr): WideChar;
|
||||
@ -8238,12 +8313,20 @@ begin
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetPtrValue(const AExpression: String;
|
||||
const AValues: array of const): TDbgPtr;
|
||||
const AValues: array of const; ConvertNegative: Boolean = False): TDbgPtr;
|
||||
var
|
||||
e: Integer;
|
||||
i: Int64;
|
||||
s: String;
|
||||
begin
|
||||
Result := 0;
|
||||
Val(GetStrValue(AExpression, AValues), Result, e);
|
||||
s := GetStrValue(AExpression, AValues);
|
||||
if (s <> '') and (s[1] = '-')
|
||||
then begin
|
||||
Val(s, i, e);
|
||||
Result := TDBGPtr(i);
|
||||
end
|
||||
else Val(s, Result, e);
|
||||
if e=0 then ;
|
||||
end;
|
||||
|
||||
@ -8986,16 +9069,310 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FixUpResult(AnExpression: string);
|
||||
var
|
||||
ResultInfo: TGDBType;
|
||||
addr: TDbgPtr;
|
||||
e: Integer;
|
||||
PrintableString: String;
|
||||
begin
|
||||
// Check for strings
|
||||
ResultInfo := GetGDBTypeInfo(AnExpression);
|
||||
if (ResultInfo = nil) then Exit;
|
||||
|
||||
case ResultInfo.Kind of
|
||||
skPointer: begin
|
||||
AnExpression := GetPart([], [' '], FTextValue, False, False);
|
||||
Val(AnExpression, addr, e);
|
||||
if e <> 0 then begin
|
||||
FreeAndNil(ResultInfo);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AnExpression := Lowercase(ResultInfo.TypeName);
|
||||
case StringCase(AnExpression, ['char', 'character', 'ansistring', '__vtbl_ptr_type', 'wchar', 'widechar', 'pointer']) of
|
||||
0, 1, 2: begin
|
||||
if Addr = 0
|
||||
then
|
||||
FTextValue := ''''''
|
||||
else
|
||||
FTextValue := MakePrintable(GetText(Addr));
|
||||
PrintableString := FTextValue;
|
||||
end;
|
||||
3: begin
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil'
|
||||
else begin
|
||||
AnExpression := GetClassName(Addr);
|
||||
if AnExpression = '' then AnExpression := '???';
|
||||
FTextValue := 'class of ' + AnExpression + ' ' + FTextValue;
|
||||
end;
|
||||
end;
|
||||
4,5: begin
|
||||
// widestring handling
|
||||
if Addr = 0
|
||||
then FTextValue := ''''''
|
||||
else FTextValue := MakePrintable(GetWideText(Addr));
|
||||
PrintableString := FTextValue;
|
||||
end;
|
||||
6: begin // pointer
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil';
|
||||
FTextValue := PascalizePointer(FTextValue);
|
||||
end;
|
||||
else
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil';
|
||||
if (Length(AnExpression) > 0)
|
||||
then begin
|
||||
if AnExpression[1] = 't'
|
||||
then begin
|
||||
AnExpression[1] := 'T';
|
||||
if Length(AnExpression) > 1 then AnExpression[2] := UpperCase(AnExpression[2])[1];
|
||||
end;
|
||||
FTextValue := PascalizePointer(FTextValue, '^' + AnExpression);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
ResultInfo.Value.AsPointer := Pointer(PtrUint(Addr));
|
||||
AnExpression := Format('$%x', [Addr]);
|
||||
if PrintableString <> ''
|
||||
then AnExpression := AnExpression + ' ' + PrintableString;
|
||||
ResultInfo.Value.AsString := AnExpression;
|
||||
end;
|
||||
|
||||
skClass: begin
|
||||
Val(FTextValue, addr, e); //Get the class mem address
|
||||
if e = 0 then begin //No error ?
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil'
|
||||
else begin
|
||||
AnExpression := GetInstanceClassName(Addr);
|
||||
if AnExpression = '' then AnExpression := '???'; //No instanced class found
|
||||
FTextValue := 'class ' + AnExpression + ' ' + FTextValue;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
skVariant: begin
|
||||
FTextValue := GetVariantValue(FTextValue);
|
||||
end;
|
||||
skRecord: begin
|
||||
FTextValue := 'record ' + ResultInfo.TypeName + ' '+ FTextValue;
|
||||
end;
|
||||
|
||||
skSimple: begin
|
||||
if ResultInfo.TypeName = 'CURRENCY' then
|
||||
FTextValue := FormatCurrency(FTextValue)
|
||||
else
|
||||
if (ResultInfo.TypeName = '&ShortString') then
|
||||
FTextValue := GetStrValue('ShortString(%s)', [AnExpression]) // we have an address here, so we need to typecast
|
||||
else
|
||||
FTextValue := FTextValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
FTypeInfo := ResultInfo;
|
||||
PutValuesInTree;
|
||||
FTextValue := FormatResult(FTextValue);
|
||||
end;
|
||||
|
||||
function AddAddressOfToExpression(const AnExpression: string; TypeInfo: TGDBType): String;
|
||||
var
|
||||
UseAt: Boolean;
|
||||
begin
|
||||
UseAt := True;
|
||||
case TypeInfo.Kind of // (skClass, skRecord, skEnum, skSet, skProcedure, skFunction, skSimple, skPointer, skVariant)
|
||||
skPointer: begin
|
||||
case StringCase(Lowercase(TypeInfo.TypeName),
|
||||
['char', 'character', 'ansistring', '__vtbl_ptr_type', 'wchar', 'widechar', 'pointer']
|
||||
)
|
||||
of
|
||||
2: UseAt := False;
|
||||
3: UseAt := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if UseAt
|
||||
then Result := '@(' + AnExpression + ')'
|
||||
else Result := AnExpression;
|
||||
end;
|
||||
|
||||
function QuoteExpr(const AnExpression: string): string;
|
||||
var
|
||||
i, j, Cnt: integer;
|
||||
begin
|
||||
if pos(' ', AnExpression) < 1
|
||||
then exit(AnExpression);
|
||||
Cnt := length(AnExpression);
|
||||
SetLength(Result, 2 * Cnt + 2);
|
||||
Result[1] := '"';
|
||||
i := 1;
|
||||
j := 2;
|
||||
while i <= Cnt do begin
|
||||
if AnExpression[i] in ['"', '\']
|
||||
then begin
|
||||
Result[j] := '\';
|
||||
inc(j);
|
||||
end;
|
||||
Result[j] := AnExpression[i];
|
||||
inc(i);
|
||||
inc(j);
|
||||
end;
|
||||
Result[j] := '"';
|
||||
SetLength(Result, j + 1);
|
||||
end;
|
||||
|
||||
function TryExecute(AnExpression: string; StoreError: Boolean): Boolean;
|
||||
|
||||
function PrepareExpr(var expr: string; NoAddressOp: Boolean = False): boolean;
|
||||
var
|
||||
ResultInfo: TGDBType;
|
||||
begin
|
||||
ResultInfo := GetGDBTypeInfo(expr);
|
||||
Result := ResultInfo <> nil;
|
||||
if (not Result) and StoreError
|
||||
then FTextValue := '<error>';
|
||||
if not Result
|
||||
then exit;
|
||||
|
||||
if NoAddressOp
|
||||
then expr := QuoteExpr(expr)
|
||||
else expr := QuoteExpr(AddAddressOfToExpression(expr, ResultInfo));
|
||||
FreeAndNil(ResultInfo);
|
||||
end;
|
||||
|
||||
var
|
||||
ResultList: TGDBMINameValueList;
|
||||
R: TGDBMIExecResult;
|
||||
MemDump: TGDBMIMemoryDumpResultList;
|
||||
Size: integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
case FDisplayFormat of
|
||||
wdfStructure:
|
||||
begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [AnExpression], R);
|
||||
Result := Result and (R.State <> dsError);
|
||||
if (not Result) and (not StoreError)
|
||||
then exit;
|
||||
|
||||
ResultList := TGDBMINameValueList.Create(R.Values);
|
||||
if Result
|
||||
then FTextValue := ResultList.Values['value']
|
||||
else FTextValue := ResultList.Values['msg'];
|
||||
FTextValue := DeleteEscapeChars(FTextValue);
|
||||
ResultList.Free;
|
||||
|
||||
if Result
|
||||
then FixUpResult(AnExpression);
|
||||
end;
|
||||
wdfChar:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := GetChar(AnExpression, []);
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
wdfString:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := GetText(AnExpression, []); // GetText takes Addr
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
wdfDecimal:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression, True);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := IntToStr(Int64(GetPtrValue(AnExpression, [], True)));
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
wdfUnsigned:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression, True);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := IntToStr(GetPtrValue(AnExpression, [], True));
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
//wdfFloat:
|
||||
// begin
|
||||
// Result := PrepareExpr(AnExpression);
|
||||
// if not Result
|
||||
// then exit;
|
||||
// FTextValue := GetFloat(AnExpression, []); // GetFloat takes address
|
||||
// if LastExecResult.State = dsError
|
||||
// then FTextValue := '<error>';
|
||||
// end;
|
||||
wdfHex:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression, True);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := IntToHex(GetPtrValue(AnExpression, [], True), 2);
|
||||
if length(FTextValue) mod 2 = 1
|
||||
then FTextValue := '0'+FTextValue; // make it an even number of digets
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
wdfPointer:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression, True);
|
||||
if not Result
|
||||
then exit;
|
||||
FTextValue := IntToHex(GetPtrValue(AnExpression, [], True), TargetInfo^.TargetPtrSize*2);
|
||||
if LastExecResult.State = dsError
|
||||
then FTextValue := '<error>';
|
||||
end;
|
||||
wdfMemDump:
|
||||
begin
|
||||
Result := PrepareExpr(AnExpression);
|
||||
if not Result
|
||||
then exit;
|
||||
|
||||
Size := 256;
|
||||
ExecuteCommand('-data-read-memory %s x 1 1 %u', [AnExpression, Size], R);
|
||||
MemDump := TGDBMIMemoryDumpResultList.Create(R);
|
||||
FTextValue := MemDump.AsText(0, MemDump.Count, TargetInfo^.TargetPtrSize*2);
|
||||
MemDump.Free;
|
||||
end;
|
||||
else // wdfDefault
|
||||
begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [AnExpression], R);
|
||||
Result := Result and (R.State <> dsError);
|
||||
if (not Result) and (not StoreError)
|
||||
then exit;
|
||||
|
||||
ResultList := TGDBMINameValueList.Create(R.Values);
|
||||
if Result
|
||||
then FTextValue := ResultList.Values['value']
|
||||
else FTextValue := ResultList.Values['msg'];
|
||||
FTextValue := DeleteEscapeChars(FTextValue);
|
||||
ResultList.Free;
|
||||
|
||||
if Result
|
||||
then FixUpResult(AnExpression);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
R, Rtmp: TGDBMIExecResult;
|
||||
R: TGDBMIExecResult;
|
||||
S: String;
|
||||
ResultList: TGDBMINameValueList;
|
||||
ResultInfo: TGDBType;
|
||||
addr: TDbgPtr;
|
||||
e: Integer;
|
||||
Expr: TGDBMIExpression;
|
||||
frame, frameidx: Integer;
|
||||
PrintableString: String;
|
||||
begin
|
||||
FTextValue:='';
|
||||
FTypeInfo:=nil;
|
||||
@ -9021,154 +9398,41 @@ begin
|
||||
// original
|
||||
frame := -1;
|
||||
frameidx := -1;
|
||||
repeat
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [S], R);
|
||||
|
||||
if (R.State <> dsError)
|
||||
then Break;
|
||||
|
||||
// check if there is a parentfp and try to evaluate there
|
||||
if frame = -1
|
||||
then begin
|
||||
// store current
|
||||
ExecuteCommand('-stack-info-frame', Rtmp);
|
||||
ResultList.Init(Rtmp.Values);
|
||||
ResultList.SetPath('frame');
|
||||
frame := StrToIntDef(ResultList.Values['level'], -1);
|
||||
if frame = -1 then Break;
|
||||
frameidx := frame;
|
||||
end;
|
||||
until not SelectParentFrame(frameidx);
|
||||
|
||||
if frameidx <> frame
|
||||
then begin
|
||||
// Restore current frame
|
||||
ExecuteCommand('-stack-select-frame %u', [frame], []);
|
||||
end;
|
||||
|
||||
ResultList.Init(R.Values);
|
||||
if R.State = dsError
|
||||
then FTextValue := ResultList.Values['msg']
|
||||
else FTextValue := ResultList.Values['value'];
|
||||
FTextValue := DeleteEscapeChars(FTextValue);
|
||||
ResultList.Free;
|
||||
if R.State = dsError
|
||||
then Exit;
|
||||
|
||||
// Check for strings
|
||||
ResultInfo := GetGDBTypeInfo(S);
|
||||
if (ResultInfo = nil) then Exit;
|
||||
|
||||
try
|
||||
case ResultInfo.Kind of
|
||||
skPointer: begin
|
||||
S := GetPart([], [' '], FTextValue, False, False);
|
||||
Val(S, addr, e);
|
||||
if e <> 0 then begin
|
||||
FreeAndNil(ResultInfo);
|
||||
Exit;
|
||||
end;
|
||||
repeat
|
||||
if TryExecute(S, frame = -1)
|
||||
then Break;
|
||||
|
||||
S := Lowercase(ResultInfo.TypeName);
|
||||
case StringCase(S, ['char', 'character', 'ansistring', '__vtbl_ptr_type', 'wchar', 'widechar']) of
|
||||
0, 1, 2: begin
|
||||
if Addr = 0
|
||||
then
|
||||
FTextValue := ''''''
|
||||
else
|
||||
FTextValue := MakePrintable(GetText(Addr));
|
||||
PrintableString := FTextValue;
|
||||
end;
|
||||
3: begin
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil'
|
||||
else begin
|
||||
S := GetClassName(Addr);
|
||||
if S = '' then S := '???';
|
||||
FTextValue := 'class of ' + S + ' ' + FTextValue;
|
||||
end;
|
||||
end;
|
||||
4,5: begin
|
||||
// widestring handling
|
||||
if Addr = 0
|
||||
then FTextValue := ''''''
|
||||
else FTextValue := MakePrintable(GetWideText(Addr));
|
||||
PrintableString := FTextValue;
|
||||
end;
|
||||
else
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil';
|
||||
|
||||
if (Length(S) > 0)
|
||||
then begin
|
||||
if (S <> 'pointer')
|
||||
then begin
|
||||
if S[1] = 't'
|
||||
then begin
|
||||
S[1] := 'T';
|
||||
if Length(S) > 1 then S[2] := UpperCase(S[2])[1];
|
||||
end;
|
||||
FTextValue := PascalizePointer(FTextValue, '^' + S);
|
||||
end
|
||||
else FTextValue := PascalizePointer(FTextValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
ResultInfo.Value.AsPointer := Pointer(PtrUint(Addr));
|
||||
S := Format('$%x', [Addr]);
|
||||
if PrintableString <> ''
|
||||
then S := S + ' ' + PrintableString;
|
||||
ResultInfo.Value.AsString := S;
|
||||
// check if there is a parentfp and try to evaluate there
|
||||
if frame = -1
|
||||
then begin
|
||||
// store current
|
||||
ExecuteCommand('-stack-info-frame', R);
|
||||
ResultList.Init(R.Values);
|
||||
ResultList.SetPath('frame');
|
||||
frame := StrToIntDef(ResultList.Values['level'], -1);
|
||||
if frame = -1 then Break;
|
||||
frameidx := frame;
|
||||
end;
|
||||
|
||||
skClass: begin
|
||||
Val(FTextValue, addr, e); //Get the class mem address
|
||||
if e = 0 then begin //No error ?
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil'
|
||||
else begin
|
||||
S := GetInstanceClassName(Addr);
|
||||
if S = '' then S := '???'; //No instanced class found
|
||||
FTextValue := 'class ' + S + ' ' + FTextValue;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
skVariant: begin
|
||||
FTextValue := GetVariantValue(FTextValue);
|
||||
end;
|
||||
skRecord: begin
|
||||
FTextValue := 'record ' + ResultInfo.TypeName + ' '+ FTextValue;
|
||||
end;
|
||||
|
||||
skSimple: begin
|
||||
if ResultInfo.TypeName = 'CURRENCY' then
|
||||
FTextValue := FormatCurrency(FTextValue)
|
||||
else
|
||||
if (ResultInfo.TypeName = '&ShortString') then
|
||||
FTextValue := GetStrValue('ShortString(%s)', [S]) // we have an address here, so we need to typecast
|
||||
else
|
||||
FTextValue := FTextValue;
|
||||
end;
|
||||
end;
|
||||
until not SelectParentFrame(frameidx);
|
||||
|
||||
finally
|
||||
if frameidx <> frame
|
||||
then begin
|
||||
// Restore current frame
|
||||
ExecuteCommand('-stack-select-frame %u', [frame], []);
|
||||
end
|
||||
end;
|
||||
FreeAndNil(ResultList);
|
||||
end;
|
||||
FTypeInfo := ResultInfo;
|
||||
PutValuesInTree;
|
||||
FTextValue := FormatResult(FTextValue);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
constructor TGDBMIDebuggerCommandEvaluate.Create(AOwner: TGDBMIDebugger;
|
||||
const AExpression: String);
|
||||
const AExpression: String; const ADisplayFormat: TWatchDisplayFormat);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FExpression := AExpression;
|
||||
FDisplayFormat := ADisplayFormat;
|
||||
FTextValue := '';
|
||||
FTypeInfo:=nil;
|
||||
end;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
object WatchPropertyDlg: TWatchPropertyDlg
|
||||
Left = 331
|
||||
Left = 542
|
||||
Height = 210
|
||||
Top = 184
|
||||
Top = 214
|
||||
Width = 420
|
||||
ActiveControl = chkAllowFunc
|
||||
BorderIcons = [biSystemMenu]
|
||||
@ -16,9 +16,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = txtExpression
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 14
|
||||
Height = 16
|
||||
Top = 9
|
||||
Width = 57
|
||||
Width = 59
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Expression:'
|
||||
ParentColor = False
|
||||
@ -28,9 +28,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = txtRepCount
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 36
|
||||
Width = 72
|
||||
Height = 16
|
||||
Top = 38
|
||||
Width = 76
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Repeat Count:'
|
||||
ParentColor = False
|
||||
@ -41,9 +41,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = txtDigits
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 171
|
||||
Height = 14
|
||||
Top = 36
|
||||
Width = 31
|
||||
Height = 16
|
||||
Top = 38
|
||||
Width = 34
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Digits:'
|
||||
ParentColor = False
|
||||
@ -53,7 +53,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 105
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 6
|
||||
Width = 309
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
@ -65,8 +65,8 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = txtExpression
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 105
|
||||
Height = 21
|
||||
Top = 33
|
||||
Height = 23
|
||||
Top = 35
|
||||
Width = 60
|
||||
BorderSpacing.Top = 6
|
||||
TabOrder = 2
|
||||
@ -77,9 +77,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = txtExpression
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 208
|
||||
Height = 21
|
||||
Top = 33
|
||||
Left = 211
|
||||
Height = 23
|
||||
Top = 35
|
||||
Width = 60
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
@ -90,9 +90,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = chkAllowFunc
|
||||
Left = 6
|
||||
Height = 17
|
||||
Top = 60
|
||||
Width = 56
|
||||
Height = 19
|
||||
Top = 64
|
||||
Width = 62
|
||||
AllowGrayed = True
|
||||
BorderSpacing.Left = 6
|
||||
Caption = 'Enabled'
|
||||
@ -102,9 +102,9 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = txtRepCount
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 105
|
||||
Height = 17
|
||||
Top = 60
|
||||
Width = 112
|
||||
Height = 19
|
||||
Top = 64
|
||||
Width = 128
|
||||
AllowGrayed = True
|
||||
BorderSpacing.Top = 6
|
||||
Caption = 'Allow Function Calls'
|
||||
@ -118,7 +118,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 78
|
||||
Top = 83
|
||||
Top = 89
|
||||
Width = 408
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
AutoFill = True
|
||||
@ -143,7 +143,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
'String'
|
||||
'Decimal'
|
||||
'Hexadecimal'
|
||||
'Floating Point'
|
||||
'Unsigned'
|
||||
'Pointer'
|
||||
'Record/Structure'
|
||||
'Default'
|
||||
@ -155,10 +155,19 @@ object WatchPropertyDlg: TWatchPropertyDlg
|
||||
AnchorSideTop.Control = rgStyle
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 37
|
||||
Top = 167
|
||||
Height = 31
|
||||
Top = 173
|
||||
Width = 408
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
OKButton.Name = 'OKButton'
|
||||
OKButton.Caption = '&OK'
|
||||
HelpButton.Name = 'HelpButton'
|
||||
HelpButton.Caption = '&Help'
|
||||
CloseButton.Name = 'CloseButton'
|
||||
CloseButton.Caption = '&Close'
|
||||
CloseButton.Enabled = False
|
||||
CancelButton.Name = 'CancelButton'
|
||||
CancelButton.Caption = 'Cancel'
|
||||
TabOrder = 6
|
||||
ShowButtons = [pbOK, pbCancel, pbHelp]
|
||||
ShowBevel = False
|
||||
|
||||
@ -77,6 +77,12 @@ uses
|
||||
{ TWatchPropertyDlg }
|
||||
|
||||
procedure TWatchPropertyDlg.btnOKClick(Sender: TObject);
|
||||
const
|
||||
StyleToDispFormat: Array [0..8] of TWatchDisplayFormat =
|
||||
(wdfChar, wdfString, wdfDecimal,
|
||||
wdfHex, wdfUnsigned, wdfPointer,
|
||||
wdfStructure, wdfDefault, wdfMemDump
|
||||
);
|
||||
begin
|
||||
if FWatch = nil
|
||||
then begin
|
||||
@ -85,7 +91,12 @@ begin
|
||||
else begin
|
||||
FWatch.Expression := txtExpression.Text;
|
||||
end;
|
||||
|
||||
|
||||
if (rgStyle.ItemIndex >= low(StyleToDispFormat))
|
||||
and (rgStyle.ItemIndex <= High(StyleToDispFormat))
|
||||
then FWatch.DisplayFormat := StyleToDispFormat[rgStyle.ItemIndex]
|
||||
else FWatch.DisplayFormat := wdfDefault;
|
||||
|
||||
FWatch.Enabled := chkEnabled.Checked;
|
||||
end;
|
||||
|
||||
@ -96,6 +107,14 @@ end;
|
||||
|
||||
constructor TWatchPropertyDlg.Create(AOwner: TComponent; const AWatch: TIDEWatch;
|
||||
const AWatchExpression: String = '');
|
||||
const
|
||||
DispFormatToStyle: Array [TWatchDisplayFormat] of Integer =
|
||||
(7, 6, //wdfDefault, wdfStructure,
|
||||
0, 1, //wdfChar, wdfString,
|
||||
2, 4, //wdfDecimal, wdfUnsigned, (TODO unsigned)
|
||||
7, 3, //wdfFloat, wdfHex,
|
||||
5, 8 //wdfPointer, wdfMemDump
|
||||
);
|
||||
begin
|
||||
FWatch := AWatch;
|
||||
inherited Create(AOwner);
|
||||
@ -103,19 +122,20 @@ begin
|
||||
then begin
|
||||
chkEnabled.Checked := True;
|
||||
txtExpression.Text := AWatchExpression;
|
||||
rgStyle.ItemIndex := 7;
|
||||
end
|
||||
else begin
|
||||
txtExpression.Text := FWatch.Expression;
|
||||
chkEnabled.Checked := FWatch.Enabled;
|
||||
rgStyle.ItemIndex := DispFormatToStyle[FWatch.DisplayFormat];
|
||||
end;
|
||||
|
||||
|
||||
lblRepCount.Enabled := False;
|
||||
txtRepCount.Enabled := False;
|
||||
lblDigits.Enabled := False;
|
||||
txtDigits.Enabled := False;
|
||||
chkAllowFunc.Enabled := False;
|
||||
rgStyle.Enabled := False;
|
||||
|
||||
|
||||
Caption:= lisWatchPropert;
|
||||
lblExpression.Caption:= lisExpression;
|
||||
lblRepCount.Caption:= lisRepeatCount;
|
||||
@ -127,11 +147,12 @@ begin
|
||||
rgStyle.Items[1]:= lisString;
|
||||
rgStyle.Items[2]:= lisDecimal;
|
||||
rgStyle.Items[3]:= lisHexadecimal;
|
||||
rgStyle.Items[4]:= lisFloatingPoin;
|
||||
rgStyle.Items[4]:= lisUnsigned;
|
||||
rgStyle.Items[5]:= lisPointer;
|
||||
rgStyle.Items[6]:= lisRecordStruct;
|
||||
rgStyle.Items[7]:= dlgAssemblerDefault;
|
||||
rgStyle.Items[8]:= lisMemoryDump;
|
||||
//rgStyle.Items[9]:= lisFloatingPoin;
|
||||
|
||||
ButtonPanel.OKButton.OnClick := @btnOKClick;
|
||||
ButtonPanel.HelpButton.OnClick := @btnHelpClick;
|
||||
|
||||
@ -275,6 +275,7 @@ type
|
||||
function GetTypeInfo: TDBGType; override;
|
||||
procedure SetEnabled(const AValue: Boolean); override;
|
||||
procedure SetExpression(const AValue: String); override;
|
||||
procedure SetDisplayFormat(const AValue: TWatchDisplayFormat); override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure ResetMaster;
|
||||
@ -827,6 +828,13 @@ begin
|
||||
if FMaster <> nil then FMaster.Expression := AValue;
|
||||
end;
|
||||
|
||||
procedure TManagedWatch.SetDisplayFormat(const AValue: TWatchDisplayFormat);
|
||||
begin
|
||||
if AValue = DisplayFormat then Exit;
|
||||
inherited SetDisplayFormat(AValue);
|
||||
if FMaster <> nil then FMaster.DisplayFormat := AValue;
|
||||
end;
|
||||
|
||||
destructor TManagedWatch.Destroy;
|
||||
begin
|
||||
ResetMaster;
|
||||
|
||||
@ -4581,6 +4581,7 @@ resourcestring
|
||||
lisCharacter = 'Character';
|
||||
lisString = 'String';
|
||||
lisDecimal = 'Decimal';
|
||||
lisUnsigned = 'Unsigned';
|
||||
lisHexadecimal = 'Hexadecimal';
|
||||
lisFloatingPoin = 'Floating Point';
|
||||
lisPointer = 'Pointer';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user