diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 34c3420c3d..8093d58aac 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -383,6 +383,8 @@ type function GetPCVersionForDirectory(const Directory: string; out Kind: TPascalCompiler): integer; function GetNamespacesForDirectory(const Directory: string; UseCache: boolean = true): string;// value of macro #Namespaces + function GetNamespacedIncludesForDirectory(const Directory: string; + UseCache: boolean = true): string; // simple global defines for tests and simple projects function GetGlobalDefines(CreateIfNotExists: boolean = true): TDefineTemplate; @@ -1783,6 +1785,22 @@ begin end; end; +function TCodeToolManager.GetNamespacedIncludesForDirectory( + const Directory: string; UseCache: boolean): string; +var + Evaluator: TExpressionEvaluator; +begin + if UseCache then begin + Result:=DirectoryCachePool.GetString(Directory,ctdcsNamespaces,true) + end else begin + Result:=''; + Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); + if Evaluator=nil then exit; + if Evaluator.IsDefined(StdDefTemplCodetoolsFPCSrc) then + Result:='1'; + end; +end; + function TCodeToolManager.GetGlobalDefines(CreateIfNotExists: boolean ): TDefineTemplate; begin @@ -6564,6 +6582,7 @@ begin ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false); ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false); ctdcsNamespaces: Result:=GetNamespacesForDirectory(ADirectory,false); + ctdcsNamespacedIncludes: Result:=GetNamespacedIncludesForDirectory(ADirectory,false); else RaiseCatchableException(''){%H-}; end; end; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 975f9e4ad3..d31c71de25 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -73,6 +73,7 @@ const StdDefTemplLazarusSrcDir = 'Lazarus source directory'; StdDefTemplLazarusBuildOpts = 'Lazarus build options'; StdDefTemplLCLProject = 'LCL project'; + StdDefTemplCodetoolsFPCSrc = 'CodetoolsFPCSrc'; // Standard macros DefinePathMacroName = ExternalMacroStart+'DefinePath'; // the current directory @@ -2552,11 +2553,17 @@ begin Format(ctsFreePascalSourcesPlusDesc,['RTL, FCL, Packages, Compiler']), '','',da_Block); - // The Free Pascal sources build a world of their own - // => reset all search paths MainDir:=TDefineTemplate.Create('Free Pascal Source Directory', ctsFreePascalSourceDir,'',FPCSrcDir,da_Directory); Result.AddChild(MainDir); + // add define + DefTempl:=TDefineTemplate.Create(StdDefTemplCodetoolsFPCSrc, + StdDefTemplCodetoolsFPCSrc,StdDefTemplCodetoolsFPCSrc,'',da_DefineRecurse); + MainDir.AddChild(DefTempl); + + // The Free Pascal sources build a world of their own + // => reset all search paths + DefTempl:=TDefineTemplate.Create('Reset SrcPath', ctsSrcPathInitialization,SrcPathMacroName,'',da_DefineRecurse); MainDir.AddChild(DefTempl); diff --git a/components/codetools/directorycacher.pas b/components/codetools/directorycacher.pas index a7a981195e..1740974679 100644 --- a/components/codetools/directorycacher.pas +++ b/components/codetools/directorycacher.pas @@ -70,7 +70,8 @@ type ctdcsUnitLinks, ctdcsUnitSet, ctdcsFPCUnitPath, // unit paths reported by FPC - ctdcsNamespaces + ctdcsNamespaces, + ctdcsNamespacedIncludes // 1 = search include file via /namespaced/ parent folder ); TCTDirCacheStringRecord = record @@ -231,6 +232,7 @@ type function FindIncludeFile(const IncFilename: string; AnyCase: boolean): string; override; function FindIncludeFileInPath(IncFilename: string; AnyCase: boolean): string; function FindIncludeFileInCleanPath(IncFilename, SearchPath: string; AnyCase: boolean): string; + function FindNamespacedIncludeFile(const IncFilename: string): string; procedure IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile); procedure UpdateListing; override; @@ -1332,6 +1334,11 @@ begin SearchPath:=Strings[ctdcsIncludePath]; Result:=FindIncludeFileInCleanPath(IncFilename,SearchPath,AnyCase); + + if (Result='') and FilenameIsPascalUnit(IncFilename) + and (Strings[ctdcsNamespacedIncludes]<>'') then begin + Result:=FindNamespacedIncludeFile(IncFilename); + end; end; function TCTDirectoryCache.FindIncludeFileInCleanPath(IncFilename, @@ -1374,6 +1381,71 @@ begin Result:=''; end; +function TCTDirectoryCache.FindNamespacedIncludeFile(const IncFilename: string + ): string; +// if Direcory contains a '/namespaced/' then search IncFilename in sibling folders +// e.g. Directory='/home/user/fpcsrc/rtl/namespaced/windows/', IncFilename='wintypes.pp' +// search it in /home/user/fpcsrc/rtl/** +const + NamespacedDir = PathDelim+'namespaced'+PathDelim; + + function Traverse(Cache: TCTDirectoryCache; Lvl: integer): string; + var + i: Integer; + Dir: string; + CurListing: TCTDirectoryListing; + ChildCache: TCTDirectoryCache; + begin + Dir:=ExtractFilename(Cache.Directory); + if SameText(Dir,'backup') then exit; + + Result:=Cache.FindIncludeFile(IncFilename,True); + if Result<>'' then exit; + if Lvl>4 then exit; + inc(Lvl); + + CurListing:=Cache.Listing; + for i:=0 to CurListing.Count-1 do begin + if CurListing.GetAttr(i) and faDirectory=0 then continue; + Dir:=Cache.Directory+CurListing.GetFilename(i); + ChildCache:=Pool.GetCache(Dir,true,false); + Result:=Traverse(ChildCache,Lvl); + if Result<>'' then exit; + end; + end; + +var + p: SizeInt; + Dir, SubDir: String; + Cache: TCTDirectoryCache; +begin + Result:=''; + if Pos(PathDelim,IncFilename)>0 then exit; + + p:=Pos(NamespacedDir,Directory); + if p<1 then exit; + //debugln(['TCTDirectoryCache.FindNamespacedIncludeFile ',Directory,' -> ',IncFilename]); + Dir:=LeftStr(Directory,p); + SubDir:=copy(Directory,p+length(NamespacedDir),length(Directory)); + if SubDir<>'' then begin + // first search in same subdir aka the directory without /namespaced/ + Result:=Dir+SubDir+IncFilename; + if Pool.FileExists(Result) then + exit; + end; + + // then search in subdir 'src' + Result:=Dir+'src'+IncFilename; + if Pool.FileExists(Result) then + exit; + + // finally search recursively + //debugln(['TCTDirectoryCache.FindNamespacedIncludeFile Dir=',Dir,' SubDir="',SubDir,'"']); + + Cache:=Pool.GetCache(Dir,true,false); + Result:=Traverse(Cache,0); +end; + function TCTDirectoryCache.FileAge(const ShortFilename: string): TCTFileAgeTime; var i: Integer; diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index d4fbcc48fc..0af7b11a11 100644 --- a/components/codetools/fileprocs.pas +++ b/components/codetools/fileprocs.pas @@ -1191,10 +1191,10 @@ function FilenameIsMatching(const Mask, Filename: string; var A, B: string; begin - SetLength(A,LenA); + SetLength(A{%H-},LenA); if LenA>0 then Move(AP^,A[1],LenA); - SetLength(B,LenB); + SetLength(B{%H-},LenB); if LenB>0 then Move(BP^,B[1],LenB); Result:=UTF8CompareText(A,B); diff --git a/components/codetools/tests/testfinddeclaration.pas b/components/codetools/tests/testfinddeclaration.pas index 6f2636c97a..27da81d5a0 100644 --- a/components/codetools/tests/testfinddeclaration.pas +++ b/components/codetools/tests/testfinddeclaration.pas @@ -1439,12 +1439,13 @@ var UnitSet: TFPCUnitSetCache; FPCSrcDir: String; - procedure Traverse(Dir: string; IsNamespaced: boolean); + procedure Traverse(const Dir: string; Lvl, NamespacedLvl: integer); var Cache: TCTDirectoryCache; Listing: TCTDirectoryListing; - i, p, AtomStart, IncludeStart, IncludeEnd: Integer; - CurFilename, Ext, FullFilename, Src, IncFilename, FullIncFilename: String; + i, p, AtomStart, IncludeStart, IncludeEnd, NextNamespacedLvl: Integer; + CurFilename, Ext, FullFilename, Src, IncFilename, FullIncFilename, + FoundFilename, CurUnitName, DirectiveName: String; CurCode: TCodeBuffer; begin Cache:=CodeToolBoss.DirectoryCachePool.GetCache(Dir,true,false); @@ -1455,10 +1456,15 @@ var FullFilename:=Dir+PathDelim+CurFilename; if Listing.GetAttr(i) and faDirectory>0 then begin // search recursive - Traverse(FullFilename,IsNamespaced or (CurFilename='namespaced')); + NextNamespacedLvl:=NamespacedLvl; + if NamespacedLvl>=0 then + inc(NextNamespacedLvl) + else if CurFilename='namespaced' then + NextNamespacedLvl:=Lvl; + Traverse(FullFilename,Lvl+1,NextNamespacedLvl); end else begin Ext:=ExtractFileExt(CurFilename); - if IsNamespaced and ((Ext='.pp') or (Ext='.pas')) then begin + if (NamespacedLvl>=0) and ((Ext='.pp') or (Ext='.pas')) then begin CurCode:=CodeToolBoss.LoadFile(FullFilename,true,false); if CurCode=nil then begin debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits failed loading "'+FullFilename+'"']); @@ -1479,18 +1485,29 @@ var end; // search include directive if not FindIncludeDirective(Src,'unit',1,IncludeStart,IncludeEnd) then begin - debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits missing include directive in "'+FullFilename+'"']); + debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits missing include directive in "'+FullFilename+'"',NamespacedLvl]); continue; end; - IncFilename:=copy(Src,IncludeStart,IncludeEnd-IncludeStart); + ExtractLongParamDirective(Src,IncludeStart,DirectiveName,IncFilename); DoDirSeparators(IncFilename); if ExtractFilePath(IncFilename)<>'' then begin FullIncFilename:=ResolveDots(Dir+PathDelim+IncFilename); - if not FileExists(FullIncFilename) then begin - Fail('Namespaced unit "'+FullFilename+'" includes missing "'+IncFilename+'"'); + if not CodeToolBoss.DirectoryCachePool.FileExists(FullIncFilename) then begin + Fail('[20231230132715] Namespaced unit "'+FullFilename+'" includes missing "'+IncFilename+'"'); end; end else begin - //debugln(['Namespaced unit "'+FullFilename+'" has include "'+IncFilename+'", searching ...']); + FoundFilename:=CodeToolBoss.DirectoryCachePool.FindIncludeFileInCompletePath(Dir,IncFilename); + if FoundFilename<>'' then continue; + if not FilenameIsPascalUnit(IncFilename) then begin + Fail('[20231230132721] Namespaced unit "'+FullFilename+'" includes missing "'+IncFilename+'"'); + end; + CurUnitName:=ExtractFileNameOnly(IncFilename); + FoundFilename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitLinks('',CurUnitName); + if FoundFilename<>'' then begin + Fail('Namespaced unit "'+FullFilename+'" includes file "'+IncFilename+'", not found via FindIncludeFileInCompletePath, but found via UnitLinks'); + end else begin + debugln('Note: Namespaced unit "'+FullFilename+'" includes missing file "'+IncFilename+'"'); + end; end; end; end; @@ -1504,7 +1521,7 @@ begin if FPCSrcDir='' then Fail('UnitSet.FPCSourceDirectory empty'); if not DirectoryExists(FPCSrcDir) then Fail('UnitSet.FPCSourceDirectory not found: "'+FPCSrcDir+'"'); - Traverse(FPCSrcDir,false); + Traverse(FPCSrcDir,0,-1); end; procedure TTestFindDeclaration.TestFindDeclaration_DirectiveWithIn;