paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-10 21:39:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 43302-43304 #e1a4c01ac8-#e1a4c01ac8, 43306-43308 #0148216198-#0148216198 from trunk:

Browse Source 
Debugger: improve cache / fix compare none case-sensitive 
........
Debugger: fix disassembler testcase
........
Debugger: fix adding watch via dialog. Open watch view window
........
Debugger: Change ExceptionList to one list (no master/slave), fix debugger follows config which exceptions to ignore.
........
SrcEdit: workaround for Mac QueueAsync bug
........
Qt: added note about spotted bug in Qt-4.8.5 lib when using raster graphicssystem.

........

git-svn-id: branches/fixes_1_2@43320 -
This commit is contained in:
martin 2013-10-25 10:10:58 +00:00
parent 310e3c4834
commit 239d001434
8 changed files with 54 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
debugger/debugger.pp
View File

@ -2545,7 +2545,9 @@ type
{ TBaseException }
TBaseException = class(TDelayedUdateItem)
private
FEnabled: Boolean;
FName: String;
procedure SetEnabled(AValue: Boolean);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure SetName(const AValue: String); virtual;
@ -2557,6 +2559,7 @@ type
const APath: string); virtual;
public
property Name: String read FName write SetName;
property Enabled: Boolean read FEnabled write SetEnabled; // ignored if enabled
end;
TBaseExceptionClass = class of TBaseException;
@ -2572,12 +2575,7 @@ type
{ TIDEException }
TIDEException = class(TBaseException)
private
FEnabled: Boolean;
FMaster: TDBGException;
protected
procedure DoChanged; override;
procedure SetEnabled(const AValue: Boolean);
protected
public
constructor Create(ACollection: TCollection); override;
procedure LoadFromXMLConfig(const AXMLConfig: TXMLConfig;
@ -2585,7 +2583,6 @@ type
procedure SaveToXMLConfig(const AXMLConfig: TXMLConfig;
const APath: string); override;
procedure ResetMaster;
property Enabled: Boolean read FEnabled write SetEnabled;
end;
{ TBaseExceptions }
@ -2593,7 +2590,8 @@ type
private
FIgnoreAll: Boolean;
function Add(const AName: String): TBaseException;
function Find(const AName: String): TBaseException;
function GetItem(const AIndex: Integer): TBaseException;
procedure SetItem(const AIndex: Integer; AValue: TBaseException);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure ClearExceptions; virtual;
@ -2602,24 +2600,9 @@ type
constructor Create(const AItemClass: TBaseExceptionClass);
destructor Destroy; override;
procedure Reset; virtual;
function Find(const AName: String): TBaseException;
property IgnoreAll: Boolean read FIgnoreAll write SetIgnoreAll;
end;
{ TDBGExceptions }
TDBGExceptions = class(TBaseExceptions)
private
FDebugger: TDebugger; // reference to our debugger
function GetItem(const AIndex: Integer): TDBGException;
procedure SetItem(const AIndex: Integer; const AValue: TDBGException);
protected
public
constructor Create(const ADebugger: TDebugger;
const AExceptionClass: TDBGExceptionClass);
function Add(const AName: String): TDBGException;
function Find(const AName: String): TDBGException;
public
property Items[const AIndex: Integer]: TDBGException read GetItem
property Items[const AIndex: Integer]: TBaseException read GetItem
write SetItem; default;
end;
@ -2627,8 +2610,6 @@ type
TIDEExceptions = class(TBaseExceptions)
private
FMaster: TDBGExceptions;
procedure SetMaster(const AValue: TDBGExceptions);
function GetItem(const AIndex: Integer): TIDEException;
procedure SetItem(const AIndex: Integer; const AValue: TIDEException);
protected
@ -2644,7 +2625,6 @@ type
const APath: string);
procedure AddIfNeeded(AName: string);
procedure Reset; override;
property Master: TDBGExceptions read FMaster write SetMaster;
property Items[const AIndex: Integer]: TIDEException read GetItem
write SetItem; default;
end;
@ -2752,10 +2732,9 @@ type
FEnvironment: TStrings;
FErrorStateInfo: String;
FErrorStateMessage: String;
FExceptions: TDBGExceptions;
FExceptions: TBaseExceptions;
FExitCode: Integer;
FExternalDebugger: String;
//FExceptions: TDBGExceptions;
FFileName: String;
FLocals: TLocalsSupplier;
FLineInfo: TDBGLineInfo;
@ -2800,7 +2779,6 @@ type
function CreateWatches: TWatchesSupplier; virtual;
function CreateThreads: TThreadsSupplier; virtual;
function CreateSignals: TDBGSignals; virtual;
function CreateExceptions: TDBGExceptions; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoDbgEvent(const ACategory: TDBGEventCategory; const AEventType: TDBGEventType; const AText: String);
@ -2885,7 +2863,7 @@ type
property DebuggerEnvironment: TStrings read FDebuggerEnvironment
write SetDebuggerEnvironment; // The environment passed to the debugger process
property Environment: TStrings read FEnvironment write SetEnvironment; // The environment passed to the debuggee
property Exceptions: TDBGExceptions read FExceptions; // A list of exceptions we should ignore
property Exceptions: TBaseExceptions read FExceptions write FExceptions; // A list of exceptions we should ignore
property ExitCode: Integer read FExitCode;
property ExternalDebugger: String read FExternalDebugger; // The name of the debugger executable
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
@ -6277,7 +6255,6 @@ begin
FDisassembler := CreateDisassembler;
FWatches := CreateWatches;
FThreads := CreateThreads;
FExceptions := CreateExceptions;
FSignals := CreateSignals;
FExitCode := 0;
end;
@ -6297,11 +6274,6 @@ begin
Result := TDBGDisassembler.Create(Self);
end;
function TDebugger.CreateExceptions: TDBGExceptions;
begin
Result := TDBGExceptions.Create(Self, TDBGException);
end;
function TDebugger.CreateLocals: TLocalsSupplier;
begin
Result := TLocalsSupplier.Create(Self);
@ -6367,7 +6339,6 @@ begin
FThreads.Debugger := nil;
FreeAndNil(FInternalUnitInfoProvider);
FreeAndNil(FExceptions);
FreeAndNil(FBreakPoints);
FreeAndNil(FLocals);
FreeAndNil(FLineInfo);
@ -10118,6 +10089,13 @@ end;
{ TBaseException }
{ =========================================================================== }
procedure TBaseException.SetEnabled(AValue: Boolean);
begin
if FEnabled = AValue then Exit;
FEnabled := AValue;
Changed;
end;
procedure TBaseException.AssignTo(Dest: TPersistent);
begin
if Dest is TBaseException
@ -10184,32 +10162,6 @@ begin
FMaster := nil;
end;
procedure TIDEException.DoChanged;
var
E: TDBGExceptions;
begin
E := TIDEExceptions(Collection).FMaster;
if ((FMaster = nil) = Enabled) and (E <> nil)
then begin
if Enabled then
begin
FMaster := E.Find(Name);
if FMaster = nil then
FMaster := E.Add(Name);
end
else FreeAndNil(FMaster);
end;
inherited DoChanged;
end;
procedure TIDEException.SetEnabled(const AValue: Boolean);
begin
if FEnabled = AValue then Exit;
FEnabled := AValue;
Changed;
end;
{ =========================================================================== }
{ TBaseExceptions }
{ =========================================================================== }
@ -10253,6 +10205,16 @@ begin
Result := nil;
end;
function TBaseExceptions.GetItem(const AIndex: Integer): TBaseException;
begin
Result := TBaseException(inherited GetItem(AIndex));
end;
procedure TBaseExceptions.SetItem(const AIndex: Integer; AValue: TBaseException);
begin
inherited SetItem(AIndex, AValue);
end;
procedure TBaseExceptions.ClearExceptions;
begin
while Count>0 do
@ -10275,36 +10237,6 @@ begin
else inherited AssignTo(Dest);
end;
{ =========================================================================== }
{ TDBGExceptions }
{ =========================================================================== }
function TDBGExceptions.Add(const AName: String): TDBGException;
begin
Result := TDBGException(inherited Add(AName));
end;
constructor TDBGExceptions.Create(const ADebugger: TDebugger; const AExceptionClass: TDBGExceptionClass);
begin
FDebugger := ADebugger;
inherited Create(AExceptionClass);
end;
function TDBGExceptions.Find(const AName: String): TDBGException;
begin
Result := TDBGException(inherited Find(AName));
end;
function TDBGExceptions.GetItem(const AIndex: Integer): TDBGException;
begin
Result := TDBGException(inherited GetItem(AIndex));
end;
procedure TDBGExceptions.SetItem(const AIndex: Integer; const AValue: TDBGException);
begin
inherited SetItem(AIndex, AValue);
end;
{ =========================================================================== }
{ TIDEExceptions }
{ =========================================================================== }
@ -10321,36 +10253,10 @@ end;
constructor TIDEExceptions.Create;
begin
FMaster := nil;
inherited Create(TIDEException);
AddDefault;
end;
procedure TIDEExceptions.SetMaster(const AValue: TDBGExceptions);
var
n: Integer;
Item: TIDEException;
begin
if FMaster = AValue then Exit;
Assert((FMaster=nil) or (AValue=nil), 'TManagedExceptions already has a Master');
FMaster := AValue;
if FMaster = nil
then begin
for n := 0 to Count - 1 do
Items[n].ResetMaster;
end
else begin
// Do not assign, add only enabled exceptions
for n := 0 to Count - 1 do
begin
Item := Items[n];
if Item.Enabled and (FMaster.Find(Item.Name) = nil)
then FMaster.Add(Item.Name);
end;
FMaster.IgnoreAll := IgnoreAll;
end;
end;
function TIDEExceptions.GetItem(const AIndex: Integer): TIDEException;
begin
Result := TIDEException(inherited GetItem(AIndex));

