From f03569a3c1ffa624c5c8d1ddd707fdbdb3ed5c27 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 16 Jul 2007 21:23:55 +0000 Subject: [PATCH] IDE: added compiler check for relative unit paths, missing directories, wrong * character, ambiguous fpc configs, missing fpc config git-svn-id: trunk@11529 - --- components/codetools/codetoolmanager.pas | 4 +- components/codetools/fpc.errore.msg | 5 + ide/checkcompileropts.pas | 406 ++++++++++++++++++----- ide/compileroptions.pp | 28 +- ide/compileroptionsdlg.pp | 72 +++- ide/ideprocs.pp | 24 +- ide/imexportcompileropts.pas | 10 +- ide/main.pp | 8 +- lcl/interfaces/gtk/gtk1extra.inc | 2 +- 9 files changed, 439 insertions(+), 120 deletions(-) diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 2438e0ad4d..3e1a40add5 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -21,8 +21,8 @@ Author: Mattias Gaertner Abstract: - TCodeToolManager gathers all tools in one single Object and makes it easy - to use the code tools in a program. + TCodeToolManager gathers all tools in one single Object + to easily use the code tools in a program. } unit CodeToolManager; diff --git a/components/codetools/fpc.errore.msg b/components/codetools/fpc.errore.msg index 6271071caa..e360ec53a3 100644 --- a/components/codetools/fpc.errore.msg +++ b/components/codetools/fpc.errore.msg @@ -29,6 +29,11 @@ general_t_objectpath=01007_T_Using object path: $1 % looks for object files you link in (files used in \var{\{\$L xxx\}} statements). % You can set this path with the \var{-Fo} option. +option_using_file=11026_T_Reading options from file $1 +% Options are also read from this file + +% Options are also read from this environment string +option_handling_option=11028_D_Handling option "$1" # end. diff --git a/ide/checkcompileropts.pas b/ide/checkcompileropts.pas index 621c194d48..5a4bb9f19f 100644 --- a/ide/checkcompileropts.pas +++ b/ide/checkcompileropts.pas @@ -1,3 +1,23 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** +} unit CheckCompilerOpts; {$mode objfpc}{$H+} @@ -5,8 +25,9 @@ unit CheckCompilerOpts; interface uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, - Buttons, FileUtil, + Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, Buttons, FileUtil, Process, + KeywordFuncLists, CodeToolManager, IDEExternToolIntf, IDEProcs, EnvironmentOpts, LazarusIDEStrConsts, CompilerOptions, ExtToolEditDlg, TransferMacros, LazConf; @@ -15,17 +36,18 @@ type TCompilerOptionsTest = ( cotNone, cotCheckCompilerExe, - cotCompileBogusFiles + cotCompileBogusFiles, + cotCheckCompilerConfig // e.g. fpc.cfg ); { TCheckCompilerOptsDlg } TCheckCompilerOptsDlg = class(TForm) CloseButton1: TBitBtn; - TestMemo: TMEMO; - TestGroupbox: TGROUPBOX; - OutputListbox: TLISTBOX; - OutputGroupBox: TGROUPBOX; + TestMemo: TMemo; + TestGroupbox: TGroupBox; + OutputListbox: TListbox; + OutputGroupBox: TGroupBox; procedure ApplicationOnIdle(Sender: TObject; var Done: Boolean); procedure CloseButtonCLICK(Sender: TObject); private @@ -37,6 +59,11 @@ type procedure SetMacroList(const AValue: TTransferMacroList); procedure SetOptions(const AValue: TCompilerOptions); procedure SetMsgDirectory(Index: integer; const CurDir: string); + function CheckCompilerExecutable(const CompilerFilename: string): TModalResult; + function CheckAmbiguousFPCCfg(const CompilerFilename: string): TModalResult; + function CheckCompilerConfig(const CompilerFilename: string; + out FPCCfgUnitPath: string): TModalResult; + function CheckCompileBogusFile(const CompilerFilename: string): TModalResult; public function DoTest: TModalResult; constructor Create(TheOwner: TComponent); override; @@ -46,6 +73,8 @@ type OriginalIndex: integer); procedure AddMsg(const Msg, CurDir: String; OriginalIndex: integer); procedure AddProgress(Line: TIDEScanMessageLine); + procedure AddHint(const Msg: string); + procedure AddWarning(const Msg: string); public property Options: TCompilerOptions read FOptions write SetOptions; property Test: TCompilerOptionsTest read FTest; @@ -85,6 +114,273 @@ begin FDirectories[Index]:=CurDir; end; +function TCheckCompilerOptsDlg.CheckCompilerExecutable( + const CompilerFilename: string): TModalResult; +var + CompilerFiles: TStrings; +begin + FTest:=cotCheckCompilerExe; + TestGroupbox.Caption:='Test: Checking compiler ...'; + try + CheckIfFileIsExecutable(CompilerFilename); + except + on e: Exception do begin + Result:=QuestionDlg('Invalid compiler', + 'The compiler "'+CompilerFilename+'" is not an executable file.'#13 + +'Details: '+E.Message, + mtError,[mrCancel,'Skip',mrAbort],0); + exit; + end; + end; + + // check if there are several compilers in path + CompilerFiles:=SearchAllFilesInPath(GetDefaultCompilerFilename,'', + SysUtils.GetEnvironmentVariable('PATH'),':',[sffDontSearchInBasePath]); + if (CompilerFiles<>nil) and (CompilerFiles.Count>1) then begin + Result:=MessageDlg('Ambiguous Compiler', + 'There are several FreePascal Compilers in your path.'#13#13 + +CompilerFiles.Text+#13 + +'Maybe you forgot to delete an old compiler?', + mtWarning,[mbCancel,mbIgnore],0); + if Result<>mrIgnore then exit; + end; + + Result:=mrOk; +end; + +function TCheckCompilerOptsDlg.CheckAmbiguousFPCCfg( + const CompilerFilename: string): TModalResult; +var + CfgFiles: TStringList; + Dir: String; + Filename: String; + i: Integer; +begin + CfgFiles:=TStringList.Create; + + // check $HOME/.fpc.cfg + Dir:=SysUtils.GetEnvironmentVariable('HOME'); + if Dir<>'' then begin + Filename:=CleanAndExpandDirectory(Dir)+'.fpc.cfg'; + if FileExists(Filename) then + CfgFiles.Add(Filename); + end; + + // check compiler path + fpc.cfg + Dir:=ExtractFilePath(CompilerFilename); + Dir:=SysUtils.GetEnvironmentVariable('HOME'); + if Dir<>'' then begin + Filename:=CleanAndExpandDirectory(Dir)+'fpc.cfg'; + if FileExists(Filename) then + CfgFiles.Add(Filename); + end; + + // check /etc/fpc.cfg + {$IFDEF Unix} + Dir:=ExtractFilePath(CompilerFilename); + Dir:=SysUtils.GetEnvironmentVariable('HOME'); + if Dir<>'' then begin + Filename:='/etc/fpc.cfg'; + if FileExists(Filename) then + CfgFiles.Add(Filename); + end; + {$ENDIF} + + // warn about missing or too many fpc.cfg + if CfgFiles.Count<1 then begin + AddWarning('no fpc.cfg found'); + end else if CfgFiles.Count>1 then begin + for i:=0 to CfgFiles.Count-1 do + AddWarning('multiple compiler configs found: '+CfgFiles[i]); + end; + + CfgFiles.Free; + Result:=mrOk; +end; + +function TCheckCompilerOptsDlg.CheckCompileBogusFile( + const CompilerFilename: string): TModalResult; +var + TestDir: String; + BogusFilename: String; + CmdLineParams: String; + CompileTool: TExternalToolOptions; +begin + // compile bogus file + FTest:=cotCompileBogusFiles; + TestGroupbox.Caption:='Test: Compiling an empty file ...'; + // get Test directory + TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory); + if not DirPathExists(TestDir) then begin + MessageDlg('Invalid Test Directory', + 'Please check the Test directory under'#13 + +'Environment -> Environment Options -> Files -> Directory for building test projects', + mtError,[mbCancel],0); + Result:=mrCancel; + exit; + end; + // create bogus file + BogusFilename:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas'); + if not CreateEmptyFile(BogusFilename) then begin + MessageDlg('Unable to create Test File', + 'Unable to create Test pascal file "'+BogusFilename+'".', + mtError,[mbCancel],0); + Result:=mrCancel; + exit; + end; + try + // create compiler command line options + CmdLineParams:=Options.MakeOptionsString(BogusFilename,nil, + [ccloAddVerboseAll,ccloDoNotAppendOutFileOption]) + +' '+BogusFilename; + + CompileTool:=TExternalToolOptions.Create; + CompileTool.Title:='Test: Compiling empty file'; + CompileTool.ScanOutputForFPCMessages:=true; + CompileTool.ScanOutputForMakeMessages:=true; + CompileTool.WorkingDirectory:=TestDir; + CompileTool.Filename:=CompilerFilename; + CompileTool.CmdLineParams:=CmdLineParams; + + Result:=RunTool(CompileTool); + FreeThenNil(CompileTool); + finally + DeleteFile(BogusFilename); + end; + + Result:=mrOk; +end; + +function TCheckCompilerOptsDlg.CheckCompilerConfig( + const CompilerFilename: string; out FPCCfgUnitPath: string): TModalResult; + + procedure ProcessOutputLine(const Line: string); + const + USING_UNIT_PATH = 'USING UNIT PATH: '; + READING_OPTIONS_FROM_FILE = 'READING OPTIONS FROM FILE '; + HANDLING_OPTION = 'HANDLING OPTION '; + var + len, curpos: integer; + NewPath: String; + UpLine: String; + begin + len := length(Line); + if len <= 6 then Exit; // shortest match + + CurPos := 1; + // strip timestamp e.g. [0.306] + if Line[CurPos] = '[' then begin + repeat + inc(CurPos); + if CurPos > len then Exit; + until line[CurPos] = ']'; + Inc(CurPos, 2); //skip space also + if len - CurPos < 6 then Exit; // shortest match + end; + + UpLine:=UpperCaseStr(Line); + + case UpLine[CurPos] of + 'C': + if (StrLComp(@UpLine[CurPos], READING_OPTIONS_FROM_FILE, + length(READING_OPTIONS_FROM_FILE)) = 0) then + begin + // show a hint what cfg file is read by FPC + AddHint(Line); + end; + 'U': + if (StrLComp(@UpLine[CurPos], USING_UNIT_PATH, length(USING_UNIT_PATH)) = 0) + then begin + Inc(CurPos, length(USING_UNIT_PATH)); + NewPath:=copy(Line,CurPos,len); + if not FilenameIsAbsolute(NewPath) then begin + AddWarning('relative unit path found in fpc cfg: '+NewPath); + NewPath:=ExpandFileName(NewPath); + end; + //DebugLn(['TCheckCompilerOptsDlg.CheckCompilerConfig: Using unit path: "',NewPath,'"']); + FPCCfgUnitPath:=FPCCfgUnitPath+NewPath+';'; + end; + end; + end; + +var + TestDir: String; + ATestPascalFile: String; + CurCompilerOptions: String; + TargetOS: String; + TargetCPU: String; + OutputLine: String; + TheProcess: TProcess; + OutLen: Integer; + LineStart: integer; + i: Integer; + CmdLine: string; + Buf: string; +begin + FPCCfgUnitPath:=''; + + FTest:=cotCheckCompilerConfig; + TestGroupbox.Caption:='Test: Checking compiler configuration ...'; + + Result:=CheckAmbiguousFPCCfg(CompilerFilename); + if not (Result in [mrOk,mrIgnore]) then exit; + + TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory); + ATestPascalFile:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas'); + + CurCompilerOptions:=''; + TargetOS:=Options.TargetOS; + if TargetOS<>'' then + CurCompilerOptions:=AddCmdLineParameter(CurCompilerOptions,'-T'+TargetOS); + TargetCPU:=Options.TargetCPU; + if TargetCPU<>'' then + CurCompilerOptions:=AddCmdLineParameter(CurCompilerOptions,'-P'+TargetCPU); + + CmdLine:=CompilerFilename+' -va '; + if FileExistsCached(CodeToolBoss.DefinePool.EnglishErrorMsgFilename) then + CmdLine:=CmdLine+'-Fr'+CodeToolBoss.DefinePool.EnglishErrorMsgFilename+' '; + if CurCompilerOptions<>'' then + CmdLine:=CmdLine+CurCompilerOptions+' '; + CmdLine:=CmdLine+ATestPascalFile; + + TheProcess := TProcess.Create(nil); + TheProcess.CommandLine := CmdLine; + TheProcess.Options:= [poUsePipes, poStdErrToOutPut]; + TheProcess.ShowWindow := swoHide; + try + TheProcess.Execute; + OutputLine:=''; + SetLength(Buf,1024); + repeat + if (TheProcess.Output<>nil) then begin + OutLen:=TheProcess.Output.Read(Buf[1],length(Buf)); + end else + OutLen:=0; + LineStart:=1; + i:=1; + while i<=OutLen do begin + if Buf[i] in [#10,#13] then begin + OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart); + ProcessOutputLine(OutputLine); + OutputLine:=''; + if (iBuf[i+1]) + then + inc(i); + LineStart:=i+1; + end; + inc(i); + end; + OutputLine:=copy(Buf,LineStart,OutLen-LineStart+1); + until OutLen=0; + TheProcess.WaitOnExit; + finally + //DebugLn('TDefinePool.CreateFPCTemplate Run with -va: OutputLine="',OutputLine,'"'); + TheProcess.Free; + end; + + Result:=mrOk; +end; + procedure TCheckCompilerOptsDlg.SetMacroList(const AValue: TTransferMacroList); begin if FMacroList=AValue then exit; @@ -93,12 +389,10 @@ end; function TCheckCompilerOptsDlg.DoTest: TModalResult; var - TestDir: String; - BogusFilename: String; CompilerFilename: String; CompileTool: TExternalToolOptions; - CmdLineParams: String; CompilerFiles: TStrings; + FPCCfgUnitPath: string; begin Result:=mrCancel; if Test<>cotNone then exit; @@ -106,77 +400,24 @@ begin TestMemo.Lines.Clear; CompilerFiles:=nil; try - // check compiler filename - FTest:=cotCheckCompilerExe; - TestGroupbox.Caption:='Test: Checking compiler ...'; CompilerFilename:=Options.ParsedOpts.GetParsedValue(pcosCompilerPath); - try - CheckIfFileIsExecutable(CompilerFilename); - except - on e: Exception do begin - Result:=MessageDlg('Invalid compiler', - 'The compiler "'+CompilerFilename+'" is not an executable file.', - mtError,[mbCancel,mbAbort],0); - exit; - end; - end; - - // check if there are several compilers in path - CompilerFiles:=SearchAllFilesInPath(GetDefaultCompilerFilename,'', - SysUtils.GetEnvironmentVariable('PATH'),':',[sffDontSearchInBasePath]); - if (CompilerFiles<>nil) and (CompilerFiles.Count>1) then begin - Result:=MessageDlg('Ambiguous Compiler', - 'There are several FreePascal Compilers in your path.'#13#13 - +CompilerFiles.Text+#13 - +'Maybe you forgot to delete an old compiler?', - mtWarning,[mbCancel,mbIgnore],0); - if Result<>mrIgnore then exit; - end; - + + // check compiler filename + Result:=CheckCompilerExecutable(CompilerFilename); + if not (Result in [mrOk,mrIgnore]) then exit; + // TODO: compiler check: check if compiler paths includes base units - // TODO: compiler check: check if compiler is older than fpc units (ppu version) + Result:=CheckCompilerConfig(CompilerFilename,FPCCfgUnitPath); + if not (Result in [mrOk,mrIgnore]) then exit; // compile bogus file - FTest:=cotCompileBogusFiles; - TestGroupbox.Caption:='Test: Compiling an empty file ...'; - // get Test directory - TestDir:=AppendPathDelim(EnvironmentOptions.TestBuildDirectory); - if not DirPathExists(TestDir) then begin - MessageDlg('Invalid Test Directory', - 'Please check the Test directory under'#13 - +'Environment -> Environment Options -> Files -> Directory for building test projects', - mtError,[mbCancel],0); - Result:=mrCancel; - exit; - end; - // create bogus file - BogusFilename:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas'); - if not CreateEmptyFile(BogusFilename) then begin - MessageDlg('Unable to create Test File', - 'Unable to create Test pascal file "'+BogusFilename+'".', - mtError,[mbCancel],0); - Result:=mrCancel; - exit; - end; - try - // create compiler command line options - CmdLineParams:=Options.MakeOptionsString(BogusFilename,nil, - [ccloAddVerboseAll,ccloDoNotAppendOutFileOption]) - +' '+BogusFilename; + Result:=CheckCompileBogusFile(CompilerFilename); + if not (Result in [mrOk,mrIgnore]) then exit; - CompileTool:=TExternalToolOptions.Create; - CompileTool.Title:='Test: Compiling empty file'; - CompileTool.ScanOutputForFPCMessages:=true; - CompileTool.ScanOutputForMakeMessages:=true; - CompileTool.WorkingDirectory:=TestDir; - CompileTool.Filename:=CompilerFilename; - CompileTool.CmdLineParams:=CmdLineParams; - - Result:=RunTool(CompileTool); - FreeThenNil(CompileTool); - finally - DeleteFile(BogusFilename); - end; + // TODO: compiler check: check if compiler is older than fpc units (ppu version) + + + // TODO: compiler check: check if there are ambiguous fpc ppu finally CompilerFiles.Free; @@ -184,6 +425,7 @@ begin FTest:=cotNone; TestGroupbox.Caption:='Test'; end; + Result:=mrOk; end; constructor TCheckCompilerOptsDlg.Create(TheOwner: TComponent); @@ -210,7 +452,7 @@ procedure TCheckCompilerOptsDlg.Add(const Msg, CurDir: String; ProgressLine: boolean; OriginalIndex: integer); var i: Integer; -Begin +begin if FLastLineIsProgress then begin OutputListbox.Items[OutputListbox.Items.Count-1]:=Msg; end else begin @@ -234,6 +476,16 @@ begin Add(Line.Line,Line.WorkingDirectory,false,Line.LineNumber); end; +procedure TCheckCompilerOptsDlg.AddHint(const Msg: string); +begin + Add('HINT: '+Msg,'',false,-1); +end; + +procedure TCheckCompilerOptsDlg.AddWarning(const Msg: string); +begin + Add('WARNING: '+Msg,'',false,-1); +end; + initialization {$I checkcompileropts.lrs} diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp index 62ac0cfd8a..71dbc4eba0 100644 --- a/ide/compileroptions.pp +++ b/ide/compileroptions.pp @@ -63,6 +63,7 @@ type type TInheritedCompilerOption = ( + icoNone, icoUnitPath, icoIncludePath, icoObjectPath, @@ -83,6 +84,7 @@ type { TParsedCompilerOptions } TParsedCompilerOptString = ( + pcosNone, pcosBaseDir, // the base directory for the relative paths pcosUnitPath, // search path for pascal units pcosIncludePath, // search path for pascal include files @@ -108,6 +110,7 @@ const ParsedCompilerSearchPaths+ParsedCompilerFilenames+ParsedCompilerDirectories; ParsedCompilerOptStringNames: array[TParsedCompilerOptString] of string = ( + 'pcosNone', 'pcosBaseDir', 'pcosUnitPath', 'pcosIncludePath', @@ -123,6 +126,7 @@ const InheritedToParsedCompilerOption: array[TInheritedCompilerOption] of TParsedCompilerOptString = ( + pcosNone, pcosUnitPath, // icoUnitPath, pcosIncludePath, // icoIncludePath, pcosObjectPath, // icoObjectPath, @@ -608,6 +612,7 @@ begin CurOptions:=InheritedOptionStrings[o]; case o of + icoNone: ; icoUnitPath,icoIncludePath,icoSrcPath,icoObjectPath,icoLibraryPath: begin if CurOptions<>'' then @@ -1551,17 +1556,19 @@ begin {$ENDIF} // inherited path - InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir,coptParsed); - {$IFDEF VerbosePkgUnitPath} - if Option=pcosUnitPath then - debugln('TBaseCompilerOptions.GetParsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"'); - {$ENDIF} + if InheritedOption<>icoNone then begin + InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir,coptParsed); + {$IFDEF VerbosePkgUnitPath} + if Option=pcosUnitPath then + debugln('TBaseCompilerOptions.GetParsedPath Inherited ',dbgsName(Self),' InheritedPath="',InheritedPath,'"'); + {$ENDIF} - Result:=MergeSearchPaths(CurrentPath,InheritedPath); - {$IFDEF VerbosePkgUnitPath} - if Option=pcosUnitPath then - debugln('TBaseCompilerOptions.GetParsedPath Total ',dbgsName(Self),' Result="',Result,'"'); - {$ENDIF} + Result:=MergeSearchPaths(CurrentPath,InheritedPath); + {$IFDEF VerbosePkgUnitPath} + if Option=pcosUnitPath then + debugln('TBaseCompilerOptions.GetParsedPath Total ',dbgsName(Self),' Result="',Result,'"'); + {$ENDIF} + end; end; function TBaseCompilerOptions.GetParsedPIPath(Option: TParsedCompilerOptString; @@ -2734,6 +2741,7 @@ function TAdditionalCompilerOptions.GetOption(AnOption: TInheritedCompilerOption ): string; begin case AnOption of + icoNone: Result:=''; icoUnitPath: Result:=UnitPath; icoIncludePath: Result:=IncludePath; icoObjectPath: Result:=ObjectPath; diff --git a/ide/compileroptionsdlg.pp b/ide/compileroptionsdlg.pp index eb29ec94fa..4e7ab8ba64 100644 --- a/ide/compileroptionsdlg.pp +++ b/ide/compileroptionsdlg.pp @@ -45,6 +45,14 @@ uses type { Compiler options form } + + TCheckCompileOptionsMsgLvl = ( + ccomlHints, + ccomlWarning, + ccomlErrors, + ccomlNone + ); + { TfrmCompilerOptions } @@ -281,8 +289,8 @@ type procedure GetCompilerOptions; procedure GetCompilerOptions(SrcCompilerOptions: TBaseCompilerOptions); - function PutCompilerOptions(CheckAndWarn: boolean): boolean; - function PutCompilerOptions(CheckAndWarn: boolean; + function PutCompilerOptions(CheckAndWarn: TCheckCompileOptionsMsgLvl): boolean; + function PutCompilerOptions(CheckAndWarn: TCheckCompileOptionsMsgLvl; DestCompilerOptions: TBaseCompilerOptions): boolean; public property ReadOnly: boolean read FReadOnly write SetReadOnly; @@ -405,7 +413,7 @@ begin Assert(False, 'Trace:Accept compiler options changes'); { Save the options and hide the dialog } - if not PutCompilerOptions(true) then exit; + if not PutCompilerOptions(ccomlErrors) then exit; ModalResult:=mrOk; end; @@ -415,7 +423,7 @@ end; procedure TfrmCompilerOptions.btnTestClicked(Sender: TObject); begin // Apply any changes and test - PutCompilerOptions(true); + if not PutCompilerOptions(ccomlHints) then exit; if Assigned(OnTest) then begin btnCheck.Enabled:=false; try @@ -434,7 +442,7 @@ end; procedure TfrmCompilerOptions.ButtonShowOptionsClicked(Sender: TObject); begin // Test MakeOptionsString function - PutCompilerOptions(true); + if not PutCompilerOptions(ccomlWarning) then exit; ShowCompilerOptionsDialog(CompilerOpts); end; @@ -735,10 +743,11 @@ begin end; end; -{------------------------------------------------------------------------------} -{ TfrmCompilerOptions PutCompilerOptions } -{------------------------------------------------------------------------------} -function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean; +{------------------------------------------------------------------------------ + TfrmCompilerOptions PutCompilerOptions +------------------------------------------------------------------------------} +function TfrmCompilerOptions.PutCompilerOptions( + CheckAndWarn: TCheckCompileOptionsMsgLvl; DestCompilerOptions: TBaseCompilerOptions): boolean; function MakeCompileReasons(const ACompile, ABuild, ARun: TCheckBox): TCompileReasons; @@ -748,6 +757,34 @@ function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean; if ABuild.Checked then Include(Result, crBuild); if ARun.Checked then Include(Result, crRun); end; + + function CheckSearchPath(const Context, ExpandedPath: string): boolean; + var + CurPath: String; + p: Integer; + begin + Result:=false; + if ord(CheckAndWarn)<=ord(ccomlHints) then begin + if System.Pos('*',ExpandedPath)>0 then begin + if MessageDlg('Warning','The '+Context+' contains a star * character.'#13 + +'Lazarus uses this as normal character and does not expand them as file mask.', + mtWarning,[mbOk,mbCancel],0) <> mrOk then exit; + end; + p:=0; + repeat + DebugLn(['CheckSearchPath ',ExpandedPath,' ',p,' ',length(ExpandedPath)]); + CurPath:=GetNextDirectoryInSearchPath(ExpandedPath,p); + if CurPath<>'' then begin + if not DirPathExistsCached(CurPath) then begin + if MessageDlg('Warning','The '+Context+' contains a not existing directory:'#13 + +CurPath, + mtWarning,[mbIgnore,mbCancel],0) <> mrIgnore then exit; + end; + end; + until p>length(ExpandedPath); + end; + Result:=true; + end; var code: LongInt; @@ -775,7 +812,7 @@ begin NewCustomConfigFile:=chkCustomConfigFile.Checked; NewConfigFilePath:=edtConfigPath.Text; - if CheckAndWarn then begin + if ord(CheckAndWarn)<=ord(ccomlWarning) then begin if ((NewDontUseConfigFile<>Options.DontUseConfigFile) or (NewCustomConfigFile<>Options.CustomConfigFile) or (NewConfigFilePath<>Options.ConfigFilePath)) @@ -805,11 +842,23 @@ begin // paths Options.IncludePath := edtIncludeFiles.Text; + if not CheckSearchPath('include search path',Options.GetIncludePath(false)) then + exit(false); Options.Libraries := edtLibraries.Text; + if not CheckSearchPath('library search path',Options.GetLibraryPath(false)) then + exit(false); Options.OtherUnitFiles := edtOtherUnits.Text; + if not CheckSearchPath('unit search path',Options.GetUnitPath(false)) then + exit(false); Options.SrcPath := edtOtherSources.Text; + if not CheckSearchPath('source search path',Options.GetSrcPath(false)) then + exit(false); Options.UnitOutputDirectory := edtUnitOutputDir.Text; Options.DebugPath := edtDebugPath.Text; + if not CheckSearchPath('debugger search path', + Options.GetParsedPath(pcosDebugPath,icoNone,false)) + then + exit(false); i:=LCLWidgetTypeComboBox.Itemindex; if i<=0 then @@ -979,7 +1028,8 @@ begin OldCompOpts.Free; end; -function TfrmCompilerOptions.PutCompilerOptions(CheckAndWarn: boolean): boolean; +function TfrmCompilerOptions.PutCompilerOptions( + CheckAndWarn: TCheckCompileOptionsMsgLvl): boolean; begin Result:=PutCompilerOptions(CheckAndWarn,nil); end; diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index 0468d8f237..0ef89177b2 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -581,16 +581,20 @@ var CurStartPos: Integer; begin PathLen:=length(SearchPath); - repeat - while (NextStartPos<=PathLen) - and (SearchPath[NextStartPos] in [';',#0..#32]) do - inc(NextStartPos); - CurStartPos:=NextStartPos; - while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do - inc(NextStartPos); - Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos)); - if Result<>'' then exit; - until (NextStartPos>PathLen); + if PathLen>0 then begin + repeat + while (NextStartPos<=PathLen) + and (SearchPath[NextStartPos] in [';',#0..#32]) do + inc(NextStartPos); + CurStartPos:=NextStartPos; + while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do + inc(NextStartPos); + Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos)); + if Result<>'' then exit; + until (NextStartPos>PathLen); + end else begin + NextStartPos:=1; + end; Result:=''; end; diff --git a/ide/imexportcompileropts.pas b/ide/imexportcompileropts.pas index cf6996e928..9ed928858a 100644 --- a/ide/imexportcompileropts.pas +++ b/ide/imexportcompileropts.pas @@ -79,9 +79,9 @@ type function ShowImExportCompilerOptionsDialog( CompOpts: TBaseCompilerOptions; var Filename: string): TImExportCompOptsResult; -function DoImportComilerOptions(CompOptsDialog: TfrmCompilerOptions; +function DoImportCompilerOptions(CompOptsDialog: TfrmCompilerOptions; CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult; -function DoExportComilerOptions(CompOptsDialog: TfrmCompilerOptions; +function DoExportCompilerOptions(CompOptsDialog: TfrmCompilerOptions; CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult; function GetXMLPathForCompilerOptions(XMLConfig: TXMLConfig): string; function ReadIntFromXMLConfig(const Filename, Path: string; @@ -104,7 +104,7 @@ begin ImExportCompOptsDlg.Free; end; -function DoImportComilerOptions(CompOptsDialog: TfrmCompilerOptions; +function DoImportCompilerOptions(CompOptsDialog: TfrmCompilerOptions; CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult; var XMLConfig: TXMLConfig; @@ -138,7 +138,7 @@ begin end; end; -function DoExportComilerOptions(CompOptsDialog: TfrmCompilerOptions; +function DoExportCompilerOptions(CompOptsDialog: TfrmCompilerOptions; CompilerOpts: TBaseCompilerOptions; const Filename: string): TModalResult; var XMLConfig: TXMLConfig; @@ -149,7 +149,7 @@ begin if (CompOptsDialog<>nil) then begin CompilerOpts:=TBaseCompilerOptions.Create(nil); FreeCompilerOpts:=true; - CompOptsDialog.PutCompilerOptions(true,CompilerOpts); + CompOptsDialog.PutCompilerOptions(ccomlNone,CompilerOpts); end; try Result:=mrCancel; diff --git a/ide/main.pp b/ide/main.pp index 9d9eb8d105..eeac8c5527 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -7582,11 +7582,11 @@ begin CompOptsDialog.CompilerOpts,Filename); if (ImExportResult=iecorCancel) or (Filename='') then exit; if ImExportResult=iecorImport then - Result:=DoImportComilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts, - Filename) + Result:=DoImportCompilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts, + Filename) else if ImExportResult=iecorExport then - Result:=DoExportComilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts, - Filename); + Result:=DoExportCompilerOptions(CompOptsDialog,CompOptsDialog.CompilerOpts, + Filename); end; function TMainIDE.DoShowProjectInspector: TModalResult; diff --git a/lcl/interfaces/gtk/gtk1extra.inc b/lcl/interfaces/gtk/gtk1extra.inc index 37a21c7c69..79e464d021 100644 --- a/lcl/interfaces/gtk/gtk1extra.inc +++ b/lcl/interfaces/gtk/gtk1extra.inc @@ -271,7 +271,7 @@ end; procedure GDK_WINDOW_SHOW_IN_TASKBAR(Window: PGdkWindowPrivate; Show: Boolean); // this is a try to hide windows from the taskbar. -// Unpleasantly, some windowmangers like metacity also hides form the Alt-Tab +// Unpleasantly, some windowmangers like metacity also hides from the Alt-Tab // cycle. // This feature is therefore disabled on default. {$IFDEF EnableHideFromTaskBar}