paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-06 21:47:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: fix data address with "Ref" / tests

Browse Source 
git-svn-id: trunk@44501 -
This commit is contained in:
martin 2014-03-23 21:22:15 +00:00
parent 3f36dd3c53
commit 7dff9e1f43
3 changed files with 46 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
components/fpdebug/fpdbgdwarf.pas
View File

@ -595,7 +595,7 @@ type
TFpDbgDwarfValue = class(TFpDbgValue)
private
FOwner: TDbgDwarfIdentifier; // the creator, usually the type
FOwner: TDbgDwarfTypeIdentifier; // the creator, usually the type
FValueSymbol: TDbgDwarfValueIdentifier;
FTypeCastTargetType: TDbgDwarfTypeIdentifier;
FTypeCastSourceValue: TFpDbgValue;
@ -635,7 +635,7 @@ type
function GetTypeInfo: TFpDbgSymbol; override;
function GetContextTypeInfo: TFpDbgSymbol; override;
public
constructor Create(AOwner: TDbgDwarfIdentifier);
constructor Create(AOwner: TDbgDwarfTypeIdentifier);
destructor Destroy; override;
procedure SetValueSymbol(AValueSymbol: TDbgDwarfValueIdentifier);
function SetTypeCastInfo(AStructure: TDbgDwarfTypeIdentifier;
@ -656,7 +656,7 @@ type
function GetFieldFlags: TFpDbgValueFieldFlags; override;
function GetSize: Integer; override;
public
constructor Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
constructor Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer);
end;
{ TFpDbgDwarfValueNumeric }
@ -669,7 +669,7 @@ type
function GetFieldFlags: TFpDbgValueFieldFlags; override; // svfOrdinal
function IsValidTypeCast: Boolean; override;
public
constructor Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
constructor Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer);
end;
{ TFpDbgDwarfValueInteger }
@ -756,11 +756,15 @@ type
{ TFpDbgDwarfValueEnumMember }
TFpDbgDwarfValueEnumMember = class(TFpDbgDwarfValue)
private
FOwnerVal: TDbgDwarfValueIdentifier;
protected
function GetFieldFlags: TFpDbgValueFieldFlags; override;
function GetAsCardinal: QWord; override;
function GetAsString: AnsiString; override;
function IsValidTypeCast: Boolean; override;
public
constructor Create(AOwner: TDbgDwarfValueIdentifier);
end;
{ TFpDbgDwarfValueConstNumber }
@ -1043,6 +1047,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
protected
procedure TypeInfoNeeded; override;
procedure ForwardToSymbolNeeded; override;
function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override;
end;
{ TDbgDwarfTypeIdentifierRef }
@ -1062,7 +1067,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
// typedef > pointer > srtuct
// while a pointer to class/object: pointer > typedef > ....
function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier; override;
function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override;
end;
{ TDbgDwarfIdentifierSubRange }
@ -1085,7 +1089,6 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
procedure InitEnumIdx;
procedure ReadBounds;
protected
function GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue; override;
function DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;override;
function GetHasBounds: Boolean; override;
function GetOrdHighBound: Int64; override;
@ -2237,7 +2240,7 @@ begin
Result := FSize;
end;
constructor TFpDbgDwarfValueSized.Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
constructor TFpDbgDwarfValueSized.Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer);
begin
inherited Create(AOwner);
FSize := ASize;
@ -2253,12 +2256,12 @@ end;
function TFpDbgDwarfValueEnumMember.GetAsCardinal: QWord;
begin
Result := FOwner.OrdinalValue;
Result := FOwnerVal.OrdinalValue;
end;
function TFpDbgDwarfValueEnumMember.GetAsString: AnsiString;
begin
Result := FOwner.Name;
Result := FOwnerVal.Name;
end;
function TFpDbgDwarfValueEnumMember.IsValidTypeCast: Boolean;
@ -2267,6 +2270,12 @@ begin
Result := False;
end;
constructor TFpDbgDwarfValueEnumMember.Create(AOwner: TDbgDwarfValueIdentifier);
begin
FOwnerVal := AOwner;
inherited Create(nil);
end;
{ TDbgDwarfEnumSymbolValue }
procedure TFpDbgDwarfValueEnum.InitMemberIndex;
@ -2797,7 +2806,7 @@ begin
Result := False;
end;
constructor TFpDbgDwarfValueNumeric.Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
constructor TFpDbgDwarfValueNumeric.Create(AOwner: TDbgDwarfTypeIdentifier; ASize: Integer);
begin
inherited Create(AOwner, ASize);
FEvaluated := [];
@ -2858,8 +2867,10 @@ end;
function TFpDbgDwarfValue.DataAddr: TFpDbgMemLocation;
begin
// GetDwarfDataAddress(???); What about FTypeCastSourceValue.AsCardinal ?
if FValueSymbol <> nil then begin
FValueSymbol.GetValueAddress(Self, Result);
//FValueSymbol.GetValueAddress(Self, Result);
FValueSymbol.GetValueDataAddress(Self, Result, FOwner);
if IsError(FValueSymbol.LastError) then
FLastError := FValueSymbol.LastError;
end
@ -2868,6 +2879,13 @@ begin
Result := FTypeCastSourceValue.Address;
if IsError(FTypeCastSourceValue.LastError) then
FLastError := FTypeCastSourceValue.LastError;
if IsReadableLoc(Result) then begin
if not FTypeCastTargetType.GetDataAddress(Self, Result, FOwner, 1) then
Result := InvalidLoc;
if IsError(FTypeCastTargetType.LastError) then
FLastError := FTypeCastTargetType.LastError;
end;
end
else
Result := InvalidLoc;
@ -3093,7 +3111,7 @@ begin
Result := nil; // internal error
end;
constructor TFpDbgDwarfValue.Create(AOwner: TDbgDwarfIdentifier);
constructor TFpDbgDwarfValue.Create(AOwner: TDbgDwarfTypeIdentifier);
begin
FOwner := AOwner;
inherited Create;
@ -5252,17 +5270,6 @@ begin
end;
end;
function TDbgDwarfIdentifierSubRange.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue;
var
t: TDbgDwarfTypeIdentifier;
begin
t := NestedTypeInfo;
if t <> nil then
Result := t.GetTypedValueObject(ATypeCast)
else
Result := inherited GetTypedValueObject(ATypeCast);
end;
function TDbgDwarfIdentifierSubRange.DoGetNestedTypeInfo: TDbgDwarfTypeIdentifier;
begin
Result := inherited DoGetNestedTypeInfo;
@ -5751,17 +5758,6 @@ begin
end;
end;
function TDbgDwarfTypeIdentifierDeclaration.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue;
var
ti: TDbgDwarfTypeIdentifier;
begin
ti := NestedTypeInfo;
if ti <> nil then
Result := ti.GetTypedValueObject(ATypeCast)
else
Result := inherited;
end;
{ TDbgDwarfValueIdentifier }
procedure TDbgDwarfValueIdentifier.SetStructureValueInfo(AValue: TDbgDwarfIdentifier);
@ -6403,6 +6399,17 @@ begin
SetForwardToSymbol(NestedTypeInfo)
end;
function TDbgDwarfTypeIdentifierModifier.GetTypedValueObject(ATypeCast: Boolean): TFpDbgDwarfValue;
var
ti: TDbgDwarfTypeIdentifier;
begin
ti := NestedTypeInfo;
if ti <> nil then
Result := ti.GetTypedValueObject(ATypeCast)
else
Result := inherited;
end;
{ TDbgDwarfBaseTypeIdentifier }
procedure TDbgDwarfBaseIdentifierBase.KindNeeded;
@ -6722,7 +6729,7 @@ begin
if ti <> nil then
Result := ti.GetDataAddress(AValueObj, AnAddress, ATargetType, ATargetCacheIndex+1)
else
Result := False; // Result := ATargetType = nil; // end of type chain
Result := ATargetType = nil; // end of type chain
end;
end;