6
debugger/gdbmidebugger.pp
View File

@ -5431,8 +5431,9 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
CanContinue: Boolean;
Location: TDBGLocationRec;
ExceptInfo: TGDBMIExceptionInfo;
ExceptItem: TBaseException;
begin
if FTheDebugger.Exceptions.IgnoreAll
if (FTheDebugger.Exceptions = nil) or FTheDebugger.Exceptions.IgnoreAll
then begin
Result := True; //ExecuteCommand('-exec-continue')
exit;
@ -5440,7 +5441,8 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
ExceptInfo := GetExceptionInfo;
// check if we should ignore this exception
if (FTheDebugger.Exceptions.Find(ExceptInfo.Name) <> nil)
ExceptItem := FTheDebugger.Exceptions.Find(ExceptInfo.Name);
if (ExceptItem <> nil) and (ExceptItem.Enabled)
then begin
Result := True; //ExecuteCommand('-exec-continue')
exit;

7
debugger/gdbtypeinfo.pp
View File

@ -1999,13 +1999,15 @@ function TGDBPTypeRequestCache.IndexOf(AThreadId, AStackFrame: Integer;
ARequest: TGDBPTypeRequest): Integer;
var
e: TGDBPTypeRequestCacheEntry;
s: String;
begin
Result := FList.Count - 1;
s := UpperCase(ARequest.Request);
while Result >= 0 do begin
e := TGDBPTypeRequestCacheEntry(FList[Result]);
if (e.ThreadId = AThreadId) and (e.StackFrame = AStackFrame) and
(e.Request.Request =ARequest.Request) and
(e.Request.ReqType =ARequest.ReqType)
(e.Request.Request = s) and
(e.Request.ReqType = ARequest.ReqType)
then
exit;
dec(Result);
@ -2021,6 +2023,7 @@ begin
e.FThreadId := AThreadId;
e.FStackFrame := AStackFrame;
e.FRequest := ARequest;
e.FRequest.Request := UpperCase(e.FRequest.Request);
e.FRequest.Next := nil;
FList.Add(e);
end;

