paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-10 03:48:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFp, FpDebug: Enable watch-eval calling function with strings as param/result (only DWARF 3 / up)

Browse Source
This commit is contained in:
Martin 2022-06-18 12:18:23 +02:00
parent 63a6ce4f32
commit b014798858
16 changed files with 986 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/fpdebug/fpdbgavrclasses.pas
View File

@ -83,6 +83,7 @@ type
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
procedure SetStackPointerRegisterValue(AValue: TDbgPtr); override;
function GetStackPointerRegisterValue: TDbgPtr; override;
procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); override;
@ -505,6 +506,10 @@ begin
result := byte(lval) + (byte(hval) shl 8);
end;
procedure TDbgAvrThread.SetStackPointerRegisterValue(AValue: TDbgPtr);
begin
end;
function TDbgAvrThread.GetStackPointerRegisterValue: TDbgPtr;
begin
Result := 0;

334
components/fpdebug/fpdbgcallcontextinfo.pas
View File

@ -5,14 +5,33 @@ unit FpDbgCallContextInfo;
interface
uses
DbgIntfBaseTypes,
DbgIntfBaseTypes, math,
FpDbgInfo,
FpdMemoryTools,
FpDbgDwarfDataClasses,
FpDbgDwarf,
FpDbgClasses, FpErrorMessages;
FpDbgClasses, FpErrorMessages, FpDbgUtil, LazLoggerBase, LazClasses;
type
{ TFpValueCallParamStringByRef }
TFpValueCallParamStringByRef = class(TFpValueDwarfPointer)
function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
ATargetType: TFpSymbolDwarfType = nil): Boolean; override;
end;
{ TFpSymbolCallParamStringByRef }
TFpSymbolCallParamStringByRef = class(TFpSymbolDwarfTypeBasic) // act as pointer
protected
procedure KindNeeded; override;
procedure Init; override;
public
constructor Create(AName: String; AStringVarAddress: TDBGPtr);
function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override;
end;
{ TFpSymbolDwarfFunctionResult }
TFpSymbolDwarfFunctionResult = class(TFpSymbolDwarfDataWithLocation)
@ -30,19 +49,84 @@ type
TFpDbgInfoCallContext = class(TFpDbgAbstractCallContext)
private
FDbgProcess: TDbgProcess;
FDbgThread: TDbgThread;
FLastError: TFpError;
FNextParamRegister: Integer;
FOrigStackPtr: TDBGPtr;
FNeedStringResInFinalize: Boolean;
FStringResultMem: TDBGPtr;
function AllocStack(ASize: Integer): TDbgPtr;
function InternalCreateParamSymbol(ParameterMemLocation: TFpDbgMemLocation; ASymbolType: TFpSymbol; AName: String): TFpValue;
function InternalCreateParamSymbol(AParamIndex: Integer; ASymbolType: TFpSymbol; AName: String): TFpValue; inline;
function InternalAddStringResult: Boolean;
public
constructor Create(const ABaseContext: TFpDbgLocationContext;
AMemReader: TFpDbgMemReaderBase;
AMemConverter: TFpDbgMemConvertor;
ADbgProcess: TDbgProcess);
ADbgProcess: TDbgProcess;
ADbgThread: TDbgThread);
destructor Destroy; override;
function CreateParamSymbol(AParamIndex: Integer; ASymbolType: TFpSymbol; AName: String = ''): TFpValue; virtual;
function AddParam(AParamIndex: Integer; AParamSymbolType: TFpSymbol; AValue: TFpValue): Boolean;
function AddParam(AParamSymbolType: TFpSymbol; AValue: TFpValue): Boolean;
function AddOrdinalParam(AParamSymbolType: TFpSymbol; AValue: QWord): Boolean;
(* AddStringResult:
Must be called before any AddParam.
Except for "Self": In case of a method, AddParm(self) must be set before the StringResult
*)
function AddStringResult: Boolean;
function AddOrdinalViaRefAsParam(AValue: QWord): Boolean; // For string dec-ref
function FinalizeParams: Boolean;
// The caller must take care to call DecRef for the result
function GetStringResultAsPointer(out AStringAsPtr: TDbgPtr): Boolean;
function GetStringResult(out AVal: TFpValue; AStringSymbolType: TFpSymbol = nil): Boolean;
function GetWideStringResult(out AVal: TFpValue; AStringSymbolType: TFpSymbol = nil): Boolean;
property LastError: TFpError read FLastError;
end;
implementation
{ TFpValueCallParamStringByRef }
function TFpValueCallParamStringByRef.GetDwarfDataAddress(out
AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType): Boolean;
begin
AnAddress := Address;
Result := IsReadableLoc(AnAddress);
end;
{ TFpSymbolCallParamStringByRef }
procedure TFpSymbolCallParamStringByRef.KindNeeded;
begin
SetKind(skPointer);
end;
procedure TFpSymbolCallParamStringByRef.Init;
begin
inherited Init;
EvaluatedFields := EvaluatedFields + [sfiAddress];
end;
function TFpSymbolCallParamStringByRef.GetTypedValueObject(ATypeCast: Boolean;
AnOuterType: TFpSymbolDwarfType): TFpValueDwarf;
begin
Result := TFpValueCallParamStringByRef.Create(AnOuterType);
end;
constructor TFpSymbolCallParamStringByRef.Create(AName: String;
AStringVarAddress: TDBGPtr);
begin
inherited Create(AName, skPointer, TargetLoc(AStringVarAddress));
SetTypeInfo(TFpSymbolDwarfTypePointer.Create(AName));
TypeInfo.ReleaseReference;
Init;
end;
{ TFpSymbolDwarfFunctionResult }
function TFpSymbolDwarfFunctionResult.GetValueAddress(AValueObj: TFpValueDwarf; out AnAddress: TFpDbgMemLocation): Boolean;
@ -67,24 +151,27 @@ end;
{ TFpDbgInfoCallContext }
constructor TFpDbgInfoCallContext.Create(
const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase;
AMemConverter: TFpDbgMemConvertor; ADbgProcess: TDbgProcess);
function TFpDbgInfoCallContext.AllocStack(ASize: Integer): TDbgPtr;
begin
inherited Create(ABaseContext, AMemReader, AMemConverter);
FDbgProcess := ADbgProcess;
Result := FDbgThread.GetStackPointerRegisterValue;
if FOrigStackPtr = 0 then
FOrigStackPtr := Result;
dec(Result, ASize);
FDbgThread.SetStackPointerRegisterValue(Result);
end;
function TFpDbgInfoCallContext.CreateParamSymbol(AParamIndex: Integer;
ASymbolType: TFpSymbol; AName: String): TFpValue;
function TFpDbgInfoCallContext.InternalCreateParamSymbol(
ParameterMemLocation: TFpDbgMemLocation; ASymbolType: TFpSymbol; AName: String
): TFpValue;
var
ParameterMemLocation: TFpDbgMemLocation;
ParamSymbol: TFpSymbol;// TFpSymbolDwarfFunctionResult;
begin
ParameterMemLocation := FDbgProcess.CallParamDefaultLocation(AParamIndex);
if AName = '' then
AName := ASymbolType.Name;
ParamSymbol := TFpSymbolDwarfFunctionResult.Create(AName, ParameterMemLocation, ASymbolType.TypeInfo);
Result := nil;
if not IsValidLoc(ParameterMemLocation) then begin
FLastError := CreateError(fpErrAnyError, ['Too many params']);
exit;
end;
ParamSymbol := TFpSymbolDwarfFunctionResult.Create(AName, ParameterMemLocation, ASymbolType);
try
Result := ParamSymbol.Value;
finally
@ -93,13 +180,70 @@ begin
TFpValueDwarf(Result).Context := Self;
end;
function TFpDbgInfoCallContext.AddParam(AParamIndex: Integer;
AParamSymbolType: TFpSymbol; AValue: TFpValue): Boolean;
function TFpDbgInfoCallContext.InternalCreateParamSymbol(AParamIndex: Integer;
ASymbolType: TFpSymbol; AName: String): TFpValue;
begin
Result := InternalCreateParamSymbol(FDbgProcess.CallParamDefaultLocation(AParamIndex),
ASymbolType, AName);
end;
function TFpDbgInfoCallContext.InternalAddStringResult: Boolean;
var
ParamSymbol: TFpValue;
begin
ParamSymbol := InternalCreateParamSymbol(FNextParamRegister,
TFpSymbolCallParamStringByRef.Create('', 0),
''
);
try
Result := ParamSymbol <> nil;
if not Result then
exit;
ParamSymbol.AsCardinal := FStringResultMem;
Result := not IsError(ParamSymbol.LastError);
FLastError := ParamSymbol.LastError;
finally
ParamSymbol.ReleaseReference;
end;
inc(FNextParamRegister);
end;
constructor TFpDbgInfoCallContext.Create(
const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase;
AMemConverter: TFpDbgMemConvertor; ADbgProcess: TDbgProcess;
ADbgThread: TDbgThread);
begin
inherited Create(ABaseContext, AMemReader, AMemConverter);
FDbgProcess := ADbgProcess;
FDbgThread := ADbgThread;
FNextParamRegister := 0;
end;
destructor TFpDbgInfoCallContext.Destroy;
begin
inherited Destroy;
if FOrigStackPtr <> 0 then
FDbgThread.SetStackPointerRegisterValue(FOrigStackPtr);
end;
function TFpDbgInfoCallContext.CreateParamSymbol(AParamIndex: Integer;
ASymbolType: TFpSymbol; AName: String): TFpValue;
begin
if AName = '' then
AName := ASymbolType.Name;
Result := InternalCreateParamSymbol(AParamIndex, ASymbolType.TypeInfo, AName);
end;
function TFpDbgInfoCallContext.AddParam(AParamSymbolType: TFpSymbol; AValue: TFpValue): Boolean;
var
ParamSymbol: TFpValue;
begin
Result := False;
ParamSymbol := CreateParamSymbol(AParamIndex, AParamSymbolType);
ParamSymbol := InternalCreateParamSymbol(FNextParamRegister, AParamSymbolType, '');
Result := ParamSymbol <> nil;
if not Result then
exit;
try
ParamSymbol.AsCardinal := AValue.AsCardinal;
Result := not IsError(ParamSymbol.LastError);
@ -107,6 +251,158 @@ begin
finally
ParamSymbol.ReleaseReference;
end;
inc(FNextParamRegister);
end;
function TFpDbgInfoCallContext.AddOrdinalParam(AParamSymbolType: TFpSymbol; AValue: QWord): Boolean;
var
ParamSymbol: TFpValue;
begin
Result := False;
ParamSymbol := InternalCreateParamSymbol(FNextParamRegister, AParamSymbolType, '');
Result := ParamSymbol <> nil;
if not Result then
exit;
try
ParamSymbol.AsCardinal := AValue;
Result := not IsError(ParamSymbol.LastError);
FLastError := ParamSymbol.LastError;
finally
ParamSymbol.ReleaseReference;
end;
inc(FNextParamRegister);
end;
function TFpDbgInfoCallContext.AddStringResult: Boolean;
var
ANil: QWord;
begin
Result := True;
ANil := 0;
FStringResultMem := AllocStack(32); // TODO: only Win64 needs 32 alignemnt
FDbgProcess.WriteData(FStringResultMem, FDbgProcess.PointerSize, ANil);
FNeedStringResInFinalize := FDbgProcess.Mode = dm32;
if not FNeedStringResInFinalize then
Result := InternalAddStringResult;
end;
function TFpDbgInfoCallContext.AddOrdinalViaRefAsParam(AValue: QWord): Boolean;
var
ParamSymbol: TFpValue;
m: TDBGPtr;
begin
m := AllocStack(32);
ParamSymbol := InternalCreateParamSymbol(FNextParamRegister,
TFpSymbolCallParamStringByRef.Create('', m),
''
);
Result := ParamSymbol <> nil;
if not Result then
exit;
try
ParamSymbol.AsCardinal := m;
Result := not IsError(ParamSymbol.LastError);
FLastError := ParamSymbol.LastError;
finally
ParamSymbol.ReleaseReference;
end;
inc(FNextParamRegister);
end;
function TFpDbgInfoCallContext.FinalizeParams: Boolean;
begin
Result := True;
if FNeedStringResInFinalize then
Result := InternalAddStringResult;
end;
function TFpDbgInfoCallContext.GetStringResultAsPointer(out
AStringAsPtr: TDbgPtr): Boolean;
begin
Result := FDbgProcess.ReadAddress(FStringResultMem, AStringAsPtr);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
end;
function TFpDbgInfoCallContext.GetStringResult(out AVal: TFpValue;
AStringSymbolType: TFpSymbol): Boolean;
var
Addr, l: TDbgPtr;
ResSymbol: TFpValue;
s: String;
r: Cardinal;
begin
AVal := nil;
Result := GetStringResultAsPointer(Addr);
if not Result then
exit;
if AStringSymbolType <> nil then begin
ResSymbol := InternalCreateParamSymbol(ConstDerefLoc(Addr), AStringSymbolType, 'result');
AVal := TFpValueConstString.Create(ResSymbol.AsString);
Result := IsError(ResSymbol.LastError);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
ReleaseRefAndNil(ResSymbol);
exit;
end;
s := '';
if Addr <> 0 then begin
Result := FDbgProcess.ReadAddress(Addr - FDbgProcess.PointerSize, l);
if Result then begin
l := min(l, 1000*1024);
SetLength(s, l);
Result := FDbgProcess.ReadData(Addr, l, s[1], r);
SetLength(s,r);
end;
if not Result then begin
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
exit;
end;
end;
AVal := TFpValueConstString.Create(s);
end;
function TFpDbgInfoCallContext.GetWideStringResult(out AVal: TFpValue;
AStringSymbolType: TFpSymbol): Boolean;
var
Addr, l: TDbgPtr;
ResSymbol: TFpValue;
s: WideString;
r: Cardinal;
begin
AVal := nil;
Result := GetStringResultAsPointer(Addr);
if not Result then
exit;
if AStringSymbolType <> nil then begin
ResSymbol := InternalCreateParamSymbol(ConstDerefLoc(Addr), AStringSymbolType, 'result');
AVal := TFpValueConstString.Create(ResSymbol.AsString);
Result := IsError(ResSymbol.LastError);
if not Result then
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
ReleaseRefAndNil(ResSymbol);
exit;
end;
s := '';
if Addr <> 0 then begin
Result := FDbgProcess.ReadAddress(Addr - FDbgProcess.PointerSize, l);
if Result then begin
l := min(l, 1000*1024);
SetLength(s, l);
Result := FDbgProcess.ReadData(Addr, l*2, s[1], r);
SetLength(s,r);
end;
if not Result then begin
FLastError := CreateError(fpErrAnyError, ['failed to read mem']);
exit;
end;
end;
AVal := TFpValueConstString.Create(s);
end;
end.

