From 5340cd2de6d4fea2de99f821c93910e868ae6193 Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 11 Jun 2014 18:57:27 +0000 Subject: [PATCH] IDE: warn if user unit path contains pkg source directory, warn if SrcPath is already in UnitPath, warn if output directory of a package contains a unit source git-svn-id: trunk@45477 - --- components/codetools/directorycacher.pas | 4 +- ide/etmessageframe.pas | 4 +- ide/main.pp | 13 +- packager/basepkgmanager.pas | 9 +- packager/packagesystem.pas | 25 +++ packager/pkgmanager.pas | 202 +++++++++++++++++++++-- 6 files changed, 230 insertions(+), 27 deletions(-) diff --git a/components/codetools/directorycacher.pas b/components/codetools/directorycacher.pas index e8e9b5350c..5705e1c4ba 100644 --- a/components/codetools/directorycacher.pas +++ b/components/codetools/directorycacher.pas @@ -189,7 +189,7 @@ type procedure UpdateListing; procedure WriteListing; procedure Invalidate; inline; - procedure GetFiles(var Files: TStrings; IncludeDirs: boolean = true); + procedure GetFiles(var Files: TStrings; IncludeDirs: boolean = true); // relative to Directory public property Directory: string read FDirectory; property RefCount: integer read FRefCount; @@ -228,7 +228,7 @@ type destructor Destroy; override; procedure CalcMemSize(Stats: TCTMemStats); procedure GetListing(const aDirectory: string; var Files: TStrings; - IncludeDirs: boolean = true); + IncludeDirs: boolean = true); // relative to Directory function GetCache(const Directory: string; CreateIfNotExists: boolean = true; DoReference: boolean = true): TCTDirectoryCache; diff --git a/ide/etmessageframe.pas b/ide/etmessageframe.pas index f560f91bb2..9c46f7d668 100644 --- a/ide/etmessageframe.pas +++ b/ide/etmessageframe.pas @@ -2750,7 +2750,7 @@ begin begin MsgAboutToolMenuItem.Caption:=Format(lisAbout2, [View.Caption]); MsgAboutSection.Visible:=true; - if View.Tool.Data is TIDEExternalToolData then begin + if (View.Tool<>nil) and (View.Tool.Data is TIDEExternalToolData) then begin ToolData:=TIDEExternalToolData(View.Tool.Data); if ToolData.Kind=IDEToolCompilePackage then ToolOptionsCaption:=Format(lisCPOpenPackage, [ToolData.ModuleName]); @@ -2855,7 +2855,7 @@ var ToolData: TIDEExternalToolData; begin View:=GetAboutView; - if View=nil then exit; + if (View=nil) or (View.Tool=nil) then exit; ToolData:=TIDEExternalToolData(View.Tool.Data); if not (ToolData is TIDEExternalToolData) then exit; if ToolData.Kind=IDEToolCompilePackage then begin diff --git a/ide/main.pp b/ide/main.pp index e9ae000ac8..a015a00fc3 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -6622,6 +6622,15 @@ begin // show messages IDEWindowCreators.ShowForm(MessagesView,EnvironmentOptions.MsgViewFocus); + + // clear old error lines + SourceEditorManager.ClearErrorLines; + SourceFileMgr.ArrangeSourceEditorAndMessageView(false); + + // check common mistakes in search paths + Result:=PkgBoss.CheckUserSearchPaths(Project1.CompilerOptions); + if Result<>mrOk then exit; + {$IFDEF EnableOldExtTools} MessagesView.BeginBlock; {$ENDIF} @@ -6648,10 +6657,6 @@ begin CompileProgress.CreateDialog(OwningComponent, Project1.MainFilename, lisInfoBuildCompile); {$ENDIF} - // clear old error lines - SourceEditorManager.ClearErrorLines; - SourceFileMgr.ArrangeSourceEditorAndMessageView(false); - // now building can start: call handler Result:=DoCallModalFunctionHandler(lihtProjectBuilding); if Result<>mrOk then begin diff --git a/packager/basepkgmanager.pas b/packager/basepkgmanager.pas index 6eff8c6c0f..08dc0a8724 100644 --- a/packager/basepkgmanager.pas +++ b/packager/basepkgmanager.pas @@ -46,7 +46,7 @@ uses TypInfo, Classes, SysUtils, Forms, FileUtil, LCLProc, LazIDEIntf, PackageIntf, MenuIntf, LazarusIDEStrConsts, EnvironmentOpts, - PackageDefs, PackageSystem, ComponentReg, Project; + CompilerOptions, PackageDefs, PackageSystem, ComponentReg, Project; type { TBasePkgManager } @@ -80,9 +80,6 @@ type InObject: TObject): TPkgFile; virtual; abstract; function AddDependencyToUnitOwners(const OwnedFilename, RequiredUnitname: string): TModalResult; virtual; abstract; - procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList); virtual; abstract; - function RevertPackages(APackageList: TStringList // list of TLazPackage and alternative lpk file name - ): TModalResult; virtual; abstract; // project function OpenProjectDependencies(AProject: TProject; @@ -121,6 +118,10 @@ type procedure OpenHiddenModifiedPackages; virtual; abstract; // package graph + procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList); virtual; abstract; + function RevertPackages(APackageList: TStringList // list of TLazPackage and alternative lpk file name + ): TModalResult; virtual; abstract; + function CheckUserSearchPaths(aCompilerOptions: TBaseCompilerOptions): TModalResult; virtual; abstract; procedure DoShowPackageGraphPathList(PathList: TFPList); virtual; abstract; procedure RebuildDefineTemplates; virtual; abstract; procedure LazarusSrcDirChanged; virtual; abstract; diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index 12b1ea7c87..e209f94ec4 100644 --- a/packager/packagesystem.pas +++ b/packager/packagesystem.pas @@ -251,6 +251,7 @@ type WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile; function FindUnitInAllPackages(const TheUnitName: string; IgnoreDeleted: boolean): TPkgFile; + function GetMapSourceDirectoryToPackage: TFilenameToPointerTree; function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean; function PackageIsNeeded(APackage: TLazPackage): boolean; function PackageNameExists(const PkgName: string; @@ -1283,6 +1284,30 @@ begin Result:=nil; end; +function TLazPackageGraph. + GetMapSourceDirectoryToPackage: TFilenameToPointerTree; +var + i: Integer; + aPackage: TLazPackage; + SearchPath: String; + p: Integer; + Dir: String; +begin + Result:=TFilenameToPointerTree.Create(false); + for i:=0 to Count-1 do begin + aPackage:=Packages[i]; + if aPackage.IsVirtual then continue; + SearchPath:=aPackage.SourceDirectories.CreateSearchPathFromAllFiles; + p:=1; + repeat + Dir:=GetNextDirectoryInSearchPath(SearchPath,p); + if Dir='' then break; + Dir:=ChompPathDelim(Dir); + Result[Dir]:=aPackage; + until false; + end; +end; + function TLazPackageGraph.FindFileInAllPackages(const TheFilename: string; IgnoreDeleted, FindVirtualFile: boolean): TPkgFile; var diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index cb6d705ba7..3535a628da 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -51,7 +51,11 @@ uses FileProcs, Laz2_XMLCfg, lazutf8classes, LazFileUtils, LazFileCache, // IDE Interface SrcEditorIntf, NewItemIntf, ProjectIntf, PackageIntf, CompOptsIntf, - MenuIntf, IDEWindowIntf, PropEdits, MacroIntf, LazIDEIntf, + MenuIntf, IDEWindowIntf, + {$IFNDEF EnableOldExtTools} + IDEExternToolIntf, + {$ENDIF} + PropEdits, MacroIntf, LazIDEIntf, IDEMsgIntf, // IDE LazarusIDEStrConsts, IDEProcs, ObjectLists, DialogProcs, IDECommands, IDEOptionDefs, EnvironmentOpts, MiscOptions, InputHistory, @@ -205,14 +209,8 @@ type function GetPublishPackageDir(APackage: TLazPackage): string; function OnRenameFile(const OldFilename, NewFilename: string; IsPartOfProject: boolean): TModalResult; override; - function FindIncludeFileInProjectDependencies(Project1: TProject; + function FindIncludeFileInProjectDependencies(aProject: TProject; const Filename: string): string; override; - function AddUnitDependenciesForComponentClasses(const UnitFilename: string; - ComponentClassnames: TStrings; - Quiet: boolean = false): TModalResult; override; - function GetMissingDependenciesForUnit(const UnitFilename: string; - ComponentClassnames: TStrings; - var List: TObjectArray): TModalResult; function GetOwnersOfUnit(const UnitFilename: string): TFPList; override; procedure ExtendOwnerListWithUsedByOwners(OwnerList: TFPList); override; function GetSourceFilesOfOwners(OwnerList: TFPList): TStrings; override; @@ -220,21 +218,19 @@ type Flags: TPkgIntfOwnerSearchFlags): TFPList; override; function GetPackageOfCurrentSourceEditor(out APackage: TIDEPackage): TPkgFile; function GetPackageOfSourceEditor(out APackage: TIDEPackage; ASrcEdit: TObject): TLazPackageFile; override; - function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult; function FindVirtualUnitSource(PkgFile: TPkgFile): string; function SearchFile(const AFilename: string; SearchFlags: TSearchIDEFileFlags; InObject: TObject): TPkgFile; override; function SearchUnitInDesigntimePackages(const AnUnitName: string; InObject: TObject): TPkgFile; override; - procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList); override; - function RevertPackages(APackageList: TStringList): TModalResult; override; // package graph function AddPackageToGraph(APackage: TLazPackage; Replace: boolean): TModalResult; procedure DoShowPackageGraph(Show: boolean); procedure DoShowPackageGraphPathList(PathList: TFPList); override; function ShowBrokenDependenciesReport(Dependencies: TFPList): TModalResult; + function CheckUserSearchPaths(aCompilerOptions: TBaseCompilerOptions): TModalResult; override; procedure RebuildDefineTemplates; override; procedure LazarusSrcDirChanged; override; function GetPackageCount: integer; override; @@ -249,6 +245,8 @@ type function AddDependencyToUnitOwners(const OwnedFilename, RequiredUnitname: string): TModalResult; override; function RedirectPackageDependency(APackage: TIDEPackage): TIDEPackage; override; + procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList); override; + function RevertPackages(APackageList: TStringList): TModalResult; override; // project function OpenProjectDependencies(AProject: TProject; @@ -275,6 +273,7 @@ type ADependency: TPkgDependency): TModalResult; override; // package editors + function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult; function DoNewPackage: TModalResult; override; function DoShowOpenInstalledPckDlg: TModalResult; override; function DoOpenPackage(APackage: TLazPackage; Flags: TPkgOpenFlags; @@ -329,6 +328,12 @@ type ShowDialog: boolean): TModalResult; // components + function AddUnitDependenciesForComponentClasses(const UnitFilename: string; + ComponentClassnames: TStrings; + Quiet: boolean = false): TModalResult; override; + function GetMissingDependenciesForUnit(const UnitFilename: string; + ComponentClassnames: TStrings; + var List: TObjectArray): TModalResult; function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; override; // list of TUnitInfo procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData; Proc: TGetStrProc); override; @@ -1280,14 +1285,17 @@ var ConflictPkg: TLazPackage; s: String; Btns: TMsgDlgButtons; + PkgList: TFPList; + i: Integer; begin {$IFDEF VerbosePkgCompile} debugln('TPkgManager.CheckPackageGraphForCompilation A'); {$ENDIF} - PathList:=nil; if ShowAbort then Btns := [mbCancel] // will be replaced to Ignore else Btns := [mbOK]; + PathList:=nil; + PkgList:=nil; try // check for unsaved packages PathList:=PackageGraph.FindUnsavedDependencyPath(APackage,FirstDependency); @@ -1339,6 +1347,16 @@ begin exit; end; + // check for all used package with wrong + PackageGraph.GetAllRequiredPackages(APackage,FirstDependency,PkgList); + if (PkgList<>nil) then begin + for i:=0 to PkgList.Count-1 do begin + Result:=CheckUserSearchPaths(TLazPackage(PkgList[i]).CompilerOptions); + if Result<>mrOk then + exit(mrCancel); + end; + end; + // check for a package that compiles to the default FPC search path PathList:=PackageGraph.FindPkgOutputInFPCSearchPath(APackage,FirstDependency); if PathList<>nil then begin @@ -1399,6 +1417,7 @@ begin end; finally + PkgList.Free; PathList.Free; end; @@ -2525,6 +2544,154 @@ begin Result:=IDEMessageDialog(lisMissingPackages, Msg, mtError, [mbOk]); end; +function TPkgManager.CheckUserSearchPaths(aCompilerOptions: TBaseCompilerOptions + ): TModalResult; +{$IFDEF EnableOldExtTools} +begin + Result:=mrOk; +end; +{$ELSE} +var + aPackage: TLazPackage; + aProject: TProject; + CurUnitPath: String; + CurIncPath: String; + CurOutPath: String; + SrcDirToPkg: TFilenameToPointerTree; + + function CheckPathContainsDirOfOtherPkg(Option: TParsedCompilerOptString + ): TModalResult; + var + aSearchPath: String; + p: Integer; + Dir: String; + OtherPackage: TLazPackage; + aType: String; + s: String; + begin + Result:=mrOk; + if Option=pcosIncludePath then begin + aType:='include'; + aSearchPath:=CurIncPath + end else begin + aType:='unit'; + aSearchPath:=CurUnitPath; + end; + p:=1; + repeat + Dir:=GetNextDirectoryInSearchPath(aSearchPath,p); + if Dir='' then break; + Dir:=ChompPathDelim(Dir); + if not FilenameIsAbsolute(Dir) then continue; + OtherPackage:=TLazPackage(SrcDirToPkg[Dir]); + if (OtherPackage<>nil) and (OtherPackage<>aPackage) then begin + // search path contains source directory of another package + if Option=pcosIncludePath then; + s:=aType+' path of '+aCompilerOptions.GetOwnerName+' contains "'+Dir+'", which belongs to package '+OtherPackage.Name; + debugln(['TPkgManager.CheckUserSearchPaths WARNING: ',s]); + { ToDo: find out + - which path it is in the unparsed path + - if there is already the dependency + - if the dependency can be added + and ask the user to delete the path and to add the dependency + + if the user has already answered this question in the past, just warn } + // warn user + IDEMessagesWindow.AddCustomMessage(mluWarning,s); + exit; + end; + until false; + end; + + function CheckOutPathContainsSources: TModalResult; + var + Files: TStrings; + i: Integer; + aFilename: String; + s: String; + begin + Result:=mrOk; + if aPackage=nil then exit; + if not FilenameIsAbsolute(CurOutPath) then exit; + Files:=nil; + CodeToolBoss.DirectoryCachePool.GetListing(CurOutPath,Files,false); + try + for i:=0 to Files.Count-1 do begin + aFilename:=Files[i]; + if FilenameIsPascalUnit(aFilename) then begin + // warning: packages output path contain unit source + s:='output directory of '+aCompilerOptions.GetOwnerName+' contains Pascal unit source "'+aFilename+'"'; + debugln(['CheckOutPathContainsSources WARNING: ',s]); + { ToDo: if the OutPath is not the default: ask user and change it } + IDEMessagesWindow.AddCustomMessage(mluWarning,s); + exit; + end; + end; + finally + Files.Free; + end; + end; + + function CheckSrcPathIsInUnitPath: TModalResult; + // warn: SrcPath should not contain directories of UnitPath + var + p: Integer; + UnparsedUnitPath: String; + UnparsedSrcPath: String; + Dir: String; + s: String; + begin + Result:=mrOk; + UnparsedUnitPath:=aCompilerOptions.OtherUnitFiles; + UnparsedSrcPath:=aCompilerOptions.SrcPath; + p:=1; + repeat + Dir:=GetNextDirectoryInSearchPath(UnparsedSrcPath,p); + if Dir='' then exit; + if SearchDirectoryInSearchPath(UnparsedUnitPath,Dir)>0 then begin + s:='other sources path of '+aCompilerOptions.GetOwnerName+' contains directory "'+Dir+'", which is already in the unit search path.'; + debugln(['CheckSrcPathIsInUnitPath WARNING: ',s]); + { ToDo: ask user and remove dir from unit path } + IDEMessagesWindow.AddCustomMessage(mluWarning,s); + exit; + end; + until false; + end; + +begin + Result:=mrOk; + if aCompilerOptions.CompilerPath='' then exit; // not a normal Pascal project + + aPackage:=nil; + aProject:=nil; + if aCompilerOptions.Owner is TLazPackage then + aPackage:=TLazPackage(aCompilerOptions.Owner) + else if aCompilerOptions.Owner is TProject then + aProject:=TProject(aCompilerOptions.Owner); + if (aPackage=nil) and (aProject=nil) then exit; + + CurUnitPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosUnitPath); + CurIncPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosIncludePath); + CurOutPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir); + //debugln(['TPkgManager.CheckUserSearchPaths UnitPath="',CurUnitPath,'" IncPath="',CurIncPath,'" SrcPath="',CurSrcPath,'" OutPath="',CurOutPath,'"']); + + // create mapping source-directory to package + SrcDirToPkg:=PackageGraph.GetMapSourceDirectoryToPackage; + try + Result:=CheckPathContainsDirOfOtherPkg(pcosUnitPath); + if Result<>mrOk then exit; + + Result:=CheckOutPathContainsSources; + if Result<>mrOk then exit; + + Result:=CheckSrcPathIsInUnitPath; + if Result<>mrOk then exit; + finally + SrcDirToPkg.Free; + end; +end; +{$ENDIF} + procedure TPkgManager.RebuildDefineTemplates; begin PackageGraph.RebuildDefineTemplates; @@ -2716,7 +2883,12 @@ begin Result:=MainIDE.DoSaveForBuild(crCompile); if Result<>mrOk then exit; end; - + + // check user search paths + Result:=CheckUserSearchPaths(APackage.CompilerOptions); + if Result<>mrOk then exit; + + // compile Result:=PackageGraph.CompilePackage(APackage,Flags,false); end; @@ -2765,7 +2937,7 @@ end; Search filename in the include paths of all required packages ------------------------------------------------------------------------------} -function TPkgManager.FindIncludeFileInProjectDependencies(Project1: TProject; +function TPkgManager.FindIncludeFileInProjectDependencies(aProject: TProject; const Filename: string): string; var APackage: TLazPackage; @@ -2779,7 +2951,7 @@ begin exit; end; PkgList:=nil; - PackageGraph.GetAllRequiredPackages(nil,Project1.FirstRequiredDependency, + PackageGraph.GetAllRequiredPackages(nil,aProject.FirstRequiredDependency, PkgList,[pirCompileOrder]); if PkgList=nil then exit; try