mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-03 02:10:03 +01:00
FpGDBMIDebug: Allow toggle to gdb results (run menu), to compare values during beta / remove old code in gdb cache/emulation
git-svn-id: trunk@44569 -
This commit is contained in:
martin
parent
160b1232b0
commit
50fe9876d5
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -2023,6 +2023,8 @@ components/lazdebuggerfp/test/TestApps/TestWatchesUnitSimple.pas svneol=native#t
|
|||||||
components/lazdebuggerfp/test/TestApps/TestWatchesUnitStruct.pas svneol=native#text/pascal
|
components/lazdebuggerfp/test/TestApps/TestWatchesUnitStruct.pas svneol=native#text/pascal
|
||||||
components/lazdebuggerfp/test/TestFpGdbmi.lpi svneol=native#text/pascal
|
components/lazdebuggerfp/test/TestFpGdbmi.lpi svneol=native#text/pascal
|
||||||
components/lazdebuggerfp/test/TestFpGdbmi.lpr svneol=native#text/pascal
|
components/lazdebuggerfp/test/TestFpGdbmi.lpr svneol=native#text/pascal
|
||||||
|
components/lazdebuggerfp/test/fpclist.txt.sample svneol=native#text/plain
|
||||||
|
components/lazdebuggerfp/test/gdblist.txt.sample svneol=native#text/plain
|
||||||
components/lazdebuggerfp/test/testwatches.pas svneol=native#text/pascal
|
components/lazdebuggerfp/test/testwatches.pas svneol=native#text/pascal
|
||||||
components/lazdebuggergdbmi/Makefile svneol=native#text/plain
|
components/lazdebuggergdbmi/Makefile svneol=native#text/plain
|
||||||
components/lazdebuggergdbmi/Makefile.compiled svneol=native#text/plain
|
components/lazdebuggergdbmi/Makefile.compiled svneol=native#text/plain
|
||||||
|
|||||||
@ -15,7 +15,7 @@ uses
|
|||||||
Classes, sysutils, math, FpdMemoryTools, FpDbgInfo, FpDbgClasses, GDBMIDebugger,
|
Classes, sysutils, math, FpdMemoryTools, FpDbgInfo, FpDbgClasses, GDBMIDebugger,
|
||||||
DbgIntfBaseTypes, DbgIntfDebuggerBase, GDBMIMiscClasses,
|
DbgIntfBaseTypes, DbgIntfDebuggerBase, GDBMIMiscClasses,
|
||||||
GDBTypeInfo, LCLProc, Forms, FpDbgLoader, FpDbgDwarf, LazLoggerBase,
|
GDBTypeInfo, LCLProc, Forms, FpDbgLoader, FpDbgDwarf, LazLoggerBase,
|
||||||
LazLoggerProfiling, LazClasses, FpPascalParser, FpPascalBuilder, FpErrorMessages;
|
LazLoggerProfiling, LazClasses, FpPascalParser, FpPascalBuilder, FpErrorMessages, MenuIntf;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -53,18 +53,6 @@ type
|
|||||||
procedure CloseProcess;
|
procedure CloseProcess;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TFpGDBPTypeRequestCache }
|
|
||||||
|
|
||||||
TFpGDBPTypeRequestCache = class(TGDBPTypeRequestCache)
|
|
||||||
private
|
|
||||||
FDebugger: TFpGDBMIDebugger;
|
|
||||||
FInIndexOf: Boolean;
|
|
||||||
public
|
|
||||||
constructor Create(ADebugger: TFpGDBMIDebugger);
|
|
||||||
function IndexOf(AThreadId, AStackFrame: Integer; ARequest: TGDBPTypeRequest): Integer; override;
|
|
||||||
property Debugger: TFpGDBMIDebugger read FDebugger;
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
const
|
||||||
MAX_CTX_CACHE = 10;
|
MAX_CTX_CACHE = 10;
|
||||||
|
|
||||||
@ -96,7 +84,6 @@ type
|
|||||||
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
|
procedure GetCurrentContext(out AThreadId, AStackFrame: Integer);
|
||||||
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
|
function GetLocationForContext(AThreadId, AStackFrame: Integer): TDBGPtr;
|
||||||
function GetInfoContextForContext(AThreadId, AStackFrame: Integer): TDbgInfoAddressContext;
|
function GetInfoContextForContext(AThreadId, AStackFrame: Integer): TDbgInfoAddressContext;
|
||||||
function CreateTypeRequestCache: TGDBPTypeRequestCache; override;
|
|
||||||
property CurrentCommand;
|
property CurrentCommand;
|
||||||
property TargetPID;
|
property TargetPID;
|
||||||
protected
|
protected
|
||||||
@ -181,6 +168,25 @@ type
|
|||||||
procedure Cancel(const ASource: String); override;
|
procedure Cancel(const ASource: String); override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
MenuCmd: TIDEMenuCommand;
|
||||||
|
CurrentDebugger: TFpGDBMIDebugger;
|
||||||
|
UseGDB: Boolean;
|
||||||
|
|
||||||
|
procedure IDEMenuClicked(Sender: TObject);
|
||||||
|
begin
|
||||||
|
UseGDB := (MenuCmd.MenuItem <> nil) and MenuCmd.MenuItem.Checked;
|
||||||
|
CurrentDebugger.Watches.CurrentWatches.ClearValues;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// This Accessor hack is temporarilly needed / the final version will not show gdb data
|
||||||
|
type TWatchValueHack = class(TWatchValue) end;
|
||||||
|
procedure MarkWatchValueAsGdb(AWatchValue: TWatchValue);
|
||||||
|
begin
|
||||||
|
AWatchValue.Value := '{GDB:}' + AWatchValue.Value;
|
||||||
|
TWatchValueHack(AWatchValue).DoDataValidityChanged(ddsRequested);
|
||||||
|
end;
|
||||||
|
|
||||||
{ TFpGDBMIDebuggerCommandEvaluate }
|
{ TFpGDBMIDebuggerCommandEvaluate }
|
||||||
|
|
||||||
function TFpGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
function TFpGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||||
@ -384,531 +390,6 @@ begin
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TFpGDBPTypeRequestCache }
|
|
||||||
|
|
||||||
constructor TFpGDBPTypeRequestCache.Create(ADebugger: TFpGDBMIDebugger);
|
|
||||||
begin
|
|
||||||
FDebugger := ADebugger;
|
|
||||||
FInIndexOf := False;
|
|
||||||
inherited Create;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TFpGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
|
|
||||||
ARequest: TGDBPTypeRequest): Integer;
|
|
||||||
const
|
|
||||||
GdbCmdPType = 'ptype ';
|
|
||||||
GdbCmdWhatIs = 'whatis ';
|
|
||||||
GdbCmdEval = '-data-evaluate-expression ';
|
|
||||||
|
|
||||||
procedure AddType(ASourceExpr: string; ATypeIdent: TFpDbgSymbol; AVal: TFpDbgValue = nil); forward;
|
|
||||||
|
|
||||||
procedure FindPointerAndBaseType(ASrcType: TFpDbgSymbol;
|
|
||||||
out APointerLevel: Integer; out ADeRefType, ABaseType: TFpDbgSymbol;
|
|
||||||
out ASrcTypeName, ADeRefTypeName, ABaseTypeName: String);
|
|
||||||
begin
|
|
||||||
APointerLevel := 0;
|
|
||||||
|
|
||||||
ADeRefType := nil;
|
|
||||||
ABaseType := ASrcType;
|
|
||||||
ASrcTypeName := ASrcType.Name;
|
|
||||||
ADeRefTypeName := '';
|
|
||||||
ABaseTypeName := ABaseType.Name;
|
|
||||||
|
|
||||||
while (ABaseType.Kind = skPointer) and (ABaseType.TypeInfo <> nil) do begin
|
|
||||||
ABaseType := ABaseType.TypeInfo;
|
|
||||||
inc(APointerLevel);
|
|
||||||
|
|
||||||
if ABaseType.Name <> '' then
|
|
||||||
begin
|
|
||||||
if ASrcTypeName = '' then
|
|
||||||
ASrcTypeName := '^' + ABaseType.Name;
|
|
||||||
if ADeRefTypeName = '' then begin
|
|
||||||
if APointerLevel = 1
|
|
||||||
then ADeRefTypeName := ABaseType.Name
|
|
||||||
else ADeRefTypeName := '^'+ ABaseType.Name;
|
|
||||||
end
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
ABaseTypeName := ABaseType.Name;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Function MembersAsGdbText(AStructType: TFpDbgSymbol; WithVisibilty: Boolean; out AText: String): Boolean;
|
|
||||||
var
|
|
||||||
CurVis: TDbgSymbolMemberVisibility;
|
|
||||||
|
|
||||||
procedure AddVisibility(AVis: TDbgSymbolMemberVisibility);
|
|
||||||
begin
|
|
||||||
CurVis := AVis;
|
|
||||||
if not WithVisibilty then
|
|
||||||
exit;
|
|
||||||
if AText <> '' then AText := AText + LineEnding;
|
|
||||||
case AVis of
|
|
||||||
svPrivate: AText := AText + ' private' + LineEnding;
|
|
||||||
svProtected: AText := AText + ' protected' + LineEnding;
|
|
||||||
svPublic: AText := AText + ' public' + LineEnding;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddMember(AMember: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
ti: TFpDbgSymbol;
|
|
||||||
s, s2: String;
|
|
||||||
begin
|
|
||||||
//todo: functions / virtual / array ...
|
|
||||||
s2 := '';
|
|
||||||
if AMember.Kind = skProcedure then begin
|
|
||||||
if sfVirtual in AMember.Flags then s2 := ' virtual;';
|
|
||||||
AText := AText + ' procedure ' + AMember.Name + ' ();' + s2 + LineEnding;
|
|
||||||
exit
|
|
||||||
end;
|
|
||||||
|
|
||||||
ti := AMember.TypeInfo;
|
|
||||||
if ti = nil then begin
|
|
||||||
Result := False;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
s := ti.Name;
|
|
||||||
if s = '' then begin
|
|
||||||
if not( (AMember.Kind = skSet) or (AMember.Kind = skEnum) or
|
|
||||||
(AMember.Kind = skArray) or (AMember.Kind = skPointer) or
|
|
||||||
(AMember.Kind = skRecord)
|
|
||||||
)
|
|
||||||
then begin
|
|
||||||
Result := False;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
if not GetTypeAsDeclaration(s, ti, [tdfSkipClassBody, tdfSkipRecordBody]) then begin
|
|
||||||
Result := False;
|
|
||||||
exit;
|
|
||||||
end
|
|
||||||
end;
|
|
||||||
|
|
||||||
if AMember.Kind = skFunction then begin
|
|
||||||
if sfVirtual in AMember.Flags then s2 := ' virtual;';
|
|
||||||
AText := AText + ' function ' + AMember.Name + ' () : '+s+';' + s2 + LineEnding;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
AText := AText + ' ' + AMember.Name + ' : ' + s + ';' + LineEnding;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
c: Integer;
|
|
||||||
i: Integer;
|
|
||||||
m: TFpDbgSymbol;
|
|
||||||
begin
|
|
||||||
Result := True;
|
|
||||||
AText := '';
|
|
||||||
c := AStructType.MemberCount;
|
|
||||||
if c = 0 then
|
|
||||||
exit;
|
|
||||||
i := 0;
|
|
||||||
m := AStructType.Member[i];
|
|
||||||
AddVisibility(m.MemberVisibility);
|
|
||||||
while true do begin
|
|
||||||
if m.MemberVisibility <> CurVis then
|
|
||||||
AddVisibility(m.MemberVisibility);
|
|
||||||
AddMember(m);
|
|
||||||
inc(i);
|
|
||||||
if (i >= c) or (not Result) then break;
|
|
||||||
m := AStructType.Member[i];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure MaybeAdd(AType: TGDBCommandRequestType; AQuery, AAnswer: String);
|
|
||||||
var
|
|
||||||
AReq: TGDBPTypeRequest;
|
|
||||||
begin
|
|
||||||
AReq.ReqType := AType;
|
|
||||||
AReq.Request := AQuery;
|
|
||||||
if inherited IndexOf(AThreadId, AStackFrame, AReq) < 0 then begin
|
|
||||||
if AType = gcrtPType then
|
|
||||||
AReq.Result := ParseTypeFromGdb(AAnswer)
|
|
||||||
else begin
|
|
||||||
AReq.Result.GdbDescription := AAnswer;
|
|
||||||
AReq.Result.Kind := ptprkSimple;
|
|
||||||
end;
|
|
||||||
Add(AThreadId, AStackFrame, AReq);
|
|
||||||
debugln(['**** AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame]);
|
|
||||||
//debugln(['**** AddToGDBMICache ', AReq.Request, ' T:', AThreadId, ' S:',AStackFrame, ' >>>> ', AAnswer, ' <<<<']);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddBaseType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s, s2, RefToken: String;
|
|
||||||
begin
|
|
||||||
if sfSubRange in ABaseType.Flags then begin
|
|
||||||
GetTypeAsDeclaration(s, ABaseType);
|
|
||||||
if APointerLevel > 0
|
|
||||||
then RefToken := '^'
|
|
||||||
else RefToken := '';
|
|
||||||
s2 := ASrcType.Name;
|
|
||||||
if s2 = '' then s2 := s;
|
|
||||||
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s%s', [RefToken, s]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s%s', [RefToken, s2]));
|
|
||||||
|
|
||||||
if APointerLevel > 0 then begin
|
|
||||||
if APointerLevel > 1
|
|
||||||
then RefToken := '^'
|
|
||||||
else RefToken := '';
|
|
||||||
if (ADeRefTypeName = '') or (ADeRefTypeName[1] = '^') then
|
|
||||||
ADeRefTypeName := RefToken + s;
|
|
||||||
|
|
||||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s%s', [RefToken, s]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s%s', [ADeRefTypeName]));
|
|
||||||
end;
|
|
||||||
|
|
||||||
exit; // subrange
|
|
||||||
end;
|
|
||||||
|
|
||||||
if APointerLevel > 0 then begin
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = ^%s', [ABaseTypeName]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ASrcTypeName]));
|
|
||||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr);
|
|
||||||
if APointerLevel > 1 then begin
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = ^%s', [ABaseTypeName]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ADeRefTypeName]));
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr + '^', Format('type = %s', [ABaseTypeName]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr + '^', Format('type = %s', [ABaseTypeName]));
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, Format('type = %s', [ABaseTypeName]));
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, Format('type = %s', [ABaseTypeName]));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddClassType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s, ParentName, RefToken: String;
|
|
||||||
s2: String;
|
|
||||||
begin
|
|
||||||
if APointerLevel = 0 then
|
|
||||||
ADeRefTypeName := ASrcTypeName;
|
|
||||||
if not MembersAsGdbText(ABaseType, True, s2) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if (ABaseType.TypeInfo <> nil) then begin
|
|
||||||
ParentName := ABaseType.TypeInfo.Name;
|
|
||||||
if ParentName <> '' then
|
|
||||||
ParentName := ' public ' + ParentName;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
ParentName := '';
|
|
||||||
|
|
||||||
s := Format('type = ^%s = class :%s %s%send%s', [ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
|
|
||||||
s := Format('type = %s%s', [ASrcTypeName, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
|
|
||||||
|
|
||||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
|
|
||||||
if APointerLevel > 0
|
|
||||||
then RefToken := '^'
|
|
||||||
else RefToken := '';
|
|
||||||
s := Format('type = %s%s = class :%s %s%send%s', [RefToken, ABaseTypeName, ParentName, LineEnding, s2, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
|
|
||||||
s := Format('type = %s%s', [ADeRefTypeName, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddRecordType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s, RefToken: String;
|
|
||||||
s2: String;
|
|
||||||
begin
|
|
||||||
if not MembersAsGdbText(ABaseType, False, s2) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
if APointerLevel > 0
|
|
||||||
then RefToken := '^'
|
|
||||||
else RefToken := '';
|
|
||||||
s := Format('type = %s%s = record %s%send%s', [RefToken, ABaseTypeName, LineEnding, s2, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
|
|
||||||
if APointerLevel > 0 then begin
|
|
||||||
s := Format('type = %s%s', [ASrcTypeName, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddEnumType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s, s2, RefToken: String;
|
|
||||||
begin
|
|
||||||
if APointerLevel > 0
|
|
||||||
then RefToken := '^'
|
|
||||||
else RefToken := '';
|
|
||||||
if GetTypeAsDeclaration(s2, ABaseType) then begin
|
|
||||||
s := Format('type = %s%s = %s%s', [RefToken, ABaseTypeName, s2, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
if APointerLevel > 0 then
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ASrcTypeName);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddSetType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s, s2, RefToken: String;
|
|
||||||
begin
|
|
||||||
case APointerLevel of
|
|
||||||
0: RefToken := '';
|
|
||||||
1: RefToken := '^';
|
|
||||||
else RefToken := '^^';
|
|
||||||
end;
|
|
||||||
|
|
||||||
if GetTypeAsDeclaration(s2, ABaseType) then begin
|
|
||||||
s := Format('type = %s%s%s', [RefToken, s2, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
if ASrcTypeName <> ''
|
|
||||||
then MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ASrcTypeName)
|
|
||||||
else MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddArrayType(ASourceExpr: string; APointerLevel: Integer;
|
|
||||||
ASrcTypeName, ADeRefTypeName, ABaseTypeName: String;
|
|
||||||
ASrcType, ABaseType: TFpDbgSymbol);
|
|
||||||
var
|
|
||||||
s: String;
|
|
||||||
ElemPointerLevel: Integer;
|
|
||||||
ElemDeRefType, ElemBaseType: TFpDbgSymbol;
|
|
||||||
ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName: String;
|
|
||||||
begin
|
|
||||||
if sfDynArray in ABaseType.Flags then begin
|
|
||||||
// dyn
|
|
||||||
if ABaseType.TypeInfo = nil then exit;
|
|
||||||
FindPointerAndBaseType(ABaseType.TypeInfo, ElemPointerLevel,
|
|
||||||
ElemDeRefType, ElemBaseType,
|
|
||||||
ElemSrcTypeName, ElemDeRefTypeName, ElemBaseTypeName);
|
|
||||||
|
|
||||||
s := ElemSrcTypeName;
|
|
||||||
if (s = '') then begin
|
|
||||||
if not GetTypeAsDeclaration(s, ABaseType.TypeInfo, [tdfDynArrayWithPointer]) then
|
|
||||||
exit;
|
|
||||||
s := Format('type = %s%s', [StringOfChar('^', APointerLevel), s]);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
s := Format('type = %s%s', ['^', s]); // ElemSrcTypeName already has ^, if it is pointer
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s + LineEnding);
|
|
||||||
|
|
||||||
s := ASrcTypeName;
|
|
||||||
if (s = '') then begin
|
|
||||||
if not GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then
|
|
||||||
exit;
|
|
||||||
s := Format('type = %s%s', [StringOfChar('^', APointerLevel), s]);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
s := Format('type = %s', [s]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s + LineEnding);
|
|
||||||
|
|
||||||
// deref
|
|
||||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
|
|
||||||
if APointerLevel = 0 then begin
|
|
||||||
if not GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then
|
|
||||||
exit;
|
|
||||||
if s[1] = '^' then begin
|
|
||||||
Delete(s,1,1);
|
|
||||||
if (s <> '') and (s[1] = '(') and (s[Length(s)] = ')') then begin
|
|
||||||
Delete(s,Length(s),1);
|
|
||||||
Delete(s,1,1);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
s := Format('type = %s%s', [s, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
|
|
||||||
AddType(ASourceExpr+'[0]', ABaseType.TypeInfo);
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
s := ElemSrcTypeName;
|
|
||||||
if (s = '') then begin
|
|
||||||
if not GetTypeAsDeclaration(s, ABaseType.TypeInfo, [tdfDynArrayWithPointer]) then
|
|
||||||
exit;
|
|
||||||
s := Format('type = %s%s', [StringOfChar('^', APointerLevel-1), s]);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
s := Format('type = ^%s', [s]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s + LineEnding);
|
|
||||||
end;
|
|
||||||
|
|
||||||
end
|
|
||||||
else begin
|
|
||||||
// stat
|
|
||||||
if GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then begin
|
|
||||||
s := Format('type = %s%s', [s, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
if ASrcTypeName <> ''
|
|
||||||
then MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ASrcTypeName)
|
|
||||||
else MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
end;
|
|
||||||
|
|
||||||
if APointerLevel = 0 then exit;
|
|
||||||
ASrcType := ASrcType.TypeInfo;
|
|
||||||
if GetTypeAsDeclaration(s, ASrcType, [tdfDynArrayWithPointer]) then begin
|
|
||||||
ASourceExpr := GDBMIMaybeApplyBracketsToExpr(ASourceExpr)+'^';
|
|
||||||
s := Format('type = %s%s', [s, LineEnding]);
|
|
||||||
MaybeAdd(gcrtPType, GdbCmdPType + ASourceExpr, s);
|
|
||||||
if ASrcTypeName <> ''
|
|
||||||
then MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, 'type = ' + ADeRefTypeName)
|
|
||||||
else MaybeAdd(gcrtPType, GdbCmdWhatIs + ASourceExpr, s);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure AddType(ASourceExpr: string; ATypeIdent: TFpDbgSymbol; AVal: TFpDbgValue = nil);
|
|
||||||
var
|
|
||||||
SrcTypeName, // The expressions own type name
|
|
||||||
DeRefTypeName, // one levvel of pointer followed
|
|
||||||
BaseTypeName: String; // all poiters followed
|
|
||||||
DeRefType, BaseType: TFpDbgSymbol;
|
|
||||||
PointerLevel: Integer;
|
|
||||||
s: String;
|
|
||||||
i: Integer;
|
|
||||||
begin
|
|
||||||
if (ASourceExpr = '') or (ATypeIdent = nil) then exit;
|
|
||||||
|
|
||||||
FindPointerAndBaseType(ATypeIdent, PointerLevel,
|
|
||||||
DeRefType, BaseType,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName);
|
|
||||||
|
|
||||||
case BaseType.Kind of
|
|
||||||
skInteger, skCardinal, skBoolean: begin
|
|
||||||
AddBaseType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skInteger) then
|
|
||||||
MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%d"', [AVal.AsInteger]))
|
|
||||||
else
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skCardinal) then
|
|
||||||
MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%u"', [AVal.AsCardinal]))
|
|
||||||
else
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skBoolean) then
|
|
||||||
MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%s"', [dbgs(AVal.AsBool)]))
|
|
||||||
else
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skPointer) then
|
|
||||||
MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%u"', [AVal.AsCardinal]))
|
|
||||||
;
|
|
||||||
end;
|
|
||||||
skChar, skFloat:
|
|
||||||
AddBaseType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
skClass:
|
|
||||||
AddClassType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
skRecord:
|
|
||||||
AddRecordType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
skEnum: begin
|
|
||||||
AddEnumType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skEnum) then
|
|
||||||
if AVal.AsString = ''
|
|
||||||
then MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%u"', [AVal.AsCardinal]))
|
|
||||||
else MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="%s"', [AVal.AsString]));
|
|
||||||
end;
|
|
||||||
skSet: begin
|
|
||||||
AddSetType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
if (AVal <> nil) and (ATypeIdent.Kind = skSet) then begin
|
|
||||||
s := '';
|
|
||||||
for i := 0 to AVal.MemberCount-1 do
|
|
||||||
if i = 0
|
|
||||||
then s := AVal.Member[i].AsString
|
|
||||||
else s := s + ', ' + AVal.Member[i].AsString;
|
|
||||||
MaybeAdd(gcrtEvalExpr, GdbCmdEval + ASourceExpr, Format(',value="[%s]"', [s]))
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
skArray:
|
|
||||||
AddArrayType(ASourceExpr, PointerLevel,
|
|
||||||
SrcTypeName, DeRefTypeName, BaseTypeName,
|
|
||||||
ATypeIdent, BaseType);
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
IdentName: String;
|
|
||||||
PasExpr: TFpPascalExpression;
|
|
||||||
rt: TFpDbgSymbol;
|
|
||||||
begin
|
|
||||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
|
||||||
DebugLn(['######## '+ARequest.Request, ' ## FOUND: ', dbgs(Result)]);
|
|
||||||
|
|
||||||
if (Result >= 0) or FInIndexOf or (not FDebugger.HasDwarf) then
|
|
||||||
exit;
|
|
||||||
|
|
||||||
FDebugger.FMemReader.FThreadId := AThreadId;
|
|
||||||
FDebugger.FMemReader.FStackFrame := AStackFrame;
|
|
||||||
FInIndexOf := True;
|
|
||||||
PasExpr := nil;
|
|
||||||
try
|
|
||||||
if (ARequest.ReqType = gcrtPType) and (length(ARequest.Request) > 0) then begin
|
|
||||||
case ARequest.Request[1] of
|
|
||||||
'p': if copy(ARequest.Request, 1, 6) = 'ptype ' then
|
|
||||||
IdentName := trim(copy(ARequest.Request, 7, length(ARequest.Request)));
|
|
||||||
'w': if copy(ARequest.Request, 1, 7) = 'whatis ' then
|
|
||||||
IdentName := trim(copy(ARequest.Request, 8, length(ARequest.Request)));
|
|
||||||
end;
|
|
||||||
|
|
||||||
if IdentName <> '' then begin
|
|
||||||
PasExpr := TFpPascalExpression.Create(IdentName, FDebugger.GetInfoContextForContext(AThreadId, AStackFrame));
|
|
||||||
rt := nil;
|
|
||||||
if PasExpr.Valid and (PasExpr.ResultValue <> nil) then begin
|
|
||||||
rt := PasExpr.ResultValue.DbgSymbol; // value or typecast
|
|
||||||
if rt <> nil then debugln(['@@@@@ ',rt.ClassName]);
|
|
||||||
DebugLn(['== VAL === ', PasExpr.ResultValue.AsInteger, ' / ', PasExpr.ResultValue.AsCardinal, ' / ', PasExpr.ResultValue.AsBool, ' / ', PasExpr.ResultValue.AsString, ' / ', PasExpr.ResultValue.MemberCount, ' / ', PasExpr.ResultValue.AsFloat]);
|
|
||||||
|
|
||||||
if (rt <> nil) and (rt is TDbgDwarfValueIdentifier) then begin
|
|
||||||
// symbol is value
|
|
||||||
rt := rt.TypeInfo;
|
|
||||||
AddType(IdentName, rt, PasExpr.ResultValue);
|
|
||||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
if rt <> nil then begin
|
|
||||||
// symbol is type
|
|
||||||
AddType(IdentName, rt, nil);
|
|
||||||
Result := inherited IndexOf(AThreadId, AStackFrame, ARequest);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else DebugLn(['NOT VALID ', PasExpr.DebugDump(True)])
|
|
||||||
;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
finally
|
|
||||||
PasExpr.Free;
|
|
||||||
FInIndexOf := False;
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
{ TFPGDBMIWatches }
|
{ TFPGDBMIWatches }
|
||||||
|
|
||||||
function TFPGDBMIWatches.FpDebugger: TFpGDBMIDebugger;
|
function TFPGDBMIWatches.FpDebugger: TFpGDBMIDebugger;
|
||||||
@ -942,13 +423,19 @@ begin
|
|||||||
try
|
try
|
||||||
WatchValue := TWatchValue(FpDebugger.FWatchEvalList[0]);
|
WatchValue := TWatchValue(FpDebugger.FWatchEvalList[0]);
|
||||||
ResTypeInfo := nil;
|
ResTypeInfo := nil;
|
||||||
|
if UseGDB then begin
|
||||||
|
inherited InternalRequestData(WatchValue);
|
||||||
|
if IsWatchValueAlive then
|
||||||
|
MarkWatchValueAsGdb(WatchValue);
|
||||||
|
end
|
||||||
|
else
|
||||||
if not FpDebugger.EvaluateExpression(WatchValue, WatchValue.Expression, ResText, ResTypeInfo)
|
if not FpDebugger.EvaluateExpression(WatchValue, WatchValue.Expression, ResText, ResTypeInfo)
|
||||||
then begin
|
then begin
|
||||||
if IsWatchValueAlive then debugln(['TFPGDBMIWatches.InternalRequestData FAILED ', WatchValue.Expression]);
|
if IsWatchValueAlive then debugln(['TFPGDBMIWatches.InternalRequestData FAILED ', WatchValue.Expression]);
|
||||||
if IsWatchValueAlive then
|
if IsWatchValueAlive then
|
||||||
inherited InternalRequestData(WatchValue);
|
inherited InternalRequestData(WatchValue);
|
||||||
if IsWatchValueAlive then
|
if IsWatchValueAlive then
|
||||||
WatchValue.Value := '{GDB:}'+WatchValue.Value;
|
MarkWatchValueAsGdb(WatchValue);
|
||||||
end;
|
end;
|
||||||
finally
|
finally
|
||||||
if IsWatchValueAlive then begin
|
if IsWatchValueAlive then begin
|
||||||
@ -1154,14 +641,19 @@ function TFpGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand;
|
|||||||
var
|
var
|
||||||
EvalFlags: TDBGEvaluateFlags;
|
EvalFlags: TDBGEvaluateFlags;
|
||||||
begin
|
begin
|
||||||
if HasDwarf and (ACommand = dcEvaluate) then begin
|
if (ACommand = dcEvaluate) then begin
|
||||||
EvalFlags := [];
|
EvalFlags := [];
|
||||||
EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger);
|
EvalFlags := TDBGEvaluateFlags(AParams[3].VInteger);
|
||||||
Result := EvaluateExpression(nil, String(AParams[0].VAnsiString),
|
Result := False;
|
||||||
String(AParams[1].VPointer^), TDBGType(AParams[2].VPointer^),
|
if (HasDwarf) and (not UseGDB) then begin
|
||||||
EvalFlags);
|
Result := EvaluateExpression(nil, String(AParams[0].VAnsiString),
|
||||||
if not Result then
|
String(AParams[1].VPointer^), TDBGType(AParams[2].VPointer^),
|
||||||
|
EvalFlags);
|
||||||
|
end;
|
||||||
|
if not Result then begin
|
||||||
Result := inherited RequestCommand(ACommand, AParams);
|
Result := inherited RequestCommand(ACommand, AParams);
|
||||||
|
String(AParams[1].VPointer^) := '{GDB:}'+String(AParams[1].VPointer^);
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
Result := inherited RequestCommand(ACommand, AParams);
|
Result := inherited RequestCommand(ACommand, AParams);
|
||||||
@ -1295,11 +787,6 @@ type
|
|||||||
property InformationEntry;
|
property InformationEntry;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TFpGDBMIDebugger.CreateTypeRequestCache: TGDBPTypeRequestCache;
|
|
||||||
begin
|
|
||||||
Result := TFpGDBPTypeRequestCache.Create(Self);
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TFpGDBMIDebugger.DoWatchFreed(Sender: TObject);
|
procedure TFpGDBMIDebugger.DoWatchFreed(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
FWatchEvalList.Remove(pointer(Sender));
|
FWatchEvalList.Remove(pointer(Sender));
|
||||||
@ -1597,10 +1084,12 @@ constructor TFpGDBMIDebugger.Create(const AExternalDebugger: String);
|
|||||||
begin
|
begin
|
||||||
FWatchEvalList := TList.Create;
|
FWatchEvalList := TList.Create;
|
||||||
inherited Create(AExternalDebugger);
|
inherited Create(AExternalDebugger);
|
||||||
|
CurrentDebugger := self;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TFpGDBMIDebugger.Destroy;
|
destructor TFpGDBMIDebugger.Destroy;
|
||||||
begin
|
begin
|
||||||
|
CurrentDebugger := nil;
|
||||||
UnLoadDwarf;
|
UnLoadDwarf;
|
||||||
FWatchEvalList.Free;
|
FWatchEvalList.Free;
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
@ -1609,6 +1098,12 @@ end;
|
|||||||
procedure Register;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
RegisterDebugger(TFpGDBMIDebugger);
|
RegisterDebugger(TFpGDBMIDebugger);
|
||||||
|
|
||||||
|
MenuCmd := RegisterIDEMenuCommand(itmRunDebugging, 'fpGdbmiToggleGDB', 'Display GDB instead of FpDebug Watches', nil,
|
||||||
|
@IDEMenuClicked);
|
||||||
|
MenuCmd.AutoCheck := True;
|
||||||
|
MenuCmd.Checked := False;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|||||||
21
components/lazdebuggerfp/test/fpclist.txt.sample
Normal file
21
components/lazdebuggerfp/test/fpclist.txt.sample
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
//This is a sample config for the test
|
||||||
|
//
|
||||||
|
//This file contains the list of all fpc that should be tested
|
||||||
|
//Entries start with a line in [] brackets, giving a name that is
|
||||||
|
//displayed by the test.
|
||||||
|
//There must be an entry starting with exe=
|
||||||
|
//The symbols= line specifies, with which debug info this fpc should be tested.
|
||||||
|
|
||||||
|
[fpc 2.6.2]
|
||||||
|
exe=C:\lazarus\fpc\2.6.2\bin\i386-win32\fpc.exe
|
||||||
|
symbols=gw,gwset
|
||||||
|
|
||||||
|
[fpc 2.6.2 external linker]
|
||||||
|
exe=C:\lazarus\fpc\2.6.2\bin\i386-win32\fpc.exe
|
||||||
|
symbols=gw,gwset
|
||||||
|
opts=-Xe
|
||||||
|
|
||||||
|
//[fpc trunk]
|
||||||
|
//exe=c:\FPC\trunk\bin\i386-win32\fpc.exe
|
||||||
|
//symbols=gw,gwset
|
||||||
|
|
||||||
19
components/lazdebuggerfp/test/gdblist.txt.sample
Normal file
19
components/lazdebuggerfp/test/gdblist.txt.sample
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
//This is a sample config for the test
|
||||||
|
//
|
||||||
|
//This file contains the list of all gdb that should be tested
|
||||||
|
//Entries start with a line in [] brackets, giving a name that is
|
||||||
|
//displayed by the test.
|
||||||
|
//There must be an entry starting with exe=
|
||||||
|
//The version is specified as one integer, made up from 3 pairs of 2 digits.
|
||||||
|
//The symbols= line specifies, with which debug info this gdb should be tested.
|
||||||
|
|
||||||
|
//[gdb 7.0]
|
||||||
|
//exe=C:\GDB\7.0\gdb.exe
|
||||||
|
//version=070000
|
||||||
|
//symbols=gw,gwset
|
||||||
|
|
||||||
|
[gdb 7.2.1 from installer]
|
||||||
|
exe=C:\lazarus\mingw\i386-win32\bin\gdb.exe
|
||||||
|
version=070201
|
||||||
|
symbols=gw,gwset
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user