diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index c25e6de080..29860d3d6b 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -994,6 +994,12 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line TDbgDwarfTypeIdentifier = class(TDbgDwarfIdentifier) protected + // FCachedDataAddress is used by + // TDbgDwarfSymbolValue.GetDwarfDataAddress + // TDbgDwarfValueIdentifier.GetDataAddress + //TODO: maybe introduce a lightweight wrapper, so types can be re-used. + FCachedDataAddress: TFpDbgMemLocation; + procedure Init; override; procedure MemberVisibilityNeeded; override; procedure SizeNeeded; override; @@ -2825,6 +2831,13 @@ function TDbgDwarfSymbolValue.GetDwarfDataAddress(out AnAddress: TFpDbgMemLocati var fields: TDbgSymbolValueFieldFlags; begin + // TODO: also cache none valid address + Result := IsValidLoc(ATargetType.FCachedDataAddress); + if Result then begin + AnAddress := ATargetType.FCachedDataAddress; + exit; + end; + if FValueSymbol <> nil then begin Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol'); Assert(TypeInfo is TDbgDwarfTypeIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo'); @@ -2856,6 +2869,8 @@ begin if IsError(FTypeCastTargetType.LastError) then FLastError := FTypeCastTargetType.LastError; end; + + ATargetType.FCachedDataAddress := AnAddress; end; procedure TDbgDwarfSymbolValue.Reset; @@ -5638,11 +5653,19 @@ begin Result := TypeInfo <> nil; if not Result then exit; + // TODO: also cache none valid address + Result := IsValidLoc(ATargetType.FCachedDataAddress); + if Result then begin + AnAddress := ATargetType.FCachedDataAddress; + exit; + end; + Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress'); AnAddress := Address; Result := IsReadableLoc(AnAddress); if Result then Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType); + ATargetType.FCachedDataAddress := AnAddress; end; procedure TDbgDwarfValueIdentifier.KindNeeded; diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index 5da255698b..9902374db8 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -164,6 +164,7 @@ type * TODO: allow to pre-read and cache Target mem (e.g. before reading all fields of a record *) TFpDbgMemLocationType = ( + mflUninitialized := 0, // like invalid, but not known // 0 means objet fields will start wint this mlfInvalid, mlfTargetMem, // an address in the target (debuggee) process mlfSelfMem, // an address in this(the debuggers) process memory; the data is in TARGET format (endian, ...) @@ -314,12 +315,12 @@ end; function IsValidLoc(ALocation: TFpDbgMemLocation): Boolean; begin - Result := (ALocation.MType <> mlfInvalid); + Result := not(ALocation.MType in [mlfInvalid, mflUninitialized]); end; function IsReadableLoc(ALocation: TFpDbgMemLocation): Boolean; begin - Result := (ALocation.MType <> mlfInvalid) and + Result := (not(ALocation.MType in [mlfInvalid, mflUninitialized])) and ( (not(ALocation.MType in [mlfTargetMem, mlfSelfMem])) or (ALocation.Address <> 0) ); @@ -492,7 +493,7 @@ begin FLastError := NoError; Result := False; case ALocation.MType of - mlfInvalid: + mlfInvalid, mflUninitialized: FLastError := CreateError(fpErrCanNotReadInvalidMem); mlfTargetMem, mlfSelfMem: begin Result := TargetMemConvertor.PrepareTargetRead(AReadDataType, ALocation.Address, @@ -589,7 +590,7 @@ begin FLastError := NoError; Result := False; case ALocation.MType of - mlfInvalid: ; + mlfInvalid, mflUninitialized: ; mlfTargetMem: begin Result := FMemReader.ReadMemory(ALocation.Address, ASize, ADest); diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 5b8b88534f..c736276ff3 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -924,6 +924,7 @@ begin tmp2 := Items[1].ResultValue; if not (svfOrdinal in tmp2.FieldFlags) then exit; + if tmp2.AsCardinal > high(Integer) then exit; // TODO max member range Result := tmp.Member[tmp2.AsCardinal]; // todo negative ? if Result <> nil then Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF}; diff --git a/components/fpdebug/test/testhelperclasses.pas b/components/fpdebug/test/testhelperclasses.pas index 4d511f4ea4..3e3bf30a39 100644 --- a/components/fpdebug/test/testhelperclasses.pas +++ b/components/fpdebug/test/testhelperclasses.pas @@ -402,7 +402,8 @@ end; function TTestMemReader.ReadMemory(AnAddress: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; begin - Result := True; + Result := AnAddress > 1000; // avoid reading at 0x0000 + if not Result then exit; Move(Pointer(AnAddress)^, ADest^, ASize); end; diff --git a/components/fpdebug/test/testtypeinfo.pas b/components/fpdebug/test/testtypeinfo.pas index 249d0ebda0..8bccda32c6 100644 --- a/components/fpdebug/test/testtypeinfo.pas +++ b/components/fpdebug/test/testtypeinfo.pas @@ -5,9 +5,9 @@ unit TestTypeInfo; interface uses - FpPascalParser, FpDbgDwarf, FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazUTF8, sysutils, - fpcunit, testregistry, TestHelperClasses, TestDwarfSetup1, TestDwarfSetupBasic, - DbgIntfBaseTypes, TestDwarfSetupArray; + FpPascalParser, FpDbgDwarf, FpDbgInfo, FpdMemoryTools, FpErrorMessages, LazLoggerBase, + LazUTF8, sysutils, fpcunit, testregistry, TestHelperClasses, TestDwarfSetup1, + TestDwarfSetupBasic, DbgIntfBaseTypes, TestDwarfSetupArray; type @@ -305,8 +305,14 @@ end; procedure TTestTypeInfo.StartInvalTest(Expr: String; ExpError: String; ExtraName: String); begin InitTest(Expr, ExtraName); - FExpression.ResultValue; - AssertTrue(FCurrentTestName + 'invalid', (not FExpression.Valid) or (FExpression.ResultValue = nil)); + if FExpression.ResultValue <> nil then begin // some value are only invalid after accessing the data + FExpression.ResultValue.AsInteger; + FExpression.ResultValue.AsCardinal; + end; + AssertTrue(FCurrentTestName + 'invalid', + (not FExpression.Valid) or (FExpression.ResultValue = nil) or + (IsError(FExpression.ResultValue.LastError)) + ); //AssertTrue(CurrentTestName + 'invalid', (not Expression.Valid)); //ExpError end;