diff --git a/components/debuggerintf/dbgintfdebuggerbase.pp b/components/debuggerintf/dbgintfdebuggerbase.pp index 6420b3ff33..e7d2283465 100644 --- a/components/debuggerintf/dbgintfdebuggerbase.pp +++ b/components/debuggerintf/dbgintfdebuggerbase.pp @@ -177,32 +177,49 @@ type TDebuggerIntf = class; TDebuggerDataSupplier = class; + { TDebuggerDataHandler } + + TDebuggerDataHandler = class + private + FNotifiedState: TDBGState; + FOldState: TDBGState; + FUpdateCount: Integer; + protected + //procedure DoModified; virtual; // user-modified / xml-storable data modified + procedure DoStateEnterPause; virtual; + procedure DoStateLeavePause; virtual; + procedure DoStateLeavePauseClean; virtual; + procedure DoStateChangeEx(const AOldState, ANewState: TDBGState); virtual; + property NotifiedState: TDBGState read FNotifiedState; // The last state seen by DoStateChange + property OldState: TDBGState read FOldState; // The state before last DoStateChange + + procedure DoBeginUpdate; virtual; + procedure DoEndUpdate; virtual; + public + //destructor Destroy; override; + procedure BeginUpdate; + procedure EndUpdate; + function IsUpdating: Boolean; + end; + { TDebuggerDataMonitor } - TDebuggerDataMonitor = class + TDebuggerDataMonitor = class(TDebuggerDataHandler) private FSupplier: TDebuggerDataSupplier; - FUpdateCount: Integer; procedure SetSupplier(const AValue: TDebuggerDataSupplier); protected procedure DoModified; virtual; // user-modified / xml-storable data modified procedure DoNewSupplier; virtual; property Supplier: TDebuggerDataSupplier read FSupplier write SetSupplier; - procedure DoStateChange(const {%H-}AOldState, {%H-}ANewState: TDBGState); virtual; - procedure DoBeginUpdate; virtual; - procedure DoEndUpdate; virtual; - function IsUpdating: Boolean; public destructor Destroy; override; - procedure BeginUpdate; - procedure EndUpdate; end; { TDebuggerDataSupplier } - TDebuggerDataSupplier = class + TDebuggerDataSupplier = class(TDebuggerDataHandler) private - FNotifiedState, FOldState: TDBGState; FDebugger: TDebuggerIntf; FMonitor: TDebuggerDataMonitor; procedure SetMonitor(const AValue: TDebuggerDataMonitor); @@ -212,18 +229,16 @@ type protected property Monitor: TDebuggerDataMonitor read FMonitor write SetMonitor; - procedure DoStateEnterPause; virtual; - procedure DoStateLeavePause; virtual; - procedure DoStateLeavePauseClean; virtual; + procedure DoStateLeavePauseClean; override; procedure DoStateChange(const AOldState: TDBGState); virtual; property NotifiedState: TDBGState read FNotifiedState; // The last state seen by DoStateChange property OldState: TDBGState read FOldState; // The state before last DoStateChange + procedure DoBeginUpdate; override; + procedure DoEndUpdate; override; public constructor Create(const ADebugger: TDebuggerIntf); destructor Destroy; override; - procedure BeginUpdate; - procedure EndUpdate; end; {$region Breakpoints **********************************************************} @@ -561,21 +576,29 @@ type { TWatchValueBase } TWatchValueBase = class(TFreeNotifyingObject) + private + FTypeInfo: TDBGType; + FValue: String; + FValidity: TDebuggerDataState; + + procedure SetValidity(AValue: TDebuggerDataState); virtual; + procedure SetValue(AValue: String); + procedure SetTypeInfo(AValue: TDBGType); protected + procedure DoDataValidityChanged({%H-}AnOldValidity: TDebuggerDataState); virtual; + function GetDisplayFormat: TWatchDisplayFormat; virtual; abstract; function GetEvaluateFlags: TDBGEvaluateFlags; virtual; abstract; function GetExpression: String; virtual; abstract; function GetRepeatCount: Integer; virtual; abstract; function GetStackFrame: Integer; virtual; abstract; function GetThreadId: Integer; virtual; abstract; - function GetTypeInfo: TDBGType; virtual; abstract; - function GetValidity: TDebuggerDataState; virtual; abstract; - function GetValue: String; virtual; abstract; + function GetTypeInfo: TDBGType; virtual; + function GetValue: String; virtual; function GetWatchBase: TWatchBase; virtual; abstract; - procedure SetTypeInfo(AValue: TDBGType); virtual; abstract; - procedure SetValidity(AValue: TDebuggerDataState); virtual; abstract; - procedure SetValue(AValue: String); virtual; abstract; public + destructor Destroy; override; + procedure Assign(AnOther: TWatchValueBase); virtual; property DisplayFormat: TWatchDisplayFormat read GetDisplayFormat; property EvaluateFlags: TDBGEvaluateFlags read GetEvaluateFlags; property RepeatCount: Integer read GetRepeatCount; @@ -584,7 +607,7 @@ type property Expression: String read GetExpression; property Watch: TWatchBase read GetWatchBase; public - property Validity: TDebuggerDataState read GetValidity write SetValidity; + property Validity: TDebuggerDataState read FValidity write SetValidity; property Value: String read GetValue write SetValue; property TypeInfo: TDBGType read GetTypeInfo write SetTypeInfo; end; @@ -1761,6 +1784,146 @@ begin end; end; +{ TDebuggerDataHandler } + +procedure TDebuggerDataHandler.DoStateEnterPause; +begin + // +end; + +procedure TDebuggerDataHandler.DoStateLeavePause; +begin + // +end; + +procedure TDebuggerDataHandler.DoStateLeavePauseClean; +begin + // +end; + +procedure TDebuggerDataHandler.DoStateChangeEx(const AOldState, ANewState: TDBGState); +begin + FNotifiedState := ANewState; + FOldState := AOldState; + DebugLnEnter(DBG_DATA_MONITORS, [ClassName, ': >>ENTER: ', ClassName, '.DoStateChange New-State=', dbgs(FNotifiedState)]); + + if FNotifiedState in [dsPause, dsInternalPause] + then begin + // typical: Clear and reload data + if not(AOldState in [dsPause, dsInternalPause] ) + then DoStateEnterPause; + end + else + if (AOldState in [dsPause, dsInternalPause, dsNone] ) + then begin + // dsIdle happens after dsStop + if (FNotifiedState in [dsRun, dsInit, dsIdle]) or (AOldState = dsNone) + then begin + // typical: finalize snapshot and clear data. + DoStateLeavePauseClean; + end + else begin + // typical: finalize snapshot + // Do *not* clear data. Objects may be in use (e.g. dsError) + DoStateLeavePause; + end; + end + else + if (AOldState in [dsStop]) and (FNotifiedState = dsIdle) + then begin + // stopped // typical: finalize snapshot and clear data. + DoStateLeavePauseClean; + end; + DebugLnExit(DBG_DATA_MONITORS, [ClassName, ': < 0, 'TDebuggerDataMonitor.EndUpdate: FUpdateCount > 0'); + dec(FUpdateCount); + if FUpdateCount = 0 then + DoEndUpdate; +end; + +function TDebuggerDataHandler.IsUpdating: Boolean; +begin + Result := FUpdateCount > 0; +end; + +{ TWatchValueBase } + +procedure TWatchValueBase.SetValidity(AValue: TDebuggerDataState); +var + OldValidity: TDebuggerDataState; +begin + if FValidity = AValue then exit; + //DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TWatchValueBase.SetValidity: FThreadId=', FThreadId, ' FStackFrame=',FStackFrame, ' Expr=', Expression, ' AValidity=',dbgs(AValue)]); + DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TWatchValueBase.SetValidity: Expr=', Expression, ' AValidity=',dbgs(AValue)]); + OldValidity := FValidity; + FValidity := AValue; + DoDataValidityChanged(OldValidity); +end; + +procedure TWatchValueBase.SetValue(AValue: String); +begin + if FValue = AValue then exit; + //asser not immutable + FValue := AValue; +end; + +procedure TWatchValueBase.SetTypeInfo(AValue: TDBGType); +begin + //assert(Self is TCurrentWatchValue, 'TWatchValue.SetTypeInfo'); + FreeAndNil(FTypeInfo); + FTypeInfo := AValue; +end; + +procedure TWatchValueBase.DoDataValidityChanged(AnOldValidity: TDebuggerDataState); +begin + +end; + +function TWatchValueBase.GetTypeInfo: TDBGType; +begin + Result := FTypeInfo; +end; + +function TWatchValueBase.GetValue: String; +begin + Result := FValue; +end; + +destructor TWatchValueBase.Destroy; +begin + inherited Destroy; + FreeAndNil(FTypeInfo); +end; + +procedure TWatchValueBase.Assign(AnOther: TWatchValueBase); +begin + FreeAndNil(FTypeInfo); + //FTypeInfo := TWatchValue(AnOther).FTypeInfo.cre; + FValue := AnOther.FValue; + FValidity := AnOther.FValidity; +end; + { TRegisterSupplier } procedure TRegisterSupplier.DoNewMonitor; @@ -2154,47 +2317,12 @@ begin // end; -procedure TDebuggerDataMonitor.DoStateChange(const AOldState, ANewState: TDBGState); -begin - // -end; - -procedure TDebuggerDataMonitor.DoBeginUpdate; -begin - // -end; - -procedure TDebuggerDataMonitor.DoEndUpdate; -begin - // -end; - -function TDebuggerDataMonitor.IsUpdating: Boolean; -begin - Result := FUpdateCount > 0; -end; - destructor TDebuggerDataMonitor.Destroy; begin Supplier := nil; inherited Destroy; end; -procedure TDebuggerDataMonitor.BeginUpdate; -begin - inc(FUpdateCount); - if FUpdateCount = 1 then - DoBeginUpdate; -end; - -procedure TDebuggerDataMonitor.EndUpdate; -begin - assert(FUpdateCount > 0, 'TDebuggerDataMonitor.EndUpdate: FUpdateCount > 0'); - dec(FUpdateCount); - if FUpdateCount = 0 then - DoEndUpdate; -end; - { TDebuggerDataSupplier } procedure TDebuggerDataSupplier.SetMonitor(const AValue: TDebuggerDataMonitor); @@ -2210,16 +2338,6 @@ begin // end; -procedure TDebuggerDataSupplier.DoStateEnterPause; -begin - // -end; - -procedure TDebuggerDataSupplier.DoStateLeavePause; -begin - // -end; - procedure TDebuggerDataSupplier.DoStateLeavePauseClean; begin DoStateLeavePause; @@ -2228,41 +2346,9 @@ end; procedure TDebuggerDataSupplier.DoStateChange(const AOldState: TDBGState); begin if (Debugger = nil) then Exit; - FNotifiedState := Debugger.State; - FOldState := AOldState; - DebugLnEnter(DBG_DATA_MONITORS, ['TDebuggerDataSupplier: >>ENTER: ', ClassName, '.DoStateChange New-State=', dbgs(FNotifiedState)]); - - if FNotifiedState in [dsPause, dsInternalPause] - then begin - // typical: Clear and reload data - if not(AOldState in [dsPause, dsInternalPause] ) - then DoStateEnterPause; - end - else - if (AOldState in [dsPause, dsInternalPause, dsNone] ) - then begin - // dsIdle happens after dsStop - if (FNotifiedState in [dsRun, dsInit, dsIdle]) or (AOldState = dsNone) - then begin - // typical: finalize snapshot and clear data. - DoStateLeavePauseClean; - end - else begin - // typical: finalize snapshot - // Do *not* clear data. Objects may be in use (e.g. dsError) - DoStateLeavePause; - end; - end - else - if (AOldState in [dsStop]) and (FNotifiedState = dsIdle) - then begin - // stopped // typical: finalize snapshot and clear data. - DoStateLeavePauseClean; - end; - + DoStateChangeEx(AOldState, Debugger.State); if Monitor <> nil then - Monitor.DoStateChange(AOldState, FNotifiedState); - DebugLnExit(DBG_DATA_MONITORS, ['TDebuggerDataSupplier: <>ENTER: ', ClassName, '.DoStateChange New-State=', dbgs(FNotifiedState)]); - - if FNotifiedState in [dsPause, dsInternalPause] - then begin - // typical: Clear and reload data - if not(AOldState in [dsPause, dsInternalPause] ) - then DoStateEnterPause; - end - else - if (AOldState in [dsPause, dsInternalPause, dsNone] ) - then begin - // dsIdle happens after dsStop - if (FNotifiedState in [dsRun, dsInit, dsIdle]) or (AOldState = dsNone) - then begin - // typical: finalize snapshot and clear data. - DoStateLeavePauseClean; - end - else begin - // typical: finalize snapshot - // Do *not* clear data. Objects may be in use (e.g. dsError) - DoStateLeavePause; - end; - end - else - if (AOldState in [dsStop]) and (FNotifiedState = dsIdle) - then begin - // stopped // typical: finalize snapshot and clear data. - DoStateLeavePauseClean; - end; - DebugLnExit(DBG_DATA_MONITORS, ['DebugDataMonitor: < nil then FSnapShot.Assign(self); @@ -3576,18 +3511,18 @@ begin exit; end; i := DbgStateChangeCounter; // workaround for state changes during TWatchValue.GetValue - if FValidity = ddsUnknown then begin + if Validity = ddsUnknown then begin Result := ''; - FValidity := ddsRequested; + Validity := ddsRequested; RequestData; if i <> DbgStateChangeCounter then exit; // in case the debugger did run. // TODO: The watch can also be deleted by the user end; - case FValidity of + case Validity of ddsRequested, ddsEvaluating: Result := ''; - ddsValid: Result := FValue; + ddsValid: Result := inherited GetValue; ddsInvalid: Result := ''; - ddsError: Result := ''; + ddsError: Result := ''; end; end; @@ -3597,32 +3532,6 @@ begin Result := FWatch; end; -procedure TWatchValue.ValidityChanged; -begin - -end; - -procedure TWatchValue.SetValidity(AValue: TDebuggerDataState); -begin - if FValidity = AValue then exit; - DebugLn(DBG_DATA_MONITORS, ['DebugDataMonitor: TWatchValueBase.SetValidity: FThreadId=', FThreadId, ' FStackFrame=',FStackFrame, ' Expr=', Expression, ' AValidity=',dbgs(AValue)]); - FValidity := AValue; - ValidityChanged; -end; - -procedure TWatchValue.SetTypeInfo(AValue: TDBGType); -begin - assert(Self is TCurrentWatchValue, 'TWatchValue.SetTypeInfo'); - FreeAndNil(FTypeInfo); - FTypeInfo := AValue; -end; - -procedure TWatchValue.SetValue(AValue: String); -begin - assert(Self is TCurrentWatchValue, 'TWatchValue.SetValue()'); - FValue := AValue; -end; - function TWatchValue.GetDisplayFormat: TWatchDisplayFormat; begin Result := FDisplayFormat; @@ -3661,44 +3570,45 @@ begin if not FWatch.Enabled then exit; i := DbgStateChangeCounter; // workaround for state changes during TWatchValue.GetValue - if FValidity = ddsUnknown then begin - FValidity := ddsRequested; + if Validity = ddsUnknown then begin + Validity := ddsRequested; RequestData; if i <> DbgStateChangeCounter then exit; end; - case FValidity of + case Validity of ddsRequested, ddsEvaluating: Result := nil; - ddsValid: Result := FTypeInfo; + ddsValid: Result := inherited GetTypeInfo; ddsInvalid, ddsError: Result := nil; end; end; -function TWatchValue.GetValidity: TDebuggerDataState; -begin - Result := FValidity; -end; - procedure TWatchValue.RequestData; begin - FValidity := ddsInvalid; + Validity := ddsInvalid; end; procedure TWatchValue.LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string); +var + NewValidity: TDebuggerDataState; begin FThreadId := AConfig.GetValue(APath + 'ThreadId', -1); FStackFrame := AConfig.GetValue(APath + 'StackFrame', -1); - FValue := AConfig.GetValue(APath + 'Value', ''); + Value := AConfig.GetValue(APath + 'Value', ''); if AConfig.GetValue(APath + 'ClassAutoCast', False) then Include(FEvaluateFlags, defClassAutoCast) else Exclude(FEvaluateFlags, defClassAutoCast); FRepeatCount := AConfig.GetValue(APath + 'RepeatCount', 0); try ReadStr(AConfig.GetValue(APath + 'DisplayFormat', 'wdfDefault'), FDisplayFormat); except FDisplayFormat := wdfDefault; end; - try ReadStr(AConfig.GetValue(APath + 'Validity', 'ddsValid'), FValidity); - except FValidity := ddsUnknown; end; + try + ReadStr(AConfig.GetValue(APath + 'Validity', 'ddsValid'), NewValidity); + Validity := NewValidity; + except + Validity := ddsUnknown; + end; end; procedure TWatchValue.SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string); @@ -3707,10 +3617,10 @@ var begin AConfig.SetValue(APath + 'ThreadId', FThreadId); AConfig.SetValue(APath + 'StackFrame', FStackFrame); - AConfig.SetValue(APath + 'Value', FValue); + AConfig.SetValue(APath + 'Value', Value); WriteStr(s{%H-}, FDisplayFormat); AConfig.SetDeleteValue(APath + 'DisplayFormat', s, 'wdfDefault'); - WriteStr(s, FValidity); + WriteStr(s, Validity); AConfig.SetDeleteValue(APath + 'Validity', s, 'ddsValid'); AConfig.SetDeleteValue(APath + 'ClassAutoCast', defClassAutoCast in FEvaluateFlags, False); AConfig.SetDeleteValue(APath + 'RepeatCount', FRepeatCount, 0); @@ -3726,7 +3636,7 @@ end; constructor TWatchValue.Create(AOwnerWatch: TWatch); begin - FValidity := ddsUnknown; + Validity := ddsUnknown; FWatch := AOwnerWatch; FDisplayFormat := FWatch.DisplayFormat; FEvaluateFlags := FWatch.EvaluateFlags; @@ -3742,21 +3652,12 @@ begin FStackFrame := AStackFrame; end; -destructor TWatchValue.Destroy; +procedure TWatchValue.Assign(AnOther: TWatchValueBase); begin - inherited Destroy; - FreeAndNil(FTypeInfo); -end; - -procedure TWatchValue.Assign(AnOther: TWatchValue); -begin - FreeAndNil(FTypeInfo); - FValue := AnOther.FValue; - FValidity := AnOther.FValidity; - //FTypeInfo := AnOther.FTypeInfo.cre; - FThreadId := AnOther.FThreadId; - FStackFrame := AnOther.FStackFrame; - FDisplayFormat := AnOther.FDisplayFormat; + inherited Assign(AnOther); + FThreadId := TWatchValue(AnOther).FThreadId; + FStackFrame := TWatchValue(AnOther).FStackFrame; + FDisplayFormat := TWatchValue(AnOther).FDisplayFormat; end; { TWatchesMonitor } diff --git a/debugger/test/Gdbmi/testbase.pas b/debugger/test/Gdbmi/testbase.pas index 935beb83a6..f772b77661 100644 --- a/debugger/test/Gdbmi/testbase.pas +++ b/debugger/test/Gdbmi/testbase.pas @@ -202,8 +202,8 @@ type // stuff for the debugger FCallStack: TCallStackMonitor; FDisassembler: TIDEDisassembler; - FExceptions: TIDEExceptions; - FSignals: TIDESignals; + FExceptions: TBaseExceptions; + //FSignals: TBaseSignals; //FBreakPoints: TIDEBreakPoints; //FBreakPointGroups: TIDEBreakPointGroups; FLocals: TLocalsMonitor; @@ -278,13 +278,13 @@ type public //property BreakPoints: TIDEBreakPoints read FBreakpoints; // A list of breakpoints for the current project //property BreakPointGroups: TIDEBreakPointGroups read FBreakPointGroups; - property Exceptions: TIDEExceptions read FExceptions; // A list of exceptions we should ignore + property Exceptions: TBaseExceptions read FExceptions; // A list of exceptions we should ignore property CallStack: TCallStackMonitor read FCallStack; property Disassembler: TIDEDisassembler read FDisassembler; property Locals: TLocalsMonitor read FLocals; property LineInfo: TIDELineInfo read FLineInfo; property Registers: TRegistersMonitor read FRegisters; - property Signals: TIDESignals read FSignals; // A list of actions for signals we know of + //property Signals: TBaseSignals read FSignals; // A list of actions for signals we know of property Watches: TWatchesMonitor read FWatches; property Threads: TThreadsMonitor read FThreads; end; @@ -528,8 +528,8 @@ begin //FBreakPointGroups := TIDEBreakPointGroups.Create; FWatches := TWatchesMonitor.Create; FThreads := TThreadsMonitor.Create; - FExceptions := TIDEExceptions.Create; - FSignals := TIDESignals.Create; + FExceptions := TBaseExceptions.Create(TBaseException); + //FSignals := TBaseSignals.Create(TBaseSignal); FLocals := TLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TCallStackMonitor.Create; @@ -548,7 +548,7 @@ begin FCallStack.Supplier := Result.CallStack; FDisassembler.Master := Result.Disassembler; Result.Exceptions := FExceptions; - FSignals.Master := Result.Signals; + //FSignals.Master := Result.Signals; FRegisters.Supplier := Result.Registers; Result.Init; @@ -571,7 +571,7 @@ begin FCallStack.Supplier := nil; FDisassembler.Master := nil; //FExceptions.Master := nil; - FSignals.Master := nil; + //FSignals.Master := nil; // FRegisters.Master := nil; FreeAndNil(FWatches); @@ -581,7 +581,7 @@ begin FreeAndNil(FCallStack); FreeAndNil(FDisassembler); FreeAndNil(FExceptions); - FreeAndNil(FSignals); + //FreeAndNil(FSignals); FreeAndNil(FLocals); FreeAndNil(FLineInfo); FreeAndNil(FRegisters); diff --git a/debugger/test/Gdbmi/testdisass.pas b/debugger/test/Gdbmi/testdisass.pas index 80b97c0d99..9584aa3944 100644 --- a/debugger/test/Gdbmi/testdisass.pas +++ b/debugger/test/Gdbmi/testdisass.pas @@ -43,8 +43,8 @@ type TTestDisAss = class(TTestCase) protected FCallStack: TCallStackMonitor; - FExceptions: TIDEExceptions; - FSignals: TIDESignals; + FExceptions: TBaseExceptions; + //FSignals: TBaseSignals; //FBreakPoints: TIDEBreakPoints; //FBreakPointGroups: TIDEBreakPointGroups; FLocals: TLocalsMonitor; @@ -337,8 +337,8 @@ var FWatches := TWatchesMonitor.Create; FThreads := TThreadsMonitor.Create; - FExceptions := TIDEExceptions.Create; - FSignals := TIDESignals.Create; + FExceptions := TBaseExceptions.Create(TBaseException); + //FSignals := TBaseSignals.Create(TBaseSignal); FLocals := TLocalsMonitor.Create; FLineInfo := TIDELineInfo.Create; FCallStack := TCallStackMonitor.Create; @@ -351,7 +351,7 @@ var FLineInfo.Master := Gdb.LineInfo; FCallStack.Supplier := Gdb.CallStack; Gdb.Exceptions := FExceptions; - FSignals.Master := Gdb.Signals; + //FSignals.Master := Gdb.Signals; FRegisters.Supplier := Gdb.Registers; Gdb.TestSetState(dsPause); @@ -377,7 +377,7 @@ var //FreeAndNil(FBreakPointGroups); FreeAndNil(FCallStack); FreeAndNil(FExceptions); - FreeAndNil(FSignals); + //FreeAndNil(FSignals); FreeAndNil(FLocals); FreeAndNil(FLineInfo); FreeAndNil(FRegisters);