codetools: search units with namespaces

git-svn-id: branches/fixes_1_8@54746 -

components/codetools/basiccodetools.pas

@@ -192,6 +192,7 @@ function DottedIdentifierLength(Identifier: PChar): integer;
 function GetDottedIdentifier(Identifier: PChar): string;
 function IsDottedIdentifier(const Identifier: string): boolean;
 function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;
+function ChompDottedIdentifier(const Identifier: string): string;
 
 // space and special chars
 function TrimCodeSpace(const ACode: string): string;
@@ -237,6 +238,8 @@ type
     property IdentifierStartInUnitName: Integer read GetIdentifierStartInUnitName;
   end;
 
+  { TNameSpaceInfo }
+
   TNameSpaceInfo = class
   private
     FUnitName: string;
@@ -249,7 +252,7 @@ type
     property IdentifierStartInUnitName: Integer read FIdentifierStartInUnitName;
   end;
 
-
+function ExtractFileNamespace(const Filename: string): string;
 procedure AddToTreeOfUnitFilesOrNamespaces(
   var TreeOfUnitFiles, TreeOfNameSpaces: TAVLTree;
   const NameSpacePath, Filename: string;
@@ -5042,6 +5045,15 @@ begin
   end;
 end;
 
+function ChompDottedIdentifier(const Identifier: string): string;
+var
+  p: Integer;
+begin
+  p:=length(Identifier);
+  while (p>0) and (Identifier[p]<>'.') do dec(p);
+  Result:=LeftStr(Identifier,p-1);
+end;
+
 function TrimCodeSpace(const ACode: string): string;
 // turn all lineends and special chars to space
 // space is combined to one char
@@ -5723,20 +5735,27 @@ begin
   System.Move(p^,Result[1],l);
 end;
 
+function ExtractFileNamespace(const Filename: string): string;
+begin
+  Result:=ExtractFileNameOnly(Filename);
+  if Result='' then exit;
+  Result:=ChompDottedIdentifier(Result);
+end;
+
 procedure AddToTreeOfUnitFilesOrNamespaces(var TreeOfUnitFiles,
   TreeOfNameSpaces: TAVLTree; const NameSpacePath, Filename: string;
   CaseInsensitive, KeepDoubles: boolean);
 
-  procedure FileAndNameSpaceFits(const UnitName: string; out FileNameFits, NameSpaceFits: Boolean);
+  procedure FileAndNameSpaceFits(const UnitName: string;
+    out FileNameFits, NameSpaceFits: Boolean);
   var
     CompareCaseInsensitive: Boolean;
   begin
     FileNameFits := False;
     NameSpaceFits := False;
     if NameSpacePath = '' then begin
-      //we search for files without namespace path
-      FileNameFits := pos('.', UnitName) = 0;
-      NameSpaceFits := not FileNameFits;
+      FileNameFits := true;
+      NameSpaceFits := true;
       Exit;
     end;
     if Length(UnitName) < Length(NameSpacePath) then Exit;
@@ -5758,6 +5777,7 @@ var
   UnitName: string;
 begin
   UnitName := ExtractFileNameOnly(Filename);
+  if not IsDottedIdentifier(UnitName) then exit;
   FileAndNameSpaceFits(UnitName, FileNameFits, NameSpaceFits);
   if FileNameFits then
     AddToTreeOfUnitFiles(TreeOfUnitFiles,FileName,UnitName,
@@ -5770,14 +5790,14 @@ end;
 function GatherUnitFiles(const BaseDir, SearchPath, Extensions,
   NameSpacePath: string; KeepDoubles, CaseInsensitive: boolean;
   var TreeOfUnitFiles, TreeOfNamespaces: TAVLTree): boolean;
-// BaseDir: base directory, used when SearchPath is relative
-// SearchPath: semicolon separated list of directories
-// Extensions: semicolon separated list of extensions (e.g. 'pas;.pp;ppu')
-// NameSpacePath: gather files only from this namespace path
-// KeepDoubles: false to return only the first match of each unit
-// CaseInsensitive: true to ignore case on comparing extensions
-// TreeOfUnitFiles: tree of TUnitFileInfo
-// TreeOfNamespaces: tree of TNameSpaceInfo
+{ BaseDir: base directory, used when SearchPath is relative
+ SearchPath: semicolon separated list of directories
+ Extensions: semicolon separated list of extensions (e.g. 'pas;.pp;ppu')
+ NameSpacePath: gather files only from this namespace path, empty '' for all
+ KeepDoubles: false to return only the first match of each unit
+ CaseInsensitive: true to ignore case on comparing extensions
+ TreeOfUnitFiles: tree of TUnitFileInfo
+ TreeOfNamespaces: tree of TNameSpaceInfo }
 var
   SearchedDirectories: TAVLTree; // tree of AnsiString
 

components/codetools/codetoolmanager.pas

@@ -365,6 +365,8 @@ type
                                         UseCache: boolean = true): string;// value of macro #FPCUnitPath
     procedure GetFPCVersionForDirectory(const Directory: string;
                                  out FPCVersion, FPCRelease, FPCPatch: integer);
+    function GetNamespacesForDirectory(const Directory: string;
+                          UseCache: boolean = true): string;// value of macro #Namespaces
 
     // miscellaneous
     property OnGetMethodName: TOnGetMethodname read FOnGetMethodName
@@ -1712,6 +1714,21 @@ begin
   end;
 end;
 
+function TCodeToolManager.GetNamespacesForDirectory(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;
+    Result:=Evaluator[NamespacesMacroName];
+  end;
+end;
+
 procedure TCodeToolManager.FreeListOfPCodeXYPosition(var List: TFPList);
 begin
   CodeCache.FreeListOfPCodeXYPosition(List);
@@ -6273,6 +6290,7 @@ begin
   ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false);
   ctdcsUnitSet: Result:=GetUnitSetIDForDirectory(ADirectory,false);
   ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false);
