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