4
debugger/test/Gdbmi/testbase.pas
View File

@ -536,7 +536,7 @@ begin
FLineInfo.Master := Result.LineInfo;
FCallStack.Supplier := Result.CallStack;
FDisassembler.Master := Result.Disassembler;
FExceptions.Master := Result.Exceptions;
Result.Exceptions := FExceptions;
FSignals.Master := Result.Signals;
FRegisters.Master := Result.Registers;
@ -559,7 +559,7 @@ begin
FLineInfo.Master := nil;
FCallStack.Supplier := nil;
FDisassembler.Master := nil;
FExceptions.Master := nil;
//FExceptions.Master := nil;
FSignals.Master := nil;
// FRegisters.Master := nil;

5
debugger/test/Gdbmi/testdisass.pas
View File

@ -350,7 +350,7 @@ var
FLocals.Supplier := Gdb.Locals;
FLineInfo.Master := Gdb.LineInfo;
FCallStack.Supplier := Gdb.CallStack;
FExceptions.Master := Gdb.Exceptions;
Gdb.Exceptions := FExceptions;
FSignals.Master := Gdb.Signals;
FRegisters.Master := Gdb.Registers;
@ -459,7 +459,7 @@ begin
Init;
SetLength(Gdb.TestDisAssRegions, 2);
with Gdb.TestDisAssRegions[0] do begin
FirstAddr := $30100-180; LastAddr := $30100-20; InstrLen := 8;
FirstAddr := $30100-188; LastAddr := $30100-20; InstrLen := 16;
FuncName := 'abc';
end;
with Gdb.TestDisAssRegions[1] do begin
@ -507,7 +507,6 @@ begin
{%region fail mem dump}
Init;
Gdb.TestFailMemDump := True;

