mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-07 21:41:34 +02:00
Debugger: implement reading class.unitname from RTTI
This commit is contained in:
Martin
parent
8749ca4f20
commit
1c87d53199
@ -31,6 +31,7 @@ function hostDescriptor: TTargetDescriptor;
|
||||
procedure AssertFpDebugThreadId(const AName: String);
|
||||
procedure AssertFpDebugThreadIdNotMain(const AName: String);
|
||||
procedure SetCurrentFpDebugThreadIdForAssert(AnId: TThreadID);
|
||||
procedure ClearCurrentFpDebugThreadIdForAssert;
|
||||
property CurrentFpDebugThreadIdForAssert: TThreadID write SetCurrentFpDebugThreadIdForAssert;
|
||||
{$ENDIF}
|
||||
|
||||
@ -87,6 +88,11 @@ begin
|
||||
FCurrentFpDebugThreadIdValidForAssert := True;
|
||||
end;
|
||||
|
||||
procedure ClearCurrentFpDebugThreadIdForAssert;
|
||||
begin
|
||||
FCurrentFpDebugThreadIdValidForAssert := False;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
@ -43,7 +43,7 @@ type
|
||||
|
||||
function GetInstanceClassNameFromPVmt(APVmt: TDbgPtr;
|
||||
AContext: TFpDbgLocationContext; ASizeOfAddr: Integer;
|
||||
out AClassName: String; out AnError: TFpError): boolean;
|
||||
AClassName, AUnitName: PString; out AnError: TFpError): boolean;
|
||||
end;
|
||||
|
||||
{ TFpDwarfFreePascalSymbolClassMapDwarf2 }
|
||||
@ -157,12 +157,12 @@ type
|
||||
//function GetInstanceClass(AValueObj: TFpValueDwarf): TFpSymbolDwarf; override;
|
||||
class function GetInstanceClassNameFromPVmt(APVmt: TDbgPtr;
|
||||
AContext: TFpDbgLocationContext; ASizeOfAddr: Integer;
|
||||
out AClassName: String; out AnError: TFpError;
|
||||
AClassName, AUnitName: PString; out AnError: TFpError;
|
||||
AParentClassIndex: integer = 0;
|
||||
ACompilerVersion: Cardinal = 0): boolean;
|
||||
public
|
||||
function GetInstanceClassName(AValueObj: TFpValue; out
|
||||
AClassName: String;
|
||||
function GetInstanceClassName(AValueObj: TFpValue;
|
||||
AClassName, AUnitName: PString;
|
||||
AParentClassIndex: integer = 0): boolean; override;
|
||||
end;
|
||||
|
||||
@ -412,11 +412,11 @@ begin
|
||||
end;
|
||||
|
||||
function TFpDwarfFreePascalSymbolClassMap.GetInstanceClassNameFromPVmt(
|
||||
APVmt: TDbgPtr; AContext: TFpDbgLocationContext; ASizeOfAddr: Integer; out
|
||||
AClassName: String; out AnError: TFpError): boolean;
|
||||
APVmt: TDbgPtr; AContext: TFpDbgLocationContext; ASizeOfAddr: Integer;
|
||||
AClassName, AUnitName: PString; out AnError: TFpError): boolean;
|
||||
begin
|
||||
Result := TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassNameFromPVmt(APVmt,
|
||||
AContext, ASizeOfAddr, AClassName, AnError);
|
||||
AContext, ASizeOfAddr, AClassName, AUnitName, AnError);
|
||||
end;
|
||||
|
||||
{ TFpDwarfFreePascalSymbolClassMapDwarf2 }
|
||||
@ -968,8 +968,8 @@ begin
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassName(
|
||||
AValueObj: TFpValue; out AClassName: String; AParentClassIndex: integer
|
||||
): boolean;
|
||||
AValueObj: TFpValue; AClassName, AUnitName: PString;
|
||||
AParentClassIndex: integer): boolean;
|
||||
var
|
||||
AnErr: TFpError;
|
||||
begin
|
||||
@ -978,7 +978,7 @@ begin
|
||||
exit;
|
||||
Result := GetInstanceClassNameFromPVmt(LocToAddrOrNil(AValueObj.DataAddress),
|
||||
TFpValueDwarf(AValueObj).Context, TFpValueDwarf(AValueObj).Context.SizeOfAddress,
|
||||
AClassName, AnErr, AParentClassIndex,
|
||||
AClassName, AUnitName, AnErr, AParentClassIndex,
|
||||
TFpDwarfFreePascalSymbolClassMap(CompilationUnit.DwarfSymbolClassMap).FCompilerVersion
|
||||
);
|
||||
|
||||
@ -987,25 +987,33 @@ begin
|
||||
end;
|
||||
|
||||
class function TFpSymbolDwarfFreePascalTypeStructure.GetInstanceClassNameFromPVmt
|
||||
(APVmt: TDbgPtr; AContext: TFpDbgLocationContext; ASizeOfAddr: Integer; out
|
||||
AClassName: String; out AnError: TFpError; AParentClassIndex: integer;
|
||||
ACompilerVersion: Cardinal): boolean;
|
||||
(APVmt: TDbgPtr; AContext: TFpDbgLocationContext; ASizeOfAddr: Integer;
|
||||
AClassName, AUnitName: PString; out AnError: TFpError;
|
||||
AParentClassIndex: integer; ACompilerVersion: Cardinal): boolean;
|
||||
|
||||
function CheckIsReadableMem(AMem: TFpDbgMemLocation): Boolean;
|
||||
begin
|
||||
Result := IsReadableMem(AMem);
|
||||
if not Result then
|
||||
AnError := CreateError(fpErrCanNotReadMemAtAddr, [AMem.Address]);
|
||||
end;
|
||||
|
||||
var
|
||||
VmtAddr, ClassNameAddr, A: TFpDbgMemLocation;
|
||||
NameLen: QWord;
|
||||
begin
|
||||
Result := False;
|
||||
AnError := NoError;
|
||||
AClassName := '';
|
||||
if AClassName <> nil then AClassName^ := '';
|
||||
if AUnitName <> nil then AUnitName^ := '';
|
||||
|
||||
if not AContext.ReadAddress(TargetLoc(APVmt), SizeVal(ASizeOfAddr), VmtAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not IsReadableMem(VmtAddr) then begin
|
||||
AnError := CreateError(fpErrCanNotReadMemAtAddr, [VmtAddr.Address]);
|
||||
if not CheckIsReadableMem(VmtAddr) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
while AParentClassIndex > 0 do begin
|
||||
{$PUSH}{$Q-}
|
||||
@ -1014,24 +1022,24 @@ begin
|
||||
A := VmtAddr;
|
||||
if not AContext.ReadAddress(A, SizeVal(ASizeOfAddr), VmtAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not IsReadableMem(VmtAddr) then begin
|
||||
AnError := CreateError(fpErrCanNotReadMemAtAddr, [VmtAddr.Address]);
|
||||
if IsTargetNil(VmtAddr) then
|
||||
exit; // no error / top parent reached
|
||||
if not CheckIsReadableMem(VmtAddr) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (ACompilerVersion >= $030200)
|
||||
then begin
|
||||
A := VmtAddr;
|
||||
if not AContext.ReadAddress(A, SizeVal(ASizeOfAddr), VmtAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not IsReadableMem(VmtAddr) then begin
|
||||
AnError := CreateError(fpErrCanNotReadMemAtAddr, [VmtAddr.Address]);
|
||||
if not CheckIsReadableMem(VmtAddr) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
dec(AParentClassIndex);
|
||||
@ -1041,31 +1049,90 @@ begin
|
||||
VmtAddr.Address := VmtAddr.Address + TDBGPtr(3 * ASizeOfAddr);
|
||||
{$POP}
|
||||
|
||||
if not AContext.ReadAddress(VmtAddr, SizeVal(ASizeOfAddr), ClassNameAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not IsReadableMem(ClassNameAddr) then begin
|
||||
AnError := CreateError(fpErrCanNotReadMemAtAddr, [ClassNameAddr.Address]);
|
||||
exit;
|
||||
end;
|
||||
if not AContext.ReadUnsignedInt(ClassNameAddr, SizeVal(1), NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
exit;
|
||||
end;
|
||||
if NameLen = 0 then begin
|
||||
AnError := CreateError(fpErrAnyError, ['No name found']);
|
||||
exit;
|
||||
end;
|
||||
if not AContext.MemManager.SetLength(AClassName, NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
exit;
|
||||
if AClassName <> nil then begin
|
||||
if not AContext.ReadAddress(VmtAddr, SizeVal(ASizeOfAddr), ClassNameAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not CheckIsReadableMem(ClassNameAddr) then
|
||||
exit;
|
||||
|
||||
if not AContext.ReadUnsignedInt(ClassNameAddr, SizeVal(1), NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if NameLen = 0 then begin
|
||||
AnError := CreateError(fpErrAnyError, ['No name found']);
|
||||
exit;
|
||||
end;
|
||||
if not AContext.MemManager.SetLength(AClassName^, NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
|
||||
ClassNameAddr.Address := ClassNameAddr.Address + 1;
|
||||
Result := AContext.ReadMemory(ClassNameAddr, SizeVal(NameLen), @AClassName^[1]);
|
||||
if not Result then
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
end;
|
||||
|
||||
ClassNameAddr.Address := ClassNameAddr.Address + 1;
|
||||
Result := AContext.ReadMemory(ClassNameAddr, SizeVal(NameLen), @AClassName[1]);
|
||||
if not Result then
|
||||
AnError := AContext.LastMemError;
|
||||
if AUnitName <> nil then begin
|
||||
// get vTypeInfo
|
||||
{$PUSH}{$Q-}
|
||||
VmtAddr.Address := VmtAddr.Address + TDBGPtr(4 * ASizeOfAddr);
|
||||
{$POP}
|
||||
|
||||
if not AContext.ReadAddress(VmtAddr, SizeVal(ASizeOfAddr), ClassNameAddr) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if not CheckIsReadableMem(ClassNameAddr) then
|
||||
exit;
|
||||
|
||||
//inc(Pointer(classtypeinfo), PByte(Pointer(classtypeinfo)+1)^ + 2);
|
||||
A := ClassNameAddr;
|
||||
{$PUSH}{$Q-}
|
||||
A.Address := A.Address + 1;
|
||||
{$POP}
|
||||
if not AContext.ReadUnsignedInt(A, SizeVal(1), NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
{$PUSH}{$Q-}
|
||||
ClassNameAddr.Address := ClassNameAddr.Address + TDBGPtr(NameLen + 2) + TDBGPtr(2 * ASizeOfAddr + 2);
|
||||
if (ACompilerVersion >= $030300) then
|
||||
ClassNameAddr.Address := ClassNameAddr.Address + TDBGPtr(ASizeOfAddr);
|
||||
{$POP}
|
||||
// Maybe align to next qword
|
||||
|
||||
|
||||
if not AContext.ReadUnsignedInt(ClassNameAddr, SizeVal(1), NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
if NameLen = 0 then begin
|
||||
AnError := CreateError(fpErrAnyError, ['No name found']);
|
||||
exit;
|
||||
end;
|
||||
if not AContext.MemManager.SetLength(AUnitName^, NameLen) then begin
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
exit;
|
||||
end;
|
||||
|
||||
ClassNameAddr.Address := ClassNameAddr.Address + 1;
|
||||
Result := AContext.ReadMemory(ClassNameAddr, SizeVal(NameLen), @AUnitName^[1]);
|
||||
if not Result then
|
||||
AnError := AContext.LastMemError;
|
||||
AContext.ClearLastMemError;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfV2FreePascalShortString }
|
||||
|
||||
@ -187,7 +187,8 @@ type
|
||||
public
|
||||
function GetTypeCastedValue(ADataVal: TFpValue): TFpValue; virtual; // only if Symbol is a type
|
||||
|
||||
function GetInstanceClassName(out AClassName: String; AParentClassIndex: integer = 0): boolean; virtual;
|
||||
function GetInstanceClassName(out AClassName; AParentClassIndex: integer = 0): boolean; virtual;
|
||||
function GetInstanceClassName(AClassName: PString; AUnitName: PString = nil; AParentClassIndex: integer = 0): boolean; virtual;
|
||||
|
||||
// base class? Or Member includes member from base
|
||||
(* Member:
|
||||
@ -463,7 +464,7 @@ type
|
||||
//
|
||||
property Flags: TDbgSymbolFlags read GetFlags;
|
||||
property Parent: TFpSymbol read GetParent; deprecated;
|
||||
function GetInstanceClassName(AValueObj: TFpValue; out AClassName: String; AParentClassIndex: integer = 0): boolean; virtual;
|
||||
function GetInstanceClassName(AValueObj: TFpValue; AClassName, AUnitName: PString; AParentClassIndex: integer = 0): boolean; virtual;
|
||||
|
||||
// for Subranges // Type-Symbols only?
|
||||
// TODO: flag bounds as cardinal if needed
|
||||
@ -508,7 +509,7 @@ type
|
||||
function GetNestedSymbolByName(const AIndex: String): TFpSymbol; override;
|
||||
function GetNestedSymbolCount: Integer; override;
|
||||
public
|
||||
function GetInstanceClassName(AValueObj: TFpValue; out AClassName: String; AParentClassIndex: integer = 0): boolean; override;
|
||||
function GetInstanceClassName(AValueObj: TFpValue; AClassName, AUnitName: PString; AParentClassIndex: integer = 0): boolean; override;
|
||||
function GetValueBounds(AValueObj: TFpValue; out ALowBound, AHighBound: Int64): Boolean; override;
|
||||
function GetValueLowBound(AValueObj: TFpValue; out ALowBound: Int64): Boolean; override;
|
||||
function GetValueHighBound(AValueObj: TFpValue; out AHighBound: Int64): Boolean; override;
|
||||
@ -929,7 +930,13 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFpValue.GetInstanceClassName(out AClassName: String;
|
||||
function TFpValue.GetInstanceClassName(out AClassName;
|
||||
AParentClassIndex: integer): boolean;
|
||||
begin
|
||||
Result := GetInstanceClassName(@AClassName, nil);
|
||||
end;
|
||||
|
||||
function TFpValue.GetInstanceClassName(AClassName, AUnitName: PString;
|
||||
AParentClassIndex: integer): boolean;
|
||||
var
|
||||
ti: TFpSymbol;
|
||||
@ -937,7 +944,7 @@ begin
|
||||
ti := TypeInfo;
|
||||
Result := ti <> nil;
|
||||
if Result then
|
||||
Result := ti.GetInstanceClassName(Self, AClassName, AParentClassIndex);
|
||||
Result := ti.GetInstanceClassName(Self, AClassName, AUnitName, AParentClassIndex);
|
||||
end;
|
||||
|
||||
procedure TFpValue.ResetError;
|
||||
@ -1396,10 +1403,11 @@ begin
|
||||
Result := DoReadSize(AValueObj, ASize);
|
||||
end;
|
||||
|
||||
function TFpSymbol.GetInstanceClassName(AValueObj: TFpValue; out
|
||||
AClassName: String; AParentClassIndex: integer): boolean;
|
||||
function TFpSymbol.GetInstanceClassName(AValueObj: TFpValue; AClassName,
|
||||
AUnitName: PString; AParentClassIndex: integer): boolean;
|
||||
begin
|
||||
AClassName := '';
|
||||
if AClassName <> nil then AClassName^ := '';
|
||||
if AUnitName <> nil then AUnitName^ := '';
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
@ -1777,16 +1785,16 @@ begin
|
||||
Result := 0; // Result := inherited GetOrdinalValue;
|
||||
end;
|
||||
|
||||
function TFpSymbolForwarder.GetInstanceClassName(AValueObj: TFpValue; out
|
||||
AClassName: String; AParentClassIndex: integer): boolean;
|
||||
function TFpSymbolForwarder.GetInstanceClassName(AValueObj: TFpValue;
|
||||
AClassName, AUnitName: PString; AParentClassIndex: integer): boolean;
|
||||
var
|
||||
p: TFpSymbol;
|
||||
begin
|
||||
p := GetForwardToSymbol;
|
||||
if p <> nil then
|
||||
Result := p.GetInstanceClassName(AValueObj, AClassName, AParentClassIndex)
|
||||
Result := p.GetInstanceClassName(AValueObj, AClassName, AUnitName, AParentClassIndex)
|
||||
else
|
||||
Result := inherited GetInstanceClassName(AValueObj, AClassName, AParentClassIndex);
|
||||
Result := inherited GetInstanceClassName(AValueObj, AClassName, AUnitName, AParentClassIndex);
|
||||
end;
|
||||
|
||||
function TFpSymbolForwarder.GetValueBounds(AValueObj: TFpValue; out
|
||||
|
||||
@ -3292,7 +3292,7 @@ begin
|
||||
if (FDbgController.CurrentProcess <> nil) then
|
||||
TFpDwarfFreePascalSymbolClassMap.GetInstanceForDbgInfo(FDbgController.CurrentProcess.DbgInfo)
|
||||
.GetInstanceClassNameFromPVmt
|
||||
(AnAddr, FDbgController.DefaultContext, DBGPTRSIZE[FDbgController.CurrentProcess.Mode], Result, AnErr);
|
||||
(AnAddr, FDbgController.DefaultContext, DBGPTRSIZE[FDbgController.CurrentProcess.Mode], @Result, nil, AnErr);
|
||||
end;
|
||||
|
||||
procedure TFpDebugDebugger.DoThreadDebugOutput(Sender: TObject; ProcessId,
|
||||
|
||||
@ -312,7 +312,7 @@ begin
|
||||
end;
|
||||
|
||||
CnIdx := 0;
|
||||
while AValue.GetInstanceClassName(ValClassName, CnIdx) and
|
||||
while AValue.GetInstanceClassName(@ValClassName, nil, CnIdx) and
|
||||
(ValClassName <> '')
|
||||
do begin
|
||||
ValClassName := LowerCase(ValClassName);
|
||||
|
||||
@ -6,10 +6,10 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, TestBase, FpDebugValueConvertors,
|
||||
TestDbgControl, TestDbgTestSuites, TestOutputLogger, TTestWatchUtilities,
|
||||
TestCommonSources, TestDbgConfig, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
|
||||
DbgIntfDebuggerBase, DbgIntfBaseTypes, Forms, IdeDebuggerBase,
|
||||
IdeDebuggerWatchResult;
|
||||
FpDebugDebugger, TestDbgControl, TestDbgTestSuites, TestOutputLogger,
|
||||
TTestWatchUtilities, TestCommonSources, TestDbgConfig, LazDebuggerIntf,
|
||||
LazDebuggerIntfBaseTypes, DbgIntfDebuggerBase, DbgIntfBaseTypes, FpDbgInfo,
|
||||
FpPascalParser, FpDbgCommon, Forms, IdeDebuggerBase, IdeDebuggerWatchResult;
|
||||
|
||||
type
|
||||
|
||||
@ -33,6 +33,7 @@ type
|
||||
procedure TestWatchesExpression;
|
||||
procedure TestWatchesModify;
|
||||
procedure TestWatchesErrors;
|
||||
procedure TestClassRtti;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -41,7 +42,7 @@ var
|
||||
ControlTestWatch, ControlTestWatchScope, ControlTestWatchValue, ControlTestWatchFunct,
|
||||
ControlTestWatchFunctStr, ControlTestWatchFunctRec, ControlTestWatchFunctVariant,
|
||||
ControlTestWatchAddressOf, ControlTestWatchTypeCast, ControlTestModify,
|
||||
ControlTestExpression, ControlTestErrors: Pointer;
|
||||
ControlTestExpression, ControlTestErrors, ControlTestRTTI: Pointer;
|
||||
|
||||
procedure TTestWatches.RunToPause(var ABrk: TDBGBreakPoint;
|
||||
ADisableBreak: Boolean);
|
||||
@ -3693,6 +3694,105 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestWatches.TestClassRtti;
|
||||
var
|
||||
ExeName: String;
|
||||
Src: TCommonSource;
|
||||
BrkPrg: TDBGBreakPoint;
|
||||
fp: TFpDebugDebugger;
|
||||
AnExpressionScope: TFpDbgSymbolScope;
|
||||
APasExpr: TFpPascalExpression;
|
||||
ResValue: TFpValue;
|
||||
InstClass, AnUnitName: String;
|
||||
r: Boolean;
|
||||
begin
|
||||
if SkipTest then exit;
|
||||
if not TestControlCanTest(ControlTestRTTI) then exit;
|
||||
|
||||
Src := GetCommonSourceFor('WatchesValuePrg.pas');
|
||||
TestCompile(Src, ExeName);
|
||||
|
||||
AssertTrue('Start debugger', Debugger.StartDebugger(AppDir, ExeName));
|
||||
|
||||
try
|
||||
BrkPrg := Debugger.SetBreakPoint(Src, 'Prg');
|
||||
AssertDebuggerNotInErrorState;
|
||||
RunToPause(BrkPrg);
|
||||
|
||||
{$IFDEF FPDEBUG_THREAD_CHECK}
|
||||
ClearCurrentFpDebugThreadIdForAssert;
|
||||
{$ENDIF}
|
||||
|
||||
fp := TFpDebugDebugger(Debugger.LazDebugger);
|
||||
AnExpressionScope := fp.DbgController.CurrentProcess.FindSymbolScope(fp.DbgController.CurrentThread.ID, 0);
|
||||
TestTrue('got scope', AnExpressionScope <> nil);
|
||||
|
||||
if AnExpressionScope <> nil then begin
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('MyClass1', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
|
||||
r := ResValue.GetInstanceClassName(InstClass);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyClass', InstClass);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyClass', InstClass);
|
||||
TestEquals('unit name', 'WatchesValuePrg', AnUnitName);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName, 1);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyBaseClass', InstClass);
|
||||
TestEquals('unit name', 'WatchesValuePrg', AnUnitName);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName, 2);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TObject', InstClass);
|
||||
TestEquals('unit name', 'system', lowercase(AnUnitName));
|
||||
|
||||
APasExpr.Free;
|
||||
|
||||
|
||||
|
||||
APasExpr := TFpPascalExpression.Create('MyClass2', AnExpressionScope);
|
||||
ResValue := APasExpr.ResultValue;
|
||||
|
||||
r := ResValue.GetInstanceClassName(InstClass);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyClass', InstClass);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyClass', InstClass);
|
||||
TestEquals('unit name', 'WatchesValuePrg', AnUnitName);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName, 1);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TMyBaseClass', InstClass);
|
||||
TestEquals('unit name', 'WatchesValuePrg', AnUnitName);
|
||||
|
||||
r := ResValue.GetInstanceClassName(@InstClass, @AnUnitName, 2);
|
||||
TestTrue('got inst class ', r);
|
||||
TestEquals('inst class ', 'TObject', InstClass);
|
||||
TestEquals('unit name', 'system', lowercase(AnUnitName));
|
||||
|
||||
APasExpr.Free;
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
finally
|
||||
Debugger.RunToNextPause(dcStop);
|
||||
Debugger.ClearDebuggerMonitors;
|
||||
Debugger.FreeDebugger;
|
||||
|
||||
AssertTestErrors;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterDbgTest(TTestWatches);
|
||||
@ -3708,6 +3808,7 @@ initialization
|
||||
ControlTestModify := TestControlRegisterTest('Modify', ControlTestWatch);
|
||||
ControlTestExpression := TestControlRegisterTest('Expression', ControlTestWatch);
|
||||
ControlTestErrors := TestControlRegisterTest('Errors', ControlTestWatch);
|
||||
ControlTestRTTI := TestControlRegisterTest('Rtti', ControlTestWatch);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user