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 Functions and classes to build dependency graphs for pascal units.
25 }
26 unit CTUnitGraph;
27
28 {$mode objfpc}{$H+}
29
30 interface
31
32 uses
33 Classes, SysUtils, Laz_AVL_Tree,
34 // LazUtils
35 LazFileUtils, LazStringUtils,
36 // Codetools
37 FileProcs, FindDeclarationTool, CodeBeautifier, CodeCache, StdCodeTools,
38 DirectoryCacher, LinkScanner, CustomCodeTool, CodeTree, CodeToolsStructs;
39
40 type
41
42 { TFindIdentifierReferenceCache }
43
44 TFindIdentifierReferenceCache = class
45 public
46 IdentifierCode: TCodeBuffer;
47 X, Y: integer;
48
49 SourcesChangeStep: int64;
50 FilesChangeStep: int64;
51 InitValuesChangeStep: integer;
52 NewTool: TFindDeclarationTool;
53 NewNode: TCodeTreeNode;
54 NewPos: TCodeXYPosition;
55 IsPrivate: boolean;
56 procedure Clear;
57 end;
58
59 type
60 TUGUnitFlag = (
61 ugufReached,
62 ugufLoadError,
63 ugufIsIncludeFile,
64 ugufHasSyntaxErrors
65 );
66 TUGUnitFlags = set of TUGUnitFlag;
67
68 { TUGUnit }
69
70 TUGUnit = class
71 public
72 Flags: TUGUnitFlags;
73 TheUnitName: string;
74 Filename: string;
75 Code: TCodeBuffer;
76 Tool: TStandardCodeTool;
77 UsesUnits: TFPList; // list of TUGUses, can be nil
78 UsedByUnits: TFPList; // list of TUGUses, can be nil
79 constructor Create(const aFilename: string);
80 destructor Destroy; override;
81 procedure Clear;
IndexOfUsesnull82 function IndexOfUses(const aFilename: string): integer; // slow linear search
83 end;
84 TUGUnitClass = class of TUGUnit;
85
86 { TUGUses }
87
88 TUGUses = class
89 public
90 Owner: TUGUnit;
91 UsesUnit: TUGUnit;
92 InImplementation: boolean;
93 constructor Create(TheOwner, TheUses: TUGUnit);
94 destructor Destroy; override;
95 end;
96 TUGUsesClass = class of TUGUses;
97
98 { TUsesGraph }
99
100 TUsesGraph = class
101 private
102 FFiles: TAVLTree; // tree of TUGUnit sorted for Filename
103 FIgnoreFiles: TAVLTree; // tree of TUGUnit sorted for Filename
104 FQueuedFiles: TAVLTree; // tree of TUGUnit sorted for Filename
105 FTargetAll: boolean;
106 FTargetFiles: TAVLTree; // tree of TUGUnit sorted for Filename
107 FTargetDirsValid: boolean;
108 FTargetDirs: string;
109 FTargetInFPCSrc: boolean;
110 FUnitClass: TUGUnitClass;
111 FUsesClass: TUGUsesClass;
112 public
113 DirectoryCachePool: TCTDirectoryCachePool;
114 OnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
115 OnLoadFile: TOnLoadCTFile;
116
117 constructor Create;
118 destructor Destroy; override;
119 procedure Clear;
120 procedure ConsistencyCheck;
GetUnitnull121 function GetUnit(const ExpFilename: string; CreateIfNotExists: boolean): TUGUnit;
FindUnitnull122 function FindUnit(const AnUnitName: string): TUGUnit; // slow
123
124 procedure AddStartUnit(ExpFilename: string);
125 procedure AddTargetUnit(ExpFilename: string);
126 procedure AddIgnoreUnit(ExpFilename: string);
127 procedure AddSystemUnitAsTarget;
Parsenull128 function Parse(IgnoreErrors: boolean; out Completed: boolean;
129 StopAfterMs: integer = -1): boolean;
GetUnitsTreeUsingTargetsnull130 function GetUnitsTreeUsingTargets: TAVLTree; // tree of TUGUnit sorted for filename
GetCodeTreeUsingTargetsnull131 function GetCodeTreeUsingTargets: TAVLTree; // tree of TCodeBuffer sorted for filename
UnitCanFindTargetnull132 function UnitCanFindTarget(ExpFilename: string): boolean;
IsTargetDirnull133 function IsTargetDir(ExpDir: string): boolean;
134
FindShortestPathnull135 function FindShortestPath(StartUnit, EndUnit: TUGUnit): TFPList; // list of TUGUnit, nil if no path exists
InsertMissingLinksnull136 function InsertMissingLinks(UGUnitList: TFPList): boolean;
137
138 property FilesTree: TAVLTree read FFiles; // tree of TUGUnit sorted for Filename (all parsed)
139 property IgnoreFilesTree: TAVLTree read FIgnoreFiles; // tree of TUGUnit sorted for Filename
140 property QueuedFilesTree: TAVLTree read FQueuedFiles; // tree of TUGUnit sorted for Filename
141 property TargetFilesTree: TAVLTree read FTargetFiles; // tree of TUGUnit sorted for Filename
142 property TargetAll: boolean read FTargetAll write FTargetAll;
143
144 property UnitClass: TUGUnitClass read FUnitClass write FUnitClass;
145 property UsesClass: TUGUsesClass read FUsesClass write FUsesClass;
146 end;
147
CompareUGUnitFilenamesnull148 function CompareUGUnitFilenames(UGUnit1, UGUnit2: Pointer): integer;
CompareFilenameAndUGUnitnull149 function CompareFilenameAndUGUnit(FileAnsistring, UGUnit: Pointer): integer;
150
151 implementation
152
CompareUGUnitFilenamesnull153 function CompareUGUnitFilenames(UGUnit1, UGUnit2: Pointer): integer;
154 var
155 Unit1: TUGUnit absolute UGUnit1;
156 Unit2: TUGUnit absolute UGUnit2;
157 begin
158 Result:=CompareFilenames(Unit1.Filename,Unit2.Filename);
159 end;
160
CompareFilenameAndUGUnitnull161 function CompareFilenameAndUGUnit(FileAnsistring, UGUnit: Pointer): integer;
162 var
163 AnUnit: TUGUnit absolute UGUnit;
164 Filename: String;
165 begin
166 Filename:=AnsiString(FileAnsistring);
167 Result:=CompareFilenames(Filename,AnUnit.Filename);
168 end;
169
170 { TFindIdentifierReferenceCache }
171
172 procedure TFindIdentifierReferenceCache.Clear;
173 begin
174 SourcesChangeStep:=CTInvalidChangeStamp64;
175 FilesChangeStep:=CTInvalidChangeStamp64;
176 InitValuesChangeStep:=CTInvalidChangeStamp;
177 NewTool:=nil;
178 NewNode:=nil;
179 NewPos:=CleanCodeXYPosition;
180 IsPrivate:=false;
181 end;
182
183 { TUGUses }
184
185 constructor TUGUses.Create(TheOwner, TheUses: TUGUnit);
186 begin
187 Owner:=TheOwner;
188 UsesUnit:=TheUses;
189 end;
190
191 destructor TUGUses.Destroy;
192 begin
193 if Owner<>nil then begin
194 Owner.UsesUnits.Remove(Self);
195 Owner:=nil;
196 end;
197 if UsesUnit<>nil then begin
198 UsesUnit.UsedByUnits.Remove(Self);
199 UsesUnit:=nil;
200 end;
201 inherited Destroy;
202 end;
203
204 { TUGUnit }
205
206 constructor TUGUnit.Create(const aFilename: string);
207 begin
208 Filename:=aFilename;
209 TheUnitName:=ExtractFileNameOnly(Filename);
210 end;
211
212 destructor TUGUnit.Destroy;
213 begin
214 Clear;
215 FreeAndNil(UsesUnits);
216 FreeAndNil(UsedByUnits);
217 inherited Destroy;
218 end;
219
220 procedure TUGUnit.Clear;
221
222 procedure FreeUsesList(var List: TFPList);
223 begin
224 if List=nil then exit;
225 while List.Count>0 do TObject(List[0]).Free;
226 FreeAndNil(List);
227 end;
228
229 begin
230 FreeUsesList(UsesUnits);
231 FreeUsesList(UsedByUnits);
232 Flags:=Flags-[ugufHasSyntaxErrors,ugufReached];
233 end;
234
TUGUnit.IndexOfUsesnull235 function TUGUnit.IndexOfUses(const aFilename: string): integer;
236 begin
237 if UsesUnits=nil then exit(-1);
238 Result:=UsesUnits.Count-1;
239 while (Result>=0)
240 and (CompareFilenames(aFilename,TUGUses(UsesUnits[Result]).UsesUnit.Filename)<>0) do
241 dec(Result);
242 end;
243
244 { TUsesGraph }
245
246 constructor TUsesGraph.Create;
247 begin
248 FUnitClass:=TUGUnit;
249 FUsesClass:=TUGUses;
250 FFiles:=TAVLTree.Create(@CompareUGUnitFilenames);
251 FIgnoreFiles:=TAVLTree.Create(@CompareUGUnitFilenames);
252 FQueuedFiles:=TAVLTree.Create(@CompareUGUnitFilenames);
253 FTargetFiles:=TAVLTree.Create(@CompareUGUnitFilenames);
254 end;
255
256 destructor TUsesGraph.Destroy;
257 begin
258 Clear;
259 FreeAndNil(FIgnoreFiles);
260 FreeAndNil(FQueuedFiles);
261 FreeAndNil(FTargetFiles);
262 FreeAndNil(FFiles);
263 inherited Destroy;
264 end;
265
266 procedure TUsesGraph.Clear;
267 begin
268 FQueuedFiles.Clear; // all files of StartFiles are in Files too
269 FTargetFiles.Clear; // all files of TargetFiles are in Files too
270 FFiles.FreeAndClear;
271 end;
272
273 procedure TUsesGraph.ConsistencyCheck;
274 var
275 AVLNode: TAVLTreeNode;
276 AnUnit: TUGUnit;
277 begin
278 FFiles.ConsistencyCheck;
279 FQueuedFiles.ConsistencyCheck;
280
281 AVLNode:=FQueuedFiles.FindLowest;
282 while AVLNode<>nil do begin
283 AnUnit:=TUGUnit(AVLNode.Data);
284 if AnUnit.Filename='' then
285 raise Exception.Create('AnUnit without filename');
286 if FFiles.FindKey(PChar(AnUnit.Filename),@CompareFilenameAndUGUnit)=nil then
287 raise Exception.Create('startfile not in files: '+AnUnit.Filename);
288 AVLNode:=FQueuedFiles.FindSuccessor(AVLNode);
289 end;
290 end;
291
TUsesGraph.GetUnitnull292 function TUsesGraph.GetUnit(const ExpFilename: string;
293 CreateIfNotExists: boolean): TUGUnit;
294 var
295 AVLNode: TAVLTreeNode;
296 begin
297 if ExpFilename='' then begin
298 Result:=nil;
299 if CreateIfNotExists then
300 raise Exception.Create('TUsesGraph.GetUnit missing filename');
301 exit;
302 end;
303 AVLNode:=FFiles.FindKey(PChar(ExpFilename),@CompareFilenameAndUGUnit);
304 if AVLNode<>nil then begin
305 Result:=TUGUnit(AVLNode.Data);
306 end else if CreateIfNotExists then begin
307 Result:=UnitClass.Create(ExpFilename);
308 FFiles.Add(Result);
309 end else
310 Result:=nil;
311 end;
312
FindUnitnull313 function TUsesGraph.FindUnit(const AnUnitName: string): TUGUnit;
314 var
315 AVLNode: TAVLTreeNode;
316 begin
317 AVLNode:=FFiles.FindLowest;
318 while AVLNode<>nil do begin
319 Result:=TUGUnit(AVLNode.Data);
320 if CompareText(ExtractFileNameOnly(Result.Filename),AnUnitName)=0 then
321 exit;
322 AVLNode:=FFiles.FindSuccessor(AVLNode);
323 end;
324 end;
325
326 procedure TUsesGraph.AddStartUnit(ExpFilename: string);
327 var
328 NewUnit: TUGUnit;
329 begin
330 if ExpFilename='' then exit;
331 if FQueuedFiles.FindKey(PChar(ExpFilename),@CompareFilenameAndUGUnit)<>nil then
332 exit; // already a start file
333 NewUnit:=GetUnit(ExpFilename,true);
334 if ugufReached in NewUnit.Flags then exit; // already parsed
335 // add to FFiles and FQueuedFiles
336 //debugln(['TUsesGraph.AddStartUnit ',ExpFilename]);
337 FQueuedFiles.Add(NewUnit);
338 end;
339
340 procedure TUsesGraph.AddTargetUnit(ExpFilename: string);
341 var
342 NewUnit: TUGUnit;
343 begin
344 if ExpFilename='' then exit;
345 if FTargetFiles.FindKey(PChar(ExpFilename),@CompareFilenameAndUGUnit)<>nil then
346 exit; // already a start file
347 // add to FFiles and FTargetFiles
348 //debugln(['TUsesGraph.AddTargetUnit ',ExpFilename]);
349 NewUnit:=GetUnit(ExpFilename,true);
350 if FTargetFiles.Find(NewUnit)=nil then
351 FTargetFiles.Add(NewUnit);
352 FTargetDirsValid:=false;
353 end;
354
355 procedure TUsesGraph.AddIgnoreUnit(ExpFilename: string);
356 var
357 NewUnit: TUGUnit;
358 begin
359 NewUnit:=GetUnit(ExpFilename,true);
360 if FIgnoreFiles.Find(NewUnit)=nil then
361 FIgnoreFiles.Add(NewUnit);
362 end;
363
364 procedure TUsesGraph.AddSystemUnitAsTarget;
365 begin
366 AddTargetUnit(DirectoryCachePool.FindUnitInUnitSet('','system'));
367 end;
368
TUsesGraph.Parsenull369 function TUsesGraph.Parse(IgnoreErrors: boolean; out Completed: boolean;
370 StopAfterMs: integer): boolean;
371
372 procedure AddUses(CurUnit: TUGUnit; UsedFiles: TStrings;
373 InImplementation: boolean);
374 var
375 i: Integer;
376 Filename: string;
377 NewUnit: TUGUnit;
378 NewUses: TUGUses;
379 begin
380 if UsedFiles=nil then exit;
381 for i:=0 to UsedFiles.Count-1 do begin
382 Filename:=UsedFiles[i];
383 if not FilenameIsPascalUnit(Filename) then continue;
384 // check if already used
385 if CurUnit.IndexOfUses(Filename)>=0 then continue;
386 if not UnitCanFindTarget(Filename) then continue;
387 // add connection
388 NewUnit:=GetUnit(Filename,true);
389 if CurUnit.UsesUnits=nil then
390 CurUnit.UsesUnits:=TFPList.Create;
391 NewUses:=UsesClass.Create(CurUnit,NewUnit);
392 NewUses.InImplementation:=InImplementation;
393 CurUnit.UsesUnits.Add(NewUses);
394 if NewUnit.UsedByUnits=nil then
395 NewUnit.UsedByUnits:=TFPList.Create;
396 NewUnit.UsedByUnits.Add(NewUses);
397 // put new file on queue
398 AddStartUnit(Filename);
399 end;
400 end;
401
ParseUnitnull402 function ParseUnit(CurUnit: TUGUnit): boolean;
403 // returns true to continue
404 var
405 Abort: boolean;
406 MainUsesSection: TStrings;
407 ImplementationUsesSection: TStrings;
408 begin
409 Result:=false;
410 //debugln(['ParseUnit ',CurUnit.Filename,' ',Pos('tcfiler',CurUnit.Filename)]);
411 Include(CurUnit.Flags,ugufLoadError);
412 // load file
413 Abort:=false;
414 OnLoadFile(Self,CurUnit.Filename,CurUnit.Code,Abort);
415 if Abort then exit;
416 if CurUnit.Code=nil then begin
417 debugln(['TUsesGraph.Parse failed loading file ',CurUnit.Filename]);
418 Result:=IgnoreErrors;
419 exit;
420 end;
421 try
422 MainUsesSection:=nil;
423 ImplementationUsesSection:=nil;
424 try
425 // create tool
426 CurUnit.Tool:=OnGetCodeToolForBuffer(Self,CurUnit.Code,true) as TStandardCodeTool;
427 if CurUnit.Tool=nil then begin
428 debugln(['TUsesGraph.Parse failed getting tool for file ',CurUnit.Code.Filename]);
429 Result:=IgnoreErrors;
430 exit;
431 end;
432 // check if include file
433 if CompareFilenames(CurUnit.Tool.MainFilename,CurUnit.Code.Filename)<>0 then
434 begin
435 Include(CurUnit.Flags,ugufIsIncludeFile);
436 exit(true);
437 end;
438 Exclude(CurUnit.Flags,ugufLoadError);
439 // parse both uses sections
440 Include(CurUnit.Flags,ugufHasSyntaxErrors);
441 CurUnit.Tool.BuildTree(lsrImplementationUsesSectionEnd);
442 Exclude(CurUnit.Flags,ugufHasSyntaxErrors);
443 // locate used units
444 if not CurUnit.Tool.FindUsedUnitFiles(MainUsesSection,
445 ImplementationUsesSection)
446 then begin
447 Result:=IgnoreErrors;
448 exit;
449 end;
450 AddUses(CurUnit,MainUsesSection,false);
451 AddUses(CurUnit,ImplementationUsesSection,true);
452 Result:=true;
453 finally
454 MainUsesSection.Free;
455 ImplementationUsesSection.Free;
456 end;
457 except
458 on E: ECodeToolError do begin
459 if not IgnoreErrors then raise;
460 end;
461 on E: ELinkScannerError do begin
462 if not IgnoreErrors then raise;
463 end;
464 end;
465 end;
466
467 var
468 StartTime: TDateTime;
469 AVLNode: TAVLTreeNode;
470 CurUnit: TUGUnit;
471 begin
472 Result:=false;
473 Completed:=false;
474 if StopAfterMs>=0 then
475 StartTime:=Now
476 else
477 StartTime:=0;
478 while FQueuedFiles.Count>0 do begin
479 AVLNode:=FQueuedFiles.FindLowest;
480 CurUnit:=TUGUnit(AVLNode.Data);
481 FQueuedFiles.Delete(AVLNode);
482 Include(CurUnit.Flags,ugufReached);
483 if FIgnoreFiles.Find(CurUnit)<>nil then continue;
484 //debugln(['TUsesGraph.Parse Unit=',CurUnit.Filename,' UnitCanFindTarget=',UnitCanFindTarget(CurUnit.Filename)]);
485 if UnitCanFindTarget(CurUnit.Filename) then begin
486 ParseUnit(CurUnit);
487 end;
488
489 if (StopAfterMs>=0) and (Abs(Now-StartTime)*86400000>=StopAfterMs) then
490 exit(true);
491 end;
492
493 Completed:=true;
494 Result:=true;
495 end;
496
TUsesGraph.GetUnitsTreeUsingTargetsnull497 function TUsesGraph.GetUnitsTreeUsingTargets: TAVLTree;
498
499 procedure Add(Units: TAVLTree; NewUnit: TUGUnit);
500 var
501 i: Integer;
502 CurUses: TUGUses;
503 begin
504 if NewUnit=nil then exit;
505 if not (ugufReached in NewUnit.Flags) then exit; // this unit was not reached
506 if ugufIsIncludeFile in NewUnit.Flags then exit;
507 if Units.Find(NewUnit)<>nil then exit; // already added
508 Units.Add(NewUnit);
509 if NewUnit.UsedByUnits=nil then exit;
510 for i:=0 to NewUnit.UsedByUnits.Count-1 do begin
511 CurUses:=TUGUses(NewUnit.UsedByUnits[i]);
512 Add(Units,CurUses.Owner);
513 end;
514 end;
515
516 var
517 AVLNode: TAVLTreeNode;
518 begin
519 Result:=TAVLTree.Create(@CompareUGUnitFilenames);
520 AVLNode:=FTargetFiles.FindLowest;
521 while AVLNode<>nil do begin
522 Add(Result,TUGUnit(AVLNode.Data));
523 AVLNode:=FTargetFiles.FindSuccessor(AVLNode);
524 end;
525 end;
526
TUsesGraph.GetCodeTreeUsingTargetsnull527 function TUsesGraph.GetCodeTreeUsingTargets: TAVLTree;
528 var
529 Units: TAVLTree;
530 AVLNode: TAVLTreeNode;
531 CurUnit: TUGUnit;
532 begin
533 Result:=TAVLTree.Create(@CompareCodeBuffers);
534 Units:=GetUnitsTreeUsingTargets;
535 try
536 AVLNode:=Units.FindLowest;
537 while AVLNode<>nil do begin
538 CurUnit:=TUGUnit(AVLNode.Data);
539 if not (ugufIsIncludeFile in CurUnit.Flags)
540 and (Result.Find(CurUnit.Code)=nil) then
541 Result.Add(CurUnit.Code);
542 AVLNode:=Units.FindSuccessor(AVLNode);
543 end;
544 finally
545 Units.Free;
546 end;
547 end;
548
TUsesGraph.UnitCanFindTargetnull549 function TUsesGraph.UnitCanFindTarget(ExpFilename: string): boolean;
550 // returns true if ExpFilename can find one of the targets via the search paths
551 var
552 BaseDir: String;
553 SrcPath: String;
554 p: integer;
555 ReachableDir: String;
556 begin
557 Result:=true;
558 if FTargetInFPCSrc or TargetAll then exit; // standard units can always be found
559
560 BaseDir:=ExtractFilePath(ExpFilename);
561 if IsTargetDir(BaseDir) then exit;
562
563 // check complete search path, including SrcPath, UnitPath
564 // and resolved compiled unit paths
565 SrcPath:=DirectoryCachePool.GetString(BaseDir,ctdcsCompleteSrcPath);
566 p:=1;
567 repeat
568 ReachableDir:=GetNextDelimitedItem(SrcPath,';',p);
569 if ReachableDir<>'' then begin
570 if not FilenameIsAbsolute(ReachableDir) then
571 ReachableDir:=BaseDir+ReachableDir;
572 if IsTargetDir(ReachableDir) then exit;
573 end;
574 until p>length(SrcPath);
575
576 Result:=false;
577 end;
578
IsTargetDirnull579 function TUsesGraph.IsTargetDir(ExpDir: string): boolean;
580 var
581 AVLNode: TAVLTreeNode;
582 CurUnit: TUGUnit;
583 Dir: String;
584 begin
585 if FTargetFiles.Count=0 then exit(TargetAll);
586
587 if not FTargetDirsValid then begin
588 FTargetDirsValid:=true;
589 FTargetInFPCSrc:=TargetAll;
590 // build list of target directories for quick lookup
591 AVLNode:=FTargetFiles.FindLowest;
592 while AVLNode<>nil do begin
593 CurUnit:=TUGUnit(AVLNode.Data);
594 Dir:=ExtractFilePath(CurUnit.Filename);
595 if FilenameIsAbsolute(Dir)
596 and (CompareFilenames(DirectoryCachePool.FindUnitInUnitSet(Dir,CurUnit.TheUnitName),
597 CurUnit.Filename)=0)
598 then begin
599 // this is a standard unit (e.g. in FPC sources)
600 // they are not reachable via search paths, but via the UnitSet
601 FTargetInFPCSrc:=true;
602 end else if Dir='' then begin
603 // in virtual directory
604 if (FTargetDirs='') or (FTargetDirs[1]<>';') then
605 FTargetDirs:=';'+FTargetDirs;
606 end else if FindPathInSearchPath(Dir,FTargetDirs)<1 then begin
607 // normal source directory
608 if FTargetDirs='' then
609 FTargetDirs:=Dir
610 else
611 FTargetDirs:=FTargetDirs+';'+Dir;
612 end;
613 AVLNode:=FTargetFiles.FindSuccessor(AVLNode);
614 end;
615 end;
616
617 Result:=true;
618 if TargetAll then exit;
619 if (ExpDir='') and (FTargetDirs[1]=';') then
620 exit; // virtual directory
621 Result:=FindPathInSearchPath(ExpDir,FTargetDirs)>0;
622 end;
623
FindShortestPathnull624 function TUsesGraph.FindShortestPath(StartUnit, EndUnit: TUGUnit): TFPList;
625 // broad search first
626 var
627 Queue: TFPList;
628 NodeToPrevNode: TPointerToPointerTree;
629 CurUnit: TUGUnit;
630 i: Integer;
631 CurUses: TUGUses;
632 UsesUnit: TUGUnit;
633 PrevUnit: TUGUnit;
634 begin
635 Result:=nil;
636 if (StartUnit=nil) or (EndUnit=nil) then exit;
637 Queue:=TFPList.Create;
638 NodeToPrevNode:=TPointerToPointerTree.Create;
639 try
640 Queue.Add(EndUnit);
641 NodeToPrevNode[EndUnit]:=EndUnit; // set end marker
642 while Queue.Count>0 do begin
643 CurUnit:=TUGUnit(Queue[0]);
644 Queue.Delete(0);
645 if CurUnit.UsedByUnits=nil then continue;
646 for i:=0 to CurUnit.UsedByUnits.Count-1 do begin
647 CurUses:=TUGUses(CurUnit.UsedByUnits[i]);
648 if CurUses.InImplementation then continue;
649 UsesUnit:=CurUses.Owner;
650 if NodeToPrevNode.Contains(UsesUnit) then
651 continue; // already visited
652 NodeToPrevNode[UsesUnit]:=CurUnit;
653 if UsesUnit=StartUnit then begin
654 // found StartUnit
655 // => create list from StartUnit to EndUnit
656 Result:=TFPList.Create;
657 CurUnit:=StartUnit;
658 repeat
659 Result.Add(CurUnit);
660 PrevUnit:=TUGUnit(NodeToPrevNode[CurUnit]);
661 if PrevUnit=CurUnit then exit; // end marker found
662 CurUnit:=PrevUnit;
663 until false;
664 exit;
665 end;
666 Queue.Add(UsesUnit);
667 end;
668 end;
669 finally
670 NodeToPrevNode.Free;
671 Queue.Free;
672 end;
673 end;
674
InsertMissingLinksnull675 function TUsesGraph.InsertMissingLinks(UGUnitList: TFPList): boolean;
676 var
677 i,j: Integer;
678 StartUnit: TUGUnit;
679 EndUnit: TUGUnit;
680 CurList: TFPList;
681 begin
682 Result:=true;
683 for i:=UGUnitList.Count-2 downto 0 do begin
684 StartUnit:=TUGUnit(UGUnitList[i]);
685 EndUnit:=TUGUnit(UGUnitList[i+1]);
686 CurList:=FindShortestPath(StartUnit,EndUnit);
687 if (CurList=nil) then begin
688 Result:=false;
689 continue;
690 end;
691 if CurList.Count>2 then begin
692 for j:=1 to CurList.Count-2 do
693 UGUnitList.Insert(i+j,CurList[j]);
694 end;
695 CurList.Free;
696 end;
697 end;
698
699 end.
700
701