FpDebug: add intrinsics "Pos(SubStr, SearchStr)" and "SubStr(Str, Start, Len, DoPtr)

components/fpdebug/fpdmemorytools.pas

@@ -441,7 +441,7 @@ type
     function SetLength(var ADest: AnsiString; ALength: Int64): Boolean; overload;
     function SetLength(var ADest: WideString; ALength: Int64): Boolean; overload;
     function CheckDataSize(ASize: Int64): Boolean;
-    function ReadPChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: AnsiString): Boolean;
+    function ReadPChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: AnsiString; NoTrimToZero: Boolean = False): Boolean;
     function ReadPWChar(const ALocation: TFpDbgMemLocation; AMaxChars: Int64; out AValue: WideString): Boolean;
 
     property TargetMemConvertor: TFpDbgMemConvertor read FTargetMemConvertor;
@@ -1922,7 +1922,7 @@ begin
 end;
 
 function TFpDbgMemManager.ReadPChar(const ALocation: TFpDbgMemLocation;
-  AMaxChars: Int64; out AValue: AnsiString): Boolean;
+  AMaxChars: Int64; out AValue: AnsiString; NoTrimToZero: Boolean): Boolean;
 var
   i: QWord;
 begin
@@ -1945,9 +1945,11 @@ begin
     Result := True;
     i := PartialReadResultLenght;
     SetLength(AValue, i);
