diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 95c595507b..0c83118b6c 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -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) diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index b2fc24e86a..78b6646801 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -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; diff --git a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas index 83265ffc78..07e50b9f30 100644 --- a/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggers/lazdebuggerfp/test/testwatches.pas @@ -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; diff --git a/components/lazdebuggers/lazdebugtestbase/sources.res b/components/lazdebuggers/lazdebugtestbase/sources.res index 582af8af2c..858fac4df8 100644 Binary files a/components/lazdebuggers/lazdebugtestbase/sources.res and b/components/lazdebuggers/lazdebugtestbase/sources.res differ diff --git a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas index 1e9c207bc9..e6504f5268 100644 --- a/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas +++ b/components/lazdebuggers/lazdebugtestbase/testapps/WatchesValuePrg.pas @@ -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}