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

FpDebug: implement typecast TFooRecord(ordinal) for matching data-sizes.

Browse Source
This commit is contained in:
Martin 2023-06-06 14:06:20 +02:00
parent 47e0610ac8
commit 63a4789e76
5 changed files with 127 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpdebug/fpdbgdwarf.pas
View File

@ -2017,7 +2017,7 @@ begin
exit;
fields := FTypeCastSourceValue.FieldFlags;
if svfOrdinal in fields then
AnAddress := ConstLoc(FTypeCastSourceValue.AsCardinal)
AnAddress := ConstDerefLoc(FTypeCastSourceValue.AsCardinal)
else
if svfAddress in fields then
AnAddress := FTypeCastSourceValue.Address;
@ -3470,11 +3470,20 @@ begin
else begin
f := FTypeCastSourceValue.FieldFlags;
// skRecord: ONLY Valid if Source has Address
if (f * [{svfOrdinal, }svfAddress] = [svfAddress]) then begin
if (f * [svfOrdinal, svfAddress] <> []) then begin
// skRecord: AND either ... if Source has same Size
if (f * [svfSize, svfSizeOfPointer]) = [svfSize] then begin
Result := GetSize(TypeSize) and GetSizeFor(FTypeCastSourceValue, SrcSize);
Result := Result and (TypeSize = SrcSize)
Result := GetSize(TypeSize);
if Result then begin
if f * [svfAddress, svfDataAddress] = [] then begin
//Result := TypeSize <= AddressSize;
Result := TypeSize <= SizeOf(TDBGPtr);
end
else begin
Result := Result and GetSizeFor(FTypeCastSourceValue, SrcSize);
Result := Result and (TypeSize = SrcSize);
end;
end;
end
else
// skRecord: AND either ... if Source has same Size (pointer size)

50
components/fpdebug/fpdbgdwarfdataclasses.pas
View File

@ -2383,24 +2383,49 @@ begin
DW_OP_plus: begin
if not AssertMinCount(2) then exit;
Entry := FStack.Pop;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
//TODO: 32 bit overflow?
EntryP^.Address := Entry.Address+EntryP^.Address;
{$POP}
(* TargetMem may be a constant after deref. So if SelfMem is involved, keep it. *)
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
if FStack.PeekKind = mlfConstantDeref then begin
EntryP := FStack.PeekForDeref;
if Entry.Address >= SizeOf(TDbgPtr) then // includes negative // SHL does not make sense, as it pretends there would be data
FStack.FError := fpErrLocationParser
else
{$PUSH}{$R-}{$Q-}
EntryP^.Address := EntryP^.Address shr (Entry.Address * 8);
{$POP}
end
else begin
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
//TODO: 32 bit overflow?
EntryP^.Address := Entry.Address+EntryP^.Address;
{$POP}
(* TargetMem may be a constant after deref. So if SelfMem is involved, keep it. *)
if (EntryP^.MType <> mlfSelfMem) and (Entry.MType in [mlfTargetMem, mlfSelfMem]) then
EntryP^.MType := Entry.MType;
end;
end;
DW_OP_plus_uconst: begin
if not AssertMinCount(1) then exit;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
EntryP^.Address := EntryP^.Address + ULEB128toOrdinal(CurData);
{$POP}
if FStack.PeekKind = mlfConstantDeref then begin
EntryP := FStack.PeekForDeref;
i := ULEB128toOrdinal(CurData);
if i >= SizeOf(TDbgPtr) then
EntryP^.Address := 0
else
{$PUSH}{$R-}{$Q-}
EntryP^.Address := EntryP^.Address shr (i * 8);
{$POP}
end
else begin
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
EntryP^.Address := EntryP^.Address + ULEB128toOrdinal(CurData);
{$POP}
end;
end;
DW_OP_minus: begin
if not AssertMinCount(2) then exit;
// TODO: small negative for mlfConstantDeref
Entry := FStack.Pop;
EntryP := FStack.Peek;
{$PUSH}{$R-}{$Q-}
@ -2608,7 +2633,6 @@ begin
if (FLastError = nil) and (FStack.FError = fpErrNoError) then begin
if not AssertMinCount(1) then exit; // no value for result
//TODO: If a caller expects it, it could accept mlfConstantDeref as result (but it would still need to deref it)
FStack.Peek(); // check that the result value is valid
if FStack.FError <> fpErrNoError then
SetError(FStack.FError);
end;

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