4
components/fpdebug/test/testtypeinfo.pas
View File

@ -550,6 +550,7 @@ begin
ImgLoader := TTestLoaderSetup1(FImageLoader);
FMemReader.RegisterValues[5] := TDbgPtr(@ImgLoader.TestStackFrame.EndPoint);
Obj1c := nil;
obj1 := TTestSetup1Class.Create;
ImgLoader.TestStackFrame.Int1 := -299;
ImgLoader.TestStackFrame.Obj1 := obj1;
@ -897,7 +898,7 @@ begin
4: s := 'VParamTestSetup1Record';
5: s := 'VParamTestRecord^';
6: s := 'TTestSetup1Record(Rec1)';
7: s := 'TTestSetup1Record2(Rec1)'; // TTestSetup1Record2 is a sdistinct type, but same sive (actually identical)
7: s := 'TTestSetup1Record2(Rec1)'; // TTestSetup1Record2 is a distinct type, but same sive (actually identical)
end;
StartTest(s, skRecord, [ttHasType]);
@ -1111,6 +1112,7 @@ begin
ExpFlags([svfCardinal, svfOrdinal, svfAddress]); // svfSize; //
finally
obj1.Free;
Obj1c.Free;
end;
end;

2
components/lazdebuggerfp/fpgdbmidebugger.pp
View File

@ -1525,7 +1525,7 @@ DebugLn(ErrorHandler.ErrorAsString(PasExpr.Error));
ResValue := PasExpr.ResultValue;
case PasExpr.ResultValue.Kind of
case ResValue.Kind of
skUnit: ;
skProcedure: ;
skFunction: ;