paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-25 03:51:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

Debugger, GDBMI: Fix displayformat for numeric values. (double conversion). Issue #39932

Browse Source
This commit is contained in:
Martin 2022-10-12 14:02:15 +02:00
parent 12ce5d9dbc
commit b5858164db
2 changed files with 86 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
components/lazdebuggergdbmi/gdbmidebugger.pp
View File

@ -518,6 +518,7 @@ type
function GetData(const AExpression: String; const AValues: array of const): TDbgPtr; overload; function GetData(const AExpression: String; const AValues: array of const): TDbgPtr; overload;
function GetStrValue(const AExpression: String; const AValues: array of const; AFlags: TGDBMICommandFlags = []): String; function GetStrValue(const AExpression: String; const AValues: array of const; AFlags: TGDBMICommandFlags = []): String;
function GetIntValue(const AExpression: String; const AValues: array of const): Integer; function GetIntValue(const AExpression: String; const AValues: array of const): Integer;
function GetPtrValue(const AResText: String): TDbgPtr; inline;
function GetPtrValue(const AExpression: String; function GetPtrValue(const AExpression: String;
const AValues: array of const; {%H-}ConvertNegative: Boolean = False; const AValues: array of const; {%H-}ConvertNegative: Boolean = False;
AFlags: TGDBMICommandFlags = []): TDbgPtr; AFlags: TGDBMICommandFlags = []): TDbgPtr;
@ -1473,6 +1474,8 @@ type
FDisplayFormat: TWatchDisplayFormat; FDisplayFormat: TWatchDisplayFormat;
FWatchValue: TWatchValueIntf; FWatchValue: TWatchValueIntf;
FTextValue: String; FTextValue: String;
FNumValue: TDBGPtr;
FHasNumValue: (nvNone, nvUnsigned, nvSigned);
FTypeInfo: TGDBType; FTypeInfo: TGDBType;
FValidity: TDebuggerDataState; FValidity: TDebuggerDataState;
FTypeInfoAutoDestroy: Boolean; FTypeInfoAutoDestroy: Boolean;
@ -12655,23 +12658,33 @@ begin
if e=0 then ; if e=0 then ;
end; end;
function TGDBMIDebuggerCommand.GetPtrValue(const AExpression: String; function TGDBMIDebuggerCommand.GetPtrValue(const AResText: String): TDbgPtr;
const AValues: array of const; ConvertNegative: Boolean;
AFlags: TGDBMICommandFlags): TDbgPtr;
var var
e: Integer; e: Integer;
i: Int64; i: Int64;
s: String;
begin begin
Result := 0; Result := 0;
s := GetStrValue(AExpression, AValues, [cfNoMemLimits]+AFlags); if (AResText <> '') and (AResText[1] = '-')
if (s <> '') and (s[1] = '-')
then begin then begin
Val(s, i, e); Val(AResText, i, e);
Result := TDBGPtr(i); Result := TDBGPtr(i);
end end
else Val(s, Result, e); else
if e=0 then ; Val(AResText, Result, e);
if (e<>0) and (FLastExecResult.State <> dsError) then begin
FLastExecResult.State := dsError;
FLastExecResult.Values := '';
end;
end;
function TGDBMIDebuggerCommand.GetPtrValue(const AExpression: String;
const AValues: array of const; ConvertNegative: Boolean;
AFlags: TGDBMICommandFlags): TDbgPtr;
begin
Result := GetPtrValue(
GetStrValue(AExpression, AValues, [cfNoMemLimits]+AFlags)
);
end; end;
function TGDBMIDebuggerCommand.CheckHasType(TypeName: String; function TGDBMIDebuggerCommand.CheckHasType(TypeName: String;
@ -14406,6 +14419,7 @@ var
var var
ResultList: TGDBMINameValueList; ResultList: TGDBMINameValueList;
begin begin
FHasNumValue := nvNone;
if (dcsCanceled in SeenStates) if (dcsCanceled in SeenStates)
then begin then begin
FTextValue := '<Canceled>'; FTextValue := '<Canceled>';
@ -14437,14 +14451,28 @@ var
else expr := QuoteExpr(AddAddressOfToExpression(expr, FTypeInfo)); else expr := QuoteExpr(AddAddressOfToExpression(expr, FTypeInfo));
end; end;
procedure GetNumValue(const AExpression: String);
var
s: String;
begin
s := GetStrValue(AExpression, [], [cfNoMemLimits]);
FHasNumValue := nvUnsigned;
if (s <> '') and (s[1] = '-') then
FHasNumValue := nvSigned;
FNumValue := GetPtrValue(s);
end;
var var
ResultList: TGDBMINameValueList; ResultList: TGDBMINameValueList;
R: TGDBMIExecResult; R: TGDBMIExecResult;
MemDump: TGDBMIMemoryDumpResultList; MemDump: TGDBMIMemoryDumpResultList;
i, Size: integer; i, Size: integer;
i64: Int64;
Error: word;
s: String; s: String;
begin begin
Result := False; Result := False;
FHasNumValue := nvNone;
case FDisplayFormat of case FDisplayFormat of
wdfStructure: wdfStructure:
@ -14495,7 +14523,8 @@ var
if not Result if not Result
then exit; then exit;
FValidity := ddsValid; FValidity := ddsValid;
FTextValue := IntToStr(Int64(GetPtrValue(AnExpression, [], True))); GetNumValue(AnExpression);
FTextValue := IntToStr(Int64(FNumValue));
if LastExecResult.State = dsError if LastExecResult.State = dsError
then ParseLastError; then ParseLastError;
end; end;
@ -14505,7 +14534,8 @@ var
if not Result if not Result
then exit; then exit;
FValidity := ddsValid; FValidity := ddsValid;
FTextValue := IntToStr(GetPtrValue(AnExpression, [], True)); GetNumValue(AnExpression);
FTextValue := IntToStr(FNumValue);
if LastExecResult.State = dsError if LastExecResult.State = dsError
then ParseLastError; then ParseLastError;
end; end;
@ -14523,8 +14553,9 @@ var
Result := PrepareExpr(AnExpression, True); Result := PrepareExpr(AnExpression, True);
if not Result if not Result
then exit; then exit;
FTextValue := IntToHex(GetPtrValue(AnExpression, [], True), 2);
FValidity := ddsValid; FValidity := ddsValid;
GetNumValue(AnExpression);
FTextValue := IntToHex(FNumValue, 2);
if length(FTextValue) mod 2 = 1 if length(FTextValue) mod 2 = 1
then FTextValue := '0'+FTextValue; // make it an even number of digets then FTextValue := '0'+FTextValue; // make it an even number of digets
if LastExecResult.State = dsError if LastExecResult.State = dsError
@ -14535,8 +14566,9 @@ var
Result := PrepareExpr(AnExpression, True); Result := PrepareExpr(AnExpression, True);
if not Result if not Result
then exit; then exit;
FTextValue := PascalizePointer('0x' + IntToHex(GetPtrValue(AnExpression, [], True), TargetInfo^.TargetPtrSize*2));
FValidity := ddsValid; FValidity := ddsValid;
GetNumValue(AnExpression);
FTextValue := PascalizePointer('0x' + IntToHex(FNumValue, TargetInfo^.TargetPtrSize*2));
if LastExecResult.State = dsError if LastExecResult.State = dsError
then FTextValue := '<error>'; then FTextValue := '<error>';
end; end;
@ -14574,7 +14606,8 @@ var
if not Result if not Result
then exit; then exit;
FValidity := ddsValid; FValidity := ddsValid;
FTextValue := Concat('0b' + BinStr(GetPtrValue(AnExpression, [], True), TargetInfo^.TargetPtrSize*2)); GetNumValue(AnExpression);
FTextValue := Concat('0b' + BinStr(FNumValue, TargetInfo^.TargetPtrSize*2));
if LastExecResult.State = dsError if LastExecResult.State = dsError
then ParseLastError; then ParseLastError;
end; end;
@ -14594,8 +14627,21 @@ var
end; end;
if FTypeInfo.HasExprEvaluatedAsText then begin if FTypeInfo.HasExprEvaluatedAsText then begin
FTextValue := FTypeInfo.ExprEvaluatedAsText; FTextValue := FTypeInfo.ExprEvaluatedAsText;
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
FValidity := ddsValid; FValidity := ddsValid;
if (FTextValue <> '') and (FTextValue[1] = '-') then begin
Val(FTextValue, i64, Error);
FNumValue := TDBGPtr(i64);
if Error = 0 then
FHasNumValue := nvSigned;
end
else begin
Val(FTextValue, FNumValue, Error);
if Error = 0 then
FHasNumValue := nvUnsigned;
end;
//FTextValue := DeleteEscapeChars(FTextValue); // TODO: move to FixUpResult / only if really needed
Result := True; Result := True;
FixUpResult(AnExpression, FTypeInfo); FixUpResult(AnExpression, FTypeInfo);
@ -14621,7 +14667,6 @@ var
S: String; S: String;
ResultList: TGDBMINameValueList; ResultList: TGDBMINameValueList;
frameidx: Integer; frameidx: Integer;
NumVal: QWord;
{$IFDEF DBG_WITH_GDB_WATCHES} R: TGDBMIExecResult; {$ENDIF} {$IFDEF DBG_WITH_GDB_WATCHES} R: TGDBMIExecResult; {$ENDIF}
begin begin
SelectContext; SelectContext;
@ -14683,35 +14728,30 @@ begin
if FWatchValue <> nil then begin if FWatchValue <> nil then begin
FWatchValue.BeginUpdate; FWatchValue.BeginUpdate;
repeat repeat
if (FTypeInfo <> nil) and (FTypeInfo.Kind in [skSimple, skPointer, skInteger, skCardinal]) and if (FHasNumValue <> nvNone) and
(FTypeInfo <> nil) and (FTypeInfo.Kind in [skSimple, skPointer, skInteger, skCardinal]) and
(FWatchValue.RepeatCount <= 0) (FWatchValue.RepeatCount <= 0)
then begin then begin
FTextValue := Trim(FTextValue);
if (FTypeInfo.Kind = skPointer) then begin if (FTypeInfo.Kind = skPointer) then begin
if TryStrToInt64(FTextValue, Int64(NumVal)) then begin FWatchValue.ResData.CreatePointerValue(FNumValue);
FWatchValue.ResData.CreatePointerValue(NumVal); FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName); FWatchValue.Validity := FValidity;
FWatchValue.Validity := FValidity; break;
break;
end;
end; end;
if (FTypeInfo.Kind = skInteger) or ((FTextValue <> '') and (FTextValue[1]='-')) then begin if (FHasNumValue = nvSigned) or
if TryStrToInt64(FTextValue, Int64(NumVal)) then begin ( (FTypeInfo.Kind = skInteger) and (FNumValue <= high(int64)) )
FWatchValue.ResData.CreateNumValue(NumVal, True); then begin
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName); FWatchValue.ResData.CreateNumValue(FNumValue, True);
FWatchValue.Validity := FValidity; FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
break; FWatchValue.Validity := FValidity;
end; break;
end end
else begin else begin
if TryStrToQWord(FTextValue, NumVal) then begin FWatchValue.ResData.CreateNumValue(FNumValue, False);
FWatchValue.ResData.CreateNumValue(NumVal, False); FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName);
FWatchValue.ResData.SetTypeName(FTypeInfo.TypeName); FWatchValue.Validity := FValidity;
FWatchValue.Validity := FValidity; break;
break;
end;
end; end;
end; end;

