paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-25 19:40:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: started test for namespaced units in fpc sources

Browse Source
This commit is contained in:
mattias 2023-12-17 10:05:45 +01:00
parent f52d11eb6e
commit dacecb3f91
3 changed files with 77 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/codetools/basiccodetools.pas
View File

@ -1028,8 +1028,8 @@ begin
until Position<1;
end;
}
function FindResourceInCode(const Source, AddCode:string;
out Position,EndPosition:integer):boolean;
function FindResourceInCode(const Source, AddCode: string;
out Position, EndPosition: integer): boolean;
var Find,Atom:string;
FindPosition,FindAtomStart,SemicolonPos:integer;
begin
@ -1055,7 +1055,7 @@ begin
Result:=true;
end;
function AddResourceCode(Source:TSourceLog; const AddCode:string):boolean;
function AddResourceCode(Source:TSourceLog; const AddCode: string): boolean;
var StartPos,EndPos:integer;
begin
if FindResourceInCode(Source.Source,AddCode,StartPos,EndPos) then begin

3
components/codetools/sourcelog.pas
View File

@ -244,9 +244,6 @@ begin
end;
end;
{ TSourceLogMarker }
{ TSourceLog }
constructor TSourceLog.Create(const ASource: string);

74
components/codetools/tests/testfinddeclaration.pas
View File

@ -145,6 +145,7 @@ type
procedure TestFindDeclaration_UnitSearch_StarStar;
procedure TestFindDeclaration_IncludeSearch_DirectiveWithPath;
procedure TestFindDeclaration_IncludeSearch_StarStar;
procedure TestFindDeclaration_FindFPCSrcNameSpacedUnits;
// directives
procedure TestFindDeclaration_DirectiveWithIn;
@ -1433,6 +1434,79 @@ begin
end;
end;
procedure TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits;
var
UnitSet: TFPCUnitSetCache;
FPCSrcDir: String;
procedure Traverse(Dir: string; IsNamespaced: boolean);
var
Cache: TCTDirectoryCache;
Listing: TCTDirectoryListing;
i, p, AtomStart, IncludeStart, IncludeEnd: Integer;
CurFilename, Ext, FullFilename, Src, IncFilename, FullIncFilename: String;
CurCode: TCodeBuffer;
begin
Cache:=CodeToolBoss.DirectoryCachePool.GetCache(Dir,true,false);
Cache.UpdateListing;
Listing:=Cache.Listing;
for i:=0 to Listing.Count-1 do begin
CurFilename:=Listing.GetFilename(i);
FullFilename:=Dir+PathDelim+CurFilename;
if Listing.GetAttr(i) and faDirectory>0 then begin
// search recursive
Traverse(FullFilename,IsNamespaced or (CurFilename='namespaced'));
end else begin
Ext:=ExtractFileExt(CurFilename);
if IsNamespaced 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+'"']);
continue;
end;
Src:=CurCode.Source;
// check if this file is an unit
p:=1;
AtomStart:=1;
ReadRawNextPascalAtom(Src,p,AtomStart,false,true);
if p=AtomStart then begin
debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits no Pascal found in "'+FullFilename+'"']);
continue;
end;
if CompareIdentifiers(@Src[AtomStart],'unit')<>0 then begin
debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits is not a Pascal unit "'+FullFilename+'"']);
continue;
end;
// search include directive
if not FindIncludeDirective(Src,'unit',1,IncludeStart,IncludeEnd) then begin
debugln(['TTestFindDeclaration.TestFindDeclaration_FindFPCSrcNameSpacedUnits missing include directive in "'+FullFilename+'"']);
continue;
end;
IncFilename:=copy(Src,IncludeStart,IncludeEnd-IncludeStart);
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+'"');
end;
end else begin
//debugln(['Namespaced unit "'+FullFilename+'" has include "'+IncFilename+'", searching ...']);
end;
end;
end;
end;
end;
begin
UnitSet:=CodeToolBoss.GetUnitSetForDirectory('');
if UnitSet=nil then Fail('GetUnitSetForDirectory returned nil');
FPCSrcDir:=ChompPathDelim(UnitSet.FPCSourceDirectory);
if FPCSrcDir='' then Fail('UnitSet.FPCSourceDirectory empty');
if not DirectoryExists(FPCSrcDir) then
Fail('UnitSet.FPCSourceDirectory not found: "'+FPCSrcDir+'"');
Traverse(FPCSrcDir,false);
end;
procedure TTestFindDeclaration.TestFindDeclaration_DirectiveWithIn;
begin
StartProgram;