tcuseanalyzer.pas 82 KB

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