1 {
2 Examples:
3 ./testpassrc --suite=TTestResolver.TestEmpty
4 }
5 unit tcuseanalyzer;
6
7 {$mode objfpc}{$H+}
8
9 interface
10
11 uses
12 Classes, SysUtils, fpcunit, PasTree, PScanner, PasResolver, tcbaseparser,
13 testregistry, strutils, tcresolver, PasUseAnalyzer, PasResolveEval;
14
15 type
16
17 { TCustomTestUseAnalyzer }
18
19 TCustomTestUseAnalyzer = Class(TCustomTestResolver)
20 private
21 FAnalyzer: TPasAnalyzer;
22 FPAMessages: TFPList; // list of TPAMessage
23 FPAGoodMessages: TFPList;
24 FProcAnalyzer: TPasAnalyzer;
GetPAMessagesnull25 function GetPAMessages(Index: integer): TPAMessage;
26 procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
27 protected
28 procedure SetUp; override;
29 procedure TearDown; override;
30 procedure AnalyzeModule; virtual;
31 procedure AnalyzeProgram; virtual;
32 procedure AnalyzeUnit; virtual;
33 procedure AnalyzeWholeProgram; virtual;
34 procedure CheckUsedMarkers; virtual;
35 procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
36 const MsgText: string); virtual;
37 procedure CheckUseAnalyzerUnexpectedHints; virtual;
38 procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
39 procedure CheckScopeReferences(const ScopeName: string;
40 const RefNames: array of string);
41 public
42 property Analyzer: TPasAnalyzer read FAnalyzer;
43 property ProcAnalyzer: TPasAnalyzer read FProcAnalyzer;
PAMessageCountnull44 function PAMessageCount: integer;
45 property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
46 end;
47
48 { TTestUseAnalyzer }
49
50 TTestUseAnalyzer = Class(TCustomTestUseAnalyzer)
51 published
52 // single module
53 procedure TestM_ProgramLocalVar;
54 procedure TestM_AssignStatement;
55 procedure TestM_BeginBlock;
56 procedure TestM_ForLoopStatement;
57 procedure TestM_AsmStatement;
58 procedure TestM_CaseOfStatement;
59 procedure TestM_IfThenElseStatement;
60 procedure TestM_WhileDoStatement;
61 procedure TestM_RepeatUntilStatement;
62 procedure TestM_TryFinallyStatement;
63 procedure TestM_TypeAlias;
64 procedure TestM_TypeAliasTypeInfo;
65 procedure TestM_RangeType;
66 procedure TestM_Unary;
67 procedure TestM_Const;
68 procedure TestM_ResourceString;
69 procedure TestM_Record;
70 procedure TestM_RecordGeneric;
71 procedure TestM_PointerTyped_Record;
72 procedure TestM_Array;
73 procedure TestM_NestedFuncResult;
74 procedure TestM_Enums;
75 procedure TestM_ProcedureType;
76 procedure TestM_AnonymousProc;
77 procedure TestM_Params;
78 procedure TestM_Class;
79 procedure TestM_ClassForward;
80 procedure TestM_Class_Property;
81 procedure TestM_Class_PropertyProtected;
82 procedure TestM_Class_PropertyOverride;
83 procedure TestM_Class_MethodOverride;
84 procedure TestM_Class_MethodOverride2;
85 procedure TestM_ClassInterface_Corba;
86 procedure TestM_ClassInterface_NoHintsForMethod;
87 procedure TestM_ClassInterface_NoHintsForImpl;
88 procedure TestM_ClassInterface_Delegation;
89 procedure TestM_ClassInterface_COM;
90 procedure TestM_TryExceptStatement;
91
92 // single module hints
93 procedure TestM_Hint_UnitNotUsed;
94 procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
95 procedure TestM_Hint_UnitUsed;
96 procedure TestM_Hint_UnitUsedVarArgs;
97 procedure TestM_Hint_ParameterNotUsed;
98 procedure TestM_Hint_ParameterNotUsedOff;
99 procedure TestM_Hint_ParameterInOverrideNotUsed;
100 procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
101 procedure TestM_Hint_ParameterNotUsed_Abstract;
102 procedure TestM_Hint_ParameterNotUsedTypecast;
103 procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
104 procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
105 procedure TestM_Hint_ArrayArg_No_ParameterNotUsed;
106 procedure TestM_Hint_ArrayArg_No_ParameterNotUsed2;
107 procedure TestM_Hint_InheritedWithoutParams;
108 procedure TestM_Hint_LocalVariableNotUsed;
109 procedure TestM_HintsOff_LocalVariableNotUsed;
110 procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
111 procedure TestM_Hint_InterfaceUnitVariableUsed;
112 procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
113 procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
114 procedure TestM_Hint_LocalXYNotUsed;
115 procedure TestM_Hint_PrivateFieldIsNeverUsed;
116 procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
117 procedure TestM_Hint_PrivateFieldExtClassNoIsAssignedButNeverUsed;
118 procedure TestM_Hint_PrivateMethodIsNeverUsed;
119 procedure TestM_Hint_LocalDestructor_No_IsNeverUsed;
120 procedure TestM_Hint_PrivateTypeNeverUsed;
121 procedure TestM_Hint_PrivateConstNeverUsed;
122 procedure TestM_Hint_PrivatePropertyNeverUsed;
123 procedure TestM_Hint_LocalClassInProgramNotUsed;
124 procedure TestM_Hint_LocalMethodInProgramNotUsed;
125 procedure TestM_Hint_LocalVarOfNotUsedProc;
126 procedure TestM_Hint_LocalVarOfNotUsedMethod;
127 procedure TestM_Hint_AssemblerParameterIgnored;
128 procedure TestM_Hint_AssemblerDelphiParameterIgnored;
129 procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
130 procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
131 procedure TestM_Hint_FunctionResultRecord;
132 procedure TestM_Hint_FunctionResultRecordEmpty;
133 procedure TestM_Hint_FunctionResultPassRecordElement;
134 procedure TestM_Hint_FunctionResultAssembler;
135 procedure TestM_Hint_FunctionResultExit;
136 procedure TestM_Hint_AbsoluteVar;
137 procedure TestM_Hint_GenFunctionResultArgNotUsed;
138 procedure TestM_Hint_GenFunc_LocalInsideImplUsed;
139
140 // whole program optimization
141 procedure TestWP_LocalVar;
142 procedure TestWP_UnitUsed;
143 procedure TestWP_UnitUsed_ResourceString;
144 procedure TestWP_UnitNotUsed;
145 procedure TestWP_UnitInitialization;
146 procedure TestWP_UnitFinalization;
147 procedure TestWP_CallInherited;
148 procedure TestWP_ProgramPublicDeclarations;
149 procedure TestWP_ClassOverride;
150 procedure TestWP_ClassDefaultProperty;
151 procedure TestWP_BeforeConstruction;
152 procedure TestWP_Published;
153 procedure TestWP_PublishedSetType;
154 procedure TestWP_PublishedArrayType;
155 procedure TestWP_PublishedClassOfType;
156 procedure TestWP_PublishedRecordType;
157 procedure TestWP_PublishedProcType;
158 procedure TestWP_PublishedProperty;
159 procedure TestWP_BuiltInFunctions;
160 procedure TestWP_TypeInfo;
161 procedure TestWP_TypeInfo_PropertyEnumType;
162 procedure TestWP_TypeInfo_Alias;
163 procedure TestWP_TypeInfo_Specialize;
164 procedure TestWP_ForInClass;
165 procedure TestWP_AssertSysUtils;
166 procedure TestWP_RangeErrorSysUtils;
167 procedure TestWP_ClassInterface;
168 procedure TestWP_ClassInterface_OneWayIntfToObj;
169 procedure TestWP_ClassInterface_Delegation;
170 procedure TestWP_ClassInterface_COM;
171 procedure TestWP_ClassInterface_COM_Unit;
172 procedure TestWP_ClassInterface_Typeinfo;
173 procedure TestWP_ClassInterface_TGUID;
174 procedure TestWP_ClassHelper;
175 procedure TestWP_ClassHelper_ClassConstrucor_Used;
176 procedure TestWP_Attributes;
177 procedure TestWP_Attributes_ForwardClass;
178 procedure TestWP_Attributes_Params;
179
180 // scope references
181 procedure TestSR_Proc_UnitVar;
182 procedure TestSR_Init_UnitVar;
183 end;
184
dbgsnull185 function dbgs(a: TPSRefAccess) : string;
186
187 implementation
188
dbgsnull189 function dbgs(a: TPSRefAccess): string;
190 begin
191 str(a,Result);
192 end;
193
194 { TCustomTestUseAnalyzer }
195
196 procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
197 Msg: TPAMessage);
198 begin
199 Msg.AddRef;
200 FPAMessages.Add(Msg);
201 end;
202
GetPAMessagesnull203 function TCustomTestUseAnalyzer.GetPAMessages(Index: integer): TPAMessage;
204 begin
205 Result:=TPAMessage(FPAMessages[Index]);
206 end;
207
208 procedure TCustomTestUseAnalyzer.SetUp;
209 begin
210 inherited SetUp;
211 FPAMessages:=TFPList.Create;
212 FPAGoodMessages:=TFPList.Create;
213 FAnalyzer:=TPasAnalyzer.Create;
214 FAnalyzer.Resolver:=ResolverEngine;
215 Analyzer.OnMessage:=@OnAnalyzerMessage;
216 end;
217
218 procedure TCustomTestUseAnalyzer.TearDown;
219 var
220 i: Integer;
221 begin
222 FreeAndNil(FPAGoodMessages);
223 for i:=0 to FPAMessages.Count-1 do
224 TPAMessage(FPAMessages[i]).Release;
225 FreeAndNil(FPAMessages);
226 FreeAndNil(FAnalyzer);
227 FreeAndNil(FProcAnalyzer);
228 inherited TearDown;
229 end;
230
231 procedure TCustomTestUseAnalyzer.AnalyzeModule;
232 begin
233 Analyzer.AnalyzeModule(Module);
234 Analyzer.EmitModuleHints(Module);
235 CheckUsedMarkers;
236 end;
237
238 procedure TCustomTestUseAnalyzer.AnalyzeProgram;
239 begin
240 ParseProgram;
241 AnalyzeModule;
242 end;
243
244 procedure TCustomTestUseAnalyzer.AnalyzeUnit;
245 begin
246 ParseUnit;
247 AnalyzeModule;
248 end;
249
250 procedure TCustomTestUseAnalyzer.AnalyzeWholeProgram;
251 begin
252 ParseProgram;
253 Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
254 CheckUsedMarkers;
255 end;
256
257 procedure TCustomTestUseAnalyzer.CheckUsedMarkers;
258 type
259 TUsed = (
260 uUsed,
261 uNotUsed,
262 uTypeInfo,
263 uNoTypeinfo
264 );
265 var
266 aMarker: PSrcMarker;
267 p: SizeInt;
268 Postfix: String;
269 Elements: TFPList;
270 i: Integer;
271 El, FoundEl: TPasElement;
272 ExpectedUsed: TUsed;
273 begin
274 aMarker:=FirstSrcMarker;
275 while aMarker<>nil do
276 begin
277 writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
278 p:=RPos('_',aMarker^.Identifier);
279 if p>1 then
280 begin
281 Postfix:=copy(aMarker^.Identifier,p+1);
282
283 if Postfix='used' then
284 ExpectedUsed:=uUsed
285 else if Postfix='notused' then
286 ExpectedUsed:=uNotUsed
287 else if Postfix='typeinfo' then
288 ExpectedUsed:=uTypeInfo
289 else if Postfix='notypeinfo' then
290 ExpectedUsed:=uNoTypeInfo
291 else
292 RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
293
294 Elements:=FindElementsAt(aMarker);
295 try
296 FoundEl:=nil;
297 for i:=0 to Elements.Count-1 do
298 begin
299 El:=TPasElement(Elements[i]);
300 writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
301 case ExpectedUsed of
302 uUsed,uNotUsed:
303 if Analyzer.IsUsed(El) then
304 begin
305 FoundEl:=El;
306 break;
307 end;
308 uTypeInfo,uNoTypeinfo:
309 if Analyzer.IsTypeInfoUsed(El) then
310 begin
311 FoundEl:=El;
312 break;
313 end;
314 end;
315 end;
316 if FoundEl<>nil then
317 case ExpectedUsed of
318 uNotUsed:
319 RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
320 uNoTypeinfo:
321 RaiseErrorAtSrcMarker('expected element to have *no* typeinfo, but it is marked',aMarker);
322 end
323 else
324 case ExpectedUsed of
325 uUsed:
326 RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
327 uTypeInfo:
328 RaiseErrorAtSrcMarker('expected element to have typeinfo, but it is not marked',aMarker);
329 end;
330 finally
331 Elements.Free;
332 end;
333 end;
334 aMarker:=aMarker^.Next;
335 end;
336 end;
337
338 procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
339 MsgNumber: integer; const MsgText: string);
340 var
341 i: Integer;
342 Msg: TPAMessage;
343 s: string;
344 begin
345 i:=PAMessageCount-1;
346 while i>=0 do
347 begin
348 Msg:=PAMessages[i];
349 if (Msg.MsgNumber=MsgNumber) then
350 begin
351 if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
352 begin
353 FPAGoodMessages.Add(Msg);
354 exit;
355 end;
356 end;
357 dec(i);
358 end;
359 // mismatch
360 writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
361 for i:=0 to PAMessageCount-1 do
362 begin
363 Msg:=PAMessages[i];
364 writeln(' ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
365 end;
366 s:='';
367 str(MsgType,s);
368 Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
369 end;
370
371 procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
372 var
373 i: Integer;
374 Msg: TPAMessage;
375 s: String;
376 begin
377 for i:=0 to PAMessageCount-1 do
378 begin
379 Msg:=PAMessages[i];
380 if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
381 s:='';
382 str(Msg.MsgType,s);
383 Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
384 end;
385 end;
386
387 procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
388 Used: boolean);
389 var
390 aResolver: TTestEnginePasResolver;
391 PAEl: TPAElement;
392 begin
393 aResolver:=FindModuleWithFilename(aFilename);
394 AssertNotNull('unit not found "'+aFilename+'"',aResolver);
395 AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
396 PAEl:=Analyzer.FindElement(aResolver.Module);
397 if PAEl<>nil then
398 begin
399 // unit is used
400 if not Used then
401 Fail('expected unit "'+aFilename+'" not used, but it is used');
402 end
403 else
404 begin
405 // unit is not used
406 if Used then
407 Fail('expected unit "'+aFilename+'" used, but it is not used');
408 end;
409 end;
410
411 procedure TCustomTestUseAnalyzer.CheckScopeReferences(
412 const ScopeName: string; const RefNames: array of string);
413 type
414 TEntry = record
415 Name: string;
416 Access: TPSRefAccess;
417 end;
418
419 var
420 Entries: array of TEntry;
421
422 procedure CheckRefs(ScopeRefs: TPasScopeReferences; const Prefix: string);
423
424 procedure DumpRefsAndFail(Refs: TFPList; const Msg: string);
425 var
426 i: Integer;
427 Ref: TPasScopeReference;
428 begin
429 {$IFDEF VerbosePasAnalyzer}
430 if Refs.Count=0 then
431 writeln('DumpRefsAndFail ',Prefix,' NO REFS');
432 {$ENDIF}
433 for i:=0 to Refs.Count-1 do
434 begin
435 Ref:=TPasScopeReference(Refs[i]);
436 if Ref=nil then break;
437 {$IFDEF VerbosePasAnalyzer}
438 writeln('DumpRefsAndFail ',Prefix,' ',i,' ',GetObjName(Ref.Element),' ',Ref.Access);
439 {$ENDIF}
440 end;
441 Fail(Prefix+': '+Msg);
442 end;
443
444 var
445 Refs: TFPList;
446 j, i: Integer;
447 o: TObject;
448 Ref: TPasScopeReference;
449 begin
450 if ScopeRefs=nil then
451 Refs:=TFPList.Create
452 else
453 Refs:=ScopeRefs.GetList;
454 try
455 // check that Refs only contains TPasProcScopeReference
456 for i:=0 to Refs.Count-1 do
457 begin
458 o:=TObject(Refs[i]);
459 if not (o is TPasScopeReference) then
460 Fail(Prefix+': Refs['+IntToStr(i)+'] '+GetObjName(o));
461 end;
462 // check that all Entries are referenced
463 for i:=0 to length(Entries)-1 do
464 begin
465 j:=Refs.Count-1;
466 while (j>=0)
467 and (CompareText(Entries[i].Name,TPasScopeReference(Refs[j]).Element.Name)<>0) do
468 dec(j);
469 if j<0 then
470 DumpRefsAndFail(Refs,'Missing reference "'+Entries[i].Name+'"');
471 Ref:=TPasScopeReference(Refs[j]);
472 if (Entries[i].Access<>psraNone) and (Ref.Access<>Entries[i].Access) then
473 DumpRefsAndFail(Refs,'Wrong reference access "'+Entries[i].Name+'",'
474 +' expected '+dbgs(Entries[i].Access)+', but got '+dbgs(Ref.Access));
475 end;
476 // check that no other references are in Refs
477 for i:=0 to Refs.Count-1 do
478 begin
479 Ref:=TPasScopeReference(Refs[i]);
480 j:=length(Entries)-1;
481 while (j>=0)
482 and (CompareText(Ref.Element.Name,Entries[j].Name)<>0) do
483 dec(j);
484 if j<0 then
485 DumpRefsAndFail(Refs,'Unneeded reference "'+GetObjName(Ref.Element)+'"');
486 end;
487 finally
488 Refs.Free;
489 end;
490 end;
491
FindProcnull492 function FindProc(Section: TPasSection): boolean;
493 var
494 i: Integer;
495 El: TPasElement;
496 Proc: TPasProcedure;
497 Scope: TPasProcedureScope;
498 begin
499 for i:=0 to Section.Declarations.Count-1 do
500 begin
501 El:=TPasElement(Section.Declarations[i]);
502 if CompareText(El.Name,ScopeName)<>0 then continue;
503 if not (El is TPasProcedure) then
504 Fail('El is not proc '+GetObjName(El));
505 Proc:=TPasProcedure(El);
506 Scope:=Proc.CustomData as TPasProcedureScope;
507 if Scope.DeclarationProc<>nil then continue;
508
509 // check references created by AnalyzeModule
510 CheckRefs(Scope.References,'AnalyzeModule');
511
512 exit(true);
513 end;
514 Result:=false;
515 end;
516
517 procedure CheckInitialFinalization(El: TPasImplBlock);
518 var
519 Scope: TPasInitialFinalizationScope;
520 begin
521 Scope:=El.CustomData as TPasInitialFinalizationScope;
522 CheckRefs(Scope.References,'AnalyzeModule');
523 end;
524
525 var
526 i: Integer;
527 begin
528 Entries:=nil;
529 SetLength(Entries,High(RefNames)-low(RefNames)+1);
530 for i:=low(RefNames) to high(RefNames) do
531 begin
532 Entries[i].Name:=RefNames[i];
533 Entries[i].Access:=psraNone;
534 end;
535
536 if Module is TPasProgram then
537 begin
538 if CompareText(ScopeName,'begin')=0 then
539 begin
540 // check begin-block references created by AnalyzeModule
541 CheckInitialFinalization(Module.InitializationSection);
542 exit;
543 end
544 else if FindProc(TPasProgram(Module).ProgramSection) then
545 exit;
546 end
547 else if Module is TPasLibrary then
548 begin
549 if CompareText(ScopeName,'begin')=0 then
550 begin
551 // check begin-block references created by AnalyzeModule
552 CheckInitialFinalization(Module.InitializationSection);
553 exit;
554 end
555 else if FindProc(TPasLibrary(Module).LibrarySection) then
556 exit;
557 end
558 else if Module.ClassType=TPasModule then
559 begin
560 if CompareText(ScopeName,'initialization')=0 then
561 begin
562 // check initialization references created by AnalyzeModule
563 CheckInitialFinalization(Module.InitializationSection);
564 exit;
565 end
566 else if CompareText(ScopeName,'finalization')=0 then
567 begin
568 // check finalization references created by AnalyzeModule
569 CheckInitialFinalization(Module.FinalizationSection);
570 exit;
571 end
572 else if FindProc(Module.InterfaceSection) then
573 exit
574 else if FindProc(Module.ImplementationSection) then
575 exit;
576 end;
577 Fail('missing proc '+ScopeName);
578 end;
579
PAMessageCountnull580 function TCustomTestUseAnalyzer.PAMessageCount: integer;
581 begin
582 Result:=FPAMessages.Count;
583 end;
584
585 { TTestUseAnalyzer }
586
587 procedure TTestUseAnalyzer.TestM_ProgramLocalVar;
588 begin
589 StartProgram(false);
590 Add('procedure {#DoIt_used}DoIt;');
591 Add('var {#l_notused}l: longint;');
592 Add('begin');
593 Add('end;');
594 Add('begin');
595 Add(' DoIt;');
596 AnalyzeProgram;
597 end;
598
599 procedure TTestUseAnalyzer.TestM_AssignStatement;
600 begin
601 StartProgram(false);
602 Add('procedure {#DoIt_used}DoIt;');
603 Add('var');
604 Add(' {#a_notused}a: longint;');
605 Add(' {#b_used}b: longint;');
606 Add(' {#c_used}c: longint;');
607 Add('begin');
608 Add(' b:=c;');
609 Add('end;');
610 Add('begin');
611 Add(' DoIt;');
612 AnalyzeProgram;
613 end;
614
615 procedure TTestUseAnalyzer.TestM_BeginBlock;
616 begin
617 StartProgram(false);
618 Add('procedure {#DoIt_used}DoIt;');
619 Add('var');
620 Add(' {#a_used}a: longint;');
621 Add('begin');
622 Add(' begin');
623 Add(' a:=1;');
624 Add(' end;');
625 Add('end;');
626 Add('begin');
627 Add(' DoIt;');
628 AnalyzeProgram;
629 end;
630
631 procedure TTestUseAnalyzer.TestM_ForLoopStatement;
632 begin
633 StartProgram(false);
634 Add('procedure {#DoIt_used}DoIt;');
635 Add('var');
636 Add(' {#a_used}a: longint;');
637 Add(' {#b_used}b: longint;');
638 Add(' {#c_used}c: longint;');
639 Add(' {#d_used}d: longint;');
640 Add('begin');
641 Add(' for a:=b to c do d:=a;');
642 Add('end;');
643 Add('begin');
644 Add(' DoIt;');
645 AnalyzeProgram;
646 end;
647
648 procedure TTestUseAnalyzer.TestM_AsmStatement;
649 begin
650 StartProgram(false);
651 Add('procedure {#DoIt_used}DoIt;');
652 Add('begin');
653 Add(' asm end;');
654 Add('end;');
655 Add('begin');
656 Add(' DoIt;');
657 AnalyzeProgram;
658 end;
659
660 procedure TTestUseAnalyzer.TestM_CaseOfStatement;
661 begin
662 StartProgram(false);
663 Add('procedure {#DoIt_used}DoIt;');
664 Add('const');
665 Add(' {#a_used}a = 1;');
666 Add(' {#b_used}b = 2;');
667 Add('var');
668 Add(' {#c_used}c: longint;');
669 Add(' {#d_used}d: longint;');
670 Add('begin');
671 Add(' case a of');
672 Add(' b: c:=1;');
673 Add(' else');
674 Add(' d:=2;');
675 Add(' end;');
676 Add('end;');
677 Add('begin');
678 Add(' DoIt;');
679 AnalyzeProgram;
680 end;
681
682 procedure TTestUseAnalyzer.TestM_IfThenElseStatement;
683 begin
684 StartProgram(false);
685 Add('procedure {#DoIt_used}DoIt;');
686 Add('var');
687 Add(' {#a_used}a: longint;');
688 Add(' {#b_used}b: longint;');
689 Add(' {#c_used}c: longint;');
690 Add('begin');
691 Add(' if a=0 then b:=1 else c:=2;');
692 Add(' if a=0 then else ;');
693 Add('end;');
694 Add('begin');
695 Add(' DoIt;');
696 AnalyzeProgram;
697 end;
698
699 procedure TTestUseAnalyzer.TestM_WhileDoStatement;
700 begin
701 StartProgram(false);
702 Add('procedure {#DoIt_used}DoIt;');
703 Add('var');
704 Add(' {#a_used}a: longint;');
705 Add(' {#b_used}b: longint;');
706 Add('begin');
707 Add(' while a>0 do b:=1;');
708 Add('end;');
709 Add('begin');
710 Add(' DoIt;');
711 AnalyzeProgram;
712 end;
713
714 procedure TTestUseAnalyzer.TestM_RepeatUntilStatement;
715 begin
716 StartProgram(false);
717 Add('procedure {#DoIt_used}DoIt;');
718 Add('var');
719 Add(' {#a_used}a: longint;');
720 Add(' {#b_used}b: longint;');
721 Add('begin');
722 Add(' repeat a:=1; until b>1;');
723 Add('end;');
724 Add('begin');
725 Add(' DoIt;');
726 AnalyzeProgram;
727 end;
728
729 procedure TTestUseAnalyzer.TestM_TryFinallyStatement;
730 begin
731 StartProgram(false);
732 Add('procedure {#DoIt_used}DoIt;');
733 Add('var');
734 Add(' {#a_used}a: longint;');
735 Add(' {#b_used}b: longint;');
736 Add('begin');
737 Add(' try');
738 Add(' a:=1;');
739 Add(' finally');
740 Add(' b:=2;');
741 Add(' end;');
742 Add('end;');
743 Add('begin');
744 Add(' DoIt;');
745 AnalyzeProgram;
746 end;
747
748 procedure TTestUseAnalyzer.TestM_TypeAlias;
749 begin
750 StartProgram(false);
751 Add('procedure {#DoIt_used}DoIt;');
752 Add('type');
753 Add(' {#integer_used}integer = longint;');
754 Add('var');
755 Add(' {#a_used}a: integer;');
756 Add(' {#b_used}b: integer;');
757 Add(' {#c_notused}c: integer;');
758 Add('begin');
759 Add(' a:=b;');
760 Add('end;');
761 Add('begin');
762 Add(' DoIt;');
763 AnalyzeProgram;
764 end;
765
766 procedure TTestUseAnalyzer.TestM_TypeAliasTypeInfo;
767 begin
768 StartUnit(false);
769 Add([
770 'interface',
771 'type',
772 ' {#integer_typeinfo}integer = type longint;',
773 ' {tobject_used}TObject = class',
774 ' private',
775 ' type {#tcolor_notypeinfo}tcolor = type longint;',
776 ' protected',
777 ' type {#tsize_typeinfo}tsize = type longint;',
778 ' end;',
779 'implementation',
780 '']);
781 AnalyzeUnit;
782 end;
783
784 procedure TTestUseAnalyzer.TestM_RangeType;
785 begin
786 StartProgram(false);
787 Add('procedure {#DoIt_used}DoIt;');
788 Add('const');
789 Add(' {#neg1_used}Neg1 = -1;');
790 Add(' {#pos1_used}Pos1 = +1;');
791 Add('type');
792 Add(' {#trg_used}TRg = Neg1..Pos1;');
793 Add('var');
794 Add(' {#a_used}a: trg;');
795 Add('begin');
796 Add(' a:=0;');
797 Add('end;');
798 Add('begin');
799 Add(' DoIt;');
800 AnalyzeProgram;
801 end;
802
803 procedure TTestUseAnalyzer.TestM_Unary;
804 begin
805 StartProgram(false);
806 Add('procedure {#DoIt_used}DoIt;');
807 Add('var');
808 Add(' {#a_used}a: longint;');
809 Add(' {#b_used}b: longint;');
810 Add(' {#c_used}c: longint;');
811 Add(' {#d_used}d: longint;');
812 Add('begin');
813 Add(' a:=+b;');
814 Add(' a:=c+d;');
815 Add('end;');
816 Add('begin');
817 Add(' DoIt;');
818 AnalyzeProgram;
819 end;
820
821 procedure TTestUseAnalyzer.TestM_Const;
822 begin
823 StartProgram(false);
824 Add([
825 'procedure {#DoIt_used}DoIt;',
826 'var',
827 ' {#a_used}a: longint;',
828 ' {#b_used}b: boolean;',
829 ' {#c_used}c: array of longint;',
830 ' {#d_used}d: string;',
831 'begin',
832 ' a:=+1;',
833 ' b:=true;',
834 ' c:=nil;',
835 ' d:=''foo'';',
836 'end;',
837 'begin',
838 ' DoIt;']);
839 AnalyzeProgram;
840 end;
841
842 procedure TTestUseAnalyzer.TestM_ResourceString;
843 begin
844 StartProgram(false);
845 Add([
846 'resourcestring',
847 ' {#a_used}a = ''txt'';',
848 ' {#b_used}b = ''foo'';',
849 ' {#c_notused}c = ''bar'';',
850 'procedure {#DoIt_used}DoIt(s: string);',
851 'var',
852 ' {#d_used}d: string;',
853 'begin',
854 ' d:=b;',
855 'end;',
856 'begin',
857 ' DoIt(a);']);
858 AnalyzeProgram;
859 end;
860
861 procedure TTestUseAnalyzer.TestM_Record;
862 begin
863 StartProgram(false);
864 Add([
865 'procedure {#DoIt_used}DoIt;',
866 'type',
867 ' {#integer_used}integer = longint;',
868 ' {#trec_used}TRec = record',
869 ' {#a_used}a: integer;',
870 ' {#b_notused}b: integer;',
871 ' {#c_used}c: integer;',
872 ' end;',
873 'var',
874 ' {#r_used}r: TRec;',
875 'const',
876 ' ci = 2;',
877 ' cr: TRec = (a:0;b:ci;c:2);',
878 'begin',
879 ' r.a:=3;',
880 ' with r do c:=4;',
881 ' r:=cr;',
882 'end;',
883 'begin',
884 ' DoIt;']);
885 AnalyzeProgram;
886 end;
887
888 procedure TTestUseAnalyzer.TestM_RecordGeneric;
889 begin
890 StartProgram(false);
891 Add([
892 'procedure {#DoIt_used}DoIt;',
893 'type',
894 ' {#integer_used}integer = longint;',
895 ' {#number_used}number = word;',
896 ' generic {#trec_used}TRec<{#trec_t_notused}T> = record',
897 ' {#a_used}a: integer;',
898 ' {#b_notused}b: integer;',
899 ' {#c_used}c: T;',
900 ' end;',
901 'var',
902 ' {#r_used}r: specialize TRec<number>;',
903 'const',
904 ' ci = 2;',
905 ' cr: specialize TRec<number> = (a:0;b:ci;c:2);',
906 'begin',
907 ' r.a:=3;',
908 ' with r do c:=4;',
909 ' r:=cr;',
910 'end;',
911 'begin',
912 ' DoIt;']);
913 AnalyzeProgram;
914 end;
915
916 procedure TTestUseAnalyzer.TestM_PointerTyped_Record;
917 begin
918 StartProgram(false);
919 Add([
920 'procedure {#DoIt_used}DoIt;',
921 'type',
922 ' {#prec_used}PRec = ^TRec;',
923 ' {#trec_used}TRec = record',
924 ' {#a_used}a: longint;',
925 ' {#b_notused}b: longint;',
926 ' {#c_used}c: longint;',
927 ' {#d_used}d: longint;',
928 ' {#e_used}e: longint;',
929 ' end;',
930 'var',
931 ' r: TRec;',
932 ' p: PRec;',
933 ' i: longint;',
934 'begin',
935 ' p:=@r;',
936 ' i:=p^.a;',
937 ' p^.c:=i;',
938 ' if i=p^.d then;',
939 ' if p^.e=i then;',
940 'end;',
941 'begin',
942 ' DoIt;']);
943 AnalyzeProgram;
944 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "b" not used');
945 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
946 'Local variable "c" is assigned but never used');
947 CheckUseAnalyzerUnexpectedHints;
948 end;
949
950 procedure TTestUseAnalyzer.TestM_Array;
951 begin
952 StartProgram(false);
953 Add('procedure {#DoIt_used}DoIt;');
954 Add('type');
955 Add(' {#integer_used}integer = longint;');
956 Add(' {#tarrayint_used}TArrayInt = array of integer;');
957 Add('var');
958 Add(' {#a_used}a: TArrayInt;');
959 Add(' {#b_used}b: integer;');
960 Add(' {#c_used}c: TArrayInt;');
961 Add(' {#d_used}d: integer;');
962 Add(' {#e_used}e: TArrayInt;');
963 Add(' {#f_used}f: integer;');
964 Add(' {#g_used}g: TArrayInt;');
965 Add(' {#h_used}h: TArrayInt;');
966 Add(' {#i_used}i: TArrayInt;');
967 Add('begin');
968 Add(' a[b]:=c[d];');
969 Add(' SetLength(e,f);');
970 Add(' if low(g)=high(h)+length(i) then');
971 Add('end;');
972 Add('begin');
973 Add(' DoIt;');
974 AnalyzeProgram;
975 end;
976
977 procedure TTestUseAnalyzer.TestM_NestedFuncResult;
978 begin
979 StartProgram(false);
980 Add('procedure {#DoIt_used}DoIt;');
981 Add('type');
982 Add(' {#integer_used}integer = longint;');
983 Add(' {#tarrayint_used}TArrayInt = array of integer;');
984 Add(' function {#nestedfunc_used}NestedFunc({#b_notused}b: longint): TArrayInt;');
985 Add(' begin');
986 Add(' end;');
987 Add('var');
988 Add(' {#d_used}d: longint;');
989 Add('begin');
990 Add(' NestedFunc(d);');
991 Add('end;');
992 Add('begin');
993 Add(' DoIt;');
994 AnalyzeProgram;
995 end;
996
997 procedure TTestUseAnalyzer.TestM_Enums;
998 begin
999 StartProgram(false);
1000 Add('procedure {#DoIt_used}DoIt(const o);');
1001 Add('type');
1002 Add(' {#TEnum_used}TEnum = (red,blue);');
1003 Add(' {#TEnums_used}TEnums = set of TEnum;');
1004 Add('var');
1005 Add(' {#a_used}a: TEnum;');
1006 Add(' {#b_used}b: TEnums;');
1007 Add(' {#c_used}c: TEnum;');
1008 Add(' {#d_used}d: TEnums;');
1009 Add(' {#e_used}e: TEnums;');
1010 Add(' {#f_used}f: TEnums;');
1011 Add(' {#g_used}g: TEnum;');
1012 Add(' {#h_used}h: TEnum;');
1013 Add('begin');
1014 Add(' b:=[a];');
1015 Add(' if c in d then;');
1016 Add(' if low(e)=high(f) then;');
1017 Add(' if pred(g)=succ(h) then;');
1018 Add('end;');
1019 Add('var {#s_used}s: string;');
1020 Add('begin');
1021 Add(' DoIt(s);');
1022 AnalyzeProgram;
1023 end;
1024
1025 procedure TTestUseAnalyzer.TestM_ProcedureType;
1026 begin
1027 StartProgram(false);
1028 Add('procedure {#DoIt_used}DoIt;');
1029 Add('type');
1030 Add(' {#TProc_used}TProc = procedure;');
1031 Add(' {#TFunc_used}TFunc = function(): longint;');
1032 Add('var');
1033 Add(' {#p_used}p: TProc;');
1034 Add(' {#f_used}f: TFunc;');
1035 Add('begin');
1036 Add(' p:=nil;');
1037 Add(' f:=nil;');
1038 Add('end;');
1039 Add('begin');
1040 Add(' DoIt;');
1041 AnalyzeProgram;
1042 end;
1043
1044 procedure TTestUseAnalyzer.TestM_AnonymousProc;
1045 begin
1046 StartProgram(false);
1047 Add([
1048 'type',
1049 ' {#TProc_used}TProc = reference to procedure;',
1050 'procedure {#DoIt_used}DoIt;',
1051 'var',
1052 ' {#p_used}p: TProc;',
1053 ' {#i_used}i: longint;',
1054 'begin',
1055 ' p:=procedure',
1056 ' begin',
1057 ' i:=3;',
1058 ' end;',
1059 'end;',
1060 'begin',
1061 ' DoIt;']);
1062 AnalyzeProgram;
1063 end;
1064
1065 procedure TTestUseAnalyzer.TestM_Params;
1066 begin
1067 StartProgram(false);
1068 Add('procedure {#DoIt_used}DoIt(const o);');
1069 Add('type');
1070 Add(' {#TEnum_used}TEnum = (red,blue);');
1071 Add('var');
1072 Add(' {#a_used}a: longint;');
1073 Add(' {#b_used}b: string;');
1074 Add(' {#c_used}c: longint;');
1075 Add(' {#d_used}d: TEnum;');
1076 Add('begin');
1077 Add(' DoIt(a);');
1078 Add(' DoIt(b[c]);');
1079 Add(' DoIt([d]);');
1080 Add(' DoIt(red);');
1081 Add('end;');
1082 Add('var {#s_used}s: string;');
1083 Add('begin');
1084 Add(' DoIt(s);');
1085 AnalyzeProgram;
1086 end;
1087
1088 procedure TTestUseAnalyzer.TestM_Class;
1089 begin
1090 StartProgram(false);
1091 Add('type');
1092 Add(' {#integer_used}integer = longint;');
1093 Add(' {tobject_used}TObject = class');
1094 Add(' {#a_used}a: integer;');
1095 Add(' end;');
1096 Add('var Obj: TObject;');
1097 Add('begin');
1098 Add(' Obj.a:=3;');
1099 AnalyzeProgram;
1100 end;
1101
1102 procedure TTestUseAnalyzer.TestM_ClassForward;
1103 begin
1104 StartProgram(false);
1105 Add('type');
1106 Add(' {#integer_notused}integer = longint;');
1107 Add(' {#TObject_used}TObject = class end;');
1108 Add(' TFelidae = class;');
1109 Add(' {#TCheetah_used}TCheetah = class');
1110 Add(' public');
1111 Add(' {#i_notused}i: integer;');
1112 Add(' {#f_used}f: TFelidae;');
1113 Add(' end;');
1114 Add(' {TFelidae_used}TFelidae = class');
1115 Add(' end;');
1116 Add('var {#c_used}c: TCheetah;');
1117 Add('begin');
1118 Add(' c.f:=nil;');
1119 AnalyzeProgram;
1120 end;
1121
1122 procedure TTestUseAnalyzer.TestM_Class_Property;
1123 begin
1124 StartProgram(false);
1125 Add('type');
1126 Add(' {#integer_used}integer = longint;');
1127 Add(' {tobject_used}TObject = class');
1128 Add(' {#fa_used}Fa: integer;');
1129 Add(' {#fb_used}Fb: integer;');
1130 Add(' {#fc_used}Fc: integer;');
1131 Add(' {#fd_used}Fd: integer;');
1132 Add(' {#fe_notused}Fe: integer;');
1133 Add(' function {#getfc_used}GetFC: integer;');
1134 Add(' procedure {#setfd_used}SetFD({#setfd_value_used}Value: integer);');
1135 Add(' property {#A_used}A: integer read Fa write Fb;');
1136 Add(' property {#C_used}C: integer read GetFC write SetFD;');
1137 Add(' end;');
1138 Add('function TObject.GetFC: integer;');
1139 Add('begin');
1140 Add(' Result:=Fc;');
1141 Add('end;');
1142 Add('procedure TObject.SetFD({#setfd_value_impl_notused}Value: integer);');
1143 Add('begin');
1144 Add(' Fd:=Value;');
1145 Add('end;');
1146 Add('var Obj: TObject;');
1147 Add('begin');
1148 Add(' Obj.A:=Obj.A;');
1149 Add(' Obj.C:=Obj.C;');
1150 AnalyzeProgram;
1151 end;
1152
1153 procedure TTestUseAnalyzer.TestM_Class_PropertyProtected;
1154 begin
1155 StartUnit(false);
1156 Add([
1157 'interface',
1158 'type',
1159 ' {#integer_used}integer = longint;',
1160 ' {tobject_used}TObject = class',
1161 ' private',
1162 ' {#fb_used}Fb: integer;',
1163 ' {#fc_used}Fc: integer;',
1164 ' {#fd_used}Fd: integer;',
1165 ' {#fe_notused}Fe: integer;',
1166 ' function {#iscstored_used}IsCStored: boolean;',
1167 ' protected',
1168 ' property {#C_used}C: integer read FC write FD stored IsCStored;',
1169 ' end;',
1170 'implementation',
1171 'function TObject.IsCStored: boolean;',
1172 'begin',
1173 ' Result:=Fb<>0;',
1174 'end;']);
1175 AnalyzeUnit;
1176 end;
1177
1178 procedure TTestUseAnalyzer.TestM_Class_PropertyOverride;
1179 begin
1180 StartProgram(false);
1181 Add('type');
1182 Add(' {#integer_used}integer = longint;');
1183 Add(' {tobject_used}TObject = class');
1184 Add(' {#fa_used}FA: integer;');
1185 Add(' {#fb_notused}FB: integer;');
1186 Add(' property {#obj_a_notused}A: integer read FA write FB;');
1187 Add(' end;');
1188 Add(' {tmobile_used}TMobile = class(TObject)');
1189 Add(' {#fc_used}FC: integer;');
1190 Add(' property {#mob_a_used}A write FC;');
1191 Add(' end;');
1192 Add('var {#m_used}M: TMobile;');
1193 Add('begin');
1194 Add(' M.A:=M.A;');
1195 AnalyzeProgram;
1196 end;
1197
1198 procedure TTestUseAnalyzer.TestM_Class_MethodOverride;
1199 begin
1200 StartProgram(false);
1201 Add('type');
1202 Add(' {tobject_used}TObject = class');
1203 Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
1204 Add(' procedure {#obj_dob_notused}DoB; virtual; abstract;');
1205 Add(' end;');
1206 Add(' {tmobile_used}TMobile = class(TObject)');
1207 Add(' constructor {#mob_create_used}Create;');
1208 Add(' procedure {#mob_doa_used}DoA; override;');
1209 Add(' procedure {#mob_dob_used}DoB; override;');
1210 Add(' end;');
1211 Add('constructor TMobile.Create; begin end;');
1212 Add('procedure TMobile.DoA; begin end;');
1213 Add('procedure TMobile.DoB; begin end;');
1214 Add('var {#o_used}o: TObject;');
1215 Add('begin');
1216 Add(' o:=TMobile.Create;'); // use TMobile before o.DoA
1217 Add(' o.DoA;');
1218 AnalyzeProgram;
1219 end;
1220
1221 procedure TTestUseAnalyzer.TestM_Class_MethodOverride2;
1222 begin
1223 StartProgram(false);
1224 Add('type');
1225 Add(' {#tobject_used}TObject = class');
1226 Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
1227 Add(' end;');
1228 Add(' {#tmobile_used}TMobile = class(TObject)');
1229 Add(' constructor {#mob_create_used}Create;');
1230 Add(' procedure {#mob_doa_used}DoA; override;');
1231 Add(' end;');
1232 Add('constructor TMobile.Create; begin end;');
1233 Add('procedure TMobile.DoA; begin end;');
1234 Add('var {#o_used}o: TObject;');
1235 Add('begin');
1236 Add(' o.DoA;');
1237 Add(' o:=TMobile.Create;'); // use TMobile after o.DoA
1238 AnalyzeProgram;
1239 end;
1240
1241 procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
1242 begin
1243 StartProgram(false);
1244 Add([
1245 '{$interfaces corba}',
1246 'type',
1247 ' {#iunknown_used}IUnknown = interface',
1248 ' procedure {#iunknown_run_used}Run;',
1249 ' procedure {#iunknown_walk_notused}Walk;',
1250 ' end;',
1251 ' {#tobject_used}TObject = class',
1252 ' end;',
1253 ' {#tbird_used}TBird = class(TObject,IUnknown)',
1254 ' strict private',
1255 ' procedure IUnknown.Run = Fly;',
1256 ' procedure {#tbird_fly_used}Fly; virtual; abstract;',
1257 ' procedure {#tbird_walk_used}Walk; virtual; abstract;',
1258 ' end;',
1259 ' {#teagle_used}TEagle = class(TBird)',
1260 ' strict private',
1261 ' procedure {#teagle_fly_used}Fly; override;',
1262 ' procedure {#teagle_walk_used}Walk; override;',
1263 ' end;',
1264 'procedure TEagle.Fly; begin end;',
1265 'procedure TEagle.Walk; begin end;',
1266 'var',
1267 ' e: TEagle;',
1268 ' i: IUnknown;',
1269 'begin',
1270 ' i:=e;',
1271 ' i.Run;',
1272 '']);
1273 AnalyzeProgram;
1274 end;
1275
1276 procedure TTestUseAnalyzer.TestM_ClassInterface_NoHintsForMethod;
1277 begin
1278 StartUnit(false);
1279 Add([
1280 '{$interfaces corba}',
1281 'interface',
1282 'type',
1283 ' {#iunknown_used}IUnknown = interface',
1284 ' procedure {#iunknown_run_used}Run(i: longint);',
1285 ' function {#iunknown_walk_used}Walk: boolean;',
1286 ' end;',
1287 'implementation',
1288 '']);
1289 AnalyzeUnit;
1290 CheckUseAnalyzerUnexpectedHints;
1291 end;
1292
1293 procedure TTestUseAnalyzer.TestM_ClassInterface_NoHintsForImpl;
1294 begin
1295 AddModuleWithIntfImplSrc('unit2.pp',
1296 LinesToStr([
1297 '{$interfaces corba}',
1298 'type',
1299 ' IBird = interface',
1300 ' procedure DoIt;',
1301 ' end;',
1302 '']),
1303 LinesToStr([
1304 '']));
1305
1306 StartUnit(true);
1307 Add([
1308 '{$interfaces corba}',
1309 'interface',
1310 'uses unit2;',
1311 'type',
1312 ' {#tobject_used}TObject = class(IBird)',
1313 ' strict private',
1314 ' procedure {#tobject_doit_used}DoIt;',
1315 ' end;',
1316 'implementation',
1317 'procedure TObject.DoIt; begin end;',
1318 '']);
1319 AnalyzeUnit;
1320 CheckUseAnalyzerUnexpectedHints;
1321 end;
1322
1323 procedure TTestUseAnalyzer.TestM_ClassInterface_Delegation;
1324 begin
1325 StartProgram(false);
1326 Add([
1327 '{$interfaces corba}',
1328 'type',
1329 ' {#iunknown_used}IUnknown = interface',
1330 ' procedure {#iunknown_run_used}Run;',
1331 ' procedure {#iunknown_walk_notused}Walk;',
1332 ' end;',
1333 ' {#tobject_used}TObject = class',
1334 ' end;',
1335 ' {#tbird_used}TBird = class(TObject,IUnknown)',
1336 ' strict private',
1337 ' procedure IUnknown.Run = Fly;',
1338 ' procedure {#tbird_fly_used}Fly;',
1339 ' procedure {#tbird_walk_used}Walk;',
1340 ' end;',
1341 ' {#teagle_used}TEagle = class(TObject,IUnknown)',
1342 ' strict private',
1343 ' {#teagle_fbird_used}FBird: TBird;',
1344 ' property {#teagle_bird_used}Bird: TBird read FBird implements IUnknown;',
1345 ' end;',
1346 'procedure TBird.Fly; begin end;',
1347 'procedure TBird.Walk; begin end;',
1348 'var',
1349 ' e: TEagle;',
1350 ' i: IUnknown;',
1351 'begin',
1352 ' i:=e;',
1353 ' i.Run;',
1354 '']);
1355 AnalyzeProgram;
1356 end;
1357
1358 procedure TTestUseAnalyzer.TestM_ClassInterface_COM;
1359 begin
1360 StartProgram(false);
1361 Add([
1362 '{$interfaces com}',
1363 'type',
1364 ' {#tguid_used}TGuid = string;',
1365 ' {#integer_used}integer = longint;',
1366 ' {#iunknown_used}IUnknown = interface',
1367 ' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
1368 ' function {#iunknown_addref_used}_AddRef: Integer;',
1369 ' function {#iunknown_release_used}_Release: Integer;',
1370 ' procedure {#iunknown_doit_notused}DoIt;',
1371 ' end;',
1372 ' {#tobject_used}TObject = class',
1373 ' end;',
1374 ' {#tbird_used}TBird = class(TObject,IUnknown)',
1375 ' strict private',
1376 ' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
1377 ' function {#tbird_addref_used}_AddRef: Integer;',
1378 ' function {#tbird_release_used}_Release: Integer;',
1379 ' procedure {#tbird_doit_used}DoIt;',
1380 ' end;',
1381 ' {#teagle_used}TEagle = class(TBird)',
1382 ' end;',
1383 'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
1384 'begin',
1385 ' if iid='''' then obj:=nil;',
1386 ' Result:=0;',
1387 'end;',
1388 'function TBird._AddRef: Integer; begin Result:=1; end;',
1389 'function TBird._Release: Integer; begin Result:=2; end;',
1390 'procedure TBird.DoIt; begin end;',
1391 'var',
1392 ' e: TEagle;',
1393 ' i: IUnknown;',
1394 'begin',
1395 ' i:=e;',
1396 ' if i=nil then ;',
1397 '']);
1398 AnalyzeProgram;
1399 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
1400 CheckUseAnalyzerUnexpectedHints;
1401 end;
1402
1403 procedure TTestUseAnalyzer.TestM_TryExceptStatement;
1404 begin
1405 StartProgram(false);
1406 Add('type');
1407 Add(' {tobject_used}TObject = class');
1408 Add(' constructor Create; external name ''create'';');
1409 Add(' end;');
1410 Add(' {texception_used}Exception = class(TObject);');
1411 Add(' {tdivbyzero_used}EDivByZero = class(Exception);');
1412 Add('procedure {#DoIt_used}DoIt;');
1413 Add('var');
1414 Add(' {#a_used}a: Exception;');
1415 Add(' {#b_used}b: Exception;');
1416 Add(' {#c_used}c: Exception;');
1417 Add(' {#d_used}d: Exception;');
1418 Add(' {#f_used}f: Exception;');
1419 Add('begin');
1420 Add(' try');
1421 Add(' a:=nil;');
1422 Add(' except');
1423 Add(' raise b;');
1424 Add(' end;');
1425 Add(' try');
1426 Add(' if Assigned(c) then ;');
1427 Add(' except');
1428 Add(' on {#e1_used}E1: Exception do raise;');
1429 Add(' on {#e2_notused}E2: EDivByZero do raise d;');
1430 Add(' else f:=nil;');
1431 Add(' end;');
1432 Add('end;');
1433 Add('begin');
1434 Add(' DoIt;');
1435 AnalyzeProgram;
1436 end;
1437
1438 procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed;
1439 begin
1440 AddModuleWithIntfImplSrc('unit2.pp',
1441 LinesToStr([
1442 'var i: longint;',
1443 'procedure DoIt;',
1444 '']),
1445 LinesToStr([
1446 'procedure DoIt; begin end;']));
1447
1448 StartProgram(true);
1449 Add('uses unit2;');
1450 Add('begin');
1451 AnalyzeProgram;
1452 CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
1453 CheckUseAnalyzerUnexpectedHints;
1454 end;
1455
1456 procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
1457 begin
1458 AddModuleWithIntfImplSrc('unit2.pp',
1459 LinesToStr([
1460 'var State: longint; external name ''state'';',
1461 'procedure DoIt; external name ''doing'';',
1462 '']),
1463 LinesToStr([
1464 ]));
1465
1466 StartProgram(true);
1467 Add('uses unit2;');
1468 Add('begin');
1469 Add(' State:=3;');
1470 Add(' DoIt;');
1471 AnalyzeProgram;
1472
1473 // unit hints: no hint, even though no code is actually used
1474 CheckUseAnalyzerUnexpectedHints;
1475 end;
1476
1477 procedure TTestUseAnalyzer.TestM_Hint_UnitUsed;
1478 begin
1479 AddModuleWithIntfImplSrc('unit2.pp',
1480 LinesToStr([
1481 'var i: longint;',
1482 '']),
1483 LinesToStr(['']));
1484
1485 StartProgram(true);
1486 Add('uses unit2;');
1487 Add('begin');
1488 Add(' i:=3;');
1489 AnalyzeProgram;
1490 CheckUseAnalyzerUnexpectedHints;
1491 end;
1492
1493 procedure TTestUseAnalyzer.TestM_Hint_UnitUsedVarArgs;
1494 begin
1495 AddModuleWithIntfImplSrc('unit2.pp',
1496 LinesToStr([
1497 'var i: longint;',
1498 '']),
1499 LinesToStr(['']));
1500
1501 StartProgram(true);
1502 Add('uses unit2;');
1503 Add('procedure Writeln(); varargs;');
1504 Add('begin end;');
1505 Add('begin');
1506 Add(' writeln(i);');
1507 AnalyzeProgram;
1508 CheckUseAnalyzerUnexpectedHints;
1509 end;
1510
1511 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
1512 begin
1513 StartProgram(true);
1514 Add('procedure DoIt(i: longint);');
1515 Add('begin end;');
1516 Add('begin');
1517 Add(' DoIt(1);');
1518 AnalyzeProgram;
1519 CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
1520 CheckUseAnalyzerUnexpectedHints;
1521 end;
1522
1523 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedOff;
1524 begin
1525 StartProgram(true);
1526 Add('{$warn '+IntToStr(nPAParameterNotUsed)+' off}');
1527 Add('procedure DoIt(i: longint);');
1528 Add('begin end;');
1529 Add('begin');
1530 Add(' DoIt(1);');
1531 AnalyzeProgram;
1532 CheckUseAnalyzerUnexpectedHints;
1533 end;
1534
1535 procedure TTestUseAnalyzer.TestM_Hint_ParameterInOverrideNotUsed;
1536 begin
1537 StartProgram(true);
1538 Add([
1539 'type',
1540 ' TObject = class',
1541 ' procedure DoIt(i: longint); virtual;',
1542 ' end;',
1543 ' TBird = class',
1544 ' procedure DoIt(j: longint); override;',
1545 ' end;',
1546 'procedure TObject.DoIt(i: longint);',
1547 'begin',
1548 'end;',
1549 'procedure TBird.DoIt(j: longint);',
1550 'begin',
1551 'end;',
1552 'var b: TBird;',
1553 'begin',
1554 ' TObject(b).DoIt(1);']);
1555 AnalyzeProgram;
1556 CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "i" not used');
1557 CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "j" not used');
1558 CheckUseAnalyzerUnexpectedHints;
1559 end;
1560
1561 procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
1562 begin
1563 StartUnit(false);
1564 Add([
1565 'interface',
1566 'procedure DoIt(i: longint);',
1567 'implementation',
1568 'procedure DoIt(i: longint);',
1569 'begin',
1570 '{$Hints off}',
1571 'end;',
1572 'begin',
1573 ' DoIt(3);']);
1574 AnalyzeUnit;
1575 CheckUseAnalyzerUnexpectedHints;
1576 end;
1577
1578 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
1579 begin
1580 StartProgram(true);
1581 Add('type');
1582 Add(' TObject = class');
1583 Add(' class procedure DoIt(i: longint); virtual; abstract;');
1584 Add(' end;');
1585 Add('begin');
1586 Add(' TObject.DoIt(3);');
1587 AnalyzeProgram;
1588 CheckUseAnalyzerUnexpectedHints;
1589 end;
1590
1591 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
1592 begin
1593 StartProgram(true);
1594 Add('type');
1595 Add(' TObject = class end;');
1596 Add(' TSortCompare = function(a,b: Pointer): integer;');
1597 Add(' TObjCompare = function(a,b: TObject): integer;');
1598 Add('procedure Sort(const Compare: TSortCompare);');
1599 Add('begin');
1600 Add(' Compare(nil,nil);');
1601 Add('end;');
1602 Add('procedure DoIt(const Compare: TObjCompare);');
1603 Add('begin');
1604 Add(' Sort(TSortCompare(Compare));');
1605 Add('end;');
1606 Add('begin');
1607 Add(' DoIt(nil);');
1608 AnalyzeProgram;
1609 CheckUseAnalyzerUnexpectedHints;
1610 end;
1611
1612 procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
1613 begin
1614 StartProgram(true);
1615 Add('procedure DoIt(out x: longint);');
1616 Add('begin');
1617 Add(' x:=3;');
1618 Add('end;');
1619 Add('var i: longint;');
1620 Add('begin');
1621 Add(' DoIt(i);');
1622 AnalyzeProgram;
1623 CheckUseAnalyzerUnexpectedHints;
1624 end;
1625
1626 procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
1627 begin
1628 StartProgram(false);
1629 Add([
1630 'procedure AssertTrue(b: boolean);',
1631 'begin',
1632 ' if b then ;',
1633 'end;',
1634 'procedure AssertFalse(b: boolean);',
1635 'begin',
1636 ' AssertTrue(not b);',
1637 'end;',
1638 'begin',
1639 ' AssertFalse(true);',
1640 '']);
1641 AnalyzeProgram;
1642 CheckUseAnalyzerUnexpectedHints;
1643 end;
1644
1645 procedure TTestUseAnalyzer.TestM_Hint_ArrayArg_No_ParameterNotUsed;
1646 begin
1647 StartProgram(false);
1648 Add([
1649 'type TArr = array of boolean;',
1650 'procedure Fly(a: TArr);',
1651 'begin',
1652 ' a[1]:=true;',
1653 'end;',
1654 'begin',
1655 ' Fly(nil);',
1656 '']);
1657 AnalyzeProgram;
1658 CheckUseAnalyzerUnexpectedHints;
1659 end;
1660
1661 procedure TTestUseAnalyzer.TestM_Hint_ArrayArg_No_ParameterNotUsed2;
1662 begin
1663 StartProgram(false);
1664 Add([
1665 'type {#Tarr_used}TArr = array of boolean;',
1666 'procedure {#Run_used}Run({#b_used}b: boolean);',
1667 'begin',
1668 ' if b then ;',
1669 'end;',
1670 'procedure {#Fly_used}Fly({#a_used}a: TArr);',
1671 'begin',
1672 ' Run(a[1]);',
1673 'end;',
1674 'begin',
1675 ' Fly(nil);',
1676 '']);
1677 AnalyzeProgram;
1678 CheckUseAnalyzerUnexpectedHints;
1679 end;
1680
1681 procedure TTestUseAnalyzer.TestM_Hint_InheritedWithoutParams;
1682 begin
1683 StartProgram(false);
1684 Add([
1685 'type',
1686 ' TObject = class',
1687 ' constructor Create(i: longint); virtual;',
1688 ' end;',
1689 ' TBird = class',
1690 ' constructor Create(i: longint); override;',
1691 ' end;',
1692 'constructor TObject.Create(i: longint);',
1693 'begin',
1694 ' if i=0 then ;',
1695 'end;',
1696 'constructor TBird.Create(i: longint);',
1697 'begin',
1698 ' inherited;',
1699 'end;',
1700 'begin',
1701 ' TBird.Create(3);']);
1702 AnalyzeProgram;
1703 CheckUseAnalyzerUnexpectedHints;
1704 end;
1705
1706 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
1707 begin
1708 StartProgram(true);
1709 Add([
1710 'procedure DoIt;',
1711 'const',
1712 ' a = 13;',
1713 ' b: longint = 14;',
1714 'var',
1715 ' c: char;',
1716 ' d: longint = 15;',
1717 'begin',
1718 'end;',
1719 'begin',
1720 ' DoIt;']);
1721 AnalyzeProgram;
1722 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
1723 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
1724 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
1725 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
1726 CheckUseAnalyzerUnexpectedHints;
1727 end;
1728
1729 procedure TTestUseAnalyzer.TestM_HintsOff_LocalVariableNotUsed;
1730 begin
1731 StartProgram(true);
1732 Add([
1733 'procedure DoIt;',
1734 'const',
1735 ' a = 13;',
1736 ' b: longint = 14;',
1737 'var',
1738 ' c: char;',
1739 ' d: longint = 15;',
1740 'begin',
1741 '{$Hints off}',
1742 'end;',
1743 'begin',
1744 ' DoIt;']);
1745 AnalyzeProgram;
1746 CheckUseAnalyzerUnexpectedHints;
1747 end;
1748
1749 procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
1750 begin
1751 StartProgram(false);
1752 Add([
1753 'procedure DoIt;',
1754 'var i: longint;',
1755 'begin',
1756 ' for i:=1 to 2 do ;',
1757 'end;',
1758 'begin',
1759 ' DoIt;',
1760 '']);
1761 AnalyzeProgram;
1762 CheckUseAnalyzerUnexpectedHints;
1763 end;
1764
1765 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
1766 begin
1767 StartUnit(true);
1768 Add('interface');
1769 Add('const {#a_used}a = 1;');
1770 Add('const {#b_used}b: longint = 2;');
1771 Add('var {#c_used}c: longint = 3;');
1772 Add('type');
1773 Add(' {#TColor_used}TColor = longint;');
1774 Add(' {#TFlag_used}TFlag = (red,green);');
1775 Add(' {#TFlags_used}TFlags = set of TFlag;');
1776 Add(' {#TArrInt_used}TArrInt = array of integer;');
1777 Add('implementation');
1778 Add('const {#d_notused}d = 1;');
1779 Add('const {#e_notused}e: longint = 2;');
1780 Add('var {#f_notused}f: longint = 3;');
1781 Add('type');
1782 Add(' {#ImpTColor_notused}ImpTColor = longint;');
1783 Add(' {#ImpTFlag_notused}ImpTFlag = (red,green);');
1784 Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
1785 Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
1786 AnalyzeUnit;
1787 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
1788 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
1789 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
1790 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
1791 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
1792 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
1793 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
1794 CheckUseAnalyzerUnexpectedHints;
1795 end;
1796
1797 procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
1798 begin
1799 StartProgram(true);
1800 Add('procedure DoIt(i: longint);');
1801 Add('begin');
1802 Add(' i:=3;');
1803 Add('end;');
1804 Add('begin');
1805 Add(' DoIt(1);');
1806 AnalyzeProgram;
1807 CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
1808 'Value parameter "i" is assigned but never used');
1809 CheckUseAnalyzerUnexpectedHints;
1810 end;
1811
1812 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
1813 begin
1814 StartProgram(true);
1815 Add('procedure DoIt;');
1816 Add('const');
1817 Add(' a: longint = 14;');
1818 Add('var');
1819 Add(' b: char;');
1820 Add(' c: longint = 15;');
1821 Add('begin');
1822 Add(' a:=16;');
1823 Add(' b:=#65;');
1824 Add(' c:=17;');
1825 Add('end;');
1826 Add('begin');
1827 Add(' DoIt;');
1828 AnalyzeProgram;
1829 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
1830 'Local variable "a" is assigned but never used');
1831 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
1832 'Local variable "b" is assigned but never used');
1833 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
1834 'Local variable "c" is assigned but never used');
1835 CheckUseAnalyzerUnexpectedHints;
1836 end;
1837
1838 procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
1839 begin
1840 StartProgram(true);
1841 Add('procedure DoIt;');
1842 Add('type');
1843 Add(' TColor = longint;');
1844 Add(' TFlag = (red,green);');
1845 Add(' TFlags = set of TFlag;');
1846 Add(' TArrInt = array of integer;');
1847 Add(' procedure Sub; begin end;');
1848 Add('begin');
1849 Add('end;');
1850 Add('begin');
1851 Add(' DoIt;');
1852 AnalyzeProgram;
1853 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
1854 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
1855 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
1856 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
1857 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
1858 CheckUseAnalyzerUnexpectedHints;
1859 end;
1860
1861 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
1862 begin
1863 StartProgram(true,[supTObject]);
1864 Add('type');
1865 Add(' TMobile = class');
1866 Add(' private');
1867 Add(' a: longint;');
1868 Add(' end;');
1869 Add('var m: TMobile;');
1870 Add('begin');
1871 Add(' m:=nil;');
1872 AnalyzeProgram;
1873 CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
1874 'Private field "TMobile.a" is never used');
1875 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
1876 'Local variable "m" is assigned but never used');
1877 CheckUseAnalyzerUnexpectedHints;
1878 end;
1879
1880 procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
1881 begin
1882 StartProgram(true,[supTObject]);
1883 Add('type');
1884 Add(' TMobile = class');
1885 Add(' private');
1886 Add(' a: longint;');
1887 Add(' public');
1888 Add(' constructor Create;');
1889 Add(' end;');
1890 Add('constructor TMobile.Create;');
1891 Add('begin');
1892 Add(' a:=3;');
1893 Add('end;');
1894 Add('begin');
1895 Add(' TMobile.Create;');
1896 AnalyzeProgram;
1897 CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
1898 'Private field "TMobile.a" is assigned but never used');
1899 CheckUseAnalyzerUnexpectedHints;
1900 end;
1901
1902 procedure TTestUseAnalyzer.
1903 TestM_Hint_PrivateFieldExtClassNoIsAssignedButNeverUsed;
1904 begin
1905 StartProgram(false,[]);
1906 Add([
1907 '{$modeswitch externalclass}',
1908 'type',
1909 ' TMobile = class external name ''foo''',
1910 ' private',
1911 ' FA: longint;',
1912 ' public',
1913 ' property A: longint write FA;',
1914 ' end;',
1915 'var m: TMobile;',
1916 'begin',
1917 ' m.A:=3;',
1918 '']);
1919 AnalyzeProgram;
1920 CheckUseAnalyzerUnexpectedHints;
1921 end;
1922
1923 procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
1924 begin
1925 StartProgram(true,[supTObject]);
1926 Add('type');
1927 Add(' TMobile = class');
1928 Add(' private');
1929 Add(' procedure DoSome; external name ''foo'';');
1930 Add(' public');
1931 Add(' constructor Create;');
1932 Add(' end;');
1933 Add('constructor TMobile.Create;');
1934 Add('begin');
1935 Add('end;');
1936 Add('begin');
1937 Add(' TMobile.Create;');
1938 AnalyzeProgram;
1939 CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
1940 'Private method "TMobile.DoSome" is never used');
1941 CheckUseAnalyzerUnexpectedHints;
1942 end;
1943
1944 procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
1945 begin
1946 StartProgram(true,[supTObject]);
1947 Add('type');
1948 Add(' TMobile = class');
1949 Add(' private');
1950 Add(' public');
1951 Add(' constructor Create;');
1952 Add(' destructor Destroy; override;');
1953 Add(' end;');
1954 Add('var DestroyCount: longint = 0;');
1955 Add('constructor TMobile.Create;');
1956 Add('begin');
1957 Add('end;');
1958 Add('destructor TMobile.Destroy;');
1959 Add('begin');
1960 Add(' inc(DestroyCount);');
1961 Add(' inherited;');
1962 Add('end;');
1963 Add('var o: TObject;');
1964 Add('begin');
1965 Add(' o:=TMobile.Create;');
1966 Add(' o.Destroy;');
1967 AnalyzeProgram;
1968 CheckUseAnalyzerUnexpectedHints;
1969 end;
1970
1971 procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
1972 begin
1973 StartProgram(true,[supTObject]);
1974 Add('type');
1975 Add(' TMobile = class');
1976 Add(' private');
1977 Add(' type t = longint;');
1978 Add(' public');
1979 Add(' constructor Create;');
1980 Add(' end;');
1981 Add('constructor TMobile.Create;');
1982 Add('begin');
1983 Add('end;');
1984 Add('begin');
1985 Add(' TMobile.Create;');
1986 AnalyzeProgram;
1987 CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
1988 'Private type "TMobile.t" never used');
1989 CheckUseAnalyzerUnexpectedHints;
1990 end;
1991
1992 procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
1993 begin
1994 StartProgram(true,[supTObject]);
1995 Add('type');
1996 Add(' TMobile = class');
1997 Add(' private');
1998 Add(' const c = 3;');
1999 Add(' public');
2000 Add(' constructor Create;');
2001 Add(' end;');
2002 Add('constructor TMobile.Create;');
2003 Add('begin');
2004 Add('end;');
2005 Add('begin');
2006 Add(' TMobile.Create;');
2007 AnalyzeProgram;
2008 CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
2009 'Private const "TMobile.c" never used');
2010 CheckUseAnalyzerUnexpectedHints;
2011 end;
2012
2013 procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
2014 begin
2015 StartProgram(true,[supTObject]);
2016 Add('type');
2017 Add(' TMobile = class');
2018 Add(' private');
2019 Add(' FA: longint;');
2020 Add(' property A: longint read FA;');
2021 Add(' public');
2022 Add(' constructor Create;');
2023 Add(' end;');
2024 Add('constructor TMobile.Create;');
2025 Add('begin');
2026 Add('end;');
2027 Add('begin');
2028 Add(' TMobile.Create;');
2029 AnalyzeProgram;
2030 CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
2031 'Private property "TMobile.A" never used');
2032 CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
2033 'Private field "TMobile.FA" is never used');
2034 CheckUseAnalyzerUnexpectedHints;
2035 end;
2036
2037 procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
2038 begin
2039 StartProgram(true,[supTObject]);
2040 Add('type');
2041 Add(' TMobile = class');
2042 Add(' public');
2043 Add(' constructor Create;');
2044 Add(' end;');
2045 Add('constructor TMobile.Create;');
2046 Add('begin');
2047 Add('end;');
2048 Add('var');
2049 Add(' m: TMobile;');
2050 Add('begin');
2051 AnalyzeProgram;
2052 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
2053 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
2054 CheckUseAnalyzerUnexpectedHints;
2055 end;
2056
2057 procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
2058 begin
2059 StartProgram(true,[supTObject]);
2060 Add('type');
2061 Add(' TMobile = class');
2062 Add(' public');
2063 Add(' constructor Create;');
2064 Add(' end;');
2065 Add('constructor TMobile.Create;');
2066 Add('begin');
2067 Add('end;');
2068 Add('var');
2069 Add(' m: TMobile;');
2070 Add('begin');
2071 Add(' if m=nil then ;');
2072 AnalyzeProgram;
2073 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
2074 CheckUseAnalyzerUnexpectedHints;
2075 end;
2076
2077 procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedProc;
2078 begin
2079 StartProgram(true,[]);
2080 Add('type');
2081 Add('procedure DoIt;');
2082 Add('var i: longint;');
2083 Add('begin');
2084 Add('end;');
2085 Add('begin');
2086 AnalyzeProgram;
2087 CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
2088 CheckUseAnalyzerUnexpectedHints;
2089 end;
2090
2091 procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedMethod;
2092 begin
2093 StartProgram(true,[supTObject]);
2094 Add('type');
2095 Add(' TMobile = class');
2096 Add(' private');
2097 Add(' procedure DoIt;');
2098 Add(' end;');
2099 Add('procedure TMobile.DoIt;');
2100 Add('var i: longint;');
2101 Add('begin');
2102 Add('end;');
2103 Add('var');
2104 Add(' m: TMobile;');
2105 Add('begin');
2106 Add(' if m=nil then ;');
2107 AnalyzeProgram;
2108 CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,'Private method "TMobile.DoIt" is never used');
2109 CheckUseAnalyzerUnexpectedHints;
2110 end;
2111
2112 procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
2113 begin
2114 StartProgram(true);
2115 Add('procedure DoIt(i: longint); assembler;');
2116 Add('type');
2117 Add(' {#tcolor_notused}TColor = longint;');
2118 Add(' {#tflag_notused}TFlag = (red,green);');
2119 Add(' {#tflags_notused}TFlags = set of TFlag;');
2120 Add(' {#tarrint_notused}TArrInt = array of integer;');
2121 Add('const');
2122 Add(' {#a_notused}a = 13;');
2123 Add(' {#b_notused}b: longint = 14;');
2124 Add('var');
2125 Add(' {#c_notused}c: char;');
2126 Add(' {#d_notused}d: longint = 15;');
2127 Add(' procedure {#sub_notused}Sub; begin end;');
2128 Add('asm end;');
2129 Add('begin');
2130 Add(' DoIt(1);');
2131 AnalyzeProgram;
2132 CheckUseAnalyzerUnexpectedHints;
2133 end;
2134
2135 procedure TTestUseAnalyzer.TestM_Hint_AssemblerDelphiParameterIgnored;
2136 begin
2137 StartProgram(true);
2138 Add([
2139 '{$mode Delphi}',
2140 'procedure DoIt(i: longint);',
2141 'type',
2142 ' {#tcolor_notused}TColor = longint;',
2143 ' {#tflag_notused}TFlag = (red,green);',
2144 ' {#tflags_notused}TFlags = set of TFlag;',
2145 ' {#tarrint_notused}TArrInt = array of integer;',
2146 'const',
2147 ' {#a_notused}a = 13;',
2148 ' {#b_notused}b: longint = 14;',
2149 'var',
2150 ' {#c_notused}c: char;',
2151 ' {#d_notused}d: longint = 15;',
2152 ' procedure {#sub_notused}Sub; begin end;',
2153 'asm end;',
2154 'begin',
2155 ' DoIt(1);',
2156 '']);
2157 AnalyzeProgram;
2158 CheckUseAnalyzerUnexpectedHints;
2159 end;
2160
2161 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
2162 begin
2163 StartProgram(true);
2164 Add('function DoIt: longint;');
2165 Add('begin end;');
2166 Add('begin');
2167 Add(' DoIt();');
2168 AnalyzeProgram;
2169 CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
2170 sPAFunctionResultDoesNotSeemToBeSet);
2171 CheckUseAnalyzerUnexpectedHints;
2172 end;
2173
2174 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
2175 begin
2176 StartProgram(true);
2177 Add('type');
2178 Add(' TObject = class');
2179 Add(' class function DoIt: longint; virtual; abstract;');
2180 Add(' end;');
2181 Add('begin');
2182 Add(' TObject.DoIt;');
2183 AnalyzeProgram;
2184 CheckUseAnalyzerUnexpectedHints;
2185 end;
2186
2187 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
2188 begin
2189 StartProgram(true);
2190 Add('type');
2191 Add(' TPoint = record X,Y:longint; end;');
2192 Add('function Point(Left: longint): TPoint;');
2193 Add('begin');
2194 Add(' Result.X:=Left;');
2195 Add('end;');
2196 Add('begin');
2197 Add(' Point(1);');
2198 AnalyzeProgram;
2199 CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
2200 'Local variable "X" is assigned but never used');
2201 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
2202 CheckUseAnalyzerUnexpectedHints;
2203 end;
2204
2205 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecordEmpty;
2206 begin
2207 StartProgram(true);
2208 Add([
2209 '{$modeswitch AdvancedRecords}',
2210 'type',
2211 ' TEmpty = record',
2212 ' class function Create: TEmpty; static;',
2213 ' end;',
2214 'class function TEmpty.Create: TEmpty;',
2215 'begin',
2216 'end;',
2217 'begin',
2218 ' TEmpty.Create;',
2219 '']);
2220 AnalyzeProgram;
2221 CheckUseAnalyzerUnexpectedHints;
2222 end;
2223
2224 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
2225 begin
2226 StartProgram(true);
2227 Add('type');
2228 Add(' TPoint = record X,Y:longint; end;');
2229 Add('procedure Three(out x: longint);');
2230 Add('begin');
2231 Add(' x:=3;');
2232 Add('end;');
2233 Add('function Point(): TPoint;');
2234 Add('begin');
2235 Add(' Three(Result.X)');
2236 Add('end;');
2237 Add('begin');
2238 Add(' Point();');
2239 AnalyzeProgram;
2240 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
2241 CheckUseAnalyzerUnexpectedHints;
2242 end;
2243
2244 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultAssembler;
2245 begin
2246 StartProgram(false);
2247 Add([
2248 'function GetIt: longint; assembler;',
2249 'asm',
2250 'end;',
2251 'begin',
2252 ' GetIt;']);
2253 AnalyzeProgram;
2254 CheckUseAnalyzerUnexpectedHints;
2255 end;
2256
2257 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultExit;
2258 begin
2259 StartProgram(false);
2260 Add([
2261 'function GetIt: longint;',
2262 'begin',
2263 ' exit(3);',
2264 'end;',
2265 'begin',
2266 ' GetIt;']);
2267 AnalyzeProgram;
2268 CheckUseAnalyzerUnexpectedHints;
2269 end;
2270
2271 procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
2272 begin
2273 StartProgram(false);
2274 Add([
2275 'procedure {#DoIt_used}DoIt({#p_used}p: pointer);',
2276 'var',
2277 ' {#i_used}i: longint absolute p;',
2278 ' {#j_used}j: longint absolute i;',
2279 'begin',
2280 ' if j=3 then ;',
2281 'end;',
2282 'begin',
2283 ' DoIt(nil);']);
2284 AnalyzeProgram;
2285 CheckUseAnalyzerUnexpectedHints;
2286 end;
2287
2288 procedure TTestUseAnalyzer.TestM_Hint_GenFunctionResultArgNotUsed;
2289 begin
2290 StartProgram(true);
2291 Add([
2292 'type',
2293 ' generic TPoint<U> = record X,Y: U; end;',
2294 'generic procedure Three<S>(out x: S);',
2295 'begin',
2296 ' x:=3;',
2297 'end;',
2298 'generic function Point<T>(): specialize TPoint<T>;',
2299 'begin',
2300 ' specialize Three<T>(Result.X)',
2301 'end;',
2302 'begin',
2303 ' specialize Point<word>();',
2304 '']);
2305 AnalyzeProgram;
2306 CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
2307 CheckUseAnalyzerUnexpectedHints;
2308 end;
2309
2310 procedure TTestUseAnalyzer.TestM_Hint_GenFunc_LocalInsideImplUsed;
2311 begin
2312 StartProgram(true,[supTObject]);
2313 Add([
2314 '{$mode delphi}',
2315 'procedure Run<T>;',
2316 'var',
2317 ' WhileV: T;',
2318 ' RepeatV: T;',
2319 ' ForR, ForV: T;',
2320 ' IfCond: boolean;',
2321 ' IfThenV,IfElseV: T;',
2322 ' CaseV, CaseSt, CaseElse: T;',
2323 ' TryFinallyV, TryFinallyX: T;',
2324 ' TryExceptV, TryExceptOn, TryExceptElse: T;',
2325 ' WithExpr: TObject;',
2326 ' WithV: T;',
2327 'begin',
2328 ' while true do WhileV:=WhileV+1;',
2329 ' repeat RepeatV:=RepeatV+1; until false;',
2330 ' for ForR:=1 to 3 do ForV:=ForV+1;',
2331 ' if IfCond then IfThenV:=IfThenV+1 else IfElseV:=IfElseV+1;',
2332 ' case CaseV of',
2333 ' 1: CaseSt:=CaseSt+1;',
2334 ' else',
2335 ' CaseElse:=CaseElse+1;',
2336 ' end;',
2337 ' try TryFinallyV:=TryFinallyV+1; finally TryFinallyX:=TryFinallyX+1; end;',
2338 ' try',
2339 ' TryExceptV:=TryExceptV+1;',
2340 ' except',
2341 ' on TryExceptE: TObject do TryExceptOn:=TryExceptOn+1;',
2342 ' else',
2343 ' TryExceptElse:=TryExceptElse+1;',
2344 ' end;',
2345 ' with WithExpr do WithV:=WithV+1',
2346 'end;',
2347 'begin',
2348 ' Run<word>();']);
2349 AnalyzeProgram;
2350 CheckUseAnalyzerUnexpectedHints;
2351 end;
2352
2353 procedure TTestUseAnalyzer.TestWP_LocalVar;
2354 begin
2355 StartProgram(false);
2356 Add('var {#a_notused}a: longint;');
2357 Add('var {#b_used}b: longint;');
2358 Add('var {#c_used}c: longint;');
2359 Add('begin');
2360 Add(' b:=2;');
2361 Add(' afile.c:=3;');
2362 AnalyzeWholeProgram;
2363 end;
2364
2365 procedure TTestUseAnalyzer.TestWP_UnitUsed;
2366 begin
2367 AddModuleWithIntfImplSrc('unit2.pp',
2368 LinesToStr([
2369 'var i: longint;',
2370 'procedure DoIt;',
2371 '']),
2372 LinesToStr([
2373 'procedure DoIt; begin end;']));
2374
2375 StartProgram(true);
2376 Add('uses unit2;');
2377 Add('begin');
2378 Add(' i:=3;');
2379 AnalyzeWholeProgram;
2380
2381 CheckUnitUsed('unit2.pp',true);
2382 end;
2383
2384 procedure TTestUseAnalyzer.TestWP_UnitUsed_ResourceString;
2385 begin
2386 AddModuleWithIntfImplSrc('unit2.pp',
2387 LinesToStr([
2388 'resourcestring rs = ''txt'';',
2389 'procedure DoIt;',
2390 '']),
2391 LinesToStr([
2392 'procedure DoIt; begin end;']));
2393
2394 StartProgram(true);
2395 Add('uses unit2;');
2396 Add('begin');
2397 Add(' if rs='''' then ;');
2398 AnalyzeWholeProgram;
2399
2400 CheckUnitUsed('unit2.pp',true);
2401 end;
2402
2403 procedure TTestUseAnalyzer.TestWP_UnitNotUsed;
2404 begin
2405 AddModuleWithIntfImplSrc('unit2.pp',
2406 LinesToStr([
2407 'var i: longint;',
2408 'procedure DoIt;',
2409 '']),
2410 LinesToStr([
2411 'procedure DoIt; begin end;']));
2412
2413 StartProgram(true);
2414 Add('uses');
2415 Add(' unit2;');
2416 Add('begin');
2417 AnalyzeWholeProgram;
2418
2419 CheckUnitUsed('unit2.pp',false);
2420 end;
2421
2422 procedure TTestUseAnalyzer.TestWP_UnitInitialization;
2423 begin
2424 AddModuleWithIntfImplSrc('unit2.pp',
2425 LinesToStr([
2426 'var i: longint;',
2427 '']),
2428 LinesToStr([
2429 '']));
2430
2431 AddModuleWithIntfImplSrc('unit1.pp',
2432 LinesToStr([
2433 'uses unit2;',
2434 '']),
2435 LinesToStr([
2436 'initialization',
2437 'i:=2;']));
2438
2439 StartProgram(true);
2440 Add('uses unit1;');
2441 Add('begin');
2442 AnalyzeWholeProgram;
2443
2444 CheckUnitUsed('unit1.pp',true);
2445 CheckUnitUsed('unit2.pp',true);
2446 end;
2447
2448 procedure TTestUseAnalyzer.TestWP_UnitFinalization;
2449 begin
2450 AddModuleWithIntfImplSrc('unit1.pp',
2451 LinesToStr([
2452 'uses unit2;',
2453 '']),
2454 LinesToStr([
2455 'finalization',
2456 'i:=2;']));
2457
2458 AddModuleWithIntfImplSrc('unit2.pp',
2459 LinesToStr([
2460 'var i: longint;',
2461 '']),
2462 LinesToStr([
2463 '']));
2464
2465 StartProgram(true);
2466 Add('uses unit1;');
2467 Add('begin');
2468 AnalyzeWholeProgram;
2469
2470 CheckUnitUsed('unit1.pp',true);
2471 CheckUnitUsed('unit2.pp',true);
2472 end;
2473
2474 procedure TTestUseAnalyzer.TestWP_CallInherited;
2475 begin
2476 StartProgram(false);
2477 Add('type');
2478 Add(' {#TObject_used}TObject = class');
2479 Add(' procedure {#TObjectDoA_used}DoA;');
2480 Add(' procedure {#TObjectDoB_used}DoB;');
2481 Add(' end;');
2482 Add(' {#TMobile_used}TMobile = class');
2483 Add(' procedure {#TMobileDoA_used}DoA;');
2484 Add(' procedure {#TMobileDoC_used}DoC;');
2485 Add(' end;');
2486 Add('procedure TObject.DoA; begin end;');
2487 Add('procedure TObject.DoB; begin end;');
2488 Add('procedure TMobile.DoA;');
2489 Add('begin');
2490 Add(' inherited;');
2491 Add('end;');
2492 Add('procedure TMobile.DoC;');
2493 Add('begin');
2494 Add(' inherited DoB;');
2495 Add('end;');
2496 Add('var o: TMobile;');
2497 Add('begin');
2498 Add(' o.DoA;');
2499 Add(' o.DoC;');
2500 AnalyzeWholeProgram;
2501 end;
2502
2503 procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
2504 begin
2505 StartProgram(false);
2506 Add('var');
2507 Add(' {#vPublic_used}vPublic: longint; public;');
2508 Add(' {#vPrivate_notused}vPrivate: longint;');
2509 Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
2510 Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
2511 Add('begin');
2512 AnalyzeWholeProgram;
2513 end;
2514
2515 procedure TTestUseAnalyzer.TestWP_ClassOverride;
2516 begin
2517 StartProgram(false);
2518 Add([
2519 'type',
2520 ' {#TObject_used}TObject = class',
2521 ' protected',
2522 ' function {#TObject_getcount_used}GetCount: longint; virtual; abstract;',
2523 ' public',
2524 ' property {#TObject_count_used}Count: longint read GetCount;',
2525 ' end;',
2526 '',
2527 ' {#tb_used}TB = class(TObject)',
2528 ' private',
2529 ' {#tb_fcount_used}FCount: longint;',
2530 ' protected',
2531 ' function {#tb_getcount_used}GetCount: longint; override;',
2532 ' end;',
2533 '',
2534 'function TB.GetCount: longint;',
2535 'begin',
2536 ' Result:=FCount;',
2537 'end;',
2538 '',
2539 'procedure {#doit_used}DoIt;',
2540 'var',
2541 ' {#l_used}l: TB;',
2542 'begin',
2543 ' if l.count=3 then ;',
2544 'end;',
2545 '',
2546 'begin',
2547 ' DoIt;']);
2548 AnalyzeWholeProgram;
2549 end;
2550
2551 procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
2552 begin
2553 StartProgram(false);
2554 Add('type');
2555 Add(' {#tobject_used}TObject = class');
2556 Add(' function {#getitems_notused}Getitems(Index: longint): string;');
2557 Add(' procedure {#setitems_used}Setitems(Index: longint; Value: String);');
2558 Add(' property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
2559 Add(' end;');
2560 Add('function TObject.Getitems(Index: longint): string; begin end;');
2561 Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
2562 Add('var');
2563 Add(' {#l_used}L: TObject;');
2564 Add('begin');
2565 Add(' L[0]:=''birdy'';');
2566 AnalyzeWholeProgram;
2567 end;
2568
2569 procedure TTestUseAnalyzer.TestWP_BeforeConstruction;
2570 begin
2571 StartProgram(false);
2572 Add([
2573 'type',
2574 ' {#tobject_used}TObject = class',
2575 ' procedure {#oAfter_used}AfterConstruction; virtual;',
2576 ' procedure {#oBefore_used}BeforeDestruction; virtual;',
2577 ' procedure {#oFree_used}Free;',
2578 ' constructor {#oCreate_used}Create;',
2579 ' destructor {#oDestroy_used}Destroy; virtual;',
2580 ' procedure {#oDoIt_notused}DoIt; virtual; abstract;',
2581 ' end;',
2582 ' TBird = class',
2583 ' procedure {#bAfter_used}AfterConstruction; override;',
2584 ' procedure {#bBefore_used}BeforeDestruction; override;',
2585 ' end;',
2586 'procedure TObject.AfterConstruction; begin end;',
2587 'procedure TObject.BeforeDestruction; begin end;',
2588 'procedure TObject.Free; begin Destroy; end;',
2589 'constructor TObject.Create; begin end;',
2590 'destructor TObject.Destroy; begin end;',
2591 'procedure TBird.AfterConstruction; begin end;',
2592 'procedure TBird.BeforeDestruction; begin end;',
2593 'var',
2594 ' {#b_used}b: TBird;',
2595 'begin',
2596 ' b:=TBird.Create;',
2597 ' b.Free;',
2598 '']);
2599 AnalyzeWholeProgram;
2600 end;
2601
2602 procedure TTestUseAnalyzer.TestWP_Published;
2603 begin
2604 StartProgram(false);
2605 Add('type');
2606 Add(' {#tobject_used}TObject = class');
2607 Add(' private');
2608 Add(' {#fcol_used}FCol: string;');
2609 Add(' {#fbird_notused}FBird: string;');
2610 Add(' published');
2611 Add(' {#fielda_used}FieldA: longint;');
2612 Add(' procedure {#doit_used}ProcA; virtual; abstract;');
2613 Add(' property {#col_used}Col: string read FCol;');
2614 Add(' end;');
2615 Add('var');
2616 Add(' {#o_used}o: TObject;');
2617 Add('begin');
2618 Add(' o:=nil;');
2619 AnalyzeWholeProgram;
2620 end;
2621
2622 procedure TTestUseAnalyzer.TestWP_PublishedSetType;
2623 begin
2624 StartProgram(false);
2625 Add('type');
2626 Add(' {#tflag_used}TFlag = (red, green);');
2627 Add(' {#tflags_used}TFlags = set of TFlag;');
2628 Add(' {#tobject_used}TObject = class');
2629 Add(' published');
2630 Add(' {#fielda_used}FieldA: TFlag;');
2631 Add(' {#fieldb_used}FieldB: TFlags;');
2632 Add(' end;');
2633 Add('var');
2634 Add(' {#o_used}o: TObject;');
2635 Add('begin');
2636 Add(' o:=nil;');
2637 AnalyzeWholeProgram;
2638 end;
2639
2640 procedure TTestUseAnalyzer.TestWP_PublishedArrayType;
2641 begin
2642 StartProgram(false);
2643 Add('type');
2644 Add(' {#tdynarr_used}TDynArr = array of longint;');
2645 Add(' {#tstatarr_used}TStatArr = array[boolean] of longint;');
2646 Add(' {#tobject_used}TObject = class');
2647 Add(' published');
2648 Add(' {#fielda_used}FieldA: TDynArr;');
2649 Add(' {#fieldb_used}FieldB: TStatArr;');
2650 Add(' end;');
2651 Add('var');
2652 Add(' {#o_used}o: TObject;');
2653 Add('begin');
2654 Add(' o:=nil;');
2655 AnalyzeWholeProgram;
2656 end;
2657
2658 procedure TTestUseAnalyzer.TestWP_PublishedClassOfType;
2659 begin
2660 StartProgram(false);
2661 Add('type');
2662 Add(' {#tobjectclass_used}TObjectClass = class of TObject;');
2663 Add(' {#tobject_used}TObject = class');
2664 Add(' published');
2665 Add(' {#fielda_used}FieldA: TObjectClass;');
2666 Add(' end;');
2667 Add(' {#tclass_used}TClass = class of TObject;');
2668 Add('var');
2669 Add(' {#c_used}c: TClass;');
2670 Add('begin');
2671 Add(' c:=nil;');
2672 AnalyzeWholeProgram;
2673 end;
2674
2675 procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
2676 begin
2677 StartProgram(false);
2678 Add([
2679 'type',
2680 ' {#trec_used}TRec = record',
2681 ' {treci_used}i: longint;',
2682 ' end;',
2683 'const c: TRec = (i:1);',
2684 'type',
2685 ' {#tobject_used}TObject = class',
2686 ' published',
2687 ' {#fielda_used}FieldA: TRec;',
2688 ' end;',
2689 'var',
2690 ' {#o_used}o: TObject;',
2691 'begin',
2692 ' o:=nil;']);
2693 AnalyzeWholeProgram;
2694 end;
2695
2696 procedure TTestUseAnalyzer.TestWP_PublishedProcType;
2697 begin
2698 StartProgram(false);
2699 Add('type');
2700 Add(' {#ta_used}ta = array of longint;');
2701 Add(' {#tb_used}tb = array of longint;');
2702 Add(' {#tproca_used}TProcA = procedure;');
2703 Add(' {#tfunca_used}TFuncA = function: ta;');
2704 Add(' {#tprocb_used}TProcB = procedure(a: tb);');
2705 Add(' {#tobject_used}TObject = class');
2706 Add(' published');
2707 Add(' {#fielda_used}FieldA: TProcA;');
2708 Add(' {#fieldb_used}FieldB: TFuncA;');
2709 Add(' {#fieldc_used}FieldC: TProcB;');
2710 Add(' end;');
2711 Add('var');
2712 Add(' {#o_used}o: TObject;');
2713 Add('begin');
2714 Add(' o:=nil;');
2715 AnalyzeWholeProgram;
2716 end;
2717
2718 procedure TTestUseAnalyzer.TestWP_PublishedProperty;
2719 begin
2720 StartProgram(false);
2721 Add('const');
2722 Add(' {#defcol_used}DefCol = 3;');
2723 Add(' {#defsize_notused}DefSize = 43;');
2724 Add('type');
2725 Add(' {#tobject_used}TObject = class');
2726 Add(' private');
2727 Add(' {#fcol_used}FCol: longint;');
2728 Add(' {#fsize_used}FSize: longint;');
2729 Add(' {#fbird_notused}FBird: string;');
2730 Add(' {#fcolstored_used}FColStored: boolean;');
2731 Add(' {#fsizestored_notused}FSizeStored: boolean;');
2732 Add(' public');
2733 Add(' property {#size_used}Size: longint read FSize stored FSizeStored default DefSize;');
2734 Add(' published');
2735 Add(' property {#col_used}Col: longint read FCol stored FColStored default DefCol;');
2736 Add(' end;');
2737 Add('var');
2738 Add(' {#o_used}o: TObject;');
2739 Add('begin');
2740 Add(' if o.Size=13 then ;');
2741 AnalyzeWholeProgram;
2742 end;
2743
2744 procedure TTestUseAnalyzer.TestWP_BuiltInFunctions;
2745 begin
2746 StartProgram(false);
2747 Add([
2748 'type',
2749 ' {#tordenum_used}TOrdEnum = (ordenum1,ordenum2);',
2750 'begin',
2751 ' if ord(ordenum1)=1 then ;',
2752 '']);
2753 AnalyzeWholeProgram;
2754 end;
2755
2756 procedure TTestUseAnalyzer.TestWP_TypeInfo;
2757 begin
2758 StartProgram(false);
2759 Add([
2760 'type',
2761 ' {#integer_used}integer = longint;',
2762 ' {#trec_used}TRec = record',
2763 ' {#trecv_used}v: integer;',
2764 ' end;',
2765 ' {#tclass_used}TClass = class of TObject;',
2766 ' {#tobject_used}TObject = class',
2767 ' class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
2768 ' end;',
2769 ' {#tbirds_used}TBirds = class of TBird;',
2770 ' {#tbird_used}TBird = class',
2771 ' end;',
2772 'function {#getbirdclass_used}GetBirdClass: TBirds;',
2773 'begin',
2774 ' Result:=nil;',
2775 'end;',
2776 'var',
2777 ' {#i_used}i: integer;',
2778 ' {#s_used}s: string;',
2779 ' {#p_used}p: pointer;',
2780 ' {#r_used}r: TRec;',
2781 ' {#o_used}o: TObject;',
2782 ' {#c_used}c: TClass;',
2783 'begin',
2784 ' p:=typeinfo(integer);',
2785 ' p:=typeinfo(longint);',
2786 ' p:=typeinfo(i);',
2787 ' p:=typeinfo(s);',
2788 ' p:=typeinfo(p);',
2789 ' p:=typeinfo(r.v);',
2790 ' p:=typeinfo(TObject.ClassType);',
2791 ' p:=typeinfo(o.ClassType);',
2792 ' p:=typeinfo(o);',
2793 ' p:=typeinfo(c);',
2794 ' p:=typeinfo(c.ClassType);',
2795 ' p:=typeinfo(GetBirdClass);',
2796 '']);
2797 AnalyzeWholeProgram;
2798 end;
2799
2800 procedure TTestUseAnalyzer.TestWP_TypeInfo_PropertyEnumType;
2801 begin
2802 StartProgram(false);
2803 Add([
2804 'type',
2805 ' TObject = class end;',
2806 ' {#talign_typeinfo}TAlign = (alLeft,alRight);',
2807 ' {$M+}',
2808 ' TPersistent = class',
2809 ' private',
2810 ' FAlign: TAlign;',
2811 ' public',
2812 ' property {#tpersistent_align_notypeinfo}Align: TAlign read FAlign write FAlign;',
2813 ' end;',
2814 ' {$M-}',
2815 ' {#tbutton_typeinfo}TButton = class(TPersistent)',
2816 ' published',
2817 ' property {#tbutton_align_typeinfo}Align;',
2818 ' end;',
2819 'var',
2820 ' {#p_notypeinfo}p: pointer;',
2821 'begin',
2822 ' p:=typeinfo(TButton);',
2823 '']);
2824 AnalyzeWholeProgram;
2825 end;
2826
2827 procedure TTestUseAnalyzer.TestWP_TypeInfo_Alias;
2828 begin
2829 AddModuleWithIntfImplSrc('mysystem.pp',
2830 LinesToStr([
2831 'type',
2832 ' integer = longint;',
2833 ' PTypeInfo = pointer;',
2834 ' {#tdatetime_typeinfo}TDateTime = type double;',
2835 '']),
2836 '');
2837 AddModuleWithIntfImplSrc('unit1.pp',
2838 LinesToStr([
2839 'uses mysystem;',
2840 'type',
2841 ' {#ttime_typeinfo}TTime = type TDateTime;',
2842 ' TDate = TDateTime;',
2843 'var',
2844 ' dt: TDateTime;',
2845 ' t: TTime;',
2846 ' d: TDate;',
2847 ' TI: PTypeInfo;',
2848 '']),'');
2849 AddModuleWithIntfImplSrc('unit2.pp',
2850 LinesToStr([
2851 'uses unit1;',
2852 '']),
2853 LinesToStr([
2854 'initialization',
2855 ' dt:=1.0;',
2856 ' t:=2.0;',
2857 ' d:=3.0;',
2858 ' ti:=typeinfo(dt);',
2859 ' ti:=typeinfo(t);',
2860 ' ti:=typeinfo(d);',
2861 '']));
2862 StartProgram(true);
2863 Add([
2864 'uses mysystem, unit2;',
2865 'var',
2866 ' PInfo: PTypeInfo;',
2867 'begin',
2868 ' PInfo:=typeinfo(TDateTime);',
2869 'end.']);
2870 AnalyzeWholeProgram;
2871 end;
2872
2873 procedure TTestUseAnalyzer.TestWP_TypeInfo_Specialize;
2874 begin
2875 StartProgram(false);
2876 Add([
2877 'type',
2878 ' TObject = class end;',
2879 ' generic TProc<T> = procedure(a: T) of object;',
2880 ' TWordProc = specialize TProc<word>;',
2881 ' {$M+}',
2882 ' TPersistent = class',
2883 ' private',
2884 ' FWordProc: TWordProc;',
2885 ' published',
2886 ' property Proc: TWordProc read FWordProc write FWordProc;',
2887 ' end;',
2888 ' {$M-}',
2889 'var',
2890 ' {#p_notypeinfo}p: pointer;',
2891 'begin',
2892 ' p:=typeinfo(TPersistent);',
2893 '']);
2894 AnalyzeWholeProgram;
2895 end;
2896
2897 procedure TTestUseAnalyzer.TestWP_ForInClass;
2898 begin
2899 StartProgram(false);
2900 Add([
2901 'type',
2902 ' TObject = class',
2903 ' end;',
2904 ' {#tenumerator_used}TEnumerator = class',
2905 ' strict private',
2906 ' {#fcurrent_used}FCurrent: longint;',
2907 ' public',
2908 ' {#v_notused}v: string;',
2909 ' function {#movenext_used}MoveNext: boolean;',
2910 ' property {#current_used}Current: longint read FCurrent;',
2911 ' end;',
2912 ' {#tbird_used}TBird = class',
2913 ' function {#getenumerator_used}GetEnumerator: TEnumerator;',
2914 ' end;',
2915 'function TEnumerator.MoveNext: boolean;',
2916 'begin',
2917 'end;',
2918 'function TBird.GetEnumerator: TEnumerator;',
2919 'begin',
2920 'end;',
2921 'var',
2922 ' {#b_used}b: TBird;',
2923 ' {#i_used}i: longint;',
2924 'begin',
2925 ' for i in b do ;',
2926 '']);
2927 AnalyzeWholeProgram;
2928 end;
2929
2930 procedure TTestUseAnalyzer.TestWP_AssertSysUtils;
2931 begin
2932 AddModuleWithIntfImplSrc('SysUtils.pas',
2933 LinesToStr([
2934 'type',
2935 ' TObject = class',
2936 ' constructor {#a_used}Create;',
2937 ' end;',
2938 ' {#e_used}EAssertionFailed = class',
2939 ' constructor {#b_used}Create(s: string);',
2940 ' end;',
2941 '']),
2942 LinesToStr([
2943 'constructor TObject.Create;',
2944 'begin end;',
2945 'constructor EAssertionFailed.Create(s: string);',
2946 'begin end;',
2947 '']) );
2948
2949 StartProgram(true);
2950 Add([
2951 'uses sysutils;',
2952 'procedure DoIt;',
2953 'var',
2954 ' b: boolean;',
2955 ' s: string;',
2956 'begin',
2957 ' {$Assertions on}',
2958 ' Assert(b);',
2959 ' Assert(b,s);',
2960 'end;',
2961 'begin',
2962 ' DoIt;',
2963 '']);
2964 AnalyzeWholeProgram;
2965 end;
2966
2967 procedure TTestUseAnalyzer.TestWP_RangeErrorSysUtils;
2968 begin
2969 AddModuleWithIntfImplSrc('SysUtils.pas',
2970 LinesToStr([
2971 'type',
2972 ' TObject = class',
2973 ' constructor {#a_used}Create;',
2974 ' end;',
2975 ' {#e_used}ERangeError = class',
2976 ' end;',
2977 '']),
2978 LinesToStr([
2979 'constructor TObject.Create;',
2980 'begin end;',
2981 '']) );
2982
2983 StartProgram(true);
2984 Add([
2985 'uses sysutils;',
2986 'procedure DoIt;',
2987 'var',
2988 ' b: byte;',
2989 'begin',
2990 ' {$R+}',
2991 ' b:=1;',
2992 'end;',
2993 'begin',
2994 ' DoIt;',
2995 '']);
2996 AnalyzeWholeProgram;
2997 end;
2998
2999 procedure TTestUseAnalyzer.TestWP_ClassInterface;
3000 begin
3001 StartProgram(false);
3002 Add([
3003 '{$interfaces corba}',
3004 'type',
3005 ' {#iunknown_used}IUnknown = interface',
3006 ' procedure {#iunknown_run_used}Run;',
3007 ' procedure {#iunknown_walk_notused}Walk;',
3008 ' end;',
3009 ' {#tobject_used}TObject = class',
3010 ' end;',
3011 ' {#tbird_used}TBird = class(TObject,IUnknown)',
3012 ' strict private',
3013 ' procedure IUnknown.Run = Fly;',
3014 ' procedure {#tbird_fly_used}Fly; virtual; abstract;',
3015 ' procedure {#tbird_walk_notused}Walk; virtual; abstract;',
3016 ' end;',
3017 ' {#teagle_used}TEagle = class(TBird)',
3018 ' strict private',
3019 ' procedure {#teagle_fly_used}Fly; override;',
3020 ' procedure {#teagle_walk_notused}Walk; override;',
3021 ' end;',
3022 'procedure TEagle.Fly; begin end;',
3023 'procedure TEagle.Walk; begin end;',
3024 'var',
3025 ' e: TEagle;',
3026 ' i: IUnknown;',
3027 'begin',
3028 ' i:=e;',
3029 ' i.Run;',
3030 '']);
3031 AnalyzeWholeProgram;
3032 end;
3033
3034 procedure TTestUseAnalyzer.TestWP_ClassInterface_OneWayIntfToObj;
3035 begin
3036 StartProgram(false);
3037 Add([
3038 '{$interfaces corba}',
3039 'type',
3040 ' {#iunknown_used}IUnknown = interface',
3041 ' procedure {#iunknown_run_used}Run;',
3042 ' procedure {#iunknown_walk_notused}Walk;',// not used
3043 ' end;',
3044 ' {#tobject_used}TObject = class',
3045 ' end;',
3046 ' {#tbird_used}TBird = class(TObject,IUnknown)',
3047 ' strict private',
3048 ' procedure IUnknown.Run = Fly;',
3049 ' procedure {#tbird_fly_used}Fly; virtual; abstract;',
3050 ' procedure {#tbird_walk_notused}Walk; virtual; abstract;', // used
3051 ' end;',
3052 ' {#teagle_used}TEagle = class(TBird)',
3053 ' private',
3054 ' procedure {#teagle_fly_used}Fly; override;',
3055 ' procedure {#teagle_walk_used}Walk; override;',
3056 ' end;',
3057 'procedure TEagle.Fly; begin end;',
3058 'procedure TEagle.Walk; begin end;',
3059 'var',
3060 ' e: TEagle;',
3061 ' i: IUnknown;',
3062 'begin',
3063 ' i:=e;',
3064 ' i.Run;', // using IUnknown.Walk must mark TEagle.Walk
3065 ' e.Walk;', // using TEagle.Walk must not mark IUnknown.Walk
3066 '']);
3067 AnalyzeWholeProgram;
3068 end;
3069
3070 procedure TTestUseAnalyzer.TestWP_ClassInterface_Delegation;
3071 begin
3072 StartProgram(false);
3073 Add([
3074 '{$interfaces corba}',
3075 'type',
3076 ' {#iunknown_used}IUnknown = interface',
3077 ' procedure {#iunknown_run_used}Run;',
3078 ' procedure {#iunknown_walk_notused}Walk;',
3079 ' end;',
3080 ' {#tobject_used}TObject = class',
3081 ' end;',
3082 ' {#tbird_used}TBird = class(TObject,IUnknown)',
3083 ' strict private',
3084 ' procedure IUnknown.Run = Fly;',
3085 ' procedure {#tbird_fly_used}Fly;',
3086 ' procedure {#tbird_walk_notused}Walk;',
3087 ' end;',
3088 ' {#teagle_used}TEagle = class(TObject,IUnknown)',
3089 ' strict private',
3090 ' {#teagle_fbird_used}FBird: TBird;',
3091 ' property {#teagle_bird_used}Bird: TBird read FBird implements IUnknown;',
3092 ' end;',
3093 'procedure TBird.Fly; begin end;',
3094 'procedure TBird.Walk; begin end;',
3095 'var',
3096 ' e: TEagle;',
3097 ' i: IUnknown;',
3098 'begin',
3099 ' i:=e;',
3100 ' i.Run;',
3101 '']);
3102 AnalyzeWholeProgram;
3103 end;
3104
3105 procedure TTestUseAnalyzer.TestWP_ClassInterface_COM;
3106 begin
3107 StartProgram(false);
3108 Add([
3109 '{$interfaces com}',
3110 'type',
3111 ' {#tguid_used}TGuid = string;',
3112 ' {#integer_used}integer = longint;',
3113 ' {#iunknown_used}IUnknown = interface',
3114 ' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
3115 ' function {#iunknown_addref_used}_AddRef: Integer;',
3116 ' function {#iunknown_release_used}_Release: Integer;',
3117 ' procedure {#iunknown_doit_notused}DoIt;',
3118 ' end;',
3119 ' {#tobject_used}TObject = class',
3120 ' end;',
3121 ' {#tbird_used}TBird = class(TObject,IUnknown)',
3122 ' strict private',
3123 ' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
3124 ' function {#tbird_addref_used}_AddRef: Integer;',
3125 ' function {#tbird_release_used}_Release: Integer;',
3126 ' procedure {#tbird_doit_notused}DoIt;',
3127 ' end;',
3128 ' {#teagle_used}TEagle = class(TBird)',
3129 ' end;',
3130 'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
3131 'begin',
3132 ' if iid='''' then obj:=nil;',
3133 ' Result:=0;',
3134 'end;',
3135 'function TBird._AddRef: Integer; begin Result:=1; end;',
3136 'function TBird._Release: Integer; begin Result:=2; end;',
3137 'procedure TBird.DoIt; begin end;',
3138 'var',
3139 ' e: TEagle;',
3140 ' i: IUnknown;',
3141 'begin',
3142 ' i:=e;',
3143 ' if i=nil then ;',
3144 '']);
3145 AnalyzeWholeProgram;
3146 end;
3147
3148 procedure TTestUseAnalyzer.TestWP_ClassInterface_COM_Unit;
3149 begin
3150 AddModuleWithIntfImplSrc('SysUtils.pas',
3151 LinesToStr([
3152 '{$interfaces com}',
3153 'type',
3154 ' {#tguid_used}TGuid = string;',
3155 ' {#integer_used}integer = longint;',
3156 ' {#iunknown_used}IUnknown = interface',
3157 ' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
3158 ' function {#iunknown_addref_used}_AddRef: Integer;',
3159 ' function {#iunknown_release_used}_Release: Integer;',
3160 ' procedure {#iunknown_doit_notused}DoIt;',
3161 ' end;',
3162 ' IBird = interface(IUnknown)',
3163 ' procedure {#ibird_fly_used}Fly;',
3164 ' end;',
3165 ' {#tobject_used}TObject = class',
3166 ' end;',
3167 ' {#tbird_used}TBird = class(TObject,IBird)',
3168 ' strict private',
3169 ' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
3170 ' function {#tbird_addref_used}_AddRef: Integer;',
3171 ' function {#tbird_release_used}_Release: Integer;',
3172 ' procedure {#tbird_doit_notused}DoIt;',
3173 ' procedure {#tbird_fly_used}Fly;',
3174 ' end;',
3175 '']),
3176 LinesToStr([
3177 'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
3178 'begin',
3179 ' if iid='''' then obj:=nil;',
3180 ' Result:=0;',
3181 'end;',
3182 'function TBird._AddRef: Integer; begin Result:=1; end;',
3183 'function TBird._Release: Integer; begin Result:=2; end;',
3184 'procedure TBird.DoIt; begin end;',
3185 'procedure TBird.Fly; begin end;',
3186 '']) );
3187
3188 StartProgram(true);
3189 Add([
3190 'uses sysutils;',
3191 'type',
3192 ' {#teagle_used}TEagle = class(TBird)',
3193 ' end;',
3194 'var',
3195 ' e: TEagle;',
3196 ' i: IBird;',
3197 'begin',
3198 ' i:=e;',
3199 ' if i=nil then ;',
3200 ' i.Fly;',
3201 '']);
3202 AnalyzeWholeProgram;
3203 end;
3204
3205 procedure TTestUseAnalyzer.TestWP_ClassInterface_Typeinfo;
3206 begin
3207 StartProgram(false);
3208 Add([
3209 '{$interfaces corba}',
3210 'type',
3211 ' {#iunknown_typeinfo}IUnknown = interface',
3212 ' function {#iunknown_getflag_typeinfo}GetFlag: boolean;',
3213 ' procedure {#iunknown_setflag_typeinfo}SetFlag(Value: boolean);',
3214 ' procedure {#iunknown_doit_notypeinfo}DoIt;',
3215 ' property {#iunknown_flag_typeinfo}Flag: boolean read GetFlag write SetFlag;',
3216 ' end;',
3217 ' {#ibird_notused}IBird = interface(IUnknown)',
3218 ' end;',
3219 'var',
3220 ' t: pointer;',
3221 ' i: IUnknown;',
3222 'begin',
3223 ' t:=typeinfo(IUnknown);',
3224 ' if i.Flag then ;',
3225 '']);
3226 AnalyzeWholeProgram;
3227 end;
3228
3229 procedure TTestUseAnalyzer.TestWP_ClassInterface_TGUID;
3230 begin
3231 StartProgram(false);
3232 Add([
3233 '{$interfaces corba}',
3234 'type',
3235 ' TGuid = record',
3236 ' {#d1_used}D1: longword;',
3237 ' {#d2_used}D2: word;',
3238 ' {#d3_used}D3: word;',
3239 ' {#d4_used}D4: array[0..7] of byte;',
3240 ' end;',
3241 'var g,h: TGuid;',
3242 'begin',
3243 ' if g=h then ;',
3244 '']);
3245 AnalyzeWholeProgram;
3246 end;
3247
3248 procedure TTestUseAnalyzer.TestWP_ClassHelper;
3249 begin
3250 StartProgram(false);
3251 Add([
3252 'type',
3253 ' {#TObject_used}TObject = class',
3254 ' end;',
3255 ' {#TBird_used}TBird = class',
3256 ' {#TBird_A_notused}A: word;',
3257 ' end;',
3258 ' {#TAnt_used}TAnt = class',
3259 ' {#TAnt_B_notused}B: word;',
3260 ' type',
3261 ' {#TMouth_used}TMouth = class',
3262 ' {#TMouth_C_notused}C: word;',
3263 ' type',
3264 ' {#TBirdHelper_used}TBirdHelper = class helper for TBird',
3265 ' procedure {#TBirdHelper_Fly_used}Fly;',
3266 ' end;',
3267 ' end;',
3268 ' end;',
3269 'procedure TAnt.TMouth.TBirdHelper.Fly;',
3270 'begin',
3271 'end;',
3272 'var b: TBird;',
3273 'begin',
3274 ' b.Fly;;',
3275 '']);
3276 AnalyzeWholeProgram;
3277 end;
3278
3279 procedure TTestUseAnalyzer.TestWP_ClassHelper_ClassConstrucor_Used;
3280 begin
3281 StartProgram(false);
3282 Add([
3283 'type',
3284 ' {#TObject_used}TObject = class',
3285 ' class constructor {#TObject_Init_used}Init;',
3286 ' class destructor {#TObject_Done_used}Done;',
3287 ' end;',
3288 ' {#TBird_used}TBird = class',
3289 ' {#TBird_A_notused}A: word;',
3290 ' class constructor {#TBird_Init_used}Init;',
3291 ' class destructor {#TBird_Done_used}Done;',
3292 ' end;',
3293 ' {#TBirdHelper_used}TBirdHelper = class helper for TBird',
3294 ' procedure {#TBirdHelper_Fly_used}Fly;',
3295 ' class constructor {#TBirdHelper_Init_used}Init;',
3296 ' class destructor {#TBirdHelper_Done_used}Done;',
3297 ' end;',
3298 ' TAnt = class',
3299 ' class constructor {#TAnt_Init_notused}Init;',
3300 ' class destructor {#TAnt_Done_notused}Done;',
3301 ' end;',
3302 'class constructor TObject.Init;',
3303 'begin',
3304 'end;',
3305 'class destructor TObject.Done;',
3306 'begin',
3307 'end;',
3308 'class constructor TBird.Init;',
3309 'begin',
3310 'end;',
3311 'class destructor TBird.Done;',
3312 'begin',
3313 'end;',
3314 'procedure TBirdHelper.Fly;',
3315 'begin',
3316 'end;',
3317 'class constructor TBirdHelper.Init;',
3318 'begin',
3319 'end;',
3320 'class destructor TBirdHelper.Done;',
3321 'begin',
3322 'end;',
3323 'class constructor TAnt.Init;',
3324 'begin',
3325 'end;',
3326 'class destructor TAnt.Done;',
3327 'begin',
3328 'end;',
3329 'var b: TBird;',
3330 'begin',
3331 ' b.Fly;',
3332 '']);
3333 AnalyzeWholeProgram;
3334 end;
3335
3336 procedure TTestUseAnalyzer.TestWP_Attributes;
3337 begin
3338 StartProgram(false);
3339 Add([
3340 '{$modeswitch prefixedattributes}',
3341 'type',
3342 ' TObject = class',
3343 ' constructor {#TObject_Create_notused}Create;',
3344 ' end;',
3345 ' {#TCustomAttribute_used}TCustomAttribute = class',
3346 ' end;',
3347 ' {#RedAttribute_used}RedAttribute = class(TCustomAttribute)',
3348 ' constructor {#Red_A_used}Create(Id: word = 3; Deep: boolean = false); overload;',
3349 ' constructor {#Red_B_notused}Create(Size: double); overload;',
3350 ' end;',
3351 ' {#Red_notused}Red = word;',
3352 'constructor TObject.Create; begin end;',
3353 'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
3354 'constructor RedAttribute.Create(Size: double); begin end;',
3355 'var',
3356 ' [NotExisting]',
3357 ' [Red]',
3358 ' o: TObject;',
3359 'begin',
3360 ' if typeinfo(o)=nil then ;',
3361 '']);
3362 AnalyzeWholeProgram;
3363 end;
3364
3365 procedure TTestUseAnalyzer.TestWP_Attributes_ForwardClass;
3366 begin
3367 StartProgram(false);
3368 Add([
3369 '{$modeswitch prefixedattributes}',
3370 'type',
3371 ' TObject = class',
3372 ' constructor {#TObject_Create_used}Create;',
3373 ' end;',
3374 ' {#TCustomAttribute_used}TCustomAttribute = class',
3375 ' end;',
3376 ' [TCustom]',
3377 ' TBird = class;',
3378 ' TMyInt = word;',
3379 ' TBird = class end;',
3380 'constructor TObject.Create; begin end;',
3381 'begin',
3382 ' if typeinfo(TBird)=nil then ;',
3383 '']);
3384 AnalyzeWholeProgram;
3385 end;
3386
3387 procedure TTestUseAnalyzer.TestWP_Attributes_Params;
3388 begin
3389 StartProgram(false);
3390 Add([
3391 '{$modeswitch prefixedattributes}',
3392 'type',
3393 ' TObject = class',
3394 ' constructor {#TObject_Create_notused}Create;',
3395 ' destructor {#TObject_Destroy_used}Destroy; virtual;',
3396 ' end;',
3397 ' {#TCustomAttribute_used}TCustomAttribute = class',
3398 ' end;',
3399 ' {#BigAttribute_used}BigAttribute = class(TCustomAttribute)',
3400 ' constructor {#Big_A_used}Create(Id: word = 3); overload;',
3401 ' destructor {#Big_B_used}Destroy; override;',
3402 ' end;',
3403 'constructor TObject.Create; begin end;',
3404 'destructor TObject.Destroy; begin end;',
3405 'constructor BigAttribute.Create(Id: word); begin end;',
3406 'destructor BigAttribute.Destroy; begin end;',
3407 'var',
3408 ' [Big(3)]',
3409 ' o: TObject;',
3410 ' a: TCustomAttribute;',
3411 'begin',
3412 ' if typeinfo(o)=nil then ;',
3413 ' a.Destroy;',
3414 '']);
3415 AnalyzeWholeProgram;
3416 end;
3417
3418 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
3419 begin
3420 StartUnit(false);
3421 Add([
3422 'interface',
3423 'type',
3424 ' TColor = longint;',
3425 ' TIntColor = TColor;',
3426 'var',
3427 ' i: longint;',
3428 ' j: longint;',
3429 'procedure DoIt;',
3430 'implementation',
3431 'procedure DoIt;',
3432 'type',
3433 ' TSubColor = TIntColor;',
3434 'var',
3435 ' b: TSubColor;',
3436 'begin',
3437 ' b:=i;',
3438 'end;',
3439 '']);
3440 Analyzer.Options:=Analyzer.Options+[paoImplReferences];
3441 AnalyzeUnit;
3442 CheckScopeReferences('DoIt',['i','tintcolor']);
3443 end;
3444
3445 procedure TTestUseAnalyzer.TestSR_Init_UnitVar;
3446 begin
3447 StartUnit(false);
3448 Add([
3449 'interface',
3450 'type',
3451 ' TColor = longint;',
3452 ' TIntColor = TColor;',
3453 'var',
3454 ' i: longint;',
3455 ' j: longint;',
3456 'implementation',
3457 'type',
3458 ' TSubColor = TIntColor;',
3459 'var',
3460 ' b: TSubColor;',
3461 'initialization',
3462 ' b:=i;',
3463 'finalization',
3464 ' b:=j;',
3465 'end.',
3466 '']);
3467 Analyzer.Options:=Analyzer.Options+[paoImplReferences];
3468 AnalyzeUnit;
3469 CheckScopeReferences('initialization',['b','i']);
3470 CheckScopeReferences('finalization',['b','j']);
3471 end;
3472
3473 initialization
3474 RegisterTests([TTestUseAnalyzer]);
3475
3476 end.
3477
3478
3479