+  ctdcsNamespaces: Result:=GetNamespacesForDirectory(ADirectory,false);
   else RaiseCatchableException('');
   end;
 end;

components/codetools/definetemplates.pas

@@ -86,6 +86,7 @@ const
   FPCUnitPathMacroName     = ExternalMacroStart+'FPCUnitPath';
   TargetOSMacroName        = ExternalMacroStart+'TargetOS';
   TargetCPUMacroName       = ExternalMacroStart+'TargetCPU';
+  NamespacesMacroName      = ExternalMacroStart+'Namespaces';
 
   DefinePathMacro          = '$('+DefinePathMacroName+')'; // the path of the define template
   UnitPathMacro            = '$('+UnitPathMacroName+')';

components/codetools/directorycacher.pas

@@ -63,7 +63,8 @@ type
     ctdcsCompleteSrcPath, // including unit path, src path and compiled src paths
     ctdcsUnitLinks,
     ctdcsUnitSet,
-    ctdcsFPCUnitPath  // unit paths reported by FPC
+    ctdcsFPCUnitPath,  // unit paths reported by FPC
+    ctdcsNamespaces
     );
 
   TCTDirCacheStringRecord = record
@@ -186,7 +187,8 @@ type
     function FindUnitSourceInCleanSearchPath(const AUnitName,
                                   SearchPath: string; AnyCase: boolean): string;
     function FindUnitSourceInCompletePath(var AUnitName, InFilename: string;
-               AnyCase: boolean; FPCSrcSearchRequiresPPU: boolean = false): string;
+               AnyCase: boolean; FPCSrcSearchRequiresPPU: boolean = false;
+               const AddNameSpaces: string = ''): string;
     function FindCompiledUnitInCompletePath(const AnUnitname: string;
                                             AnyCase: boolean): string;
     procedure IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile);