21
components/fpdebug/fpdbgclasses.pp
View File

@ -212,6 +212,7 @@ type
FStoreStepStartAddr, FStoreStepEndAddr: TDBGPtr;
FStoreStepSrcLineNo: integer;
FStoreStepFuncAddr: TDBGPtr;
FStackBeforeAlloc: TDBGPtr;
procedure LoadRegisterValues; virtual;
property Process: TDbgProcess read FProcess;
function ResetInstructionPointerAfterBreakpoint: boolean; virtual; abstract;
@ -239,8 +240,12 @@ type
function GetInstructionPointerRegisterValue: TDbgPtr; virtual; abstract;
function GetStackBasePointerRegisterValue: TDbgPtr; virtual; abstract;
function GetStackPointerRegisterValue: TDbgPtr; virtual; abstract;
procedure SetStackPointerRegisterValue(AValue: TDbgPtr); virtual; abstract;
function GetCurrentStackFrameInfo: TDbgStackFrameInfo;
function AllocStackMem(ASize: Integer): TDbgPtr; virtual;
procedure RestoreStackMem;
procedure PrepareCallStackEntryList(AFrameRequired: Integer = -1); virtual;
function FindCallStackEntryByBasePointer(AFrameBasePointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
function FindCallStackEntryByInstructionPointer(AInstructionPointer: TDBGPtr; AMaxFrameToSearch: Integer; AStartFrame: integer = 0): Integer; //virtual;
@ -2985,6 +2990,22 @@ begin
Result := TDbgStackFrameInfo.Create(Self);
end;
function TDbgThread.AllocStackMem(ASize: Integer): TDbgPtr;
begin
Result := GetStackPointerRegisterValue;
if FStackBeforeAlloc = 0 then
FStackBeforeAlloc := Result;
dec(Result, ASize);
SetStackPointerRegisterValue(Result);
end;
procedure TDbgThread.RestoreStackMem;
begin
if FStackBeforeAlloc <> 0 then
SetStackPointerRegisterValue(FStackBeforeAlloc);
FStackBeforeAlloc := 0;
end;
procedure TDbgThread.PrepareCallStackEntryList(AFrameRequired: Integer);
const
MAX_FRAMES = 50000; // safety net

2
components/fpdebug/fpdbgcontroller.pas
View File

@ -1940,7 +1940,7 @@ function TDbgController.Call(const FunctionAddress: TFpDbgMemLocation;
var
Context: TFpDbgInfoCallContext;
begin
Context := TFpDbgInfoCallContext.Create(ABaseContext, AMemReader, AMemConverter, FCurrentProcess);
Context := TFpDbgInfoCallContext.Create(ABaseContext, AMemReader, AMemConverter, FCurrentProcess, FCurrentThread);
Context.AddReference;
InitializeCommand(TDbgControllerCallRoutineCmd.Create(self, FunctionAddress, Context));
Result := Context;

5
components/fpdebug/fpdbgdarwinclasses.pas
View File

@ -123,6 +123,7 @@ type
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackPointerRegisterValue: TDbgPtr; override;
procedure SetStackPointerRegisterValue(AValue: TDbgPtr); override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
end;
@ -561,6 +562,10 @@ begin
result := FThreadState64.__rsp;
end;
procedure TDbgDarwinThread.SetStackPointerRegisterValue(AValue: TDbgPtr);
begin
end;
function TDbgDarwinThread.GetStackBasePointerRegisterValue: TDbgPtr;
begin
if Process.Mode=dm32 then

2
components/fpdebug/fpdbgdwarf.pas
View File

@ -204,7 +204,7 @@ type
// Address of the data (followed type deref, location, ...)
function OrdOrDataAddr: TFpDbgMemLocation;
function GetDataAddress: TFpDbgMemLocation; override;
function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType = nil): Boolean;
function GetDwarfDataAddress(out AnAddress: TFpDbgMemLocation; ATargetType: TFpSymbolDwarfType = nil): Boolean; virtual;
function GetStructureDwarfDataAddress(out AnAddress: TFpDbgMemLocation;
ATargetType: TFpSymbolDwarfType = nil): Boolean;

7
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -504,6 +504,7 @@ type
protected
procedure Init; virtual;
public
constructor Create(const AName: String); overload;
constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry); overload;
constructor Create(const AName: String; AnInformationEntry: TDwarfInformationEntry;
AKind: TDbgSymbolKind; const AAddress: TFpDbgMemLocation); overload;
@ -4041,6 +4042,12 @@ begin
//
end;
constructor TDbgDwarfSymbolBase.Create(const AName: String);
begin
inherited Create(AName);
Init;
end;
constructor TDbgDwarfSymbolBase.Create(const AName: String;
AnInformationEntry: TDwarfInformationEntry);
begin

