tcuseanalyzer.pas 93 KB

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