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