21
components/fpdebug/fpdbgdwarffreepascal.pas
View File

@ -247,6 +247,8 @@ type
function GetFieldFlags: TFpValueFieldFlags; override;
function GetAsString: AnsiString; override;
function GetAsWideString: WideString; override;
procedure SetAsCardinal(AValue: QWord); override;
function GetAsCardinal: QWord; override;
public
property DynamicCodePage: TSystemCodePage read GetCodePage;
end;
@ -1535,6 +1537,25 @@ begin
Result := GetAsString;
end;
procedure TFpValueDwarfV3FreePascalString.SetAsCardinal(AValue: QWord);
begin
if not Context.WriteUnsignedInt(Address, SizeVal(AddressSize), AValue) then begin
SetLastError(Context.LastMemError);
end;
FValueDone := False;
end;
function TFpValueDwarfV3FreePascalString.GetAsCardinal: QWord;
var
d: TFpDbgMemLocation;
begin
d := DataAddress;
if IsTargetAddr(d) then
Result := DataAddress.Address
else
Result := inherited GetAsCardinal;
end;
function TFpValueDwarfV3FreePascalString.ObtainDynamicCodePage(Addr: TFpDbgMemLocation; out
Codepage: TSystemCodePage): Boolean;
var

7
components/fpdebug/fpdbginfo.pas
View File

