1 {
2  Test with:
3    ./testcodetools --suite=TTestFindDeclaration
4    ./testcodetools --suite=TestFindDeclaration_Basic
5    ./testcodetools --suite=TestFindDeclaration_ClassOf
6    ./testcodetools --suite=TestFindDeclaration_With
7    ./testcodetools --suite=TestFindDeclaration_NestedClasses
8    ./testcodetools --suite=TestFindDeclaration_ClassHelper
9    ./testcodetools --suite=TestFindDeclaration_TypeHelper
10    ./testcodetools --suite=TestFindDeclaration_ObjCClass
11    ./testcodetools --suite=TestFindDeclaration_ObjCCategory
12    ./testcodetools --suite=TestFindDeclaration_Generics
13    ./testcodetools --suite=TestFindDeclaration_FileAtCursor
14 
15  FPC tests:
16    ./testcodetools --suite=TestFindDeclaration_FPCTests
17    ./testcodetools --suite=TestFindDeclaration_FPCTests --filemask=t*.pp
18    ./testcodetools --suite=TestFindDeclaration_FPCTests --filemask=tchlp41.pp
19  Laz tests:
20    ./testcodetools --suite=TestFindDeclaration_LazTests
21    ./testcodetools --suite=TestFindDeclaration_LazTests --filemask=t*.pp
22    ./testcodetools --suite=TestFindDeclaration_LazTests --filemask=tdefaultproperty1.pp
23 }
24 unit TestFindDeclaration;
25 
26 {$mode objfpc}{$H+}
27 
28 {off $define VerboseFindDeclarationTests}
29 
30 interface
31 
32 uses
33   Classes, SysUtils, contnrs,
34   fpcunit, testregistry,
35   FileProcs, LazFileUtils, LazLogger,
36   CodeToolManager, ExprEval, CodeCache, BasicCodeTools,
37   CustomCodeTool, CodeTree, FindDeclarationTool, KeywordFuncLists,
38   IdentCompletionTool, TestPascalParser;
39 
40 const
41   MarkDecl = '#'; // a declaration, must be unique
42   MarkRef = '@'; // a reference to a declaration
43 
44 type
45   TFDMarker = class
46   public
47     Name: string;
48     Kind: char;
49     NameStartPos, NameEndPos: integer; // identifier in front of comment
50     CleanPos: integer; // comment end
51   end;
52 
53   { TCustomTestFindDeclaration }
54 
55   TCustomTestFindDeclaration = class(TCustomTestPascalParser)
56   private
57     FMainCode: TCodeBuffer;
58     FMarkers: TObjectList;// list of TFDMarker
59     FMainTool: TCodeTool;
GetMarkersnull60     function GetMarkers(Index: integer): TFDMarker;
61   protected
62     procedure SetUp; override;
63     procedure TearDown; override;
MarkerCountnull64     function MarkerCount: integer;
65     property Markers[Index: integer]: TFDMarker read GetMarkers;
AddMarkernull66     function AddMarker(const aName: string; Kind: char; CleanPos: integer;
67       NameStartPos, NameEndPos: integer): TFDMarker;
IndexOfMarkernull68     function IndexOfMarker(const aName: string; Kind: char): integer;
69     procedure ParseSimpleMarkers(aCode: TCodeBuffer);
FindMarkernull70     function FindMarker(const aName: string; Kind: char): TFDMarker;
71     procedure CheckReferenceMarkers;
72     procedure FindDeclarations(Filename: string; ExpandFile: boolean = true);
73     procedure FindDeclarations(aCode: TCodeBuffer);
74     procedure TestFiles(Directory: string);
75     property MainCode: TCodeBuffer read FMainCode;
76     property MainTool: TCodeTool read FMainTool;
77   end;
78 
79   { TTestFindDeclaration }
80 
81   TTestFindDeclaration = class(TCustomTestFindDeclaration)
82   published
83     procedure TestFindDeclaration_Program;
84     procedure TestFindDeclaration_Basic;
85     procedure TestFindDeclaration_Proc_BaseTypes;
86     procedure TestFindDeclaration_With;
87     procedure TestFindDeclaration_ClassOf;
88     procedure TestFindDeclaration_NestedClasses;
89     procedure TestFindDeclaration_ClassHelper;
90     procedure TestFindDeclaration_TypeHelper;
91     procedure TestFindDeclaration_ObjCClass;
92     procedure TestFindDeclaration_ObjCCategory;
93     procedure TestFindDeclaration_GenericFunction;
94     procedure TestFindDeclaration_Generics_Enumerator;
95     procedure TestFindDeclaration_Generics;
96     procedure TestFindDeclaration_Generics_GuessType;
97     procedure TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
98     procedure TestFindDeclaration_ForIn;
99     procedure TestFindDeclaration_FileAtCursor;
100     procedure TestFindDeclaration_CBlocks;
101     procedure TestFindDeclaration_Arrays;
102     procedure TestFindDeclaration_GuessType;
103     procedure TestFindDeclaration_Attributes;
104     procedure TestFindDeclaration_BracketOpen;
105     procedure TestFindDeclaration_VarArgsOfType;
106     // test all files in directories:
107     procedure TestFindDeclaration_FPCTests;
108     procedure TestFindDeclaration_LazTests;
109   end;
110 
111 implementation
112 
113 { TCustomTestFindDeclaration }
114 
115 procedure TCustomTestFindDeclaration.CheckReferenceMarkers;
116 var
117   i, FoundTopLine, FoundCleanPos, BlockTopLine, BlockBottomLine: Integer;
118   Marker, DeclMarker: TFDMarker;
119   CursorPos, FoundCursorPos: TCodeXYPosition;
120   FoundTool: TFindDeclarationTool;
121 begin
122   for i:=0 to MarkerCount-1 do begin
123     Marker:=Markers[i];
124     if Marker.Kind=MarkRef then begin
125       DeclMarker:=FindMarker(Marker.Name,MarkDecl);
126       if DeclMarker=nil then
127         Fail('ref has no decl marker. ref "'+Marker.Name+'" at '+MainTool.CleanPosToStr(Marker.CleanPos));
128       MainTool.CleanPosToCaret(Marker.NameStartPos,CursorPos);
129 
130       // test FindDeclaration
131       if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
132         FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine,
133         BlockTopLine,BlockBottomLine)
134       then begin
135         WriteSource(CursorPos);
136         Fail('find declaration failed at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)+': '+CodeToolBoss.ErrorMessage);
137       end else begin
138         FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
139         if FoundTool<>MainTool then begin
140           WriteSource(CursorPos);
141           Fail('find declaration at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)
142             +' returned wrong tool "'+FoundTool.MainFilename+'" instead of "'+MainTool.MainFilename+'"');
143         end;
144         MainTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
145         if (FoundCleanPos<DeclMarker.NameStartPos)
146         or (FoundCleanPos>DeclMarker.NameEndPos) then begin
147           WriteSource(CursorPos);
148           Fail('find declaration at '+MainTool.CleanPosToStr(Marker.NameStartPos,true)
149             +' returned wrong position "'+MainTool.CleanPosToStr(FoundCleanPos)+'"'
150             +' instead of "'+MainTool.CleanPosToStr(Marker.NameStartPos)+'"');
151         end;
152       end;
153     end;
154   end;
155 end;
156 
157 procedure TCustomTestFindDeclaration.FindDeclarations(Filename: string;
158   ExpandFile: boolean);
159 var
160   aCode: TCodeBuffer;
161 begin
162   if ExpandFile then
163     Filename:=TrimAndExpandFilename(Filename);
164   {$IFDEF VerboseFindDeclarationTests}
165   debugln(['TTestFindDeclaration.FindDeclarations File=',Filename]);
166   {$ENDIF}
167   aCode:=CodeToolBoss.LoadFile(Filename,true,false);
168   if aCode=nil then
169     raise Exception.Create('unable to load '+Filename);
170   FindDeclarations(aCode);
171 end;
172 
173 procedure TCustomTestFindDeclaration.FindDeclarations(aCode: TCodeBuffer);
174 
175   procedure PrependPath(Prefix: string; var Path: string);
176   begin
177     if Path<>'' then Path:='.'+Path;
178     Path:=Prefix+Path;
179   end;
180 
NodeAsPathnull181   function NodeAsPath(Tool: TFindDeclarationTool; Node: TCodeTreeNode): string;
182   begin
183     Result:='';
184     while Node<>nil do begin
185       case Node.Desc of
186       ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition,ctnGenericParameter:
187         PrependPath(GetIdentifier(@Tool.Src[Node.StartPos]),Result);
188       ctnGenericType:
189         PrependPath(GetIdentifier(@Tool.Src[Node.FirstChild.StartPos]),Result);
190       ctnInterface,ctnUnit:
191         PrependPath(Tool.GetSourceName(false),Result);
192       ctnProcedure:
193         PrependPath(Tool.ExtractProcName(Node,[]),Result);
194       ctnProperty:
195         PrependPath(Tool.ExtractPropName(Node,false),Result);
196       ctnUseUnit:
197         PrependPath(Tool.ExtractUsedUnitName(Node),Result);
198       ctnUseUnitNamespace,ctnUseUnitClearName:
199         begin
200           PrependPath(GetIdentifier(@Tool.Src[Node.StartPos]),Result);
201           if Node.PriorBrother<>nil then begin
202             Node:=Node.PriorBrother;
203             continue;
204           end else
205             Node:=Node.Parent;
206         end;
207       //else debugln(['NodeAsPath ',Node.DescAsString]);
208       end;
209       Node:=Node.Parent;
210     end;
211     //debugln(['NodeAsPath ',Result]);
212   end;
213 
214 var
215   CommentP: Integer;
216   p: Integer;
217   ExpectedPath: String;
218   PathPos: Integer;
219   CursorPos, FoundCursorPos: TCodeXYPosition;
220   FoundTopLine: integer;
221   FoundTool: TFindDeclarationTool;
222   FoundCleanPos: Integer;
223   FoundNode: TCodeTreeNode;
224   FoundPath: String;
225   Src: String;
226   NameStartPos, i, l, IdentifierStartPos, IdentifierEndPos,
227     BlockTopLine, BlockBottomLine: Integer;
228   Marker, ExpectedType, NewType: String;
229   IdentItem: TIdentifierListItem;
230   ItsAKeyword, IsSubIdentifier: boolean;
231   ExistingDefinition: TFindContext;
232   ListOfPFindContext: TFPList;
233   NewExprType: TExpressionType;
234 begin
235   FMainCode:=aCode;
236   DoParseModule(MainCode,FMainTool);
237   CommentP:=1;
238   Src:=MainTool.Src;
239   while CommentP<length(Src) do begin
240     CommentP:=FindNextComment(Src,CommentP);
241     if CommentP>length(Src) then break;
242     p:=CommentP;
243     CommentP:=FindCommentEnd(Src,CommentP,MainTool.Scanner.NestedComments);
244     if Src[p]<>'{' then continue;
245     if Src[p+1] in ['$','%',' ',#0..#31] then continue;
246 
247     IdentifierStartPos:=p;
248     IdentifierEndPos:=p;
249     while (IdentifierStartPos>1) and (IsIdentChar[Src[IdentifierStartPos-1]]) do
250       dec(IdentifierStartPos);
251     if IdentifierStartPos=p then begin
252       WriteSource(p,MainTool);
253       Fail('missing identifier in front of marker at '+MainTool.CleanPosToStr(p));
254     end;
255     inc(p);
256     NameStartPos:=p;
257     if Src[p] in ['#','@'] then begin
258       {#name}  {@name}
259       inc(p);
260       if not IsIdentStartChar[Src[p]] then begin
261         WriteSource(p,MainTool);
262         Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
263       end;
264       NameStartPos:=p;
265       while IsIdentChar[Src[p]] do inc(p);
266       Marker:=copy(Src,NameStartPos,p-NameStartPos);
267       AddMarker(Marker,Src[NameStartPos],CommentP,IdentifierStartPos,IdentifierEndPos);
268       continue;
269     end;
270 
271     // check for specials:
272     {declaration:path}
273     {guesstype:type}
274     if not IsIdentStartChar[Src[p]] then continue;
275     while (p<=length(Src)) and (IsIdentChar[Src[p]]) do inc(p);
276     Marker:=copy(Src,NameStartPos,p-NameStartPos);
277     if (p>length(Src)) or (Src[p]<>':') then begin
278       WriteSource(p,MainTool);
279       AssertEquals('Expected : at '+MainTool.CleanPosToStr(p,true),'declaration',Marker);
280       continue;
281     end;
282     inc(p);
283     PathPos:=p;
284 
285     //debugln(['TTestFindDeclaration.FindDeclarations Marker="',Marker,'" params: ',dbgstr(MainTool.Src,p,CommentP-p)]);
286     if (Marker='declaration') then begin
287       ExpectedPath:=copy(Src,PathPos,CommentP-1-PathPos);
288       {$IFDEF VerboseFindDeclarationTests}
289       debugln(['TTestFindDeclaration.FindDeclarations searching "',Marker,'" at ',MainTool.CleanPosToStr(NameStartPos-1),' ExpectedPath=',ExpectedPath]);
290       {$ENDIF}
291       MainTool.CleanPosToCaret(IdentifierStartPos,CursorPos);
292 
293       // test FindDeclaration
294       if not CodeToolBoss.FindDeclaration(CursorPos.Code,CursorPos.X,CursorPos.Y,
295         FoundCursorPos.Code,FoundCursorPos.X,FoundCursorPos.Y,FoundTopLine,
296         BlockTopLine,BlockBottomLine)
297       then begin
298         if ExpectedPath<>'' then begin
299           //if (CodeToolBoss.ErrorCode<>nil) then begin
300             //ErrorTool:=CodeToolBoss.GetCodeToolForSource(CodeToolBoss.ErrorCode);
301             //if ErrorTool<>MainTool then
302              // WriteSource(,ErrorTool);
303           WriteSource(IdentifierStartPos,MainTool);
304           Fail('find declaration failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage);
305         end;
306         continue;
307       end else begin
308         FoundTool:=CodeToolBoss.GetCodeToolForSource(FoundCursorPos.Code,true,true) as TFindDeclarationTool;
309         FoundPath:='';
310         FoundNode:=nil;
311         if (FoundCursorPos.Y=1) and (FoundCursorPos.X=1) then begin
312           // unit
313           FoundPath:=ExtractFileNameOnly(FoundCursorPos.Code.Filename);
314         end else begin
315           FoundTool.CaretToCleanPos(FoundCursorPos,FoundCleanPos);
316           if (FoundCleanPos>1) and (IsIdentChar[FoundTool.Src[FoundCleanPos-1]]) then
317             dec(FoundCleanPos);
318           FoundNode:=FoundTool.FindDeepestNodeAtPos(FoundCleanPos,true);
319           //debugln(['TTestFindDeclaration.FindDeclarations Found: ',FoundTool.CleanPosToStr(FoundNode.StartPos,true),' FoundNode=',FoundNode.DescAsString]);
320           FoundPath:=NodeAsPath(FoundTool,FoundNode);
321         end;
322         //debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
323         if LowerCase(ExpectedPath)<>LowerCase(FoundPath) then begin
324           WriteSource(IdentifierStartPos,MainTool);
325           AssertEquals('find declaration wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedPath),LowerCase(FoundPath));
326         end;
327       end;
328 
329       // test identifier completion
330       if (ExpectedPath<>'') then begin
331         if not CodeToolBoss.GatherIdentifiers(CursorPos.Code,CursorPos.X,CursorPos.Y)
332         then begin
333           if ExpectedPath<>'' then begin
334             WriteSource(IdentifierStartPos,MainTool);
335             AssertEquals('GatherIdentifiers failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage,false,true);
336           end;
337           continue;
338         end else begin
339           i:=CodeToolBoss.IdentifierList.GetFilteredCount-1;
340           while i>=0 do begin
341             IdentItem:=CodeToolBoss.IdentifierList.FilteredItems[i];
342             //debugln(['TTestFindDeclaration.FindDeclarations ',IdentItem.Identifier]);
343             l:=length(IdentItem.Identifier);
344             if ((l=length(ExpectedPath)) or (ExpectedPath[length(ExpectedPath)-l]='.'))
345             and (CompareText(IdentItem.Identifier,RightStr(ExpectedPath,l))=0)
346             then break;
347             dec(i);
348           end;
349           if i<0 then begin
350             WriteSource(IdentifierStartPos,MainTool);
351             AssertEquals('GatherIdentifiers misses "'+ExpectedPath+'" at '+MainTool.CleanPosToStr(IdentifierStartPos,true),true,i>=0);
352           end;
353         end;
354       end;
355     end else if Marker='guesstype' then begin
356       ExpectedType:=copy(Src,PathPos,CommentP-1-PathPos);
357       {$IFDEF VerboseFindDeclarationTests}
358       debugln(['TTestFindDeclaration.FindDeclarations "',Marker,'" at ',Tool.CleanPosToStr(NameStartPos-1),' ExpectedType=',ExpectedType]);
359       {$ENDIF}
360       MainTool.CleanPosToCaret(IdentifierStartPos,CursorPos);
361 
362       // test GuessTypeOfIdentifier
363       ListOfPFindContext:=nil;
364       try
365         if not CodeToolBoss.GuessTypeOfIdentifier(CursorPos.Code,CursorPos.X,CursorPos.Y,
366           ItsAKeyword, IsSubIdentifier, ExistingDefinition, ListOfPFindContext,
367           NewExprType, NewType)
368         then begin
369           if ExpectedType<>'' then
370             AssertEquals('GuessTypeOfIdentifier failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage,false,true);
371           continue;
372         end else begin
373           //debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
374           if LowerCase(ExpectedType)<>LowerCase(NewType) then begin
375             WriteSource(IdentifierStartPos,MainTool);
376             AssertEquals('GuessTypeOfIdentifier wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedType),LowerCase(NewType));
377           end;
378         end;
379       finally
380         FreeListOfPFindContext(ListOfPFindContext);
381       end;
382 
383     end else begin
384       WriteSource(IdentifierStartPos,MainTool);
385       AssertEquals('Unknown marker at '+MainTool.CleanPosToStr(IdentifierStartPos,true),'declaration',Marker);
386       continue;
387     end;
388   end;
389   CheckReferenceMarkers;
390 end;
391 
GetMarkersnull392 function TCustomTestFindDeclaration.GetMarkers(Index: integer): TFDMarker;
393 begin
394   Result:=TFDMarker(FMarkers[Index]);
395 end;
396 
397 procedure TCustomTestFindDeclaration.TestFiles(Directory: string);
398 const
399   fmparam = '--filemask=';
400 var
401   Info: TSearchRec;
402   aFilename, Param, aFileMask: String;
403   i: Integer;
404   Verbose: Boolean;
405 begin
406   aFileMask:='t*.p*';
407   Verbose:=false;
408   for i:=1 to ParamCount do begin
409     Param:=ParamStr(i);
410     if LeftStr(Param,length(fmparam))=fmparam then
411       aFileMask:=copy(Param,length(fmparam)+1,100);
412     if Param='-v' then
413       Verbose:=true;
414   end;
415   Directory:=AppendPathDelim(Directory);
416 
417   if FindFirstUTF8(Directory+aFileMask,faAnyFile,Info)=0 then begin
418     repeat
419       if faDirectory and Info.Attr>0 then continue;
420       aFilename:=Info.Name;
421       if not FilenameIsPascalUnit(aFilename) then continue;
422       if Verbose then
423         debugln(['TTestFindDeclaration.TestFiles File="',aFilename,'"']);
424       FindDeclarations(Directory+aFilename);
425     until FindNextUTF8(Info)<>0;
426   end;
427 end;
428 
429 procedure TCustomTestFindDeclaration.SetUp;
430 begin
431   inherited SetUp;
432   FMarkers:=TObjectList.Create(true);
433 end;
434 
435 procedure TCustomTestFindDeclaration.TearDown;
436 begin
437   FMainCode:=nil;
438   FMainTool:=nil;
439   FreeAndNil(FMarkers);
440   inherited TearDown;
441 end;
442 
MarkerCountnull443 function TCustomTestFindDeclaration.MarkerCount: integer;
444 begin
445   if FMarkers=nil then
446     Result:=0
447   else
448     Result:=FMarkers.Count;
449 end;
450 
TCustomTestFindDeclaration.AddMarkernull451 function TCustomTestFindDeclaration.AddMarker(const aName: string; Kind: char;
452   CleanPos: integer; NameStartPos, NameEndPos: integer): TFDMarker;
453 begin
454   if (Kind=MarkDecl) then begin
455     Result:=FindMarker(aName,Kind);
456     if Result<>nil then
457       Fail('duplicate decl marker at '+MainTool.CleanPosToStr(CleanPos)+' and at '+MainTool.CleanPosToStr(Result.CleanPos));
458   end;
459   Result:=TFDMarker.Create;
460   Result.Name:=aName;
461   Result.Kind:=Kind;
462   Result.CleanPos:=CleanPos;
463   Result.NameStartPos:=NameStartPos;
464   Result.NameEndPos:=NameEndPos;
465   FMarkers.Add(Result);
466 end;
467 
TCustomTestFindDeclaration.IndexOfMarkernull468 function TCustomTestFindDeclaration.IndexOfMarker(const aName: string; Kind: char
469   ): integer;
470 var
471   i: Integer;
472   Marker: TFDMarker;
473 begin
474   for i:=0 to MarkerCount-1 do begin
475     Marker:=Markers[i];
476     if (Marker.Kind=Kind) and (CompareText(Markers[i].Name,aName)=0) then
477       exit(i);
478   end;
479   Result:=-1;
480 end;
481 
482 procedure TCustomTestFindDeclaration.ParseSimpleMarkers(aCode: TCodeBuffer);
483 var
484   CommentP, p, IdentifierStartPos, IdentifierEndPos, NameStartPos: Integer;
485   Src, Marker: String;
486 begin
487   FMainCode:=aCode;
488   DoParseModule(MainCode,FMainTool);
489   CommentP:=1;
490   Src:=MainTool.Src;
491   while CommentP<length(Src) do begin
492     CommentP:=FindNextComment(Src,CommentP);
493     if CommentP>length(Src) then break;
494     p:=CommentP;
495     CommentP:=FindCommentEnd(Src,CommentP,MainTool.Scanner.NestedComments);
496     if Src[p]<>'{' then continue;
497     if Src[p+1] in ['$','%',' ',#0..#31] then continue;
498 
499     IdentifierStartPos:=p;
500     IdentifierEndPos:=p;
501     while (IdentifierStartPos>1) and (IsIdentChar[Src[IdentifierStartPos-1]]) do
502       dec(IdentifierStartPos);
503 
504     inc(p);
505     NameStartPos:=p;
506     if Src[p] in ['#','@'] then begin
507       {#name}  {@name}
508       inc(p);
509       if not IsIdentStartChar[Src[p]] then begin
510         WriteSource(p,MainTool);
511         Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
512       end;
513       NameStartPos:=p;
514       while IsIdentChar[Src[p]] do inc(p);
515       Marker:=copy(Src,NameStartPos,p-NameStartPos);
516       AddMarker(Marker,Src[NameStartPos-1],CommentP,IdentifierStartPos,IdentifierEndPos);
517     end else begin
518       WriteSource(p,MainTool);
519       Fail('invalid marker at '+MainTool.CleanPosToStr(p));
520     end;
521   end;
522 end;
523 
TCustomTestFindDeclaration.FindMarkernull524 function TCustomTestFindDeclaration.FindMarker(const aName: string; Kind: char
525   ): TFDMarker;
526 var
527   i: Integer;
528 begin
529   i:=IndexOfMarker(aName,Kind);
530   if i<0 then
531     Result:=nil
532   else
533     Result:=Markers[i];
534 end;
535 
536 procedure TTestFindDeclaration.TestFindDeclaration_Program;
537 begin
538   StartProgram;
539   Add([
540   'var Cow: longint;',
541   'begin',
542   '  cow{declaration:Cow}:=3;',
543   '  test1{declaration:Test1}.cow{declaration:Cow}:=3;',
544   'end.',
545   '']);
546   FindDeclarations(Code);
547 end;
548 
549 procedure TTestFindDeclaration.TestFindDeclaration_Basic;
550 begin
551   FindDeclarations('moduletests/fdt_basic.pas');
552 end;
553 
554 procedure TTestFindDeclaration.TestFindDeclaration_Proc_BaseTypes;
555 begin
556   FindDeclarations('moduletests/fdt_proc_basetypes.pas');
557 end;
558 
559 procedure TTestFindDeclaration.TestFindDeclaration_With;
560 begin
561   FindDeclarations('moduletests/fdt_with.pas');
562 end;
563 
564 procedure TTestFindDeclaration.TestFindDeclaration_ClassOf;
565 begin
566   FindDeclarations('moduletests/fdt_classof.pas');
567 end;
568 
569 procedure TTestFindDeclaration.TestFindDeclaration_NestedClasses;
570 begin
571   FindDeclarations('moduletests/fdt_nestedclasses.pas');
572 end;
573 
574 procedure TTestFindDeclaration.TestFindDeclaration_ClassHelper;
575 begin
576   FindDeclarations('moduletests/fdt_classhelper.pas');
577 end;
578 
579 procedure TTestFindDeclaration.TestFindDeclaration_TypeHelper;
580 begin
581   FindDeclarations('moduletests/fdt_typehelper.pas');
582 end;
583 
584 procedure TTestFindDeclaration.TestFindDeclaration_ObjCClass;
585 begin
586   {$IFDEF Darwin}
587   FindDeclarations('moduletests/fdt_objcclass.pas');
588   {$ENDIF}
589 end;
590 
591 procedure TTestFindDeclaration.TestFindDeclaration_ObjCCategory;
592 begin
593   {$IFDEF Darwin}
594   FindDeclarations('moduletests/fdt_objccategory.pas');
595   {$ENDIF}
596 end;
597 
598 procedure TTestFindDeclaration.TestFindDeclaration_GenericFunction;
599 begin
600   StartProgram;
601   Add([
602   '{$mode objfpc}',
603   'generic function RandomFrom<T>(const AValues:array of T):T;',
604   'begin',
605   '  Result:=Avalue[1];',
606   'end;',
607   'begin',
608   '  i:=RandomFrom<longint>([1,2,3]);',
609   'end.',
610   '']);
611   FindDeclarations(Code);
612 end;
613 
614 procedure TTestFindDeclaration.TestFindDeclaration_Generics_Enumerator;
615 begin
616   StartProgram;
617   Add([
618   'type',
619   '  integer = longint;',
620   '  TOwnedCollection = class',
621   '  end;',
622   '  generic TMyOwnedCollection<T: class> = class(TOwnedCollection)',
623   '  public type',
624   '    TEnumerator = class',
625   '    private',
626   '      FIndex: Integer;',
627   '      FCol: specialize TMyOwnedCollection<T>;',
628   '    public',
629   '      constructor Create(ACol: specialize TMyOwnedCollection<T>);',
630   '      function GetCurrent: T;',
631   '      function MoveNext: Boolean;',
632   '      property Current: T read GetCurrent;',
633   '    end;',
634   '  public',
635   '    function GetEnumerator: TEnumerator;',
636   '    function GetItem(AIndex: Integer): T;',
637   '  end;',
638   'end.']);
639   FindDeclarations(Code);
640 end;
641 
642 procedure TTestFindDeclaration.TestFindDeclaration_Generics;
643 begin
644   FindDeclarations('moduletests/fdt_generics.pas');
645 end;
646 
647 procedure TTestFindDeclaration.TestFindDeclaration_Generics_GuessType;
648 begin
649   FindDeclarations('moduletests/fdt_generics_guesstype.pas');
650 end;
651 
652 procedure TTestFindDeclaration.TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
653 begin
654   StartProgram;
655   Add([
656   '{$mode delphi}',
657   'type',
658   '  IParameters = interface',
659   '  end;',
660   '  IItem = class',
661   '  end;',
662   '  IBirdy = interface (IParameters<IItem>)',
663   '    [''guid'']',
664   '  end;',
665   'end.']);
666   FindDeclarations(Code);
667 end;
668 
669 procedure TTestFindDeclaration.TestFindDeclaration_ForIn;
670 begin
671   FindDeclarations('moduletests/fdt_for_in.pas');
672 end;
673 
674 procedure TTestFindDeclaration.TestFindDeclaration_FileAtCursor;
675 var
676   SubUnit2Code, LFMCode: TCodeBuffer;
677   Found: TFindFileAtCursorFlag;
678   FoundFilename: string;
679 begin
680   FMainCode:=CodeToolBoss.CreateFile('test1.lpr');
681   MainCode.Source:='uses unit2 in ''sub/../unit2.pas'';'+LineEnding;
682   SubUnit2Code:=CodeToolBoss.CreateFile('unit2.pas');
683   LFMCode:=CodeToolBoss.CreateFile('test1.lfm');
684   try
685     // --- used unit ---
686     // test cursor on 'unit2'
687     if not CodeToolBoss.FindFileAtCursor(MainCode,6,1,Found,FoundFilename) then
688       Fail('CodeToolBoss.FindFileAtCursor at uses unit2');
689     AssertEquals('FindFileAtCursor at uses unit2 Found',ord(ffatUsedUnit),ord(Found));
690     AssertEquals('FindFileAtCursor at uses unit2 FoundFilename','unit2.pas',FoundFilename);
691     // test cursor on 'in'
692     if not CodeToolBoss.FindFileAtCursor(MainCode,12,1,Found,FoundFilename) then
693       Fail('CodeToolBoss.FindFileAtCursor at uses unit2-in');
694     AssertEquals('FindFileAtCursor at uses unit2-in Found',ord(ffatUsedUnit),ord(Found));
695     AssertEquals('FindFileAtCursor at uses unit2-in FoundFilename','unit2.pas',FoundFilename);
696     // test cursor on in-file literal
697     if not CodeToolBoss.FindFileAtCursor(MainCode,16,1,Found,FoundFilename) then
698       Fail('CodeToolBoss.FindFileAtCursor at uses unit2-in-literal');
699     AssertEquals('FindFileAtCursor at uses unit2-in-lit Found',ord(ffatUsedUnit),ord(Found));
700     AssertEquals('FindFileAtCursor at uses unit2-in-lit FoundFilename','unit2.pas',FoundFilename);
701 
702     // --- enabled include directive ---
703     // test cursor on enabled include directive of empty file
704     MainCode.Source:='program test1;'+LineEnding
705       +'{$i unit2.pas}'+LineEnding;
706     SubUnit2Code.Source:='';
707     if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
708       Fail('CodeToolBoss.FindFileAtCursor at enabled include directive of empty inc');
709     AssertEquals('FindFileAtCursor at enabled include directive of empty Found',ord(ffatIncludeFile),ord(Found));
710     AssertEquals('FindFileAtCursor at enabled include directive of empty FoundFilename','unit2.pas',FoundFilename);
711 
712     // test cursor on enabled include directive of not empty file
713     SubUnit2Code.Source:='{$define a}';
714     if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
715       Fail('CodeToolBoss.FindFileAtCursor at enabled include directive of non-empty inc');
716     AssertEquals('FindFileAtCursor at enabled include directive of non-empty Found',ord(ffatIncludeFile),ord(Found));
717     AssertEquals('FindFileAtCursor at enabled include directive of non-empty FoundFilename','unit2.pas',FoundFilename);
718 
719     // --- disabled include directive ---
720     // test cursor on disabled include directive
721     MainCode.Source:='program test1;'+LineEnding
722       +'{$ifdef disabled}'+LineEnding
723       +'{$i unit2.pas}'+LineEnding
724       +'{$endif}'+LineEnding;
725     SubUnit2Code.Source:='';
726     if not CodeToolBoss.FindFileAtCursor(MainCode,1,3,Found,FoundFilename) then
727       Fail('CodeToolBoss.FindFileAtCursor at disabled include directive');
728     AssertEquals('FindFileAtCursor at disabled include directive Found',ord(ffatDisabledIncludeFile),ord(Found));
729     AssertEquals('FindFileAtCursor at disabled include directive FoundFilename','unit2.pas',FoundFilename);
730 
731     // --- enabled resource directive ---
732     MainCode.Source:='program test1;'+LineEnding
733       +'{$R test1.lfm}'+LineEnding;
734     if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
735       Fail('CodeToolBoss.FindFileAtCursor at enabled resource directive');
736     AssertEquals('FindFileAtCursor at enabled resource directive Found',ord(ffatResource),ord(Found));
737     AssertEquals('FindFileAtCursor at enabled resource directive FoundFilename','test1.lfm',FoundFilename);
738 
739     MainCode.Source:='program test1;'+LineEnding
740       +'{$R *.lfm}'+LineEnding;
741     if not CodeToolBoss.FindFileAtCursor(MainCode,1,2,Found,FoundFilename) then
742       Fail('CodeToolBoss.FindFileAtCursor at enabled resource directive');
743     AssertEquals('FindFileAtCursor at enabled resource directive Found',ord(ffatResource),ord(Found));
744     AssertEquals('FindFileAtCursor at enabled resource directive FoundFilename','test1.lfm',FoundFilename);
745 
746     // --- disabled resource directive ---
747     MainCode.Source:='program test1;'+LineEnding
748       +'{$ifdef disabled}'+LineEnding
749       +'{$R test1.lfm}'+LineEnding
750       +'{$endif}'+LineEnding;
751     if not CodeToolBoss.FindFileAtCursor(MainCode,1,3,Found,FoundFilename) then
752       Fail('CodeToolBoss.FindFileAtCursor at disabled resource directive');
753     AssertEquals('FindFileAtCursor at disabled resource directive Found',ord(ffatDisabledResource),ord(Found));
754     AssertEquals('FindFileAtCursor at disabled resource directive FoundFilename','test1.lfm',FoundFilename);
755 
756     // --- literal ---
757     MainCode.Source:='program test1;'+LineEnding
758       +'const Cfg=''unit2.pas'';'+LineEnding;
759     if not CodeToolBoss.FindFileAtCursor(MainCode,11,2,Found,FoundFilename) then
760       Fail('CodeToolBoss.FindFileAtCursor in literal');
761     AssertEquals('FindFileAtCursor in literal Found',ord(ffatLiteral),ord(Found));
762     AssertEquals('FindFileAtCursor in literal FoundFilename','unit2.pas',FoundFilename);
763 
764     // --- comment ---
765     MainCode.Source:='program test1;'+LineEnding
766       +'{unit2.pas}'+LineEnding;
767     if not CodeToolBoss.FindFileAtCursor(MainCode,3,2,Found,FoundFilename) then
768       Fail('CodeToolBoss.FindFileAtCursor in comment');
769     AssertEquals('FindFileAtCursor in comment Found',ord(ffatComment),ord(Found));
770     AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
771 
772     // --- unit name search in comment ---
773     MainCode.Source:='program test1;'+LineEnding
774       +'{unit2}'+LineEnding;
775     if not CodeToolBoss.FindFileAtCursor(MainCode,3,2,Found,FoundFilename) then
776       Fail('CodeToolBoss.FindFileAtCursor in comment');
777     AssertEquals('FindFileAtCursor in comment Found',ord(ffatUnit),ord(Found));
778     AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
779 
780     // --- unit name search in MainCode ---
781     MainCode.Source:='program test1;'+LineEnding
782       +'begin'+LineEnding
783       +'  unit2.Test;'+LineEnding;
784     if not CodeToolBoss.FindFileAtCursor(MainCode,3,3,Found,FoundFilename) then
785       Fail('CodeToolBoss.FindFileAtCursor in comment');
786     AssertEquals('FindFileAtCursor in comment Found',ord(ffatUnit),ord(Found));
787     AssertEquals('FindFileAtCursor in comment FoundFilename','unit2.pas',FoundFilename);
788 
789   finally
790     MainCode.IsDeleted:=true;
791     SubUnit2Code.IsDeleted:=true;
792     LFMCode.IsDeleted:=true;
793   end;
794 end;
795 
796 procedure TTestFindDeclaration.TestFindDeclaration_CBlocks;
797 begin
798   StartProgram;
799   Add([
800     '{$modeswitch cblocks}',
801     'type tblock = reference to procedure; cdecl;',
802     'procedure test(b: tblock);',
803     'begin',
804     '  b;',
805     'end;',
806     'procedure proc;',
807     'begin',
808     'end;',
809     'const bconst: tblock = @proc;',
810     'var',
811     '  b: tblock;',
812     'begin',
813     '  b:=@proc;',
814     '  b;',
815     '  test{declaration:test1.test}(@proc);',
816     '  test{declaration:test1.test}(b);',
817     '  bconst{declaration:test1.bconst};',
818     '  test{declaration:test1.test}(bconst{declaration:test1.bconst});',
819     'end.',
820   '']);
821   ParseModule;
822 end;
823 
824 procedure TTestFindDeclaration.TestFindDeclaration_Arrays;
825 begin
826   FindDeclarations('moduletests/fdt_arrays.pas');
827 end;
828 
829 procedure TTestFindDeclaration.TestFindDeclaration_GuessType;
830 begin
831   FindDeclarations('moduletests/fdt_guesstype1.pas');
832 end;
833 
834 procedure TTestFindDeclaration.TestFindDeclaration_Attributes;
835 var
836   Node: TCodeTreeNode;
837   p: Integer;
838   Src: String;
839 begin
840   StartProgram;
841   Add([
842   '{$modeswitch prefixedattributes}',
843   'type',
844   '  TCustomAttribute = class',
845   '  end;',
846   '  BirdAttribute = class(TCustomAttribute)',
847   '  end;',
848   '  Bird = class(TCustomAttribute)',
849   '  end;',
850   '  [Bird{declaration:BirdAttribute}]',
851   '  THawk = class',
852   '    [Bird{declaration:BirdAttribute}(1)]',
853   '    FField: integer;',
854   '    [Bird(2)]',
855   '    procedure DoSome;',
856   '    [Bird(3)]',
857   '    property  F: integer read FField;',
858   '  end;',
859   '  IMy = interface',
860   '    [''guid'']',
861   '    [Bird]',
862   '    [Bird(12)]',
863   '    function GetSome: integer;',
864   '    [Bird(13)]',
865   '    property  Some: integer read GetSome;',
866   '  end;',
867   '  IMy = dispinterface',
868   '    [''guid'']',
869   '    [Bird(21)]',
870   '    function GetMore: integer;',
871   '  end;',
872   '[test1.bird]',
873   '[bird(4)]',
874   'procedure DoIt; forward;',
875   '[bird(5)]',
876   'procedure DoIt;',
877   'begin',
878   'end;',
879   'var',
880   '  [bird(1+2,3),bird]',
881   '  Foo: TObject;',
882   'begin',
883   'end.',
884   '']);
885   FindDeclarations(Code);
886   // check if all attributes were parsed
887   Src:=MainTool.Src;
888   for p:=1 to length(Src) do begin
889     if (Src[p]='[') and (IsIdentStartChar[Src[p+1]]) then begin
890       Node:=MainTool.FindDeepestNodeAtPos(p,false);
891       if (Node=nil) then begin
892         WriteSource(p,MainTool);
893         Fail('missing node at '+MainTool.CleanPosToStr(p));
894       end;
895       if (Node.Desc<>ctnAttribute) then begin
896         WriteSource(p,MainTool);
897         Fail('missing attribute at '+MainTool.CleanPosToStr(p));
898       end;
899       if Node.NextBrother=nil then begin
900         WriteSource(Node.StartPos,MainTool);
901         Fail('Attribute without NextBrother');
902       end;
903       if not (Node.NextBrother.Desc in [ctnAttribute,ctnVarDefinition,ctnTypeDefinition,ctnProcedure,ctnProperty])
904       then begin
905         WriteSource(Node.StartPos,MainTool);
906         Fail('Attribute invalid NextBrother '+Node.NextBrother.DescAsString);
907       end;
908     end;
909   end;
910 end;
911 
912 procedure TTestFindDeclaration.TestFindDeclaration_BracketOpen;
913 begin
914   StartProgram;
915   Add([
916   'var c: integer;',
917   'procedure DoIt(i: integer);',
918   '  procedure WriteStr(s: string);',
919   '  begin',
920   '  end;',
921   'begin',
922   '  begin',
923   '    DoIt(c{declaration:c}',
924   '  end;',
925   '  begin',
926   '    WriteStr(c{declaration:c}',
927   '  end;',
928   'end;',
929   'begin',
930   'end.',
931   '']);
932   FindDeclarations(Code);
933 end;
934 
935 procedure TTestFindDeclaration.TestFindDeclaration_VarArgsOfType;
936 begin
937   StartProgram;
938   Add([
939   'procedure Run; varargs of word;',
940   'begin',
941   '  Run{declaration:run}(1,2);',
942   'end;',
943   'begin',
944   '  Run{declaration:run}(3);',
945   'end.']);
946   FindDeclarations(Code);
947 end;
948 
949 procedure TTestFindDeclaration.TestFindDeclaration_FPCTests;
950 begin
951   TestFiles('fpctests');
952 end;
953 
954 procedure TTestFindDeclaration.TestFindDeclaration_LazTests;
955 begin
956   TestFiles('laztests');
957 end;
958 
959 initialization
960   RegisterTests([TTestFindDeclaration]);
961 end.
962 
963