8
ide/debugmanager.pas
View File

@ -938,7 +938,8 @@ begin
end;
// watch was not added automatically => show a dialog
ShowWatchProperties(nil, '');
if ShowWatchProperties(nil, '') = mrOK then
ViewDebugDialog(ddtWatches, False);
end;
//-----------------------------------------------------------------------------
@ -2936,6 +2937,7 @@ begin
FDebugger.OnConsoleOutput := nil;
FDebugger.OnFeedback := nil;
FDebugger.OnIdle := nil;
FDebugger.Exceptions := nil;
end;
FDebugger := ADebugger;
@ -2948,7 +2950,6 @@ begin
FLineInfo.Master := nil;
FCallStack.Supplier := nil;
FDisassembler.Master := nil;
FExceptions.Master := nil;
FSignals.Master := nil;
FRegisters.Master := nil;
FSnapshots.Debugger := nil;
@ -2962,10 +2963,11 @@ begin
FLineInfo.Master := FDebugger.LineInfo;
FCallStack.Supplier := FDebugger.CallStack;
FDisassembler.Master := FDebugger.Disassembler;
FExceptions.Master := FDebugger.Exceptions;
FSignals.Master := FDebugger.Signals;
FRegisters.Master := FDebugger.Registers;
FSnapshots.Debugger := FDebugger;
FDebugger.Exceptions := FExceptions;
end;
end;

2
ide/sourceeditor.pp
View File

@ -8057,8 +8057,8 @@ Begin
TopLine := SrcEdit.EditorComponent.TopLine;
TSynEditMarkupManager(SrcEdit.EditorComponent.MarkupMgr).IncPaintLock;
SrcEdit.BeginUpdate;
SrcEdit.FEditor.HandleNeeded; // make sure we have a handle
SrcEdit.Visible := True;
SrcEdit.FEditor.Handle; // make sure we have a handle
SrcEdit.EndUpdate;
// Restore the intial Positions, must be after lock
SrcEdit.EditorComponent.LeftChar := 1;

9
lcl/interfaces/qt/qtobjects.pas
View File

@ -2776,6 +2776,15 @@ begin
{$ifdef VerboseQt}
writeln('TQtDeviceContext.drawRect() x1: ',x1,' y1: ',y1,' w: ',w,' h: ',h);
{$endif}
{Important note: sometimes QPainter_drawRect() fails (diagonal line over rect)
with raster graphicssystem (spotted with qt-4.8.5 under Fedora 19 32bit).
With native (X11) graphicssystem it looks ok.
Solution until it's fixed in Qt:
APath := QPainterPath_create;
QPainterPath_addRect(APath, x1, y1, w, h);
QPainter_drawPath(Widget, APath);
QPainterPath_destroy(APath);
}
QPainter_drawRect(Widget, x1, y1, w, h);
end;