tcuseanalyzer.pas 82 KB

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