pasuseanalyzer.pas 86 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994
  1. {
  2. This file is part of the Free Component Library
  3. Pascal parse tree classes
  4. Copyright (c) 2017 Mattias Gaertner, [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {
  12. Abstract:
  13. After running TPasResolver, run this to
  14. - create a list of used declararion, either in a module or a whole program.
  15. - emit hints about unused declarations
  16. - and warnings about uninitialized variables.
  17. Working:
  18. - mark used elements of a module, starting from all accessible elements
  19. - Hint: 'Unit "%s" not used in %s'
  20. - Hint: 'Parameter "%s" not used'
  21. - Hint: 'Local variable "%s" not used'
  22. - Hint: 'Value parameter "%s" is assigned but never used'
  23. - Hint: 'Local variable "%s" is assigned but never used'
  24. - Hint: 'Local %s "%s" not used'
  25. - Hint: 'Private field "%s" is never used'
  26. - Hint: 'Private field "%s" is assigned but never used'
  27. - Hint: 'Private method "%s" is never used'
  28. - Hint: 'Private type "%s" never used'
  29. - Hint: 'Private const "%s" never used'
  30. - Hint: 'Private property "%s" never used'
  31. - Hint: 'Function result does not seem to be set'
  32. - TPasArgument: compute the effective Access
  33. - calls: use the effective Access of arguments
  34. }
  35. unit PasUseAnalyzer;
  36. {$mode objfpc}{$H+}
  37. {$inline on}
  38. {$ifdef fpc}
  39. {$define UsePChar}
  40. {$define HasInt64}
  41. {$endif}
  42. interface
  43. uses
  44. {$ifdef pas2js}
  45. js,
  46. {$else}
  47. AVL_Tree,
  48. {$endif}
  49. Classes, SysUtils, Types,
  50. PasTree, PScanner, PasResolveEval, PasResolver;
  51. const
  52. // non fpc hints
  53. nPAParameterInOverrideNotUsed = 4501;
  54. sPAParameterInOverrideNotUsed = 'Parameter "%s" not used';
  55. // fpc hints: use same IDs as fpc
  56. nPAUnitNotUsed = 5023;
  57. sPAUnitNotUsed = 'Unit "%s" not used in %s';
  58. nPAParameterNotUsed = 5024;
  59. sPAParameterNotUsed = 'Parameter "%s" not used';
  60. nPALocalVariableNotUsed = 5025;
  61. sPALocalVariableNotUsed = 'Local variable "%s" not used';
  62. nPAValueParameterIsAssignedButNeverUsed = 5026;
  63. sPAValueParameterIsAssignedButNeverUsed = 'Value parameter "%s" is assigned but never used';
  64. nPALocalVariableIsAssignedButNeverUsed = 5027;
  65. sPALocalVariableIsAssignedButNeverUsed = 'Local variable "%s" is assigned but never used';
  66. nPALocalXYNotUsed = 5028;
  67. sPALocalXYNotUsed = 'Local %s "%s" not used';
  68. nPAPrivateFieldIsNeverUsed = 5029;
  69. sPAPrivateFieldIsNeverUsed = 'Private field "%s" is never used';
  70. nPAPrivateFieldIsAssignedButNeverUsed = 5030;
  71. sPAPrivateFieldIsAssignedButNeverUsed = 'Private field "%s" is assigned but never used';
  72. nPAPrivateMethodIsNeverUsed = 5031;
  73. sPAPrivateMethodIsNeverUsed = 'Private method "%s" is never used';
  74. nPAFunctionResultDoesNotSeemToBeSet = 5033;
  75. sPAFunctionResultDoesNotSeemToBeSet = 'Function result does not seem to be set';
  76. nPAPrivateTypeXNeverUsed = 5071;
  77. sPAPrivateTypeXNeverUsed = 'Private type "%s" never used';
  78. nPAPrivateConstXNeverUsed = 5072;
  79. sPAPrivateConstXNeverUsed = 'Private const "%s" never used';
  80. nPAPrivatePropertyXNeverUsed = 5073;
  81. sPAPrivatePropertyXNeverUsed = 'Private property "%s" never used';
  82. type
  83. EPasAnalyzer = class(EPasResolve);
  84. { TPAMessage }
  85. TPAMessage = class
  86. private
  87. FRefCount: integer;
  88. public
  89. Id: TMaxPrecInt;
  90. MsgType: TMessageType;
  91. MsgNumber: integer;
  92. MsgText: string;
  93. MsgPattern: String;
  94. Args: TMessageArgs;
  95. PosEl: TPasElement;
  96. Filename: string;
  97. Row, Col: integer;
  98. constructor Create;
  99. procedure AddRef;
  100. procedure Release;
  101. property RefCount: integer read FRefCount;
  102. end;
  103. TPAMessageEvent = procedure(Sender: TObject; Msg: TPAMessage) of object;
  104. TPAIdentifierAccess = (
  105. paiaNone,
  106. paiaRead,
  107. paiaWrite,
  108. paiaReadWrite,
  109. paiaWriteRead
  110. );
  111. { TPAElement }
  112. TPAElement = class
  113. private
  114. FElement: TPasElement;
  115. procedure SetElement(AValue: TPasElement);
  116. public
  117. Access: TPAIdentifierAccess;
  118. destructor Destroy; override;
  119. property Element: TPasElement read FElement write SetElement;
  120. end;
  121. TPAElementClass = class of TPAElement;
  122. { TPAOverrideList
  123. used for
  124. - a method and its overrides
  125. - an interface method and its implementations
  126. - an interface and its delegations (property implements) }
  127. TPAOverrideList = class
  128. private
  129. FElement: TPasElement;
  130. FOverrides: TFPList; // list of TPasElement
  131. function GetOverrides(Index: integer): TPasElement; inline;
  132. procedure SetElement(AValue: TPasElement);
  133. public
  134. constructor Create;
  135. destructor Destroy; override;
  136. procedure Add(OverrideEl: TPasElement);
  137. property Element: TPasElement read FElement write SetElement;
  138. function Count: integer;
  139. function IndexOf(OverrideEl: TPasElement): integer; inline;
  140. property Overrides[Index: integer]: TPasElement read GetOverrides; default;
  141. end;
  142. {$ifdef pas2js}
  143. TPASItemToNameProc = function(Item: Pointer): String;
  144. {$endif}
  145. { TPasAnalyzerKeySet - set of items, each item has a key, no duplicate keys }
  146. TPasAnalyzerKeySet = class
  147. private
  148. {$ifdef pas2js}
  149. FItems: TJSObject;
  150. FCount: integer;
  151. FItemToName: TPASItemToNameProc;
  152. FKeyToName: TPASItemToNameProc;
  153. {$else}
  154. FTree: TAVLTree; // tree of pointers, sorted for keys given by OnItemToKey, no duplicate keys
  155. FCompareKeyWithData: TListSortCompare;
  156. {$endif}
  157. public
  158. {$ifdef pas2js}
  159. constructor Create(const OnItemToName, OnKeyToName: TPASItemToNameProc); reintroduce;
  160. {$else}
  161. constructor Create(const OnCompareMethod: TListSortCompare;
  162. const OnCompareKeyWithData: TListSortCompare);
  163. {$endif}
  164. destructor Destroy; override;
  165. procedure Clear;
  166. procedure FreeItems;
  167. procedure Add(Item: Pointer; CheckDuplicates: boolean = true);
  168. procedure Remove(Item: Pointer);
  169. function ContainsItem(Item: Pointer): boolean;
  170. function ContainsKey(Key: Pointer): boolean;
  171. function FindItem(Item: Pointer): Pointer;
  172. function FindKey(Key: Pointer): Pointer;
  173. function Count: integer;
  174. function GetList: TFPList; // list of items
  175. end;
  176. TPasAnalyzerOption = (
  177. paoOnlyExports, // default: use all class members accessible from outside (protected, but not private)
  178. paoImplReferences // collect references of top lvl proc implementations, initializationa dn finalization sections
  179. );
  180. TPasAnalyzerOptions = set of TPasAnalyzerOption;
  181. TPAUseMode = (
  182. paumElement, // Mark element. Do not descend into children.
  183. paumAllPasUsable, // Mark element and descend into children and mark non private identifiers
  184. paumAllExports, // Do not mark element. Descend into children and mark exports.
  185. paumTypeInfo // Mark element and its type and descend into children and mark published identifiers
  186. );
  187. TPAUseModes = set of TPAUseMode;
  188. const
  189. PAUseModeToPSRefAccess: array[TPAUseMode] of TPSRefAccess = (
  190. psraRead,
  191. psraRead,
  192. psraRead,
  193. psraTypeInfo
  194. );
  195. type
  196. TPAOtherCheckedEl = (
  197. pocClassConstructor
  198. );
  199. { TPasAnalyzer }
  200. TPasAnalyzer = class
  201. private
  202. FModeChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
  203. FOtherChecked: array[TPAOtherCheckedEl] of TPasAnalyzerKeySet; // tree of TElement
  204. FOnMessage: TPAMessageEvent;
  205. FOptions: TPasAnalyzerOptions;
  206. FOverrideLists: TPasAnalyzerKeySet; // tree of TPAOverrideList sorted for Element
  207. FResolver: TPasResolver;
  208. FScopeModule: TPasModule;
  209. FUsedElements: TPasAnalyzerKeySet; // tree of TPAElement sorted for Element
  210. procedure UseElType(El: TPasElement; aType: TPasType; Mode: TPAUseMode); inline;
  211. function AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
  212. procedure SetOptions(AValue: TPasAnalyzerOptions);
  213. procedure UpdateAccess(IsWrite: Boolean; IsRead: Boolean; Usage: TPAElement);
  214. procedure OnUseScopeRef(Data, DeclScope: pointer);
  215. protected
  216. procedure RaiseInconsistency(const Id: TMaxPrecInt; Msg: string);
  217. procedure RaiseNotSupported(const Id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
  218. function FindTopImplScope(El: TPasElement): TPasScope;
  219. // mark used elements
  220. function Add(El: TPasElement; CheckDuplicate: boolean = true;
  221. aClass: TPAElementClass = nil): TPAElement;
  222. function PAElementExists(El: TPasElement): boolean; inline;
  223. procedure CreateTree; virtual;
  224. function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
  225. function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean; overload;
  226. function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
  227. procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
  228. procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
  229. UseFull: boolean); virtual;
  230. procedure UseTypeInfo(El: TPasElement); virtual;
  231. procedure UseAttributes(El: TPasElement); virtual;
  232. function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
  233. procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
  234. procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
  235. procedure UseImplElement(El: TPasImplElement); virtual;
  236. procedure UseExpr(El: TPasExpr); virtual;
  237. procedure UseExprRef(El: TPasElement; Expr: TPasExpr;
  238. Access: TResolvedRefAccess; UseFull: boolean); virtual;
  239. procedure UseInheritedExpr(El: TInheritedExpr); virtual;
  240. procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
  241. procedure UseProcedure(Proc: TPasProcedure); virtual;
  242. procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
  243. procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
  244. procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
  245. procedure UseClassConstructor(El: TPasMembersType); virtual;
  246. procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
  247. UseFull: boolean); virtual;
  248. procedure UseResourcestring(El: TPasResString); virtual;
  249. procedure UseArgument(El: TPasArgument; Access: TResolvedRefAccess); virtual;
  250. procedure UseResultElement(El: TPasResultElement; Access: TResolvedRefAccess); virtual;
  251. // create hints for a unit, program or library
  252. procedure EmitElementHints(El: TPasElement); virtual;
  253. procedure EmitSectionHints(Section: TPasSection); virtual;
  254. procedure EmitDeclarationsHints(El: TPasDeclarations); virtual;
  255. procedure EmitTypeHints(El: TPasType); virtual;
  256. procedure EmitVariableHints(El: TPasVariable); virtual;
  257. procedure EmitProcedureHints(El: TPasProcedure); virtual;
  258. public
  259. constructor Create;
  260. destructor Destroy; override;
  261. procedure Clear;
  262. procedure AnalyzeModule(aModule: TPasModule);
  263. procedure AnalyzeWholeProgram(aStartModule: TPasProgram);
  264. procedure EmitModuleHints(aModule: TPasModule); virtual;
  265. function FindElement(El: TPasElement): TPAElement; inline;
  266. function FindUsedElement(El: TPasElement): TPAElement;
  267. // utility
  268. function IsUsed(El: TPasElement): boolean; // valid after calling Analyze*
  269. function IsTypeInfoUsed(El: TPasElement): boolean; // valid after calling Analyze*
  270. function IsModuleInternal(El: TPasElement): boolean;
  271. function IsExport(El: TPasElement): boolean;
  272. function IsIdentifier(El: TPasElement): boolean;
  273. function IsImplBlockEmpty(El: TPasImplBlock): boolean;
  274. procedure EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
  275. MsgNumber: integer; Fmt: String;
  276. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  277. PosEl: TPasElement);
  278. procedure EmitMessage(Msg: TPAMessage);
  279. class function GetWarnIdentifierNumbers(Identifier: string;
  280. out MsgNumbers: TIntegerDynArray): boolean; virtual;
  281. function GetUsedElements: TFPList; virtual; // list of TPAElement
  282. property OnMessage: TPAMessageEvent read FOnMessage write FOnMessage;
  283. property Options: TPasAnalyzerOptions read FOptions write SetOptions;
  284. property Resolver: TPasResolver read FResolver write FResolver;
  285. property ScopeModule: TPasModule read FScopeModule write FScopeModule;
  286. end;
  287. {$ifdef pas2js}
  288. function PasElementToHashName(Item: Pointer): String;
  289. function PAElement_ElToHashName(Item: Pointer): String;
  290. function PAOverrideList_ElToHashName(Item: Pointer): String;
  291. {$else}
  292. function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
  293. function CompareElementWithPAElement(El, Id: Pointer): integer;
  294. function ComparePAOverrideLists(List1, List2: Pointer): integer;
  295. function CompareElementWithPAOverrideList(El, List: Pointer): integer;
  296. {$endif}
  297. function GetElModName(El: TPasElement): string;
  298. function dbgs(a: TPAIdentifierAccess): string; overload;
  299. implementation
  300. {$ifdef pas2js}
  301. function PasElementToHashName(Item: Pointer): String;
  302. var
  303. El: TPasElement absolute Item;
  304. begin
  305. Result:=string(jsvalue(El.PasElementId));
  306. end;
  307. function PAElement_ElToHashName(Item: Pointer): String;
  308. var
  309. El: TPAElement absolute Item;
  310. begin
  311. Result:=string(jsvalue(El.Element.PasElementId));
  312. end;
  313. function PAOverrideList_ElToHashName(Item: Pointer): String;
  314. var
  315. List: TPAOverrideList absolute Item;
  316. begin
  317. Result:=string(jsvalue(List.Element.PasElementId));
  318. end;
  319. {$else}
  320. function ComparePointer(Data1, Data2: Pointer): integer;
  321. begin
  322. if Data1>Data2 then Result:=-1
  323. else if Data1<Data2 then Result:=1
  324. else Result:=0;
  325. end;
  326. function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
  327. var
  328. Item1: TPAElement absolute Identifier1;
  329. Item2: TPAElement absolute Identifier2;
  330. begin
  331. Result:=ComparePointer(Item1.Element,Item2.Element);
  332. end;
  333. function CompareElementWithPAElement(El, Id: Pointer): integer;
  334. var
  335. Identifier: TPAElement absolute Id;
  336. begin
  337. Result:=ComparePointer(El,Identifier.Element);
  338. end;
  339. function ComparePAOverrideLists(List1, List2: Pointer): integer;
  340. var
  341. Item1: TPAOverrideList absolute List1;
  342. Item2: TPAOverrideList absolute List2;
  343. begin
  344. Result:=ComparePointer(Item1.Element,Item2.Element);
  345. end;
  346. function CompareElementWithPAOverrideList(El, List: Pointer): integer;
  347. var
  348. OvList: TPAOverrideList absolute List;
  349. begin
  350. Result:=ComparePointer(El,OvList.Element);
  351. end;
  352. {$endif}
  353. function GetElModName(El: TPasElement): string;
  354. var
  355. aModule: TPasModule;
  356. begin
  357. if El=nil then exit('nil');
  358. Result:=El.PathName+':'+El.ClassName;
  359. aModule:=El.GetModule;
  360. if aModule=El then exit;
  361. if aModule=nil then
  362. Result:='NilModule.'+Result;
  363. end;
  364. function dbgs(a: TPAIdentifierAccess): string;
  365. begin
  366. str(a,Result);
  367. end;
  368. { TPasAnalyzerKeySet }
  369. {$ifdef pas2js}
  370. constructor TPasAnalyzerKeySet.Create(const OnItemToName,
  371. OnKeyToName: TPASItemToNameProc);
  372. begin
  373. FItemToName:=OnItemToName;
  374. FKeyToName:=OnKeyToName;
  375. FItems:=TJSObject.new;
  376. end;
  377. {$else}
  378. constructor TPasAnalyzerKeySet.Create(const OnCompareMethod: TListSortCompare;
  379. const OnCompareKeyWithData: TListSortCompare);
  380. begin
  381. FTree:=TAVLTree.Create(OnCompareMethod);
  382. FCompareKeyWithData:=OnCompareKeyWithData;
  383. end;
  384. {$endif}
  385. destructor TPasAnalyzerKeySet.Destroy;
  386. begin
  387. {$ifdef pas2js}
  388. FItems:=nil;
  389. {$else}
  390. FreeAndNil(FTree);
  391. {$endif}
  392. inherited Destroy;
  393. end;
  394. procedure TPasAnalyzerKeySet.Clear;
  395. begin
  396. {$ifdef pas2js}
  397. FItems:=TJSObject.new;
  398. FCount:=0;
  399. {$else}
  400. FTree.Clear;
  401. {$endif}
  402. end;
  403. procedure TPasAnalyzerKeySet.FreeItems;
  404. {$ifdef pas2js}
  405. var
  406. List: TStringDynArray;
  407. i: Integer;
  408. begin
  409. List:=TJSObject.getOwnPropertyNames(FItems);
  410. for i:=0 to length(List)-1 do
  411. TObject(FItems[List[i]]).Destroy;
  412. FItems:=TJSObject.new;
  413. FCount:=0;
  414. end;
  415. {$else}
  416. begin
  417. FTree.FreeAndClear;
  418. end;
  419. {$endif}
  420. procedure TPasAnalyzerKeySet.Add(Item: Pointer; CheckDuplicates: boolean);
  421. begin
  422. if CheckDuplicates {$IFDEF VerbosePasAnalyzer}or true{$endif} then
  423. if ContainsItem(Item) then
  424. raise Exception.Create('[20181101151755] TPasAnalyzerSet.Add duplicate');
  425. {$ifdef pas2js}
  426. FItems['%'+FItemToName(Item)]:=Item;
  427. inc(FCount);
  428. {$else}
  429. FTree.Add(Item);
  430. {$endif}
  431. {$ifdef VerbosePasAnalyzer}
  432. if not ContainsItem(Item) then
  433. raise Exception.Create('[20181101151811] TPasAnalyzerSet.Add failed');
  434. {$endif}
  435. end;
  436. procedure TPasAnalyzerKeySet.Remove(Item: Pointer);
  437. {$ifdef pas2js}
  438. var
  439. aName: string;
  440. begin
  441. aName:='%'+FItemToName(Item);
  442. if not FItems.hasOwnProperty(aName) then exit;
  443. JSDelete(FItems,aName);
  444. dec(FCount);
  445. end;
  446. {$else}
  447. begin
  448. FTree.Remove(Item);
  449. end;
  450. {$endif}
  451. function TPasAnalyzerKeySet.ContainsItem(Item: Pointer): boolean;
  452. begin
  453. {$ifdef pas2js}
  454. Result:=FItems.hasOwnProperty('%'+FItemToName(Item));
  455. {$else}
  456. Result:=FTree.Find(Item)<>nil;
  457. {$endif}
  458. end;
  459. function TPasAnalyzerKeySet.ContainsKey(Key: Pointer): boolean;
  460. begin
  461. {$ifdef pas2js}
  462. Result:=FItems.hasOwnProperty('%'+FKeyToName(Key));
  463. {$else}
  464. Result:=FTree.FindKey(Key,FCompareKeyWithData)<>nil;
  465. {$endif}
  466. end;
  467. function TPasAnalyzerKeySet.FindItem(Item: Pointer): Pointer;
  468. {$ifdef pas2js}
  469. var
  470. aName: string;
  471. begin
  472. aName:='%'+FItemToName(Item);
  473. if not FItems.hasOwnProperty(aName) then
  474. exit(nil)
  475. else
  476. Result:=Pointer(FItems[aName]);
  477. end;
  478. {$else}
  479. var
  480. Node: TAVLTreeNode;
  481. begin
  482. Node:=FTree.Find(Item);
  483. if Node<>nil then
  484. Result:=Node.Data
  485. else
  486. Result:=nil;
  487. end;
  488. {$endif}
  489. function TPasAnalyzerKeySet.FindKey(Key: Pointer): Pointer;
  490. {$ifdef pas2js}
  491. var
  492. aName: string;
  493. begin
  494. aName:='%'+FKeyToName(Key);
  495. if not FItems.hasOwnProperty(aName) then
  496. exit(nil)
  497. else
  498. Result:=Pointer(FItems[aName]);
  499. end;
  500. {$else}
  501. var
  502. Node: TAVLTreeNode;
  503. begin
  504. Node:=FTree.FindKey(Key,FCompareKeyWithData);
  505. if Node<>nil then
  506. Result:=Node.Data
  507. else
  508. Result:=nil;
  509. end;
  510. {$endif}
  511. function TPasAnalyzerKeySet.Count: integer;
  512. begin
  513. {$ifdef pas2js}
  514. Result:=FCount;
  515. {$else}
  516. Result:=FTree.Count;
  517. {$endif}
  518. end;
  519. function TPasAnalyzerKeySet.GetList: TFPList;
  520. {$ifdef pas2js}
  521. var
  522. List: TStringDynArray;
  523. i: Integer;
  524. begin
  525. List:=TJSObject.getOwnPropertyNames(FItems);
  526. Result:=TFPList.Create;
  527. for i:=0 to length(List)-1 do
  528. Result.Add(FItems[List[i]]);
  529. end;
  530. {$else}
  531. var
  532. Node: TAVLTreeNode;
  533. begin
  534. Result:=TFPList.Create;
  535. Node:=FTree.FindLowest;
  536. while Node<>nil do
  537. begin
  538. Result.Add(Node.Data);
  539. Node:=FTree.FindSuccessor(Node);
  540. end;
  541. end;
  542. {$endif}
  543. { TPAMessage }
  544. constructor TPAMessage.Create;
  545. begin
  546. FRefCount:=1;
  547. end;
  548. procedure TPAMessage.AddRef;
  549. begin
  550. inc(FRefCount);
  551. end;
  552. procedure TPAMessage.Release;
  553. begin
  554. if FRefCount=0 then
  555. raise Exception.Create('');
  556. dec(FRefCount);
  557. if FRefCount=0 then
  558. {$ifdef pas2js}
  559. Destroy;
  560. {$else}
  561. Free;
  562. {$endif}
  563. end;
  564. { TPAOverrideList }
  565. // inline
  566. function TPAOverrideList.GetOverrides(Index: integer): TPasElement;
  567. begin
  568. Result:=TPasElement(FOverrides[Index]);
  569. end;
  570. // inline
  571. function TPAOverrideList.IndexOf(OverrideEl: TPasElement): integer;
  572. begin
  573. Result:=FOverrides.IndexOf(OverrideEl);
  574. end;
  575. procedure TPAOverrideList.SetElement(AValue: TPasElement);
  576. begin
  577. if FElement=AValue then Exit;
  578. if FElement<>nil then
  579. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPAOverrideList.Element'){$ENDIF};
  580. FElement:=AValue;
  581. if FElement<>nil then
  582. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPAOverrideList.Element'){$ENDIF};
  583. end;
  584. constructor TPAOverrideList.Create;
  585. begin
  586. FOverrides:=TFPList.Create;
  587. end;
  588. destructor TPAOverrideList.Destroy;
  589. var
  590. i: Integer;
  591. begin
  592. for i:=0 to FOverrides.Count-1 do
  593. TPasElement(FOverrides[i]).Release{$IFDEF CheckPasTreeRefCount}('TPAOverrideList.Overrides'){$ENDIF};
  594. FreeAndNil(FOverrides);
  595. Element:=nil;
  596. inherited Destroy;
  597. end;
  598. procedure TPAOverrideList.Add(OverrideEl: TPasElement);
  599. begin
  600. FOverrides.Add(OverrideEl);
  601. OverrideEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPAOverrideList.Overrides'){$ENDIF};
  602. end;
  603. function TPAOverrideList.Count: integer;
  604. begin
  605. Result:=FOverrides.Count;
  606. end;
  607. { TPAElement }
  608. procedure TPAElement.SetElement(AValue: TPasElement);
  609. begin
  610. if FElement=AValue then Exit;
  611. if FElement<>nil then
  612. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPAElement.Element'){$ENDIF};
  613. FElement:=AValue;
  614. if FElement<>nil then
  615. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPAElement.Element'){$ENDIF};
  616. end;
  617. destructor TPAElement.Destroy;
  618. begin
  619. Element:=nil;
  620. inherited Destroy;
  621. end;
  622. { TPasAnalyzer }
  623. // inline
  624. function TPasAnalyzer.PAElementExists(El: TPasElement): boolean;
  625. begin
  626. Result:=FUsedElements.ContainsKey(El);
  627. end;
  628. // inline
  629. procedure TPasAnalyzer.UseElType(El: TPasElement; aType: TPasType;
  630. Mode: TPAUseMode);
  631. begin
  632. if aType=nil then exit;
  633. MarkImplScopeRef(El,aType,PAUseModeToPSRefAccess[Mode]);
  634. UseType(aType,Mode);
  635. end;
  636. // inline
  637. function TPasAnalyzer.FindElement(El: TPasElement): TPAElement;
  638. begin
  639. Result:=TPAElement(FUsedElements.FindKey(El));
  640. end;
  641. procedure TPasAnalyzer.SetOptions(AValue: TPasAnalyzerOptions);
  642. begin
  643. if FOptions=AValue then Exit;
  644. FOptions:=AValue;
  645. end;
  646. function TPasAnalyzer.AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
  647. // OverrideEl overrides OverriddenEl
  648. // returns true if new override
  649. var
  650. Item: TPAOverrideList;
  651. OverriddenPAEl: TPAElement;
  652. TypeEl: TPasType;
  653. begin
  654. {$IFDEF VerbosePasAnalyzer}
  655. writeln('TPasAnalyzer.AddOverride OverriddenEl=',GetElModName(OverriddenEl),' OverrideEl=',GetElModName(OverrideEl));
  656. {$ENDIF}
  657. Item:=TPAOverrideList(FOverrideLists.FindKey(OverriddenEl));
  658. if Item=nil then
  659. begin
  660. Item:=TPAOverrideList.Create;
  661. Item.Element:=OverriddenEl;
  662. FOverrideLists.Add(Item,false);
  663. end
  664. else
  665. begin
  666. if Item.IndexOf(OverrideEl)>=0 then
  667. exit(false);
  668. end;
  669. // new override
  670. Item.Add(OverrideEl);
  671. Result:=true;
  672. OverriddenPAEl:=FindElement(OverriddenEl);
  673. if OverriddenPAEl<>nil then
  674. begin
  675. // OverriddenEl was already used -> use OverrideEl
  676. if OverrideEl.ClassType=TPasProperty then
  677. begin
  678. if OverriddenEl is TPasType then
  679. begin
  680. TypeEl:=Resolver.ResolveAliasTypeEl(TPasType(OverriddenEl));
  681. if (TypeEl.ClassType=TPasClassType)
  682. and (TPasClassType(TypeEl).ObjKind=okInterface) then
  683. begin
  684. // interface was already used -> use delegation / property implements
  685. UseVariable(TPasProperty(OverrideEl),rraRead,false);
  686. exit;
  687. end;
  688. end;
  689. RaiseNotSupported(20180328221736,OverrideEl,GetElModName(OverriddenEl));
  690. end
  691. else
  692. UseElement(OverrideEl,rraNone,true);
  693. end;
  694. end;
  695. procedure TPasAnalyzer.UpdateAccess(IsWrite: Boolean; IsRead: Boolean;
  696. Usage: TPAElement);
  697. begin
  698. if IsRead then
  699. case Usage.Access of
  700. paiaNone: Usage.Access:=paiaRead;
  701. paiaRead: ;
  702. paiaWrite: Usage.Access:=paiaWriteRead;
  703. paiaReadWrite: ;
  704. paiaWriteRead: ;
  705. else RaiseInconsistency(20170311183122, '');
  706. end;
  707. if IsWrite then
  708. case Usage.Access of
  709. paiaNone: Usage.Access:=paiaWrite;
  710. paiaRead: Usage.Access:=paiaReadWrite;
  711. paiaWrite: ;
  712. paiaReadWrite: ;
  713. paiaWriteRead: ;
  714. else RaiseInconsistency(20170311183127, '');
  715. end;
  716. end;
  717. procedure TPasAnalyzer.OnUseScopeRef(Data, DeclScope: pointer);
  718. var
  719. Ref: TPasScopeReference absolute data;
  720. Scope: TPasScope absolute DeclScope;
  721. begin
  722. if Scope=nil then ;
  723. while Ref<>nil do
  724. begin
  725. case Ref.Access of
  726. psraNone: ;
  727. psraRead: UseElement(Ref.Element,rraRead,false);
  728. psraWrite: UseElement(Ref.Element,rraAssign,false);
  729. psraReadWrite: UseElement(Ref.Element,rraReadAndAssign,false);
  730. psraWriteRead:
  731. begin
  732. UseElement(Ref.Element,rraAssign,false);
  733. UseElement(Ref.Element,rraRead,false);
  734. end;
  735. psraTypeInfo: UseTypeInfo(Ref.Element);
  736. else
  737. RaiseNotSupported(20180228191928,Ref.Element,dbgs(Ref.Access));
  738. end;
  739. Ref:=Ref.NextSameName;
  740. end;
  741. end;
  742. procedure TPasAnalyzer.RaiseInconsistency(const Id: TMaxPrecInt; Msg: string);
  743. begin
  744. {$IFDEF VerbosePasAnalyzer}
  745. writeln('TPasAnalyzer.RaiseInconsistency ['+IntToStr(Id)+']: '+Msg);
  746. {$ENDIF}
  747. raise EPasAnalyzer.Create('['+IntToStr(Id)+']: '+Msg);
  748. end;
  749. procedure TPasAnalyzer.RaiseNotSupported(const Id: TMaxPrecInt; El: TPasElement;
  750. const Msg: string);
  751. var
  752. s: String;
  753. E: EPasAnalyzer;
  754. begin
  755. s:='['+IntToStr(Id)+']: Element='+GetElModName(El);
  756. if Msg<>'' then S:=S+' '+Msg;
  757. E:=EPasAnalyzer.Create(s);
  758. E.PasElement:=El;
  759. {$IFDEF VerbosePasAnalyzer}
  760. writeln('TPasAnalyzer.RaiseNotSupported ',E.Message);
  761. {$ENDIF}
  762. raise E;
  763. end;
  764. function TPasAnalyzer.FindTopImplScope(El: TPasElement): TPasScope;
  765. var
  766. ProcScope: TPasProcedureScope;
  767. C: TClass;
  768. ImplProc: TPasProcedure;
  769. begin
  770. Result:=nil;
  771. while El<>nil do
  772. begin
  773. C:=El.ClassType;
  774. if C.InheritsFrom(TPasProcedure) then
  775. begin
  776. ProcScope:=TPasProcedureScope(El.CustomData);
  777. if ProcScope.DeclarationProc<>nil then
  778. ProcScope:=TPasProcedureScope(ProcScope.DeclarationProc.CustomData);
  779. ImplProc:=ProcScope.ImplProc;
  780. if ImplProc=nil then
  781. ImplProc:=TPasProcedure(ProcScope.Element);
  782. if ImplProc.Body<>nil then
  783. // has implementation, not an external proc
  784. Result:=ProcScope;
  785. end
  786. else if (C=TInitializationSection)
  787. or (C=TFinalizationSection) then
  788. Result:=TPasInitialFinalizationScope(El.CustomData);
  789. El:=El.Parent;
  790. end;
  791. end;
  792. function TPasAnalyzer.Add(El: TPasElement; CheckDuplicate: boolean;
  793. aClass: TPAElementClass): TPAElement;
  794. begin
  795. if El=nil then
  796. RaiseInconsistency(20170308093407,'');
  797. {$IFDEF VerbosePasAnalyzer}
  798. writeln('TPasAnalyzer.Add ',GetElModName(El),' New=',not PAElementExists(El){$IFDEF Pas2js},' ID=[',El.PasElementId,']'{$ENDIF});
  799. {$ENDIF}
  800. {$IFDEF VerbosePasAnalyzer}CheckDuplicate:=true;{$ENDIF}
  801. if CheckDuplicate and PAElementExists(El) then
  802. RaiseInconsistency(20170304201318,'');
  803. if aClass=nil then
  804. aClass:=TPAElement;
  805. Result:=aClass.Create;
  806. Result.Element:=El;
  807. FUsedElements.Add(Result);
  808. {$IFDEF VerbosePasAnalyzer}
  809. writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',PAElementExists(El),' '{$Ifdef pas2js},El.PasElementId{$endif});
  810. {$ENDIF}
  811. end;
  812. procedure TPasAnalyzer.CreateTree;
  813. begin
  814. FUsedElements:=TPasAnalyzerKeySet.Create(
  815. {$ifdef pas2js}
  816. @PAElement_ElToHashName,@PasElementToHashName
  817. {$else}
  818. @ComparePAElements,@CompareElementWithPAElement
  819. {$endif});
  820. end;
  821. function TPasAnalyzer.MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass
  822. ): boolean;
  823. function MarkModule(CurModule: TPasModule): boolean;
  824. begin
  825. if PAElementExists(CurModule) then
  826. exit(false);
  827. {$IFDEF VerbosePasAnalyzer}
  828. writeln('TPasAnalyzer.MarkElement.MarkModule mark "',GetElModName(CurModule),'"');
  829. {$ENDIF}
  830. Add(CurModule);
  831. Result:=true;
  832. end;
  833. var
  834. CurModule: TPasModule;
  835. begin
  836. if El=nil then exit(false);
  837. CurModule:=El.GetModule;
  838. if CurModule=nil then
  839. begin
  840. if El.ClassType=TPasUnresolvedSymbolRef then
  841. exit(false);
  842. {$IFDEF VerbosePasAnalyzer}
  843. writeln('TPasAnalyzer.MarkElement GetModule failed for El=',GetElModName(El),' El.Parent=',GetElModName(El.Parent));
  844. {$ENDIF}
  845. RaiseInconsistency(20170308093540,GetElModName(El));
  846. end;
  847. if (ScopeModule<>nil) then
  848. begin
  849. // single module analysis
  850. if (CurModule<>ScopeModule) then
  851. begin
  852. // element from another unit
  853. // -> mark unit as used and do not descend deeper
  854. MarkModule(CurModule);
  855. exit(false);
  856. end;
  857. end;
  858. // mark element
  859. if PAElementExists(El) then exit(false);
  860. Add(El,false,aClass);
  861. Result:=true;
  862. if ScopeModule=nil then
  863. begin
  864. // whole program analysis
  865. if IsIdentifier(El) then
  866. // an identifier of this unit is used -> mark unit
  867. if MarkModule(CurModule) then
  868. UseModule(CurModule,paumElement);
  869. end;
  870. end;
  871. function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
  872. ): boolean;
  873. begin
  874. if El=nil then
  875. exit(true);
  876. if FModeChecked[Mode].ContainsItem(El) then exit(true);
  877. Result:=false;
  878. FModeChecked[Mode].Add(El,false);
  879. end;
  880. function TPasAnalyzer.ElementVisited(El: TPasElement;
  881. OtherCheck: TPAOtherCheckedEl): boolean;
  882. begin
  883. if El=nil then
  884. exit(true);
  885. if FOtherChecked[OtherCheck].ContainsItem(El) then exit(true);
  886. Result:=false;
  887. FOtherChecked[OtherCheck].Add(El,false);
  888. end;
  889. procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
  890. Access: TPSRefAccess);
  891. procedure CheckImplRef;
  892. // check if El inside a proc, initialization or finalization
  893. // and if RefEl is outside
  894. var
  895. ElImplScope, RefElImplScope: TPasScope;
  896. begin
  897. ElImplScope:=FindTopImplScope(El);
  898. if ElImplScope=nil then exit;
  899. RefElImplScope:=FindTopImplScope(RefEl);
  900. if RefElImplScope=ElImplScope then exit;
  901. if (RefEl.Name='') and not (RefEl is TInterfaceSection) then
  902. exit; // reference to anonymous type -> not needed
  903. if ElImplScope is TPasProcedureScope then
  904. TPasProcedureScope(ElImplScope).AddReference(RefEl,Access)
  905. else if ElImplScope is TPasInitialFinalizationScope then
  906. TPasInitialFinalizationScope(ElImplScope).AddReference(RefEl,Access)
  907. else
  908. RaiseInconsistency(20180302142933,GetObjName(ElImplScope));
  909. end;
  910. begin
  911. if RefEl=nil then exit;
  912. if RefEl.Parent=El then exit; // same scope
  913. if paoImplReferences in Options then
  914. CheckImplRef;
  915. end;
  916. procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
  917. UseFull: boolean);
  918. var
  919. C: TClass;
  920. begin
  921. if El=nil then exit;
  922. C:=El.ClassType;
  923. if C.InheritsFrom(TPasType) then
  924. UseType(TPasType(El),paumElement)
  925. else if C.InheritsFrom(TPasVariable) then
  926. UseVariable(TPasVariable(El),Access,UseFull)
  927. else if C=TPasArgument then
  928. UseArgument(TPasArgument(El),Access)
  929. else if C=TPasResultElement then
  930. UseResultElement(TPasResultElement(El),Access)
  931. else if C=TPasResString then
  932. UseResourcestring(TPasResString(El))
  933. else if C.InheritsFrom(TPasProcedure) then
  934. UseProcedure(TPasProcedure(El))
  935. else if C.InheritsFrom(TPasExpr) then
  936. UseExpr(TPasExpr(El))
  937. else if C=TPasEnumValue then
  938. UseExpr(TPasEnumValue(El).Value)
  939. else if C=TPasMethodResolution then
  940. // nothing to do
  941. else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then
  942. // e.g. unitname.identifier -> the module is used by the identifier
  943. else
  944. RaiseNotSupported(20170307090947,El);
  945. repeat
  946. El:=El.Parent;
  947. if not (El is TPasType) then break;
  948. MarkElementAsUsed(El);
  949. if El is TPasMembersType then
  950. UseClassConstructor(TPasMembersType(El));
  951. until false;
  952. end;
  953. procedure TPasAnalyzer.UseTypeInfo(El: TPasElement);
  954. // mark typeinfo, do not mark code
  955. procedure UseSubEl(SubEl: TPasElement); inline;
  956. begin
  957. if SubEl=nil then exit;
  958. MarkImplScopeRef(El,SubEl,psraTypeInfo);
  959. UseTypeInfo(SubEl);
  960. end;
  961. var
  962. C: TClass;
  963. Members, Args: TFPList;
  964. i: Integer;
  965. Member: TPasElement;
  966. MemberResolved: TPasResolverResult;
  967. Prop: TPasProperty;
  968. ProcType: TPasProcedureType;
  969. ClassEl: TPasClassType;
  970. begin
  971. {$IFDEF VerbosePasAnalyzer}
  972. writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
  973. {$ENDIF}
  974. if ElementVisited(El,paumTypeInfo) then exit;
  975. C:=El.ClassType;
  976. if C=TPasUnresolvedSymbolRef then
  977. else if (C=TPasVariable) or (C=TPasConst) then
  978. UseSubEl(TPasVariable(El).VarType)
  979. else if (C=TPasArgument) then
  980. UseSubEl(TPasArgument(El).ArgType)
  981. else if C=TPasProperty then
  982. begin
  983. // published property
  984. Prop:=TPasProperty(El);
  985. Args:=Resolver.GetPasPropertyArgs(Prop);
  986. for i:=0 to Args.Count-1 do
  987. UseSubEl(TPasArgument(Args[i]).ArgType);
  988. UseSubEl(Resolver.GetPasPropertyType(Prop));
  989. UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
  990. UseElement(Resolver.GetPasPropertySetter(Prop),rraRead,false);
  991. UseElement(Resolver.GetPasPropertyIndex(Prop),rraRead,false);
  992. // stored and defaultvalue are only used when published -> mark as used
  993. UseElement(Resolver.GetPasPropertyStoredExpr(Prop),rraRead,false);
  994. UseElement(Resolver.GetPasPropertyDefaultExpr(Prop),rraRead,false);
  995. end
  996. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  997. UseSubEl(TPasAliasType(El).DestType)
  998. else if C=TPasEnumType then
  999. else if C=TPasSetType then
  1000. UseSubEl(TPasSetType(El).EnumType)
  1001. else if C=TPasRangeType then
  1002. else if C=TPasArrayType then
  1003. begin
  1004. UseSubEl(TPasArrayType(El).ElType);
  1005. for i:=0 to length(TPasArrayType(El).Ranges)-1 do
  1006. begin
  1007. Member:=TPasArrayType(El).Ranges[i];
  1008. Resolver.ComputeElement(Member,MemberResolved,[rcConstant]);
  1009. UseSubEl(MemberResolved.HiTypeEl);
  1010. end;
  1011. end
  1012. else if C=TPasPointerType then
  1013. UseSubEl(TPasPointerType(El).DestType)
  1014. else if C=TPasClassType then
  1015. begin
  1016. ClassEl:=TPasClassType(El);
  1017. if ClassEl.ObjKind=okInterface then
  1018. begin
  1019. // mark all used members
  1020. Members:=ClassEl.Members;
  1021. for i:=0 to Members.Count-1 do
  1022. begin
  1023. Member:=TPasElement(Members[i]);
  1024. if Member.ClassType=TPasAttributes then
  1025. continue;
  1026. if IsUsed(Member) then
  1027. UseTypeInfo(Member);
  1028. end;
  1029. end;
  1030. end
  1031. else if C=TPasClassOfType then
  1032. else if C=TPasRecordType then
  1033. begin
  1034. // published record: use all members
  1035. Members:=TPasRecordType(El).Members;
  1036. for i:=0 to Members.Count-1 do
  1037. begin
  1038. Member:=TPasElement(Members[i]);
  1039. if Member.ClassType=TPasAttributes then
  1040. continue; // attributes are never used directly
  1041. UseSubEl(Member);
  1042. end;
  1043. end
  1044. else if C.InheritsFrom(TPasProcedure) then
  1045. UseSubEl(TPasProcedure(El).ProcType)
  1046. else if C.InheritsFrom(TPasProcedureType) then
  1047. begin
  1048. ProcType:=TPasProcedureType(El);
  1049. for i:=0 to ProcType.Args.Count-1 do
  1050. UseSubEl(TPasArgument(ProcType.Args[i]).ArgType);
  1051. if El is TPasFunctionType then
  1052. UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
  1053. end
  1054. else
  1055. begin
  1056. {$IFDEF VerbosePasAnalyzer}
  1057. writeln('TPasAnalyzer.UsePublished ',GetObjName(El));
  1058. {$ENDIF}
  1059. RaiseNotSupported(20170414153904,El);
  1060. end;
  1061. UseElement(El,rraNone,true);
  1062. UseAttributes(El);
  1063. end;
  1064. procedure TPasAnalyzer.UseAttributes(El: TPasElement);
  1065. var
  1066. Calls: TPasExprArray;
  1067. i: Integer;
  1068. begin
  1069. Calls:=Resolver.GetAttributeCallsEl(El);
  1070. for i:=0 to length(Calls)-1 do
  1071. UseExpr(Calls[i]);
  1072. end;
  1073. function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
  1074. procedure UseInitFinal(ImplBlock: TPasImplBlock);
  1075. var
  1076. Scope: TPasInitialFinalizationScope;
  1077. begin
  1078. if ImplBlock=nil then exit;
  1079. Scope:=TPasInitialFinalizationScope(ImplBlock.CustomData);
  1080. UseScopeReferences(Scope.References);
  1081. if (Scope.References=nil) and IsImplBlockEmpty(ImplBlock) then exit;
  1082. // this module has an initialization section -> mark module
  1083. if not PAElementExists(aModule) then
  1084. Add(aModule);
  1085. UseImplBlock(ImplBlock,true);
  1086. end;
  1087. var
  1088. ModScope: TPasModuleScope;
  1089. begin
  1090. if ElementVisited(aModule,Mode) then exit(false);
  1091. Result:=true;
  1092. {$IFDEF VerbosePasAnalyzer}
  1093. writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
  1094. {$ENDIF}
  1095. if Mode in [paumAllExports,paumAllPasUsable] then
  1096. begin
  1097. if aModule is TPasProgram then
  1098. UseSection(TPasProgram(aModule).ProgramSection,Mode)
  1099. else if aModule is TPasLibrary then
  1100. UseSection(TPasLibrary(aModule).LibrarySection,Mode)
  1101. else
  1102. begin
  1103. // unit
  1104. UseSection(aModule.InterfaceSection,Mode);
  1105. // Note: implementation can not be used directly from outside
  1106. end;
  1107. end;
  1108. UseInitFinal(aModule.InitializationSection);
  1109. UseInitFinal(aModule.FinalizationSection);
  1110. ModScope:=aModule.CustomData as TPasModuleScope;
  1111. if ModScope.RangeErrorClass<>nil then
  1112. UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
  1113. if ModScope.RangeErrorConstructor<>nil then
  1114. UseProcedure(ModScope.RangeErrorConstructor);
  1115. // no need to use here ModScope.AssertClass, it is used by Assert
  1116. // no need to use here ModScope.AssertMsgConstructor
  1117. // no need to use here ModScope.AssertDefConstructor
  1118. // no need to use here ModScope.SystemTVarRec
  1119. if Mode=paumElement then
  1120. // e.g. a reference: unitname.identifier
  1121. if not PAElementExists(aModule) then
  1122. Add(aModule);
  1123. end;
  1124. procedure TPasAnalyzer.UseSection(Section: TPasSection; Mode: TPAUseMode);
  1125. // called by UseModule
  1126. var
  1127. i: Integer;
  1128. UsedModule: TPasModule;
  1129. Decl: TPasElement;
  1130. OnlyExports: Boolean;
  1131. UsesClause: TPasUsesClause;
  1132. C: TClass;
  1133. begin
  1134. // Section is TProgramSection, TLibrarySection, TInterfaceSection, TImplementationSection
  1135. if Mode=paumElement then
  1136. RaiseInconsistency(20170317172721,'');
  1137. if ElementVisited(Section,Mode) then exit;
  1138. OnlyExports:=Mode=paumAllExports;
  1139. if Mode=paumAllPasUsable then
  1140. MarkElementAsUsed(Section);
  1141. {$IFDEF VerbosePasAnalyzer}
  1142. writeln('TPasAnalyzer.UseSection ',GetElModName(Section),' Mode=',Mode);
  1143. {$ENDIF}
  1144. // used units
  1145. UsesClause:=Section.UsesClause;
  1146. for i:=0 to length(UsesClause)-1 do
  1147. begin
  1148. if UsesClause[i].Module is TPasModule then
  1149. begin
  1150. UsedModule:=TPasModule(UsesClause[i].Module);
  1151. if ScopeModule=nil then
  1152. // whole program analysis
  1153. UseModule(UsedModule,paumAllExports)
  1154. else
  1155. begin
  1156. // unit analysis
  1157. if IsImplBlockEmpty(UsedModule.InitializationSection)
  1158. and IsImplBlockEmpty(UsedModule.FinalizationSection) then
  1159. continue;
  1160. if not PAElementExists(UsedModule) then
  1161. Add(UsedModule);
  1162. UseImplBlock(UsedModule.InitializationSection,true);
  1163. UseImplBlock(UsedModule.FinalizationSection,true);
  1164. end;
  1165. end;
  1166. end;
  1167. // section declarations
  1168. for i:=0 to Section.Declarations.Count-1 do
  1169. begin
  1170. Decl:=TPasElement(Section.Declarations[i]);
  1171. {$IFDEF VerbosePasAnalyzer}
  1172. writeln('TPasAnalyzer.UseSection ',Section.ClassName,' Decl=',GetElModName(Decl),' Mode=',Mode);
  1173. {$ENDIF}
  1174. C:=Decl.ClassType;
  1175. // Note: no MarkImplScopeRef needed, because all Decl are in the same scope
  1176. if C.InheritsFrom(TPasProcedure) then
  1177. begin
  1178. if OnlyExports and ([pmExport,pmPublic]*TPasProcedure(Decl).Modifiers=[]) then
  1179. continue;
  1180. UseProcedure(TPasProcedure(Decl))
  1181. end
  1182. else if C.InheritsFrom(TPasType) then
  1183. UseType(TPasType(Decl),Mode)
  1184. else if C.InheritsFrom(TPasVariable) then
  1185. begin
  1186. if OnlyExports and ([vmExport,vmPublic]*TPasVariable(Decl).VarModifiers=[]) then
  1187. continue;
  1188. UseVariable(TPasVariable(Decl),rraNone,true);
  1189. end
  1190. else if C=TPasResString then
  1191. UseResourcestring(TPasResString(Decl))
  1192. else if C=TPasAttributes then
  1193. // attributes are never used directly
  1194. else
  1195. RaiseNotSupported(20170306165213,Decl);
  1196. end;
  1197. end;
  1198. procedure TPasAnalyzer.UseImplBlock(Block: TPasImplBlock; Mark: boolean);
  1199. var
  1200. i: Integer;
  1201. El: TPasElement;
  1202. begin
  1203. if Block=nil then exit;
  1204. if Mark and not MarkElementAsUsed(Block) then exit;
  1205. {$IFDEF VerbosePasAnalyzer}
  1206. writeln('TPasAnalyzer.UseImplBlock ',GetElModName(Block),' Elements=',Block.Elements.Count);
  1207. {$ENDIF}
  1208. for i:=0 to Block.Elements.Count-1 do
  1209. begin
  1210. El:=TPasElement(Block.Elements[i]);
  1211. if El is TPasImplElement then
  1212. UseImplElement(TPasImplElement(El))
  1213. else
  1214. RaiseNotSupported(20170306195110,El);
  1215. end;
  1216. end;
  1217. procedure TPasAnalyzer.UseImplElement(El: TPasImplElement);
  1218. var
  1219. C: TClass;
  1220. ForLoop: TPasImplForLoop;
  1221. CaseOf: TPasImplCaseOf;
  1222. i, j: Integer;
  1223. CaseSt: TPasImplCaseStatement;
  1224. WithDo: TPasImplWithDo;
  1225. SubEl, ParentEl: TPasElement;
  1226. ForScope: TPasForLoopScope;
  1227. begin
  1228. // do not mark
  1229. if El=nil then exit;
  1230. C:=El.ClassType;
  1231. if C=TPasImplBlock then
  1232. // impl block
  1233. UseImplBlock(TPasImplBlock(El),false)
  1234. else if C=TPasImplSimple then
  1235. // simple expression
  1236. UseExpr(TPasImplSimple(El).expr)
  1237. else if C=TPasImplAssign then
  1238. // a:=b
  1239. begin
  1240. UseExpr(TPasImplAssign(El).left);
  1241. UseExpr(TPasImplAssign(El).right);
  1242. end
  1243. else if C=TPasImplAsmStatement then
  1244. // asm..end
  1245. else if C=TPasImplBeginBlock then
  1246. // begin..end
  1247. UseImplBlock(TPasImplBeginBlock(El),false)
  1248. else if C=TPasImplCaseOf then
  1249. begin
  1250. // case-of
  1251. CaseOf:=TPasImplCaseOf(El);
  1252. UseExpr(CaseOf.CaseExpr);
  1253. for i:=0 to CaseOf.Elements.Count-1 do
  1254. begin
  1255. SubEl:=TPasElement(CaseOf.Elements[i]);
  1256. if SubEl.ClassType=TPasImplCaseStatement then
  1257. begin
  1258. CaseSt:=TPasImplCaseStatement(SubEl);
  1259. for j:=0 to CaseSt.Expressions.Count-1 do
  1260. UseExpr(TObject(CaseSt.Expressions[j]) as TPasExpr);
  1261. UseImplElement(CaseSt.Body);
  1262. end
  1263. else if SubEl.ClassType=TPasImplCaseElse then
  1264. UseImplBlock(TPasImplCaseElse(SubEl),false)
  1265. else
  1266. RaiseNotSupported(20170307195329,SubEl);
  1267. end;
  1268. end
  1269. else if C=TPasImplForLoop then
  1270. begin
  1271. // for-loop
  1272. ForLoop:=TPasImplForLoop(El);
  1273. UseExpr(ForLoop.VariableName);
  1274. UseExpr(ForLoop.StartExpr);
  1275. UseExpr(ForLoop.EndExpr);
  1276. ForScope:=ForLoop.CustomData as TPasForLoopScope;
  1277. MarkImplScopeRef(ForLoop,ForScope.GetEnumerator,psraRead);
  1278. UseProcedure(ForScope.GetEnumerator);
  1279. MarkImplScopeRef(ForLoop,ForScope.MoveNext,psraRead);
  1280. UseProcedure(ForScope.MoveNext);
  1281. MarkImplScopeRef(ForLoop,ForScope.Current,psraRead);
  1282. UseVariable(ForScope.Current,rraRead,false);
  1283. UseImplElement(ForLoop.Body);
  1284. end
  1285. else if C=TPasImplIfElse then
  1286. begin
  1287. // if-then-else
  1288. UseExpr(TPasImplIfElse(El).ConditionExpr);
  1289. UseImplElement(TPasImplIfElse(El).IfBranch);
  1290. UseImplElement(TPasImplIfElse(El).ElseBranch);
  1291. end
  1292. else if C=TPasImplCommand then
  1293. // used for if-then <empty> -> nothing to do
  1294. else if C=TPasImplLabelMark then
  1295. // label mark
  1296. else if C=TPasImplRepeatUntil then
  1297. begin
  1298. // repeat-until
  1299. UseImplBlock(TPasImplRepeatUntil(El),false);
  1300. UseExpr(TPasImplRepeatUntil(El).ConditionExpr);
  1301. end
  1302. else if C=TPasImplWhileDo then
  1303. begin
  1304. // while-do
  1305. UseExpr(TPasImplWhileDo(El).ConditionExpr);
  1306. UseImplBlock(TPasImplWhileDo(El),false);
  1307. end
  1308. else if C=TPasImplWithDo then
  1309. begin
  1310. // with-do
  1311. WithDo:=TPasImplWithDo(El);
  1312. for i:=0 to WithDo.Expressions.Count-1 do
  1313. UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
  1314. UseImplBlock(WithDo,false);
  1315. end
  1316. else if C=TPasImplExceptOn then
  1317. begin
  1318. // except-on
  1319. // Note: VarEl is marked when actually used
  1320. UseElType(El,TPasImplExceptOn(El).TypeEl,paumElement);
  1321. UseImplElement(TPasImplExceptOn(El).Body);
  1322. end
  1323. else if C=TPasImplRaise then
  1324. begin
  1325. // raise
  1326. if TPasImplRaise(El).ExceptObject<>nil then
  1327. UseExpr(TPasImplRaise(El).ExceptObject)
  1328. else
  1329. begin
  1330. // raise; -> mark On E:
  1331. ParentEl:=El.Parent;
  1332. while ParentEl<>nil do
  1333. begin
  1334. if ParentEl is TPasImplExceptOn then
  1335. begin
  1336. UseVariable(TPasVariable(TPasImplExceptOn(ParentEl).VarEl),rraRead,false);
  1337. break;
  1338. end;
  1339. ParentEl:=ParentEl.Parent;
  1340. end;
  1341. end;
  1342. UseExpr(TPasImplRaise(El).ExceptAddr);
  1343. end
  1344. else if C=TPasImplTry then
  1345. begin
  1346. // try..finally/except..else..end
  1347. UseImplBlock(TPasImplTry(El),false);
  1348. UseImplBlock(TPasImplTry(El).FinallyExcept,false);
  1349. UseImplBlock(TPasImplTry(El).ElseBranch,false);
  1350. end
  1351. else
  1352. RaiseNotSupported(20170307162715,El);
  1353. end;
  1354. procedure TPasAnalyzer.UseExpr(El: TPasExpr);
  1355. var
  1356. Ref: TResolvedReference;
  1357. C: TClass;
  1358. Params: TPasExprArray;
  1359. i: Integer;
  1360. BuiltInProc: TResElDataBuiltInProc;
  1361. ParamResolved: TPasResolverResult;
  1362. Decl: TPasElement;
  1363. ModScope: TPasModuleScope;
  1364. Access: TResolvedRefAccess;
  1365. SubEl: TPasElement;
  1366. begin
  1367. if El=nil then exit;
  1368. // Note: expression itself is not marked, but it can reference identifiers
  1369. Ref:=nil;
  1370. if El.CustomData is TResolvedReference then
  1371. begin
  1372. // this is a reference -> mark target
  1373. Ref:=TResolvedReference(El.CustomData);
  1374. Decl:=Ref.Declaration;
  1375. Access:=Ref.Access;
  1376. MarkImplScopeRef(El,Decl,ResolvedToPSRefAccess[Access]);
  1377. UseElement(Decl,Access,false);
  1378. if Ref.Context<>nil then
  1379. begin
  1380. if Ref.Context.ClassType=TResolvedRefCtxAttrProc then
  1381. UseProcedure(TResolvedRefCtxAttrProc(Ref.Context).Proc);
  1382. end;
  1383. if Resolver.IsNameExpr(El) then
  1384. begin
  1385. if Ref.WithExprScope<>nil then
  1386. begin
  1387. if Ref.WithExprScope.ClassRecScope is TPasRecordScope then
  1388. begin
  1389. // a record member was accessed -> access the record too
  1390. UseExprRef(El,Ref.WithExprScope.Expr,Access,false);
  1391. exit;
  1392. end;
  1393. end;
  1394. if (Decl is TPasVariable)
  1395. and (El.Parent is TBinaryExpr)
  1396. and (TBinaryExpr(El.Parent).right=El) then
  1397. begin
  1398. if ((Decl.Parent is TPasRecordType)
  1399. or (Decl.Parent is TPasVariant)) then
  1400. begin
  1401. // a record member was accessed -> access the record with same Access
  1402. UseExprRef(El.Parent,TBinaryExpr(El.Parent).left,Access,false);
  1403. end;
  1404. end;
  1405. end;
  1406. if Decl is TPasUnresolvedSymbolRef then
  1407. begin
  1408. if Decl.CustomData is TResElDataBuiltInProc then
  1409. begin
  1410. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  1411. case BuiltInProc.BuiltIn of
  1412. bfExit:
  1413. begin
  1414. if El.Parent is TParamsExpr then
  1415. begin
  1416. Params:=(El.Parent as TParamsExpr).Params;
  1417. if length(Params)=1 then
  1418. begin
  1419. SubEl:=El.Parent;
  1420. while (SubEl<>nil) and not (SubEl is TPasProcedure) do
  1421. SubEl:=SubEl.Parent;
  1422. if (SubEl is TPasProcedure)
  1423. and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
  1424. begin
  1425. SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
  1426. UseElement(SubEl,rraAssign,false);
  1427. end;
  1428. end;
  1429. end;
  1430. end;
  1431. bfTypeInfo:
  1432. begin
  1433. Params:=(El.Parent as TParamsExpr).Params;
  1434. if length(Params)<>1 then
  1435. RaiseNotSupported(20180226144217,El.Parent);
  1436. Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
  1437. {$IFDEF VerbosePasAnalyzer}
  1438. writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
  1439. {$ENDIF}
  1440. if ParamResolved.IdentEl=nil then
  1441. RaiseNotSupported(20180628155107,Params[0]);
  1442. if (ParamResolved.IdentEl is TPasProcedure)
  1443. and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
  1444. begin
  1445. SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
  1446. MarkImplScopeRef(El,SubEl,psraTypeInfo);
  1447. UseTypeInfo(SubEl);
  1448. end
  1449. else
  1450. begin
  1451. SubEl:=ParamResolved.IdentEl;
  1452. MarkImplScopeRef(El,SubEl,psraTypeInfo);
  1453. UseTypeInfo(SubEl);
  1454. end;
  1455. // the parameter is not used otherwise
  1456. exit;
  1457. end;
  1458. bfAssert:
  1459. begin
  1460. ModScope:=Resolver.RootElement.CustomData as TPasModuleScope;
  1461. if ModScope.AssertClass<>nil then
  1462. UseElType(El,ModScope.AssertClass,paumElement);
  1463. end;
  1464. end;
  1465. end;
  1466. end;
  1467. end;
  1468. UseExpr(El.format1);
  1469. UseExpr(El.format2);
  1470. C:=El.ClassType;
  1471. if (C=TPrimitiveExpr)
  1472. or (C=TBoolConstExpr)
  1473. or (C=TNilExpr) then
  1474. // ok
  1475. else if C=TBinaryExpr then
  1476. begin
  1477. UseExpr(TBinaryExpr(El).left);
  1478. UseExpr(TBinaryExpr(El).right);
  1479. end
  1480. else if C=TUnaryExpr then
  1481. UseExpr(TUnaryExpr(El).Operand)
  1482. else if C=TParamsExpr then
  1483. begin
  1484. UseExpr(TParamsExpr(El).Value);
  1485. Params:=TParamsExpr(El).Params;
  1486. for i:=0 to length(Params)-1 do
  1487. UseExpr(Params[i]);
  1488. end
  1489. else if C=TArrayValues then
  1490. begin
  1491. Params:=TArrayValues(El).Values;
  1492. for i:=0 to length(Params)-1 do
  1493. UseExpr(Params[i]);
  1494. end
  1495. else if C=TRecordValues then
  1496. begin
  1497. for i:=0 to length(TRecordValues(El).Fields)-1 do
  1498. UseExpr(TRecordValues(El).Fields[i].ValueExp);
  1499. end
  1500. else if C=TInheritedExpr then
  1501. UseInheritedExpr(TInheritedExpr(El))
  1502. else if C=TProcedureExpr then
  1503. UseProcedure(TProcedureExpr(El).Proc)
  1504. else
  1505. RaiseNotSupported(20170307085444,El);
  1506. end;
  1507. procedure TPasAnalyzer.UseExprRef(El: TPasElement; Expr: TPasExpr;
  1508. Access: TResolvedRefAccess; UseFull: boolean);
  1509. var
  1510. Ref: TResolvedReference;
  1511. C: TClass;
  1512. Bin: TBinaryExpr;
  1513. Params: TParamsExpr;
  1514. ValueResolved: TPasResolverResult;
  1515. Unary: TUnaryExpr;
  1516. begin
  1517. C:=Expr.ClassType;
  1518. if C=TBinaryExpr then
  1519. begin
  1520. Bin:=TBinaryExpr(Expr);
  1521. if Bin.OpCode in [eopSubIdent,eopNone] then
  1522. UseExprRef(El,Bin.right,Access,UseFull);
  1523. end
  1524. else if C=TParamsExpr then
  1525. begin
  1526. Params:=TParamsExpr(Expr);
  1527. case Params.Kind of
  1528. pekFuncParams:
  1529. if Resolver.IsTypeCast(Params) then
  1530. UseExprRef(El,Params.Params[0],Access,UseFull)
  1531. else
  1532. UseExprRef(El,Params.Value,Access,UseFull);
  1533. pekArrayParams:
  1534. begin
  1535. Resolver.ComputeElement(Params.Value,ValueResolved,[]);
  1536. if not Resolver.IsDynArray(ValueResolved.LoTypeEl) then
  1537. UseExprRef(El,Params.Value,Access,UseFull);
  1538. end;
  1539. pekSet: ;
  1540. else
  1541. RaiseNotSupported(20170403173817,Params);
  1542. end;
  1543. end
  1544. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  1545. begin
  1546. if (Expr.CustomData is TResolvedReference) then
  1547. begin
  1548. Ref:=TResolvedReference(Expr.CustomData);
  1549. MarkImplScopeRef(El,Ref.Declaration,ResolvedToPSRefAccess[Access]);
  1550. UseElement(Ref.Declaration,Access,UseFull);
  1551. end;
  1552. end
  1553. else if C=TUnaryExpr then
  1554. begin
  1555. Unary:=TUnaryExpr(Expr);
  1556. if Unary.OpCode in [eopAdd,eopSubtract,eopAddress,eopDeref,eopMemAddress] then
  1557. UseExprRef(El,Unary.Operand,rraRead,false)
  1558. else
  1559. RaiseNotSupported(20181015193334,Expr,OpcodeStrings[Unary.OpCode]);
  1560. end
  1561. else if (Access=rraRead)
  1562. and ((C=TPrimitiveExpr) // Kind<>pekIdent
  1563. or (C=TNilExpr)
  1564. or (C=TBoolConstExpr)
  1565. or (C=TUnaryExpr)) then
  1566. // ok
  1567. else
  1568. begin
  1569. {$IFDEF VerbosePasResolver}
  1570. writeln('TPasResolver.UseExprRef Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  1571. {$ENDIF}
  1572. RaiseNotSupported(20170306102159,Expr);
  1573. end;
  1574. end;
  1575. procedure TPasAnalyzer.UseInheritedExpr(El: TInheritedExpr);
  1576. var
  1577. P: TPasElement;
  1578. ProcScope: TPasProcedureScope;
  1579. Proc: TPasProcedure;
  1580. Args: TFPList;
  1581. i: Integer;
  1582. Arg: TPasArgument;
  1583. begin
  1584. if (El.Parent.ClassType=TBinaryExpr)
  1585. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  1586. // 'inherited Proc...;'
  1587. exit;
  1588. // 'inherited;'
  1589. P:=El.Parent;
  1590. while not P.InheritsFrom(TPasProcedure) do
  1591. P:=P.Parent;
  1592. ProcScope:=TPasProcedure(P).CustomData as TPasProcedureScope;
  1593. if ProcScope.DeclarationProc<>nil then
  1594. Proc:=ProcScope.DeclarationProc
  1595. else
  1596. Proc:=TPasProcedure(P);
  1597. Args:=Proc.ProcType.Args;
  1598. for i:=0 to Args.Count-1 do
  1599. begin
  1600. Arg:=TPasArgument(Args[i]);
  1601. case Arg.Access of
  1602. argDefault,argConst,argConstRef: UseArgument(Arg,rraRead);
  1603. argVar: UseArgument(Arg,rraVarParam);
  1604. argOut: UseArgument(Arg,rraOutParam);
  1605. else
  1606. RaiseNotSupported(20171107175406,Arg);
  1607. end;
  1608. end;
  1609. end;
  1610. procedure TPasAnalyzer.UseScopeReferences(Refs: TPasScopeReferences);
  1611. begin
  1612. if Refs=nil then exit;
  1613. Refs.References.ForEachCall(@OnUseScopeRef,Refs.Scope);
  1614. end;
  1615. procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
  1616. procedure UseOverrides(CurProc: TPasProcedure);
  1617. var
  1618. OverrideList: TPAOverrideList;
  1619. i: Integer;
  1620. OverrideProc: TPasProcedure;
  1621. begin
  1622. OverrideList:=TPAOverrideList(FOverrideLists.FindKey(CurProc));
  1623. if OverrideList=nil then exit;
  1624. // Note: while traversing the OverrideList it may grow
  1625. i:=0;
  1626. while i<OverrideList.Count do
  1627. begin
  1628. OverrideProc:=TObject(OverrideList.Overrides[i]) as TPasProcedure;
  1629. UseProcedure(OverrideProc);
  1630. inc(i);
  1631. end;
  1632. end;
  1633. var
  1634. ProcScope: TPasProcedureScope;
  1635. ImplProc: TPasProcedure;
  1636. ClassScope: TPasClassScope;
  1637. Name: String;
  1638. Identifier: TPasIdentifier;
  1639. El: TPasElement;
  1640. ClassEl: TPasClassType;
  1641. begin
  1642. if Proc=nil then exit;
  1643. // use declaration, not implementation
  1644. ProcScope:=Proc.CustomData as TPasProcedureScope;
  1645. if ProcScope.DeclarationProc<>nil then
  1646. exit; // skip implementation, Note:PasResolver always refers the declaration
  1647. if not MarkElementAsUsed(Proc) then exit;
  1648. {$IFDEF VerbosePasAnalyzer}
  1649. writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
  1650. {$ENDIF}
  1651. UseScopeReferences(ProcScope.References);
  1652. UseProcedureType(Proc.ProcType);
  1653. ImplProc:=Proc;
  1654. if ProcScope.ImplProc<>nil then
  1655. ImplProc:=ProcScope.ImplProc;
  1656. if ImplProc.Body<>nil then
  1657. UseImplBlock(ImplProc.Body.Body,false);
  1658. if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
  1659. AddOverride(ProcScope.OverriddenProc,Proc);
  1660. // mark overrides
  1661. if ([pmOverride,pmVirtual]*Proc.Modifiers<>[])
  1662. or ((Proc.Parent.ClassType=TPasClassType)
  1663. and (TPasClassType(Proc.Parent).ObjKind=okInterface)) then
  1664. UseOverrides(Proc);
  1665. if Proc.Parent is TPasClassType then
  1666. begin
  1667. ClassScope:=TPasClassScope(Proc.Parent.CustomData);
  1668. ClassEl:=TPasClassType(ClassScope.Element);
  1669. if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then
  1670. UseTypeInfo(Proc);
  1671. if (Proc.ClassType=TPasConstructor) or (Proc.ClassType=TPasDestructor) then
  1672. begin
  1673. if ClassScope.AncestorScope=nil then
  1674. begin
  1675. // root class constructor -> mark AfterConstruction
  1676. if Proc.ClassType=TPasConstructor then
  1677. Name:='AfterConstruction'
  1678. else
  1679. Name:='BeforeDestruction';
  1680. Identifier:=ClassScope.FindLocalIdentifier(Name);
  1681. while Identifier<>nil do
  1682. begin
  1683. El:=Identifier.Element;
  1684. if (El.ClassType=TPasProcedure)
  1685. and (TPasProcedure(El).ProcType.Args.Count=0) then
  1686. begin
  1687. UseProcedure(TPasProcedure(El));
  1688. break;
  1689. end;
  1690. Identifier:=Identifier.NextSameIdentifier;
  1691. end;
  1692. end;
  1693. end;
  1694. end;
  1695. end;
  1696. procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType);
  1697. var
  1698. i: Integer;
  1699. Arg: TPasArgument;
  1700. begin
  1701. {$IFDEF VerbosePasAnalyzer}
  1702. writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
  1703. {$ENDIF}
  1704. if not MarkElementAsUsed(ProcType) then exit;
  1705. for i:=0 to ProcType.Args.Count-1 do
  1706. begin
  1707. Arg:=TPasArgument(ProcType.Args[i]);
  1708. // Note: the arguments themselves are marked when used in code
  1709. // mark argument type and default value
  1710. UseElType(ProcType,Arg.ArgType,paumElement);
  1711. UseExpr(Arg.ValueExpr);
  1712. end;
  1713. if ProcType is TPasFunctionType then
  1714. UseElType(ProcType,TPasFunctionType(ProcType).ResultEl.ResultType,paumElement);
  1715. end;
  1716. procedure TPasAnalyzer.UseType(El: TPasType; Mode: TPAUseMode);
  1717. var
  1718. C: TClass;
  1719. i: Integer;
  1720. begin
  1721. if El=nil then exit;
  1722. C:=El.ClassType;
  1723. if Mode=paumAllExports then
  1724. begin
  1725. {$IFDEF VerbosePasAnalyzer}
  1726. writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
  1727. {$ENDIF}
  1728. if (C=TPasRecordType) or (C=TPasClassType) then
  1729. UseClassOrRecType(TPasMembersType(El),Mode);
  1730. end
  1731. else
  1732. begin
  1733. {$IFDEF VerbosePasAnalyzer}
  1734. writeln('TPasAnalyzer.UseType using ',GetElModName(El),' Mode=',Mode);
  1735. {$ENDIF}
  1736. if C=TPasUnresolvedSymbolRef then
  1737. begin
  1738. if (El.CustomData is TResElDataBaseType)
  1739. or (El.CustomData is TResElDataBuiltInProc) then
  1740. else
  1741. RaiseNotSupported(20170307101353,El);
  1742. end
  1743. else if (C=TPasAliasType)
  1744. or (C=TPasTypeAliasType)
  1745. or (C=TPasClassOfType) then
  1746. begin
  1747. if not MarkElementAsUsed(El) then exit;
  1748. UseElType(El,TPasAliasType(El).DestType,Mode);
  1749. if C=TPasTypeAliasType then
  1750. UseExpr(TPasTypeAliasType(El).Expr);
  1751. end
  1752. else if C=TPasArrayType then
  1753. begin
  1754. if not MarkElementAsUsed(El) then exit;
  1755. for i:=0 to length(TPasArrayType(El).Ranges)-1 do
  1756. UseExpr(TPasArrayType(El).Ranges[i]);
  1757. UseElType(El,TPasArrayType(El).ElType,Mode);
  1758. end
  1759. else if (C=TPasRecordType) or (C=TPasClassType) then
  1760. UseClassOrRecType(TPasMembersType(El),Mode)
  1761. else if C=TPasEnumType then
  1762. begin
  1763. if not MarkElementAsUsed(El) then exit;
  1764. for i:=0 to TPasEnumType(El).Values.Count-1 do
  1765. UseElement(TPasEnumValue(TPasEnumType(El).Values[i]),rraRead,false);
  1766. end
  1767. else if C=TPasPointerType then
  1768. begin
  1769. if not MarkElementAsUsed(El) then exit;
  1770. UseElType(El,TPasPointerType(El).DestType,Mode);
  1771. end
  1772. else if C=TPasRangeType then
  1773. begin
  1774. if not MarkElementAsUsed(El) then exit;
  1775. UseExpr(TPasRangeType(El).RangeExpr);
  1776. end
  1777. else if C=TPasSetType then
  1778. begin
  1779. if not MarkElementAsUsed(El) then exit;
  1780. UseElType(El,TPasSetType(El).EnumType,Mode);
  1781. end
  1782. else if C.InheritsFrom(TPasProcedureType) then
  1783. UseProcedureType(TPasProcedureType(El))
  1784. else
  1785. RaiseNotSupported(20170306170315,El);
  1786. if Mode=paumAllPasUsable then
  1787. UseTypeInfo(El);
  1788. end;
  1789. end;
  1790. procedure TPasAnalyzer.UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode);
  1791. // called by UseType
  1792. procedure UseDelegations;
  1793. var
  1794. OverrideList: TPAOverrideList;
  1795. i: Integer;
  1796. Prop: TPasProperty;
  1797. begin
  1798. OverrideList:=TPAOverrideList(FOverrideLists.FindKey(El));
  1799. if OverrideList=nil then exit;
  1800. // Note: while traversing the OverrideList it may grow
  1801. i:=0;
  1802. while i<OverrideList.Count do
  1803. begin
  1804. Prop:=TObject(OverrideList.Overrides[i]) as TPasProperty;
  1805. UseVariable(Prop,rraRead,false);
  1806. inc(i);
  1807. end;
  1808. end;
  1809. procedure MarkAllInterfaceImplementations(Scope: TPasClassScope);
  1810. var
  1811. i, j: Integer;
  1812. o: TObject;
  1813. Map: TPasClassIntfMap;
  1814. begin
  1815. if Scope.Interfaces=nil then exit;
  1816. for i:=0 to Scope.Interfaces.Count-1 do
  1817. begin
  1818. o:=TObject(Scope.Interfaces[i]);
  1819. if o is TPasProperty then
  1820. UseVariable(TPasProperty(o),rraRead,false)
  1821. else if o is TPasClassIntfMap then
  1822. begin
  1823. Map:=TPasClassIntfMap(o);
  1824. repeat
  1825. if Map.Intf<>nil then
  1826. UseClassOrRecType(TPasClassType(Map.Intf),paumElement);
  1827. if Map.Procs<>nil then
  1828. for j:=0 to Map.Procs.Count-1 do
  1829. UseProcedure(TPasProcedure(Map.Procs[j]));
  1830. Map:=Map.AncestorMap;
  1831. until Map=nil;
  1832. end
  1833. else
  1834. RaiseNotSupported(20180405190114,El,GetObjName(o));
  1835. end;
  1836. end;
  1837. var
  1838. i: Integer;
  1839. Member: TPasElement;
  1840. AllPublished, FirstTime, IsCOMInterfaceRoot: Boolean;
  1841. ProcScope: TPasProcedureScope;
  1842. ClassScope: TPasClassScope;
  1843. Ref: TResolvedReference;
  1844. j: Integer;
  1845. List, ProcList: TFPList;
  1846. o: TObject;
  1847. Map: TPasClassIntfMap;
  1848. ImplProc, IntfProc, Proc: TPasProcedure;
  1849. aClass: TPasClassType;
  1850. begin
  1851. FirstTime:=true;
  1852. case Mode of
  1853. paumAllExports: exit;
  1854. paumAllPasUsable:
  1855. begin
  1856. if MarkElementAsUsed(El) then
  1857. ElementVisited(El,Mode)
  1858. else
  1859. begin
  1860. if ElementVisited(El,Mode) then exit;
  1861. FirstTime:=false;
  1862. end;
  1863. end;
  1864. paumElement:
  1865. if not MarkElementAsUsed(El) then exit;
  1866. else
  1867. RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
  1868. end;
  1869. {$IFDEF VerbosePasAnalyzer}
  1870. writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
  1871. {$ENDIF}
  1872. aClass:=nil;
  1873. ClassScope:=nil;
  1874. IsCOMInterfaceRoot:=false;
  1875. if El.ClassType=TPasClassType then
  1876. begin
  1877. aClass:=TPasClassType(El);
  1878. if aClass.IsForward then
  1879. begin
  1880. Ref:=aClass.CustomData as TResolvedReference;
  1881. UseClassOrRecType(Ref.Declaration as TPasClassType,Mode);
  1882. exit;
  1883. end;
  1884. ClassScope:=aClass.CustomData as TPasClassScope;
  1885. if ClassScope=nil then
  1886. exit; // ClassScope can be nil if msIgnoreInterfaces
  1887. if FirstTime then
  1888. begin
  1889. UseElType(El,ClassScope.DirectAncestor,paumElement);
  1890. UseElType(El,aClass.HelperForType,paumElement);
  1891. UseExpr(aClass.GUIDExpr);
  1892. // aClass.Interfaces: using a class does not use automatically the interfaces
  1893. if aClass.ObjKind=okInterface then
  1894. begin
  1895. UseDelegations;
  1896. if (aClass.InterfaceType=citCom) and (aClass.AncestorType=nil) then
  1897. IsCOMInterfaceRoot:=true;
  1898. end;
  1899. if (aClass.ObjKind=okClass) and (ScopeModule<>nil)
  1900. and (ClassScope.Interfaces<>nil) then
  1901. // when checking a single unit, mark all method+properties implementing the interfaces
  1902. MarkAllInterfaceImplementations(ClassScope);
  1903. end;
  1904. end
  1905. else if El is TPasRecordType then
  1906. begin
  1907. if (Mode<>paumAllPasUsable) and Resolver.IsTGUID(TPasRecordType(El)) then
  1908. for i:=0 to El.Members.Count-1 do
  1909. begin
  1910. Member:=TPasElement(El.Members[i]);
  1911. if Member is TPasVariable then
  1912. UseVariable(TPasVariable(Member),rraNone,true);
  1913. end;
  1914. end
  1915. else
  1916. RaiseNotSupported(20181229103139,El);
  1917. // members
  1918. AllPublished:=(Mode<>paumAllExports);
  1919. for i:=0 to El.Members.Count-1 do
  1920. begin
  1921. Member:=TPasElement(El.Members[i]);
  1922. if FirstTime and (Member is TPasProcedure) then
  1923. begin
  1924. Proc:=TPasProcedure(Member);
  1925. ProcScope:=Member.CustomData as TPasProcedureScope;
  1926. if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
  1927. begin
  1928. // this is an override
  1929. AddOverride(ProcScope.OverriddenProc,Member);
  1930. if ScopeModule<>nil then
  1931. begin
  1932. // when analyzing a single module, all overrides are assumed to be called
  1933. UseProcedure(Proc);
  1934. continue;
  1935. end;
  1936. end
  1937. else if (Proc.ClassType=TPasClassConstructor)
  1938. or (Proc.ClassType=TPasClassDestructor) then
  1939. begin
  1940. UseProcedure(Proc);
  1941. continue;
  1942. end;
  1943. if IsCOMInterfaceRoot then
  1944. begin
  1945. case lowercase(Member.Name) of
  1946. 'queryinterface':
  1947. if (Proc.ProcType.Args.Count=2) then
  1948. begin
  1949. UseProcedure(Proc);
  1950. continue;
  1951. end;
  1952. '_addref':
  1953. if Proc.ProcType.Args.Count=0 then
  1954. begin
  1955. UseProcedure(Proc);
  1956. continue;
  1957. end;
  1958. '_release':
  1959. if Proc.ProcType.Args.Count=0 then
  1960. begin
  1961. UseProcedure(Proc);
  1962. continue;
  1963. end;
  1964. end;
  1965. //writeln('TPasAnalyzer.UseClassType ',El.FullName,' ',Mode,' ',Member.Name);
  1966. end;
  1967. end
  1968. else if Member.ClassType=TPasAttributes then
  1969. continue; // attributes are never used directly
  1970. if AllPublished and (Member.Visibility=visPublished) then
  1971. begin
  1972. // include published
  1973. if not FirstTime then continue;
  1974. UseTypeInfo(Member);
  1975. end
  1976. else if Mode=paumElement then
  1977. continue
  1978. else if IsModuleInternal(Member) then
  1979. // private or strict private
  1980. continue
  1981. else if (Mode=paumAllPasUsable) and FirstTime
  1982. and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
  1983. begin
  1984. // non private property can be used by typeinfo by descendants in other units
  1985. UseTypeInfo(Member);
  1986. end
  1987. else
  1988. ; // else: class/record is in unit interface, mark all non private members
  1989. UseElement(Member,rraNone,true);
  1990. end;
  1991. if FirstTime and (ClassScope<>nil) then
  1992. begin
  1993. // method resolution
  1994. List:=ClassScope.Interfaces;
  1995. if List<>nil then
  1996. for i:=0 to List.Count-1 do
  1997. begin
  1998. o:=TObject(List[i]);
  1999. if o is TPasProperty then
  2000. begin
  2001. // interface delegation
  2002. // Note: This class is used. When the intftype is used, this delegation is used.
  2003. AddOverride(TPasType(aClass.Interfaces[i]),TPasProperty(o));
  2004. end
  2005. else if o is TPasClassIntfMap then
  2006. begin
  2007. Map:=TPasClassIntfMap(o);
  2008. while Map<>nil do
  2009. begin
  2010. ProcList:=Map.Procs;
  2011. if ProcList<>nil then
  2012. for j:=0 to ProcList.Count-1 do
  2013. begin
  2014. ImplProc:=TPasProcedure(ProcList[j]);
  2015. if ImplProc=nil then continue;
  2016. IntfProc:=TObject(Map.Intf.Members[j]) as TPasProcedure;
  2017. // This class is used. When the interface method is used, this method is used.
  2018. AddOverride(IntfProc,ImplProc);
  2019. end;
  2020. Map:=Map.AncestorMap;
  2021. end;
  2022. end
  2023. else
  2024. RaiseNotSupported(20180328224632,aClass,GetObjName(o));
  2025. end;
  2026. end;
  2027. end;
  2028. procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
  2029. var
  2030. i: Integer;
  2031. Member: TPasElement;
  2032. begin
  2033. if ElementVisited(El,pocClassConstructor) then exit;
  2034. for i:=0 to El.Members.Count-1 do
  2035. begin
  2036. Member:=TPasElement(El.Members[i]);
  2037. if (Member.ClassType=TPasClassConstructor) or (Member.ClassType=TPasClassDestructor) then
  2038. UseProcedure(TPasProcedure(Member));
  2039. end;
  2040. end;
  2041. procedure TPasAnalyzer.UseVariable(El: TPasVariable;
  2042. Access: TResolvedRefAccess; UseFull: boolean);
  2043. var
  2044. Usage: TPAElement;
  2045. UseRead, UseWrite: boolean;
  2046. procedure UpdateVarAccess(IsRead, IsWrite: boolean);
  2047. begin
  2048. if IsRead then
  2049. case Usage.Access of
  2050. paiaNone: begin Usage.Access:=paiaRead; UseRead:=true; end;
  2051. paiaRead: ;
  2052. paiaWrite: begin Usage.Access:=paiaWriteRead; UseRead:=true; end;
  2053. paiaReadWrite: ;
  2054. paiaWriteRead: ;
  2055. else RaiseInconsistency(20170311182420,'');
  2056. end;
  2057. if IsWrite then
  2058. case Usage.Access of
  2059. paiaNone: begin Usage.Access:=paiaWrite; UseWrite:=true; end;
  2060. paiaRead: begin Usage.Access:=paiaReadWrite; UseWrite:=true; end;
  2061. paiaWrite: ;
  2062. paiaReadWrite: ;
  2063. paiaWriteRead: ;
  2064. else RaiseInconsistency(20170311182536,'');
  2065. end;
  2066. end;
  2067. var
  2068. Prop: TPasProperty;
  2069. i: Integer;
  2070. IsRead, IsWrite, CanRead, CanWrite: Boolean;
  2071. ClassEl: TPasClassType;
  2072. begin
  2073. if El=nil then exit;
  2074. {$IFDEF VerbosePasAnalyzer}
  2075. writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
  2076. {$ENDIF}
  2077. if El.ClassType=TPasProperty then
  2078. begin
  2079. Prop:=TPasProperty(El);
  2080. if Prop.Parent is TPasClassType then
  2081. begin
  2082. ClassEl:=TPasClassType(Prop.Parent);
  2083. if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then
  2084. begin
  2085. UseFull:=true;
  2086. UseTypeInfo(Prop);
  2087. end;
  2088. end;
  2089. end
  2090. else
  2091. Prop:=nil;
  2092. IsRead:=false;
  2093. IsWrite:=false;
  2094. if UseFull then
  2095. if (Prop<>nil) then
  2096. begin
  2097. CanRead:=Resolver.GetPasPropertyGetter(Prop)<>nil;
  2098. CanWrite:=Resolver.GetPasPropertySetter(Prop)<>nil;
  2099. if CanRead then
  2100. begin
  2101. if CanWrite then
  2102. Access:=rraReadAndAssign
  2103. else
  2104. Access:=rraRead;
  2105. end
  2106. else
  2107. if CanWrite then
  2108. Access:=rraAssign
  2109. else
  2110. Access:=rraNone;
  2111. end
  2112. else
  2113. Access:=rraRead;
  2114. case Access of
  2115. rraNone: ;
  2116. rraRead: IsRead:=true;
  2117. rraAssign: IsWrite:=true;
  2118. rraReadAndAssign,
  2119. rraVarParam,
  2120. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2121. rraParamToUnknownProc: RaiseInconsistency(20170307153439,'');
  2122. else
  2123. RaiseInconsistency(20170308120949,'');
  2124. end;
  2125. UseRead:=false;
  2126. UseWrite:=false;
  2127. if MarkElementAsUsed(El) then
  2128. begin
  2129. // first access of this variable
  2130. Usage:=FindElement(El);
  2131. // first set flags
  2132. if El.Expr<>nil then
  2133. Usage.Access:=paiaWrite;
  2134. UpdateVarAccess(IsRead,IsWrite);
  2135. // then use recursively
  2136. UseElType(El,El.VarType,paumElement);
  2137. UseExpr(El.Expr);
  2138. UseExpr(El.LibraryName);
  2139. UseExpr(El.ExportName);
  2140. UseExpr(El.AbsoluteExpr);
  2141. if Prop<>nil then
  2142. begin
  2143. for i:=0 to Prop.Args.Count-1 do
  2144. UseElType(Prop,TPasArgument(Prop.Args[i]).ArgType,paumElement);
  2145. UseExpr(Prop.IndexExpr);
  2146. // ToDo: UseExpr(Prop.DispIDExpr);
  2147. // see UseTypeInfo: Prop.StoredAccessor, Prop.DefaultExpr
  2148. end;
  2149. end
  2150. else
  2151. begin
  2152. Usage:=FindElement(El);
  2153. if Usage=nil then
  2154. exit; // element outside of scope
  2155. // var is accessed another time
  2156. // first update flags
  2157. UpdateVarAccess(IsRead,IsWrite);
  2158. end;
  2159. // then use recursively
  2160. if Prop<>nil then
  2161. begin
  2162. {$IFDEF VerbosePasAnalyzer}
  2163. writeln('TPasAnalyzer.UseVariable Property=',Prop.FullName,
  2164. ' Ancestor=',GetElModName(Resolver.GetPasPropertyAncestor(Prop)),
  2165. ' UseRead=',UseRead,',Acc=',GetElModName(Resolver.GetPasPropertyGetter(Prop)),
  2166. ' UseWrite=',UseWrite,',Acc=',GetElModName(Resolver.GetPasPropertySetter(Prop)),
  2167. '');
  2168. {$ENDIF}
  2169. if UseRead then
  2170. UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
  2171. if UseWrite then
  2172. UseElement(Resolver.GetPasPropertySetter(Prop),rraAssign,false);
  2173. end;
  2174. end;
  2175. procedure TPasAnalyzer.UseResourcestring(El: TPasResString);
  2176. begin
  2177. if not MarkElementAsUsed(El) then exit;
  2178. UseExpr(El.Expr);
  2179. end;
  2180. procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
  2181. );
  2182. var
  2183. Usage: TPAElement;
  2184. IsRead, IsWrite: Boolean;
  2185. begin
  2186. IsRead:=false;
  2187. IsWrite:=false;
  2188. case Access of
  2189. rraNone: ;
  2190. rraRead: IsRead:=true;
  2191. rraAssign: IsWrite:=true;
  2192. rraReadAndAssign,
  2193. rraVarParam,
  2194. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2195. rraParamToUnknownProc: RaiseInconsistency(20170308121031,'');
  2196. else
  2197. RaiseInconsistency(20170308121037,'');
  2198. end;
  2199. if MarkElementAsUsed(El) then
  2200. begin
  2201. // first time
  2202. Usage:=FindElement(El);
  2203. end
  2204. else
  2205. begin
  2206. // used again
  2207. Usage:=FindElement(El);
  2208. if Usage=nil then
  2209. RaiseNotSupported(20170308121928,El);
  2210. end;
  2211. UpdateAccess(IsWrite, IsRead, Usage);
  2212. end;
  2213. procedure TPasAnalyzer.UseResultElement(El: TPasResultElement;
  2214. Access: TResolvedRefAccess);
  2215. var
  2216. IsRead, IsWrite: Boolean;
  2217. Usage: TPAElement;
  2218. begin
  2219. IsRead:=false;
  2220. IsWrite:=false;
  2221. case Access of
  2222. rraNone: ;
  2223. rraRead: IsRead:=true;
  2224. rraAssign: IsWrite:=true;
  2225. rraReadAndAssign,
  2226. rraVarParam,
  2227. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2228. rraParamToUnknownProc: RaiseInconsistency(20170308122319,'');
  2229. else
  2230. RaiseInconsistency(20170308122324,'');
  2231. end;
  2232. if MarkElementAsUsed(El) then
  2233. begin
  2234. // first time
  2235. Usage:=FindElement(El);
  2236. end
  2237. else
  2238. begin
  2239. // used again
  2240. Usage:=FindElement(El);
  2241. if Usage=nil then
  2242. RaiseNotSupported(20170308122333,El);
  2243. end;
  2244. UpdateAccess(IsWrite, IsRead, Usage);
  2245. end;
  2246. procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
  2247. var
  2248. C: TClass;
  2249. begin
  2250. if El=nil then exit;
  2251. C:=El.ClassType;
  2252. if C.InheritsFrom(TPasVariable) then
  2253. EmitVariableHints(TPasVariable(El))
  2254. else if C.InheritsFrom(TPasType) then
  2255. EmitTypeHints(TPasType(El))
  2256. else if C.InheritsFrom(TPasProcedure) then
  2257. EmitProcedureHints(TPasProcedure(El))
  2258. else if C=TPasMethodResolution then
  2259. else
  2260. RaiseInconsistency(20170312093126,'');
  2261. end;
  2262. procedure TPasAnalyzer.EmitSectionHints(Section: TPasSection);
  2263. var
  2264. i: Integer;
  2265. UsedModule, aModule: TPasModule;
  2266. UsesClause: TPasUsesClause;
  2267. Use: TPasUsesUnit;
  2268. PosEl: TPasElement;
  2269. begin
  2270. {$IFDEF VerbosePasAnalyzer}
  2271. writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
  2272. {$ENDIF}
  2273. // initialization, program or library sections
  2274. aModule:=Section.GetModule;
  2275. UsesClause:=Section.UsesClause;
  2276. for i:=0 to length(UsesClause)-1 do
  2277. begin
  2278. Use:=UsesClause[i];
  2279. if Use.Module is TPasModule then
  2280. begin
  2281. UsedModule:=TPasModule(Use.Module);
  2282. if CompareText(UsedModule.Name,'system')=0 then continue;
  2283. if not PAElementExists(UsedModule) then
  2284. begin
  2285. PosEl:=Use.Expr;
  2286. if PosEl=nil then PosEl:=Use;
  2287. EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
  2288. [UsedModule.Name,aModule.Name],PosEl);
  2289. end;
  2290. end;
  2291. end;
  2292. EmitDeclarationsHints(Section);
  2293. end;
  2294. procedure TPasAnalyzer.EmitDeclarationsHints(El: TPasDeclarations);
  2295. var
  2296. i: Integer;
  2297. Decl: TPasElement;
  2298. Usage: TPAElement;
  2299. begin
  2300. {$IFDEF VerbosePasAnalyzer}
  2301. writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
  2302. {$ENDIF}
  2303. for i:=0 to El.Declarations.Count-1 do
  2304. begin
  2305. Decl:=TPasElement(El.Declarations[i]);
  2306. if Decl is TPasVariable then
  2307. EmitVariableHints(TPasVariable(Decl))
  2308. else if Decl is TPasType then
  2309. EmitTypeHints(TPasType(Decl))
  2310. else if Decl is TPasProcedure then
  2311. EmitProcedureHints(TPasProcedure(Decl))
  2312. else if Decl.ClassType=TPasAttributes then
  2313. // no hints
  2314. else
  2315. begin
  2316. Usage:=FindElement(Decl);
  2317. if Usage=nil then
  2318. begin
  2319. // declaration was never used
  2320. EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
  2321. sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
  2322. end;
  2323. end;
  2324. end;
  2325. end;
  2326. procedure TPasAnalyzer.EmitTypeHints(El: TPasType);
  2327. var
  2328. C: TClass;
  2329. Usage: TPAElement;
  2330. i: Integer;
  2331. Member: TPasElement;
  2332. Members: TFPList;
  2333. begin
  2334. {$IFDEF VerbosePasAnalyzer}
  2335. writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
  2336. {$ENDIF}
  2337. Usage:=FindElement(El);
  2338. if Usage=nil then
  2339. begin
  2340. // the whole type was never used
  2341. if (El.Visibility in [visPrivate,visStrictPrivate]) then
  2342. EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
  2343. sPAPrivateTypeXNeverUsed,[El.FullName],El)
  2344. else
  2345. begin
  2346. if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
  2347. exit;
  2348. EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
  2349. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2350. end;
  2351. exit;
  2352. end;
  2353. // emit hints for sub elements
  2354. Members:=nil;
  2355. C:=El.ClassType;
  2356. if C=TPasRecordType then
  2357. Members:=TPasRecordType(El).Members
  2358. else if C=TPasClassType then
  2359. begin
  2360. if TPasClassType(El).IsForward then exit;
  2361. Members:=TPasClassType(El).Members;
  2362. end;
  2363. if Members<>nil then
  2364. for i:=0 to Members.Count-1 do
  2365. begin
  2366. Member:=TPasElement(Members[i]);
  2367. if Member.ClassType=TPasAttributes then continue;
  2368. EmitElementHints(Member);
  2369. end;
  2370. end;
  2371. procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);
  2372. var
  2373. Usage: TPAElement;
  2374. begin
  2375. {$IFDEF VerbosePasAnalyzer}
  2376. writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
  2377. {$ENDIF}
  2378. Usage:=FindElement(El);
  2379. if Usage=nil then
  2380. begin
  2381. // not used
  2382. if El.Visibility in [visPrivate,visStrictPrivate] then
  2383. begin
  2384. if El.ClassType=TPasConst then
  2385. EmitMessage(20170311234602,mtHint,nPAPrivateConstXNeverUsed,
  2386. sPAPrivateConstXNeverUsed,[El.FullName],El)
  2387. else if El.ClassType=TPasProperty then
  2388. EmitMessage(20170311234634,mtHint,nPAPrivatePropertyXNeverUsed,
  2389. sPAPrivatePropertyXNeverUsed,[El.FullName],El)
  2390. else
  2391. EmitMessage(20170311231412,mtHint,nPAPrivateFieldIsNeverUsed,
  2392. sPAPrivateFieldIsNeverUsed,[El.FullName],El);
  2393. end
  2394. else if El.ClassType=TPasVariable then
  2395. EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
  2396. sPALocalVariableNotUsed,[El.Name],El)
  2397. else
  2398. EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
  2399. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2400. end
  2401. else if Usage.Access=paiaWrite then
  2402. begin
  2403. // write without read
  2404. if (vmExternal in El.VarModifiers)
  2405. or ((El.Parent is TPasClassType) and (TPasClassType(El.Parent).IsExternal)) then
  2406. exit;
  2407. if El.Visibility in [visPrivate,visStrictPrivate] then
  2408. EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
  2409. sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
  2410. else
  2411. EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
  2412. sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);
  2413. end;
  2414. end;
  2415. procedure TPasAnalyzer.EmitProcedureHints(El: TPasProcedure);
  2416. var
  2417. Args: TFPList;
  2418. i: Integer;
  2419. Arg: TPasArgument;
  2420. Usage: TPAElement;
  2421. ProcScope: TPasProcedureScope;
  2422. PosEl: TPasElement;
  2423. DeclProc, ImplProc: TPasProcedure;
  2424. FuncType: TPasFunctionType;
  2425. begin
  2426. {$IFDEF VerbosePasAnalyzer}
  2427. writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
  2428. {$ENDIF}
  2429. ProcScope:=El.CustomData as TPasProcedureScope;
  2430. if ProcScope.DeclarationProc=nil then
  2431. DeclProc:=El
  2432. else
  2433. DeclProc:=ProcScope.DeclarationProc;
  2434. if ProcScope.ImplProc=nil then
  2435. ImplProc:=El
  2436. else
  2437. ImplProc:=ProcScope.ImplProc;
  2438. if not PAElementExists(DeclProc) then
  2439. begin
  2440. // procedure never used
  2441. if ProcScope.DeclarationProc=nil then
  2442. begin
  2443. if El.Visibility in [visPrivate,visStrictPrivate] then
  2444. EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
  2445. sPAPrivateMethodIsNeverUsed,[El.FullName],El)
  2446. else
  2447. EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
  2448. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2449. end;
  2450. exit;
  2451. end;
  2452. // procedure was used
  2453. if [pmAbstract,pmAssembler,pmExternal]*DeclProc.Modifiers<>[] then exit;
  2454. if [pmAssembler]*ImplProc.Modifiers<>[] then exit;
  2455. if El.Parent is TPasClassType then
  2456. begin
  2457. if TPasClassType(El.Parent).ObjKind=okInterface then exit;
  2458. end;
  2459. if ProcScope.DeclarationProc=nil then
  2460. begin
  2461. // check parameters
  2462. Args:=El.ProcType.Args;
  2463. for i:=0 to Args.Count-1 do
  2464. begin
  2465. Arg:=TPasArgument(Args[i]);
  2466. Usage:=FindElement(Arg);
  2467. if (Usage=nil) or (Usage.Access=paiaNone) then
  2468. begin
  2469. // parameter was never used
  2470. if (Arg.Parent is TPasProcedureType) and (Arg.Parent.Parent is TPasProcedure)
  2471. and ([pmVirtual,pmOverride]*TPasProcedure(Arg.Parent.Parent).Modifiers<>[]) then
  2472. EmitMessage(20180625153623,mtHint,nPAParameterInOverrideNotUsed,
  2473. sPAParameterInOverrideNotUsed,[Arg.Name],Arg)
  2474. else
  2475. EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
  2476. sPAParameterNotUsed,[Arg.Name],Arg);
  2477. end
  2478. else
  2479. begin
  2480. // parameter was used
  2481. if (Usage.Access=paiaWrite) and not (Arg.Access in [argOut,argVar]) then
  2482. EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed,
  2483. sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg);
  2484. end;
  2485. end;
  2486. // check result
  2487. if (El.ProcType is TPasFunctionType) then
  2488. begin
  2489. FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
  2490. PosEl:=FuncType.ResultEl;
  2491. if (ProcScope.ImplProc<>nil)
  2492. and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
  2493. PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
  2494. Usage:=FindElement(FuncType.ResultEl);
  2495. if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
  2496. // result was never used
  2497. EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
  2498. sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
  2499. else
  2500. begin
  2501. // result was used
  2502. end;
  2503. end;
  2504. end;
  2505. if El.Body<>nil then
  2506. begin
  2507. // check declarations
  2508. EmitDeclarationsHints(El.Body);
  2509. // ToDo: emit hints for statements
  2510. end;
  2511. end;
  2512. constructor TPasAnalyzer.Create;
  2513. var
  2514. m: TPAUseMode;
  2515. oc: TPAOtherCheckedEl;
  2516. begin
  2517. CreateTree;
  2518. for m in TPAUseMode do
  2519. FModeChecked[m]:=TPasAnalyzerKeySet.Create(
  2520. {$ifdef pas2js}
  2521. @PasElementToHashName
  2522. {$else}
  2523. @ComparePointer
  2524. {$endif}
  2525. ,nil
  2526. );
  2527. for oc in TPAOtherCheckedEl do
  2528. FOtherChecked[oc]:=TPasAnalyzerKeySet.Create(
  2529. {$ifdef pas2js}
  2530. @PasElementToHashName
  2531. {$else}
  2532. @ComparePointer
  2533. {$endif}
  2534. ,nil
  2535. );
  2536. FOverrideLists:=TPasAnalyzerKeySet.Create(
  2537. {$ifdef pas2js}
  2538. @PAOverrideList_ElToHashName,@PasElementToHashName
  2539. {$else}
  2540. @ComparePAOverrideLists,@CompareElementWithPAOverrideList
  2541. {$endif});
  2542. end;
  2543. destructor TPasAnalyzer.Destroy;
  2544. var
  2545. m: TPAUseMode;
  2546. oc: TPAOtherCheckedEl;
  2547. begin
  2548. Clear;
  2549. FreeAndNil(FOverrideLists);
  2550. FreeAndNil(FUsedElements);
  2551. for m in TPAUseMode do
  2552. FreeAndNil(FModeChecked[m]);
  2553. for oc in TPAOtherCheckedEl do
  2554. FreeAndNil(FOtherChecked[oc]);
  2555. inherited Destroy;
  2556. end;
  2557. procedure TPasAnalyzer.Clear;
  2558. var
  2559. m: TPAUseMode;
  2560. oc: TPAOtherCheckedEl;
  2561. begin
  2562. FOverrideLists.FreeItems;
  2563. FUsedElements.FreeItems;
  2564. for m in TPAUseMode do
  2565. FModeChecked[m].Clear;
  2566. for oc in TPAOtherCheckedEl do
  2567. FOtherChecked[oc].Clear;
  2568. end;
  2569. procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
  2570. var
  2571. Mode: TPAUseMode;
  2572. begin
  2573. {$IFDEF VerbosePasAnalyzer}
  2574. writeln('TPasAnalyzer.AnalyzeModule START ',GetElModName(aModule));
  2575. {$ENDIF}
  2576. if Resolver=nil then
  2577. RaiseInconsistency(20170314223032,'TPasAnalyzer.AnalyzeModule missing Resolver');
  2578. if FUsedElements.Count>0 then
  2579. RaiseInconsistency(20170315153243,'');
  2580. ScopeModule:=aModule;
  2581. if (aModule is TPasProgram) or (aModule is TPasLibrary) then
  2582. Mode:=paumAllExports
  2583. else
  2584. Mode:=paumAllPasUsable;
  2585. UseModule(aModule,Mode);
  2586. {$IFDEF VerbosePasAnalyzer}
  2587. writeln('TPasAnalyzer.AnalyzeModule END ',GetElModName(aModule));
  2588. {$ENDIF}
  2589. end;
  2590. procedure TPasAnalyzer.AnalyzeWholeProgram(aStartModule: TPasProgram);
  2591. begin
  2592. {$IFDEF VerbosePasAnalyzer}
  2593. writeln('TPasAnalyzer.AnalyzeWholeProgram START ',GetElModName(aStartModule));
  2594. {$ENDIF}
  2595. if Resolver=nil then
  2596. RaiseInconsistency(20170315153201,'TPasAnalyzer.AnalyzeWholeProgram missing Resolver');
  2597. if FUsedElements.Count>0 then
  2598. RaiseInconsistency(20170315153252,'');
  2599. ScopeModule:=nil;
  2600. UseModule(aStartModule,paumAllExports);
  2601. MarkElementAsUsed(aStartModule); // always mark the start
  2602. {$IFDEF VerbosePasAnalyzer}
  2603. writeln('TPasAnalyzer.AnalyzeWholeProgram END ',GetElModName(aStartModule));
  2604. {$ENDIF}
  2605. end;
  2606. procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
  2607. begin
  2608. {$IFDEF VerbosePasAnalyzer}
  2609. writeln('TPasAnalyzer.EmitModuleHints ',GetElModName(aModule));
  2610. {$ENDIF}
  2611. if aModule.ClassType=TPasProgram then
  2612. EmitSectionHints(TPasProgram(aModule).ProgramSection)
  2613. else if aModule.ClassType=TPasLibrary then
  2614. EmitSectionHints(TPasLibrary(aModule).LibrarySection)
  2615. else
  2616. begin
  2617. // unit
  2618. EmitSectionHints(aModule.InterfaceSection);
  2619. EmitSectionHints(aModule.ImplementationSection);
  2620. end;
  2621. //EmitBlockHints(aModule.InitializationSection);
  2622. //EmitBlockHints(aModule.FinalizationSection);
  2623. end;
  2624. function TPasAnalyzer.FindUsedElement(El: TPasElement): TPAElement;
  2625. var
  2626. ProcScope: TPasProcedureScope;
  2627. begin
  2628. if not IsIdentifier(El) then exit(nil);
  2629. if El is TPasProcedure then
  2630. begin
  2631. ProcScope:=El.CustomData as TPasProcedureScope;
  2632. if (ProcScope<>nil) and (ProcScope.DeclarationProc<>nil) then
  2633. El:=ProcScope.DeclarationProc;
  2634. end;
  2635. Result:=FindElement(El);
  2636. end;
  2637. function TPasAnalyzer.IsUsed(El: TPasElement): boolean;
  2638. begin
  2639. Result:=FindUsedElement(El)<>nil;
  2640. end;
  2641. function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
  2642. begin
  2643. Result:=FModeChecked[paumTypeInfo].ContainsItem(El);
  2644. end;
  2645. function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
  2646. begin
  2647. if El=nil then
  2648. exit(true);
  2649. if El.ClassType=TInterfaceSection then
  2650. exit(false);
  2651. if IsExport(El) then exit(false);
  2652. case El.Visibility of
  2653. visPrivate,visStrictPrivate: exit(true);
  2654. visPublished: exit(false);
  2655. end;
  2656. Result:=IsModuleInternal(El.Parent);
  2657. end;
  2658. function TPasAnalyzer.IsExport(El: TPasElement): boolean;
  2659. begin
  2660. if El is TPasVariable then
  2661. Result:=[vmExport,vmPublic]*TPasVariable(El).VarModifiers<>[]
  2662. else if El is TPasProcedure then
  2663. Result:=[pmExport,pmPublic]*TPasProcedure(El).Modifiers<>[]
  2664. else
  2665. Result:=false;
  2666. end;
  2667. function TPasAnalyzer.IsIdentifier(El: TPasElement): boolean;
  2668. var
  2669. C: TClass;
  2670. begin
  2671. C:=El.ClassType;
  2672. Result:=C.InheritsFrom(TPasType)
  2673. or C.InheritsFrom(TPasVariable)
  2674. or C.InheritsFrom(TPasProcedure)
  2675. or C.InheritsFrom(TPasModule)
  2676. or (C=TPasArgument)
  2677. or (C=TPasResString);
  2678. end;
  2679. function TPasAnalyzer.IsImplBlockEmpty(El: TPasImplBlock): boolean;
  2680. begin
  2681. Result:=true;
  2682. if (El=nil) or (El.Elements.Count=0) then exit;
  2683. Result:=false;
  2684. end;
  2685. procedure TPasAnalyzer.EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
  2686. MsgNumber: integer; Fmt: String;
  2687. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2688. PosEl: TPasElement);
  2689. var
  2690. Msg: TPAMessage;
  2691. El: TPasElement;
  2692. ProcScope: TPasProcedureScope;
  2693. ModScope: TPasModuleScope;
  2694. Scanner: TPascalScanner;
  2695. State: TWarnMsgState;
  2696. begin
  2697. {$IFDEF VerbosePasAnalyzer}
  2698. //writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  2699. {$ENDIF}
  2700. if MsgType>=mtWarning then
  2701. begin
  2702. El:=PosEl;
  2703. while El<>nil do
  2704. begin
  2705. if El is TPasProcedure then
  2706. begin
  2707. ProcScope:=El.CustomData as TPasProcedureScope;
  2708. if ProcScope.ImplProc<>nil then
  2709. ProcScope:=ProcScope.ImplProc.CustomData as TPasProcedureScope;
  2710. case MsgType of
  2711. mtHint: if not (bsHints in ProcScope.BoolSwitches) then exit;
  2712. mtNote: if not (bsNotes in ProcScope.BoolSwitches) then exit;
  2713. mtWarning: if not (bsWarnings in ProcScope.BoolSwitches) then exit;
  2714. end;
  2715. break;
  2716. end
  2717. else if El is TPasModule then
  2718. begin
  2719. ModScope:=TPasModule(El).CustomData as TPasModuleScope;
  2720. case MsgType of
  2721. mtHint: if not (bsHints in ModScope.BoolSwitches) then exit;
  2722. mtNote: if not (bsNotes in ModScope.BoolSwitches) then exit;
  2723. mtWarning: if not (bsWarnings in ModScope.BoolSwitches) then exit;
  2724. end;
  2725. break;
  2726. end;
  2727. El:=El.Parent;
  2728. end;
  2729. if (Resolver<>nil) and (Resolver.CurrentParser<>nil) then
  2730. begin
  2731. Scanner:=Resolver.CurrentParser.Scanner;
  2732. if Scanner<>nil then
  2733. begin
  2734. State:=Scanner.WarnMsgState[MsgNumber];
  2735. case State of
  2736. wmsOff:
  2737. begin
  2738. {$IFDEF VerbosePasAnalyzer}
  2739. writeln('TPasAnalyzer.EmitMessage ignoring [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  2740. {$ENDIF}
  2741. exit;
  2742. end;
  2743. wmsError:
  2744. MsgType:=mtError;
  2745. end;
  2746. end;
  2747. end;
  2748. end;
  2749. Msg:=TPAMessage.Create;
  2750. Msg.Id:=Id;
  2751. Msg.MsgType:=MsgType;
  2752. Msg.MsgNumber:=MsgNumber;
  2753. Msg.MsgPattern:=Fmt;
  2754. Msg.MsgText:=SafeFormat(Fmt,Args);
  2755. CreateMsgArgs(Msg.Args,Args);
  2756. Msg.PosEl:=PosEl;
  2757. Msg.Filename:=PosEl.SourceFilename;
  2758. Resolver.UnmangleSourceLineNumber(PosEl.SourceLinenumber,Msg.Row,Msg.Col);
  2759. EmitMessage(Msg);
  2760. end;
  2761. procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
  2762. begin
  2763. if not Assigned(OnMessage) then
  2764. begin
  2765. Msg.Release;
  2766. exit;
  2767. end;
  2768. {$IFDEF VerbosePasAnalyzer}
  2769. writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') "',Msg.MsgText,'" at ',Resolver.GetElementSourcePosStr(Msg.PosEl),' ScopeModule=',GetObjName(ScopeModule));
  2770. {$ENDIF}
  2771. try
  2772. OnMessage(Self,Msg);
  2773. finally
  2774. Msg.Release;
  2775. end;
  2776. end;
  2777. class function TPasAnalyzer.GetWarnIdentifierNumbers(Identifier: string; out
  2778. MsgNumbers: TIntegerDynArray): boolean;
  2779. procedure SetNumber(Number: integer);
  2780. begin
  2781. {$IF FPC_FULLVERSION>=30101}
  2782. MsgNumbers:=[Number];
  2783. {$ELSE}
  2784. Setlength(MsgNumbers,1);
  2785. MsgNumbers[0]:=Number;
  2786. {$ENDIF}
  2787. end;
  2788. begin
  2789. if Identifier='' then exit(false);
  2790. if Identifier[1] in ['0'..'9'] then exit(false);
  2791. Result:=true;
  2792. case UpperCase(Identifier) of
  2793. // Delphi+FPC
  2794. 'NO_RETVAL': SetNumber(nPAFunctionResultDoesNotSeemToBeSet); // Function result is not set.
  2795. else
  2796. Result:=false;
  2797. end;
  2798. end;
  2799. function TPasAnalyzer.GetUsedElements: TFPList;
  2800. begin
  2801. Result:=FUsedElements.GetList;
  2802. end;
  2803. end.