tcuseanalyzer.pas 89 KB

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