From 177677936d4183d65192c0fddcd080ec896fe008 Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 8 Aug 2003 10:24:48 +0000 Subject: [PATCH] fixed initialenabled, debuggertype, linkscaner open string constant git-svn-id: trunk@4458 - --- components/codetools/linkscanner.pas | 40 ++++++++++++-------- debugger/debugger.pp | 43 +++++++-------------- debugger/gdbmidebugger.pp | 5 ++- ide/basedebugmanager.pas | 5 ++- ide/debugmanager.pas | 42 +++++++++++++++++---- ide/environmentopts.pp | 56 +++++++++++++--------------- ide/ideoptiondefs.pas | 4 +- ide/main.pp | 10 +++-- 8 files changed, 115 insertions(+), 90 deletions(-) diff --git a/components/codetools/linkscanner.pas b/components/codetools/linkscanner.pas index 47c1cb64ac..c8def1394f 100644 --- a/components/codetools/linkscanner.pas +++ b/components/codetools/linkscanner.pas @@ -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 diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 8b0edcb727..b734622b0f 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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 diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 98b3a86e94..9a5d893c15 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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 diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index ce3722e0f2..a162ec66e2 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -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 diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 9e494e8842..610b7839ad 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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 diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index 0ef63c9ec6..7c6d168696 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -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 } diff --git a/ide/ideoptiondefs.pas b/ide/ideoptiondefs.pas index 2caedf7e1a..8b031288fd 100644 --- a/ide/ideoptiondefs.pas +++ b/ide/ideoptiondefs.pas @@ -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; diff --git a/ide/main.pp b/ide/main.pp index dafa558f72..5b2be6a8ca 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -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