paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 07:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed initialenabled, debuggertype, linkscaner open string constant

Browse Source 
git-svn-id: trunk@4458 -
This commit is contained in:
mattias 2003-08-08 10:24:48 +00:00
parent 845d0b41cf
commit 177677936d
8 changed files with 115 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
components/codetools/linkscanner.pas
View File

@ -841,6 +841,7 @@ procedure TLinkScanner.ReadNextToken;
begin
Result:=false;
if not ReturnFromIncludeFile then begin
SrcPos:=SrcLen+1; // make sure SrcPos stands somewhere
TokenStart:=SrcPos;
TokenType:=lsttSrcEnd;
Result:=true;
@ -909,10 +910,19 @@ begin
'''':
begin
inc(SrcPos);
while (SrcPos<=SrcLen)
and (Src[SrcPos]<>'''') do
inc(SrcPos);
inc(SrcPos);
while (SrcPos<=SrcLen) do begin
case Src[SrcPos] of
'''':
begin
inc(SrcPos);
break;
end;
#10,#13:
break;
else
inc(SrcPos);
end;
end;
end;
else
break;
@ -1073,19 +1083,17 @@ begin
end;
ReadNextToken;
//writeln('TLinkScanner.Scan G "',copy(Src,TokenStart,SrcPos-TokenStart),'"');
if (SrcPos<=SrcLen+1) then begin
if (TokenType=lsttEndOfInterface) and (LastTokenType<>lsttEqual) then
begin
EndOfInterfaceFound:=true;
if ScanTillInterfaceEnd then break;
end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
EndOfInterfaceFound:=true;
EndOfSourceFound:=true;
break;
end;
LastTokenType:=TokenType;
end else
if (TokenType=lsttEndOfInterface) and (LastTokenType<>lsttEqual) then
begin
EndOfInterfaceFound:=true;
if ScanTillInterfaceEnd then break;
end else if (LastTokenType=lsttEnd) and (TokenType=lsttPoint) then begin
EndOfInterfaceFound:=true;
EndOfSourceFound:=true;
break;
end else if SrcPos>SrcLen then
break;
LastTokenType:=TokenType;
until false;
finally
if not FSkippingTillEndif then begin

43
debugger/debugger.pp
View File

@ -196,13 +196,14 @@ type
procedure SetEnabled(const AValue: Boolean); virtual;
procedure SetExpression(const AValue: String); virtual;
procedure SetInitialEnabled(const AValue: Boolean); virtual;
public
constructor Create(ACollection: TCollection); override;
function GetSourceLine: integer; virtual;
property Enabled: Boolean read GetEnabled write SetEnabled;
property Expression: String read GetExpression write SetExpression;
property HitCount: Integer read GetHitCount;
property InitialEnabled: Boolean read FInitialEnabled write FInitialEnabled;
property InitialEnabled: Boolean read FInitialEnabled write SetInitialEnabled;
property Line: Integer read GetLine;
property Source: String read GetSource;
property Valid: TValidState read GetValid;
@ -1358,6 +1359,13 @@ end;
TBaseBreakPoint
=========================================================================== }
procedure TBaseBreakPoint.SetInitialEnabled(const AValue: Boolean);
begin
if FInitialEnabled=AValue then exit;
//writeln('TBaseBreakPoint.SetInitialEnabled A Self=',HexStr(Cardinal(Self),8),' ',ClassName,' Line=',Line,' AValue=',AValue);
FInitialEnabled:=AValue;
end;
procedure TBaseBreakPoint.AssignTo(Dest: TPersistent);
var
DestBreakPoint: TBaseBreakPoint;
@ -1369,6 +1377,7 @@ begin
DestBreakPoint.SetLocation(FSource, FLine);
DestBreakPoint.SetExpression(FExpression);
DestBreakPoint.SetEnabled(FEnabled);
//writeln('TBaseBreakPoint.AssignTo A ',Line,' Enabled=',Enabled,' InitialEnabled=',InitialEnabled);
DestBreakPoint.InitialEnabled := FInitialEnabled;
end
else inherited;
@ -2261,35 +2270,6 @@ begin
Items[i].Enabled:=Items[i].InitialEnabled;
end;
(*
procedure TIDEBreakPointGroups.Regroup(SrcGroups: TIDEBreakPointGroups;
SrcBreakPoints, DestBreakPoints: TIDEBreakPoints);
var
BreakPointCnt: Integer;
i: Integer;
SrcBreakPoint: TIDEBreakPoint;
DestBreakPoint: TIDEBreakPoint;
begin
// copy the groups
Assign(SrcGroups);
// copy the groups of the SrcBreakPoints to the DestBreakPoints by using
// the new groups
BreakPointCnt:=SrcBreakPoints.Count;
if BreakPointCnt<>DestBreakPoints.Count then
RaiseException('TIDEBreakPointGroups.Regroup Src<>Dest breakpoints');
for i:=0 to BreakPointCnt-1 do begin
SrcBreakPoint:=SrcBreakPoints[i];
DestBreakPoint:=DestBreakPoints[i];
// copy group of breakpoint
if SrcBreakPoint.Group<>nil then
DestBreakPoint.Group:=GetGroupByName(SrcBreakPoint.Group.Name)
else
DestBreakPoint.Group:=nil;
// copy group lists of breakpoint
DestBreakPoint.CopyAllGroupLists(SrcBreakPoint,Self);
end;
end;
*)
function TIDEBreakPointGroups.GetItem(const AnIndex: Integer
): TIDEBreakPointGroup;
begin
@ -3114,6 +3094,9 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.51 2003/08/08 10:24:48 mattias
fixed initialenabled, debuggertype, linkscaner open string constant
Revision 1.50 2003/08/08 07:49:56 mattias
fixed mem leaks in debugger

5
debugger/gdbmidebugger.pp
View File

@ -1511,7 +1511,7 @@ begin
if Debugger.State = dsRun
then TGDBMIDebugger(Debugger).GDBPause(True);
writeln('TGDBMIBreakPoint.UpdateEnable Line=',Line,' Enabled=',Enabled,' InitialEnabled=',InitialEnabled);
//writeln('TGDBMIBreakPoint.UpdateEnable Line=',Line,' Enabled=',Enabled,' InitialEnabled=',InitialEnabled);
TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d',
[CMD[Enabled], FBreakID], []);
end;
@ -2065,6 +2065,9 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.37 2003/08/08 10:24:48 mattias
fixed initialenabled, debuggertype, linkscaner open string constant
Revision 1.36 2003/08/08 07:49:56 mattias
fixed mem leaks in debugger

5
ide/basedebugmanager.pas
View File

@ -72,7 +72,7 @@ type
function DoStopProject: TModalResult; virtual; abstract;
procedure DoToggleCallStack; virtual; abstract;
procedure RunDebugger; virtual; abstract;
function RunDebugger: TModalResult; virtual; abstract;
procedure EndDebugging; virtual; abstract;
function Evaluate(const AExpression: String; var AResult: String
): Boolean; virtual; abstract; // Evaluates the given expression, returns true if valid
@ -148,6 +148,9 @@ end.
{ =============================================================================
$Log$
Revision 1.18 2003/08/08 10:24:47 mattias
fixed initialenabled, debuggertype, linkscaner open string constant
Revision 1.17 2003/07/31 00:42:20 marc
* Fixed classof to object cast

42
ide/debugmanager.pas
View File

@ -138,7 +138,7 @@ type
function DoStopProject: TModalResult; override;
procedure DoToggleCallStack; override;
procedure RunDebugger; override;
function RunDebugger: TModalResult; override;
procedure EndDebugging; override;
function Evaluate(const AExpression: String;
var AResult: String): Boolean; override;
@ -181,6 +181,7 @@ type
procedure OnDeleteMenuItemClick(Sender: TObject);
procedure OnViewPropertiesMenuItemClick(Sender: TObject);
procedure SetEnabled(const AValue: Boolean); override;
procedure SetInitialEnabled(const AValue: Boolean); override;
procedure SetExpression(const AValue: String); override;
procedure SetLocation(const ASource: String; const ALine: Integer); override;
procedure SetSourceMark(const AValue: TSourceMark);
@ -532,6 +533,13 @@ begin
if FMaster <> nil then FMaster.Enabled := AValue;
end;
procedure TManagedBreakPoint.SetInitialEnabled(const AValue: Boolean);
begin
if InitialEnabled = AValue then exit;
inherited SetInitialEnabled(AValue);
if FMaster <> nil then FMaster.InitialEnabled := AValue;
end;
procedure TManagedBreakPoint.SetExpression(const AValue: String);
begin
if AValue=Expression then exit;
@ -951,7 +959,6 @@ begin
ddtLocals: InitLocalsDlg;
ddtCallStack: InitCallStackDlg;
end;
//DoInitDebugger;
CurDialog.Debugger := FDebugger;
end else begin
CurDialog:=FDialogs[ADialogType];
@ -1266,8 +1273,12 @@ var
procedure RestoreDebuggerItems;
begin
// restore the watches
if OldWatches<>nil then
FWatches.Assign(OldWatches);
if (OldWatches<>nil) then begin
if FWatches=nil then
FWatches:=OldWatches
else if FWatches<>OldWatches then
FWatches.Assign(OldWatches);
end;
end;
procedure FreeDebugger;
@ -1334,7 +1345,8 @@ begin
RestoreDebuggerItems;
end;
finally
OldWatches.Free;
if FWatches<>OldWatches then
OldWatches.Free;
end;
FDebugger.OnState := @OnDebuggerChangeState;
@ -1423,10 +1435,16 @@ begin
ViewDebugDialog(ddtCallStack);
end;
procedure TDebugManager.RunDebugger;
function TDebugManager.RunDebugger: TModalResult;
begin
//writeln('TDebugManager.RunDebugger A ',FDebugger<>nil,' Destroying=',Destroying);
Result:=mrCancel;
if Destroying then exit;
if (FDebugger <> nil) then FDebugger.Run;
if (FDebugger <> nil) then begin
writeln('TDebugManager.RunDebugger B ',FDebugger.ClassName);
FDebugger.Run;
Result:=mrOk;
end;
end;
procedure TDebugManager.EndDebugging;
@ -1505,6 +1523,7 @@ var
ActiveUnitInfo: TUnitInfo;
UnitFilename: string;
begin
writeln('TDebugManager.DoRunToCursor A');
if (MainIDE.DoInitProjectRun <> mrOK)
or (MainIDE.ToolStatus <> itDebugger)
or (FDebugger = nil) or Destroying
@ -1512,14 +1531,16 @@ begin
Result := mrAbort;
Exit;
end;
writeln('TDebugManager.DoRunToCursor B');
Result := mrCancel;
MainIDE.GetCurrentUnit(ActiveSrcEdit, ActiveUnitInfo);
MainIDE.GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
then begin
MessageDlg(lisRunToFailed, lisPleaseOpenAUnitBeforeRun, mtError,
[mbCancel],0);
Result := mrCancel;
Exit;
end;
@ -1527,9 +1548,11 @@ begin
then UnitFilename:=ActiveUnitInfo.Filename
else UnitFilename:=MainIDE.GetTestUnitFilename(ActiveUnitInfo);
writeln('TDebugManager.DoRunToCursor C');
FDebugger.RunTo(ExtractFilename(UnitFilename),
ActiveSrcEdit.EditorComponent.CaretY);
writeln('TDebugManager.DoRunToCursor D');
Result := mrOK;
end;
@ -1551,6 +1574,9 @@ end.
{ =============================================================================
$Log$
Revision 1.60 2003/08/08 10:24:47 mattias
fixed initialenabled, debuggertype, linkscaner open string constant
Revision 1.59 2003/08/08 07:49:56 mattias
fixed mem leaks in debugger

56
ide/environmentopts.pp
View File

@ -191,7 +191,6 @@ type
FDebuggerClass: string;
FDebuggerFilename: string; // per debugger class
FDebuggerFileHistory: TStringList; // per debugger class
FDebuggerType: TDebuggerType; // obsolete
FTestBuildDirectory: string;
FTestBuildDirHistory: TStringList;
@ -222,7 +221,6 @@ type
procedure SetCompilerFilename(const AValue: string);
procedure SetDebuggerFilename(const AValue: string);
procedure SetDebuggerType (const AValue: TDebuggerType );
procedure SetFPCSourceDirectory(const AValue: string);
procedure SetLazarusDirectory(const AValue: string);
procedure SetOnApplyWindowLayout(const AValue: TOnApplyIDEWindowLayout);
@ -243,9 +241,10 @@ type
procedure SetLazarusDefaultFilename;
procedure GetDefaultFPCSourceDirectory;
procedure CreateWindowLayout(const TheFormID: string);
function DebuggerClassIsDefined: boolean;
property OnApplyWindowLayout: TOnApplyIDEWindowLayout
read FOnApplyWindowLayout write SetOnApplyWindowLayout;
// auto save
property AutoSaveEditorFiles: boolean read FAutoSaveEditorFiles
write FAutoSaveEditorFiles;
@ -322,8 +321,6 @@ type
write SetDebuggerFilename;
property DebuggerFileHistory: TStringList read FDebuggerFileHistory
write FDebuggerFileHistory;
property DebuggerType: TDebuggerType read FDebuggerType
write SetDebuggerType;
property TestBuildDirectory: string read FTestBuildDirectory
write SetTestBuildDirectory;
property TestBuildDirHistory: TStringList read FTestBuildDirHistory
@ -807,7 +804,6 @@ begin
FFPCSourceDirHistory:=TStringList.Create;
DebuggerFilename:='';
FDebuggerFileHistory:=TStringList.Create;
FDebuggerType:=dtNone;
TestBuildDirectory:={$ifdef win32}'c:\temp\'{$else}'/tmp/'{$endif};
FTestBuildDirHistory:=TStringList.Create;
@ -890,6 +886,8 @@ end;
procedure TEnvironmentOptions.Load(OnlyDesktop:boolean);
var XMLConfig: TXMLConfig;
FileVersion: integer;
CurDebuggerClass: String;
OldDebuggerType: TDebuggerType;
procedure LoadBackupInfo(var BackupInfo: TBackupInfo; const Path:string);
var i:integer;
@ -914,13 +912,13 @@ var XMLConfig: TXMLConfig;
end;
end;
procedure LoadDebuggerType(var ADebuggerType: TDebuggerType;
procedure LoadDebuggerType(var ADebuggerType: TDebuggerType;
const Path: string);
begin
ADebuggerType:=DebuggerNameToType(
XMLConfig.GetValue(Path+'Debugger/Type',''));
end;
procedure LoadPascalFileExt(const Path: string);
begin
fPascalFileExtension:=PascalExtToType(XMLConfig.GetValue(
@ -1064,10 +1062,16 @@ begin
// Debugger
// first try to load the old type
// it will be overwritten by Class if found
DebuggerType := DebuggerNameToType(XMLConfig.GetValue(
'EnvironmentOptions/Debugger/Type',''));
DebuggerClass := XMLConfig.GetValue(
'EnvironmentOptions/Debugger/Class',FDebuggerClass);
CurDebuggerClass := XMLConfig.GetValue(
'EnvironmentOptions/Debugger/Class','');
if CurDebuggerClass='' then begin
// try old format
OldDebuggerType := DebuggerNameToType(XMLConfig.GetValue(
'EnvironmentOptions/Debugger/Type',''));
if OldDebuggerType=dtGnuDebugger then
CurDebuggerClass:='TGDBMIDEBUGGER';
end;
DebuggerClass:=CurDebuggerClass;
DebuggerFilename:=XMLConfig.GetValue(
'EnvironmentOptions/DebuggerFilename/Value',FDebuggerFilename);
LoadRecentList(XMLConfig,FDebuggerFileHistory,
@ -1254,14 +1258,12 @@ begin
,'EnvironmentOptions/BackupOtherFiles/');
// debugger
XMLConfig.SetValue('EnvironmentOptions/Debugger/Class', FDebuggerClass);
XMLConfig.SetValue(
'EnvironmentOptions/DebuggerFilename/Value',FDebuggerFilename);
XMLConfig.SetDeleteValue('EnvironmentOptions/Debugger/Class',
FDebuggerClass,'');
XMLConfig.SetDeleteValue('EnvironmentOptions/DebuggerFilename/Value',
FDebuggerFilename,'');
SaveRecentList(XMLConfig,FDebuggerFileHistory,
'EnvironmentOptions/DebuggerFilename/History/');
//TODO: remove when registerdebugger is operational
// SaveDebuggerType(DebuggerType,'EnvironmentOptions/');
//--
end;
// hints
@ -1375,6 +1377,12 @@ begin
IDEWindowLayoutList.Add(NewLayout);
end;
function TEnvironmentOptions.DebuggerClassIsDefined: boolean;
begin
Result:=(FDebuggerClass='')
or (AnsiCompareText(FDebuggerClass,DebuggerName[dtNone])=0);
end;
function TEnvironmentOptions.FileHasChangedOnDisk: boolean;
begin
Result:=FFileHasChangedOnDisk
@ -1447,18 +1455,6 @@ begin
copy(FDebuggerFilename,SpacePos,length(FDebuggerFilename)-SpacePos+1);
end;
procedure TEnvironmentOptions.SetDebuggerType(const AValue: TDebuggerType);
const
CLASSNAMES: array[TDebuggerType] of String = (
'', 'TGDBMIDEBUGGER', 'TSSHGDBMIDEBUGGER'
);
begin
if FDebuggerType = AValue then Exit;
FDebuggerType := AValue;
DebuggerClass := CLASSNAMES[FDebuggerType];
end;
//==============================================================================
{ TEnvironmentOptionsDialog }

4
ide/ideoptiondefs.pas
View File

@ -33,7 +33,7 @@ unit IDEOptionDefs;
interface
uses
Classes, SysUtils, Laz_XMLCfg, Forms, Controls, StdCtrls, Buttons,
Classes, SysUtils, Laz_XMLCfg, LCLProc, Forms, Controls, StdCtrls, Buttons,
LazarusIDEStrConsts;
type
@ -736,6 +736,8 @@ procedure TIDEWindowLayoutList.Apply(AForm: TForm; const ID: string);
var ALayout: TIDEWindowLayout;
begin
ALayout:=ItemByFormID(ID);
if ALayout=nil then
RaiseGDBException(ID);
ALayout.Form:=AForm;
ALayout.Apply;
end;

10
ide/main.pp
View File

@ -5670,12 +5670,13 @@ begin
Result := mrAbort;
Exit;
end;
//Writeln('[TMainIDE.DoRunProject] B ',EnvironmentOptions.DebuggerClass);
Result := mrCancel;
if EnvironmentOptions.DebuggerType <> dtNone then begin
DebugBoss.RunDebugger;
Result := mrOK;
if not EnvironmentOptions.DebuggerClassIsDefined then begin
Result := DebugBoss.RunDebugger;
if Result<>mrOk then exit;
end else begin
if FRunProcess = nil then Exit;
try
@ -9367,6 +9368,9 @@ end.
{ =============================================================================
$Log$
Revision 1.630 2003/08/08 10:24:47 mattias
fixed initialenabled, debuggertype, linkscaner open string constant
Revision 1.629 2003/08/03 10:27:30 mattias
fixed fpc src defines for bsd