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

components/fpdebug/fpdbgavrclasses.pas

@@ -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;

components/fpdebug/fpdbgcallcontextinfo.pas

@@ -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(
+function TFpDbgInfoCallContext.AllocStack(ASize: Integer): TDbgPtr;
-  const ABaseContext: TFpDbgLocationContext; AMemReader: TFpDbgMemReaderBase;
-  AMemConverter: TFpDbgMemConvertor; ADbgProcess: TDbgProcess);
 begin
-  inherited Create(ABaseContext, AMemReader, AMemConverter);
+  Result := FDbgThread.GetStackPointerRegisterValue;
-  FDbgProcess := ADbgProcess;
+  if FOrigStackPtr = 0 then
+    FOrigStackPtr := Result;
+  dec(Result, ASize);
+  FDbgThread.SetStackPointerRegisterValue(Result);
 end;
 
-function TFpDbgInfoCallContext.CreateParamSymbol(AParamIndex: Integer;
+function TFpDbgInfoCallContext.InternalCreateParamSymbol(
-  ASymbolType: TFpSymbol; AName: String): TFpValue;
+  ParameterMemLocation: TFpDbgMemLocation; ASymbolType: TFpSymbol; AName: String
+  ): TFpValue;
 var
-  ParameterMemLocation: TFpDbgMemLocation;
   ParamSymbol: TFpSymbol;// TFpSymbolDwarfFunctionResult;
 begin
-  ParameterMemLocation := FDbgProcess.CallParamDefaultLocation(AParamIndex);
+  Result := nil;
-  if AName = '' then
+  if not IsValidLoc(ParameterMemLocation) then begin
-    AName := ASymbolType.Name;
+    FLastError := CreateError(fpErrAnyError, ['Too many params']);
-  ParamSymbol := TFpSymbolDwarfFunctionResult.Create(AName, ParameterMemLocation, ASymbolType.TypeInfo);
+    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;
+function TFpDbgInfoCallContext.InternalCreateParamSymbol(AParamIndex: Integer;
-  AParamSymbolType: TFpSymbol; AValue: TFpValue): Boolean;
+  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.

components/fpdebug/fpdbgclasses.pp

@@ -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

components/fpdebug/fpdbgcontroller.pas

@@ -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;

components/fpdebug/fpdbgdarwinclasses.pas

@@ -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

components/fpdebug/fpdbgdwarf.pas

@@ -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;
 

components/fpdebug/fpdbgdwarfdataclasses.pas

@@ -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

components/fpdebug/fpdbgdwarffreepascal.pas

@@ -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

components/fpdebug/fpdbginfo.pas

@@ -1607,11 +1607,12 @@ end;
 
 function TFpSymbolForwarder.GetForwardToSymbol: TFpSymbol;
 begin
+  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;
 

components/fpdebug/fpdbglinuxclasses.pas

@@ -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;

components/fpdebug/fpdbgwinclasses.pas

@@ -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
-  if ID = MDebugEvent.dwThreadId then begin
   inherited;
+  if ID = MDebugEvent.dwThreadId then begin
 
     {$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}

components/fpdebug/fpdmemorytools.pas

@@ -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

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas

@@ -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,6 +827,36 @@ begin
     exit;
   end;
 
+  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;
@@ -843,7 +877,6 @@ begin
       for i := 0 to High(ParameterSymbolArr) do
         ParameterSymbolArr[i] := nil;
     FoundIdx := 0;
-  try
     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
+        if (ASelfValue <> nil) and (i = 0) then begin
-          ExprParamVal := ASelfValue
+          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;
 
+      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;

components/lazdebuggers/lazdebuggerfp/test/testapps/WatchesFuncStringPrg.pas

@@ -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.

components/lazdebuggers/lazdebuggerfp/test/testwatches.pas

@@ -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);

components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas

@@ -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,6 +1347,7 @@ begin
 
   with AnWatchExp do begin
     try
+      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
@@ -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.