@@ -664,6 +666,7 @@ function TCTDirectoryCache.GetUnitSourceCacheValue(
 var
   Files: TStringToStringTree;
 begin
+  //debugln(['TCTDirectoryCache.GetUnitSourceCacheValue START ',UnitSrc,' Search=',Search]);
   Files:=FUnitSources[UnitSrc].Files;
   if (FUnitSources[UnitSrc].FileTimeStamp<>Pool.FileTimeStamp)
   or (FUnitSources[UnitSrc].ConfigTimeStamp<>Pool.ConfigTimeStamp) then begin
@@ -681,6 +684,7 @@ begin
       Result:=false;
     end;
   end;
+  //debugln(['TCTDirectoryCache.GetUnitSourceCacheValue END ',UnitSrc,' Search=',Search,' Result=',Result,' Filename=',Filename]);
 end;
 
 procedure TCTDirectoryCache.AddToCache(const UnitSrc: TCTDirectoryUnitSources;
@@ -1145,8 +1149,8 @@ begin
 end;
 
 function TCTDirectoryCache.FindUnitSourceInCompletePath(var AUnitName,
-  InFilename: string; AnyCase: boolean; FPCSrcSearchRequiresPPU: boolean
-  ): string;
+  InFilename: string; AnyCase: boolean; FPCSrcSearchRequiresPPU: boolean;
+  const AddNameSpaces: string): string;
 
   function FindInFilenameLowUp(aFilename: string): string;
   begin
@@ -1190,11 +1194,12 @@ var
   UnitSrc: TCTDirectoryUnitSources;
   CurDir: String;
   SrcPath: string;
-  NewUnitName: String;
+  NewUnitName, aNameSpace, aName, NameSpaces: String;
+  p: SizeInt;
 begin
   Result:='';
   {$IFDEF ShowTriedUnits}
-  DebugLn('TCTDirectoryCache.FindUnitSourceInCompletePath AUnitName="',AUnitname,'" InFilename="',InFilename,'" Directory="',Directory,'"');
+  DebugLn('TCTDirectoryCache.FindUnitSourceInCompletePath AUnitName="',AUnitname,'" InFilename="',InFilename,'" Directory="',Directory,'"',BoolToStr(AddNameSpaces<>'',' ExtraNameSpaces="'+AddNameSpaces+'"',''));
   {$ENDIF}
   if InFilename<>'' then begin
     // uses IN parameter
@@ -1234,6 +1239,39 @@ begin
   end else begin
     // normal unit name
 
+    if Pos('.',AUnitName)<1 then begin
+      // generic unit -> search with namespaces first
+      NameSpaces:=Strings[ctdcsNamespaces];
+      if AddNameSpaces<>'' then begin
+        if NameSpaces<>'' then NameSpaces:=NameSpaces+';';
+        NameSpaces:=NameSpaces+AddNameSpaces;
+      end;
+
+      if NameSpaces<>'' then begin
+        // search with additional namespaces, separated by semicolon
+        //debugln(['TCTDirectoryCache.FindUnitSourceInCompletePath NameSpaces="',NameSpaces,'"']);
+        repeat
+          p:=Pos(';',NameSpaces);
+          if p>0 then begin
+            aNameSpace:=LeftStr(NameSpaces,p-1);
+            Delete(NameSpaces,1,p);
+          end else begin
+            aNameSpace:=NameSpaces;
+            NameSpaces:='';
+          end;
+          if IsValidIdent(aNameSpace,true,true) then begin
+            aName:=aNameSpace+'.'+AUnitName;
+            Result:=FindUnitSourceInCompletePath(aName,InFilename,AnyCase,
+              FPCSrcSearchRequiresPPU,'');
+            if Result<>'' then begin
+              AUnitName:=RightStr(aName,length(aName)-length(aNameSpace)-1);
+              exit;
+            end;
+          end;
+        until NameSpaces='';
+      end;
+    end;
+
     if AnyCase then
       UnitSrc:=ctdusUnitCaseInsensitive
     else

components/codetools/finddeclarationtool.pas

@@ -944,6 +944,7 @@ type
     procedure GatherUnitAndSrcPath(var UnitPath, CompleteSrcPath: string);
     function SearchUnitInUnitLinks(const TheUnitName: string): string; deprecated;
     function SearchUnitInUnitSet(const TheUnitName: string): string;
+    function GetNameSpaces: string;
 
     function IsIncludeDirectiveAtPos(CleanPos, CleanCodePosInFront: integer;
       out IncludeCode: TCodeBuffer): boolean;
@@ -3026,7 +3027,7 @@ begin
   NewInFilename:=AnUnitInFilename;
 
   AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
-                                               NewUnitName,NewInFilename,false);
+                          NewUnitName,NewInFilename,false,false,AddedNameSpace);
   Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AFilename,true));
 
   if (Result=nil) and Assigned(OnFindUsedUnit) then begin
@@ -3074,7 +3075,7 @@ function TFindDeclarationTool.FindUnitCaseInsensitive(var AnUnitName,
   AnUnitInFilename: string): string;
 begin
   Result:=DirectoryCache.FindUnitSourceInCompletePath(
-                                              AnUnitName,AnUnitInFilename,true);
+                         AnUnitName,AnUnitInFilename,true,false,AddedNameSpace);
 end;
 
 procedure TFindDeclarationTool.GatherUnitAndSrcPath(var UnitPath,
@@ -3099,6 +3100,15 @@ begin
   Result:=DirectoryCache.FindUnitInUnitSet(TheUnitName);
 end;
 
+function TFindDeclarationTool.GetNameSpaces: string;
+begin
+  Result:=DirectoryCache.Strings[ctdcsNamespaces];
+  if AddedNameSpace<>'' then begin
+    if Result<>'' then Result:=';'+Result;
+    Result:=AddedNameSpace+Result;
+  end;
+end;
+
 function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition;
   Flags: TFindSmartFlags): string;
 var

components/codetools/identcompletiontool.pas

@@ -1622,7 +1622,6 @@ begin
       while ANode<>nil do begin
         UnitFileInfo:=TUnitFileInfo(ANode.Data);
         ANode:=FIDTTreeOfUnitFiles.FindSuccessor(ANode);
-        //debugln(['TIdentCompletionTool.GatherUnitnames Unit=',UnitFileInfo.FileUnitName,' File=',UnitFileInfo.Filename]);
         if CompareText(PChar(Pointer(UnitFileInfo.FileUnitName)), Length(UnitFileInfo.FileUnitName),
                        PChar(Pointer(CurSourceName)), Length(CurSourceName), False)=0
         then