-    i := pos(#0, AValue);
+    if not NoTrimToZero then begin
-    if i > 0 then
+      i := pos(#0, AValue);
-      SetLength(AValue, i-1);
+      if i > 0 then
+        SetLength(AValue, i-1);
+    end;
     exit;
   end
 end;

components/fpdebug/fppascalparser.pas

@@ -50,7 +50,7 @@ type
   TSeparatorType = (ppstComma);
 
   TFpIntrinsicPrefix = (ipColon, ipExclamation, ipNoPrefix);
-  TFpIntrinsicFunc = (ifErrorNotFound, ifLength, ifChildClass, ifRefCount);
+  TFpIntrinsicFunc = (ifErrorNotFound, ifLength, ifChildClass, ifRefCount, ifPos, ifSubStr);
 
   TFpPascalParserCallFunctionProc = function (AnExpressionPart: TFpPascalExpressionPart;
     AFunctionValue: TFpValue; ASelfValue: TFpValue; AParams: TFpPascalExpressionPartList;
@@ -218,11 +218,16 @@ type
     FIntrinsic: TFpIntrinsicFunc;
     FChildClassCastType: TFpValue;
 
-    function CheckArgumentCount(AParams: TFpPascalExpressionPartBracketArgumentList; ARequiredCount: Integer): Boolean;
+    function CheckArgumentCount(AParams: TFpPascalExpressionPartBracketArgumentList; ARequiredCount: Integer; AMaxAccepted: Integer = -1): Boolean;
+    // GetArg; ANum is 1 based
+    function GetArg(AParams: TFpPascalExpressionPartBracketArgumentList; ANum: Integer; out AValue: TFpValue;
+                    AnErr: String = ''): Boolean;
   protected
     function DoLength(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
     function DoChildClass(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
     function DoRefCnt(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
+    function DoPos(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
+    function DoSubStr(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
 
     function DoGetResultValue: TFpValue; override;
     function DoGetResultValue(AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
@@ -1790,12 +1795,16 @@ end;
 { TFpPascalExpressionPartIntrinsic }
 
 function TFpPascalExpressionPartIntrinsic.CheckArgumentCount(
-  AParams: TFpPascalExpressionPartBracketArgumentList; ARequiredCount: Integer
+  AParams: TFpPascalExpressionPartBracketArgumentList; ARequiredCount: Integer;
-  ): Boolean;
+  AMaxAccepted: Integer): Boolean;
 var
   i: Integer;
 begin
-  Result := AParams.Count - 1 = ARequiredCount;
+  if AMaxAccepted < 0 then
+    Result := AParams.Count - 1 = ARequiredCount
+  else
+    Result := (AParams.Count - 1 >= ARequiredCount) and
+              (AParams.Count - 1 <= AMaxAccepted);
   if not Result then begin
     SetError('wrong argument count');
     exit;
@@ -1809,6 +1818,26 @@ begin
     end;
 end;
 
+function TFpPascalExpressionPartIntrinsic.GetArg(
+  AParams: TFpPascalExpressionPartBracketArgumentList; ANum: Integer; out
+  AValue: TFpValue; AnErr: String): Boolean;
+begin
+  AValue := nil;
+  Result := ANum < AParams.Count;
+  if not Result then begin
+    if AnErr <> '' then
+      SetError(AnErr);
+    exit;
+  end;
+
+  AValue := AParams.Items[ANum].ResultValue;
+  Result := (AValue <> nil) and (not IsError(Expression.Error)) and (not IsError(AValue.LastError));
+  if not Result then begin
+    if AnErr <> '' then
+      SetError(AnErr);
+  end;
+end;
+
 function TFpPascalExpressionPartIntrinsic.DoLength(
   AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
 var
@@ -1819,11 +1848,8 @@ begin
   if not CheckArgumentCount(AParams, 1) then
     exit;
 
-  Arg := AParams.Items[1].ResultValue;
+  if not GetArg(AParams, 1, Arg, 'argument required') then
-  if (Arg = nil) then begin
-    SetError('argument not supported');
     exit;
-  end;
 
   ResLen := 0;
   case Arg.Kind of
@@ -1846,18 +1872,17 @@ function TFpPascalExpressionPartIntrinsic.DoChildClass(
   AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
 var
   CastName: String;
-  NewResult: TFpValue;
+  NewResult, Arg: TFpValue;
 begin
   Result := nil;
   if not CheckArgumentCount(AParams, 1) then
     exit;
 
-  Result := AParams.Items[1].ResultValue;
+  if not GetArg(AParams, 1, Arg, 'argument required') then
-  if Result = nil then
     exit;
+  Result := Arg;
   Result.AddReference;
-  if IsError(Expression.Error) or IsError(Result.LastError) or
+  if (Result.Kind <> skClass) or (Result.AsCardinal = 0)
-     (Result.Kind <> skClass) or (Result.AsCardinal = 0)
   then
     exit;
 
@@ -1892,16 +1917,150 @@ begin
   if not CheckArgumentCount(AParams, 1) then
     exit;
 
-  Tmp := AParams.Items[1].ResultValue;
+  if not GetArg(AParams, 1, Tmp, 'argument required') then
-  if (Tmp = nil) or IsError(Expression.Error) or IsError(Tmp.LastError) then
     exit;
 
-  if not Tmp.GetFpcRefCount(rcnt) then
+  if not Tmp.GetFpcRefCount(rcnt) then begin
+    SetError('argument not supported');
     exit;
+  end;
 
   Result := TFpValueConstNumber.Create(QWord(rcnt), True)
 end;
 
+function TFpPascalExpressionPartIntrinsic.DoPos(
+  AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
+var
+  Tmp, Tmp2, CmpCase: TFpValue;
+  s1, s2: String;
+begin
+  Result := nil;
+  if not CheckArgumentCount(AParams, 2, 3) then
+    exit;
+
+  if not GetArg(AParams, 1, Tmp, 'argument required')  then exit;
+  if not GetArg(AParams, 2, Tmp2, 'argument required') then exit;
+
+  CmpCase := nil;
+  if AParams.Count = 4 then begin
+    if not GetArg(AParams, 3, Tmp, 'argument required') then
+      exit;
+    if (CmpCase.Kind <> skBoolean) then begin
+      SetError('bool argument expected');
+      exit;
+    end;
+  end;
+
+  s1 := Tmp.AsString;
+  s2 := Tmp2.AsString;
+
+  if (CmpCase <> nil) and (CmpCase.AsBool) then begin
+    s1 := LowerCase(s1);
+    s2 := LowerCase(s2);
+  end;
+
+  if (s1 = '') or (s2 = '') then
+    Result := TFpValueConstNumber.Create(0, True)
+  else
+    Result := TFpValueConstNumber.Create(pos(s1, s2), True);
+end;
+
+function TFpPascalExpressionPartIntrinsic.DoSubStr(
+  AParams: TFpPascalExpressionPartBracketArgumentList): TFpValue;
+var
+  Tmp, Tmp2, Tmp3, Tmp4: TFpValue;
+  s1, s2: String;
+  p1, p2: Int64;
+  UsePtr: Boolean;
+  Addr: QWord;
+begin
+  Result := nil;
+  if not CheckArgumentCount(AParams, 3,4) then
+    exit;
+
+  if not GetArg(AParams, 1, Tmp, 'argument required')  then exit;
+  if not GetArg(AParams, 2, Tmp2, 'argument required') then exit;
+  if not GetArg(AParams, 3, Tmp3, 'argument required') then exit;
+
+  UsePtr := False;
+  if AParams.Count = 5 then begin
+    if not GetArg(AParams, 4, Tmp4, 'argument required') then
+      exit;
+    if (Tmp4.Kind <> skBoolean) then begin
+      SetError('bool argument expected');
+      exit;
+    end;
+    UsePtr := Tmp4.AsBool;
+  end;
+
+  s1 := Tmp.AsString;
+  if (s1 = '') and (Tmp.Kind in [skPointer, skAddress]) then begin
+    if (AParams.Count = 5) and not UsePtr then begin
+      SetError('expected true for argument 4');
+      exit;
+    end;
+    UsePtr := True;
+  end;
+
+  if svfInteger in Tmp2.FieldFlags then
+    p1 := Tmp2.AsInteger
+  else
+  if svfCardinal in Tmp2.FieldFlags then
+    {$PUSH}{$R-}{$Q-}
+    p1 := Int64(Tmp2.AsCardinal)
+    {$POP}
+  else begin
+    SetError('int argument expected');
+    exit;
+  end;
+  if (p1 < 1) and (not UsePtr) then begin
+    SetError('argument >= 1 expected');
+    exit;
+  end;
+
+  if svfInteger in Tmp3.FieldFlags then
+    p2 := Tmp3.AsInteger
+  else
+  if svfCardinal in Tmp3.FieldFlags then
+    {$PUSH}{$R-}{$Q-}
+    p2 := Int64(Tmp3.AsCardinal)
+    {$POP}
+  else begin
+    SetError('int argument expected');
+    exit;
+  end;
+  if (p2 < 1) and (not UsePtr) then begin
+    SetError('argument >= 1 expected');
+    exit;
+  end;
+
+  if UsePtr then begin
+    if not (Tmp.Kind in [skPointer, skString, skAnsiString, skWideString, skAddress]) then begin
+      SetError('argument 1 not supported');
+    end;
+    Addr := Tmp.AsCardinal;
+    if Addr = 0 then begin
+      Result := TFpValueConstString.Create('');
+      exit;
+    end;
+
+    {$PUSH}{$R-}{$Q-}
+    Expression.Context.MemManager.ReadPChar(TargetLoc(Addr+QWord(p1)), p2, s1, True);
+    {$POP}
+    Result := TFpValueConstString.Create(s1);
+    exit;
+  end;
+
+  if (s1 = '') then begin
+    Result := TFpValueConstString.Create('');
+    exit;
+  end;
+
+  {$PUSH}{$R-}{$Q-}
+  Result := TFpValueConstString.Create(copy(s1, p1, p2));
+  {$POP}
+end;
+
 function TFpPascalExpressionPartIntrinsic.DoGetResultValue: TFpValue;
 begin
   Result := nil;
@@ -1922,6 +2081,8 @@ begin
     ifLength:     Result := DoLength(AParams);
     ifChildClass: Result := DoChildClass(AParams);
     ifRefCount:   Result := DoRefCnt(AParams);
+    ifPos:        Result := DoPos(AParams);
+    ifSubStr:     Result := DoSubStr(AParams);
   end;
   {$IFDEF WITH_REFCOUNT_DEBUG}
   if Result <> nil then
@@ -2452,9 +2613,11 @@ begin
   Result := ifErrorNotFound;
   case ALen of
     2: if strlicomp(AStart, 'CC', 2) = 0     then Result := ifChildClass;
+    3: if strlicomp(AStart, 'POS', 3) = 0     then Result := ifPos;
     6: case AStart^ of
         'l', 'L': if strlicomp(AStart, 'LENGTH', 6) = 0 then Result := ifLength;
         'r', 'R': if strlicomp(AStart, 'REFCNT', 6) = 0 then Result := ifRefCount;
+        's', 'S': if strlicomp(AStart, 'SUBSTR', 6) = 0 then Result := ifSubStr;
       end;
   end;
 end;

components/lazdebuggers/lazdebuggerfp/test/testwatches.pas

@@ -1582,6 +1582,27 @@ begin
     t.Add('refcnt', PREFIX+'refcnt(ARef3)',     weInteger( 2, #1, 0)).IgnTypeName();
     t.Add('refcnt', PREFIX+'refcnt(ARef4)',     weInteger( 2, #1, 0)).IgnTypeName();
 
+    t.Add('pos', PREFIX+'pos(''c'', SRef1)',     weInteger( 3, #1, 0)).IgnTypeName();
+    t.Add('pos', PREFIX+'pos(''d'', PCRef1)',     weInteger( 4, #1, 0)).IgnTypeName();
+    t.Add('pos', PREFIX+'pos(''e'', Short0)',     weInteger( 5, #1, 0)).IgnTypeName();
+    t.Add('pos', PREFIX+'pos(''e'', ''1e'')',     weInteger( 2, #1, 0)).IgnTypeName();
+
+    t.Add('substr', PREFIX+'substr(SRef1, 2,3)',   weAnsiStr('bcd', #1)).IgnTypeName();
+    t.Add('substr', PREFIX+'substr(Short0, 4,3)',   weAnsiStr('def', #1)).IgnTypeName();
+    t.Add('substr', PREFIX+'substr(SRef1, 2,3, false)',   weAnsiStr('bcd', #1)).IgnTypeName();
+    t.Add('substr', PREFIX+'substr(Short0, 4,3, false)',   weAnsiStr('def', #1)).IgnTypeName();
+    //  0 based
+    t.Add('substr', PREFIX+'substr(SRef1, 2,3, true)',   weAnsiStr('cde', #1)).IgnTypeName();
+    t.Add('substr', PREFIX+'substr(Short0, 4,3, true)',   weAnsiStr('ef1', #1)).IgnTypeName();
+    // cut off
+    t.Add('substr', PREFIX+'substr(SRef1, 10, 30)',   weAnsiStr('456', #1)).IgnTypeName();
+
+    t.Add('substr', PREFIX+'substr(SHORT1[1], -4, 2, true)',   weAnsiStr('23', #1)).IgnTypeName();
+
+    t.Add('substr', PREFIX+'PtrRef1, 2, 4, true)',   weAnsiStr('cdef', #1)).IgnTypeName();
+    t.Add('substr', PREFIX+'PCRef1, 2, 4, true)',   weAnsiStr('cdef', #1)).IgnTypeName();
+
+
     AddWatches(t, 'glob var',   'gv', 001, 'B');
     AddWatches(t, 'glob MyClass1',     'MyClass1.mc',  002, 'C');
     t.EvaluateWatches;

components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas

@@ -84,6 +84,10 @@ var
   v_array: array [3..4] of variant;
 
   SRef0, SRef1, SRef2, SRef3, SRef4: String;
+  PCRef1: PChar;
+  PtrRef1: Pointer;
+  Short0: Shortstring;
+  Short1: array [0..2] of ShortString[10];
   ARef0, ARef1, ARef2, ARef3, ARef4: array of byte;
 
 type
@@ -1072,11 +1076,19 @@ begin
   RecursePtrC18 := @RecursePtrC1;
 
   SRef0 := '';
-  SRef1 := 'abc';
+  SRef1 := 'abcdef123456';
   SRef1 := inttostr(random(9))+SRef1;
   SRef2 := inttostr(random(9))+SRef1;
   SRef3 := SRef2;
 
+  PCRef1 := @SRef1[1];
+  PtrRef1 := PCRef1;
+
+  Short0 := 'abcdef1234';
+  Short1[0] := 'abcdef1234';
+  Short1[1] := 'ABCDEF7890';
+  Short1[2] := 'mnopqrstuv';
+
   ARef0 := nil;
   SetLength(ARef1, 10);
   SetLength(ARef2, 10);