{ *************************************************************************** * * * 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., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: Called after checking what packages need compile. Check source files and compiled files for name conflicts between packages. ToDo: - project compiler option verbosity: dialog on duplicate files - save date ignore - use date ignore - clear ignore on - clean build - error cant find include file unit_f_cant_find_ppu=10022_F_Can't find unit $1 used by $2 unit_w_unit_name_error=10023_W_Unit $1 was not found but $2 exists unit_f_unit_name_error=10024_F_Unit $1 searched but $2 found unit_u_ppu_invalid_header=10007_U_PPU Invalid Header (no PPU at the begin) unit_f_cant_compile_unit=10021_F_Can't compile unit $1, no sources available unit_u_recompile_crc_change=10028_U_Recompiling $1, checksum changed for $2 unit_u_recompile_source_found_alone=10029_U_Recompiling $1, source found only unit_u_recompile_staticlib_is_older=10030_U_Recompiling unit, static lib is older than ppufile unit_u_recompile_sharedlib_is_older=10031_U_Recompiling unit, shared lib is older than ppufile unit_u_recompile_obj_and_asm_older=10032_U_Recompiling unit, obj and asm are older than ppufile unit_u_recompile_obj_older_than_asm=10033_U_Recompiling unit, obj is older than asm unit_w_cant_compile_unit_with_changed_incfile=10040_W_Can't recompile unit $1, but found modifed include files unit_u_source_modified=10041_U_File $1 is newer than the one used for creating PPU file $2 } unit InterPkgConflictFiles; {$mode objfpc}{$H+} interface uses // RTL + FCL Classes, SysUtils, Types, Math, Contnrs, AVL_Tree, // LCL Forms, ComCtrls, Controls, ButtonPanel, Themes, Graphics, StdCtrls, Buttons, InterfaceBase, // CodeTools BasicCodeTools, DefineTemplates, CodeToolManager, FileProcs, // LazUtils FPCAdds, LazFileUtils, LazFileCache, LazTracer, // BuildIntf ProjectIntf, CompOptsIntf, IDEExternToolIntf, // IDEIntf IDEWindowIntf, LazIDEIntf, IDEMsgIntf, // IdeConfig EnvironmentOpts, TransferMacros, IDEProcs, SearchPathProcs, ParsedCompilerOpts, CompilerOptions, // IDE DialogProcs, LazarusIDEStrConsts, PackageDefs, PackageSystem; type TPGInterPkgOwnerInfo = class public Name: string; Owner: TObject; HasOptionUr: boolean; CompOptions: TBaseCompilerOptions; BaseDir: string; SrcDirs: string; // unitpath without inherited IncDirs: string; // incpath without inherited and without SrcDirs UnitOutDir: string; // can be empty -> if empty FPC creates ppu in SrcDirs end; { TPGInterPkgFile } TPGInterPkgFile = class public FullFilename: string; ShortFilename: string; AnUnitName: string; OwnerInfo: TPGInterPkgOwnerInfo; constructor Create(TheFullFilename, TheUnitName: string; Owner: TPGInterPkgOwnerInfo); end; TPGInterPkgFileArray = array of TPGInterPkgFile; { TPGIPAmbiguousFileGroup } TPGIPAmbiguousFileGroup = class public CompiledFiles: TPGInterPkgFileArray; Sources: TPGInterPkgFileArray; function Add(SrcFile, PPUFile: TPGInterPkgFile): integer; function IndexOfOwner(OwnerInfo: TPGInterPkgOwnerInfo): integer; procedure Switch(Index1, Index2: integer); end; TPGIPCategory = ( pgipOrphanedCompiled, pgipDuplicateSource ); { TPGIPConflictsDialog } TPGIPConflictsDialog = class(TForm) ButtonPanel1: TButtonPanel; ConflictsTreeView: TTreeView; IDEDialogLayoutStorage1: TIDEDialogLayoutStorage; ImageList1: TImageList; procedure ConflictsTreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; {%H-}State: TCustomDrawState; Stage: TCustomDrawStage; var {%H-}PaintImages, {%H-}DefaultDraw: Boolean); procedure ConflictsTreeViewMouseDown(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer); procedure DeleteSelectedFilesButtonClick(Sender: TObject); procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure OkButtonClick(Sender: TObject); private DeleteSelectedFilesButton: TButton; FImgIndexChecked: integer; FImgIndexUnchecked: integer; FCategoryNodes: array[TPGIPCategory] of TTreeNode; procedure UpdateButtons; procedure IgnoreConflicts; public FileGroups: TObjectList; // list of TPGIPAmbiguousFileGroup FilesChanged: boolean; procedure Init(Groups: TObjectList); end; function CheckInterPkgFiles(IDEObject: TObject; PkgList: TFPList; out FilesChanged: boolean ): boolean; // returns false if user cancelled implementation {$R *.lfm} function ComparePGInterPkgFullFilenames(File1, File2: Pointer): integer; var F1: TPGInterPkgFile absolute File1; F2: TPGInterPkgFile absolute File2; begin Result:=CompareFilenames(F1.FullFilename,F2.FullFilename); end; function ComparePGInterPkgUnitnames(File1, File2: Pointer): integer; var F1: TPGInterPkgFile absolute File1; F2: TPGInterPkgFile absolute File2; begin Assert(Assigned(F1), 'ComparePGInterPkgUnitnames: File1=Nil.'); Assert(Assigned(F2), 'ComparePGInterPkgUnitnames: File2=Nil.'); Result:=CompareDottedIdentifiers(PChar(F1.AnUnitName),PChar(F2.AnUnitName)); end; function ComparePGInterPkgShortFilename(File1, File2: Pointer): integer; var F1: TPGInterPkgFile absolute File1; F2: TPGInterPkgFile absolute File2; begin // compare case insensitive to find cross platform duplicates // Note: do not use CompareFilenamesIgnoreCase, because of Turkish ı, I Result:=CompareText(F1.ShortFilename,F2.ShortFilename); end; function FilenameIsCompiledSource(aFilename: string): boolean; begin Result:=FilenameExtIn(aFilename,['.ppu','.o','.rst','.rsj']); end; { TPGIPAmbiguousFileGroup } function TPGIPAmbiguousFileGroup.Add(SrcFile, PPUFile: TPGInterPkgFile): integer; begin if (SrcFile=nil) and (PPUFile=nil) then RaiseGDBException(''); if (SrcFile<>nil) and (PPUFile<>nil) and (PPUFile.OwnerInfo<>SrcFile.OwnerInfo) then RaiseGDBException('bug: not equal: PPUFile.OwnerInfo='+PPUFile.OwnerInfo.Name+' SrcFile.OwnerInfo='+SrcFile.OwnerInfo.Name); if (SrcFile<>nil) and FilenameIsCompiledSource(SrcFile.ShortFilename) then RaiseGDBException('bug: src is compiled file: SrcFile.Filename='+SrcFile.FullFilename); if (PPUFile<>nil) and not FilenameIsCompiledSource(PPUFile.ShortFilename) then RaiseGDBException('bug: compiled file is source:'+PPUFile.FullFilename); Result:=length(CompiledFiles); SetLength(CompiledFiles,Result+1); SetLength(Sources,Result+1); Sources[Result]:=SrcFile; CompiledFiles[Result]:=PPUFile end; function TPGIPAmbiguousFileGroup.IndexOfOwner(OwnerInfo: TPGInterPkgOwnerInfo ): integer; begin Result:=length(Sources)-1; while (Result>=0) do begin if (Sources[Result]<>nil) then begin if (Sources[Result].OwnerInfo=OwnerInfo) then exit; end else begin if (CompiledFiles[Result].OwnerInfo=OwnerInfo) then exit; end; dec(Result); end; end; procedure TPGIPAmbiguousFileGroup.Switch(Index1, Index2: integer); var aFile: TPGInterPkgFile; begin aFile:=Sources[Index1]; Sources[Index1]:=Sources[Index2]; Sources[Index2]:=aFile; aFile:=CompiledFiles[Index1]; CompiledFiles[Index1]:=CompiledFiles[Index2]; CompiledFiles[Index2]:=aFile; end; { TPGIPConflictsDialog } procedure TPGIPConflictsDialog.ConflictsTreeViewAdvancedCustomDrawItem( Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean); var Detail: TThemedButton; Details: TThemedElementDetails; aSize: TSize; NodeRect: Classes.TRect; r: TRect; begin if Stage<>cdPostPaint then exit; if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin if Node.ImageIndex=FImgIndexChecked then Detail := tbCheckBoxCheckedNormal else Detail := tbCheckBoxUncheckedNormal; Details := ThemeServices.GetElementDetails(Detail); // Maybe: aSize := ThemeServices.GetDetailSizeForPPI(Details, PixelsPerInch); aSize := ThemeServices.GetDetailSize(Details); NodeRect:=Node.DisplayRect(false); r:=Bounds(Node.DisplayIconLeft+(ImageList1.Width-aSize.cx) div 2, NodeRect.Top+(NodeRect.Bottom-NodeRect.Top-aSize.cy) div 2, aSize.cx,aSize.cy); ThemeServices.DrawElement(ConflictsTreeView.Canvas.Handle,Details,r); end; end; procedure TPGIPConflictsDialog.ConflictsTreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Node: TTreeNode; begin Node:=ConflictsTreeView.GetNodeAt(X,Y); if Node=nil then exit; if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin if (X>=Node.DisplayIconLeft) and (XmrOk then exit(false); if FilenameIsPascalUnit(aFilename) then begin // unit source -> delete compiled files and resources DeleteFileUTF8(ChangeFileExt(aFilename,'.ppu')); DeleteFileUTF8(ChangeFileExt(aFilename,'.o')); DeleteFileUTF8(ChangeFileExt(aFilename,'.rst')); DeleteFileUTF8(ChangeFileExt(aFilename,'.rsj')); DeleteFileUTF8(ChangeFileExt(aFilename,'.lfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.dfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.xfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.fmx')); end else if FilenameIsCompiledSource(aFilename) then begin // compiled file -> delete compiled files. Keep sources. DeleteFileUTF8(ChangeFileExt(aFilename,'.ppu')); DeleteFileUTF8(ChangeFileExt(aFilename,'.o')); DeleteFileUTF8(ChangeFileExt(aFilename,'.rst')); DeleteFileUTF8(ChangeFileExt(aFilename,'.rsj')); if FileExistsCached(ChangeFileExt(aFilename,'.pas')) or FileExistsCached(ChangeFileExt(aFilename,'.pp')) or FileExistsCached(ChangeFileExt(aFilename,'.p')) then begin // delete only compiled file end else begin // no source in this directory => delete copied lfm file DeleteFileUTF8(ChangeFileExt(aFilename,'.lfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.dfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.xfm')); DeleteFileUTF8(ChangeFileExt(aFilename,'.fmx')); end; end; Result:=true; end; var Node: TTreeNode; NextNode: TTreeNode; FileGroup: TPGIPAmbiguousFileGroup; IndexInGroup: integer; ConflictCount: Integer; begin ConflictsTreeView.Items.BeginUpdate; try Node:=ConflictsTreeView.Items.GetFirstNode; IndexInGroup:=-1; ConflictCount:=0; while Node<>nil do begin NextNode:=Node.GetNext; if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin FileGroup:=TPGIPAmbiguousFileGroup(Node.Data); inc(IndexInGroup); if Node.ImageIndex=FImgIndexChecked then begin if not DeleteFileAndAssociates(FileGroup.Sources[IndexInGroup]) then exit; if not DeleteFileAndAssociates(FileGroup.CompiledFiles[IndexInGroup]) then exit; end; if ((FileGroup.Sources[IndexInGroup]<>nil) and FileExistsUTF8(FileGroup.Sources[IndexInGroup].FullFilename)) or ((FileGroup.CompiledFiles[IndexInGroup]<>nil) and FileExistsUTF8(FileGroup.CompiledFiles[IndexInGroup].FullFilename)) then inc(ConflictCount); if IndexInGroup=length(FileGroup.Sources)-1 then begin if ConflictCount<=1 then begin // conflict does not exist anymore FilesChanged:=true; Node:=Node.Parent; NextNode:=Node.GetNextSkipChildren; Node.Delete; end; IndexInGroup:=-1; ConflictCount:=0; end; end; Node:=NextNode; end; finally ConflictsTreeView.Items.EndUpdate; UpdateButtons; end; end; procedure TPGIPConflictsDialog.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin IDEDialogLayoutList.SaveLayout(Self); end; procedure TPGIPConflictsDialog.FormCreate(Sender: TObject); var Details: TThemedElementDetails; aSize: TSize; Img: TBitmap; begin IDEDialogLayoutList.ApplyLayout(Self); DeleteSelectedFilesButton:=TButton.Create(Self); with DeleteSelectedFilesButton do begin Name:='DeleteSelectedFilesButton'; Caption:='Delete selected files'; Align:=alLeft; AutoSize:=true; OnClick:=@DeleteSelectedFilesButtonClick; Parent:=ButtonPanel1; end; ButtonPanel1.OKButton.Kind:=bkIgnore; ButtonPanel1.OKButton.Caption:='Ignore'; ButtonPanel1.OKButton.OnClick:=@OkButtonClick; Details := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal); // Maybe: aSize := ThemeServices.GetDetailSizeForPPI(Details, PixelsPerInch); aSize := ThemeServices.GetDetailSize(Details); ImageList1.Width:=Max(16,aSize.cx); ImageList1.Height:=Max(16,aSize.cy); // add empty images Img:=TBitmap.Create; Img.TransparentMode:=tmFixed; Img.TransparentColor:=0; Img.Transparent:=true; Img.SetSize(ImageList1.Width,ImageList1.Height); FImgIndexChecked:=ImageList1.Add(Img,nil); FImgIndexUnchecked:=ImageList1.Add(Img,nil); Img.Free; end; procedure TPGIPConflictsDialog.OkButtonClick(Sender: TObject); begin IgnoreConflicts; end; procedure TPGIPConflictsDialog.UpdateButtons; var Node: TTreeNode; DeleteCount: Integer; ConflictCount: Integer; begin DeleteCount:=0; ConflictCount:=0; Node:=ConflictsTreeView.Items.GetFirstNode; while Node<>nil do begin if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin inc(ConflictCount); if Node.ImageIndex=FImgIndexChecked then inc(DeleteCount); end; Node:=Node.GetNext; end; DeleteSelectedFilesButton.Enabled:=DeleteCount>0; if ConflictCount=0 then IgnoreConflicts; end; procedure TPGIPConflictsDialog.IgnoreConflicts; begin // ToDo ModalResult:=mrOk; end; procedure TPGIPConflictsDialog.Init(Groups: TObjectList); function AddChild(ParentNode: TTreeNode; Caption: string): TTreeNode; begin Result:=ConflictsTreeView.Items.AddChild(ParentNode,Caption); end; var i, j: Integer; ItemNode: TTreeNode; s: String; FileGroupNode: TTreeNode; FileGroup: TPGIPAmbiguousFileGroup; SrcFile: TPGInterPkgFile; CompiledFile: TPGInterPkgFile; CurFile: TPGInterPkgFile; c: TPGIPCategory; begin FileGroups:=Groups; ConflictsTreeView.Items.BeginUpdate; ConflictsTreeView.Items.Clear; ConflictsTreeView.Images:=ImageList1; for c in TPGIPCategory do FCategoryNodes[c]:=nil; for i:=0 to FileGroups.Count-1 do begin FileGroup:=TPGIPAmbiguousFileGroup(FileGroups[i]); // category if FileGroup.Sources[0]=nil then begin // orphaned compiled file CurFile:=FileGroup.CompiledFiles[0]; c:=pgipOrphanedCompiled; if FCategoryNodes[c]=nil then FCategoryNodes[c]:= ConflictsTreeView.Items.Add(nil,'Orphaned compiled files'); end else begin // duplicate source file CurFile:=FileGroup.Sources[0]; c:=pgipDuplicateSource; if FCategoryNodes[c]=nil then FCategoryNodes[c]:= ConflictsTreeView.Items.Add(nil,'Duplicate source files'); end; // file group s:=ExtractFilename(CurFile.ShortFilename); FileGroupNode:=AddChild(FCategoryNodes[c],s); for j:=0 to length(FileGroup.Sources)-1 do begin SrcFile:=FileGroup.Sources[j]; CompiledFile:=FileGroup.CompiledFiles[j]; if SrcFile<>nil then CurFile:=SrcFile else CurFile:=CompiledFile; s:=ExtractFilename(CurFile.ShortFilename); if CurFile.OwnerInfo.Owner is TLazPackage then s+=' of package '+CurFile.OwnerInfo.Name else s+=' of '+CurFile.OwnerInfo.Name; ItemNode:=AddChild(FileGroupNode,s); if SrcFile=nil then ItemNode.ImageIndex:=FImgIndexChecked // default: delete else ItemNode.ImageIndex:=FImgIndexUnchecked; // default: keep ItemNode.SelectedIndex:=ItemNode.ImageIndex; ItemNode.Data:=FileGroup; begin // file paths of compiled and src if CompiledFile<>nil then AddChild(ItemNode,'Compiled: '+CompiledFile.FullFilename); if SrcFile<>nil then AddChild(ItemNode,'Source: '+SrcFile.FullFilename) else AddChild(ItemNode,'No source found'); end; end; end; // expand all nodes for c in TPGIPCategory do if FCategoryNodes[c]<>nil then FCategoryNodes[c].Expand(true); ConflictsTreeView.Items.EndUpdate; UpdateButtons; end; { TPGInterPkgFile } constructor TPGInterPkgFile.Create(TheFullFilename, TheUnitName: string; Owner: TPGInterPkgOwnerInfo); begin FullFilename:=TheFullFilename; ShortFilename:=ExtractFileName(FullFilename); AnUnitName:=TheUnitName; OwnerInfo:=Owner; end; function CheckInterPkgFiles(IDEObject: TObject; PkgList: TFPList; out FilesChanged: boolean): boolean; { Scan all source and output directories (Note: they are already cached, because this method is called after the checks if a compile is needed). Report strange ppu files and duplicate file names. IDEObject can be a TProject, TLazPackage or TLazPackageGraph(building IDE) PkgList is list of TLazPackage } var OwnerInfos: TObjectList; // list of TPGInterPkgOwnerInfo TargetOS: String; TargetCPU: String; LCLWidgetType: String; FullFiles: TAvlTree; // tree of TPGInterPkgFile sorted for FullFilename Units: TAvlTree; // tree of TPGInterPkgFile sorted for AnUnitName ShortFiles: TAvlTree; // tree of TPGInterPkgFile sorted for ShortFilename AmbiguousFileGroups: TObjectList; // list of TPGIPAmbiguousFileGroup procedure AddOwnerInfo(TheOwner: TObject); var LazDir: String; CustomOptions: String; p: Integer; OwnerInfo: TPGInterPkgOwnerInfo; begin OwnerInfo:=TPGInterPkgOwnerInfo.Create; OwnerInfos.Add(OwnerInfo); OwnerInfo.Owner:=TheOwner; if TheOwner is TLazPackage then begin OwnerInfo.Name:=TLazPackage(TheOwner).IDAsString; OwnerInfo.CompOptions:=TLazPackage(TheOwner).LazCompilerOptions as TBaseCompilerOptions; end else if TheOwner is TLazProject then begin OwnerInfo.Name:=TLazProject(TheOwner).GetTitleOrName; OwnerInfo.CompOptions:=TLazProject(TheOwner).LazCompilerOptions as TBaseCompilerOptions; end else if TheOwner=PackageGraph then begin // building IDE OwnerInfo.Name:='#IDE'; LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory); OwnerInfo.BaseDir:=LazDir; OwnerInfo.SrcDirs:=LazDir+'ide' +';'+LazDir+'debugger' +';'+LazDir+'packager' +';'+LazDir+'designer' +';'+LazDir+'converter'; OwnerInfo.IncDirs:=OwnerInfo.SrcDirs +';'+LazDir+'ide'+PathDelim+'include'+PathDelim+TargetOS +';'+LazDir+'ide'+PathDelim+'include'+PathDelim+GetDefaultSrcOSForTargetOS(TargetOS); OwnerInfo.UnitOutDir:=LazDir+'units'+PathDelim+TargetCPU+'-'+TargetOS+PathDelim+LCLWidgetType; end; if OwnerInfo.CompOptions<>nil then begin OwnerInfo.BaseDir:=OwnerInfo.CompOptions.BaseDirectory; OwnerInfo.SrcDirs:=OwnerInfo.CompOptions.GetPath( pcosUnitPath,icoNone,false,coptParsed,true); OwnerInfo.IncDirs:=OwnerInfo.CompOptions.GetPath( pcosIncludePath,icoNone,false,coptParsed,true); if OwnerInfo.CompOptions.UnitOutputDirectory<>'' then OwnerInfo.UnitOutDir:=OwnerInfo.CompOptions.GetUnitOutputDirectory(false); CustomOptions:=OwnerInfo.CompOptions.ParsedOpts.GetParsedValue(pcosCustomOptions); p:=1; OwnerInfo.HasOptionUr:=FindNextFPCParameter(CustomOptions,'-Ur',p)>0; end; OwnerInfo.IncDirs:=TrimSearchPath(RemoveSearchPaths(OwnerInfo.IncDirs,OwnerInfo.SrcDirs),''); OwnerInfo.UnitOutDir:=TrimFilename(OwnerInfo.UnitOutDir); OwnerInfo.SrcDirs:=TrimSearchPath(OwnerInfo.SrcDirs,''); {$IFDEF VerboseCheckInterPkgFiles} debugln(['AddOwnerInfo Name="',OwnerInfo.Name,'"', ' SrcDirs="',CreateRelativeSearchPath(OwnerInfo.SrcDirs,OwnerInfo.BaseDir),'"', ' IncDirs="',CreateRelativeSearchPath(OwnerInfo.IncDirs,OwnerInfo.BaseDir),'"', ' UnitOutDir="',CreateRelativeSearchPath(OwnerInfo.UnitOutDir,OwnerInfo.BaseDir),'"', '']); {$ENDIF} end; procedure CollectFilesInDir(OwnerInfo: TPGInterPkgOwnerInfo; Dir: string; var SearchedDirs: string; {%H-}IsIncDir: boolean); var Files: TStrings; aFilename: String; AnUnitName: String; NewFile: TPGInterPkgFile; begin if Dir='' then exit; if not FilenameIsAbsolute(Dir) then begin debugln(['Inconsistency: CollectFilesInDir dir no absolute: "',Dir,'" Owner=',OwnerInfo.Name]); exit; end; if SearchDirectoryInSearchPath(SearchedDirs,Dir)>0 then exit; SearchedDirs+=';'+Dir; Files:=nil; try CodeToolBoss.DirectoryCachePool.GetListing(Dir,Files,false); for aFilename in Files do begin if (aFilename='') or (aFilename='.') or (aFilename='..') then continue; if CompareFilenames(aFilename,'fpmake.pp')=0 then continue; AnUnitName:=''; if FilenameExtIn(aFilename,['.ppu','.o','.rst','.rsj','.pas','.pp','.p']) then begin AnUnitName:=ExtractFileNameOnly(aFilename); if not IsDottedIdentifier(AnUnitName) then continue; end else if FilenameExtIn(aFilename,['.inc', '.lfm', '.dfm','.fmx']) then begin {Do nothing} end else continue; NewFile:=TPGInterPkgFile.Create(AppendPathDelim(Dir)+aFilename, AnUnitName,OwnerInfo); FullFiles.Add(NewFile); ShortFiles.Add(NewFile); if AnUnitName<>'' then Units.Add(NewFile); end; finally Files.Free; end; end; procedure CollectFilesOfOwner(OwnerInfo: TPGInterPkgOwnerInfo); var SearchedDirs: String; SearchPath: String; p: Integer; Dir: String; begin // find all unit and include FullFiles in src, inc and out dirs SearchedDirs:=''; CollectFilesInDir(OwnerInfo,OwnerInfo.UnitOutDir,SearchedDirs,false); SearchPath:=OwnerInfo.SrcDirs; p:=1; repeat Dir:=GetNextDirectoryInSearchPath(SearchPath,p); if Dir='' then break; CollectFilesInDir(OwnerInfo,Dir,SearchedDirs,false); until false; SearchPath:=OwnerInfo.IncDirs; p:=1; repeat Dir:=GetNextDirectoryInSearchPath(SearchPath,p); if Dir='' then break; CollectFilesInDir(OwnerInfo,Dir,SearchedDirs,true); until false; end; procedure RemoveSecondaryFiles; // remove each .o file if there is an .ppu file, so that there is only one // warning per ppu file var Node: TAvlTreeNode; ONode: TAvlTreeNode; OFile: TPGInterPkgFile; PPUFileName: String; SearchFile: TPGInterPkgFile; PPUNode: TAvlTreeNode; begin Node:=Units.FindLowest; while Node<>nil do begin // for each .o file ONode:=Node; Node:=Node.Successor; OFile:=TPGInterPkgFile(ONode.Data); if not FilenameIsCompiledSource(OFile.ShortFilename) then continue; if FilenameExtIs(OFile.ShortFilename,'ppu',true) then continue; // search corresponding .ppu PPUFileName:=ChangeFileExt(OFile.FullFilename,'.ppu'); SearchFile:=TPGInterPkgFile.Create(PPUFileName,'',nil); PPUNode:=FullFiles.Find(SearchFile); SearchFile.Free; if PPUNode=nil then continue; // remove .o file ShortFiles.RemovePointer(OFile); FullFiles.RemovePointer(OFile); Units.Delete(ONode); OFile.Free; end; end; function OwnerHasDependency(Owner1, Owner2: TPGInterPkgOwnerInfo): boolean; // returns true if Owner1 depends on Owner2 begin if Owner1=Owner2 then exit(true); if Owner1.Owner is TLazPackage then begin if Owner2.Owner is TLazPackage then begin Result:=PackageGraph.FindDependencyRecursively( TLazPackage(Owner1.Owner).FirstRequiredDependency, TLazPackage(Owner2.Owner))<>nil; end else begin // Owner1 is package, Owner2 is project/IDE => not possible Result:=false; end; end else begin // Owner1 is project or IDE => true Result:=true; end; end; function OptionUrAllowsDuplicate(File1, File2: TPGInterPkgFile): boolean; begin Result:=true; if File1.OwnerInfo.HasOptionUr and File2.OwnerInfo.HasOptionUr then exit; if File1.OwnerInfo.HasOptionUr and OwnerHasDependency(File2.OwnerInfo,File1.OwnerInfo) then exit; if File2.OwnerInfo.HasOptionUr and OwnerHasDependency(File1.OwnerInfo,File2.OwnerInfo) then exit; Result:=false; end; function CheckIfFilesCanConflict(FileGroup: TPGIPAmbiguousFileGroup; File1, File2: TPGInterPkgFile): boolean; var FileDir1: String; FileDir2: String; begin Result:=false; // report only one unit per package if File1.OwnerInfo=File2.OwnerInfo then exit; if (FileGroup<>nil) and (FileGroup.IndexOfOwner(File1.OwnerInfo)>=0) then exit; // check -Ur if OptionUrAllowsDuplicate(File2,File1) then exit; // check shared directories if CompareFilenames(File2.FullFilename,File1.FullFilename)=0 then begin // Two packages share directories // It would would require a lenghty codetools check to find out if // this is right or wrong // => skip exit; end; FileDir1:=ExtractFilePath(File1.FullFilename); FileDir2:=ExtractFilePath(File2.FullFilename); if (FindPathInSearchPath(FileDir1,File2.OwnerInfo.SrcDirs)>0) or (FindPathInSearchPath(FileDir2,File1.OwnerInfo.SrcDirs)>0) then begin // File1 in SrcDirs of file owner 2 // or File2 in SrcDirs of file owner 1 // => a warning about sharing source directories is enough // don't warn every shared file // => skip exit; end; Result:=true; end; procedure FindUnitSourcePPU(var TheUnit: TPGInterPkgFile; out UnitPPU: TPGInterPkgFile); // find in same package the source of a ppu, or the ppu of a source var SearchPPU: Boolean; AnUnitName: string; function FindOther(Node: TAvlTreeNode; Left: boolean): TPGInterPkgFile; var IsPPU: Boolean; begin while Node<>nil do begin Result:=TPGInterPkgFile(Node.Data); if CompareFilenames(ExtractFileNameOnly(Result.ShortFilename), AnUnitName)<>0 then break; if (TheUnit.OwnerInfo=Result.OwnerInfo) then begin IsPPU:=FilenameIsCompiledSource(Result.ShortFilename); if SearchPPU=IsPPU then exit; end; if Left then Node:=Node.Precessor else Node:=Node.Successor; end; Result:=nil; end; var StartNode: TAvlTreeNode; h: TPGInterPkgFile; begin UnitPPU:=nil; AnUnitName:=ExtractFileNameOnly(TheUnit.ShortFilename); SearchPPU:=FilenameIsPascalUnit(TheUnit.ShortFilename); // search opposite StartNode:=ShortFiles.FindPointer(TheUnit); UnitPPU:=FindOther(StartNode,true); if UnitPPU=nil then UnitPPU:=FindOther(StartNode,false); if not SearchPPU then begin h:=TheUnit; TheUnit:=UnitPPU; UnitPPU:=h; end; end; procedure CheckDuplicateUnits; { Check two or more packages have the same unit (ppu/o/pas/pp/p) Unless A uses B and B has -Ur or A has -Ur and B uses A } var CurNode: TAvlTreeNode; CurUnit: TPGInterPkgFile; FirstNodeSameUnitname: TAvlTreeNode; OtherNode: TAvlTreeNode; OtherFile: TPGInterPkgFile; PPUFile: TPGInterPkgFile; FileGroup: TPGIPAmbiguousFileGroup; OtherPPUFile: TPGInterPkgFile; i: Integer; Msg: String; SrcFile: TPGInterPkgFile; begin CurNode:=Units.FindLowest; FirstNodeSameUnitname:=nil; while CurNode<>nil do begin CurUnit:=TPGInterPkgFile(CurNode.Data); if (FirstNodeSameUnitname=nil) or (ComparePGInterPkgUnitnames(CurUnit,TPGInterPkgFile(FirstNodeSameUnitname.Data))<>0) then FirstNodeSameUnitname:=CurNode; CurNode:=CurNode.Successor; if CurUnit.OwnerInfo.HasOptionUr then continue; // CurUnit is an unit without -Ur // => check units with same name FileGroup:=nil; PPUFile:=nil; SrcFile:=nil; OtherNode:=FirstNodeSameUnitname; while OtherNode<>nil do begin OtherFile:=TPGInterPkgFile(OtherNode.Data); if (ComparePGInterPkgUnitnames(CurUnit,OtherFile)<>0) then break; // other unit with same name found OtherNode:=OtherNode.Successor; if not CheckIfFilesCanConflict(FileGroup,CurUnit,OtherFile) then continue; //debugln(['CheckPPUFilesInWrongDirs duplicate units found: file1="',CurUnit.FullFilename,'"(',CurUnit.OwnerInfo.Name,') file2="',OtherFile.FullFilename,'"(',OtherFile.OwnerInfo.Name,')']); FindUnitSourcePPU(OtherFile,OtherPPUFile); if FileGroup=nil then begin SrcFile:=CurUnit; FindUnitSourcePPU(SrcFile,PPUFile); end; if (SrcFile<>nil) and (OtherFile<>nil) and (CompareFilenames(SrcFile.FullFilename,OtherFile.FullFilename)=0) then begin // two packages share source directories // -> do not warn single files continue; end; if (PPUFile<>nil) and (OtherPPUFile<>nil) and (CompareFilenames(PPUFile.FullFilename,OtherPPUFile.FullFilename)=0) and ((OtherFile=nil) or (SrcFile=nil)) then begin // the same ppu is in both packages // ... and only one package has a source // for example: two packages share output directories // => ok continue; end; if FileGroup=nil then begin FileGroup:=TPGIPAmbiguousFileGroup.Create; FileGroup.Add(SrcFile,PPUFile); AmbiguousFileGroups.Add(FileGroup); end; FileGroup.Add(OtherFile,OtherPPUFile); if (PPUFile<>nil) and (OtherPPUFile=nil) then begin // put the orphaned ppu at top FileGroup.Switch(0,length(FileGroup.Sources)-1); end; end; // create Warnings if FileGroup<>nil then begin for i:=0 to length(FileGroup.Sources)-1 do begin SrcFile:=FileGroup.Sources[i]; PPUFile:=FileGroup.CompiledFiles[i]; if SrcFile<>nil then begin Msg:=Format(lisDuplicateUnitIn, [SrcFile.AnUnitName, SrcFile. OwnerInfo.Name]); if PPUFile<>nil then Msg+=', ppu="'+PPUFile.FullFilename+'"'; Msg+=', source="'+SrcFile.FullFilename+'"'; end else begin Msg:=Format(lisDuplicateUnitIn, [PPUFile.AnUnitName, PPUFile. OwnerInfo.Name]); Msg+=', orphaned ppu "'+PPUFile.FullFilename+'"'; end; if IDEMessagesWindow<>nil then IDEMessagesWindow.AddCustomMessage(mluNote,Msg) else debugln('Warning: (lazarus) ',Msg); end; end; // all duplicates of this unitname were found -> skip to next unitname CurNode:=OtherNode; end; end; procedure CheckDuplicateSrcFiles; { Check if a src file in pkg A exists in another package B Unless A uses B and B has -Ur or A has -Ur and B uses A => IDE: ignore or cancel => lazbuild: warn } var CurNode: TAvlTreeNode; CurFile: TPGInterPkgFile; FirstNodeSameShortName: TAvlTreeNode; OtherNode: TAvlTreeNode; OtherFile: TPGInterPkgFile; FileGroup: TPGIPAmbiguousFileGroup; i: Integer; Msg: String; begin CurNode:=ShortFiles.FindLowest; FirstNodeSameShortName:=nil; while CurNode<>nil do begin CurFile:=TPGInterPkgFile(CurNode.Data); if (FirstNodeSameShortName=nil) or (ComparePGInterPkgShortFilename(CurFile,TPGInterPkgFile(FirstNodeSameShortName.Data))<>0) then FirstNodeSameShortName:=CurNode; CurNode:=CurNode.Successor; if CurFile.AnUnitName<>'' then continue; // units were already checked in CheckDuplicateUnits // check files with same short name FileGroup:=nil; OtherNode:=FirstNodeSameShortName; while OtherNode<>nil do begin OtherFile:=TPGInterPkgFile(OtherNode.Data); if (ComparePGInterPkgShortFilename(CurFile,OtherFile)<>0) then break; OtherNode:=OtherNode.Successor; if OtherFile.AnUnitName<>'' then continue; // units were already checked in CheckDuplicateUnits // other file with same short name found if not CheckIfFilesCanConflict(FileGroup,CurFile,OtherFile) then continue; if FileGroup=nil then begin FileGroup:=TPGIPAmbiguousFileGroup.Create; FileGroup.Add(CurFile,nil); AmbiguousFileGroups.Add(FileGroup); end; FileGroup.Add(OtherFile,nil); end; // create Warnings if FileGroup<>nil then begin for i:=0 to length(FileGroup.Sources)-1 do begin CurFile:=FileGroup.Sources[i]; Msg:='Duplicate file "'+ExtractFileName(CurFile.ShortFilename)+'"'; Msg+=' in "'+CurFile.OwnerInfo.Name+'"'; Msg+=', path="'+CurFile.FullFilename+'"'; if IDEMessagesWindow<>nil then IDEMessagesWindow.AddCustomMessage(mluWarning,Msg) else debugln('Warning: (lazarus) ',Msg); end; end; // all duplicates of this file were found -> skip to next group CurNode:=OtherNode; end; end; var i: Integer; {$IFDEF EnableCheckInterPkgFiles} Dlg: TPGIPConflictsDialog; {$ENDIF} begin Result:=true; FilesChanged:=false; if (PkgList=nil) or (PkgList.Count=0) then exit; OwnerInfos:=TObjectList.create(true); FullFiles:=TAvlTree.Create(@ComparePGInterPkgFullFilenames); Units:=TAvlTree.Create(@ComparePGInterPkgUnitnames); ShortFiles:=TAvlTree.Create(@ComparePGInterPkgShortFilename); AmbiguousFileGroups:=TObjectList.create(true); {$IFDEF EnableCheckInterPkgFiles} Dlg:=nil; {$ENDIF} try // get target OS, CPU and LCLWidgetType TargetOS:='$(TargetOS)'; GlobalMacroList.SubstituteStr(TargetOS); if TargetOS='' then TargetOS:=GetCompiledTargetOS; TargetCPU:='$(TargetCPU)'; GlobalMacroList.SubstituteStr(TargetCPU); if TargetCPU='' then TargetCPU:=GetCompiledTargetCPU; LCLWidgetType:='$(LCLWidgetType)'; GlobalMacroList.SubstituteStr(LCLWidgetType); if LCLWidgetType='' then LCLWidgetType:=GetLCLWidgetTypeName; {$IFDEF VerboseCheckInterPkgFiles} debugln(['CheckInterPkgFiles TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' LCLWidgetType=',LCLWidgetType]); {$ENDIF} // get search paths AddOwnerInfo(IDEObject); for i:=0 to PkgList.Count-1 do AddOwnerInfo(TObject(PkgList[i])); // collect FullFiles for i:=0 to OwnerInfos.Count-1 do CollectFilesOfOwner(TPGInterPkgOwnerInfo(OwnerInfos[i])); RemoveSecondaryFiles; // checks CheckDuplicateUnits; CheckDuplicateSrcFiles; if (AmbiguousFileGroups.Count=0) then exit; // show warnings if LazarusIDE<>nil then begin {$IFDEF EnableCheckInterPkgFiles} // IDE Dlg:=TPGIPConflictsDialog.Create(nil); Dlg.Init(AmbiguousFileGroups); if Dlg.ShowModal<>mrOK then exit(false); FilesChanged:=Dlg.FilesChanged; {$ENDIF} end; finally {$IFDEF EnableCheckInterPkgFiles} Dlg.Free; {$ENDIF} AmbiguousFileGroups.Free; Units.Free; ShortFiles.Free; FullFiles.FreeAndClear; FullFiles.Free; OwnerInfos.Free; end; end; end.