@ -1607,11 +1607,12 @@ end;
function TFpSymbolForwarder.GetForwardToSymbol: TFpSymbol;
begin
if TMethod(@ForwardToSymbolNeeded).Code = Pointer(@TFpSymbolForwarder.ForwardToSymbolNeeded) then
exit(nil);
if not(sfiForwardToSymbol in EvaluatedFields) then begin
if TMethod(@ForwardToSymbolNeeded).Code = Pointer(@TFpSymbolForwarder.ForwardToSymbolNeeded) then
exit(nil);
if not(sfiForwardToSymbol in EvaluatedFields) then
ForwardToSymbolNeeded;
end;
Result := FForwardToSymbol;
end;

13
components/fpdebug/fpdbglinuxclasses.pas
View File

@ -296,6 +296,7 @@ type
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
procedure SetStackPointerRegisterValue(AValue: TDbgPtr); override;
function GetStackPointerRegisterValue: TDbgPtr; override;
end;
@ -806,6 +807,16 @@ begin
result := FUserRegs.regs64[rbp];
end;
procedure TDbgLinuxThread.SetStackPointerRegisterValue(AValue: TDbgPtr);
begin
if not FHasThreadState then
exit;
if Process.Mode=dm32 then
FUserRegs.regs32[UESP] := AValue
else
FUserRegs.regs64[rsp] := AValue;
end;
function TDbgLinuxThread.GetStackPointerRegisterValue: TDbgPtr;
begin
//{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgLinuxThread.GetStackPointerRegisterValue');{$ENDIF}
@ -827,6 +838,8 @@ begin
case AName of
'eip': FUserRegs.regs32[eip] := AValue;
'eax': FUserRegs.regs32[eax] := AValue;
'ecx': FUserRegs.regs32[ecx] := AValue;
'edx': FUserRegs.regs32[edx] := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;

20
components/fpdebug/fpdbgwinclasses.pas
View File

