tcuseanalyzer.pas 53 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085
  1. {
  2. Examples:
  3. ./testpassrc --suite=TTestResolver.TestEmpty
  4. }
  5. unit tcuseanalyzer;
  6. {$mode objfpc}{$H+}
  7. interface
  8. uses
  9. Classes, SysUtils, fpcunit, PasTree, PScanner, PasResolver, tcbaseparser,
  10. testregistry, strutils, tcresolver, PasUseAnalyzer, PasResolveEval;
  11. type
  12. { TCustomTestUseAnalyzer }
  13. TCustomTestUseAnalyzer = Class(TCustomTestResolver)
  14. private
  15. FAnalyzer: TPasAnalyzer;
  16. FPAMessages: TFPList; // list of TPAMessage
  17. FPAGoodMessages: TFPList;
  18. function GetPAMessages(Index: integer): TPAMessage;
  19. procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
  20. protected
  21. procedure SetUp; override;
  22. procedure TearDown; override;
  23. procedure AnalyzeModule; virtual;
  24. procedure AnalyzeProgram; virtual;
  25. procedure AnalyzeUnit; virtual;
  26. procedure AnalyzeWholeProgram; virtual;
  27. procedure CheckUsedMarkers; virtual;
  28. procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
  29. const MsgText: string); virtual;
  30. procedure CheckUseAnalyzerUnexpectedHints; virtual;
  31. procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
  32. public
  33. property Analyzer: TPasAnalyzer read FAnalyzer;
  34. function PAMessageCount: integer;
  35. property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
  36. end;
  37. { TTestUseAnalyzer }
  38. TTestUseAnalyzer = Class(TCustomTestUseAnalyzer)
  39. published
  40. // single module
  41. procedure TestM_ProgramLocalVar;
  42. procedure TestM_AssignStatement;
  43. procedure TestM_BeginBlock;
  44. procedure TestM_ForLoopStatement;
  45. procedure TestM_AsmStatement;
  46. procedure TestM_CaseOfStatement;
  47. procedure TestM_IfThenElseStatement;
  48. procedure TestM_WhileDoStatement;
  49. procedure TestM_RepeatUntilStatement;
  50. procedure TestM_TryFinallyStatement;
  51. procedure TestM_TypeAlias;
  52. procedure TestM_RangeType;
  53. procedure TestM_Unary;
  54. procedure TestM_Const;
  55. procedure TestM_ResourceString;
  56. procedure TestM_Record;
  57. procedure TestM_Array;
  58. procedure TestM_NestedFuncResult;
  59. procedure TestM_Enums;
  60. procedure TestM_ProcedureType;
  61. procedure TestM_Params;
  62. procedure TestM_Class;
  63. procedure TestM_ClassForward;
  64. procedure TestM_Class_Property;
  65. procedure TestM_Class_PropertyOverride;
  66. procedure TestM_Class_MethodOverride;
  67. procedure TestM_Class_MethodOverride2;
  68. procedure TestM_ClassInterface_Ignore;
  69. procedure TestM_TryExceptStatement;
  70. // single module hints
  71. procedure TestM_Hint_UnitNotUsed;
  72. procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
  73. procedure TestM_Hint_ParameterNotUsed;
  74. procedure TestM_HintsOff_ParameterNotUsed;
  75. procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
  76. procedure TestM_Hint_ParameterNotUsed_Abstract;
  77. procedure TestM_Hint_ParameterNotUsedTypecast;
  78. procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
  79. procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
  80. procedure TestM_Hint_InheritedWithoutParams;
  81. procedure TestM_Hint_LocalVariableNotUsed;
  82. procedure TestM_HintsOff_LocalVariableNotUsed;
  83. procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
  84. procedure TestM_Hint_InterfaceUnitVariableUsed;
  85. procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
  86. procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
  87. procedure TestM_Hint_LocalXYNotUsed;
  88. procedure TestM_Hint_PrivateFieldIsNeverUsed;
  89. procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
  90. procedure TestM_Hint_PrivateMethodIsNeverUsed;
  91. procedure TestM_Hint_LocalDestructor_No_IsNeverUsed;
  92. procedure TestM_Hint_PrivateTypeNeverUsed;
  93. procedure TestM_Hint_PrivateConstNeverUsed;
  94. procedure TestM_Hint_PrivatePropertyNeverUsed;
  95. procedure TestM_Hint_LocalClassInProgramNotUsed;
  96. procedure TestM_Hint_LocalMethodInProgramNotUsed;
  97. procedure TestM_Hint_LocalVarOfNotUsedProc;
  98. procedure TestM_Hint_LocalVarOfNotUsedMethod;
  99. procedure TestM_Hint_AssemblerParameterIgnored;
  100. procedure TestM_Hint_AssemblerDelphiParameterIgnored;
  101. procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
  102. procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
  103. procedure TestM_Hint_FunctionResultRecord;
  104. procedure TestM_Hint_FunctionResultPassRecordElement;
  105. procedure TestM_Hint_AbsoluteVar;
  106. // whole program optimization
  107. procedure TestWP_LocalVar;
  108. procedure TestWP_UnitUsed;
  109. procedure TestWP_UnitUsed_ResourceString;
  110. procedure TestWP_UnitNotUsed;
  111. procedure TestWP_UnitInitialization;
  112. procedure TestWP_UnitFinalization;
  113. procedure TestWP_CallInherited;
  114. procedure TestWP_ProgramPublicDeclarations;
  115. procedure TestWP_ClassDefaultProperty;
  116. procedure TestWP_Published;
  117. procedure TestWP_PublishedSetType;
  118. procedure TestWP_PublishedArrayType;
  119. procedure TestWP_PublishedClassOfType;
  120. procedure TestWP_PublishedRecordType;
  121. procedure TestWP_PublishedProcType;
  122. procedure TestWP_PublishedProperty;
  123. procedure TestWP_BuiltInFunctions;
  124. procedure TestWP_TypeInfo;
  125. procedure TestWP_ForInClass;
  126. procedure TestWP_AssertSysUtils;
  127. procedure TestWP_RangeErrorSysUtils;
  128. end;
  129. implementation
  130. { TCustomTestUseAnalyzer }
  131. procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
  132. Msg: TPAMessage);
  133. begin
  134. Msg.AddRef;
  135. FPAMessages.Add(Msg);
  136. end;
  137. function TCustomTestUseAnalyzer.GetPAMessages(Index: integer): TPAMessage;
  138. begin
  139. Result:=TPAMessage(FPAMessages[Index]);
  140. end;
  141. procedure TCustomTestUseAnalyzer.SetUp;
  142. begin
  143. inherited SetUp;
  144. FPAMessages:=TFPList.Create;
  145. FPAGoodMessages:=TFPList.Create;
  146. FAnalyzer:=TPasAnalyzer.Create;
  147. FAnalyzer.Resolver:=ResolverEngine;
  148. Analyzer.OnMessage:=@OnAnalyzerMessage;
  149. end;
  150. procedure TCustomTestUseAnalyzer.TearDown;
  151. var
  152. i: Integer;
  153. begin
  154. FreeAndNil(FPAGoodMessages);
  155. for i:=0 to FPAMessages.Count-1 do
  156. TPAMessage(FPAMessages[i]).Release;
  157. FreeAndNil(FPAMessages);
  158. FreeAndNil(FAnalyzer);
  159. inherited TearDown;
  160. end;
  161. procedure TCustomTestUseAnalyzer.AnalyzeModule;
  162. begin
  163. Analyzer.AnalyzeModule(Module);
  164. Analyzer.EmitModuleHints(Module);
  165. CheckUsedMarkers;
  166. end;
  167. procedure TCustomTestUseAnalyzer.AnalyzeProgram;
  168. begin
  169. ParseProgram;
  170. AnalyzeModule;
  171. end;
  172. procedure TCustomTestUseAnalyzer.AnalyzeUnit;
  173. begin
  174. ParseUnit;
  175. AnalyzeModule;
  176. end;
  177. procedure TCustomTestUseAnalyzer.AnalyzeWholeProgram;
  178. begin
  179. ParseProgram;
  180. Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
  181. CheckUsedMarkers;
  182. end;
  183. procedure TCustomTestUseAnalyzer.CheckUsedMarkers;
  184. var
  185. aMarker: PSrcMarker;
  186. p: SizeInt;
  187. Postfix: String;
  188. Elements: TFPList;
  189. i: Integer;
  190. El: TPasElement;
  191. ExpectedUsed: Boolean;
  192. FoundEl: TPAElement;
  193. begin
  194. aMarker:=FirstSrcMarker;
  195. while aMarker<>nil do
  196. begin
  197. writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
  198. p:=RPos('_',aMarker^.Identifier);
  199. if p>1 then
  200. begin
  201. Postfix:=copy(aMarker^.Identifier,p+1);
  202. if Postfix='used' then
  203. ExpectedUsed:=true
  204. else if Postfix='notused' then
  205. ExpectedUsed:=false
  206. else
  207. RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
  208. Elements:=FindElementsAt(aMarker);
  209. try
  210. FoundEl:=nil;
  211. for i:=0 to Elements.Count-1 do
  212. begin
  213. El:=TPasElement(Elements[i]);
  214. writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
  215. FoundEl:=Analyzer.FindElement(El);
  216. if FoundEl<>nil then break;
  217. end;
  218. if FoundEl<>nil then
  219. begin
  220. if not ExpectedUsed then
  221. RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
  222. end
  223. else
  224. begin
  225. if ExpectedUsed then
  226. RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
  227. end;
  228. finally
  229. Elements.Free;
  230. end;
  231. end;
  232. aMarker:=aMarker^.Next;
  233. end;
  234. end;
  235. procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
  236. MsgNumber: integer; const MsgText: string);
  237. var
  238. i: Integer;
  239. Msg: TPAMessage;
  240. s: string;
  241. begin
  242. i:=PAMessageCount-1;
  243. while i>=0 do
  244. begin
  245. Msg:=PAMessages[i];
  246. if (Msg.MsgNumber=MsgNumber) then
  247. begin
  248. if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
  249. begin
  250. FPAGoodMessages.Add(Msg);
  251. exit;
  252. end;
  253. end;
  254. dec(i);
  255. end;
  256. // mismatch
  257. writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
  258. for i:=0 to PAMessageCount-1 do
  259. begin
  260. Msg:=PAMessages[i];
  261. writeln(' ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
  262. end;
  263. s:='';
  264. str(MsgType,s);
  265. Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
  266. end;
  267. procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
  268. var
  269. i: Integer;
  270. Msg: TPAMessage;
  271. s: String;
  272. begin
  273. for i:=0 to PAMessageCount-1 do
  274. begin
  275. Msg:=PAMessages[i];
  276. if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
  277. s:='';
  278. str(Msg.MsgType,s);
  279. Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
  280. end;
  281. end;
  282. procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
  283. Used: boolean);
  284. var
  285. aResolver: TTestEnginePasResolver;
  286. PAEl: TPAElement;
  287. begin
  288. aResolver:=FindModuleWithFilename(aFilename);
  289. AssertNotNull('unit not found "'+aFilename+'"',aResolver);
  290. AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
  291. PAEl:=Analyzer.FindElement(aResolver.Module);
  292. if PAEl<>nil then
  293. begin
  294. // unit is used
  295. if not Used then
  296. Fail('expected unit "'+aFilename+'" not used, but it is used');
  297. end
  298. else
  299. begin
  300. // unit is not used
  301. if Used then
  302. Fail('expected unit "'+aFilename+'" used, but it is not used');
  303. end;
  304. end;
  305. function TCustomTestUseAnalyzer.PAMessageCount: integer;
  306. begin
  307. Result:=FPAMessages.Count;
  308. end;
  309. { TTestUseAnalyzer }
  310. procedure TTestUseAnalyzer.TestM_ProgramLocalVar;
  311. begin
  312. StartProgram(false);
  313. Add('procedure {#DoIt_used}DoIt;');
  314. Add('var {#l_notused}l: longint;');
  315. Add('begin');
  316. Add('end;');
  317. Add('begin');
  318. Add(' DoIt;');
  319. AnalyzeProgram;
  320. end;
  321. procedure TTestUseAnalyzer.TestM_AssignStatement;
  322. begin
  323. StartProgram(false);
  324. Add('procedure {#DoIt_used}DoIt;');
  325. Add('var');
  326. Add(' {#a_notused}a: longint;');
  327. Add(' {#b_used}b: longint;');
  328. Add(' {#c_used}c: longint;');
  329. Add('begin');
  330. Add(' b:=c;');
  331. Add('end;');
  332. Add('begin');
  333. Add(' DoIt;');
  334. AnalyzeProgram;
  335. end;
  336. procedure TTestUseAnalyzer.TestM_BeginBlock;
  337. begin
  338. StartProgram(false);
  339. Add('procedure {#DoIt_used}DoIt;');
  340. Add('var');
  341. Add(' {#a_used}a: longint;');
  342. Add('begin');
  343. Add(' begin');
  344. Add(' a:=1;');
  345. Add(' end;');
  346. Add('end;');
  347. Add('begin');
  348. Add(' DoIt;');
  349. AnalyzeProgram;
  350. end;
  351. procedure TTestUseAnalyzer.TestM_ForLoopStatement;
  352. begin
  353. StartProgram(false);
  354. Add('procedure {#DoIt_used}DoIt;');
  355. Add('var');
  356. Add(' {#a_used}a: longint;');
  357. Add(' {#b_used}b: longint;');
  358. Add(' {#c_used}c: longint;');
  359. Add(' {#d_used}d: longint;');
  360. Add('begin');
  361. Add(' for a:=b to c do d:=a;');
  362. Add('end;');
  363. Add('begin');
  364. Add(' DoIt;');
  365. AnalyzeProgram;
  366. end;
  367. procedure TTestUseAnalyzer.TestM_AsmStatement;
  368. begin
  369. StartProgram(false);
  370. Add('procedure {#DoIt_used}DoIt;');
  371. Add('begin');
  372. Add(' asm end;');
  373. Add('end;');
  374. Add('begin');
  375. Add(' DoIt;');
  376. AnalyzeProgram;
  377. end;
  378. procedure TTestUseAnalyzer.TestM_CaseOfStatement;
  379. begin
  380. StartProgram(false);
  381. Add('procedure {#DoIt_used}DoIt;');
  382. Add('const');
  383. Add(' {#a_used}a = 1;');
  384. Add(' {#b_used}b = 2;');
  385. Add('var');
  386. Add(' {#c_used}c: longint;');
  387. Add(' {#d_used}d: longint;');
  388. Add('begin');
  389. Add(' case a of');
  390. Add(' b: c:=1;');
  391. Add(' else');
  392. Add(' d:=2;');
  393. Add(' end;');
  394. Add('end;');
  395. Add('begin');
  396. Add(' DoIt;');
  397. AnalyzeProgram;
  398. end;
  399. procedure TTestUseAnalyzer.TestM_IfThenElseStatement;
  400. begin
  401. StartProgram(false);
  402. Add('procedure {#DoIt_used}DoIt;');
  403. Add('var');
  404. Add(' {#a_used}a: longint;');
  405. Add(' {#b_used}b: longint;');
  406. Add(' {#c_used}c: longint;');
  407. Add('begin');
  408. Add(' if a=0 then b:=1 else c:=2;');
  409. Add('end;');
  410. Add('begin');
  411. Add(' DoIt;');
  412. AnalyzeProgram;
  413. end;
  414. procedure TTestUseAnalyzer.TestM_WhileDoStatement;
  415. begin
  416. StartProgram(false);
  417. Add('procedure {#DoIt_used}DoIt;');
  418. Add('var');
  419. Add(' {#a_used}a: longint;');
  420. Add(' {#b_used}b: longint;');
  421. Add('begin');
  422. Add(' while a>0 do b:=1;');
  423. Add('end;');
  424. Add('begin');
  425. Add(' DoIt;');
  426. AnalyzeProgram;
  427. end;
  428. procedure TTestUseAnalyzer.TestM_RepeatUntilStatement;
  429. begin
  430. StartProgram(false);
  431. Add('procedure {#DoIt_used}DoIt;');
  432. Add('var');
  433. Add(' {#a_used}a: longint;');
  434. Add(' {#b_used}b: longint;');
  435. Add('begin');
  436. Add(' repeat a:=1; until b>1;');
  437. Add('end;');
  438. Add('begin');
  439. Add(' DoIt;');
  440. AnalyzeProgram;
  441. end;
  442. procedure TTestUseAnalyzer.TestM_TryFinallyStatement;
  443. begin
  444. StartProgram(false);
  445. Add('procedure {#DoIt_used}DoIt;');
  446. Add('var');
  447. Add(' {#a_used}a: longint;');
  448. Add(' {#b_used}b: longint;');
  449. Add('begin');
  450. Add(' try');
  451. Add(' a:=1;');
  452. Add(' finally');
  453. Add(' b:=2;');
  454. Add(' end;');
  455. Add('end;');
  456. Add('begin');
  457. Add(' DoIt;');
  458. AnalyzeProgram;
  459. end;
  460. procedure TTestUseAnalyzer.TestM_TypeAlias;
  461. begin
  462. StartProgram(false);
  463. Add('procedure {#DoIt_used}DoIt;');
  464. Add('type');
  465. Add(' {#integer_used}integer = longint;');
  466. Add('var');
  467. Add(' {#a_used}a: integer;');
  468. Add(' {#b_used}b: integer;');
  469. Add(' {#c_notused}c: integer;');
  470. Add('begin');
  471. Add(' a:=b;');
  472. Add('end;');
  473. Add('begin');
  474. Add(' DoIt;');
  475. AnalyzeProgram;
  476. end;
  477. procedure TTestUseAnalyzer.TestM_RangeType;
  478. begin
  479. StartProgram(false);
  480. Add('procedure {#DoIt_used}DoIt;');
  481. Add('const');
  482. Add(' {#neg1_used}Neg1 = -1;');
  483. Add(' {#pos1_used}Pos1 = +1;');
  484. Add('type');
  485. Add(' {#trg_used}TRg = Neg1..Pos1;');
  486. Add('var');
  487. Add(' {#a_used}a: trg;');
  488. Add('begin');
  489. Add(' a:=0;');
  490. Add('end;');
  491. Add('begin');
  492. Add(' DoIt;');
  493. AnalyzeProgram;
  494. end;
  495. procedure TTestUseAnalyzer.TestM_Unary;
  496. begin
  497. StartProgram(false);
  498. Add('procedure {#DoIt_used}DoIt;');
  499. Add('var');
  500. Add(' {#a_used}a: longint;');
  501. Add(' {#b_used}b: longint;');
  502. Add(' {#c_used}c: longint;');
  503. Add(' {#d_used}d: longint;');
  504. Add('begin');
  505. Add(' a:=+b;');
  506. Add(' a:=c+d;');
  507. Add('end;');
  508. Add('begin');
  509. Add(' DoIt;');
  510. AnalyzeProgram;
  511. end;
  512. procedure TTestUseAnalyzer.TestM_Const;
  513. begin
  514. StartProgram(false);
  515. Add([
  516. 'procedure {#DoIt_used}DoIt;',
  517. 'var',
  518. ' {#a_used}a: longint;',
  519. ' {#b_used}b: boolean;',
  520. ' {#c_used}c: array of longint;',
  521. ' {#d_used}d: string;',
  522. 'begin',
  523. ' a:=+1;',
  524. ' b:=true;',
  525. ' c:=nil;',
  526. ' d:=''foo'';',
  527. 'end;',
  528. 'begin',
  529. ' DoIt;']);
  530. AnalyzeProgram;
  531. end;
  532. procedure TTestUseAnalyzer.TestM_ResourceString;
  533. begin
  534. StartProgram(false);
  535. Add([
  536. 'resourcestring',
  537. 'resourcestring',
  538. ' {#a_used}a = ''txt'';',
  539. ' {#b_used}b = ''foo'';',
  540. 'procedure {#DoIt_used}DoIt(s: string);',
  541. 'var',
  542. ' {#d_used}d: string;',
  543. 'begin',
  544. ' d:=b;',
  545. 'end;',
  546. 'begin',
  547. ' DoIt(a);']);
  548. AnalyzeProgram;
  549. end;
  550. procedure TTestUseAnalyzer.TestM_Record;
  551. begin
  552. StartProgram(false);
  553. Add('procedure {#DoIt_used}DoIt;');
  554. Add('type');
  555. Add(' {#integer_used}integer = longint;');
  556. Add(' {#trec_used}TRec = record');
  557. Add(' {#a_used}a: integer;');
  558. Add(' {#b_notused}b: integer;');
  559. Add(' {#c_used}c: integer;');
  560. Add(' end;');
  561. Add('var');
  562. Add(' {#r_used}r: TRec;');
  563. Add('begin');
  564. Add(' r.a:=3;');
  565. Add(' with r do c:=4;');
  566. Add('end;');
  567. Add('begin');
  568. Add(' DoIt;');
  569. AnalyzeProgram;
  570. end;
  571. procedure TTestUseAnalyzer.TestM_Array;
  572. begin
  573. StartProgram(false);
  574. Add('procedure {#DoIt_used}DoIt;');
  575. Add('type');
  576. Add(' {#integer_used}integer = longint;');
  577. Add(' {#tarrayint_used}TArrayInt = array of integer;');
  578. Add('var');
  579. Add(' {#a_used}a: TArrayInt;');
  580. Add(' {#b_used}b: integer;');
  581. Add(' {#c_used}c: TArrayInt;');
  582. Add(' {#d_used}d: integer;');
  583. Add(' {#e_used}e: TArrayInt;');
  584. Add(' {#f_used}f: integer;');
  585. Add(' {#g_used}g: TArrayInt;');
  586. Add(' {#h_used}h: TArrayInt;');
  587. Add(' {#i_used}i: TArrayInt;');
  588. Add('begin');
  589. Add(' a[b]:=c[d];');
  590. Add(' SetLength(e,f);');
  591. Add(' if low(g)=high(h)+length(i) then');
  592. Add('end;');
  593. Add('begin');
  594. Add(' DoIt;');
  595. AnalyzeProgram;
  596. end;
  597. procedure TTestUseAnalyzer.TestM_NestedFuncResult;
  598. begin
  599. StartProgram(false);
  600. Add('procedure {#DoIt_used}DoIt;');
  601. Add('type');
  602. Add(' {#integer_used}integer = longint;');
  603. Add(' {#tarrayint_used}TArrayInt = array of integer;');
  604. Add(' function {#nestedfunc_used}NestedFunc({#b_notused}b: longint): TArrayInt;');
  605. Add(' begin');
  606. Add(' end;');
  607. Add('var');
  608. Add(' {#d_used}d: longint;');
  609. Add('begin');
  610. Add(' NestedFunc(d);');
  611. Add('end;');
  612. Add('begin');
  613. Add(' DoIt;');
  614. AnalyzeProgram;
  615. end;
  616. procedure TTestUseAnalyzer.TestM_Enums;
  617. begin
  618. StartProgram(false);
  619. Add('procedure {#DoIt_used}DoIt(const o);');
  620. Add('type');
  621. Add(' {#TEnum_used}TEnum = (red,blue);');
  622. Add(' {#TEnums_used}TEnums = set of TEnum;');
  623. Add('var');
  624. Add(' {#a_used}a: TEnum;');
  625. Add(' {#b_used}b: TEnums;');
  626. Add(' {#c_used}c: TEnum;');
  627. Add(' {#d_used}d: TEnums;');
  628. Add(' {#e_used}e: TEnums;');
  629. Add(' {#f_used}f: TEnums;');
  630. Add(' {#g_used}g: TEnum;');
  631. Add(' {#h_used}h: TEnum;');
  632. Add('begin');
  633. Add(' b:=[a];');
  634. Add(' if c in d then;');
  635. Add(' if low(e)=high(f) then;');
  636. Add(' if pred(g)=succ(h) then;');
  637. Add('end;');
  638. Add('var {#s_used}s: string;');
  639. Add('begin');
  640. Add(' DoIt(s);');
  641. AnalyzeProgram;
  642. end;
  643. procedure TTestUseAnalyzer.TestM_ProcedureType;
  644. begin
  645. StartProgram(false);
  646. Add('procedure {#DoIt_used}DoIt;');
  647. Add('type');
  648. Add(' {#TProc_used}TProc = procedure;');
  649. Add(' {#TFunc_used}TFunc = function(): longint;');
  650. Add('var');
  651. Add(' {#p_used}p: TProc;');
  652. Add(' {#f_used}f: TFunc;');
  653. Add('begin');
  654. Add(' p:=nil;');
  655. Add(' f:=nil;');
  656. Add('end;');
  657. Add('begin');
  658. Add(' DoIt;');
  659. AnalyzeProgram;
  660. end;
  661. procedure TTestUseAnalyzer.TestM_Params;
  662. begin
  663. StartProgram(false);
  664. Add('procedure {#DoIt_used}DoIt(const o);');
  665. Add('type');
  666. Add(' {#TEnum_used}TEnum = (red,blue);');
  667. Add('var');
  668. Add(' {#a_used}a: longint;');
  669. Add(' {#b_used}b: string;');
  670. Add(' {#c_used}c: longint;');
  671. Add(' {#d_used}d: TEnum;');
  672. Add('begin');
  673. Add(' DoIt(a);');
  674. Add(' DoIt(b[c]);');
  675. Add(' DoIt([d]);');
  676. Add(' DoIt(red);');
  677. Add('end;');
  678. Add('var {#s_used}s: string;');
  679. Add('begin');
  680. Add(' DoIt(s);');
  681. AnalyzeProgram;
  682. end;
  683. procedure TTestUseAnalyzer.TestM_Class;
  684. begin
  685. StartProgram(false);
  686. Add('type');
  687. Add(' {#integer_used}integer = longint;');
  688. Add(' {tobject_used}TObject = class');
  689. Add(' {#a_used}a: integer;');
  690. Add(' end;');
  691. Add('var Obj: TObject;');
  692. Add('begin');
  693. Add(' Obj.a:=3;');
  694. AnalyzeProgram;
  695. end;
  696. procedure TTestUseAnalyzer.TestM_ClassForward;
  697. begin
  698. StartProgram(false);
  699. Add('type');
  700. Add(' {#integer_notused}integer = longint;');
  701. Add(' {#TObject_used}TObject = class end;');
  702. Add(' TFelidae = class;');
  703. Add(' {#TCheetah_used}TCheetah = class');
  704. Add(' public');
  705. Add(' {#i_notused}i: integer;');
  706. Add(' {#f_used}f: TFelidae;');
  707. Add(' end;');
  708. Add(' {TFelidae_used}TFelidae = class');
  709. Add(' end;');
  710. Add('var {#c_used}c: TCheetah;');
  711. Add('begin');
  712. Add(' c.f:=nil;');
  713. AnalyzeProgram;
  714. end;
  715. procedure TTestUseAnalyzer.TestM_Class_Property;
  716. begin
  717. StartProgram(false);
  718. Add('type');
  719. Add(' {#integer_used}integer = longint;');
  720. Add(' {tobject_used}TObject = class');
  721. Add(' {#fa_used}Fa: integer;');
  722. Add(' {#fb_used}Fb: integer;');
  723. Add(' {#fc_used}Fc: integer;');
  724. Add(' {#fd_used}Fd: integer;');
  725. Add(' {#fe_notused}Fe: integer;');
  726. Add(' function {#getfc_used}GetFC: integer;');
  727. Add(' procedure {#setfd_used}SetFD({#setfd_value_used}Value: integer);');
  728. Add(' property {#A_used}A: integer read Fa write Fb;');
  729. Add(' property {#C_used}C: integer read GetFC write SetFD;');
  730. Add(' end;');
  731. Add('function TObject.GetFC: integer;');
  732. Add('begin');
  733. Add(' Result:=Fc;');
  734. Add('end;');
  735. Add('procedure TObject.SetFD({#setfd_value_impl_notused}Value: integer);');
  736. Add('begin');
  737. Add(' Fd:=Value;');
  738. Add('end;');
  739. Add('var Obj: TObject;');
  740. Add('begin');
  741. Add(' Obj.A:=Obj.A;');
  742. Add(' Obj.C:=Obj.C;');
  743. AnalyzeProgram;
  744. end;
  745. procedure TTestUseAnalyzer.TestM_Class_PropertyOverride;
  746. begin
  747. StartProgram(false);
  748. Add('type');
  749. Add(' {#integer_used}integer = longint;');
  750. Add(' {tobject_used}TObject = class');
  751. Add(' {#fa_used}FA: integer;');
  752. Add(' {#fb_notused}FB: integer;');
  753. Add(' property {#obj_a_notused}A: integer read FA write FB;');
  754. Add(' end;');
  755. Add(' {tmobile_used}TMobile = class(TObject)');
  756. Add(' {#fc_used}FC: integer;');
  757. Add(' property {#mob_a_used}A write FC;');
  758. Add(' end;');
  759. Add('var {#m_used}M: TMobile;');
  760. Add('begin');
  761. Add(' M.A:=M.A;');
  762. AnalyzeProgram;
  763. end;
  764. procedure TTestUseAnalyzer.TestM_Class_MethodOverride;
  765. begin
  766. StartProgram(false);
  767. Add('type');
  768. Add(' {tobject_used}TObject = class');
  769. Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
  770. Add(' procedure {#obj_dob_notused}DoB; virtual; abstract;');
  771. Add(' end;');
  772. Add(' {tmobile_used}TMobile = class(TObject)');
  773. Add(' constructor {#mob_create_used}Create;');
  774. Add(' procedure {#mob_doa_used}DoA; override;');
  775. Add(' procedure {#mob_dob_used}DoB; override;');
  776. Add(' end;');
  777. Add('constructor TMobile.Create; begin end;');
  778. Add('procedure TMobile.DoA; begin end;');
  779. Add('procedure TMobile.DoB; begin end;');
  780. Add('var {#o_used}o: TObject;');
  781. Add('begin');
  782. Add(' o:=TMobile.Create;'); // use TMobile before o.DoA
  783. Add(' o.DoA;');
  784. AnalyzeProgram;
  785. end;
  786. procedure TTestUseAnalyzer.TestM_Class_MethodOverride2;
  787. begin
  788. StartProgram(false);
  789. Add('type');
  790. Add(' {tobject_used}TObject = class');
  791. Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
  792. Add(' end;');
  793. Add(' {tmobile_used}TMobile = class(TObject)');
  794. Add(' constructor {#mob_create_used}Create;');
  795. Add(' procedure {#mob_doa_used}DoA; override;');
  796. Add(' end;');
  797. Add('constructor TMobile.Create; begin end;');
  798. Add('procedure TMobile.DoA; begin end;');
  799. Add('var {#o_used}o: TObject;');
  800. Add('begin');
  801. Add(' o.DoA;');
  802. Add(' o:=TMobile.Create;'); // use TMobile after o.DoA
  803. AnalyzeProgram;
  804. end;
  805. procedure TTestUseAnalyzer.TestM_ClassInterface_Ignore;
  806. begin
  807. StartProgram(false);
  808. Add([
  809. '{$modeswitch ignoreinterfaces}',
  810. 'type',
  811. ' TGUID = record end;',
  812. ' IUnknown = interface;',
  813. ' IUnknown = interface',
  814. ' [''{00000000-0000-0000-C000-000000000046}'']',
  815. ' function QueryInterface(const iid : tguid;out obj) : longint;',
  816. ' function _AddRef : longint; cdecl;',
  817. ' function _Release : longint; stdcall;',
  818. ' end;',
  819. ' IInterface = IUnknown;',
  820. ' TObject = class',
  821. ' ClassName: string;',
  822. ' end;',
  823. ' TInterfacedObject = class(TObject,IUnknown)',
  824. ' RefCount : longint;',
  825. ' end;',
  826. 'var i: TInterfacedObject;',
  827. 'begin',
  828. ' i.ClassName:=''a'';',
  829. ' i.RefCount:=3;',
  830. '']);
  831. AnalyzeProgram;
  832. end;
  833. procedure TTestUseAnalyzer.TestM_TryExceptStatement;
  834. begin
  835. StartProgram(false);
  836. Add('type');
  837. Add(' {tobject_used}TObject = class');
  838. Add(' constructor Create; external name ''create'';');
  839. Add(' end;');
  840. Add(' {texception_used}Exception = class(TObject);');
  841. Add(' {tdivbyzero_used}EDivByZero = class(Exception);');
  842. Add('procedure {#DoIt_used}DoIt;');
  843. Add('var');
  844. Add(' {#a_used}a: Exception;');
  845. Add(' {#b_used}b: Exception;');
  846. Add(' {#c_used}c: Exception;');
  847. Add(' {#d_used}d: Exception;');
  848. Add(' {#f_used}f: Exception;');
  849. Add('begin');
  850. Add(' try');
  851. Add(' a:=nil;');
  852. Add(' except');
  853. Add(' raise b;');
  854. Add(' end;');
  855. Add(' try');
  856. Add(' if Assigned(c) then ;');
  857. Add(' except');
  858. Add(' on {#e1_used}E1: Exception do raise;');
  859. Add(' on {#e2_notused}E2: EDivByZero do raise d;');
  860. Add(' else f:=nil;');
  861. Add(' end;');
  862. Add('end;');
  863. Add('begin');
  864. Add(' DoIt;');
  865. AnalyzeProgram;
  866. end;
  867. procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed;
  868. begin
  869. AddModuleWithIntfImplSrc('unit2.pp',
  870. LinesToStr([
  871. 'var i: longint;',
  872. 'procedure DoIt;',
  873. '']),
  874. LinesToStr([
  875. 'procedure DoIt; begin end;']));
  876. StartProgram(true);
  877. Add('uses unit2;');
  878. Add('begin');
  879. AnalyzeProgram;
  880. CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
  881. CheckUseAnalyzerUnexpectedHints;
  882. end;
  883. procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
  884. begin
  885. AddModuleWithIntfImplSrc('unit2.pp',
  886. LinesToStr([
  887. 'var State: longint; external name ''state'';',
  888. 'procedure DoIt; external name ''doing'';',
  889. '']),
  890. LinesToStr([
  891. ]));
  892. StartProgram(true);
  893. Add('uses unit2;');
  894. Add('begin');
  895. Add(' State:=3;');
  896. Add(' DoIt;');
  897. AnalyzeProgram;
  898. // unit hints: no hint, even though no code is actually used
  899. CheckUseAnalyzerUnexpectedHints;
  900. end;
  901. procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
  902. begin
  903. StartProgram(true);
  904. Add('procedure DoIt(i: longint);');
  905. Add('begin end;');
  906. Add('begin');
  907. Add(' DoIt(1);');
  908. AnalyzeProgram;
  909. CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
  910. CheckUseAnalyzerUnexpectedHints;
  911. end;
  912. procedure TTestUseAnalyzer.TestM_HintsOff_ParameterNotUsed;
  913. begin
  914. end;
  915. procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
  916. begin
  917. StartUnit(false);
  918. Add([
  919. 'interface',
  920. 'procedure DoIt(i: longint);',
  921. 'implementation',
  922. 'procedure DoIt(i: longint);',
  923. 'begin',
  924. '{$Hints off}',
  925. 'end;',
  926. 'begin',
  927. ' DoIt(3);']);
  928. AnalyzeUnit;
  929. CheckUseAnalyzerUnexpectedHints;
  930. end;
  931. procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
  932. begin
  933. StartProgram(true);
  934. Add('type');
  935. Add(' TObject = class');
  936. Add(' class procedure DoIt(i: longint); virtual; abstract;');
  937. Add(' end;');
  938. Add('begin');
  939. Add(' TObject.DoIt(3);');
  940. AnalyzeProgram;
  941. CheckUseAnalyzerUnexpectedHints;
  942. end;
  943. procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
  944. begin
  945. StartProgram(true);
  946. Add('type');
  947. Add(' TObject = class end;');
  948. Add(' TSortCompare = function(a,b: Pointer): integer;');
  949. Add(' TObjCompare = function(a,b: TObject): integer;');
  950. Add('procedure Sort(const Compare: TSortCompare);');
  951. Add('begin');
  952. Add(' Compare(nil,nil);');
  953. Add('end;');
  954. Add('procedure DoIt(const Compare: TObjCompare);');
  955. Add('begin');
  956. Add(' Sort(TSortCompare(Compare));');
  957. Add('end;');
  958. Add('begin');
  959. Add(' DoIt(nil);');
  960. AnalyzeProgram;
  961. CheckUseAnalyzerUnexpectedHints;
  962. end;
  963. procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
  964. begin
  965. StartProgram(true);
  966. Add('procedure DoIt(out x: longint);');
  967. Add('begin');
  968. Add(' x:=3;');
  969. Add('end;');
  970. Add('var i: longint;');
  971. Add('begin');
  972. Add(' DoIt(i);');
  973. AnalyzeProgram;
  974. CheckUseAnalyzerUnexpectedHints;
  975. end;
  976. procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
  977. begin
  978. StartProgram(false);
  979. Add([
  980. 'procedure AssertTrue(b: boolean);',
  981. 'begin',
  982. ' if b then ;',
  983. 'end;',
  984. 'procedure AssertFalse(b: boolean);',
  985. 'begin',
  986. ' AssertTrue(not b);',
  987. 'end;',
  988. 'begin',
  989. ' AssertFalse(true);',
  990. '']);
  991. AnalyzeProgram;
  992. CheckUseAnalyzerUnexpectedHints;
  993. end;
  994. procedure TTestUseAnalyzer.TestM_Hint_InheritedWithoutParams;
  995. begin
  996. StartProgram(false);
  997. Add([
  998. 'type',
  999. ' TObject = class',
  1000. ' constructor Create(i: longint); virtual;',
  1001. ' end;',
  1002. ' TBird = class',
  1003. ' constructor Create(i: longint); override;',
  1004. ' end;',
  1005. 'constructor TObject.Create(i: longint);',
  1006. 'begin',
  1007. ' if i=0 then ;',
  1008. 'end;',
  1009. 'constructor TBird.Create(i: longint);',
  1010. 'begin',
  1011. ' inherited;',
  1012. 'end;',
  1013. 'begin',
  1014. ' TBird.Create(3);']);
  1015. AnalyzeProgram;
  1016. CheckUseAnalyzerUnexpectedHints;
  1017. end;
  1018. procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
  1019. begin
  1020. StartProgram(true);
  1021. Add([
  1022. 'procedure DoIt;',
  1023. 'const',
  1024. ' a = 13;',
  1025. ' b: longint = 14;',
  1026. 'var',
  1027. ' c: char;',
  1028. ' d: longint = 15;',
  1029. 'begin',
  1030. 'end;',
  1031. 'begin',
  1032. ' DoIt;']);
  1033. AnalyzeProgram;
  1034. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
  1035. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
  1036. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
  1037. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
  1038. CheckUseAnalyzerUnexpectedHints;
  1039. end;
  1040. procedure TTestUseAnalyzer.TestM_HintsOff_LocalVariableNotUsed;
  1041. begin
  1042. StartProgram(true);
  1043. Add([
  1044. 'procedure DoIt;',
  1045. 'const',
  1046. ' a = 13;',
  1047. ' b: longint = 14;',
  1048. 'var',
  1049. ' c: char;',
  1050. ' d: longint = 15;',
  1051. 'begin',
  1052. '{$Hints off}',
  1053. 'end;',
  1054. 'begin',
  1055. ' DoIt;']);
  1056. AnalyzeProgram;
  1057. CheckUseAnalyzerUnexpectedHints;
  1058. end;
  1059. procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
  1060. begin
  1061. StartProgram(false);
  1062. Add([
  1063. 'procedure DoIt;',
  1064. 'var i: longint;',
  1065. 'begin',
  1066. ' for i:=1 to 2 do ;',
  1067. 'end;',
  1068. 'begin',
  1069. ' DoIt;',
  1070. '']);
  1071. AnalyzeProgram;
  1072. CheckUseAnalyzerUnexpectedHints;
  1073. end;
  1074. procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
  1075. begin
  1076. StartUnit(true);
  1077. Add('interface');
  1078. Add('const {#a_used}a = 1;');
  1079. Add('const {#b_used}b: longint = 2;');
  1080. Add('var {#c_used}c: longint = 3;');
  1081. Add('type');
  1082. Add(' {#TColor_used}TColor = longint;');
  1083. Add(' {#TFlag_used}TFlag = (red,green);');
  1084. Add(' {#TFlags_used}TFlags = set of TFlag;');
  1085. Add(' {#TArrInt_used}TArrInt = array of integer;');
  1086. Add('implementation');
  1087. Add('const {#d_notused}d = 1;');
  1088. Add('const {#e_notused}e: longint = 2;');
  1089. Add('var {#f_notused}f: longint = 3;');
  1090. Add('type');
  1091. Add(' {#ImpTColor_notused}ImpTColor = longint;');
  1092. Add(' {#ImpTFlag_notused}ImpTFlag = (red,green);');
  1093. Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
  1094. Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
  1095. AnalyzeUnit;
  1096. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
  1097. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
  1098. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
  1099. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
  1100. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
  1101. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
  1102. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
  1103. CheckUseAnalyzerUnexpectedHints;
  1104. end;
  1105. procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
  1106. begin
  1107. StartProgram(true);
  1108. Add('procedure DoIt(i: longint);');
  1109. Add('begin');
  1110. Add(' i:=3;');
  1111. Add('end;');
  1112. Add('begin');
  1113. Add(' DoIt(1);');
  1114. AnalyzeProgram;
  1115. CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
  1116. 'Value parameter "i" is assigned but never used');
  1117. CheckUseAnalyzerUnexpectedHints;
  1118. end;
  1119. procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
  1120. begin
  1121. StartProgram(true);
  1122. Add('procedure DoIt;');
  1123. Add('const');
  1124. Add(' a: longint = 14;');
  1125. Add('var');
  1126. Add(' b: char;');
  1127. Add(' c: longint = 15;');
  1128. Add('begin');
  1129. Add(' a:=16;');
  1130. Add(' b:=#65;');
  1131. Add(' c:=17;');
  1132. Add('end;');
  1133. Add('begin');
  1134. Add(' DoIt;');
  1135. AnalyzeProgram;
  1136. CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
  1137. 'Local variable "a" is assigned but never used');
  1138. CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
  1139. 'Local variable "b" is assigned but never used');
  1140. CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
  1141. 'Local variable "c" is assigned but never used');
  1142. CheckUseAnalyzerUnexpectedHints;
  1143. end;
  1144. procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
  1145. begin
  1146. StartProgram(true);
  1147. Add('procedure DoIt;');
  1148. Add('type');
  1149. Add(' TColor = longint;');
  1150. Add(' TFlag = (red,green);');
  1151. Add(' TFlags = set of TFlag;');
  1152. Add(' TArrInt = array of integer;');
  1153. Add(' procedure Sub; begin end;');
  1154. Add('begin');
  1155. Add('end;');
  1156. Add('begin');
  1157. Add(' DoIt;');
  1158. AnalyzeProgram;
  1159. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
  1160. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
  1161. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
  1162. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
  1163. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
  1164. CheckUseAnalyzerUnexpectedHints;
  1165. end;
  1166. procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
  1167. begin
  1168. StartProgram(true,[supTObject]);
  1169. Add('type');
  1170. Add(' TMobile = class');
  1171. Add(' private');
  1172. Add(' a: longint;');
  1173. Add(' end;');
  1174. Add('var m: TMobile;');
  1175. Add('begin');
  1176. Add(' m:=nil;');
  1177. AnalyzeProgram;
  1178. CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
  1179. 'Private field "TMobile.a" is never used');
  1180. CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
  1181. 'Local variable "m" is assigned but never used');
  1182. CheckUseAnalyzerUnexpectedHints;
  1183. end;
  1184. procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
  1185. begin
  1186. StartProgram(true,[supTObject]);
  1187. Add('type');
  1188. Add(' TMobile = class');
  1189. Add(' private');
  1190. Add(' a: longint;');
  1191. Add(' public');
  1192. Add(' constructor Create;');
  1193. Add(' end;');
  1194. Add('constructor TMobile.Create;');
  1195. Add('begin');
  1196. Add(' a:=3;');
  1197. Add('end;');
  1198. Add('begin');
  1199. Add(' TMobile.Create;');
  1200. AnalyzeProgram;
  1201. CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
  1202. 'Private field "TMobile.a" is assigned but never used');
  1203. CheckUseAnalyzerUnexpectedHints;
  1204. end;
  1205. procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
  1206. begin
  1207. StartProgram(true,[supTObject]);
  1208. Add('type');
  1209. Add(' TMobile = class');
  1210. Add(' private');
  1211. Add(' procedure DoSome; external name ''foo'';');
  1212. Add(' public');
  1213. Add(' constructor Create;');
  1214. Add(' end;');
  1215. Add('constructor TMobile.Create;');
  1216. Add('begin');
  1217. Add('end;');
  1218. Add('begin');
  1219. Add(' TMobile.Create;');
  1220. AnalyzeProgram;
  1221. CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
  1222. 'Private method "TMobile.DoSome" is never used');
  1223. CheckUseAnalyzerUnexpectedHints;
  1224. end;
  1225. procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
  1226. begin
  1227. StartProgram(true,[supTObject]);
  1228. Add('type');
  1229. Add(' TMobile = class');
  1230. Add(' private');
  1231. Add(' public');
  1232. Add(' constructor Create;');
  1233. Add(' destructor Destroy; override;');
  1234. Add(' end;');
  1235. Add('var DestroyCount: longint = 0;');
  1236. Add('constructor TMobile.Create;');
  1237. Add('begin');
  1238. Add('end;');
  1239. Add('destructor TMobile.Destroy;');
  1240. Add('begin');
  1241. Add(' inc(DestroyCount);');
  1242. Add(' inherited;');
  1243. Add('end;');
  1244. Add('var o: TObject;');
  1245. Add('begin');
  1246. Add(' o:=TMobile.Create;');
  1247. Add(' o.Destroy;');
  1248. AnalyzeProgram;
  1249. CheckUseAnalyzerUnexpectedHints;
  1250. end;
  1251. procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
  1252. begin
  1253. StartProgram(true,[supTObject]);
  1254. Add('type');
  1255. Add(' TMobile = class');
  1256. Add(' private');
  1257. Add(' type t = longint;');
  1258. Add(' public');
  1259. Add(' constructor Create;');
  1260. Add(' end;');
  1261. Add('constructor TMobile.Create;');
  1262. Add('begin');
  1263. Add('end;');
  1264. Add('begin');
  1265. Add(' TMobile.Create;');
  1266. AnalyzeProgram;
  1267. CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
  1268. 'Private type "TMobile.t" never used');
  1269. CheckUseAnalyzerUnexpectedHints;
  1270. end;
  1271. procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
  1272. begin
  1273. StartProgram(true,[supTObject]);
  1274. Add('type');
  1275. Add(' TMobile = class');
  1276. Add(' private');
  1277. Add(' const c = 3;');
  1278. Add(' public');
  1279. Add(' constructor Create;');
  1280. Add(' end;');
  1281. Add('constructor TMobile.Create;');
  1282. Add('begin');
  1283. Add('end;');
  1284. Add('begin');
  1285. Add(' TMobile.Create;');
  1286. AnalyzeProgram;
  1287. CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
  1288. 'Private const "TMobile.c" never used');
  1289. CheckUseAnalyzerUnexpectedHints;
  1290. end;
  1291. procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
  1292. begin
  1293. StartProgram(true,[supTObject]);
  1294. Add('type');
  1295. Add(' TMobile = class');
  1296. Add(' private');
  1297. Add(' FA: longint;');
  1298. Add(' property A: longint read FA;');
  1299. Add(' public');
  1300. Add(' constructor Create;');
  1301. Add(' end;');
  1302. Add('constructor TMobile.Create;');
  1303. Add('begin');
  1304. Add('end;');
  1305. Add('begin');
  1306. Add(' TMobile.Create;');
  1307. AnalyzeProgram;
  1308. CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
  1309. 'Private property "TMobile.A" never used');
  1310. CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
  1311. 'Private field "TMobile.FA" is never used');
  1312. CheckUseAnalyzerUnexpectedHints;
  1313. end;
  1314. procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
  1315. begin
  1316. StartProgram(true,[supTObject]);
  1317. Add('type');
  1318. Add(' TMobile = class');
  1319. Add(' public');
  1320. Add(' constructor Create;');
  1321. Add(' end;');
  1322. Add('constructor TMobile.Create;');
  1323. Add('begin');
  1324. Add('end;');
  1325. Add('var');
  1326. Add(' m: TMobile;');
  1327. Add('begin');
  1328. AnalyzeProgram;
  1329. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
  1330. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
  1331. CheckUseAnalyzerUnexpectedHints;
  1332. end;
  1333. procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
  1334. begin
  1335. StartProgram(true,[supTObject]);
  1336. Add('type');
  1337. Add(' TMobile = class');
  1338. Add(' public');
  1339. Add(' constructor Create;');
  1340. Add(' end;');
  1341. Add('constructor TMobile.Create;');
  1342. Add('begin');
  1343. Add('end;');
  1344. Add('var');
  1345. Add(' m: TMobile;');
  1346. Add('begin');
  1347. Add(' if m=nil then ;');
  1348. AnalyzeProgram;
  1349. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
  1350. CheckUseAnalyzerUnexpectedHints;
  1351. end;
  1352. procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedProc;
  1353. begin
  1354. StartProgram(true,[]);
  1355. Add('type');
  1356. Add('procedure DoIt;');
  1357. Add('var i: longint;');
  1358. Add('begin');
  1359. Add('end;');
  1360. Add('begin');
  1361. AnalyzeProgram;
  1362. CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
  1363. CheckUseAnalyzerUnexpectedHints;
  1364. end;
  1365. procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedMethod;
  1366. begin
  1367. StartProgram(true,[supTObject]);
  1368. Add('type');
  1369. Add(' TMobile = class');
  1370. Add(' private');
  1371. Add(' procedure DoIt;');
  1372. Add(' end;');
  1373. Add('procedure TMobile.DoIt;');
  1374. Add('var i: longint;');
  1375. Add('begin');
  1376. Add('end;');
  1377. Add('var');
  1378. Add(' m: TMobile;');
  1379. Add('begin');
  1380. Add(' if m=nil then ;');
  1381. AnalyzeProgram;
  1382. CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,'Private method "TMobile.DoIt" is never used');
  1383. CheckUseAnalyzerUnexpectedHints;
  1384. end;
  1385. procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
  1386. begin
  1387. StartProgram(true);
  1388. Add('procedure DoIt(i: longint); assembler;');
  1389. Add('type');
  1390. Add(' {#tcolor_notused}TColor = longint;');
  1391. Add(' {#tflag_notused}TFlag = (red,green);');
  1392. Add(' {#tflags_notused}TFlags = set of TFlag;');
  1393. Add(' {#tarrint_notused}TArrInt = array of integer;');
  1394. Add('const');
  1395. Add(' {#a_notused}a = 13;');
  1396. Add(' {#b_notused}b: longint = 14;');
  1397. Add('var');
  1398. Add(' {#c_notused}c: char;');
  1399. Add(' {#d_notused}d: longint = 15;');
  1400. Add(' procedure {#sub_notused}Sub; begin end;');
  1401. Add('asm end;');
  1402. Add('begin');
  1403. Add(' DoIt(1);');
  1404. AnalyzeProgram;
  1405. CheckUseAnalyzerUnexpectedHints;
  1406. end;
  1407. procedure TTestUseAnalyzer.TestM_Hint_AssemblerDelphiParameterIgnored;
  1408. begin
  1409. StartProgram(true);
  1410. Add([
  1411. '{$mode Delphi}',
  1412. 'procedure DoIt(i: longint);',
  1413. 'type',
  1414. ' {#tcolor_notused}TColor = longint;',
  1415. ' {#tflag_notused}TFlag = (red,green);',
  1416. ' {#tflags_notused}TFlags = set of TFlag;',
  1417. ' {#tarrint_notused}TArrInt = array of integer;',
  1418. 'const',
  1419. ' {#a_notused}a = 13;',
  1420. ' {#b_notused}b: longint = 14;',
  1421. 'var',
  1422. ' {#c_notused}c: char;',
  1423. ' {#d_notused}d: longint = 15;',
  1424. ' procedure {#sub_notused}Sub; begin end;',
  1425. 'asm end;',
  1426. 'begin',
  1427. ' DoIt(1);',
  1428. '']);
  1429. AnalyzeProgram;
  1430. CheckUseAnalyzerUnexpectedHints;
  1431. end;
  1432. procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
  1433. begin
  1434. StartProgram(true);
  1435. Add('function DoIt: longint;');
  1436. Add('begin end;');
  1437. Add('begin');
  1438. Add(' DoIt();');
  1439. AnalyzeProgram;
  1440. CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
  1441. sPAFunctionResultDoesNotSeemToBeSet);
  1442. CheckUseAnalyzerUnexpectedHints;
  1443. end;
  1444. procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
  1445. begin
  1446. StartProgram(true);
  1447. Add('type');
  1448. Add(' TObject = class');
  1449. Add(' class function DoIt: longint; virtual; abstract;');
  1450. Add(' end;');
  1451. Add('begin');
  1452. Add(' TObject.DoIt;');
  1453. AnalyzeProgram;
  1454. CheckUseAnalyzerUnexpectedHints;
  1455. end;
  1456. procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
  1457. begin
  1458. StartProgram(true);
  1459. Add('type');
  1460. Add(' TPoint = record X,Y:longint; end;');
  1461. Add('function Point(Left: longint): TPoint;');
  1462. Add('begin');
  1463. Add(' Result.X:=Left;');
  1464. Add('end;');
  1465. Add('begin');
  1466. Add(' Point(1);');
  1467. AnalyzeProgram;
  1468. CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
  1469. 'Local variable "X" is assigned but never used');
  1470. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
  1471. CheckUseAnalyzerUnexpectedHints;
  1472. end;
  1473. procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
  1474. begin
  1475. StartProgram(true);
  1476. Add('type');
  1477. Add(' TPoint = record X,Y:longint; end;');
  1478. Add('procedure Three(out x: longint);');
  1479. Add('begin');
  1480. Add(' x:=3;');
  1481. Add('end;');
  1482. Add('function Point(): TPoint;');
  1483. Add('begin');
  1484. Add(' Three(Result.X)');
  1485. Add('end;');
  1486. Add('begin');
  1487. Add(' Point();');
  1488. AnalyzeProgram;
  1489. CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
  1490. CheckUseAnalyzerUnexpectedHints;
  1491. end;
  1492. procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
  1493. begin
  1494. StartProgram(false);
  1495. Add([
  1496. 'procedure {#DoIt_used}DoIt({#p_used}p: pointer);',
  1497. 'var',
  1498. ' {#i_used}i: longint absolute p;',
  1499. ' {#j_used}j: longint absolute i;',
  1500. 'begin',
  1501. ' if j=3 then ;',
  1502. 'end;',
  1503. 'begin',
  1504. ' DoIt(nil);']);
  1505. CheckUseAnalyzerUnexpectedHints;
  1506. end;
  1507. procedure TTestUseAnalyzer.TestWP_LocalVar;
  1508. begin
  1509. StartProgram(false);
  1510. Add('var {#a_notused}a: longint;');
  1511. Add('var {#b_used}b: longint;');
  1512. Add('var {#c_used}c: longint;');
  1513. Add('begin');
  1514. Add(' b:=2;');
  1515. Add(' afile.c:=3;');
  1516. AnalyzeWholeProgram;
  1517. end;
  1518. procedure TTestUseAnalyzer.TestWP_UnitUsed;
  1519. begin
  1520. AddModuleWithIntfImplSrc('unit2.pp',
  1521. LinesToStr([
  1522. 'var i: longint;',
  1523. 'procedure DoIt;',
  1524. '']),
  1525. LinesToStr([
  1526. 'procedure DoIt; begin end;']));
  1527. StartProgram(true);
  1528. Add('uses unit2;');
  1529. Add('begin');
  1530. Add(' i:=3;');
  1531. AnalyzeWholeProgram;
  1532. CheckUnitUsed('unit2.pp',true);
  1533. end;
  1534. procedure TTestUseAnalyzer.TestWP_UnitUsed_ResourceString;
  1535. begin
  1536. AddModuleWithIntfImplSrc('unit2.pp',
  1537. LinesToStr([
  1538. 'resourcestring rs = ''txt'';',
  1539. 'procedure DoIt;',
  1540. '']),
  1541. LinesToStr([
  1542. 'procedure DoIt; begin end;']));
  1543. StartProgram(true);
  1544. Add('uses unit2;');
  1545. Add('begin');
  1546. Add(' if rs='''' then ;');
  1547. AnalyzeWholeProgram;
  1548. CheckUnitUsed('unit2.pp',true);
  1549. end;
  1550. procedure TTestUseAnalyzer.TestWP_UnitNotUsed;
  1551. begin
  1552. AddModuleWithIntfImplSrc('unit2.pp',
  1553. LinesToStr([
  1554. 'var i: longint;',
  1555. 'procedure DoIt;',
  1556. '']),
  1557. LinesToStr([
  1558. 'procedure DoIt; begin end;']));
  1559. StartProgram(true);
  1560. Add('uses');
  1561. Add(' unit2;');
  1562. Add('begin');
  1563. AnalyzeWholeProgram;
  1564. CheckUnitUsed('unit2.pp',false);
  1565. end;
  1566. procedure TTestUseAnalyzer.TestWP_UnitInitialization;
  1567. begin
  1568. AddModuleWithIntfImplSrc('unit1.pp',
  1569. LinesToStr([
  1570. 'uses unit2;',
  1571. '']),
  1572. LinesToStr([
  1573. 'initialization',
  1574. 'i:=2;']));
  1575. AddModuleWithIntfImplSrc('unit2.pp',
  1576. LinesToStr([
  1577. 'var i: longint;',
  1578. '']),
  1579. LinesToStr([
  1580. '']));
  1581. StartProgram(true);
  1582. Add('uses unit1;');
  1583. Add('begin');
  1584. AnalyzeWholeProgram;
  1585. CheckUnitUsed('unit1.pp',true);
  1586. CheckUnitUsed('unit2.pp',true);
  1587. end;
  1588. procedure TTestUseAnalyzer.TestWP_UnitFinalization;
  1589. begin
  1590. AddModuleWithIntfImplSrc('unit1.pp',
  1591. LinesToStr([
  1592. 'uses unit2;',
  1593. '']),
  1594. LinesToStr([
  1595. 'finalization',
  1596. 'i:=2;']));
  1597. AddModuleWithIntfImplSrc('unit2.pp',
  1598. LinesToStr([
  1599. 'var i: longint;',
  1600. '']),
  1601. LinesToStr([
  1602. '']));
  1603. StartProgram(true);
  1604. Add('uses unit1;');
  1605. Add('begin');
  1606. AnalyzeWholeProgram;
  1607. CheckUnitUsed('unit1.pp',true);
  1608. CheckUnitUsed('unit2.pp',true);
  1609. end;
  1610. procedure TTestUseAnalyzer.TestWP_CallInherited;
  1611. begin
  1612. StartProgram(false);
  1613. Add('type');
  1614. Add(' {#TObject_used}TObject = class');
  1615. Add(' procedure {#TObjectDoA_used}DoA;');
  1616. Add(' procedure {#TObjectDoB_used}DoB;');
  1617. Add(' end;');
  1618. Add(' {#TMobile_used}TMobile = class');
  1619. Add(' procedure {#TMobileDoA_used}DoA;');
  1620. Add(' procedure {#TMobileDoC_used}DoC;');
  1621. Add(' end;');
  1622. Add('procedure TObject.DoA; begin end;');
  1623. Add('procedure TObject.DoB; begin end;');
  1624. Add('procedure TMobile.DoA;');
  1625. Add('begin');
  1626. Add(' inherited;');
  1627. Add('end;');
  1628. Add('procedure TMobile.DoC;');
  1629. Add('begin');
  1630. Add(' inherited DoB;');
  1631. Add('end;');
  1632. Add('var o: TMobile;');
  1633. Add('begin');
  1634. Add(' o.DoA;');
  1635. Add(' o.DoC;');
  1636. AnalyzeWholeProgram;
  1637. end;
  1638. procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
  1639. begin
  1640. StartProgram(false);
  1641. Add('var');
  1642. Add(' {#vPublic_used}vPublic: longint; public;');
  1643. Add(' {#vPrivate_notused}vPrivate: longint;');
  1644. Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
  1645. Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
  1646. Add('begin');
  1647. AnalyzeWholeProgram;
  1648. end;
  1649. procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
  1650. begin
  1651. StartProgram(false);
  1652. Add('type');
  1653. Add(' {#tobject_used}TObject = class');
  1654. Add(' function {#getitems_notused}Getitems(Index: longint): string;');
  1655. Add(' procedure {#setitems_used}Setitems(Index: longint; Value: String);');
  1656. Add(' property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
  1657. Add(' end;');
  1658. Add('function TObject.Getitems(Index: longint): string; begin end;');
  1659. Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
  1660. Add('var');
  1661. Add(' {#l_used}L: TObject;');
  1662. Add('begin');
  1663. Add(' L[0]:=''birdy'';');
  1664. AnalyzeWholeProgram;
  1665. end;
  1666. procedure TTestUseAnalyzer.TestWP_Published;
  1667. begin
  1668. StartProgram(false);
  1669. Add('type');
  1670. Add(' {#tobject_used}TObject = class');
  1671. Add(' private');
  1672. Add(' {#fcol_used}FCol: string;');
  1673. Add(' {#fbird_notused}FBird: string;');
  1674. Add(' published');
  1675. Add(' {#fielda_used}FieldA: longint;');
  1676. Add(' procedure {#doit_used}ProcA; virtual; abstract;');
  1677. Add(' property {#col_used}Col: string read FCol;');
  1678. Add(' end;');
  1679. Add('var');
  1680. Add(' {#o_used}o: TObject;');
  1681. Add('begin');
  1682. Add(' o:=nil;');
  1683. AnalyzeWholeProgram;
  1684. end;
  1685. procedure TTestUseAnalyzer.TestWP_PublishedSetType;
  1686. begin
  1687. StartProgram(false);
  1688. Add('type');
  1689. Add(' {#tflag_used}TFlag = (red, green);');
  1690. Add(' {#tflags_used}TFlags = set of TFlag;');
  1691. Add(' {#tobject_used}TObject = class');
  1692. Add(' published');
  1693. Add(' {#fielda_used}FieldA: TFlag;');
  1694. Add(' {#fieldb_used}FieldB: TFlags;');
  1695. Add(' end;');
  1696. Add('var');
  1697. Add(' {#o_used}o: TObject;');
  1698. Add('begin');
  1699. Add(' o:=nil;');
  1700. AnalyzeWholeProgram;
  1701. end;
  1702. procedure TTestUseAnalyzer.TestWP_PublishedArrayType;
  1703. begin
  1704. StartProgram(false);
  1705. Add('type');
  1706. Add(' {#tdynarr_used}TDynArr = array of longint;');
  1707. Add(' {#tstatarr_used}TStatArr = array[boolean] of longint;');
  1708. Add(' {#tobject_used}TObject = class');
  1709. Add(' published');
  1710. Add(' {#fielda_used}FieldA: TDynArr;');
  1711. Add(' {#fieldb_used}FieldB: TStatArr;');
  1712. Add(' end;');
  1713. Add('var');
  1714. Add(' {#o_used}o: TObject;');
  1715. Add('begin');
  1716. Add(' o:=nil;');
  1717. AnalyzeWholeProgram;
  1718. end;
  1719. procedure TTestUseAnalyzer.TestWP_PublishedClassOfType;
  1720. begin
  1721. StartProgram(false);
  1722. Add('type');
  1723. Add(' {#tobjectclass_used}TObjectClass = class of TObject;');
  1724. Add(' {#tobject_used}TObject = class');
  1725. Add(' published');
  1726. Add(' {#fielda_used}FieldA: TObjectClass;');
  1727. Add(' end;');
  1728. Add(' {#tclass_used}TClass = class of TObject;');
  1729. Add('var');
  1730. Add(' {#c_used}c: TClass;');
  1731. Add('begin');
  1732. Add(' c:=nil;');
  1733. AnalyzeWholeProgram;
  1734. end;
  1735. procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
  1736. begin
  1737. StartProgram(false);
  1738. Add('type');
  1739. Add(' {#trec_used}TRec = record');
  1740. Add(' {treci_used}i: longint;');
  1741. Add(' end;');
  1742. Add(' {#tobject_used}TObject = class');
  1743. Add(' published');
  1744. Add(' {#fielda_used}FieldA: TRec;');
  1745. Add(' end;');
  1746. Add('var');
  1747. Add(' {#o_used}o: TObject;');
  1748. Add('begin');
  1749. Add(' o:=nil;');
  1750. AnalyzeWholeProgram;
  1751. end;
  1752. procedure TTestUseAnalyzer.TestWP_PublishedProcType;
  1753. begin
  1754. StartProgram(false);
  1755. Add('type');
  1756. Add(' {#ta_used}ta = array of longint;');
  1757. Add(' {#tb_used}tb = array of longint;');
  1758. Add(' {#tproca_used}TProcA = procedure;');
  1759. Add(' {#tfunca_used}TFuncA = function: ta;');
  1760. Add(' {#tprocb_used}TProcB = procedure(a: tb);');
  1761. Add(' {#tobject_used}TObject = class');
  1762. Add(' published');
  1763. Add(' {#fielda_used}FieldA: TProcA;');
  1764. Add(' {#fieldb_used}FieldB: TFuncA;');
  1765. Add(' {#fieldc_used}FieldC: TProcB;');
  1766. Add(' end;');
  1767. Add('var');
  1768. Add(' {#o_used}o: TObject;');
  1769. Add('begin');
  1770. Add(' o:=nil;');
  1771. AnalyzeWholeProgram;
  1772. end;
  1773. procedure TTestUseAnalyzer.TestWP_PublishedProperty;
  1774. begin
  1775. StartProgram(false);
  1776. Add('const');
  1777. Add(' {#defcol_used}DefCol = 3;');
  1778. Add(' {#defsize_notused}DefSize = 43;');
  1779. Add('type');
  1780. Add(' {#tobject_used}TObject = class');
  1781. Add(' private');
  1782. Add(' {#fcol_used}FCol: longint;');
  1783. Add(' {#fsize_used}FSize: longint;');
  1784. Add(' {#fbird_notused}FBird: string;');
  1785. Add(' {#fcolstored_used}FColStored: boolean;');
  1786. Add(' {#fsizestored_notused}FSizeStored: boolean;');
  1787. Add(' public');
  1788. Add(' property {#size_used}Size: longint read FSize stored FSizeStored default DefSize;');
  1789. Add(' published');
  1790. Add(' property {#col_used}Col: longint read FCol stored FColStored default DefCol;');
  1791. Add(' end;');
  1792. Add('var');
  1793. Add(' {#o_used}o: TObject;');
  1794. Add('begin');
  1795. Add(' if o.Size=13 then ;');
  1796. AnalyzeWholeProgram;
  1797. end;
  1798. procedure TTestUseAnalyzer.TestWP_BuiltInFunctions;
  1799. begin
  1800. StartProgram(false);
  1801. Add([
  1802. 'type',
  1803. ' {#tordenum_used}TOrdEnum = (ordenum1,ordenum2);',
  1804. 'begin',
  1805. ' if ord(ordenum1)=1 then ;',
  1806. '']);
  1807. AnalyzeWholeProgram;
  1808. end;
  1809. procedure TTestUseAnalyzer.TestWP_TypeInfo;
  1810. begin
  1811. StartProgram(false);
  1812. Add([
  1813. 'type',
  1814. ' {#integer_used}integer = longint;',
  1815. ' {#trec_used}TRec = record',
  1816. ' {#trecv_used}v: integer;',
  1817. ' end;',
  1818. ' {#tclass_used}TClass = class of TObject;',
  1819. ' {#tobject_used}TObject = class',
  1820. ' class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
  1821. ' end;',
  1822. ' {#tbirds_used}TBirds = class of TBird;',
  1823. ' {#tbird_used}TBird = class',
  1824. ' end;',
  1825. 'function {#getbirdclass_used}GetBirdClass: TBirds;',
  1826. 'begin',
  1827. ' Result:=nil;',
  1828. 'end;',
  1829. 'var',
  1830. ' {#i_used}i: integer;',
  1831. ' {#s_used}s: string;',
  1832. ' {#p_used}p: pointer;',
  1833. ' {#r_used}r: TRec;',
  1834. ' {#o_used}o: TObject;',
  1835. ' {#c_used}c: TClass;',
  1836. 'begin',
  1837. ' p:=typeinfo(integer);',
  1838. ' p:=typeinfo(longint);',
  1839. ' p:=typeinfo(i);',
  1840. ' p:=typeinfo(s);',
  1841. ' p:=typeinfo(p);',
  1842. ' p:=typeinfo(r.v);',
  1843. ' p:=typeinfo(TObject.ClassType);',
  1844. ' p:=typeinfo(o.ClassType);',
  1845. ' p:=typeinfo(o);',
  1846. ' p:=typeinfo(c);',
  1847. ' p:=typeinfo(c.ClassType);',
  1848. ' p:=typeinfo(GetBirdClass);',
  1849. '']);
  1850. AnalyzeWholeProgram;
  1851. end;
  1852. procedure TTestUseAnalyzer.TestWP_ForInClass;
  1853. begin
  1854. StartProgram(false);
  1855. Add([
  1856. 'type',
  1857. ' TObject = class',
  1858. ' end;',
  1859. ' {#tenumerator_used}TEnumerator = class',
  1860. ' strict private',
  1861. ' {#fcurrent_used}FCurrent: longint;',
  1862. ' public',
  1863. ' {#v_notused}v: string;',
  1864. ' function {#movenext_used}MoveNext: boolean;',
  1865. ' property {#current_used}Current: longint read FCurrent;',
  1866. ' end;',
  1867. ' {#tbird_used}TBird = class',
  1868. ' function {#getenumerator_used}GetEnumerator: TEnumerator;',
  1869. ' end;',
  1870. 'function TEnumerator.MoveNext: boolean;',
  1871. 'begin',
  1872. 'end;',
  1873. 'function TBird.GetEnumerator: TEnumerator;',
  1874. 'begin',
  1875. 'end;',
  1876. 'var',
  1877. ' {#b_used}b: TBird;',
  1878. ' {#i_used}i: longint;',
  1879. 'begin',
  1880. ' for i in b do ;',
  1881. '']);
  1882. AnalyzeWholeProgram;
  1883. end;
  1884. procedure TTestUseAnalyzer.TestWP_AssertSysUtils;
  1885. begin
  1886. AddModuleWithIntfImplSrc('SysUtils.pas',
  1887. LinesToStr([
  1888. 'type',
  1889. ' TObject = class',
  1890. ' constructor {#a_used}Create;',
  1891. ' end;',
  1892. ' {#e_used}EAssertionFailed = class',
  1893. ' constructor {#b_used}Create(s: string);',
  1894. ' end;',
  1895. '']),
  1896. LinesToStr([
  1897. 'constructor TObject.Create;',
  1898. 'begin end;',
  1899. 'constructor EAssertionFailed.Create(s: string);',
  1900. 'begin end;',
  1901. '']) );
  1902. StartProgram(true);
  1903. Add([
  1904. 'uses sysutils;',
  1905. 'procedure DoIt;',
  1906. 'var',
  1907. ' b: boolean;',
  1908. ' s: string;',
  1909. 'begin',
  1910. ' {$Assertions on}',
  1911. ' Assert(b);',
  1912. ' Assert(b,s);',
  1913. 'end;',
  1914. 'begin',
  1915. ' DoIt;',
  1916. '']);
  1917. AnalyzeWholeProgram;
  1918. end;
  1919. procedure TTestUseAnalyzer.TestWP_RangeErrorSysUtils;
  1920. begin
  1921. AddModuleWithIntfImplSrc('SysUtils.pas',
  1922. LinesToStr([
  1923. 'type',
  1924. ' TObject = class',
  1925. ' constructor {#a_used}Create;',
  1926. ' end;',
  1927. ' {#e_used}ERangeError = class',
  1928. ' end;',
  1929. '']),
  1930. LinesToStr([
  1931. 'constructor TObject.Create;',
  1932. 'begin end;',
  1933. '']) );
  1934. StartProgram(true);
  1935. Add([
  1936. 'uses sysutils;',
  1937. 'procedure DoIt;',
  1938. 'var',
  1939. ' b: byte;',
  1940. 'begin',
  1941. ' {$R+}',
  1942. ' b:=1;',
  1943. 'end;',
  1944. 'begin',
  1945. ' DoIt;',
  1946. '']);
  1947. AnalyzeWholeProgram;
  1948. end;
  1949. initialization
  1950. RegisterTests([TTestUseAnalyzer]);
  1951. end.