10
components/lazdebuggergdbmi/test/gdbmitestutils/testwatchutils.pas
View File

@ -7,7 +7,8 @@ interface
uses uses
Classes, SysUtils, RegExpr, TestBase, LazLoggerBase, DbgIntfBaseTypes, Classes, SysUtils, RegExpr, TestBase, LazLoggerBase, DbgIntfBaseTypes,
DbgIntfDebuggerBase, TestDbgConfig, TTestDebuggerClasses, IdeDebuggerBase, DbgIntfDebuggerBase, TestDbgConfig, TTestDebuggerClasses, IdeDebuggerBase,
IdeDebuggerWatchResult, LazDebuggerIntf, LazDebuggerIntfBaseTypes; IdeDebuggerWatchResult, IdeDebuggerWatchResPrinter, LazDebuggerIntf,
LazDebuggerIntfBaseTypes;
type type
@ -380,6 +381,7 @@ end;
var var
Frx: TRegExpr; Frx: TRegExpr;
TheWatchPrinter: TWatchResultPrinter;
{ TTestWatchesBase } { TTestWatchesBase }
@ -445,7 +447,7 @@ begin
if not TestTrue('Dbg did NOT enter dsError', ADbg.State <> dsError) then if not TestTrue('Dbg did NOT enter dsError', ADbg.State <> dsError) then
exit; exit;
s := PrintWatchValue(WV.ResultData, AWatch.DisplayFormat); s := TheWatchPrinter.PrintWatchValue(WV.ResultData, AWatch.DisplayFormat);
IsValid := WV.Validity = ddsValid; IsValid := WV.Validity = ddsValid;
HasTpInfo := IsValid and ( HasTpInfo := IsValid and (
(WV.TypeInfo <> nil) or (WV.TypeInfo <> nil) or
@ -638,8 +640,12 @@ begin
end; end;
initialization
TheWatchPrinter := TWatchResultPrinter.Create;
finalization finalization
FreeAndNil(Frx); FreeAndNil(Frx);
FreeAndNil(TheWatchPrinter);
end. end.