@ -162,6 +162,7 @@ type
procedure RestoreRegisters; override;
function GetInstructionPointerRegisterValue: TDbgPtr; override;
function GetStackBasePointerRegisterValue: TDbgPtr; override;
procedure SetStackPointerRegisterValue(AValue: TDbgPtr); override;
function GetStackPointerRegisterValue: TDbgPtr; override;
property Process;
end;
@ -1718,8 +1719,8 @@ end;
procedure TDbgWinThread.BeforeContinue;
begin
inherited;
if ID = MDebugEvent.dwThreadId then begin
inherited;
{$ifdef cpux86_64}
if (TDbgWinProcess(Process).FBitness = b32) then begin
@ -1834,6 +1835,8 @@ begin
'rax': FCurrentContext^.def.Rax := AValue;
'rcx': FCurrentContext^.def.Rcx := AValue;
'rdx': FCurrentContext^.def.Rdx := AValue;
'r8': FCurrentContext^.def.R8 := AValue;
'r9': FCurrentContext^.def.R9 := AValue;
else
raise Exception.CreateFmt('Setting the [%s] register is not supported', [AName]);
end;
@ -1894,6 +1897,21 @@ begin
{$endif}
end;
procedure TDbgWinThread.SetStackPointerRegisterValue(AValue: TDbgPtr);
begin
if FCurrentContext = nil then
exit;
{$ifdef cpui386}
FCurrentContext^.def.Esp := AValue;
{$else}
if (TDbgWinProcess(Process).FBitness = b32) then
FCurrentContext^.WOW.Esp := AValue
else
FCurrentContext^.def.Rsp := AValue;
{$endif}
FThreadContextChanged:=True;
end;
function TDbgWinThread.GetStackPointerRegisterValue: TDbgPtr;
begin
//{$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TDbgWinThread.GetStackPointerRegisterValue');{$ENDIF}

8
components/fpdebug/fpdmemorytools.pas
View File

@ -454,6 +454,7 @@ function RegisterLoc(ARegNum: Cardinal): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: TDbgPtr): TFpDbgMemLocation; inline;
function SelfLoc(AnAddress: Pointer): TFpDbgMemLocation; inline;
function ConstLoc(AValue: QWord): TFpDbgMemLocation; inline;
function ConstDerefLoc(AValue: QWord): TFpDbgMemLocation; inline;
function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64): TFpDbgMemLocation; inline;
@ -562,6 +563,13 @@ begin
Result.MType := mlfConstant;
end;
function ConstDerefLoc(AValue: QWord): TFpDbgMemLocation;
begin
Result := Default(TFpDbgMemLocation);
Result.Address := AValue;
Result.MType := mlfConstantDeref;
end;
function AddBitOffset(const AnAddr: TFpDbgMemLocation; ABitOffset: Int64
): TFpDbgMemLocation;
begin

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

