paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 08:20:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

LazDebugger: Remove TWatchDisplayFormat from debugger backends.

Browse Source
This commit is contained in:
Martin 2024-02-21 23:20:59 +01:00
parent be387c3f21
commit 8117ca5a5d
20 changed files with 284 additions and 324 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpdebug/test/testmemmanager.pas
View File

@ -19,6 +19,7 @@ type
FMemReader: TTestMemReader;
FMemConvTarget: TFpDbgMemConvertorLittleEndian;
FMemConvSelf: TFpDbgMemConvertorLittleEndian;
FMemModel: TFpDbgMemModel;
FMemManager: TFpDbgMemManager;
FDummyContext: TFpDbgSimpleLocationContext;
@ -37,7 +38,8 @@ begin
FMemReader := TTestMemReader.Create;
FMemConvTarget := TFpDbgMemConvertorLittleEndian.Create;
FMemConvSelf := TFpDbgMemConvertorLittleEndian.Create;
FMemManager := TFpDbgMemManager.Create(FMemReader, FMemConvTarget, FMemConvSelf);
FMemModel := TFpDbgMemModel.Create;
FMemManager := TFpDbgMemManager.Create(FMemReader, FMemConvTarget, FMemConvSelf, FMemModel);
FDummyContext := TFpDbgSimpleLocationContext.Create(FMemManager, 0, 4, 0, 0);
end;
@ -47,6 +49,7 @@ begin
FMemReader := nil;
FMemConvTarget := nil;
FMemConvSelf := nil;
FMemModel := nil;
FMemManager := nil;
end;
@ -57,6 +60,7 @@ begin
FreeAndNil(FMemReader);
FreeAndNil(FMemConvTarget);
FreeAndNil(FMemConvSelf);
FreeAndNil(FMemModel);
FreeAndNil(FMemManager);
end;

8
components/fpdebug/test/testtypeinfo.pas
View File

@ -28,6 +28,7 @@ type
FImageLoaderList: TDbgImageLoaderList;
FMemReader: TTestMemReader;
FMemManager: TFpDbgMemManager;
FMemModel: TFpDbgMemModel;
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
@ -337,8 +338,9 @@ begin
FImageLoaderList := TDbgImageLoaderList.Create(True);
FImageLoaderList.Add(FImageLoader);
FMemReader := TTestMemReader.Create;
FMemManager := TFpDbgMemManager.Create(FMemReader, TFpDbgMemConvertorLittleEndian.Create);
FDwarfInfo := TFpDwarfInfo.Create(FImageLoaderList, FMemManager);
FMemModel := TFpDbgMemModel.Create;
FMemManager := TFpDbgMemManager.Create(FMemReader, TFpDbgMemConvertorLittleEndian.Create, FMemModel);
FDwarfInfo := TFpDwarfInfo.Create(FImageLoaderList, FMemManager, FMemModel);
FDwarfInfo.LoadCompilationUnits;
end;
@ -348,6 +350,7 @@ begin
FImageLoader := nil;
FImageLoaderList := nil;
FMemReader := nil;
FMemModel := nil;
FMemManager := nil;
FDwarfInfo := nil;
FCurrentTestName := '';
@ -362,6 +365,7 @@ begin
FDwarfInfo.Free;
FImageLoaderList.Free;
FMemReader.Free;
FMemModel.Free;
if FMemManager <> nil then
FMemManager.TargetMemConvertor.Free;
FreeAndNil(FMemManager);

12
components/ideintf/idedebuggerwatchvalueintf.pas
View File