@ -3225,6 +3225,32 @@ begin
t.Add('((^^^char(gvInstance1)^)+3)^[1]', '((^^^char(gvInstance1)^)+3)^[1]', weChar('T'));
t.Add('((^^^char(gvInstance1)^)+3)[0][1]', '((^^^char(gvInstance1)^)+3)[0][1]', weChar('T'));
t.Add('TCastRecordB1(gvByte_2)', 'TCastRecordB1(gvByte_2)', weRecord([weCardinal(241, 'Byte', 12).N('b')], 'TCastRecordB1') );
t.Add('TCastRecordB1(gcByte_2)', 'TCastRecordB1(gcByte_2)', weRecord([weCardinal(240, 'Byte', 12).N('b')], 'TCastRecordB1') );
t.Add('TCastRecordB1($04)', 'TCastRecordB1($04)', weRecord([weCardinal( 4, 'Byte', 12).N('b')], 'TCastRecordB1') );
t.Add('TCastRecordB2(gvWord2)', 'TCastRecordB2(gvWord_2)', weRecord([weCardinal($DE, 'Byte', 1).N('b'), weCardinal($FF, 'Byte', 1).N('b2')], 'TCastRecordB2') );
t.Add('TCastRecordB2(gcWord2)', 'TCastRecordB2(gcWord_2)', weRecord([weCardinal($DD, 'Byte', 1).N('b'), weCardinal($FF, 'Byte', 1).N('b2')], 'TCastRecordB2') );
t.Add('TCastRecordB2($0405)', 'TCastRecordB2($0405)', weRecord([weCardinal($05, 'Byte', 1).N('b'), weCardinal($04, 'Byte', 1).N('b2')], 'TCastRecordB2') );
t.Add('TCastRecordW2(gvLongword_2)', 'TCastRecordW2(gvLongword_2)', weRecord([weCardinal($F516, 'Word', 2).N('w'), weCardinal($F5C6, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordW2(gcLongword_2)', 'TCastRecordW2(gcLongword_2)', weRecord([weCardinal($F515, 'Word', 2).N('w'), weCardinal($F5C6, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordW2($01020304)', 'TCastRecordW2($01020304)', weRecord([weCardinal($0304, 'Word', 2).N('w'), weCardinal($0102, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordW2(LongWord(gvLongword_2))', 'TCastRecordW2(LongWord(gvLongword_2))', weRecord([weCardinal($F516, 'Word', 2).N('w'), weCardinal($F5C6, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordW2(LongWord(gcLongword_2))', 'TCastRecordW2(LongWord(gcLongword_2))', weRecord([weCardinal($F515, 'Word', 2).N('w'), weCardinal($F5C6, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordW2(LongWord($01020304))', ' TCastRecordW2(LongWord($01020304))', weRecord([weCardinal($0304, 'Word', 2).N('w'), weCardinal($0102, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordL2(gvQword_2)', 'TCastRecordL2(gvQword_2)', weRecord([weCardinal($09D3FFFB, 'LongWord', 4).N('l'), weCardinal($D65DDBE5, 'LongWord', 4).N('l2')], 'TCastRecordL2') );
t.Add('TCastRecordL2(gcQword_2)', 'TCastRecordL2(gcQword_2)', weRecord([weCardinal($09D3FFFA, 'LongWord', 4).N('l'), weCardinal($D65DDBE5, 'LongWord', 4).N('l2')], 'TCastRecordL2') );
t.Add('TCastRecordL2($0102030405060708)', 'TCastRecordL2($0102030405060708)', weRecord([weCardinal($05060708, 'LongWord', 4).N('l'), weCardinal($01020304, 'LongWord', 4).N('l2')], 'TCastRecordL2') );
t.Add('TCastRecordW2(VarCastRecL1)', 'TCastRecordW2(VarCastRecL1)', weRecord([weCardinal(7, 'Word', 2).N('w'), weCardinal(0, 'Word', 2).N('w2')], 'TCastRecordW2') );
t.Add('TCastRecordL1(VarCastRecW2)', 'TCastRecordL1(VarCastRecW2)', weRecord([weCardinal($00060005, 'LongWord', 4).N('l')], 'TCastRecordL1') );
t.Add('TCastRecordQ2(VarCastRecL4)', 'TCastRecordQ2(VarCastRecL4)', weRecord([weCardinal($000000000B0000000A, 'QWord', 8).N('q'), weCardinal($000000000D0000000C, 'QWord', 8).N('q2')], 'TCastRecordQ2') );
t.Add('TCastRecordL4(VarCastRecQ2)', 'TCastRecordL4(VarCastRecQ2)', weRecord([weCardinal($00120013, 'LongWord', 4).N('l'), weCardinal($00100011, 'LongWord', 4).N('l2'), weCardinal($00220023, 'LongWord', 4).N('l3'), weCardinal($00200021, 'LongWord', 4).N('l4')], 'TCastRecordL4') );
AddWatchesConv(t, 'glob const', 'gc', 000, 'A', tlConst);
AddWatchesConv(t, 'glob var', 'gv', 001, 'B');
@ -3237,6 +3263,8 @@ begin
AddWatchesCast(t, 'glob var dyn array of [0]', 'gva', 005, 'K', tlArrayWrap, '[0]' );
AddWatchesCast(t, 'glob var dyn array of [1]', 'gva', 006, 'L', tlArrayWrap, '[1]');
AddWatchesCast(t, 'glob var pointer', 'gvp_', 001, 'B', tlPointer, '^'); // pointer
t.EvaluateWatches;
t.CheckResults;

BIN
components/lazdebuggers/lazdebugtestbase/sources.res
View File

Binary file not shown.

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

@ -68,6 +68,30 @@ type
FList: PMyStringItemList;
end;
TCastRecordB1 = packed record
b: Byte;
end;
TCastRecordB2 = packed record
b,b2: Byte;
end;
TCastRecordW1 = packed record
w: Word;
end;
TCastRecordW2 = packed record
w,w2: Word;
end;
TCastRecordL1 = packed record
l: LongWord;
end;
TCastRecordL2 = packed record
l,l2: LongWord;
end;
TCastRecordL4 = packed record
l,l2,l3,l4: LongWord;
end;
TCastRecordQ2 = packed record
q,q2: QWord;
end;
var
BreakDummy, BreakDummy2: PtrUInt;
@ -91,6 +115,15 @@ var
Short1: array [0..2] of String[10];
ARef0, ARef1, ARef2, ARef3, ARef4: array of byte;
VarCastRecb1: TCastRecordB1;
VarCastRecb2: TCastRecordB2;
VarCastRecw1: TCastRecordW1;
VarCastRecw2: TCastRecordW2;
VarCastRecl1: TCastRecordL1;
VarCastRecl2: TCastRecordL2;
VarCastRecl4: TCastRecordL4;
VarCastRecq2: TCastRecordQ2;
type
TClass1 = class;
@ -935,6 +968,22 @@ begin
v_array[3] := 104;
v_array[4] := True;
VarCastRecb1.b := 1;
VarCastRecb2.b := 2;
VarCastRecb2.b2 := 2;
VarCastRecw1.w := 4;
VarCastRecw2.w := 5;
VarCastRecw2.w2 := 6;
VarCastRecl1.l := 7;
VarCastRecl2.l := 8;
VarCastRecl2.l2 := 9;
VarCastRecl4.l := 10;
VarCastRecl4.l2 := 11;
VarCastRecl4.l3 := 12;
VarCastRecl4.l4 := 13;
VarCastRecq2.q := $0010001100120013;
VarCastRecq2.q2 := $0020002100220023;
{$if FPC_FULLVERSION >= 30000}
dummy1 := nil;
{$ENDIF}