paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 13:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: evaluate "pointer - pointer" return int (with pointermath)

Browse Source 
git-svn-id: trunk@65150 -
This commit is contained in:
martin 2021-05-29 22:51:06 +00:00
parent 320fe8c8a8
commit 4d4db524ac
3 changed files with 58 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
components/fpdebug/fppascalparser.pas
View File

@ -1060,6 +1060,10 @@ procedure TPasParserSymbolPointer.TypeInfoNeeded;
var
t: TPasParserSymbolPointer;
begin
if FPointerLevels = 0 then begin
SetTypeInfo(FPointedTo);
exit;
end;
assert(FPointerLevels > 1, 'TPasParserSymbolPointer.TypeInfoNeeded: FPointerLevels > 1');
t := TPasParserSymbolPointer.Create(FPointedTo, FContext, FPointerLevels-1);
SetTypeInfo(t);
@ -2738,12 +2742,50 @@ function TFpPascalExpressionPartOperatorPlusMinus.DoGetResultValue: TFpValue;
{$PUSH}{$R-}{$Q-}
function AddSubValueToPointer(APointerVal, AOtherVal: TFpValue; ADoSubtract: Boolean = False): TFpValue;
var
Idx: Int64;
Idx, m: Int64;
TmpVal: TFpValue;
s1, s2: TFpDbgValueSize;
begin
Result := nil;
case AOtherVal.Kind of
// skPointer: Result := nil;
skPointer: if ADoSubtract then begin
if ( (APointerVal.TypeInfo = nil) or (APointerVal.TypeInfo.TypeInfo = nil) ) and
( (AOtherVal.TypeInfo = nil) or (AOtherVal.TypeInfo.TypeInfo = nil) )
then begin
Idx := APointerVal.AsCardinal - AOtherVal.AsCardinal;
Result := TFpValueConstNumber.Create(Idx, True);
exit;
end
else
if (APointerVal.TypeInfo <> nil) and (APointerVal.TypeInfo.TypeInfo <> nil) and
(AOtherVal.TypeInfo <> nil) and (AOtherVal.TypeInfo.TypeInfo <> nil) and
(APointerVal.TypeInfo.TypeInfo.Kind = AOtherVal.TypeInfo.TypeInfo.Kind) and
(APointerVal.TypeInfo.TypeInfo.ReadSize(nil, s1)) and
(AOtherVal.TypeInfo.TypeInfo.ReadSize(nil, s2)) and
(s1 = s2)
then begin
if s1 <> (APointerVal.Member[1].DataAddress.Address - APointerVal.DataAddress.Address) then begin
debugln('Size mismatch for pointer math');
exit;
end;
Idx := APointerVal.AsCardinal - AOtherVal.AsCardinal;
if SizeToFullBytes(s1) > 0 then begin
m := Idx mod SizeToFullBytes(s1);
Idx := Idx div SizeToFullBytes(s1);
if m <> 0 then begin
debugln('Size mismatch for pointer math');
exit;
end;
end;
Result := TFpValueConstNumber.Create(Idx, True);
exit;
end
else
exit;
end
else
exit;
skInteger: Idx := AOtherVal.AsInteger;
skCardinal: begin
Idx := AOtherVal.AsInteger;

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

@ -2325,6 +2325,18 @@ begin
t.Add('Pointer-Op: ', 'LongInt(Pointer(10)+4)', weInteger(14));
t.Add('Pointer-Op: ', 'Pointer(10)-Pointer(4)', weInteger(6));
t.Add('Pointer-Op: ', 'PWord(10)-PWord(4)', weInteger(3));
t.Add('Pointer-Op: ', '^Word(10)-^Word(4)', weInteger(3));
t.Add('Pointer-Op: ', '^Word(10)-Pointer(4)', weInteger(3)).ExpectError();
t.Add('Pointer-Op: ', 'gcPtr2 - gcPtr1', weInteger(1000));
t.Add('Pointer-Op: ', 'gcPtr2 - gvPtr1', weInteger(1000));
t.Add('Pointer-Op: ', 'gvPtr2 - gcPtr2', weInteger(1));
t.Add('Pointer-Op: ', 'gvPtr2 - gvPtr1', weInteger(1001));
t.Add('Pointer-Op: ', '@gv_sa_Word[2] - @gv_sa_Word[1]', weInteger(1));
t.Add('Pointer-Op: ', 'pointer(@gv_sa_Word[2]) - pointer(@gv_sa_Word[1])', weInteger(2));
AddWatches(t, 'glob', 'gv', 001, 'B', '', tlAny, 'gv', 001, 'B', '', tlAny);
AddWatches(t, 'glob', 'gc', 000, 'A', '', tlConst, 'gv', 001, 'B', '', tlAny);
AddWatches(t, 'glob', 'gv', 001, 'B', '', tlAny, 'gc', 000, 'A', '', tlConst);

2
components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas
View File

@ -53,6 +53,7 @@ var
BreakDummy: PtrUInt;
PByteDummy: PByte;
p: Pointer;
pw: PWord; // ensure we have the type
InterfacedObject, InterfacedObject2: TInterfacedObject;
type
@ -482,6 +483,7 @@ begin
BreakDummy := ord(gcWCharStatArray[1]);
p := nil;
PByteDummy := nil;
pw := nil;
SomeFunc1(1,1,1,1);
SomeProc1();
{$if FPC_FULLVERSION >= 30000}