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

FpGdbmiDebugger:Restoring class auto typecast, accidentally removed in rev 44974 #89d29e376f

Browse Source 
git-svn-id: trunk@45006 -
This commit is contained in:
martin 2014-05-11 15:11:33 +00:00
parent b1eca5be27
commit cc4a591d5f
1 changed files with 30 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
components/lazdebuggers/lazdebuggerfpgdbmi/fpgdbmidebugger.pp
View File

@ -936,7 +936,7 @@ function TFpGDBMIDebugger.EvaluateExpression(AWatchValue: TWatchValue; AExpressi
out AResText: String; out ATypeInfo: TDBGType; EvalFlags: TDBGEvaluateFlags): Boolean;
var
Ctx: TFpDbgInfoContext;
PasExpr: TFpPascalExpression;
PasExpr, PasExpr2: TFpPascalExpression;
ResValue: TFpDbgValue;
s: String;
DispFormat: TWatchDisplayFormat;
@ -951,7 +951,10 @@ var
);
end;
var
CastName: String;
ClassAddr, CNameAddr: TFpDbgMemLocation;
NameLen: QWord;
begin
Result := False;
ATypeInfo := nil;
@ -1008,6 +1011,31 @@ DebugLn(FPGDBDBG_VERBOSE, [ErrorHandler.ErrorAsString(PasExpr.Error)]);
ResValue := PasExpr.ResultValue;
if (ResValue.Kind = skClass) and (ResValue.AsCardinal <> 0) and (defClassAutoCast in EvalFlags)
then begin
CastName := '';
if FMemManager.ReadAddress(ResValue.DataAddress, Ctx.SizeOfAddress, ClassAddr) then begin
ClassAddr.Address := ClassAddr.Address + 3 * Ctx.SizeOfAddress;
if FMemManager.ReadAddress(ClassAddr, Ctx.SizeOfAddress, CNameAddr) then begin
if (FMemManager.ReadUnsignedInt(CNameAddr, 1, NameLen)) then
if NameLen > 0 then begin
SetLength(CastName, NameLen);
CNameAddr.Address := CNameAddr.Address + 1;
FMemManager.ReadMemory(CNameAddr, NameLen, @CastName[1]);
PasExpr2 := TFpPascalExpression.Create(CastName+'('+AExpression+')', Ctx);
PasExpr2.ResultValue;
if PasExpr2.Valid then begin
PasExpr.Free;
PasExpr := PasExpr2;
ResValue := PasExpr.ResultValue;
end
else
PasExpr2.Free;
end;
end;
end;
end;
case ResValue.Kind of
skNone: begin
// maybe type