@ -15,10 +15,20 @@ unit IdeDebuggerWatchValueIntf experimental;
interface
uses
LazDebuggerIntf, LazDebuggerIntfBaseTypes;
LazDebuggerIntf, LazDebuggerIntfBaseTypes, IdeIntfStrConsts;
type
TWatchDisplayFormat =
(wdfDefault,
wdfStructure,
wdfChar, wdfString,
wdfDecimal, wdfUnsigned, wdfFloat, wdfHex,
wdfPointer,
wdfMemDump, wdfBinary
);
TWatchDisplayFormats = set of TWatchDisplayFormat;
TWatchResultDataKind = (
rdkUnknown,
rdkError, rdkPrePrinted,

313
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -1471,7 +1471,6 @@ type
FCallback: TDBGEvaluateResultCallback;
FEvalFlags: TWatcheEvaluateFlags;
FExpression: String;
FDisplayFormat: TWatchDisplayFormat;
FWatchValue: IDbgWatchValueIntf;
FTextValue: String;
FNumValue: TDBGPtr;
@ -1491,13 +1490,12 @@ type
function SelectContext: Boolean;
procedure UnSelectContext;
public
constructor Create(AOwner: TGDBMIDebuggerBase; AExpression: String; ADisplayFormat: TWatchDisplayFormat);
constructor Create(AOwner: TGDBMIDebuggerBase; AExpression: String);
constructor Create(AOwner: TGDBMIDebuggerBase; AWatchValue: IDbgWatchValueIntf);
destructor Destroy; override;
function DebugText: String; override;
property Expression: String read FExpression;
property EvalFlags: TWatcheEvaluateFlags read FEvalFlags write FEvalFlags;
property DisplayFormat: TWatchDisplayFormat read FDisplayFormat;
property TextValue: String read FTextValue;
property TypeInfo: TGDBType read GetTypeInfo;
property TypeInfoAutoDestroy: Boolean read FTypeInfoAutoDestroy write FTypeInfoAutoDestroy;
@ -9611,7 +9609,7 @@ function TGDBMIDebuggerBase.GDBEvaluate(const AExpression: String;
var
CommandObj: TGDBMIDebuggerCommandEvaluate;
begin
CommandObj := TGDBMIDebuggerCommandEvaluate.Create(Self, AExpression, wdfDefault);
CommandObj := TGDBMIDebuggerCommandEvaluate.Create(Self, AExpression);
CommandObj.EvalFlags := EvalFlags;
CommandObj.AddReference;
CommandObj.Priority := GDCMD_PRIOR_IMMEDIATE; // try run imediately
@ -14400,7 +14398,7 @@ var
else
FTextValue := UnEscapeBackslashed(FTextValue); // TODO: Check for string
end;
skString, skAnsiString, skWideString:
skString, skAnsiString, skWideString, skChar:
exit; // dont call FormatResult
end;
@ -14498,100 +14496,74 @@ var
exit;
end;
case FDisplayFormat of
// wdfStructure:
// begin
// FreeAndNil(FTypeInfo);
// Result := ExecuteCommand('-data-evaluate-expression %s', [Quote(AnExpression)], R);
// Result := Result and (R.State <> dsError);
// if (not Result) then begin
// ParseLastError;
// exit;
// end;
//
// 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 begin
// FixUpResult(AnExpression);
// FValidity := ddsValid;
// end;
// end;
wdfMemDump:
begin
AnExpression := QuoteExpr(AddAddressOfToExpression(AnExpression, FTypeInfo));
if defMemDump in FEvalFlags then
begin
AnExpression := QuoteExpr(AddAddressOfToExpression(AnExpression, FTypeInfo));
Result := False;
Size := 256;
if (FTypeInfo <> nil) and (saInternalPointer in FTypeInfo.Attributes) then begin
Result := ExecuteCommand('-data-read-memory %s^ x 1 1 %u', [AnExpression, Size], R);
Result := Result and (R.State <> dsError);
// nil ?
if (R.State = dsError) and (pos('Unable to read memory', R.Values) > 0) then
Size := TargetInfo^.TargetPtrSize;
end;
if (not Result) then begin
Result := ExecuteCommand('-data-read-memory %s x 1 1 %u', [AnExpression, Size], R);
Result := Result and (R.State <> dsError);
end;
if (not Result) then begin
ParseLastError;
exit;
end;
MemDump := TGDBMIMemoryDumpResultList.Create(R);
FValidity := ddsValid;
FTextValue := MemDump.AsText(0, MemDump.Count, TargetInfo^.TargetPtrSize*2);
MemDump.Free;
Result := False;
Size := 256;
if (FTypeInfo <> nil) and (saInternalPointer in FTypeInfo.Attributes) then begin
Result := ExecuteCommand('-data-read-memory %s^ x 1 1 %u', [AnExpression, Size], R);
Result := Result and (R.State <> dsError);
// nil ?
if (R.State = dsError) and (pos('Unable to read memory', R.Values) > 0) then
Size := TargetInfo^.TargetPtrSize;
end;
if (not Result) then begin
Result := ExecuteCommand('-data-read-memory %s x 1 1 %u', [AnExpression, Size], R);
Result := Result and (R.State <> dsError);
end;
if (not Result) then begin
ParseLastError;
exit;
end;
MemDump := TGDBMIMemoryDumpResultList.Create(R);
FValidity := ddsValid;
FTextValue := MemDump.AsText(0, MemDump.Count, TargetInfo^.TargetPtrSize*2);
MemDump.Free;
end
else
begin
Result := False;
if (FTypeInfo = nil) or (dcsCanceled in SeenStates)
then begin
ParseLastError;
exit;
end;
if FTypeInfo.HasExprEvaluatedAsText then begin
FTextValue := FTypeInfo.ExprEvaluatedAsText;
FValidity := ddsValid;
if (FTextValue <> '') and (FTextValue[1] = '-') then begin
Val(FTextValue, i64, Error);
FNumValue := TDBGPtr(i64);
if Error = 0 then
FHasNumValue := nvSigned;
end
else begin
Val(FTextValue, FNumValue, Error);
if Error = 0 then
FHasNumValue := nvUnsigned;
end;
else // wdfDefault
begin
Result := False;
if (FTypeInfo = nil) or (dcsCanceled in SeenStates)
then begin
ParseLastError;
exit;
end;
if FTypeInfo.HasExprEvaluatedAsText then begin
FTextValue := FTypeInfo.ExprEvaluatedAsText;
FValidity := ddsValid;
if (FTextValue <> '') and (FTextValue[1] = '-') then begin
Val(FTextValue, i64, Error);
FNumValue := TDBGPtr(i64);
if Error = 0 then
FHasNumValue := nvSigned;
end
else begin
Val(FTextValue, FNumValue, Error);
if Error = 0 then
FHasNumValue := nvUnsigned;
end;
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
Result := True;
FixUpResult(AnExpression, FTypeInfo);
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
Result := True;
FixUpResult(AnExpression, FTypeInfo);
if FTypeInfo.HasStringExprEvaluatedAsText then begin
s := FTextValue;
FTextValue := FTypeInfo.StringExprEvaluatedAsText;
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
FixUpResult(AnExpression, FTypeInfo);
FTextValue := 'PCHAR: ' + s + LineEnding + 'STRING: ' + FTextValue;
end;
exit;
end;
debugln(DBG_WARNINGS, '############# Not expected to be here');
FTextValue := '<ERROR>';
if FTypeInfo.HasStringExprEvaluatedAsText then begin
s := FTextValue;
FTextValue := FTypeInfo.StringExprEvaluatedAsText;
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
FixUpResult(AnExpression, FTypeInfo);
FTextValue := 'PCHAR: ' + s + LineEnding + 'STRING: ' + FTextValue;
end;
exit;
end;
debugln(DBG_WARNINGS, '############# Not expected to be here');
FTextValue := '<ERROR>';
end;
end;
var
@ -14660,82 +14632,84 @@ begin
if FWatchValue <> nil then begin
FWatchValue.BeginUpdate;
repeat
if (FHasNumValue <> nvNone) and
(FTypeInfo <> nil) and (FTypeInfo.Kind in [skSimple, skPointer, skInteger, skCardinal]) and
(FWatchValue.RepeatCount <= 0)
then begin
if (FTypeInfo.Kind = skPointer) then begin
FWatchValue.ResData.CreatePointerValue(FNumValue);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end;
if (FHasNumValue = nvSigned) or
( (FTypeInfo.Kind = skInteger) and (FNumValue <= high(int64)) )
if not(defMemDump in FEvalFlags) then begin
if (FHasNumValue <> nvNone) and
(FTypeInfo <> nil) and (FTypeInfo.Kind in [skSimple, skPointer, skInteger, skCardinal]) and
(FWatchValue.RepeatCount <= 0)
then begin
FWatchValue.ResData.CreateNumValue(FNumValue, True);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end
else begin
FWatchValue.ResData.CreateNumValue(FNumValue, False);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end;
end;
if FTypeInfo <> nil then begin
DoneResData := True;
s := LowerCase(FTextValue);
case FTypeInfo.Kind of
//skProcedure: ;
//skFunction: ;
//skProcedureRef: ;
//skFunctionRef: ;
skBoolean:
if s = 'false' then
FWatchValue.ResData.CreateBoolValue(0)
else
if s = 'true' then
FWatchValue.ResData.CreateBoolValue(1)
else
DoneResData := False;
skChar:
if Length(s) = 1 then
FWatchValue.ResData.CreateCharValue(ord(FTextValue[1]), 1)
else
DoneResData := False;
//skFloat: ;
skString,
skAnsiString:
FWatchValue.ResData.CreateString(FTextValue);
skWideString:
FWatchValue.ResData.CreateWideString(FTextValue);
skEnum: begin
i := 0;
if FTypeInfo.Members <> nil then begin
i := FTypeInfo.Members.IndexOf(FTextValue);
if i < 0 then i := 0;
end;
FWatchValue.ResData.CreateEnumValue(i, FTextValue);
if (FTypeInfo.Kind = skPointer) then begin
FWatchValue.ResData.CreatePointerValue(FNumValue);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end;
if (FHasNumValue = nvSigned) or
( (FTypeInfo.Kind = skInteger) and (FNumValue <= high(int64)) )
then begin
FWatchValue.ResData.CreateNumValue(FNumValue, True);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end
else begin
FWatchValue.ResData.CreateNumValue(FNumValue, False);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end;
//skEnumValue: ;
// FWatchValue.ResData.CreateEnumValue(0, FTextValue, 0 ,True);
//skSet: ;
//skRecord: ;
//skObject: ;
//skClass: ;
//skInterface: ;
//skArray: ;
else
DoneResData := False;
end;
if DoneResData then begin
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
if FTypeInfo <> nil then begin
DoneResData := True;
s := LowerCase(FTextValue);
case FTypeInfo.Kind of
//skProcedure: ;
//skFunction: ;
//skProcedureRef: ;
//skFunctionRef: ;
skBoolean:
if s = 'false' then
FWatchValue.ResData.CreateBoolValue(0)
else
if s = 'true' then
FWatchValue.ResData.CreateBoolValue(1)
else
DoneResData := False;
skChar:
if Length(s) = 1 then
FWatchValue.ResData.CreateCharValue(ord(FTextValue[1]), 1)
else
DoneResData := False;
//skFloat: ;
skString,
skAnsiString:
FWatchValue.ResData.CreateString(FTextValue);
skWideString:
FWatchValue.ResData.CreateWideString(FTextValue);
skEnum: begin
i := 0;
if FTypeInfo.Members <> nil then begin
i := FTypeInfo.Members.IndexOf(FTextValue);
if i < 0 then i := 0;
end;
FWatchValue.ResData.CreateEnumValue(i, FTextValue);
end;
//skEnumValue: ;
// FWatchValue.ResData.CreateEnumValue(0, FTextValue, 0 ,True);
//skSet: ;
//skRecord: ;
//skObject: ;
//skClass: ;
//skInterface: ;
//skArray: ;
else
DoneResData := False;
end;
if DoneResData then begin
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.Validity := FValidity;
break;
end;
end;
end;
@ -14771,13 +14745,12 @@ begin
FContext.StackContext := ccUseGlobal;
end;
constructor TGDBMIDebuggerCommandEvaluate.Create(AOwner: TGDBMIDebuggerBase; AExpression: String;
ADisplayFormat: TWatchDisplayFormat);
constructor TGDBMIDebuggerCommandEvaluate.Create(AOwner: TGDBMIDebuggerBase;
AExpression: String);
begin
inherited Create(AOwner);
FWatchValue := nil;
FExpression := AExpression;
FDisplayFormat := ADisplayFormat;
FTextValue := '';
FTypeInfo:=nil;
FEvalFlags := [];
@ -14789,7 +14762,7 @@ end;
constructor TGDBMIDebuggerCommandEvaluate.Create(AOwner: TGDBMIDebuggerBase;
AWatchValue: IDbgWatchValueIntf);
begin
Create(AOwner, AWatchValue.Expression, AWatchValue.DisplayFormat);
Create(AOwner, AWatchValue.Expression);
EvalFlags := AWatchValue.EvaluateFlags;
FWatchValue := AWatchValue;
FWatchValue.AddFreeNotification(@DoWatchFreed);

9
components/lazdebuggergdbmi/test/gdbmitestutils/testbase.pas
View File

@ -20,15 +20,6 @@ const
stDwarfAll = [stDwarf, stDwarfSet, stDwarf3];
stSymAll = [stStabs, stDwarf, stDwarfSet, stDwarf3];
TWatchDisplayFormatNames: array [TWatchDisplayFormat] of string =
('wdfDefault',
'wdfStructure',
'wdfChar', 'wdfString',
'wdfDecimal', 'wdfUnsigned', 'wdfFloat', 'wdfHex',
'wdfPointer',
'wdfMemDump', 'wdfBinary'
);
type
TGDBMIDebuggerClass = class of TGDBMIDebugger;

31
components/lazdebuggergdbmi/test/gdbmitestutils/testwatchutils.pas
View File

@ -113,7 +113,6 @@ type
TWatchExpectation = record
TestName: String;
Expression: string;
DspFormat: TWatchDisplayFormat;
RepeatCount: Integer;
EvaluateFlags: TWatcheEvaluateFlags;
StackFrame: Integer;
@ -142,28 +141,28 @@ type
function AddWatchExp(var ExpArray: TWatchExpectationArray;
const AnExpr: string; AFmt: TWatchDisplayFormat;
const AnExpr: string;
const AMtch: string; AKind: TDBGSymbolKind; const ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray;
const AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TWatcheEvaluateFlags;
const AnExpr: string; AEvaluateFlags: TWatcheEvaluateFlags;
const AMtch: string; AKind: TDBGSymbolKind; const ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
const AnExpr: string; AFmt: TWatchDisplayFormat;
const AnExpr: string;
const AMtch: string; AKind: TDBGSymbolKind; const ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
AMinGdb: Integer = 0; AMinFpc: Integer = 0
): PWatchExpectation;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
const AnExpr: string; AFmt: TWatchDisplayFormat; AEvaluateFlags: TWatcheEvaluateFlags;
const AnExpr: string; AEvaluateFlags: TWatcheEvaluateFlags;
const AMtch: string; AKind: TDBGSymbolKind; const ATpNm: string;
AFlgs: TWatchExpectationFlags = [];
AStackFrame: Integer = 0;
@ -203,37 +202,37 @@ procedure AddMemberExpect(AWatchExp: PWatchExpectation;
implementation
function AddWatchExp(var ExpArray: TWatchExpectationArray;
const AnExpr: string; AFmt: TWatchDisplayFormat; const AMtch: string;
const AnExpr: string; const AMtch: string;
AKind: TDBGSymbolKind; const ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer; AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', []',
AnExpr, AFmt, [], AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
AnExpr + ' []',
AnExpr, [], AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray;
const AnExpr: string; AFmt: TWatchDisplayFormat;
const AnExpr: string;
AEvaluateFlags: TWatcheEvaluateFlags; const AMtch: string;
AKind: TDBGSymbolKind; const ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer; AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray,
AnExpr + ' (' + TWatchDisplayFormatNames[AFmt] + ', ' + dbgs(AEvaluateFlags) + ')',
AnExpr, AFmt, AEvaluateFlags, AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
AnExpr + ' (' + dbgs(AEvaluateFlags) + ')',
AnExpr, AEvaluateFlags, AMtch, AKind, ATpNm, AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
const AnExpr: string; AFmt: TWatchDisplayFormat; const AMtch: string;
const AnExpr: string; const AMtch: string;
AKind: TDBGSymbolKind; const ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer; AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
begin
Result := AddWatchExp(ExpArray, ATestName, AnExpr, AFmt, [], AMtch, AKind, ATpNm,
Result := AddWatchExp(ExpArray, ATestName, AnExpr, [], AMtch, AKind, ATpNm,
AFlgs, AStackFrame, AMinGdb, AMinFpc);
end;
function AddWatchExp(var ExpArray: TWatchExpectationArray; ATestName: String;
const AnExpr: string; AFmt: TWatchDisplayFormat;
const AnExpr: string;
AEvaluateFlags: TWatcheEvaluateFlags; const AMtch: string;
AKind: TDBGSymbolKind; const ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer; AMinGdb: Integer; AMinFpc: Integer): PWatchExpectation;
@ -244,7 +243,6 @@ begin
with ExpArray[Length(ExpArray)-1] do begin
TestName := ATestName;
Expression := AnExpr;
DspFormat := AFmt;
RepeatCount := 0;
EvaluateFlags := AEvaluateFlags;
TheWatch := nil;
@ -435,7 +433,7 @@ begin
// Get Value
n := Data.TestName;
if n = '' then n := Data.Expression + ' (' + TWatchDisplayFormatNames[Data.DspFormat] + ', ' + dbgs(Data.EvaluateFlags) + ' RepCnt=' + dbgs(Data.RepeatCount) + ')';
if n = '' then n := Data.Expression + ' (' + dbgs(Data.EvaluateFlags) + ' RepCnt=' + dbgs(Data.RepeatCount) + ')';
Name := Name + ' ' + n + ' ::: '+adbg.GetLocation.SrcFile+' '+IntToStr(ADbg.GetLocation.SrcLine);
LogToFile('###### ' + Name + '###### '+LineEnding);
flag := AWatch <> nil; // test for typeinfo/kind // Awatch=nil > direct gdb command
@ -609,7 +607,6 @@ begin
if not SkipTest(ExpectList[i]) then begin
ExpectList[i].TheWatch := TTestWatch.Create(AWatches);
ExpectList[i].TheWatch.Expression := ExpectList[i].Expression;
ExpectList[i].TheWatch.DisplayFormat := ExpectList[i].DspFormat;
ExpectList[i].TheWatch.RepeatCount := ExpectList[i].RepeatCount;
ExpectList[i].TheWatch.EvaluateFlags:= ExpectList[i].EvaluateFlags;
ExpectList[i].TheWatch.enabled := True;

83
components/lazdebuggergdbmi/test/testwatches.pas
View File

@ -55,9 +55,9 @@ type
procedure ClearAllTestArrays;
function HasTestArraysData: Boolean;
// using FCurrentExpArray
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
function Add(AnExpr: string; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
function Add(AnExpr: string; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
function AddFmtDef (AnExpr, AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
function AddFmtDef (AnExpr: String; AEvalFlags: TWatcheEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
@ -154,29 +154,29 @@ begin
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
function TTestWatches.Add(AnExpr: string; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat;
function TTestWatches.Add(AnExpr: string;
AEvalFlags: TWatcheEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AFmt, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpArray^, AnExpr, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr, AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AMtch, AKind, ATpNm, AFlgs );
Result := Add(AnExpr, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr: String; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
Result := Add(AnExpr, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddStringFmtDef(AnExpr, AMtch, ATpNm: string;
@ -230,11 +230,11 @@ begin
if not TestControlCanTest(ControlTestWatchGdb) then exit;
FCurrentExpArray := @ExpectBreakFooGdb;
Add('ptype ArgTFoo', wdfDefault, 'type = \^TFoo = class : PUBLIC TObject', skClass, '', []);
Add('ptype ArgTFoo^', wdfDefault, 'type = TFoo = class : PUBLIC TObject', skClass, '', []);
Add('ptype ArgTFoo', 'type = \^TFoo = class : PUBLIC TObject', skClass, '', []);
Add('ptype ArgTFoo^', 'type = TFoo = class : PUBLIC TObject', skClass, '', []);
Add('-data-evaluate-expression sizeof(ArgTFoo)', wdfDefault, 'value="(4|8)"|(parse|syntax) error in expression', skClass, '', []);
Add('-data-evaluate-expression sizeof(ArgTFoo^)', wdfDefault, 'value="\d\d+"|(parse|syntax) error in expression', skClass, '', []);
Add('-data-evaluate-expression sizeof(ArgTFoo)', 'value="(4|8)"|(parse|syntax) error in expression', skClass, '', []);
Add('-data-evaluate-expression sizeof(ArgTFoo^)', 'value="\d\d+"|(parse|syntax) error in expression', skClass, '', []);
if RUN_GDB_TEST_ONLY > 0 then begin
ExpectBreakFooGdb[0] := ExpectBreakFooGdb[abs(RUN_GDB_TEST_ONLY)];
@ -482,8 +482,7 @@ begin
//AddFmtDef('VArgPPFoo.ValueInt', 'error', skSimple, '', []);
Add('ArgTFoo', wdfPointer, Match_Pointer, skClass, 'TFoo', []);
Add('ArgTFoo', wdfMemDump, ':.*?6D 65 6D 20 6F 66 20 54 46 6F 6F', skClass, 'TFoo', []);
Add('ArgTFoo', [defMemDump], ':.*?6D 65 6D 20 6F 66 20 54 46 6F 6F', skClass, 'TFoo', []);
{%region * Classes * typecasts }
// typecast does not change class
@ -891,7 +890,7 @@ begin
*)
Add('ArgTMyAnsiString', wdfMemDump, ': 4d 79 41 6e 73 69 00', skPOINTER, '^(TMy)?AnsiString$', [fTpMtch]);
Add('ArgTMyAnsiString', [defMemDump], ': 4d 79 41 6e 73 69 00', skPOINTER, '^(TMy)?AnsiString$', [fTpMtch]);
// Utf8
// a single ', must appear double ''
@ -1057,21 +1056,21 @@ procedure TTestWatches.AddExpectBreakFooArray;
function AddRecForArrFmtDef (AnExpr: string; ARecSuffix, AValue: Integer; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
begin
case ARecSuffix of
1: Result := Add(AnExpr, wdfDefault, MatchRecord('TRecForArray1', ' a = '+IntToStr(AValue)), skRecord, 'TRecForArray1', AFlgs );
2: Result := Add(AnExpr, wdfDefault, MatchRecord('TRecForArray2', ' c = '+IntToStr(AValue)), skRecord, 'TRecForArray2', AFlgs );
3: Result := Add(AnExpr, wdfDefault, MatchRecord('TRecForArray3', ' a = '+IntToStr(AValue)), skRecord, 'TRecForArray3', AFlgs );
4: Result := Add(AnExpr, wdfDefault, MatchRecord('TRecForArray4', ' c = '+IntToStr(AValue)), skRecord, 'TRecForArray4', AFlgs );
1: Result := Add(AnExpr, MatchRecord('TRecForArray1', ' a = '+IntToStr(AValue)), skRecord, 'TRecForArray1', AFlgs );
2: Result := Add(AnExpr, MatchRecord('TRecForArray2', ' c = '+IntToStr(AValue)), skRecord, 'TRecForArray2', AFlgs );
3: Result := Add(AnExpr, MatchRecord('TRecForArray3', ' a = '+IntToStr(AValue)), skRecord, 'TRecForArray3', AFlgs );
4: Result := Add(AnExpr, MatchRecord('TRecForArray4', ' c = '+IntToStr(AValue)), skRecord, 'TRecForArray4', AFlgs );
end;
case ARecSuffix of
1,3: Add(AnExpr+'.a', wdfDefault, '^'+IntToStr(AValue)+'$', skSimple, M_Int, AFlgs+[fTpMtch] );
2,4: Add(AnExpr+'.c', wdfDefault, '^'+IntToStr(AValue)+'$', skSimple, M_Int, AFlgs+[fTpMtch] );
1,3: Add(AnExpr+'.a', '^'+IntToStr(AValue)+'$', skSimple, M_Int, AFlgs+[fTpMtch] );
2,4: Add(AnExpr+'.c', '^'+IntToStr(AValue)+'$', skSimple, M_Int, AFlgs+[fTpMtch] );
end;
end;
function AddArrayFmtDef (AnExpr, AMtch, ATpNm: string; AFlgs: TWatchExpectationFlags=[]): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AMtch, skSimple, ATpNm, AFlgs );
Result := Add(AnExpr, AMtch, skSimple, ATpNm, AFlgs );
end;
var
@ -1202,13 +1201,13 @@ begin
//TDynStatArrayPRec2 = array of array [3..5] of ^TRecForArray2;
(* Array in expression*)
Add(v+'ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayTRec1[0].a+'+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add('ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayTRec1[0].a and '+v+'ArgTDynArrayTRec1[1].a', wdfDefault, '^90$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayTRec1[0].a+'+'ArgTDynArrayTRec1[1].a', '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add('ArgTDynArrayTRec1[0].a+'+v+'ArgTDynArrayTRec1[1].a', '^181$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayTRec1[0].a and '+v+'ArgTDynArrayTRec1[1].a', '^90$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynDynArrayTRec1[1][1].a+'+v+'ArgTDynArrayPRec1[1]^.a', wdfDefault, '^177$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayPRec1[1]^.a+'+v+'ArgTDynDynArrayTRec1[1][1].a', wdfDefault, '^177$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynDynArrayTRec1[1][1].a+'+v+'ArgTDynArrayPRec1[1]^.a', '^177$', skSimple, M_Int+'|long', [fTpMtch] );
Add(v+'ArgTDynArrayPRec1[1]^.a+'+v+'ArgTDynDynArrayTRec1[1][1].a', '^177$', skSimple, M_Int+'|long', [fTpMtch] );
{%endregion DYN ARRAY (norm)}
@ -1546,17 +1545,17 @@ procedure TTestWatches.AddExpectBreakFooMixInfo;
begin
if AExpClass = '' then AExpClass := ATCast;
If ATCast <> ''
then Add(ATCast+'('+AVar+')', wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs)
else Add(AVar, wdfDefault, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs);
then Add(ATCast+'('+AVar+')', MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs)
else Add(AVar, MatchClass(AExpClass, ''), skClass, AExpClass, AFlgs);
if AIntMember <> '' then
Add(ATCast+'('+AVar+').'+AIntMember, wdfDefault, IntToStr(AIntValue), skSimple, M_Int, [fTpMtch]);
Add(ATCast+'('+AVar+').'+AIntMember, IntToStr(AIntValue), skSimple, M_Int, [fTpMtch]);
end;
procedure AddTCN(AVar, ATCast: string; AExpClass: String = ''; AFlgs: TWatchExpectationFlags = []);
begin
if AExpClass = '' then AExpClass := ATCast;
If ATCast <> ''
then Add(ATCast+'('+AVar+')', wdfDefault, MatchClassNil(AExpClass), skClass, AExpClass, AFlgs)
else Add(AVar, wdfDefault, MatchClassNil(AExpClass), skClass, AExpClass, AFlgs);
then Add(ATCast+'('+AVar+')', MatchClassNil(AExpClass), skClass, AExpClass, AFlgs)
else Add(AVar, MatchClassNil(AExpClass), skClass, AExpClass, AFlgs);
end;
begin
if not TestControlCanTest(ControlTestWatchMix) then exit;
@ -1661,7 +1660,7 @@ begin
// MIXED symbol info types
FCurrentExpArray := @ExpectBreakFooArray;
if FDoStatIntArray then
Add('VarStatIntArray', wdfDefault, '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
Add('VarStatIntArray', '10,[\s\r\n]+12,[\s\r\n]+14,[\s\r\n]+16,[\s\r\n]+18',
skSimple, 'TStatIntArray',
[]);
end;
@ -1682,31 +1681,31 @@ begin
end;
procedure TTestWatches.AddExpectBreakFooAndSubFoo;
procedure AddF(AnExpr: string; AFmt: TWatchDisplayFormat;
procedure AddF(AnExpr: string;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer=0);
begin
FCurrentExpArray := @ExpectBreakFoo;
AddWatchExp(ExpectBreakFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
AddWatchExp(ExpectBreakFoo, AnExpr, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
end;
procedure AddS(AnExpr: string; AFmt: TWatchDisplayFormat;
procedure AddS(AnExpr: string;
AMtch: string; AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags;
AStackFrame: Integer=0);
begin
FCurrentExpArray := @ExpectBreakSubFoo;
AddWatchExp(ExpectBreakSubFoo, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
AddWatchExp(ExpectBreakSubFoo, AnExpr, AMtch, AKind, ATpNm, AFlgs, AStackFrame)
end;
begin
if not TestControlCanTest(ControlTestWatchCache) then exit;
// FCurrentExpArray := @ExpectBreakSubFoo;
AddS('VarCacheTest1', wdfDefault, MatchRecord('TCacheTest', 'CTVal = 101'),
AddS('VarCacheTest1', MatchRecord('TCacheTest', 'CTVal = 101'),
skRecord, 'TCacheTest', []);
AddF('VarCacheTest1', wdfDefault, '<TCacheTest(Type)?> = \{.*(<|vptr\$)TObject>?.+CTVal = 201',
AddF('VarCacheTest1', '<TCacheTest(Type)?> = \{.*(<|vptr\$)TObject>?.+CTVal = 201',
skClass, 'TCacheTest(Type)?', [fTpMtch]);
AddS('VarCacheTest2', wdfDefault, '102', skSimple, M_Int, [fTpMtch], 0);
AddS('VarCacheTest2', wdfDefault, '202', skSimple, M_Int, [fTpMtch], 1);
AddS('VarCacheTest2', '102', skSimple, M_Int, [fTpMtch], 0);
AddS('VarCacheTest2', '202', skSimple, M_Int, [fTpMtch], 1);
end;
procedure TTestWatches.DoDbgOutput(Sender: TObject; const AText: String);

2
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -1111,7 +1111,7 @@ begin
FWatchValue.AddNotification(weeCancel, @DoWachCanceled);
inherited Create(ADebugger, twpWatch, FWatchValue.Expression, FWatchValue.StackFrame, FWatchValue.ThreadId,
FWatchValue.DisplayFormat, FWatchValue.RepeatCount, FWatchValue.EvaluateFlags);
FWatchValue.RepeatCount, FWatchValue.EvaluateFlags);
end;
{ TFpThreadWorkerBreakPointSetUpdate }

27
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas
View File

@ -233,7 +233,6 @@ type
FWatchValue: IDbgWatchValueIntf;
function EvaluateExpression(const AnExpression: String;
AStackFrame, AThreadId: Integer;
ADispFormat: TWatchDisplayFormat;
ARepeatCnt: Integer;
AnEvalFlags: TWatcheEvaluateFlags;
out AResText: String;
@ -248,7 +247,6 @@ type
private
FExpression: String;
FStackFrame, FThreadId: Integer;
FDispFormat: TWatchDisplayFormat;
FRepeatCnt: Integer;
FEvalFlags: TWatcheEvaluateFlags;
protected
@ -261,7 +259,6 @@ type
APriority: TFpThreadWorkerPriority;
const AnExpression: String;
AStackFrame, AThreadId: Integer;
ADispFormat: TWatchDisplayFormat;
ARepeatCnt: Integer;
AnEvalFlags: TWatcheEvaluateFlags
);
@ -1116,9 +1113,8 @@ begin
end;
function TFpThreadWorkerEvaluate.EvaluateExpression(const AnExpression: String;
AStackFrame, AThreadId: Integer; ADispFormat: TWatchDisplayFormat;
ARepeatCnt: Integer; AnEvalFlags: TWatcheEvaluateFlags; out AResText: String;
out ATypeInfo: TDBGType): Boolean;
AStackFrame, AThreadId: Integer; ARepeatCnt: Integer; AnEvalFlags: TWatcheEvaluateFlags;
out AResText: String; out ATypeInfo: TDBGType): Boolean;
var
APasExpr, PasExpr2: TFpPascalExpression;
PrettyPrinter: TFpPascalPrettyPrinter;
@ -1128,6 +1124,7 @@ var
ResData: IDbgWatchDataIntf;
i: Integer;
ddf: TDataDisplayFormat;
AMemDump: Boolean;
begin
Result := False;
AResText := '';
@ -1203,11 +1200,10 @@ begin
exit;
end;
if (ResValue <> nil) and (ResValue.Kind = skAddress) then
ADispFormat := wdfMemDump;
AMemDump := (defMemDump in AnEvalFlags) or
( (ResValue <> nil) and (ResValue.Kind = skAddress) );
if (FWatchValue <> nil) and (ResValue <> nil) and
(ADispFormat <> wdfMemDump) // TODO
if (FWatchValue <> nil) and (ResValue <> nil) and (not AMemDump)
then begin
WatchResConv := TFpLazDbgWatchResultConvertor.Create(FExpressionScope.LocationContext);
WatchResConv.MaxArrayConv := TFpDebugDebuggerProperties(FDebugger.GetProperties).MemLimits.MaxArrayConversionCnt;
@ -1247,7 +1243,7 @@ begin
PrettyPrinter.Context := FExpressionScope.LocationContext;
ddf := ddfDefault;
if ADispFormat = wdfMemDump then ddf := ddfMemDump;
if AMemDump then ddf := ddfMemDump;
if defNoTypeInfo in AnEvalFlags then
Result := PrettyPrinter.PrintValue(AResText, ResValue, ddf, ARepeatCnt)
else
@ -1288,19 +1284,17 @@ end;
procedure TFpThreadWorkerEvaluateExpr.DoExecute;
begin
FRes := EvaluateExpression(FExpression, FStackFrame, FThreadId,
FDispFormat, FRepeatCnt, FEvalFlags, FResText, FResDbgType);
FRepeatCnt, FEvalFlags, FResText, FResDbgType);
end;
constructor TFpThreadWorkerEvaluateExpr.Create(ADebugger: TFpDebugDebuggerBase;
APriority: TFpThreadWorkerPriority; const AnExpression: String; AStackFrame,
AThreadId: Integer; ADispFormat: TWatchDisplayFormat; ARepeatCnt: Integer;
AnEvalFlags: TWatcheEvaluateFlags);
AThreadId: Integer; ARepeatCnt: Integer; AnEvalFlags: TWatcheEvaluateFlags);
begin
inherited Create(ADebugger, APriority);
FExpression := AnExpression;
FStackFrame := AStackFrame;
FThreadId := AThreadId;
FDispFormat := ADispFormat;
FRepeatCnt := ARepeatCnt;
FEvalFlags := AnEvalFlags;
FAllowFunctions := defAllowFunctionCall in AnEvalFlags;
@ -1366,8 +1360,7 @@ constructor TFpThreadWorkerCmdEval.Create(ADebugger: TFpDebugDebuggerBase;
AThreadId: Integer; AnEvalFlags: TWatcheEvaluateFlags;
ACallback: TDBGEvaluateResultCallback);
begin
inherited Create(ADebugger, APriority, AnExpression, AStackFrame, AThreadId, wdfDefault, 0,
AnEvalFlags);
inherited Create(ADebugger, APriority, AnExpression, AStackFrame, AThreadId, 0, AnEvalFlags);
FCallback := ACallback;
end;

11
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -1025,7 +1025,6 @@ var
PasExpr, PasExpr2: TFpPascalExpression;
ResValue: TFpValue;
s: String;
DispFormat: TWatchDisplayFormat;
RepeatCnt: Integer;
TiSym: TFpSymbol;
@ -1041,6 +1040,7 @@ var
CastName: String;
WatchResConv: TFpWatchResultConvertor;
ddf: TDataDisplayFormat;
AMemDump: Boolean;
begin
Result := False;
ATypeInfo := nil;
@ -1058,12 +1058,10 @@ begin
if AWatchValue <> nil then begin
Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
DispFormat := AWatchValue.DisplayFormat;
RepeatCnt := AWatchValue.RepeatCount;
end
else begin
Ctx := GetInfoContextForContext(CurrentThreadId, CurrentStackFrame);
DispFormat := wdfDefault;
RepeatCnt := -1;
end;
if Ctx = nil then exit;
@ -1124,9 +1122,12 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
end;
end;
AMemDump := (defMemDump in EvalFlags) or
( (ResValue <> nil) and (ResValue.Kind = skAddress) );
if (AWatchValue <> nil) and
(ResValue <> nil) and (not IsError(ResValue.LastError)) and
(DispFormat <> wdfMemDump) and (AWatchValue.RepeatCount <= 0) // TODO
(not AMemDump) and (AWatchValue.RepeatCount <= 0) // TODO
then begin
WatchResConv := TFpWatchResultConvertor.Create(Ctx.LocationContext);
Result := WatchResConv.WriteWatchResultData(ResValue, AWatchValue.ResData);
@ -1137,7 +1138,7 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
ddf := ddfDefault;
if DispFormat = wdfMemDump then ddf := ddfMemDump;
if AMemDump then ddf := ddfMemDump;
TiSym := ResValue.DbgSymbol;
if (ResValue.Kind = skNone) and (TiSym <> nil) and (TiSym.SymbolType = stType) then begin
if GetTypeAsDeclaration(AResText, TiSym) then

38
components/lazdebuggers/lazdebuggerfpgdbmi/test/testwatches.pas
View File

@ -69,9 +69,9 @@ type
function HasTestArraysData: Boolean;
// Add to FLastAddedExp
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
function Add(AnExpr: string; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
function Add(AnExpr: string; AFmt: TWatchDisplayFormat; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
function Add(AnExpr: string; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
//
function AddFmtDef (AnExpr: string;
@ -243,25 +243,25 @@ begin
Result := Result or (Length(ExpectBreakSimple[i]) > 0);
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat; AMtch: string;
function TTestWatches.Add(AnExpr: string; AMtch: string;
AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpect^, AnExpr, AFmt, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpect^, AnExpr, AMtch, AKind, ATpNm, AFlgs );
FLastAddedExp := Result;
end;
function TTestWatches.Add(AnExpr: string; AFmt: TWatchDisplayFormat;
function TTestWatches.Add(AnExpr: string;
AEvalFlags: TWatcheEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := AddWatchExp(FCurrentExpect^, AnExpr, AFmt, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
Result := AddWatchExp(FCurrentExpect^, AnExpr, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
FLastAddedExp := Result;
end;
function TTestWatches.AddFmtDef(AnExpr: string; AMtch: string; AKind: TDBGSymbolKind;
ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(AnExpr, wdfDefault, AMtch, AKind, ATpNm, AFlgs );
Result := Add(AnExpr, AMtch, AKind, ATpNm, AFlgs );
end;
function TTestWatches.AddFmtDef(AnExpr: string; AnFormatParam: array of const; AMtch: string;
@ -273,14 +273,14 @@ end;
//function TTestWatches.AddFmtDef(AnExpr: String; AEvalFlags: TWatcheEvaluateFlags; AMtch: string;
// AKind: TDBGSymbolKind; ATpNm: string; AFlgs: TWatchExpectationFlags): PWatchExpectation;
//begin
// Result := Add(AnExpr, wdfDefault, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
// Result := Add(AnExpr, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
//end;
function TTestWatches.AddFmtDef(AnExpr: String; AnFormatParam: array of const;
AEvalFlags: TWatcheEvaluateFlags; AMtch: string; AKind: TDBGSymbolKind; ATpNm: string;
AFlgs: TWatchExpectationFlags): PWatchExpectation;
begin
Result := Add(Format(AnExpr, AnFormatParam), wdfDefault, AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
Result := Add(Format(AnExpr, AnFormatParam), AEvalFlags, AMtch, AKind, ATpNm, AFlgs );
end;
procedure TTestWatches.JoinExpectsForHexReplace;
@ -789,26 +789,20 @@ begin
AddExpInt('%sDynInt1%1:s[0]', [s,s2], 5511, M_Int);
AddExpInt('%sDynInt1%1:s[19]', [s,s2], 5500, M_Int);
// Test: wdfMemDump
// Test: defMemDump
//TODO: DynArray.Size / check for end after last element.
if not SkipParamArgs then begin
// 5511 = $1587 / -5511=$FFFFEA79 / 5500=$157c
AddFmtDef('%sDynInt1%1:s', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *(00 00 )?((15 87)|(87 15)) +00 00 +([0-9A-F][0-9A-F] +)*00 ((15 7C)|(7C 15))'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sDynInt1%1:s[1]', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 15 88)|(88 15 00 00)) *$'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sDynInt1%1:s[1]', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 15 88)|(88 15 00 00)) +[0-9A-F][0-9A-F]'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sDynInt1%1:s', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *(00 00 )?((15 87)|(87 15)) +00 00 +([0-9A-F][0-9A-F] +)*00 ((15 7C)|(7C 15))'), skArray, '', [fTpMtch]);
AddFmtDef('%sDynInt1%1:s[1]', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 15 88)|(88 15 00 00)) *$'), skArray, '', [fTpMtch]);
AddFmtDef('%sDynInt1%1:s[1]', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 15 88)|(88 15 00 00)) +[0-9A-F][0-9A-F]'), skArray, '', [fTpMtch]);
FLastAddedExp^.RepeatCount := 5;
end;
// 6600 = $19C8 / 6699=$1A2B
AddFmtDef('%sStatAInt1%1:s', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *(00 00 )?((19 C8)|(C8 19)) +00 00 +([0-9A-F][0-9A-F] +)*00 ((1A 2B)|(2B 1A))'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sStatAInt1%1:s[5]', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 19 C9)|(C9 19 00 00)) *$'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sStatAInt1%1:s[5]', [s,s2], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 19 C9)|(C9 19 00 00)) +[0-9A-F][0-9A-F]'), skArray, '', [fTpMtch]);
FLastAddedExp^.DspFormat := wdfMemDump;
AddFmtDef('%sStatAInt1%1:s', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *(00 00 )?((19 C8)|(C8 19)) +00 00 +([0-9A-F][0-9A-F] +)*00 ((1A 2B)|(2B 1A))'), skArray, '', [fTpMtch]);
AddFmtDef('%sStatAInt1%1:s[5]', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 19 C9)|(C9 19 00 00)) *$'), skArray, '', [fTpMtch]);
AddFmtDef('%sStatAInt1%1:s[5]', [s,s2], [defMemDump], Sp2RegEx('^\$?[0-9A-F]+: *((00 00 19 C9)|(C9 19 00 00)) +[0-9A-F][0-9A-F]'), skArray, '', [fTpMtch]);
FLastAddedExp^.RepeatCount := 5;
// Test: typecast dynarray to dynarray

17
components/lazdebuggers/lazdebuggerfplldb/fplldbdebugger.pas
View File

@ -1654,7 +1654,6 @@ var
PasExpr, PasExpr2: TFpPascalExpression;
ResValue: TFpValue;
s: String;
DispFormat: TWatchDisplayFormat;
RepeatCnt: Integer;
TiSym: TFpSymbol;
@ -1672,6 +1671,7 @@ var
NameLen: QWord;
WatchResConv: TFpWatchResultConvertor;
ddf: TDataDisplayFormat;
AMemDump: Boolean;
begin
Result := False;
@ -1690,12 +1690,10 @@ begin
if AWatchValue <> nil then begin
Ctx := GetInfoContextForContext(AWatchValue.ThreadId, AWatchValue.StackFrame);
DispFormat := AWatchValue.DisplayFormat;
RepeatCnt := AWatchValue.RepeatCount;
end
else begin
Ctx := GetInfoContextForContext(CurrentThreadId, CurrentStackFrame);
DispFormat := wdfDefault;
RepeatCnt := -1;
end;
if Ctx = nil then exit;
@ -1715,11 +1713,10 @@ begin
if not IsWatchValueAlive then exit;
if not PasExpr.Valid then begin
DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
if ErrorCode(PasExpr.Error) <> fpErrAnyError then begin
Result := True;
AResText := ErrorHandler.ErrorAsString(PasExpr.Error);;
if AWatchValue <> nil then begin;
AResText := ErrorHandler.ErrorAsString(PasExpr.Error);
if AWatchValue <> nil then begin
AWatchValue.Value := AResText;
AWatchValue.Validity := ddsError;
end;
@ -1767,12 +1764,12 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
end;
end;
if (ResValue <> nil) and (ResValue.Kind = skAddress) then
DispFormat := wdfMemDump;
AMemDump := (defMemDump in EvalFlags) or
( (ResValue <> nil) and (ResValue.Kind = skAddress) );
if (AWatchValue <> nil) and
(ResValue <> nil) and (not IsError(ResValue.LastError)) and
(DispFormat <> wdfMemDump) and (AWatchValue.RepeatCount <= 0) // TODO
(not AMemDump) and (AWatchValue.RepeatCount <= 0) // TODO
then begin
WatchResConv := TFpWatchResultConvertor.Create(Ctx.LocationContext);
Result := WatchResConv.WriteWatchResultData(ResValue, AWatchValue.ResData);
@ -1783,7 +1780,7 @@ DebugLn(DBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
ddf := ddfDefault;
if DispFormat = wdfMemDump then ddf := ddfMemDump;
if AMemDump then ddf := ddfMemDump;
case ResValue.Kind of
skNone: begin
// maybe type

13
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas
View File

@ -107,22 +107,13 @@ type
******************************************************************************
******************************************************************************}
TWatchDisplayFormat =
(wdfDefault,
wdfStructure,
wdfChar, wdfString,
wdfDecimal, wdfUnsigned, wdfFloat, wdfHex,
wdfPointer,
wdfMemDump, wdfBinary
);
TWatchDisplayFormats = set of TWatchDisplayFormat;
TWatcheEvaluateFlag =
( defClassAutoCast, // Find real class of instance, and use, instead of declared class of variable
defAllowFunctionCall, //
defFunctionCallRunAllThreads, //
defExtraDepth, // Evaluate 1 extra level of sub-elements => i.e., evaluate each nested sub-item
defSkipValConv,
defMemDump, // Return Memory Dump, **instead** of value
// deprecated
defNoTypeInfo, // No Typeinfo object will be returned // for structures that means a printed value will be returned
defSimpleTypeInfo, // Returns: Kind (skSimple, skClass, ..); TypeName (but does make no attempt to avoid an alias)
@ -246,7 +237,6 @@ type
(* ***** Methods for the front-end to provide the request ***** *)
function GetDisplayFormat: TWatchDisplayFormat;
function GetEvaluateFlags: TWatcheEvaluateFlags;
function GetDbgValConverter: ILazDbgValueConvertSelectorIntf;
function GetExpression: String;
@ -260,7 +250,6 @@ type
procedure SetValidity(AValue: TDebuggerDataState);
procedure SetValue(AValue: String);
property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat; // deprecated
property EvaluateFlags: TWatcheEvaluateFlags read GetEvaluateFlags;
property FirstIndexOffs: Int64 read GetFirstIndexOffs;
property RepeatCount: Integer read GetRepeatCount;

9
ide/packages/idedebugger/debugger.pp
View File

@ -776,6 +776,8 @@ type
procedure DoEndUpdating; override;
function ResData: IDbgWatchDataIntf;
function GetDbgValConverter: ILazDbgValueConvertSelectorIntf;
function GetIntfEvaluateFlags: TWatcheEvaluateFlags;
function IDbgWatchValueIntf.GetEvaluateFlags = GetIntfEvaluateFlags;
private
FOnValidityChanged: TNotifyEvent;
FSnapShot: TIdeWatchValue;
@ -4132,6 +4134,13 @@ begin
Result := FDbgBackendConverter;
end;
function TCurrentWatchValue.GetIntfEvaluateFlags: TWatcheEvaluateFlags;
begin
Result := EvaluateFlags;
if FDisplayFormat = wdfMemDump then
Result := Result + [defMemDump];
end;
procedure TCurrentWatchValue.SetSnapShot(const AValue: TIdeWatchValue);
begin
assert((FSnapShot=nil) or (AValue=nil), 'TCurrentWatchValue already have snapshot');

2
ide/packages/idedebugger/frames/watchinspecttoolbar.pas
View File

@ -13,7 +13,7 @@ uses
// LazControls
SpinEx,
// IdeIntf
IDEImagesIntf,
IDEImagesIntf, IdeDebuggerWatchValueIntf,
// Debugger
LazDebuggerIntf, IdeDebuggerStringConstants, ArrayNavigationFrame,
IdeDebuggerOpts, Debugger, IdeDebuggerBackendValueConv, IdeDebuggerBase,

5
ide/packages/idedebugger/idedbgvalueformattersettingsframe.pas
View File

@ -6,8 +6,9 @@ interface
uses
Classes, SysUtils, Forms, Controls, ExtCtrls, CheckLst, StdCtrls, Dialogs,
StrUtils, IdeDebuggerValueFormatterIntf, LazDebuggerIntf,
IdeDebuggerStringConstants, IdeDebuggerValueFormatter, IdeDebuggerUtils;
StrUtils, IdeDebuggerValueFormatterIntf, IdeDebuggerWatchValueIntf,
LazDebuggerIntf, IdeDebuggerStringConstants, IdeDebuggerValueFormatter,
IdeDebuggerUtils;
type

12
ide/packages/idedebugger/idedebuggerbase.pas
View File

@ -443,15 +443,13 @@ end;
function TWatchValue.GetDisplayFormat: TWatchDisplayFormat;
begin
if (FWatch <> nil) and
(FWatch.FDisplayFormat <> wdfMemDump) and
(FDisplayFormat <> wdfMemDump) and
(FResultData <> nil) and
(FResultData.ValueKind <> rdkPrePrinted)
if (FWatch = nil) or
(FDisplayFormat = wdfMemDump) or
(FWatch.FDisplayFormat = wdfMemDump)
then
Result := FWatch.DisplayFormat
Result := FDisplayFormat
else
Result := FDisplayFormat;
Result := FWatch.DisplayFormat;
end;
function TWatchValue.GetRepeatCount: Integer;

2
ide/packages/idedebugger/idedebuggerutils.pas
View File

@ -5,7 +5,7 @@ unit IdeDebuggerUtils;
interface
uses
Classes, SysUtils, IdeDebuggerStringConstants, LazDebuggerIntf;
Classes, SysUtils, IdeDebuggerStringConstants, IdeDebuggerWatchValueIntf;
function HexDigicCount(ANum: QWord; AByteSize: Integer = 0; AForceAddr: Boolean = False): integer;
function QuoteText(AText: Utf8String): UTf8String;

6
ide/packages/idedebugger/idedebuggervalueformattersetup.pas
View File

@ -5,9 +5,9 @@ unit IdeDebuggerValueFormatterSetup;
interface
uses
LazIDEIntf, LazDebuggerIntf, IdeDebuggerOpts, IdeDebuggerValueFormatter,
IdeDebuggerValueFormatterDateTime, IdeDebuggerValueFormatterColor,
IdeDebuggerValueFormatterCurrency;
LazIDEIntf, IdeDebuggerWatchValueIntf, IdeDebuggerOpts,
IdeDebuggerValueFormatter, IdeDebuggerValueFormatterDateTime,
IdeDebuggerValueFormatterColor, IdeDebuggerValueFormatterCurrency;
implementation

2
ide/packages/idedebugger/watchpropertydlg.pp
View File

@ -43,7 +43,7 @@ uses
// LCL
Forms, StdCtrls, Extctrls, ButtonPanel,
// IdeIntf
IDEHelpIntf, IdeIntfStrConsts,
IDEHelpIntf, IdeIntfStrConsts, IdeDebuggerWatchValueIntf,
// IdeConfig
//EnvironmentOpts,
// DebuggerIntf