From 22aca35233eb403d3df40cef2bdaede8d02923ee Mon Sep 17 00:00:00 2001 From: martin Date: Sun, 13 Oct 2019 12:25:37 +0000 Subject: [PATCH] FpDebug: Use LastError from value object. git-svn-id: trunk@62045 - --- components/fpdebug/fpdbgdwarf.pas | 172 +++++++++---------- components/fpdebug/fpdbgdwarfdataclasses.pas | 10 +- components/fpdebug/fpdbgdwarffreepascal.pas | 21 +-- components/fpdebug/fpdbginfo.pas | 44 ++--- components/fpdebug/fpdmemorytools.pas | 14 +- components/fpdebug/fperrormessages.pas | 19 +- components/fpdebug/fppascalparser.pas | 13 +- 7 files changed, 145 insertions(+), 148 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 3b2d1d30da..30e9335b40 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -491,7 +491,7 @@ type property LocalProcInfo: TFpSymbolDwarf read FLocalProcInfo write SetLocalProcInfo; function DoForwardReadSize(const AValueObj: TFpValue; out ASize: TFpDbgValueSize): Boolean; inline; - function DataSize: TFpDbgValueSize; virtual; + function DoReadDataSize(const AValueObj: TFpValue; out ADataSize: TFpDbgValueSize): Boolean; virtual; protected function InitLocationParser(const {%H-}ALocationParser: TDwarfLocationExpression; AnInitLocParserData: PInitLocParserData = nil): Boolean; virtual; @@ -870,13 +870,13 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line procedure CreateMembers; protected procedure KindNeeded; override; - function DoReadOrdering(AValObject: TFpValueDwarf; out ARowMajor: Boolean): Boolean; + function DoReadOrdering(AValueObj: TFpValueDwarf; out ARowMajor: Boolean): Boolean; function GetFlags: TDbgSymbolFlags; override; // GetNestedSymbolEx: returns the TYPE/range of each index. NOT the data function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override; function GetNestedSymbolCount: Integer; override; - function GetMemberAddress(AValObject: TFpValueDwarf; const AIndex: Array of Int64): TFpDbgMemLocation; + function GetMemberAddress(AValueObj: TFpValueDwarf; const AIndex: Array of Int64): TFpDbgMemLocation; public destructor Destroy; override; function GetTypedValueObject({%H-}ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override; @@ -1541,11 +1541,8 @@ begin AnAddress := Address; Result := IsReadableLoc(AnAddress); - if Result then begin + if Result then Result := TFpSymbolDwarf(ti).GetDataAddress(Self, AnAddress, ATargetType); - if not Result then - SetLastError(ti.LastError); - end; end else @@ -1564,11 +1561,8 @@ begin AnAddress := FTypeCastSourceValue.Address; Result := IsReadableLoc(AnAddress); - if Result then begin + if Result then Result := FTypeSymbol.GetDataAddress(Self, AnAddress, ATargetType); - if IsError(FTypeSymbol.LastError) then - SetLastError(FTypeSymbol.LastError); - end; end; if not Result then @@ -1652,8 +1646,6 @@ begin if FTypeSymbol <> nil then begin Result := FTypeSymbol.ReadSize(Self, ASize); - if (not Result) and IsError(FTypeSymbol.LastError) then - SetLastError(FTypeSymbol.LastError); end else Result := inherited DoGetSize(ASize); @@ -2056,6 +2048,11 @@ begin i := 2000; while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1])) do i := i div 2; + if i = 0 then begin + Result := ''; + SetLastError(MemManager.LastError); + exit; + end; SetLength(Result,i); i := pos(#0, Result); if i > 0 then @@ -2078,6 +2075,11 @@ begin i := 4000; // 2000 * 16 bit while (i > 0) and (not MemManager.ReadMemory(GetDerefAddress, SizeVal(i), @Result[1])) do i := i div 2; + if i = 0 then begin + Result := ''; + SetLastError(MemManager.LastError); + exit; + end; SetLength(Result, i div 2); i := pos(#0, Result); if i > 0 then @@ -2505,8 +2507,10 @@ function TFpValueDwarfStruct.GetDataSize: TFpDbgValueSize; begin Assert((FDataSymbol = nil) or (FDataSymbol.TypeInfo is TFpSymbolDwarf)); if (FDataSymbol <> nil) and (FDataSymbol.TypeInfo <> nil) then begin - if FDataSymbol.TypeInfo.Kind = skClass then - Result := TFpSymbolDwarf(FDataSymbol.TypeInfo).DataSize + if FDataSymbol.TypeInfo.Kind = skClass then begin + if not TFpSymbolDwarf(FDataSymbol.TypeInfo).DoReadDataSize(Self, Result) then + Result := ZeroSize; + end else if not GetSize(Result) then Result := ZeroSize; @@ -2556,8 +2560,10 @@ function TFpValueDwarfStructTypeCast.GetDataSize: TFpDbgValueSize; begin Assert((FTypeSymbol = nil) or (FTypeSymbol is TFpSymbolDwarf)); if FTypeSymbol <> nil then begin - if FTypeSymbol.Kind = skClass then - Result := TFpSymbolDwarf(FTypeSymbol).DataSize + if FTypeSymbol.Kind = skClass then begin + if not TFpSymbolDwarf(FTypeSymbol).DoReadDataSize(Self, Result) then + Result := ZeroSize; + end else if not GetSize(Result) then Result := ZeroSize; @@ -3053,15 +3059,19 @@ begin Result := inherited DoReadSize(AValueObj, ASize); end; -function TFpSymbolDwarf.DataSize: TFpDbgValueSize; +function TFpSymbolDwarf.DoReadDataSize(const AValueObj: TFpValue; out + ADataSize: TFpDbgValueSize): Boolean; var t: TFpSymbolDwarfType; begin t := NestedTypeInfo; if t <> nil then - Result := t.DataSize + Result := t.DoReadDataSize(AValueObj, ADataSize) else - Result := ZeroSize; + begin + Result := False; + ADataSize := ZeroSize; + end; end; function TFpSymbolDwarf.InitLocationParser(const ALocationParser: TDwarfLocationExpression; @@ -3115,7 +3125,7 @@ begin Result := True; end else - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); end // TODO: loclistptr: DW_FORM_data4, DW_FORM_data8, @@ -3128,7 +3138,7 @@ begin end else begin - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); end; // Bit Offset @@ -3152,7 +3162,7 @@ begin end; if not Result then - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); exit; end; @@ -3163,7 +3173,7 @@ begin AnAddress := AddBitOffset(AnAddress, BitOffset); if not Result then - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); end; end; @@ -3193,7 +3203,7 @@ begin Result := InformationEntry.ReadValue(AnAttribData, AValue); if not Result then - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); end else @@ -3217,17 +3227,20 @@ begin assert(ValObj is TFpValueDwarfBase, 'Result is TFpValueDwarfBase'); TFpValueDwarfBase(ValObj).Context := AValueObj.Context; AValue := ValObj.AsInteger; + if IsError(ValObj.LastError) then begin + Result := False; + SetLastError(AValueObj, ValObj.LastError); + end; ValObj.ReleaseReference; - Result := not IsError(RefSymbol.LastError); - // TODO: copy the error + if ADataSymbol <> nil then ADataSymbol^ := RefSymbol else RefSymbol.ReleaseReference; end; end; - if not Result then - SetLastError(CreateError(fpErrAnyError)); + if (not Result) and (not HasError(AValueObj)) then + SetLastError(AValueObj, CreateError(fpErrAnyError)); end else @@ -3243,6 +3256,9 @@ begin if AReadState <> nil then AReadState^ := rfExpression; + // TODO: (or not todo?) AValueObj may be the pointer (internal ptr to object), + // but since that is the nearest actual variable => what would the LocExpr expect? + // Maybe we need "AddressFor(type) // see TFpSymbolDwarfFreePascalTypePointer.DoReadDataSize InitLocParserData.ObjectDataAddress := AValueObj.Address; if not IsValidLoc(InitLocParserData.ObjectDataAddress) then InitLocParserData.ObjectDataAddress := AValueObj.OrdOrAddress; @@ -3251,11 +3267,11 @@ begin if Result then AValue := Int64(t.Address) else - SetLastError(CreateError(fpErrLocationParser)); + SetLastError(AValueObj, CreateError(fpErrLocationParser)); end else begin - SetLastError(CreateError(fpErrAnyError)); + SetLastError(AValueObj, CreateError(fpErrAnyError)); end; if (not Result) and (AReadState <> nil) then @@ -3280,11 +3296,13 @@ begin // DW_AT_location [block or reference] todo: const if not InformationEntry.ReadValue(AnAttribData, Val) then begin DebugLn(['LocationFromAttrData: failed to read DW_AT_location']); + SetLastError(AValueObj, CreateError(fpErrAnyError)); exit; end; if Length(Val) = 0 then begin DebugLn('LocationFromAttrData: Warning DW_AT_location empty'); + SetLastError(AValueObj, CreateError(fpErrAnyError)); //exit; end; @@ -3294,7 +3312,7 @@ begin LocationParser.Evaluate; if IsError(LocationParser.LastError) then - SetLastError(LocationParser.LastError); + SetLastError(AValueObj, LocationParser.LastError); AnAddress := LocationParser.ResultData; Result := IsValidLoc(AnAddress); @@ -3471,17 +3489,17 @@ end; function TFpSymbolDwarf.GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; begin + assert(False, 'TFpSymbolDwarf.GetNestedSymbolEx: False not a structuer'); Result := nil; AnParentTypeSymbol := nil; - SetLastError(CreateError(fpErrorNotAStructure, ['', Name])); end; function TFpSymbolDwarf.GetNestedSymbolExByName(AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; begin + assert(False, 'TFpSymbolDwarf.GetNestedSymbolExByName: False not a structuer'); Result := nil; AnParentTypeSymbol := nil; - SetLastError(CreateError(fpErrorNotAStructure, [AIndex, Name])); end; function TFpSymbolDwarf.GetNestedSymbol(AIndex: Int64): TFpSymbol; @@ -3692,22 +3710,16 @@ begin if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; + if not Result then exit; - end; ASize := SizeFromBits(Bits); exit; end; if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; + if not Result then exit; - end; end; // If it does not have a size => No error @@ -3723,19 +3735,11 @@ begin if InformationEntry.GetAttribData(DW_AT_bit_stride, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, BitStride); AStride := SizeFromBits(BitStride); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; - end; exit; end; if InformationEntry.GetAttribData(DW_AT_byte_stride, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, AStride.Size); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; - end; exit; end; end; @@ -3988,15 +3992,17 @@ begin exit; Result := AValueObj.MemManager <> nil; - if not Result then + if not Result then begin + SetLastError(AValueObj, CreateError(fpErrAnyError)); exit; + end; AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize)); Result := IsValidLoc(AnAddress); if (not Result) and IsError(AValueObj.MemManager.LastError) then - SetLastError(AValueObj.MemManager.LastError); + SetLastError(AValueObj, AValueObj.MemManager.LastError); // Todo: other error end; @@ -4070,7 +4076,7 @@ var t: TFpSymbolDwarfType; begin Result := inherited DoReadSize(AValueObj, ASize); - if Result or IsError(LastError) then + if Result or HasError(AValueObj) then exit; t := NestedTypeInfo; @@ -4305,14 +4311,16 @@ begin exit; Result := AValueObj.MemManager <> nil; - if not Result then + if not Result then begin + SetLastError(AValueObj, CreateError(fpErrAnyError)); exit; + end; AnAddress := AValueObj.MemManager.ReadAddress(AnAddress, SizeVal(CompilationUnit.AddressSize)); Result := IsValidLoc(AnAddress); if not Result then if IsError(AValueObj.MemManager.LastError) then - SetLastError(AValueObj.MemManager.LastError); + SetLastError(AValueObj, AValueObj.MemManager.LastError); // Todo: other error end; @@ -4531,22 +4539,16 @@ begin if InformationEntry.GetAttribData(DW_AT_bit_size, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, Bits); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; + if not Result then exit; - end; ASize := SizeFromBits(Bits); exit; end; if InformationEntry.GetAttribData(DW_AT_byte_size, AttrData) then begin Result := ConstRefOrExprFromAttrData(AttrData, AValueObj as TFpValueDwarf, ASize.Size); - if not Result then begin - // If AValueObj <> nil then - //AValueObj.LastError := LastError; + if not Result then exit; - end; end; // If it does not have a size => No error @@ -4560,17 +4562,17 @@ begin if (AValueObj = nil) or (AValueObj.StructureValue = nil) or (AValueObj.FParentTypeSymbol = nil) then begin - debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser Error: ',ErrorCode(LastError)]); + debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser ']); Result := False; - if not IsError(LastError) then - SetLastError(CreateError(fpErrLocationParserInit)); // TODO: error message? + if not HasError(AValueObj) then + SetLastError(AValueObj, CreateError(fpErrLocationParserInit)); // TODO: error message? exit; end; if not AValueObj.GetStructureDwarfDataAddress(AnAddress, AValueObj.FParentTypeSymbol) then begin - debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser Error: ',ErrorCode(LastError)]); + debugln(FPDBG_DWARF_ERRORS, ['DWARF ERROR in TFpSymbolDwarfDataMember.InitLocationParser Error: ',ErrorCode(AValueObj.LastError)]); Result := False; - if not IsError(LastError) then - SetLastError(CreateError(fpErrLocationParserInit)); // TODO: error message? + if not HasError(AValueObj) then + SetLastError(AValueObj, CreateError(fpErrLocationParserInit)); // TODO: error message? exit; end; //TODO: AValueObj.StructureValue.LastError @@ -4800,7 +4802,7 @@ begin SetKind(skArray); // Todo: static/dynamic? end; -function TFpSymbolDwarfTypeArray.DoReadOrdering(AValObject: TFpValueDwarf; out +function TFpSymbolDwarfTypeArray.DoReadOrdering(AValueObj: TFpValueDwarf; out ARowMajor: Boolean): Boolean; var AVal: Integer; @@ -4814,9 +4816,7 @@ begin if Result then ARowMajor := AVal = DW_ORD_row_major else - // If AValueObj <> nil then - //AValueObj.LastError := LastError; - ; + SetLastError(AValueObj, CreateError(fpErrAnyError)); end; end; @@ -4873,7 +4873,7 @@ begin Result := FMembers.Count; end; -function TFpSymbolDwarfTypeArray.GetMemberAddress(AValObject: TFpValueDwarf; +function TFpSymbolDwarfTypeArray.GetMemberAddress(AValueObj: TFpValueDwarf; const AIndex: array of Int64): TFpDbgMemLocation; var Idx, Factor: Int64; @@ -4883,12 +4883,12 @@ var RowMajor: Boolean; Offs, StrideInBits: TFpDbgValueSize; begin - assert((AValObject is TFpValueDwarfArray), 'TFpSymbolDwarfTypeArray.GetMemberAddress AValObject'); + assert((AValueObj is TFpValueDwarfArray), 'TFpSymbolDwarfTypeArray.GetMemberAddress AValueObj'); // ReadOrdering; -// ReadStride(AValObject); // TODO Stride per member (member = dimension/index) +// ReadStride(AValueObj); // TODO Stride per member (member = dimension/index) Result := InvalidLoc; - if not TFpValueDwarfArray(AValObject).GetMainStride(StrideInBits) then + if not TFpValueDwarfArray(AValueObj).GetMainStride(StrideInBits) then exit; if (StrideInBits <= 0) then exit; @@ -4897,8 +4897,8 @@ begin if Length(AIndex) > FMembers.Count then exit; - if AValObject is TFpValueDwarfArray then begin - if not TFpValueDwarfArray(AValObject).GetDwarfDataAddress(Result) then begin + if AValueObj is TFpValueDwarfArray then begin + if not TFpValueDwarfArray(AValueObj).GetDwarfDataAddress(Result) then begin Result := InvalidLoc; Exit; end; @@ -4915,7 +4915,7 @@ begin Factor := 1; - if not TFpValueDwarfArray(AValObject).GetOrdering(RowMajor) then + if not TFpValueDwarfArray(AValueObj).GetOrdering(RowMajor) then exit; {$PUSH}{$R-}{$Q-} // TODO: check range of index if RowMajor then begin @@ -4923,7 +4923,7 @@ begin Idx := AIndex[i]; m := TFpSymbolDwarf(FMembers[i]); if i > 0 then begin - if not m.GetValueBounds(AValObject, LowBound, HighBound) then begin + if not m.GetValueBounds(AValueObj, LowBound, HighBound) then begin Result := InvalidLoc; exit; end; @@ -4932,7 +4932,7 @@ begin Factor := Factor * (HighBound - LowBound + 1); // TODO range check end else begin - if m.GetValueLowBound(AValObject, LowBound) then + if m.GetValueLowBound(AValueObj, LowBound) then Idx := Idx - LowBound; Offs := Offs + StrideInBits * Idx * Factor; end; @@ -4943,7 +4943,7 @@ begin Idx := AIndex[i]; m := TFpSymbolDwarf(FMembers[i]); if i > 0 then begin - if not m.GetValueBounds(AValObject, LowBound, HighBound) then begin + if not m.GetValueBounds(AValueObj, LowBound, HighBound) then begin Result := InvalidLoc; exit; end; @@ -4952,7 +4952,7 @@ begin Factor := Factor * (HighBound - LowBound + 1); // TODO range check end else begin - if m.GetValueLowBound(AValObject, LowBound) then + if m.GetValueLowBound(AValueObj, LowBound) then Idx := Idx - LowBound; Offs := Offs + StrideInBits * Idx * Factor; end; @@ -5143,8 +5143,8 @@ begin Result := rd.Address; if IsError(FFrameBaseParser.LastError) then begin - SetLastError(FFrameBaseParser.LastError); - debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(LastError)]); + ASender.SetLastError(FFrameBaseParser.LastError); + debugln(FPDBG_DWARF_ERRORS, ['TFpSymbolDwarfDataProc.GetFrameBase location parser failed ', ErrorHandler.ErrorAsString(ASender.LastError)]); end else if Result = 0 then begin diff --git a/components/fpdebug/fpdbgdwarfdataclasses.pas b/components/fpdebug/fpdbgdwarfdataclasses.pas index c19dd6d3d3..b25492699c 100644 --- a/components/fpdebug/fpdbgdwarfdataclasses.pas +++ b/components/fpdebug/fpdbgdwarfdataclasses.pas @@ -714,6 +714,7 @@ type //TODO: caller keeps data, and determines livetime of data constructor Create(AExpressionData: Pointer; AMaxCount: Integer; ACU: TDwarfCompilationUnit; AMemManager: TFpDbgMemManager; AContext: TFpDbgAddressContext); + procedure SetLastError(ALastError: TFpError); procedure Evaluate; function ResultData: TFpDbgMemLocation; procedure Push(AValue: TFpDbgMemLocation); @@ -1865,6 +1866,12 @@ begin FContext := AContext; end; +procedure TDwarfLocationExpression.SetLastError(ALastError: TFpError); +begin + assert(Not IsError(FLastError), 'TDwarfLocationExpression.SetLastError: Not IsError(FLastError)'); + FLastError := ALastError; +end; + procedure TDwarfLocationExpression.Evaluate; var CurInstr, CurData: PByte; @@ -2046,7 +2053,8 @@ begin DW_OP_fbreg: begin if (FFrameBase = 0) and (FOnFrameBaseNeeded <> nil) then FOnFrameBaseNeeded(Self); if FFrameBase = 0 then begin - SetError; + if not IsError(FLastError) then + SetError; exit; end; {$PUSH}{$R-}{$Q-} diff --git a/components/fpdebug/fpdbgdwarffreepascal.pas b/components/fpdebug/fpdbgdwarffreepascal.pas index 49e172102b..71d7c76f33 100644 --- a/components/fpdebug/fpdbgdwarffreepascal.pas +++ b/components/fpdebug/fpdbgdwarffreepascal.pas @@ -118,7 +118,7 @@ type function GetDataAddressNext(AValueObj: TFpValueDwarf; var AnAddress: TFpDbgMemLocation; out ADoneWork: Boolean; ATargetType: TFpSymbolDwarfType): Boolean; override; function GetTypedValueObject(ATypeCast: Boolean; AnOuterType: TFpSymbolDwarfType = nil): TFpValueDwarf; override; - function DataSize: TFpDbgValueSize; override; + function DoReadDataSize(const AValueObj: TFpValue; out ADataSize: TFpDbgValueSize): Boolean; override; public property IsInternalPointer: Boolean read GetIsInternalPointer write FIsInternalPointer; // Class (also DynArray, but DynArray is handled without this) end; @@ -677,8 +677,7 @@ begin if (not Result) and IsError(AValueObj.MemManager.LastError) then - SetLastError(AValueObj.MemManager.LastError); - // Todo: other error + SetLastError(AValueObj, AValueObj.MemManager.LastError); end; function TFpSymbolDwarfFreePascalTypePointer.GetTypedValueObject( @@ -692,21 +691,19 @@ begin Result := inherited GetTypedValueObject(ATypeCast, AnOuterType); end; -function TFpSymbolDwarfFreePascalTypePointer.DataSize: TFpDbgValueSize; +function TFpSymbolDwarfFreePascalTypePointer.DoReadDataSize( + const AValueObj: TFpValue; out ADataSize: TFpDbgValueSize): Boolean; var Size: TFpDbgValueSize; begin if Kind = skClass then begin - // TODO: get a value object // though fpc does not yet write variable sizes - if not NestedTypeInfo.ReadSize(nil, Size) then begin - Result := ZeroSize; - SetLastError(CreateError(fpErrAnyError, ['unknown size'])); - exit; - end; - Result := Size + // TODO: get/adjust a value object to have the deref address // see ConstRefOrExprFromAttrData + Result := NestedTypeInfo.ReadSize(AValueObj, ADataSize); + if not Result then + ADataSize := ZeroSize; end else - Result := inherited DataSize; + Result := inherited DoReadDataSize(AValueObj, ADataSize); end; { TFpSymbolDwarfFreePascalTypeStructure } diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 10334e8935..1b7e25cff6 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -318,8 +318,6 @@ type TFpSymbol = class(TRefCountedObject) private FEvaluatedFields: TFpSymbolFields; - FLastError: TFpError; - // Cached fields FName: String; FKind: TDbgSymbolKind; @@ -335,8 +333,8 @@ type function GetTypeInfo: TFpSymbol; inline; function GetMemberVisibility: TDbgSymbolMemberVisibility; inline; protected - function GetLastError: TFpError; virtual; - procedure SetLastError(AnError: TFpError); + procedure SetLastError(AValueObj: TFpValue; ALastError: TFpError); inline; + function HasError(AValueObj: TFpValue): Boolean; inline; // NOT cached fields function GetChild({%H-}AIndex: Integer): TFpSymbol; virtual; function GetColumn: Cardinal; virtual; @@ -427,8 +425,6 @@ type // TypeCastValue| only fon stType symbols, may return nil // Returns a reference to caller / caller must release function TypeCastValue({%H-}AValue: TFpValue): TFpValue; virtual; - - property LastError: TFpError read GetLastError; experimental; end; { TFpSymbolForwarder } @@ -441,7 +437,6 @@ type procedure ForwardToSymbolNeeded; virtual; function GetForwardToSymbol: TFpSymbol; inline; protected - function GetLastError: TFpError; override; procedure KindNeeded; override; procedure NameNeeded; override; procedure SymbolTypeNeeded; override; @@ -719,8 +714,6 @@ begin exit; Result := ti.ReadSize(Self, ASize); - if (not Result) and IsError(ti.LastError) then - SetLastError(ti.LastError); end; function TFpValue.GetDataAddress: TFpDbgMemLocation; @@ -1003,6 +996,17 @@ begin Result := FMemberVisibility; end; +procedure TFpSymbol.SetLastError(AValueObj: TFpValue; ALastError: TFpError); +begin + if AValueObj <> nil then + AValueObj.SetLastError(ALastError); +end; + +function TFpSymbol.HasError(AValueObj: TFpValue): Boolean; +begin + Result := (AValueObj <> nil) and IsError(AValueObj.LastError); +end; + function TFpSymbol.GetValueObject: TFpValue; begin Result := nil; @@ -1029,16 +1033,6 @@ begin Result := FSymbolType; end; -function TFpSymbol.GetLastError: TFpError; -begin - Result := FLastError; -end; - -procedure TFpSymbol.SetLastError(AnError: TFpError); -begin - FLastError := AnError; -end; - function TFpSymbol.GetHasOrdinalValue: Boolean; begin Result := False; @@ -1197,18 +1191,6 @@ begin Result := FForwardToSymbol; end; -function TFpSymbolForwarder.GetLastError: TFpError; -var - p: TFpSymbol; -begin - Result := inherited GetLastError; - if IsError(Result) then - exit; - p := GetForwardToSymbol; - if p <> nil then - Result := p.LastError; -end; - procedure TFpSymbolForwarder.KindNeeded; var p: TFpSymbol; diff --git a/components/fpdebug/fpdmemorytools.pas b/components/fpdebug/fpdmemorytools.pas index d20abc77d8..e369b476ba 100644 --- a/components/fpdebug/fpdmemorytools.pas +++ b/components/fpdebug/fpdmemorytools.pas @@ -1129,7 +1129,7 @@ begin if (ASourceLocation.MType in [mlfInvalid, mlfUninitialized]) or (ASourceSize <= 0) then begin - FLastError := CreateError(fpErrCanNotReadInvalidMem); + FLastError := CreateError(fpInternalErrCanNotReadInvalidMem); exit; end; @@ -1152,7 +1152,7 @@ begin SourceFullSize := ConvData.SourceFullSize; if (SourceFullSize > TMP_MEM_SIZE) and (SourceFullSize > ConvData.DestSize) then begin // The un-shifted (bit-offset) result must fully fit in either ADest or FTmpMem - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpInternalErrFailedReadMem); exit; end; @@ -1293,7 +1293,7 @@ begin // TODO: only needed if ADestSize > SourceReadSize ? // Maybe do that after Move to ADest? // Maybe as part of FinishTargetRead ? if not FSelfMemConvertor.AdjustIntPointer(ReadData, SizeOf(TmpVal), SourceReadSize) then begin - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpInternalErrFailedReadMem); exit; end; @@ -1313,7 +1313,7 @@ begin TargetMemConvertor.FailedTargetRead(ConvData); if (not Result) and (not IsError(FLastError)) then - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpInternalErrFailedReadMem); end; procedure TFpDbgMemManager.SetCacheManager(ACacheMgr: TFpDbgMemCacheManagerBase); @@ -1367,7 +1367,7 @@ begin FLastError := NoError; if (ASourceLocation.BitOffset <> 0) then begin // Not supported to read at bit offset - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpInternalErrFailedReadMem); Result := False; exit; end; @@ -1379,7 +1379,7 @@ begin Result := ReadMemory(ASourceLocation, ASize, ADest, AContext); end; if (not Result) and (not IsError(FLastError)) then - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpInternalErrFailedReadMem); end; function TFpDbgMemManager.ReadRegister(ARegNum: Cardinal; out AValue: TDbgPtr; @@ -1391,7 +1391,7 @@ begin AContext := FDefaultContext; Result := FMemReader.ReadRegister(ARegNum, AValue, AContext); if not Result then - FLastError := CreateError(fpErrFailedReadMem); + FLastError := CreateError(fpErrFailedReadRegister); end; function TFpDbgMemManager.ReadAddress(const ALocation: TFpDbgMemLocation; diff --git a/components/fpdebug/fperrormessages.pas b/components/fpdebug/fperrormessages.pas index 155513135b..2d08f9c174 100644 --- a/components/fpdebug/fperrormessages.pas +++ b/components/fpdebug/fperrormessages.pas @@ -26,9 +26,10 @@ resourcestring MsgfpErrCannotDereferenceType = 'Can not dereference Expression "%1:s"'; MsgfpErrTypeHasNoIndex = 'Not a type or Array. Cannot access indexed element on expression %1:s'; // 100 memreader error - MsgfpErrfpErrFailedReadMem = 'Failed to read data from target mem'; - MsgfpErrCanNotReadInvalidMem = 'Failed to read data from invalid location'; + MsgfpInternalErrfpErrFailedReadMem = 'Internal error: Failed to read data from memory'; + MsgfpInternalErrCanNotReadInvalidMem = 'Internal error: Missing data location'; MsgfpErrCanNotReadMemAtAddr = 'Failed to read Mem at Address $%1:x'; + MsgfpErrFailedReadRegiseter = 'Failed to read data from register'; // 200 LocationParser MsgfpErrLocationParser = 'Internal Error: Can not calculate location.'; MsgfpErrLocationParserMemRead = '%1:s (while calculating location)'; // Pass on nested error @@ -54,9 +55,10 @@ const fpErrTypeHasNoIndex = TFpErrorCode(30); // 100 memreader error - fpErrFailedReadMem = TFpErrorCode(100); - fpErrCanNotReadInvalidMem = TFpErrorCode(101); - fpErrCanNotReadMemAtAddr = TFpErrorCode(102); + fpInternalErrFailedReadMem = TFpErrorCode(100); + fpInternalErrCanNotReadInvalidMem = TFpErrorCode(101); + fpErrCanNotReadMemAtAddr = TFpErrorCode(102); + fpErrFailedReadRegister = TFpErrorCode(103); // 200 LocationParser fpErrLocationParser = TFpErrorCode(200); @@ -188,9 +190,10 @@ begin fpErrCannotDereferenceType: Result := MsgfpErrCannotDereferenceType; fpErrTypeHasNoIndex: Result := MsgfpErrTypeHasNoIndex; - fpErrCanNotReadInvalidMem: Result := MsgfpErrCanNotReadInvalidMem; - fpErrCanNotReadMemAtAddr: Result := MsgfpErrCanNotReadMemAtAddr; - fpErrFailedReadMem: Result := MsgfpErrfpErrFailedReadMem; + fpInternalErrCanNotReadInvalidMem: Result := MsgfpInternalErrCanNotReadInvalidMem; + fpInternalErrFailedReadMem: Result := MsgfpInternalErrfpErrFailedReadMem; + fpErrCanNotReadMemAtAddr: Result := MsgfpErrCanNotReadMemAtAddr; + fpErrFailedReadRegister: Result := MsgfpErrFailedReadRegiseter; fpErrLocationParser: Result := MsgfpErrLocationParser; fpErrLocationParserMemRead: Result := MsgfpErrLocationParserMemRead; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index cdd9790302..46928db626 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -659,11 +659,14 @@ begin Result := FValue.AsCardinal else if svfAddress in f then begin - if not FContext.MemManager.ReadUnsignedInt(FValue.Address, SizeVal(FContext.SizeOfAddress), Result) then + if not FContext.MemManager.ReadUnsignedInt(FValue.Address, SizeVal(FContext.SizeOfAddress), Result) then begin Result := 0; + SetLastError(FContext.MemManager.LastError); + end; end - else - Result := 0; + else begin + SetLastError(CreateError(fpErrAnyError, [''])); + end; end; function TFpPasParserValueCastToPointer.GetDataAddress: TFpDbgMemLocation; @@ -805,6 +808,10 @@ function TFpPasParserValueDerefPointer.GetAddress: TFpDbgMemLocation; begin Result := FValue.DataAddress; Result := Context.MemManager.ReadAddress(Result, SizeVal(Context.SizeOfAddress)); + if IsValidLoc(Result) then begin + SetLastError(Context.MemManager.LastError); + exit; + end; if FAddressOffset <> 0 then begin assert(IsTargetAddr(Result ), 'TFpPasParserValueDerefPointer.GetAddress: TargetLoc(Result)');