mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 15:56:08 +02:00
dbg: start fallback location detection
git-svn-id: trunk@41870 -
This commit is contained in:
martin
parent
f79f60fda0
commit
d8a0270a7a
@ -231,7 +231,8 @@ type
|
||||
dltProject,
|
||||
dltPackage
|
||||
);
|
||||
TDebuggerLocationFlag = (dlfLoadError // resolved but failed to load
|
||||
TDebuggerLocationFlag = (dlfLoadError, // resolved but failed to load
|
||||
dlfSearchByFunctionName
|
||||
);
|
||||
TDebuggerLocationFlags = set of TDebuggerLocationFlag;
|
||||
|
||||
@ -239,10 +240,13 @@ type
|
||||
|
||||
TDebuggerUnitInfo = class(TRefCountedObject)
|
||||
private
|
||||
FSrcClassName: String;
|
||||
FFileName, FDbgFullName: String;
|
||||
FFlags: TDebuggerLocationFlags;
|
||||
FFunctionName: String;
|
||||
FLocationName, FLocationOwnerName, FLocationFullFile: String;
|
||||
FLocationType: TDebuggerLocationType;
|
||||
FUnitName: String;
|
||||
function GetFileName: String;
|
||||
function GetDbgFullName: String;
|
||||
function GetLocationFullFile: String;
|
||||
@ -253,8 +257,10 @@ type
|
||||
procedure SetLocationType(AValue: TDebuggerLocationType);
|
||||
public
|
||||
constructor Create(const AFileName: String; const AFullFileName: String);
|
||||
constructor Create(const AUnitName, AClassName, AFunctionName: String);
|
||||
function DebugText: String;
|
||||
function IsEqual(const AFileName: String; const AFullFileName: String): boolean;
|
||||
function IsEqual(const AUnitName, AClassName, AFunctionName: String): boolean;
|
||||
function IsEqual(AnOther: TDebuggerUnitInfo): boolean;
|
||||
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig;
|
||||
const APath: string); virtual;
|
||||
@ -267,6 +273,9 @@ type
|
||||
property LocationName: String read GetLocationName;
|
||||
property LocationFullFile: String read GetLocationFullFile write SetLocationFullFile;
|
||||
property Flags: TDebuggerLocationFlags read FFlags write FFlags;
|
||||
property UnitName: String read FUnitName;
|
||||
property SrcClassName: String read FSrcClassName;
|
||||
property FunctionName: String read FFunctionName;
|
||||
end;
|
||||
|
||||
{ TDebuggerUnitInfoList }
|
||||
@ -291,6 +300,7 @@ type
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function GetUnitInfoFor(const AFileName: String; const AFullFileName: String): TDebuggerUnitInfo;
|
||||
function GetUnitInfoByFunction(const AUnitName, AClassName, AFunctionName: String): TDebuggerUnitInfo;
|
||||
function IndexOf(AnInfo: TDebuggerUnitInfo; AddIfNotExists: Boolean = False): Integer;
|
||||
function Count: integer;
|
||||
property Items[Index: Integer]: TDebuggerUnitInfo read GetInfo; default;
|
||||
@ -3382,9 +3392,11 @@ var
|
||||
begin
|
||||
i := FList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
if FList[i].IsEqual(AFileName, AFullFileName) then begin
|
||||
if (not(dlfSearchByFunctionName in FList[i].Flags)) and
|
||||
FList[i].IsEqual(AFileName, AFullFileName)
|
||||
then begin
|
||||
debugln(DBG_LOCATION_INFO, ['TDebuggerLocationProvider.GetLocationInfoFor Found entry for: ', AFileName, ' / ', AFullFileName]);
|
||||
exit(FList[i])
|
||||
exit(FList[i]);
|
||||
end;
|
||||
dec(i);
|
||||
end;
|
||||
@ -3393,6 +3405,26 @@ begin
|
||||
debugln(DBG_LOCATION_INFO, ['TDebuggerLocationProvider.GetLocationInfoFor Created new entry (Cnt=',FList.Count,') for: ', AFileName, ' / ', AFullFileName]);
|
||||
end;
|
||||
|
||||
function TDebuggerUnitInfoProvider.GetUnitInfoByFunction(const AUnitName,
|
||||
AClassName, AFunctionName: String): TDebuggerUnitInfo;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i := FList.Count - 1;
|
||||
while i >= 0 do begin
|
||||
if (dlfSearchByFunctionName in FList[i].Flags) and
|
||||
FList[i].IsEqual(AUnitName, AClassName, AFunctionName)
|
||||
then begin
|
||||
debugln(DBG_LOCATION_INFO, ['TDebuggerLocationProvider.GetLocationInfoFor Found entry for: ', AUnitName, ' / ', AClassName, ' / ', AFunctionName]);
|
||||
exit(FList[i]);
|
||||
end;
|
||||
dec(i);
|
||||
end;
|
||||
Result := TDebuggerUnitInfo.Create(AUnitName, AClassName, AFunctionName);
|
||||
FList.Add(Result);
|
||||
debugln(DBG_LOCATION_INFO, ['TDebuggerLocationProvider.GetLocationInfoFor Created new entry (Cnt=',FList.Count,') for: ', AUnitName, ' / ', AClassName, ' / ', AFunctionName]);
|
||||
end;
|
||||
|
||||
function TDebuggerUnitInfoProvider.IndexOf(AnInfo: TDebuggerUnitInfo;
|
||||
AddIfNotExists: Boolean): Integer;
|
||||
begin
|
||||
@ -3497,6 +3529,16 @@ begin
|
||||
FLocationType := dltUnknown;
|
||||
end;
|
||||
|
||||
constructor TDebuggerUnitInfo.Create(const AUnitName, AClassName,
|
||||
AFunctionName: String);
|
||||
begin
|
||||
include(FFlags, dlfSearchByFunctionName);
|
||||
FUnitName := AUnitName;
|
||||
FSrcClassName := AClassName;
|
||||
FFunctionName := AFunctionName;
|
||||
FLocationType := dltUnknown;
|
||||
end;
|
||||
|
||||
function TDebuggerUnitInfo.DebugText: String;
|
||||
var s: String;
|
||||
begin
|
||||
@ -3504,6 +3546,9 @@ begin
|
||||
Result
|
||||
:= ' FileName="'+FFileName+'" '
|
||||
+ 'DbgFullName="' + FDbgFullName+'" '
|
||||
+ 'UnitName="' + FUnitName+'" '
|
||||
+ 'ClassName="' + FSrcClassName+'" '
|
||||
+ 'FunctionName="' + FFunctionName+'" '
|
||||
+ 'Flags="' + dbgs(FFlags)+'" '
|
||||
+ 'LocationName="' + FLocationName+'" '
|
||||
+ 'LocationOwnerName="' + FLocationOwnerName+'" '
|
||||
@ -3518,6 +3563,14 @@ begin
|
||||
(FDbgFullName = AFullFileName);
|
||||
end;
|
||||
|
||||
function TDebuggerUnitInfo.IsEqual(const AUnitName, AClassName,
|
||||
AFunctionName: String): boolean;
|
||||
begin
|
||||
Result := (FUnitName = AUnitName) and
|
||||
(FSrcClassName = AClassName) and
|
||||
(FFunctionName = AFunctionName);
|
||||
end;
|
||||
|
||||
function TDebuggerUnitInfo.IsEqual(AnOther: TDebuggerUnitInfo): boolean;
|
||||
begin
|
||||
Result := (FFileName = AnOther.FFileName);
|
||||
@ -3545,11 +3598,18 @@ begin
|
||||
FLocationType := dltUnknown;
|
||||
end;
|
||||
|
||||
if AConfig.GetValue(APath + 'ByFunction', False) then
|
||||
include(FFlags, dlfSearchByFunctionName)
|
||||
else
|
||||
exclude(FFlags, dlfSearchByFunctionName);
|
||||
FFileName := AConfig.GetValue(APath + 'File', '');
|
||||
FLocationOwnerName := AConfig.GetValue(APath + 'UnitOwner', '');
|
||||
FLocationName := AConfig.GetValue(APath + 'UnitFile', '');
|
||||
FDbgFullName := AConfig.GetValue(APath + 'DbgFile', '');
|
||||
FLocationFullFile := '';
|
||||
FUnitName := AConfig.GetValue(APath + 'UnitName', '');
|
||||
FSrcClassName := AConfig.GetValue(APath + 'SrcClassName', '');
|
||||
FFunctionName := AConfig.GetValue(APath + 'FunctionName', '');
|
||||
end;
|
||||
|
||||
procedure TDebuggerUnitInfo.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
||||
@ -3560,10 +3620,14 @@ begin
|
||||
WriteStr(s{%H-}, LocationType);
|
||||
AConfig.SetValue(APath + 'Type', s);
|
||||
AConfig.SetValue(APath + 'File', FileName);
|
||||
AConfig.SetDeleteValue(APath + 'ByFunction', dlfSearchByFunctionName in FFlags, False);
|
||||
|
||||
AConfig.SetValue(APath + 'UnitOwner', LocationOwnerName);
|
||||
AConfig.SetValue(APath + 'UnitFile', LocationName);
|
||||
AConfig.SetValue(APath + 'DbgFile', FDbgFullName);
|
||||
AConfig.SetDeleteValue(APath + 'UnitName', FUnitName, '');
|
||||
AConfig.SetDeleteValue(APath + 'SrcClassName', FSrcClassName, '');
|
||||
AConfig.SetDeleteValue(APath + 'FunctionName', FFunctionName, '');
|
||||
end;
|
||||
|
||||
{ TSnapshotList }
|
||||
|
||||
@ -39,7 +39,7 @@ unit GDBMIDebugger;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Controls, Math, Variants, LCLProc, LazClasses, LazLoggerBase, Dialogs,
|
||||
Classes, SysUtils, strutils, Controls, Math, Variants, LCLProc, LazClasses, LazLoggerBase, Dialogs,
|
||||
DebugUtils, Debugger, FileUtil, CmdLineDebugger, GDBTypeInfo, Maps, LCLIntf, Forms,
|
||||
{$IFdef MSWindows}
|
||||
Windows,
|
||||
@ -6121,12 +6121,13 @@ var
|
||||
|
||||
procedure UpdateEntry(AnEntry: TCallStackEntry; AArgInfo, AFrameInfo : TGDBMINameValueList);
|
||||
var
|
||||
n, e: Integer;
|
||||
i, j, n, e: Integer;
|
||||
Arguments: TStringList;
|
||||
List: TGDBMINameValueList;
|
||||
Arg: PGDBMINameValue;
|
||||
addr: TDbgPtr;
|
||||
func, filename, fullname, line : String;
|
||||
func, filename, fullname, line, cl, fn, un: String;
|
||||
loc: TDebuggerUnitInfo;
|
||||
begin
|
||||
Arguments := TStringList.Create;
|
||||
|
||||
@ -6157,11 +6158,68 @@ var
|
||||
line := AFrameInfo.Values['line'];
|
||||
end;
|
||||
|
||||
(*
|
||||
func="fpc_pushexceptaddr"
|
||||
func="_$CODETEMPLATESDLG$_Ld98"
|
||||
func="_$CODETEMPLATESDLG$_Ld98"
|
||||
func="??"
|
||||
*)
|
||||
|
||||
j := pos('$', func);
|
||||
if j > 1 then begin
|
||||
un := '';
|
||||
cl := '';
|
||||
i := pos('_$__', func);
|
||||
if i > 1 then begin
|
||||
// CLASSES$_$TREADER_$__$$_READINTEGER$$LONGINT
|
||||
// SYSTEM_TOBJECT_$__DISPATCH$formal
|
||||
cl := copy(func, 1, i - 1); // unit and class
|
||||
|
||||
if copy(func, i + 4, 3) = '$$_' then
|
||||
inc(i, 3);
|
||||
j := PosEx('$', func, i + 4);
|
||||
if j > 0
|
||||
then j := j - (i + 4)
|
||||
else j := MaxInt;
|
||||
fn := copy(func, i + 4, j); // function
|
||||
|
||||
i := pos('$_$', cl);
|
||||
if i > 1 then begin
|
||||
un := copy(cl, 1, i - 1); // unit
|
||||
delete(cl, 1, i + 2); // class
|
||||
end
|
||||
else begin
|
||||
i := pos('_', cl);
|
||||
if posex('_', cl, i + 1) < 1 then begin
|
||||
// Only one _ => split unit and class
|
||||
un := copy(cl, 1, i - 1); // unit
|
||||
delete(cl, 1, i); // class
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
// SYSUTILS_COMPARETEXT$ANSISTRING$ANSISTRING$$LONGINT
|
||||
fn := copy(func, 1, j - 1);
|
||||
i := pos('_', fn);
|
||||
if posex('_', fn, i + 1) < 1 then begin
|
||||
// Only one _ => split unit and class
|
||||
un := copy(fn, 1, i - 1); // unit
|
||||
delete(fn, 1, i); // class
|
||||
end;
|
||||
end;
|
||||
|
||||
//debugln([cl,' ## ', fn]);
|
||||
loc := FTheDebugger.UnitInfoProvider.GetUnitInfoByFunction(un, cl, fn);
|
||||
end
|
||||
else begin
|
||||
loc := FTheDebugger.UnitInfoProvider.GetUnitInfoFor(filename, fullname);
|
||||
end;
|
||||
|
||||
AnEntry.Init(
|
||||
addr,
|
||||
Arguments,
|
||||
func,
|
||||
FTheDebugger.UnitInfoProvider.GetUnitInfoFor(filename, fullname),
|
||||
loc,
|
||||
StrToIntDef(line, 0)
|
||||
);
|
||||
|
||||
|
||||
@ -567,6 +567,13 @@ begin
|
||||
Result := Filename <> '';
|
||||
if Result then exit;
|
||||
|
||||
if dlfSearchByFunctionName in AUnitinfo.Flags then begin
|
||||
//debuln(['need locatien for', AUnitinfo.UnitName, ', ', AUnitinfo.SrcClassName, ', ', AUnitinfo.FunctionName]);
|
||||
//Result := '';
|
||||
//AUnitinfo.LocationFullFile := Result;
|
||||
//exit;
|
||||
end;
|
||||
|
||||
case AUnitinfo.LocationType of
|
||||
dltUnknown:
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user