1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Called after checking what packages need compile.
25 Check source files and compiled files for name conflicts between packages.
26
27 ToDo:
28 - project compiler option verbosity: dialog on duplicate files
29 - save date ignore
30 - use date ignore
31 - clear ignore on
32 - clean build
33 - error cant find include file
34 unit_f_cant_find_ppu=10022_F_Can't find unit $1 used by $2
35 unit_u_ppu_invalid_header=10007_U_PPU Invalid Header (no PPU at the begin)
36 unit_f_cant_compile_unit=10021_F_Can't compile unit $1, no sources available
37 unit_f_cant_find_ppu=10022_F_Can't find unit $1 used by $2
38 unit_w_unit_name_error=10023_W_Unit $1 was not found but $2 exists
39 unit_f_unit_name_error=10024_F_Unit $1 searched but $2 found
40 unit_u_recompile_crc_change=10028_U_Recompiling $1, checksum changed for $2
41 unit_u_recompile_source_found_alone=10029_U_Recompiling $1, source found only
42 unit_u_recompile_staticlib_is_older=10030_U_Recompiling unit, static lib is older than ppufile
43 unit_u_recompile_sharedlib_is_older=10031_U_Recompiling unit, shared lib is older than ppufile
44 unit_u_recompile_obj_and_asm_older=10032_U_Recompiling unit, obj and asm are older than ppufile
45 unit_u_recompile_obj_older_than_asm=10033_U_Recompiling unit, obj is older than asm
46 unit_w_cant_compile_unit_with_changed_incfile=10040_W_Can't recompile unit $1, but found modifed include files
47 unit_u_source_modified=10041_U_File $1 is newer than the one used for creating PPU file $2
48 }
49 unit InterPkgConflictFiles;
50
51 {$mode objfpc}{$H+}
52
53 interface
54
55 uses
56 // RTL + FCL
57 Classes, SysUtils, types, math, contnrs, Laz_AVL_Tree,
58 // LCL
59 Forms, ComCtrls, Controls, ButtonPanel, Themes, Graphics, StdCtrls, Buttons,
60 InterfaceBase,
61 // CodeTools
62 BasicCodeTools, DefineTemplates, CodeToolManager, FileProcs,
63 // LazUtils
64 LazFileUtils, LazFileCache, LazTracer,
65 // IDEIntf
66 ProjectIntf, CompOptsIntf, IDEWindowIntf, LazIDEIntf, IDEMsgIntf, IDEExternToolIntf,
67 // IDE
68 CompilerOptions, EnvironmentOpts, IDEProcs, DialogProcs, LazarusIDEStrConsts,
69 TransferMacros, PackageDefs, PackageSystem;
70
71 type
72 TPGInterPkgOwnerInfo = class
73 public
74 Name: string;
75 Owner: TObject;
76 HasOptionUr: boolean;
77 CompOptions: TBaseCompilerOptions;
78 BaseDir: string;
79 SrcDirs: string; // unitpath without inherited
80 IncDirs: string; // incpath without inherited and without SrcDirs
81 UnitOutDir: string; // can be empty -> if empty FPC creates ppu in SrcDirs
82 end;
83
84 { TPGInterPkgFile }
85
86 TPGInterPkgFile = class
87 public
88 FullFilename: string;
89 ShortFilename: string;
90 AnUnitName: string;
91 OwnerInfo: TPGInterPkgOwnerInfo;
92 constructor Create(TheFullFilename, TheUnitName: string; Owner: TPGInterPkgOwnerInfo);
93 end;
94 TPGInterPkgFileArray = array of TPGInterPkgFile;
95
96 { TPGIPAmbiguousFileGroup }
97
98 TPGIPAmbiguousFileGroup = class
99 public
100 CompiledFiles: TPGInterPkgFileArray;
101 Sources: TPGInterPkgFileArray;
Addnull102 function Add(SrcFile, PPUFile: TPGInterPkgFile): integer;
IndexOfOwnernull103 function IndexOfOwner(OwnerInfo: TPGInterPkgOwnerInfo): integer;
104 procedure Switch(Index1, Index2: integer);
105 end;
106
107 TPGIPCategory = (
108 pgipOrphanedCompiled,
109 pgipDuplicateSource
110 );
111
112 { TPGIPConflictsDialog }
113
114 TPGIPConflictsDialog = class(TForm)
115 ButtonPanel1: TButtonPanel;
116 ConflictsTreeView: TTreeView;
117 IDEDialogLayoutStorage1: TIDEDialogLayoutStorage;
118 ImageList1: TImageList;
119 procedure ConflictsTreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
120 Node: TTreeNode; {%H-}State: TCustomDrawState; Stage: TCustomDrawStage;
121 var {%H-}PaintImages, {%H-}DefaultDraw: Boolean);
122 procedure ConflictsTreeViewMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
123 {%H-}Shift: TShiftState; X, Y: Integer);
124 procedure DeleteSelectedFilesButtonClick(Sender: TObject);
125 procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
126 procedure FormCreate(Sender: TObject);
127 procedure OkButtonClick(Sender: TObject);
128 private
129 DeleteSelectedFilesButton: TButton;
130 FImgIndexChecked: integer;
131 FImgIndexUnchecked: integer;
132 FCategoryNodes: array[TPGIPCategory] of TTreeNode;
133 procedure UpdateButtons;
134 procedure IgnoreConflicts;
135 public
136 FileGroups: TObjectList; // list of TPGIPAmbiguousFileGroup
137 FilesChanged: boolean;
138 procedure Init(Groups: TObjectList);
139 end;
140
CheckInterPkgFilesnull141 function CheckInterPkgFiles(IDEObject: TObject;
142 PkgList: TFPList; out FilesChanged: boolean
143 ): boolean; // returns false if user cancelled
144
145 implementation
146
147 {$R *.lfm}
148
ComparePGInterPkgFullFilenamesnull149 function ComparePGInterPkgFullFilenames(File1, File2: Pointer): integer;
150 var
151 F1: TPGInterPkgFile absolute File1;
152 F2: TPGInterPkgFile absolute File2;
153 begin
154 Result:=CompareFilenames(F1.FullFilename,F2.FullFilename);
155 end;
156
ComparePGInterPkgUnitnamesnull157 function ComparePGInterPkgUnitnames(File1, File2: Pointer): integer;
158 var
159 F1: TPGInterPkgFile absolute File1;
160 F2: TPGInterPkgFile absolute File2;
161 begin
162 Assert(Assigned(F1), 'ComparePGInterPkgUnitnames: File1=Nil.');
163 Assert(Assigned(F2), 'ComparePGInterPkgUnitnames: File2=Nil.');
164 Result:=CompareDottedIdentifiers(PChar(F1.AnUnitName),PChar(F2.AnUnitName));
165 end;
166
ComparePGInterPkgShortFilenamenull167 function ComparePGInterPkgShortFilename(File1, File2: Pointer): integer;
168 var
169 F1: TPGInterPkgFile absolute File1;
170 F2: TPGInterPkgFile absolute File2;
171 begin
172 // compare case insensitive to find cross platform duplicates
173 // Note: do not use CompareFilenamesIgnoreCase, because of Turkish ı, I
174 Result:=CompareText(F1.ShortFilename,F2.ShortFilename);
175 end;
176
FilenameIsCompiledSourcenull177 function FilenameIsCompiledSource(aFilename: string): boolean;
178 begin
179 Result:=FilenameExtIn(aFilename,['.ppu','.o','.rst','.rsj']);
180 end;
181
182 { TPGIPAmbiguousFileGroup }
183
Addnull184 function TPGIPAmbiguousFileGroup.Add(SrcFile, PPUFile: TPGInterPkgFile): integer;
185 begin
186 if (SrcFile=nil) and (PPUFile=nil) then
187 RaiseGDBException('');
188 if (SrcFile<>nil) and (PPUFile<>nil) and (PPUFile.OwnerInfo<>SrcFile.OwnerInfo) then
189 RaiseGDBException('bug: not equal: PPUFile.OwnerInfo='+PPUFile.OwnerInfo.Name+' SrcFile.OwnerInfo='+SrcFile.OwnerInfo.Name);
190 if (SrcFile<>nil) and FilenameIsCompiledSource(SrcFile.ShortFilename) then
191 RaiseGDBException('bug: src is compiled file: SrcFile.Filename='+SrcFile.FullFilename);
192 if (PPUFile<>nil) and not FilenameIsCompiledSource(PPUFile.ShortFilename) then
193 RaiseGDBException('bug: compiled file is source:'+PPUFile.FullFilename);
194 Result:=length(CompiledFiles);
195 SetLength(CompiledFiles,Result+1);
196 SetLength(Sources,Result+1);
197 Sources[Result]:=SrcFile;
198 CompiledFiles[Result]:=PPUFile
199 end;
200
TPGIPAmbiguousFileGroup.IndexOfOwnernull201 function TPGIPAmbiguousFileGroup.IndexOfOwner(OwnerInfo: TPGInterPkgOwnerInfo
202 ): integer;
203 begin
204 Result:=length(Sources)-1;
205 while (Result>=0) do
206 begin
207 if (Sources[Result]<>nil) then
208 begin
209 if (Sources[Result].OwnerInfo=OwnerInfo) then exit;
210 end else begin
211 if (CompiledFiles[Result].OwnerInfo=OwnerInfo) then exit;
212 end;
213 dec(Result);
214 end;
215 end;
216
217 procedure TPGIPAmbiguousFileGroup.Switch(Index1, Index2: integer);
218 var
219 aFile: TPGInterPkgFile;
220 begin
221 aFile:=Sources[Index1]; Sources[Index1]:=Sources[Index2]; Sources[Index2]:=aFile;
222 aFile:=CompiledFiles[Index1]; CompiledFiles[Index1]:=CompiledFiles[Index2]; CompiledFiles[Index2]:=aFile;
223 end;
224
225 { TPGIPConflictsDialog }
226
227 procedure TPGIPConflictsDialog.ConflictsTreeViewAdvancedCustomDrawItem(
228 Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
229 Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
230 var
231 Detail: TThemedButton;
232 Details: TThemedElementDetails;
233 aSize: TSize;
234 NodeRect: Classes.TRect;
235 r: TRect;
236 begin
237 if Stage<>cdPostPaint then exit;
238 if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin
239 if Node.ImageIndex=FImgIndexChecked then
240 Detail := tbCheckBoxCheckedNormal
241 else
242 Detail := tbCheckBoxUncheckedNormal;
243 Details := ThemeServices.GetElementDetails(Detail);
244 aSize := ThemeServices.GetDetailSize(Details);
245 NodeRect:=Node.DisplayRect(false);
246 r:=Bounds(Node.DisplayIconLeft+(ImageList1.Width-aSize.cx) div 2,
247 NodeRect.Top+(NodeRect.Bottom-NodeRect.Top-aSize.cy) div 2,
248 aSize.cx,aSize.cy);
249 ThemeServices.DrawElement(ConflictsTreeView.Canvas.Handle,Details,r);
250 end;
251 end;
252
253 procedure TPGIPConflictsDialog.ConflictsTreeViewMouseDown(Sender: TObject;
254 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
255 var
256 Node: TTreeNode;
257 begin
258 Node:=ConflictsTreeView.GetNodeAt(X,Y);
259 if Node=nil then exit;
260 if TObject(Node.Data) is TPGIPAmbiguousFileGroup then begin
261 if (X>=Node.DisplayIconLeft) and (X<Node.DisplayTextLeft) then begin
262 if Node.ImageIndex=FImgIndexChecked then
263 Node.ImageIndex:=FImgIndexUnchecked
264 else
265 Node.ImageIndex:=FImgIndexChecked;
266 Node.SelectedIndex:=Node.ImageIndex;
267 UpdateButtons;
268 end;
269 end;
270 end;
271
272 procedure TPGIPConflictsDialog.DeleteSelectedFilesButtonClick(Sender: TObject);
273
DeleteFileAndAssociatesnull274 function DeleteFileAndAssociates(aFile: TPGInterPkgFile): boolean;
275 var
276 aFilename: String;
277 begin
278 if aFile=nil then exit(true);
279 aFilename:=aFile.FullFilename;
280 {$IFDEF VerboseCheckInterPkgFiles}
281 debugln(['DeleteFileGroup ',aFilename]);
282 {$ENDIF}
283 if DeleteFileInteractive(aFilename)<>mrOk then exit(false);
284 if FilenameIsPascalUnit(aFilename) then
285 begin
286 // unit source -> delete compiled files and resources
287 DeleteFileUTF8(ChangeFileExt(aFilename,'.ppu'));
288 DeleteFileUTF8(ChangeFileExt(aFilename,'.o'));
289 DeleteFileUTF8(ChangeFileExt(aFilename,'.rst'));
290 DeleteFileUTF8(ChangeFileExt(aFilename,'.rsj'));
291 DeleteFileUTF8(ChangeFileExt(aFilename,'.lfm'));
292 DeleteFileUTF8(ChangeFileExt(aFilename,'.dfm'));
293 DeleteFileUTF8(ChangeFileExt(aFilename,'.xfm'));
294 end else if FilenameIsCompiledSource(aFilename) then begin
295 // compiled file -> delete compiled files. Keep sources.
296 DeleteFileUTF8(ChangeFileExt(aFilename,'.ppu'));
297 DeleteFileUTF8(ChangeFileExt(aFilename,'.o'));
298 DeleteFileUTF8(ChangeFileExt(aFilename,'.rst'));
299 DeleteFileUTF8(ChangeFileExt(aFilename,'.rsj'));
300 if FileExistsCached(ChangeFileExt(aFilename,'.pas'))
301 or FileExistsCached(ChangeFileExt(aFilename,'.pp'))
302 or FileExistsCached(ChangeFileExt(aFilename,'.p')) then begin
303 // delete only compiled file
304 end else begin
305 // no source in this directory => delete copied lfm file
306 DeleteFileUTF8(ChangeFileExt(aFilename,'.lfm'));
307 DeleteFileUTF8(ChangeFileExt(aFilename,'.dfm'));
308 DeleteFileUTF8(ChangeFileExt(aFilename,'.xfm'));
309 end;
310 end;
311 Result:=true;
312 end;
313
314 var
315 Node: TTreeNode;
316 NextNode: TTreeNode;
317 FileGroup: TPGIPAmbiguousFileGroup;
318 IndexInGroup: integer;
319 ConflictCount: Integer;
320 begin
321 ConflictsTreeView.Items.BeginUpdate;
322 try
323 Node:=ConflictsTreeView.Items.GetFirstNode;
324 IndexInGroup:=-1;
325 ConflictCount:=0;
326 while Node<>nil do
327 begin
328 NextNode:=Node.GetNext;
329 if TObject(Node.Data) is TPGIPAmbiguousFileGroup then
330 begin
331 FileGroup:=TPGIPAmbiguousFileGroup(Node.Data);
332 inc(IndexInGroup);
333 if Node.ImageIndex=FImgIndexChecked then
334 begin
335 if not DeleteFileAndAssociates(FileGroup.Sources[IndexInGroup]) then exit;
336 if not DeleteFileAndAssociates(FileGroup.CompiledFiles[IndexInGroup]) then exit;
337 end;
338 if ((FileGroup.Sources[IndexInGroup]<>nil)
339 and FileExistsUTF8(FileGroup.Sources[IndexInGroup].FullFilename))
340 or ((FileGroup.CompiledFiles[IndexInGroup]<>nil)
341 and FileExistsUTF8(FileGroup.CompiledFiles[IndexInGroup].FullFilename))
342 then
343 inc(ConflictCount);
344 if IndexInGroup=length(FileGroup.Sources)-1 then
345 begin
346 if ConflictCount<=1 then begin
347 // conflict does not exist anymore
348 FilesChanged:=true;
349 Node:=Node.Parent;
350 NextNode:=Node.GetNextSkipChildren;
351 Node.Delete;
352 end;
353 IndexInGroup:=-1;
354 ConflictCount:=0;
355 end;
356 end;
357 Node:=NextNode;
358 end;
359 finally
360 ConflictsTreeView.Items.EndUpdate;
361 UpdateButtons;
362 end;
363 end;
364
365 procedure TPGIPConflictsDialog.FormClose(Sender: TObject;
366 var CloseAction: TCloseAction);
367 begin
368 IDEDialogLayoutList.SaveLayout(Self);
369 end;
370
371 procedure TPGIPConflictsDialog.FormCreate(Sender: TObject);
372 var
373 Details: TThemedElementDetails;
374 aSize: TSize;
375 Img: TBitmap;
376 begin
377 IDEDialogLayoutList.ApplyLayout(Self);
378
379 DeleteSelectedFilesButton:=TButton.Create(Self);
380 with DeleteSelectedFilesButton do
381 begin
382 Name:='DeleteSelectedFilesButton';
383 Caption:='Delete selected files';
384 Align:=alLeft;
385 AutoSize:=true;
386 OnClick:=@DeleteSelectedFilesButtonClick;
387 Parent:=ButtonPanel1;
388 end;
389
390 ButtonPanel1.OKButton.Kind:=bkIgnore;
391 ButtonPanel1.OKButton.Caption:='Ignore';
392 ButtonPanel1.OKButton.OnClick:=@OkButtonClick;
393
394 Details := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
395 aSize := ThemeServices.GetDetailSize(Details);
396 ImageList1.Width:=Max(16,aSize.cx);
397 ImageList1.Height:=Max(16,aSize.cy);
398 // add empty images
399 Img:=TBitmap.Create;
400 Img.TransparentMode:=tmFixed;
401 Img.TransparentColor:=0;
402 Img.Transparent:=true;
403 Img.SetSize(ImageList1.Width,ImageList1.Height);
404 FImgIndexChecked:=ImageList1.Add(Img,nil);
405 FImgIndexUnchecked:=ImageList1.Add(Img,nil);
406 Img.Free;
407 end;
408
409 procedure TPGIPConflictsDialog.OkButtonClick(Sender: TObject);
410 begin
411 IgnoreConflicts;
412 end;
413
414 procedure TPGIPConflictsDialog.UpdateButtons;
415 var
416 Node: TTreeNode;
417 DeleteCount: Integer;
418 ConflictCount: Integer;
419 begin
420 DeleteCount:=0;
421 ConflictCount:=0;
422 Node:=ConflictsTreeView.Items.GetFirstNode;
423 while Node<>nil do begin
424 if TObject(Node.Data) is TPGIPAmbiguousFileGroup then
425 begin
426 inc(ConflictCount);
427 if Node.ImageIndex=FImgIndexChecked then
428 inc(DeleteCount);
429 end;
430 Node:=Node.GetNext;
431 end;
432 DeleteSelectedFilesButton.Enabled:=DeleteCount>0;
433 if ConflictCount=0 then
434 IgnoreConflicts;
435 end;
436
437 procedure TPGIPConflictsDialog.IgnoreConflicts;
438 begin
439 // ToDo
440 ModalResult:=mrOk;
441 end;
442
443 procedure TPGIPConflictsDialog.Init(Groups: TObjectList);
444
AddChildnull445 function AddChild(ParentNode: TTreeNode; Caption: string): TTreeNode;
446 begin
447 Result:=ConflictsTreeView.Items.AddChild(ParentNode,Caption);
448 end;
449
450 var
451 i, j: Integer;
452 ItemNode: TTreeNode;
453 s: String;
454 FileGroupNode: TTreeNode;
455 FileGroup: TPGIPAmbiguousFileGroup;
456 SrcFile: TPGInterPkgFile;
457 CompiledFile: TPGInterPkgFile;
458 CurFile: TPGInterPkgFile;
459 c: TPGIPCategory;
460 begin
461 FileGroups:=Groups;
462
463 ConflictsTreeView.Items.BeginUpdate;
464 ConflictsTreeView.Items.Clear;
465 ConflictsTreeView.Images:=ImageList1;
466 for c in TPGIPCategory do
467 FCategoryNodes[c]:=nil;
468 for i:=0 to FileGroups.Count-1 do
469 begin
470 FileGroup:=TPGIPAmbiguousFileGroup(FileGroups[i]);
471
472 // category
473 if FileGroup.Sources[0]=nil then
474 begin
475 // orphaned compiled file
476 CurFile:=FileGroup.CompiledFiles[0];
477 c:=pgipOrphanedCompiled;
478 if FCategoryNodes[c]=nil then
479 FCategoryNodes[c]:=
480 ConflictsTreeView.Items.Add(nil,'Orphaned compiled files');
481 end else begin
482 // duplicate source file
483 CurFile:=FileGroup.Sources[0];
484 c:=pgipDuplicateSource;
485 if FCategoryNodes[c]=nil then
486 FCategoryNodes[c]:=
487 ConflictsTreeView.Items.Add(nil,'Duplicate source files');
488 end;
489
490 // file group
491 s:=ExtractFilename(CurFile.ShortFilename);
492 FileGroupNode:=AddChild(FCategoryNodes[c],s);
493
494 for j:=0 to length(FileGroup.Sources)-1 do
495 begin
496 SrcFile:=FileGroup.Sources[j];
497 CompiledFile:=FileGroup.CompiledFiles[j];
498
499 if SrcFile<>nil then
500 CurFile:=SrcFile
501 else
502 CurFile:=CompiledFile;
503
504 s:=ExtractFilename(CurFile.ShortFilename);
505 if CurFile.OwnerInfo.Owner is TLazPackage then
506 s+=' of package '+CurFile.OwnerInfo.Name
507 else
508 s+=' of '+CurFile.OwnerInfo.Name;
509 ItemNode:=AddChild(FileGroupNode,s);
510 if SrcFile=nil then
511 ItemNode.ImageIndex:=FImgIndexChecked // default: delete
512 else
513 ItemNode.ImageIndex:=FImgIndexUnchecked; // default: keep
514 ItemNode.SelectedIndex:=ItemNode.ImageIndex;
515 ItemNode.Data:=FileGroup;
516 begin
517 // file paths of compiled and src
518 if CompiledFile<>nil then
519 AddChild(ItemNode,'Compiled: '+CompiledFile.FullFilename);
520 if SrcFile<>nil then
521 AddChild(ItemNode,'Source: '+SrcFile.FullFilename)
522 else
523 AddChild(ItemNode,'No source found');
524 end;
525 end;
526 end;
527 // expand all nodes
528 for c in TPGIPCategory do
529 if FCategoryNodes[c]<>nil then
530 FCategoryNodes[c].Expand(true);
531
532 ConflictsTreeView.Items.EndUpdate;
533
534 UpdateButtons;
535 end;
536
537 { TPGInterPkgFile }
538
539 constructor TPGInterPkgFile.Create(TheFullFilename, TheUnitName: string;
540 Owner: TPGInterPkgOwnerInfo);
541 begin
542 FullFilename:=TheFullFilename;
543 ShortFilename:=ExtractFileName(FullFilename);
544 AnUnitName:=TheUnitName;
545 OwnerInfo:=Owner;
546 end;
547
CheckInterPkgFilesnull548 function CheckInterPkgFiles(IDEObject: TObject; PkgList: TFPList; out
549 FilesChanged: boolean): boolean;
550 { Scan all source and output directories (Note: they are already cached, because
551 this method is called after the checks if a compile is needed).
552 Report strange ppu files and duplicate file names.
553
554 IDEObject can be a TProject, TLazPackage or TLazPackageGraph(building IDE)
555 PkgList is list of TLazPackage
556 }
557 var
558 OwnerInfos: TObjectList; // list of TPGInterPkgOwnerInfo
559 TargetOS: String;
560 TargetCPU: String;
561 LCLWidgetType: String;
562 FullFiles: TAvlTree; // tree of TPGInterPkgFile sorted for FullFilename
563 Units: TAvlTree; // tree of TPGInterPkgFile sorted for AnUnitName
564 ShortFiles: TAvlTree; // tree of TPGInterPkgFile sorted for ShortFilename
565 AmbiguousFileGroups: TObjectList; // list of TPGIPAmbiguousFileGroup
566
567 procedure AddOwnerInfo(TheOwner: TObject);
568 var
569 LazDir: String;
570 CustomOptions: String;
571 p: Integer;
572 OwnerInfo: TPGInterPkgOwnerInfo;
573 begin
574 OwnerInfo:=TPGInterPkgOwnerInfo.Create;
575 OwnerInfos.Add(OwnerInfo);
576 OwnerInfo.Owner:=TheOwner;
577 if TheOwner is TLazPackage then
578 begin
579 OwnerInfo.Name:=TLazPackage(TheOwner).IDAsString;
580 OwnerInfo.CompOptions:=TLazPackage(TheOwner).LazCompilerOptions as TBaseCompilerOptions;
581 end else if TheOwner is TLazProject then
582 begin
583 OwnerInfo.Name:=TLazProject(TheOwner).GetTitleOrName;
584 OwnerInfo.CompOptions:=TLazProject(TheOwner).LazCompilerOptions as TBaseCompilerOptions;
585 end
586 else if TheOwner=PackageGraph then begin
587 // building IDE
588 OwnerInfo.Name:='#IDE';
589 LazDir:=AppendPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
590 OwnerInfo.BaseDir:=LazDir;
591 OwnerInfo.SrcDirs:=LazDir+'ide'
592 +';'+LazDir+'debugger'
593 +';'+LazDir+'packager'
594 +';'+LazDir+'designer'
595 +';'+LazDir+'converter';
596 OwnerInfo.IncDirs:=OwnerInfo.SrcDirs
597 +';'+LazDir+'ide'+PathDelim+'include'+PathDelim+TargetOS
598 +';'+LazDir+'ide'+PathDelim+'include'+PathDelim+GetDefaultSrcOSForTargetOS(TargetOS);
599 OwnerInfo.UnitOutDir:=LazDir+'units'+PathDelim+TargetCPU+'-'+TargetOS+PathDelim+LCLWidgetType;
600 end;
601 if OwnerInfo.CompOptions<>nil then begin
602 OwnerInfo.BaseDir:=OwnerInfo.CompOptions.BaseDirectory;
603 OwnerInfo.SrcDirs:=OwnerInfo.CompOptions.GetPath(
604 pcosUnitPath,icoNone,false,coptParsed,true);
605 OwnerInfo.IncDirs:=OwnerInfo.CompOptions.GetPath(
606 pcosIncludePath,icoNone,false,coptParsed,true);
607 if OwnerInfo.CompOptions.UnitOutputDirectory<>'' then
608 OwnerInfo.UnitOutDir:=OwnerInfo.CompOptions.GetUnitOutputDirectory(false);
609 CustomOptions:=OwnerInfo.CompOptions.ParsedOpts.GetParsedValue(pcosCustomOptions);
610 p:=1;
611 OwnerInfo.HasOptionUr:=FindNextFPCParameter(CustomOptions,'-Ur',p)>0;
612 end;
613 OwnerInfo.IncDirs:=TrimSearchPath(RemoveSearchPaths(OwnerInfo.IncDirs,OwnerInfo.SrcDirs),'');
614 OwnerInfo.UnitOutDir:=TrimFilename(OwnerInfo.UnitOutDir);
615 OwnerInfo.SrcDirs:=TrimSearchPath(OwnerInfo.SrcDirs,'');
616 {$IFDEF VerboseCheckInterPkgFiles}
617 debugln(['AddOwnerInfo Name="',OwnerInfo.Name,'"',
618 ' SrcDirs="',CreateRelativeSearchPath(OwnerInfo.SrcDirs,OwnerInfo.BaseDir),'"',
619 ' IncDirs="',CreateRelativeSearchPath(OwnerInfo.IncDirs,OwnerInfo.BaseDir),'"',
620 ' UnitOutDir="',CreateRelativeSearchPath(OwnerInfo.UnitOutDir,OwnerInfo.BaseDir),'"',
621 '']);
622 {$ENDIF}
623 end;
624
625 procedure CollectFilesInDir(OwnerInfo: TPGInterPkgOwnerInfo; Dir: string;
626 var SearchedDirs: string; {%H-}IsIncDir: boolean);
627 var
628 Files: TStrings;
629 aFilename: String;
630 AnUnitName: String;
631 NewFile: TPGInterPkgFile;
632 begin
633 if Dir='' then exit;
634 if not FilenameIsAbsolute(Dir) then
635 begin
636 debugln(['Inconsistency: CollectFilesInDir dir no absolute: "',Dir,'" Owner=',OwnerInfo.Name]);
637 exit;
638 end;
639 if SearchDirectoryInSearchPath(SearchedDirs,Dir)>0 then exit;
640 SearchedDirs+=';'+Dir;
641 Files:=nil;
642 try
643 CodeToolBoss.DirectoryCachePool.GetListing(Dir,Files,false);
644 for aFilename in Files do
645 begin
646 if (aFilename='') or (aFilename='.') or (aFilename='..') then continue;
647 if CompareFilenames(aFilename,'fpmake.pp')=0 then continue;
648 AnUnitName:='';
649 if FilenameExtIn(aFilename,['.ppu','.o','.rst','.rsj','.pas','.pp','.p']) then
650 begin
651 AnUnitName:=ExtractFileNameOnly(aFilename);
652 if not IsDottedIdentifier(AnUnitName) then continue;
653 end
654 else if FilenameExtIn(aFilename,['.inc', '.lfm', '.dfm']) then
655 begin {Do nothing} end
656 else
657 continue;
658 NewFile:=TPGInterPkgFile.Create(AppendPathDelim(Dir)+aFilename,
659 AnUnitName,OwnerInfo);
660 FullFiles.Add(NewFile);
661 ShortFiles.Add(NewFile);
662 if AnUnitName<>'' then
663 Units.Add(NewFile);
664 end;
665 finally
666 Files.Free;
667 end;
668 end;
669
670 procedure CollectFilesOfOwner(OwnerInfo: TPGInterPkgOwnerInfo);
671 var
672 SearchedDirs: String;
673 SearchPath: String;
674 p: Integer;
675 Dir: String;
676 begin
677 // find all unit and include FullFiles in src, inc and out dirs
678 SearchedDirs:='';
679 CollectFilesInDir(OwnerInfo,OwnerInfo.UnitOutDir,SearchedDirs,false);
680 SearchPath:=OwnerInfo.SrcDirs;
681 p:=1;
682 repeat
683 Dir:=GetNextDirectoryInSearchPath(SearchPath,p);
684 if Dir='' then break;
685 CollectFilesInDir(OwnerInfo,Dir,SearchedDirs,false);
686 until false;
687 SearchPath:=OwnerInfo.IncDirs;
688 p:=1;
689 repeat
690 Dir:=GetNextDirectoryInSearchPath(SearchPath,p);
691 if Dir='' then break;
692 CollectFilesInDir(OwnerInfo,Dir,SearchedDirs,true);
693 until false;
694 end;
695
696 procedure RemoveSecondaryFiles;
697 // remove each .o file if there is an .ppu file, so that there is only one
698 // warning per ppu file
699 var
700 Node: TAvlTreeNode;
701 ONode: TAvlTreeNode;
702 OFile: TPGInterPkgFile;
703 PPUFileName: String;
704 SearchFile: TPGInterPkgFile;
705 PPUNode: TAvlTreeNode;
706 begin
707 Node:=Units.FindLowest;
708 while Node<>nil do begin
709 // for each .o file
710 ONode:=Node;
711 Node:=Node.Successor;
712 OFile:=TPGInterPkgFile(ONode.Data);
713 if not FilenameIsCompiledSource(OFile.ShortFilename) then continue;
714 if FilenameExtIs(OFile.ShortFilename,'ppu',true) then continue;
715 // search corresponding .ppu
716 PPUFileName:=ChangeFileExt(OFile.FullFilename,'.ppu');
717 SearchFile:=TPGInterPkgFile.Create(PPUFileName,'',nil);
718 PPUNode:=FullFiles.Find(SearchFile);
719 SearchFile.Free;
720 if PPUNode=nil then continue;
721 // remove .o file
722 ShortFiles.RemovePointer(OFile);
723 FullFiles.RemovePointer(OFile);
724 Units.Delete(ONode);
725 OFile.Free;
726 end;
727 end;
728
OwnerHasDependencynull729 function OwnerHasDependency(Owner1, Owner2: TPGInterPkgOwnerInfo): boolean;
730 // returns true if Owner1 depends on Owner2
731 begin
732 if Owner1=Owner2 then exit(true);
733 if Owner1.Owner is TLazPackage then
734 begin
735 if Owner2.Owner is TLazPackage then
736 begin
737 Result:=PackageGraph.FindDependencyRecursively(
738 TLazPackage(Owner1.Owner).FirstRequiredDependency,
739 TLazPackage(Owner2.Owner))<>nil;
740 end else begin
741 // Owner1 is package, Owner2 is project/IDE => not possible
742 Result:=false;
743 end;
744 end else begin
745 // Owner1 is project or IDE => true
746 Result:=true;
747 end;
748 end;
749
OptionUrAllowsDuplicatenull750 function OptionUrAllowsDuplicate(File1, File2: TPGInterPkgFile): boolean;
751 begin
752 Result:=true;
753 if File1.OwnerInfo.HasOptionUr
754 and File2.OwnerInfo.HasOptionUr then
755 exit;
756 if File1.OwnerInfo.HasOptionUr
757 and OwnerHasDependency(File2.OwnerInfo,File1.OwnerInfo) then
758 exit;
759 if File2.OwnerInfo.HasOptionUr
760 and OwnerHasDependency(File1.OwnerInfo,File2.OwnerInfo) then
761 exit;
762 Result:=false;
763 end;
764
CheckIfFilesCanConflictnull765 function CheckIfFilesCanConflict(FileGroup: TPGIPAmbiguousFileGroup;
766 File1, File2: TPGInterPkgFile): boolean;
767 var
768 FileDir1: String;
769 FileDir2: String;
770 begin
771 Result:=false;
772 // report only one unit per package
773 if File1.OwnerInfo=File2.OwnerInfo then exit;
774 if (FileGroup<>nil) and (FileGroup.IndexOfOwner(File1.OwnerInfo)>=0)
775 then exit;
776 // check -Ur
777 if OptionUrAllowsDuplicate(File2,File1) then
778 exit;
779 // check shared directories
780 if CompareFilenames(File2.FullFilename,File1.FullFilename)=0 then
781 begin
782 // Two packages share directories
783 // It would would require a lenghty codetools check to find out if
784 // this is right or wrong
785 // => skip
786 exit;
787 end;
788 FileDir1:=ExtractFilePath(File1.FullFilename);
789 FileDir2:=ExtractFilePath(File2.FullFilename);
790 if (FindPathInSearchPath(FileDir1,File2.OwnerInfo.SrcDirs)>0)
791 or (FindPathInSearchPath(FileDir2,File1.OwnerInfo.SrcDirs)>0) then
792 begin
793 // File1 in SrcDirs of file owner 2
794 // or File2 in SrcDirs of file owner 1
795 // => a warning about sharing source directories is enough
796 // don't warn every shared file
797 // => skip
798 exit;
799 end;
800
801 Result:=true;
802 end;
803
804 procedure FindUnitSourcePPU(var TheUnit: TPGInterPkgFile; out UnitPPU: TPGInterPkgFile);
805 // find in same package the source of a ppu, or the ppu of a source
806 var
807 SearchPPU: Boolean;
808 AnUnitName: string;
809
810 function FindOther(Node: TAvlTreeNode; Left: boolean): TPGInterPkgFile;
811 var
812 IsPPU: Boolean;
813 begin
814 while Node<>nil do begin
815 Result:=TPGInterPkgFile(Node.Data);
816 if CompareFilenames(ExtractFileNameOnly(Result.ShortFilename),
817 AnUnitName)<>0 then break;
818 if (TheUnit.OwnerInfo=Result.OwnerInfo) then
819 begin
820 IsPPU:=FilenameIsCompiledSource(Result.ShortFilename);
821 if SearchPPU=IsPPU then exit;
822 end;
823 if Left then
824 Node:=Node.Precessor
825 else
826 Node:=Node.Successor;
827 end;
828 Result:=nil;
829 end;
830
831 var
832 StartNode: TAvlTreeNode;
833 h: TPGInterPkgFile;
834 begin
835 UnitPPU:=nil;
836 AnUnitName:=ExtractFileNameOnly(TheUnit.ShortFilename);
837 SearchPPU:=FilenameIsPascalUnit(TheUnit.ShortFilename); // search opposite
838 StartNode:=ShortFiles.FindPointer(TheUnit);
839 UnitPPU:=FindOther(StartNode,true);
840 if UnitPPU=nil then
841 UnitPPU:=FindOther(StartNode,false);
842 if not SearchPPU then begin
843 h:=TheUnit;
844 TheUnit:=UnitPPU;
845 UnitPPU:=h;
846 end;
847 end;
848
849 procedure CheckDuplicateUnits;
850 { Check two or more packages have the same unit (ppu/o/pas/pp/p)
851 Unless A uses B and B has -Ur or A has -Ur and B uses A }
852 var
853 CurNode: TAvlTreeNode;
854 CurUnit: TPGInterPkgFile;
855 FirstNodeSameUnitname: TAvlTreeNode;
856 OtherNode: TAvlTreeNode;
857 OtherFile: TPGInterPkgFile;
858 PPUFile: TPGInterPkgFile;
859 FileGroup: TPGIPAmbiguousFileGroup;
860 OtherPPUFile: TPGInterPkgFile;
861 i: Integer;
862 Msg: String;
863 SrcFile: TPGInterPkgFile;
864 begin
865 CurNode:=Units.FindLowest;
866 FirstNodeSameUnitname:=nil;
867 while CurNode<>nil do begin
868 CurUnit:=TPGInterPkgFile(CurNode.Data);
869 if (FirstNodeSameUnitname=nil)
870 or (ComparePGInterPkgUnitnames(CurUnit,TPGInterPkgFile(FirstNodeSameUnitname.Data))<>0) then
871 FirstNodeSameUnitname:=CurNode;
872 CurNode:=CurNode.Successor;
873 if CurUnit.OwnerInfo.HasOptionUr then continue;
874
875 // CurUnit is an unit without -Ur
876 // => check units with same name
877 FileGroup:=nil;
878 PPUFile:=nil;
879 SrcFile:=nil;
880 OtherNode:=FirstNodeSameUnitname;
881 while OtherNode<>nil do begin
882 OtherFile:=TPGInterPkgFile(OtherNode.Data);
883 if (ComparePGInterPkgUnitnames(CurUnit,OtherFile)<>0) then break;
884 // other unit with same name found
885 OtherNode:=OtherNode.Successor;
886
887 if not CheckIfFilesCanConflict(FileGroup,CurUnit,OtherFile) then
888 continue;
889 //debugln(['CheckPPUFilesInWrongDirs duplicate units found: file1="',CurUnit.FullFilename,'"(',CurUnit.OwnerInfo.Name,') file2="',OtherFile.FullFilename,'"(',OtherFile.OwnerInfo.Name,')']);
890 FindUnitSourcePPU(OtherFile,OtherPPUFile);
891 if FileGroup=nil then begin
892 SrcFile:=CurUnit;
893 FindUnitSourcePPU(SrcFile,PPUFile);
894 end;
895 if (SrcFile<>nil) and (OtherFile<>nil)
896 and (CompareFilenames(SrcFile.FullFilename,OtherFile.FullFilename)=0) then
897 begin
898 // two packages share source directories
899 // -> do not warn single files
900 continue;
901 end;
902
903 if (PPUFile<>nil) and (OtherPPUFile<>nil)
904 and (CompareFilenames(PPUFile.FullFilename,OtherPPUFile.FullFilename)=0)
905 and ((OtherFile=nil) or (SrcFile=nil)) then begin
906 // the same ppu is in both packages
907 // ... and only one package has a source
908 // for example: two packages share output directories
909 // => ok
910 continue;
911 end;
912
913 if FileGroup=nil then begin
914 FileGroup:=TPGIPAmbiguousFileGroup.Create;
915 FileGroup.Add(SrcFile,PPUFile);
916 AmbiguousFileGroups.Add(FileGroup);
917 end;
918 FileGroup.Add(OtherFile,OtherPPUFile);
919 if (PPUFile<>nil) and (OtherPPUFile=nil) then
920 begin
921 // put the orphaned ppu at top
922 FileGroup.Switch(0,length(FileGroup.Sources)-1);
923 end;
924 end;
925
926 // create Warnings
927 if FileGroup<>nil then begin
928 for i:=0 to length(FileGroup.Sources)-1 do
929 begin
930 SrcFile:=FileGroup.Sources[i];
931 PPUFile:=FileGroup.CompiledFiles[i];
932 if SrcFile<>nil then
933 begin
934 Msg:=Format(lisDuplicateUnitIn, [SrcFile.AnUnitName, SrcFile.
935 OwnerInfo.Name]);
936 if PPUFile<>nil then
937 Msg+=', ppu="'+PPUFile.FullFilename+'"';
938 Msg+=', source="'+SrcFile.FullFilename+'"';
939 end else begin
940 Msg:=Format(lisDuplicateUnitIn, [PPUFile.AnUnitName, PPUFile.
941 OwnerInfo.Name]);
942 Msg+=', orphaned ppu "'+PPUFile.FullFilename+'"';
943 end;
944 if IDEMessagesWindow<>nil then
945 IDEMessagesWindow.AddCustomMessage(mluNote,Msg)
946 else
947 debugln('Warning: (lazarus) ',Msg);
948 end;
949 end;
950
951 // all duplicates of this unitname were found -> skip to next unitname
952 CurNode:=OtherNode;
953 end;
954 end;
955
956 procedure CheckDuplicateSrcFiles;
957 { Check if a src file in pkg A exists in another package B
958 Unless A uses B and B has -Ur or A has -Ur and B uses A
959 => IDE: ignore or cancel
960 => lazbuild: warn }
961 var
962 CurNode: TAvlTreeNode;
963 CurFile: TPGInterPkgFile;
964 FirstNodeSameShortName: TAvlTreeNode;
965 OtherNode: TAvlTreeNode;
966 OtherFile: TPGInterPkgFile;
967 FileGroup: TPGIPAmbiguousFileGroup;
968 i: Integer;
969 Msg: String;
970 begin
971 CurNode:=ShortFiles.FindLowest;
972 FirstNodeSameShortName:=nil;
973 while CurNode<>nil do begin
974 CurFile:=TPGInterPkgFile(CurNode.Data);
975 if (FirstNodeSameShortName=nil)
976 or (ComparePGInterPkgShortFilename(CurFile,TPGInterPkgFile(FirstNodeSameShortName.Data))<>0) then
977 FirstNodeSameShortName:=CurNode;
978 CurNode:=CurNode.Successor;
979 if CurFile.AnUnitName<>'' then
980 continue; // units were already checked in CheckDuplicateUnits
981
982 // check files with same short name
983 FileGroup:=nil;
984 OtherNode:=FirstNodeSameShortName;
985 while OtherNode<>nil do begin
986 OtherFile:=TPGInterPkgFile(OtherNode.Data);
987 if (ComparePGInterPkgShortFilename(CurFile,OtherFile)<>0) then break;
988 OtherNode:=OtherNode.Successor;
989
990 if OtherFile.AnUnitName<>'' then
991 continue; // units were already checked in CheckDuplicateUnits
992
993 // other file with same short name found
994 if not CheckIfFilesCanConflict(FileGroup,CurFile,OtherFile) then
995 continue;
996
997 if FileGroup=nil then begin
998 FileGroup:=TPGIPAmbiguousFileGroup.Create;
999 FileGroup.Add(CurFile,nil);
1000 AmbiguousFileGroups.Add(FileGroup);
1001 end;
1002 FileGroup.Add(OtherFile,nil);
1003 end;
1004
1005 // create Warnings
1006 if FileGroup<>nil then begin
1007 for i:=0 to length(FileGroup.Sources)-1 do
1008 begin
1009 CurFile:=FileGroup.Sources[i];
1010 Msg:='Duplicate file "'+ExtractFileName(CurFile.ShortFilename)+'"';
1011 Msg+=' in "'+CurFile.OwnerInfo.Name+'"';
1012 Msg+=', path="'+CurFile.FullFilename+'"';
1013 if IDEMessagesWindow<>nil then
1014 IDEMessagesWindow.AddCustomMessage(mluWarning,Msg)
1015 else
1016 debugln('Warning: (lazarus) ',Msg);
1017 end;
1018 end;
1019
1020 // all duplicates of this file were found -> skip to next group
1021 CurNode:=OtherNode;
1022 end;
1023 end;
1024
1025 var
1026 i: Integer;
1027 {$IFDEF EnableCheckInterPkgFiles}
1028 Dlg: TPGIPConflictsDialog;
1029 {$ENDIF}
1030 begin
1031 Result:=true;
1032 FilesChanged:=false;
1033 if (PkgList=nil) or (PkgList.Count=0) then exit;
1034 OwnerInfos:=TObjectList.create(true);
1035 FullFiles:=TAvlTree.Create(@ComparePGInterPkgFullFilenames);
1036 Units:=TAvlTree.Create(@ComparePGInterPkgUnitnames);
1037 ShortFiles:=TAvlTree.Create(@ComparePGInterPkgShortFilename);
1038 AmbiguousFileGroups:=TObjectList.create(true);
1039 {$IFDEF EnableCheckInterPkgFiles}
1040 Dlg:=nil;
1041 {$ENDIF}
1042 try
1043 // get target OS, CPU and LCLWidgetType
1044 TargetOS:='$(TargetOS)';
1045 GlobalMacroList.SubstituteStr(TargetOS);
1046 if TargetOS='' then TargetOS:=GetCompiledTargetOS;
1047 TargetCPU:='$(TargetCPU)';
1048 GlobalMacroList.SubstituteStr(TargetCPU);
1049 if TargetCPU='' then TargetCPU:=GetCompiledTargetCPU;
1050 LCLWidgetType:='$(LCLWidgetType)';
1051 GlobalMacroList.SubstituteStr(LCLWidgetType);
1052 if LCLWidgetType='' then
1053 LCLWidgetType:=GetLCLWidgetTypeName;
1054
1055 {$IFDEF VerboseCheckInterPkgFiles}
1056 debugln(['CheckInterPkgFiles TargetOS=',TargetOS,' TargetCPU=',TargetCPU,' LCLWidgetType=',LCLWidgetType]);
1057 {$ENDIF}
1058
1059 // get search paths
1060 AddOwnerInfo(IDEObject);
1061 for i:=0 to PkgList.Count-1 do
1062 AddOwnerInfo(TObject(PkgList[i]));
1063
1064 // collect FullFiles
1065 for i:=0 to OwnerInfos.Count-1 do
1066 CollectFilesOfOwner(TPGInterPkgOwnerInfo(OwnerInfos[i]));
1067 RemoveSecondaryFiles;
1068
1069 // checks
1070 CheckDuplicateUnits;
1071 CheckDuplicateSrcFiles;
1072 if (AmbiguousFileGroups.Count=0) then exit;
1073
1074 // show warnings
1075 if LazarusIDE<>nil then begin
1076 {$IFDEF EnableCheckInterPkgFiles}
1077 // IDE
1078 Dlg:=TPGIPConflictsDialog.Create(nil);
1079 Dlg.Init(AmbiguousFileGroups);
1080 if Dlg.ShowModal<>mrOK then exit(false);
1081 FilesChanged:=Dlg.FilesChanged;
1082 {$ENDIF}
1083 end;
1084 finally
1085 {$IFDEF EnableCheckInterPkgFiles}
1086 Dlg.Free;
1087 {$ENDIF}
1088 AmbiguousFileGroups.Free;
1089 Units.Free;
1090 ShortFiles.Free;
1091 FullFiles.FreeAndClear;
1092 FullFiles.Free;
1093 OwnerInfos.Free;
1094 end;
1095 end;
1096
1097 end.
1098
1099