@@ -2711,13 +2710,14 @@ begin
       end;
 
       // find context
+      GatherContext:=CreateFindContext(Self,CursorNode);
       {$IFDEF CTDEBUG}
       DebugLn('TIdentCompletionTool.GatherIdentifiers B',
         ' CleanCursorPos=',CleanPosToStr(CleanCursorPos),
         ' IdentStartPos=',CleanPosToStr(IdentStartPos),' IdentEndPos=',CleanPosToStr(IdentEndPos),
-        ' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos));
+        ' Ident=',copy(Src,IdentStartPos,IdentEndPos-IdentStartPos),
+        ' GatherContext=',FindContextToString(GatherContext));
       {$ENDIF}
-      GatherContext:=CreateFindContext(Self,CursorNode);
       CurrentIdentifierList.NewMemberVisibility:=GetClassVisibility(CursorNode);
       if CursorNode.Desc in [ctnUsesSection,ctnUseUnit,ctnUseUnitNamespace,ctnUseUnitClearName] then begin
         GatherUnitNames(IdentifierPath);

components/codetools/pascalparsertool.pas

@@ -240,6 +240,7 @@ type
 
     ScannedRange: TLinkScannerRange; // excluding the section with a syntax error
     ScanTill: TLinkScannerRange;
+    AddedNameSpace: string; // program, library and package namespace
 
     procedure ValidateToolDependencies; virtual;
     procedure BuildTree(Range: TLinkScannerRange);
@@ -555,6 +556,7 @@ var
   ok: Boolean;
   OldLastNode: TCodeTreeNode;
   OldLastPos: Integer;
+  aNameSpace, aName: String;
 begin
   {$IFDEF MEM_CHECK}CheckHeap('TPascalParserTool.BuildTree A '+IntToStr(MemCheck_GetMem_Cnt));{$ENDIF}
   {$IFDEF CTDEBUG}
@@ -680,14 +682,23 @@ begin
         ScannedRange:=lsrSourceType;
         if ord(Range)<=ord(ScannedRange) then exit;
         if HasSourceType then begin
+          aNameSpace:='';
           repeat
             ReadNextAtom; // read source name
             // program and library can use keywords
             if (CurPos.Flag<>cafWord)
             or (CurSection in [ctnUnit,ctnPackage]) then
               AtomIsIdentifierSaveE;
+            aName:=GetAtom;
             ReadNextAtom; // read ';' (or 'platform;' or 'unimplemented;')
-          until CurPos.Flag<>cafPoint;
+            if CurPos.Flag=cafPoint then begin
+              if aNameSpace<>'' then aNameSpace:=aNameSpace+'.';
+              aNameSpace:=aNameSpace+aName;
+            end else
+              break;
+          until false;
+          if CurSection in [ctnProgram,ctnLibrary,ctnPackage] then
+            AddedNameSpace:=aNameSpace;
         end;
         ScannedRange:=lsrSourceName;
         if ord(Range)<=ord(ScannedRange) then exit;

components/codetools/pascalreadertool.pas

@@ -3182,8 +3182,6 @@ function TPascalReaderTool.ExtractArrayRanges(ArrayNode: TCodeTreeNode;
   Attr: TProcHeadAttributes): string;
 const
   AllArrays = [ctnRangedArrayType, ctnOpenArrayType];
-var
-  i: Integer;
 begin
   Result:='';
   if (ArrayNode=nil) or not (ArrayNode.Desc in AllArrays) then exit;

components/codetools/sourcechanger.pas

@@ -504,11 +504,11 @@ begin
 end;
 
 function CompareWordExceptions(p1, p2: Pointer): Integer;
-var w1, w2: string;
+var
+  w1: TWordPolicyException absolute p1;
+  w2: TWordPolicyException absolute p2;
 begin
-  w1 := TWordPolicyException(p1).Word;
-  w2 := TWordPolicyException(p2).Word;
-  Result := CompareIdentifiers(PChar(w1), PChar(w2));
+  Result := CompareIdentifiers(PChar(w1.Word), PChar(w2.Word));
 end;
 
 function CompareKeyWordExceptions(Item1, Item2: Pointer): Integer;

components/codetools/stdcodetools.pas

@@ -1556,7 +1556,7 @@ const
       NewInFilename:=OldInFilename;
       //debugln(['CheckUsesSection NewUnitName="',NewUnitName,'" NewInFilename="',NewInFilename,'"']);
       AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
-                        NewUnitName,NewInFilename,true,FPCSrcSearchRequiresPPU);
+         NewUnitName,NewInFilename,true,FPCSrcSearchRequiresPPU,AddedNameSpace);
       s:=NewUnitName;
       if NewInFilename<>'' then
         s:=s+' in '''+NewInFilename+'''';