@ -49,7 +49,8 @@ uses
FpDbgUtil, FPDbgController, FpPascalBuilder, FpdMemoryTools, FpDbgInfo,
FpPascalParser, FpErrorMessages, FpDbgCallContextInfo, FpDbgDwarf,
FpDbgDwarfDataClasses, FpWatchResultData, LazDebuggerIntf,
Forms, fgl, math, Classes, sysutils, {$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif};
Forms, fgl, math, Classes, sysutils, LazClasses,
{$ifdef FORCE_LAZLOGGER_DUMMY} LazLoggerDummy {$else} LazLoggerBase {$endif};
type
@ -778,16 +779,19 @@ function TFpThreadWorkerEvaluate.DoWatchFunctionCall(
AnExpressionPart: TFpPascalExpressionPart; AFunctionValue,
ASelfValue: TFpValue; AParams: TFpPascalExpressionPartList; out
AResult: TFpValue; var AnError: TFpError): boolean;
const
NilData: array [0..0] of TDBGPtr = (0);
var
FunctionSymbolData, FunctionSymbolType, FunctionResultSymbolType,
TempSymbol: TFpSymbol;
TempSymbol, StringDecRefSymbol, StringSymbol: TFpSymbol;
ExprParamVal: TFpValue;
ProcAddress: TFpDbgMemLocation;
ProcAddress, StringLocation: TFpDbgMemLocation;
FunctionResultDataSize: TFpDbgValueSize;
ParameterSymbolArr: array of TFpSymbol;
CallContext: TFpDbgInfoCallContext;
PCnt, i, FoundIdx, ItemsOffs: Integer;
rk: TDbgSymbolKind;
StringAddr: TDBGPtr;
begin
Result := False;
if FExpressionScope = nil then
@ -806,7 +810,7 @@ begin
FunctionResultSymbolType := FunctionSymbolType.TypeInfo;
if not (FunctionResultSymbolType.Kind in [skInteger, skCurrency, skPointer, skEnum,
skCardinal, skBoolean, skChar, skClass])
skCardinal, skBoolean, skChar, skClass, skString, skAnsiString, skWideString])
then begin
DebugLn(['Error result kind ', dbgs(FunctionSymbolType.Kind)]);
AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
@ -823,27 +827,56 @@ begin
exit;
end;
// check params
ProcAddress := AFunctionValue.DataAddress;
if not IsReadableLoc(ProcAddress) then begin
DebugLn(['Error proc addr']);
AnError := CreateError(fpErrAnyError, ['Unable to calculate function address']);
exit;
end;
PCnt := AParams.Count;
ItemsOffs := 0;
if ASelfValue <> nil then begin
inc(PCnt);
ItemsOffs := -1; // In the loop "i = 0" is the self object. So "i = 1" should be AParams[0]
end;
SetLength(ParameterSymbolArr, PCnt);
for i := 0 to High(ParameterSymbolArr) do
ParameterSymbolArr[i] := nil;
FoundIdx := 0;
try
ParameterSymbolArr := nil;
StringDecRefSymbol := nil;
StringAddr := 0;
if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString])
then begin
if (FunctionResultSymbolType.Kind = skWideString) then
StringDecRefSymbol := FDebugger.FDbgController.CurrentProcess.FindProcSymbol('FPC_WIDESTR_DECR_REF')
else
StringDecRefSymbol := FDebugger.FDbgController.CurrentProcess.FindProcSymbol('FPC_ANSISTR_DECR_REF');
if (StringDecRefSymbol = nil) or (not IsTargetNotNil(StringDecRefSymbol.Address)) then begin
DebugLn(['Error result kind ', dbgs(FunctionSymbolType.Kind)]);
AnError := CreateError(fpErrAnyError, ['Result type of function not supported']);
exit;
end;
for i := 0 to FunctionSymbolType.NestedSymbolCount - 1 do begin
StringSymbol := FunctionSymbolType.NestedSymbol[i];
if sfParameter in StringSymbol.Flags then
Continue;
if StringSymbol.Name = '$result' then
break;
end;
if StringSymbol = nil then begin
AnError := CreateError(fpErrAnyError, ['Result for string not found']);
exit;
end;
end;
// check params
ProcAddress := AFunctionValue.DataAddress;
if not IsReadableLoc(ProcAddress) then begin
DebugLn(['Error proc addr']);
AnError := CreateError(fpErrAnyError, ['Unable to calculate function address']);
exit;
end;
PCnt := AParams.Count;
ItemsOffs := 0;
if ASelfValue <> nil then begin
inc(PCnt);
ItemsOffs := -1; // In the loop "i = 0" is the self object. So "i = 1" should be AParams[0]
end;
SetLength(ParameterSymbolArr, PCnt);
for i := 0 to High(ParameterSymbolArr) do
ParameterSymbolArr[i] := nil;
FoundIdx := 0;
for i := 0 to FunctionSymbolType.NestedSymbolCount - 1 do begin
TempSymbol := FunctionSymbolType.NestedSymbol[i];
if sfParameter in TempSymbol.Flags then begin
@ -868,7 +901,11 @@ begin
exit;
end;
rk := ExprParamVal.Kind;
if not (rk in [skInteger, {skCurrency,} skPointer, skEnum, skCardinal, skBoolean, skChar, skClass]) then begin
if not(
(rk in [skInteger, {skCurrency,} skPointer, skEnum, skCardinal, skBoolean, skChar, skClass]) or
( (rk in [skString, skAnsiString, skWideString]) and (ExprParamVal.FieldFlags * [svfAddress, svfDataAddress] <> []) )
)
then begin
DebugLn('Error not supported kind arg %d : %s ', [FoundIdx, dbgs(rk)]);
AnError := CreateError(fpErrAnyError, ['parameter type not supported']);
exit;
@ -891,6 +928,7 @@ begin
inc(FoundIdx)
end;
end;
if FoundIdx <> PCnt then begin
DebugLn(['Error param count']);
AnError := CreateError(fpErrAnyError, ['wrong amount of parameters']);
@ -902,17 +940,41 @@ begin
FDebugger.FMemReader, FDebugger.FMemConverter);
try
if (ASelfValue = nil) and (StringDecRefSymbol <> nil) then begin
if not CallContext.AddStringResult then begin
DebugLn('Internal error for string result');
AnError := CallContext.LastError;
exit;
end;
end;
ItemsOffs := 0;
for i := 0 to High(ParameterSymbolArr) do begin
if (ASelfValue <> nil) and (i = 0) then
ExprParamVal := ASelfValue
if (ASelfValue <> nil) and (i = 0) then begin
ExprParamVal := ASelfValue;
dec(ItemsOffs);
end
else
ExprParamVal := AParams.Items[i + ItemsOffs].ResultValue;
if not CallContext.AddParam(i, ParameterSymbolArr[i], ExprParamVal) then begin
if not CallContext.AddParam(ParameterSymbolArr[i].TypeInfo, ExprParamVal) then begin
DebugLn('Internal error for arg %d ', [i]);
AnError := CallContext.LastError;
exit;
end;
if (ASelfValue <> nil) and (StringDecRefSymbol <> nil) and (i = 0) then begin
if not CallContext.AddStringResult then begin
DebugLn('Internal error for string result');
AnError := CallContext.LastError;
exit;
end;
end;
end;
if not CallContext.FinalizeParams then begin
DebugLn('Internal error after params');
AnError := CallContext.LastError;
exit;
end;
FDebugger.FDbgController.ProcessLoop;
@ -923,18 +985,52 @@ begin
exit;
end;
AResult := CallContext.CreateParamSymbol(-1, FunctionSymbolType, FunctionSymbolData.Name);
if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString]) then begin
if not CallContext.GetStringResultAsPointer(StringAddr) then begin
AnError := CallContext.LastError;
end
else
if (FunctionResultSymbolType.Kind = skWideString) then begin
if not CallContext.GetWideStringResult(AResult, FunctionSymbolType.TypeInfo) then begin
AnError := CallContext.LastError;
end;
end
else begin
if not CallContext.GetStringResult(AResult, FunctionSymbolType.TypeInfo) then begin
AnError := CallContext.LastError;
end;
end;
end
else begin
AResult := CallContext.CreateParamSymbol(-1, FunctionSymbolType, FunctionSymbolData.Name);
end;
Result := AResult <> nil;
finally
FDebugger.FDbgController.AbortCurrentCommand;
CallContext.ReleaseReference;
end;
if (FunctionResultSymbolType.Kind in [skString, skAnsiString, skWideString]) and (StringAddr <> 0) then begin
CallContext := FDebugger.FDbgController.Call(StringDecRefSymbol.Address, FExpressionScope.LocationContext,
FDebugger.FMemReader, FDebugger.FMemConverter);
try
CallContext.AddOrdinalViaRefAsParam(StringAddr);
FDebugger.FDbgController.ProcessLoop;
finally
FDebugger.FDbgController.AbortCurrentCommand;
CallContext.ReleaseReference;
end;
end;
finally
FDebugger.FDbgController.CurrentThread.RestoreStackMem;
for i := 0 to High(ParameterSymbolArr) do
if ParameterSymbolArr[i] <> nil then
ParameterSymbolArr[i].ReleaseReference;
ReleaseRefAndNil(StringDecRefSymbol);
end;
end;
function TFpThreadWorkerEvaluate.EvaluateExpression(const AnExpression: String;

236
components/lazdebuggers/lazdebuggerfp/test/testapps/WatchesFuncStringPrg.pas Normal file
View File

@ -0,0 +1,236 @@
program WatchesFuncStringPrg;
{$mode objfpc}{$H+}
uses SysUtils;
var
CurMemUsed: ptruint;
SomeInt: Integer;
s1, s2, s3, s4, x: String;
function UsedMem: ptruint;
var
mm: TMemoryManager;
hs: TFPCHeapStatus;
i: integer;
begin
// ensure global vars are in mem
i := SomeInt + Length(s1) + Length(s2) + Length(s3) + Length(s4);
x := IntToStr(i);
GetMemoryManager(mm);
hs := mm.GetFPCHeapStatus();
Result := hs.CurrHeapUsed;
end;
var
Cnt: Integer;
function TestStrRes: String;
begin
Result := '#'+IntToStr(Cnt);
inc(Cnt);
end;
function TestIntToStrRes(AVal: Integer): String;
begin
Result := '$'+IntToHex(AVal, 8);
end;
function TestIntSumToStrRes(AVal, AVal2: Integer): String;
begin
Result := '$'+IntToHex(AVal+AVal2, 8);
end;
function TestStrToIntRes(AVal: String): Integer;
begin
if Length(AVal) = 1 then
AVal := AVal + 'abc'
else
if AVal <> '' then
AVal[1] := 'X';
Result := Length(AVal);
end;
function TestStrToStrRes(AVal: String): String;
begin
if Length(AVal) = 1 then
AVal := AVal + 'abc'
else
if AVal <> '' then
AVal[1] := 'X';
Result := '"' + IntToStr(Length(AVal)) + '"';
end;
function conc(AVal, BVal: String): String;
begin
Result := AVal + BVal;
end;
begin
// Call all functions, so they are used in the exe
TestStrRes;
TestIntToStrRes(1);
TestIntSumToStrRes(1,2);
TestStrToIntRes('a');
TestStrToStrRes('a');
conc('a', 'b');
Cnt := 0;
SomeInt := 126;
s1 := '';
s2 := 'A';
s3 := 'abc';
s4 := 'def';
// After each test the debugger can check the memusage
CurMemUsed := UsedMem;
CurMemUsed := UsedMem; // TEST_BREAKPOINT=main
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
CurMemUsed := UsedMem;
// access variables again
TestIntToStrRes(SomeInt);
TestStrToIntRes(s1);
TestStrToIntRes(s2);
TestStrToIntRes(s3);
TestStrToIntRes(s4);
end.

183
components/lazdebuggers/lazdebuggerfp/test/testwatches.pas
View File

@ -25,6 +25,7 @@ type
procedure TestWatchesScope;
procedure TestWatchesValue;
procedure TestWatchesFunctions;
procedure TestWatchesFunctionsWithString;
procedure TestWatchesAddressOf;
procedure TestWatchesTypeCast;
procedure TestWatchesExpression;
@ -36,7 +37,7 @@ implementation
var
ControlTestWatch, ControlTestWatchScope, ControlTestWatchValue, ControlTestWatchFunct,
ControlTestWatchAddressOf, ControlTestWatchTypeCast, ControlTestModify,
ControlTestWatchFunctStr, ControlTestWatchAddressOf, ControlTestWatchTypeCast, ControlTestModify,
ControlTestExpression, ControlTestErrors: Pointer;
procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint;
@ -1499,6 +1500,13 @@ begin
t.Add('MyClass1.SomeFuncIntResAdd(3)', weInteger(80)).AddEvalFlag([defAllowFunctionCall]);
t.Add('MyClass1.SomeFuncIntRes()', weInteger(80+999)).AddEvalFlag([defAllowFunctionCall]);
// Error wrong param count
t.Add('SomeFuncIntRes(1)', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).ExpectError;
t.Add('SomeFuncIntRes(1,2)', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).ExpectError;
t.Add('FuncIntAdd()', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).ExpectError;
t.Add('FuncIntAdd(1)', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).ExpectError;
t.Add('FuncIntAdd(1,2,3)', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).ExpectError;
t.EvaluateWatches;
t.CheckResults;
@ -1513,6 +1521,178 @@ begin
end;
end;
procedure TTestWatches.TestWatchesFunctionsWithString;
var
MemUsed, PrevMemUsed: Int64;
t2: TWatchExpectationList;
procedure UpdateMemUsed;
var
Thread: Integer;
WtchVal: TWatchValue;
begin
PrevMemUsed := MemUsed;
MemUsed := -1;
t2.Clear;
t2.AddWithoutExpect('', 'CurMemUsed');
t2.EvaluateWatches;
Thread := Debugger.Threads.Threads.CurrentThreadId;
WtchVal := t2.Tests[0]^.TstWatch.Values[Thread, 0];
if (WtchVal <> nil) and (WtchVal.ResultData <> nil) then
MemUsed := WtchVal.ResultData.AsInt64;
TestTrue('MemUsed <> 0', MemUsed > 0);
end;
procedure CheckMemUsed;
begin
Debugger.RunToNextPause(dcStepOver);
UpdateMemUsed;
TestEquals('MemUsed not changed', PrevMemUsed, MemUsed);
end;
var
ExeName, tbn: String;
t: TWatchExpectationList;
Src: TCommonSource;
BrkPrg: TDBGBreakPoint;
i: Integer;
begin
if SkipTest then exit;
if not TestControlCanTest(ControlTestWatchFunctStr) then exit;
if not (Compiler.SymbolType in [stDwarf3, stDwarf4]) then exit;
if Compiler.HasFlag('SkipStringFunc') then exit;
tbn := TestBaseName;
try
for i := 0 to 2 do begin
TestBaseName := tbn;
TestBaseName := TestBaseName + ' -O'+IntToStr(i);
Src := GetCommonSourceFor(AppDir + 'WatchesFuncStringPrg.pas');
case i of
0: TestCompile(Src, ExeName, '_O0', '-O-');
1: TestCompile(Src, ExeName, '_O1', '-O-1');
2: TestCompile(Src, ExeName, '_O2', '-O-2');
end;
t := nil;
t2 := nil;
AssertTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
try
t := TWatchExpectationList.Create(Self);
t2 := TWatchExpectationList.Create(Self);
t.AcceptSkSimple := [skInteger, skCardinal, skBoolean, skChar, skFloat,
skString, skAnsiString, skCurrency, skVariant, skWideString,
skInterface, skEnumValue];
t.AddTypeNameAlias('integer', 'integer|longint');
BrkPrg := Debugger.SetBreakPoint(Src, 'main');
AssertDebuggerNotInErrorState;
(* ************ Nested Functions ************* *)
RunToPause(BrkPrg);
UpdateMemUsed;
t.Clear;
t.Add('TestStrRes()', weAnsiStr('#0')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrRes()', weAnsiStr('#1')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestIntToStrRes(33)', weAnsiStr('$00000021')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestIntToStrRes(SomeInt)', weAnsiStr('$0000007E')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestIntSumToStrRes(10,20)', weAnsiStr('$0000001E')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestIntSumToStrRes(SomeInt,3)', weAnsiStr('$00000081')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToIntRes(s1)', weInteger(0)).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s1', weAnsiStr('')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToIntRes(s2)', weInteger(4)).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s2', weAnsiStr('A')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToIntRes(s3)', weInteger(3)).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s3', weAnsiStr('abc')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToStrRes(s1)', weAnsiStr('"0"')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s1', weAnsiStr('')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToStrRes(s2)', weAnsiStr('"4"')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s2', weAnsiStr('A')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('TestStrToStrRes(s3)', weAnsiStr('"3"')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.Add('s3', weAnsiStr('abc')).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('conc(s1, s2)', weAnsiStr('A')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
t.Clear;
t.Add('conc(s3, s4)', weAnsiStr('abcdef')).AddEvalFlag([defAllowFunctionCall]).IgnTypeName.SkipEval;
t.EvalAndCheck;
CheckMemUsed;
finally
Debugger.RunToNextPause(dcStop);
FreeAndNil(t);
FreeAndNil(t2);
Debugger.ClearDebuggerMonitors;
Debugger.FreeDebugger;
end;
end;
finally
AssertTestErrors;
end;
end;
procedure TTestWatches.TestWatchesAddressOf;
type
@ -3061,6 +3241,7 @@ initialization
ControlTestWatchScope := TestControlRegisterTest('Scope', ControlTestWatch);
ControlTestWatchValue := TestControlRegisterTest('Value', ControlTestWatch);
ControlTestWatchFunct := TestControlRegisterTest('Function', ControlTestWatch);
ControlTestWatchFunctStr := TestControlRegisterTest('FunctionString', ControlTestWatch);
ControlTestWatchAddressOf := TestControlRegisterTest('AddressOf', ControlTestWatch);
ControlTestWatchTypeCast := TestControlRegisterTest('TypeCast', ControlTestWatch);
ControlTestModify := TestControlRegisterTest('Modify', ControlTestWatch);

25
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -141,6 +141,7 @@ type
TstTestName: String;
TstWatch: TTestWatch;
SkipEvalCall: Boolean;
EvalCallTestFlags: TWatcheEvaluateFlags;
EvalCallResReceived: Boolean;
EvalCallResSuccess: Boolean;
@ -175,6 +176,7 @@ type
function Skip(ASymTypes: TSymbolTypes = []): PWatchExpectation;
function SkipIf(ACond: Boolean; ASymTypes: TSymbolTypes = []): PWatchExpectation;
function SkipEval: PWatchExpectation;
function IgnAll(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
function IgnData(ASymTypes: TSymbolTypes = []; ACond: Boolean = True): PWatchExpectation;
@ -297,6 +299,7 @@ type
function Count: Integer;
procedure EvaluateWatches;
procedure CheckResults;
procedure EvalAndCheck;
procedure AddTypeNameAlias(ATypeName, AnAliases: String);
property AcceptSkSimple: TDbgSymbolKinds read FAcceptSkSimple write FAcceptSkSimple ; // skSimple for skInteger,skChar,...
@ -1005,6 +1008,12 @@ begin
Result := Self;
end;
function TWatchExpectationHelper.SkipEval: PWatchExpectation;
begin
Self^.SkipEvalCall := True;
Result := Self;
end;
function TWatchExpectationHelper.IgnAll(ASymTypes: TSymbolTypes; ACond: Boolean
): PWatchExpectation;
begin
@ -1235,6 +1244,9 @@ var
i: Integer;
begin
Result := true;
if AWatchExp^.SkipEvalCall then
exit;
if AWatchExp^.EvalCallTestFlags <> [] then begin
with CurLoc do
FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
@ -1335,8 +1347,9 @@ begin
with AnWatchExp do begin
try
with Debugger.CurLocation do
FTest.TestBaseName := FTest.TestBaseName + ' ' + TstTestName + ' WATCH: '+TstWatch.Expression+' AT '+ SrcFile + ':' + IntToStr(SrcLine) +')';
if Debugger.LazDebugger.State in [dsPause, dsInternalPause] then
with Debugger.CurLocation do
FTest.TestBaseName := FTest.TestBaseName + ' ' + TstTestName + ' WATCH: '+TstWatch.Expression+' AT '+ SrcFile + ':' + IntToStr(SrcLine) +')';
if TstStackFrame > 0 then
FTest.TestBaseName := FTest.TestBaseName + ' (Stack: ' + IntToStr(TstStackFrame) + ')';
if not VerifyDebuggerState then
@ -1386,7 +1399,7 @@ begin
Context.HasTypeInfo := True;
end;
if EvalCallTestFlags <> [] then begin
if (EvalCallTestFlags <> []) and not SkipEvalCall then begin
TestTrue('Got eval res', EvalCallResReceived, Context, AnIgnoreRsn);
TestTrue('Got eval success', EvalCallResSuccess, Context, AnIgnoreRsn);
// if (Context.WatchRes.ValueKind in [rdkUnknown, rdkPrePrinted, rdkError]) then
@ -2365,5 +2378,11 @@ begin
CheckResult(FList[i]);
end;
procedure TWatchExpectationList.EvalAndCheck;
begin
EvaluateWatches;
CheckResults;
end;
end.