pasuseanalyzer.pas 86 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002
  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. ParamsExpr: TParamsExpr;
  1367. begin
  1368. if El=nil then exit;
  1369. // Note: expression itself is not marked, but it can reference identifiers
  1370. Ref:=nil;
  1371. if El.CustomData is TResolvedReference then
  1372. begin
  1373. // this is a reference -> mark target
  1374. Ref:=TResolvedReference(El.CustomData);
  1375. Decl:=Ref.Declaration;
  1376. Access:=Ref.Access;
  1377. MarkImplScopeRef(El,Decl,ResolvedToPSRefAccess[Access]);
  1378. UseElement(Decl,Access,false);
  1379. if Ref.Context<>nil then
  1380. begin
  1381. if Ref.Context.ClassType=TResolvedRefCtxAttrProc then
  1382. UseProcedure(TResolvedRefCtxAttrProc(Ref.Context).Proc);
  1383. end;
  1384. if Resolver.IsNameExpr(El) then
  1385. begin
  1386. if Ref.WithExprScope<>nil then
  1387. begin
  1388. if Ref.WithExprScope.ClassRecScope is TPasRecordScope then
  1389. begin
  1390. // a record member was accessed -> access the record too
  1391. UseExprRef(El,Ref.WithExprScope.Expr,Access,false);
  1392. exit;
  1393. end;
  1394. end;
  1395. if (Decl is TPasVariable)
  1396. and (El.Parent is TBinaryExpr)
  1397. and (TBinaryExpr(El.Parent).right=El) then
  1398. begin
  1399. if ((Decl.Parent is TPasRecordType)
  1400. or (Decl.Parent is TPasVariant)) then
  1401. begin
  1402. // a record member was accessed -> access the record with same Access
  1403. UseExprRef(El.Parent,TBinaryExpr(El.Parent).left,Access,false);
  1404. end;
  1405. end;
  1406. end;
  1407. if Decl is TPasUnresolvedSymbolRef then
  1408. begin
  1409. if Decl.CustomData is TResElDataBuiltInProc then
  1410. begin
  1411. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  1412. case BuiltInProc.BuiltIn of
  1413. bfExit:
  1414. begin
  1415. ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
  1416. if ParamsExpr<>nil then
  1417. begin
  1418. Params:=(El.Parent as TParamsExpr).Params;
  1419. if length(Params)=1 then
  1420. begin
  1421. SubEl:=El.Parent;
  1422. while (SubEl<>nil) and not (SubEl is TPasProcedure) do
  1423. SubEl:=SubEl.Parent;
  1424. if (SubEl is TPasProcedure)
  1425. and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
  1426. begin
  1427. SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
  1428. UseElement(SubEl,rraAssign,false);
  1429. end;
  1430. end;
  1431. end;
  1432. end;
  1433. bfTypeInfo:
  1434. begin
  1435. ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
  1436. if ParamsExpr=nil then
  1437. RaiseNotSupported(20190225150136,El);
  1438. Params:=ParamsExpr.Params;
  1439. if length(Params)<>1 then
  1440. RaiseNotSupported(20180226144217,El.Parent);
  1441. Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
  1442. {$IFDEF VerbosePasAnalyzer}
  1443. writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
  1444. {$ENDIF}
  1445. if ParamResolved.IdentEl=nil then
  1446. RaiseNotSupported(20180628155107,Params[0]);
  1447. if (ParamResolved.IdentEl is TPasProcedure)
  1448. and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
  1449. begin
  1450. SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
  1451. MarkImplScopeRef(El,SubEl,psraTypeInfo);
  1452. UseTypeInfo(SubEl);
  1453. end
  1454. else
  1455. begin
  1456. SubEl:=ParamResolved.IdentEl;
  1457. MarkImplScopeRef(El,SubEl,psraTypeInfo);
  1458. UseTypeInfo(SubEl);
  1459. end;
  1460. // the parameter is not used otherwise
  1461. exit;
  1462. end;
  1463. bfAssert:
  1464. begin
  1465. ModScope:=Resolver.RootElement.CustomData as TPasModuleScope;
  1466. if ModScope.AssertClass<>nil then
  1467. UseElType(El,ModScope.AssertClass,paumElement);
  1468. end;
  1469. end;
  1470. end;
  1471. end;
  1472. end;
  1473. UseExpr(El.format1);
  1474. UseExpr(El.format2);
  1475. C:=El.ClassType;
  1476. if (C=TPrimitiveExpr)
  1477. or (C=TBoolConstExpr)
  1478. or (C=TNilExpr) then
  1479. // ok
  1480. else if C=TBinaryExpr then
  1481. begin
  1482. UseExpr(TBinaryExpr(El).left);
  1483. UseExpr(TBinaryExpr(El).right);
  1484. end
  1485. else if C=TUnaryExpr then
  1486. UseExpr(TUnaryExpr(El).Operand)
  1487. else if C=TParamsExpr then
  1488. begin
  1489. UseExpr(TParamsExpr(El).Value);
  1490. Params:=TParamsExpr(El).Params;
  1491. for i:=0 to length(Params)-1 do
  1492. UseExpr(Params[i]);
  1493. end
  1494. else if C=TArrayValues then
  1495. begin
  1496. Params:=TArrayValues(El).Values;
  1497. for i:=0 to length(Params)-1 do
  1498. UseExpr(Params[i]);
  1499. end
  1500. else if C=TRecordValues then
  1501. begin
  1502. for i:=0 to length(TRecordValues(El).Fields)-1 do
  1503. UseExpr(TRecordValues(El).Fields[i].ValueExp);
  1504. end
  1505. else if C=TInheritedExpr then
  1506. UseInheritedExpr(TInheritedExpr(El))
  1507. else if C=TProcedureExpr then
  1508. UseProcedure(TProcedureExpr(El).Proc)
  1509. else
  1510. RaiseNotSupported(20170307085444,El);
  1511. end;
  1512. procedure TPasAnalyzer.UseExprRef(El: TPasElement; Expr: TPasExpr;
  1513. Access: TResolvedRefAccess; UseFull: boolean);
  1514. var
  1515. Ref: TResolvedReference;
  1516. C: TClass;
  1517. Bin: TBinaryExpr;
  1518. Params: TParamsExpr;
  1519. ValueResolved: TPasResolverResult;
  1520. Unary: TUnaryExpr;
  1521. begin
  1522. C:=Expr.ClassType;
  1523. if C=TBinaryExpr then
  1524. begin
  1525. Bin:=TBinaryExpr(Expr);
  1526. if Bin.OpCode in [eopSubIdent,eopNone] then
  1527. UseExprRef(El,Bin.right,Access,UseFull);
  1528. end
  1529. else if C=TParamsExpr then
  1530. begin
  1531. Params:=TParamsExpr(Expr);
  1532. case Params.Kind of
  1533. pekFuncParams:
  1534. if Resolver.IsTypeCast(Params) then
  1535. UseExprRef(El,Params.Params[0],Access,UseFull)
  1536. else
  1537. UseExprRef(El,Params.Value,Access,UseFull);
  1538. pekArrayParams:
  1539. begin
  1540. Resolver.ComputeElement(Params.Value,ValueResolved,[]);
  1541. if not Resolver.IsDynArray(ValueResolved.LoTypeEl) then
  1542. UseExprRef(El,Params.Value,Access,UseFull);
  1543. end;
  1544. pekSet: ;
  1545. else
  1546. RaiseNotSupported(20170403173817,Params);
  1547. end;
  1548. end
  1549. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  1550. begin
  1551. if (Expr.CustomData is TResolvedReference) then
  1552. begin
  1553. Ref:=TResolvedReference(Expr.CustomData);
  1554. MarkImplScopeRef(El,Ref.Declaration,ResolvedToPSRefAccess[Access]);
  1555. UseElement(Ref.Declaration,Access,UseFull);
  1556. end;
  1557. end
  1558. else if C=TUnaryExpr then
  1559. begin
  1560. Unary:=TUnaryExpr(Expr);
  1561. if Unary.OpCode in [eopAdd,eopSubtract,eopAddress,eopDeref,eopMemAddress] then
  1562. UseExprRef(El,Unary.Operand,rraRead,false)
  1563. else
  1564. RaiseNotSupported(20181015193334,Expr,OpcodeStrings[Unary.OpCode]);
  1565. end
  1566. else if (Access=rraRead)
  1567. and ((C=TPrimitiveExpr) // Kind<>pekIdent
  1568. or (C=TNilExpr)
  1569. or (C=TBoolConstExpr)
  1570. or (C=TUnaryExpr)) then
  1571. // ok
  1572. else
  1573. begin
  1574. {$IFDEF VerbosePasResolver}
  1575. writeln('TPasResolver.UseExprRef Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  1576. {$ENDIF}
  1577. RaiseNotSupported(20170306102159,Expr);
  1578. end;
  1579. end;
  1580. procedure TPasAnalyzer.UseInheritedExpr(El: TInheritedExpr);
  1581. var
  1582. P: TPasElement;
  1583. ProcScope: TPasProcedureScope;
  1584. Proc: TPasProcedure;
  1585. Args: TFPList;
  1586. i: Integer;
  1587. Arg: TPasArgument;
  1588. begin
  1589. if (El.Parent.ClassType=TBinaryExpr)
  1590. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  1591. // 'inherited Proc...;'
  1592. exit;
  1593. // 'inherited;'
  1594. P:=El.Parent;
  1595. while not P.InheritsFrom(TPasProcedure) do
  1596. P:=P.Parent;
  1597. ProcScope:=TPasProcedure(P).CustomData as TPasProcedureScope;
  1598. if ProcScope.DeclarationProc<>nil then
  1599. Proc:=ProcScope.DeclarationProc
  1600. else
  1601. Proc:=TPasProcedure(P);
  1602. Args:=Proc.ProcType.Args;
  1603. for i:=0 to Args.Count-1 do
  1604. begin
  1605. Arg:=TPasArgument(Args[i]);
  1606. case Arg.Access of
  1607. argDefault,argConst,argConstRef: UseArgument(Arg,rraRead);
  1608. argVar: UseArgument(Arg,rraVarParam);
  1609. argOut: UseArgument(Arg,rraOutParam);
  1610. else
  1611. RaiseNotSupported(20171107175406,Arg);
  1612. end;
  1613. end;
  1614. end;
  1615. procedure TPasAnalyzer.UseScopeReferences(Refs: TPasScopeReferences);
  1616. begin
  1617. if Refs=nil then exit;
  1618. Refs.References.ForEachCall(@OnUseScopeRef,Refs.Scope);
  1619. end;
  1620. procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
  1621. procedure UseOverrides(CurProc: TPasProcedure);
  1622. var
  1623. OverrideList: TPAOverrideList;
  1624. i: Integer;
  1625. OverrideProc: TPasProcedure;
  1626. begin
  1627. OverrideList:=TPAOverrideList(FOverrideLists.FindKey(CurProc));
  1628. if OverrideList=nil then exit;
  1629. // Note: while traversing the OverrideList it may grow
  1630. i:=0;
  1631. while i<OverrideList.Count do
  1632. begin
  1633. OverrideProc:=TObject(OverrideList.Overrides[i]) as TPasProcedure;
  1634. UseProcedure(OverrideProc);
  1635. inc(i);
  1636. end;
  1637. end;
  1638. var
  1639. ProcScope: TPasProcedureScope;
  1640. ImplProc: TPasProcedure;
  1641. ClassScope: TPasClassScope;
  1642. Name: String;
  1643. Identifier: TPasIdentifier;
  1644. El: TPasElement;
  1645. ClassEl: TPasClassType;
  1646. begin
  1647. if Proc=nil then exit;
  1648. // use declaration, not implementation
  1649. ProcScope:=Proc.CustomData as TPasProcedureScope;
  1650. if ProcScope.DeclarationProc<>nil then
  1651. exit; // skip implementation, Note:PasResolver always refers the declaration
  1652. if not MarkElementAsUsed(Proc) then exit;
  1653. {$IFDEF VerbosePasAnalyzer}
  1654. writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
  1655. {$ENDIF}
  1656. if Proc.Parent is TPasMembersType then
  1657. UseClassOrRecType(TPasMembersType(Proc.Parent),paumElement);
  1658. UseScopeReferences(ProcScope.References);
  1659. UseProcedureType(Proc.ProcType);
  1660. ImplProc:=Proc;
  1661. if ProcScope.ImplProc<>nil then
  1662. ImplProc:=ProcScope.ImplProc;
  1663. if ImplProc.Body<>nil then
  1664. UseImplBlock(ImplProc.Body.Body,false);
  1665. if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
  1666. AddOverride(ProcScope.OverriddenProc,Proc);
  1667. // mark overrides
  1668. if ([pmOverride,pmVirtual]*Proc.Modifiers<>[])
  1669. or ((Proc.Parent.ClassType=TPasClassType)
  1670. and (TPasClassType(Proc.Parent).ObjKind=okInterface)) then
  1671. UseOverrides(Proc);
  1672. if Proc.Parent is TPasClassType then
  1673. begin
  1674. ClassScope:=TPasClassScope(Proc.Parent.CustomData);
  1675. ClassEl:=TPasClassType(ClassScope.Element);
  1676. if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then
  1677. UseTypeInfo(Proc);
  1678. if (Proc.ClassType=TPasConstructor) or (Proc.ClassType=TPasDestructor) then
  1679. begin
  1680. if ClassScope.AncestorScope=nil then
  1681. begin
  1682. // root class constructor -> mark AfterConstruction
  1683. if Proc.ClassType=TPasConstructor then
  1684. Name:='AfterConstruction'
  1685. else
  1686. Name:='BeforeDestruction';
  1687. Identifier:=ClassScope.FindLocalIdentifier(Name);
  1688. while Identifier<>nil do
  1689. begin
  1690. El:=Identifier.Element;
  1691. if (El.ClassType=TPasProcedure)
  1692. and (TPasProcedure(El).ProcType.Args.Count=0) then
  1693. begin
  1694. UseProcedure(TPasProcedure(El));
  1695. break;
  1696. end;
  1697. Identifier:=Identifier.NextSameIdentifier;
  1698. end;
  1699. end;
  1700. end;
  1701. end;
  1702. end;
  1703. procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType);
  1704. var
  1705. i: Integer;
  1706. Arg: TPasArgument;
  1707. begin
  1708. {$IFDEF VerbosePasAnalyzer}
  1709. writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
  1710. {$ENDIF}
  1711. if not MarkElementAsUsed(ProcType) then exit;
  1712. for i:=0 to ProcType.Args.Count-1 do
  1713. begin
  1714. Arg:=TPasArgument(ProcType.Args[i]);
  1715. // Note: the arguments themselves are marked when used in code
  1716. // mark argument type and default value
  1717. UseElType(ProcType,Arg.ArgType,paumElement);
  1718. UseExpr(Arg.ValueExpr);
  1719. end;
  1720. if ProcType is TPasFunctionType then
  1721. UseElType(ProcType,TPasFunctionType(ProcType).ResultEl.ResultType,paumElement);
  1722. end;
  1723. procedure TPasAnalyzer.UseType(El: TPasType; Mode: TPAUseMode);
  1724. var
  1725. C: TClass;
  1726. i: Integer;
  1727. begin
  1728. if El=nil then exit;
  1729. C:=El.ClassType;
  1730. if Mode=paumAllExports then
  1731. begin
  1732. {$IFDEF VerbosePasAnalyzer}
  1733. writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
  1734. {$ENDIF}
  1735. if (C=TPasRecordType) or (C=TPasClassType) then
  1736. UseClassOrRecType(TPasMembersType(El),Mode);
  1737. end
  1738. else
  1739. begin
  1740. {$IFDEF VerbosePasAnalyzer}
  1741. writeln('TPasAnalyzer.UseType using ',GetElModName(El),' Mode=',Mode);
  1742. {$ENDIF}
  1743. if C=TPasUnresolvedSymbolRef then
  1744. begin
  1745. if (El.CustomData is TResElDataBaseType)
  1746. or (El.CustomData is TResElDataBuiltInProc) then
  1747. else
  1748. RaiseNotSupported(20170307101353,El);
  1749. end
  1750. else if (C=TPasAliasType)
  1751. or (C=TPasTypeAliasType)
  1752. or (C=TPasClassOfType) then
  1753. begin
  1754. if not MarkElementAsUsed(El) then exit;
  1755. UseElType(El,TPasAliasType(El).DestType,Mode);
  1756. if C=TPasTypeAliasType then
  1757. UseExpr(TPasTypeAliasType(El).Expr);
  1758. end
  1759. else if C=TPasArrayType then
  1760. begin
  1761. if not MarkElementAsUsed(El) then exit;
  1762. for i:=0 to length(TPasArrayType(El).Ranges)-1 do
  1763. UseExpr(TPasArrayType(El).Ranges[i]);
  1764. UseElType(El,TPasArrayType(El).ElType,Mode);
  1765. end
  1766. else if (C=TPasRecordType) or (C=TPasClassType) then
  1767. UseClassOrRecType(TPasMembersType(El),Mode)
  1768. else if C=TPasEnumType then
  1769. begin
  1770. if not MarkElementAsUsed(El) then exit;
  1771. for i:=0 to TPasEnumType(El).Values.Count-1 do
  1772. UseElement(TPasEnumValue(TPasEnumType(El).Values[i]),rraRead,false);
  1773. end
  1774. else if C=TPasPointerType then
  1775. begin
  1776. if not MarkElementAsUsed(El) then exit;
  1777. UseElType(El,TPasPointerType(El).DestType,Mode);
  1778. end
  1779. else if C=TPasRangeType then
  1780. begin
  1781. if not MarkElementAsUsed(El) then exit;
  1782. UseExpr(TPasRangeType(El).RangeExpr);
  1783. end
  1784. else if C=TPasSetType then
  1785. begin
  1786. if not MarkElementAsUsed(El) then exit;
  1787. UseElType(El,TPasSetType(El).EnumType,Mode);
  1788. end
  1789. else if C.InheritsFrom(TPasProcedureType) then
  1790. UseProcedureType(TPasProcedureType(El))
  1791. else
  1792. RaiseNotSupported(20170306170315,El);
  1793. if Mode=paumAllPasUsable then
  1794. UseTypeInfo(El);
  1795. end;
  1796. end;
  1797. procedure TPasAnalyzer.UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode);
  1798. // called by UseType
  1799. procedure UseDelegations;
  1800. var
  1801. OverrideList: TPAOverrideList;
  1802. i: Integer;
  1803. Prop: TPasProperty;
  1804. begin
  1805. OverrideList:=TPAOverrideList(FOverrideLists.FindKey(El));
  1806. if OverrideList=nil then exit;
  1807. // Note: while traversing the OverrideList it may grow
  1808. i:=0;
  1809. while i<OverrideList.Count do
  1810. begin
  1811. Prop:=TObject(OverrideList.Overrides[i]) as TPasProperty;
  1812. UseVariable(Prop,rraRead,false);
  1813. inc(i);
  1814. end;
  1815. end;
  1816. procedure MarkAllInterfaceImplementations(Scope: TPasClassScope);
  1817. var
  1818. i, j: Integer;
  1819. o: TObject;
  1820. Map: TPasClassIntfMap;
  1821. begin
  1822. if Scope.Interfaces=nil then exit;
  1823. for i:=0 to Scope.Interfaces.Count-1 do
  1824. begin
  1825. o:=TObject(Scope.Interfaces[i]);
  1826. if o is TPasProperty then
  1827. UseVariable(TPasProperty(o),rraRead,false)
  1828. else if o is TPasClassIntfMap then
  1829. begin
  1830. Map:=TPasClassIntfMap(o);
  1831. repeat
  1832. if Map.Intf<>nil then
  1833. UseClassOrRecType(TPasClassType(Map.Intf),paumElement);
  1834. if Map.Procs<>nil then
  1835. for j:=0 to Map.Procs.Count-1 do
  1836. UseProcedure(TPasProcedure(Map.Procs[j]));
  1837. Map:=Map.AncestorMap;
  1838. until Map=nil;
  1839. end
  1840. else
  1841. RaiseNotSupported(20180405190114,El,GetObjName(o));
  1842. end;
  1843. end;
  1844. var
  1845. i: Integer;
  1846. Member: TPasElement;
  1847. AllPublished, FirstTime, IsCOMInterfaceRoot: Boolean;
  1848. ProcScope: TPasProcedureScope;
  1849. ClassScope: TPasClassScope;
  1850. Ref: TResolvedReference;
  1851. j: Integer;
  1852. List, ProcList: TFPList;
  1853. o: TObject;
  1854. Map: TPasClassIntfMap;
  1855. ImplProc, IntfProc, Proc: TPasProcedure;
  1856. aClass: TPasClassType;
  1857. begin
  1858. FirstTime:=true;
  1859. case Mode of
  1860. paumAllExports: exit;
  1861. paumAllPasUsable:
  1862. begin
  1863. if MarkElementAsUsed(El) then
  1864. ElementVisited(El,Mode)
  1865. else
  1866. begin
  1867. if ElementVisited(El,Mode) then exit;
  1868. FirstTime:=false;
  1869. end;
  1870. end;
  1871. paumElement:
  1872. if not MarkElementAsUsed(El) then exit;
  1873. else
  1874. RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
  1875. end;
  1876. {$IFDEF VerbosePasAnalyzer}
  1877. writeln('TPasAnalyzer.UseClassOrRecType ',GetElModName(El),' ',Mode,' First=',FirstTime);
  1878. {$ENDIF}
  1879. aClass:=nil;
  1880. ClassScope:=nil;
  1881. IsCOMInterfaceRoot:=false;
  1882. if El.ClassType=TPasClassType then
  1883. begin
  1884. aClass:=TPasClassType(El);
  1885. if aClass.IsForward then
  1886. begin
  1887. Ref:=aClass.CustomData as TResolvedReference;
  1888. UseClassOrRecType(Ref.Declaration as TPasClassType,Mode);
  1889. exit;
  1890. end;
  1891. ClassScope:=aClass.CustomData as TPasClassScope;
  1892. if ClassScope=nil then
  1893. exit; // ClassScope can be nil if msIgnoreInterfaces
  1894. if FirstTime then
  1895. begin
  1896. UseElType(El,ClassScope.DirectAncestor,paumElement);
  1897. UseElType(El,aClass.HelperForType,paumElement);
  1898. UseExpr(aClass.GUIDExpr);
  1899. // aClass.Interfaces: using a class does not use automatically the interfaces
  1900. if aClass.ObjKind=okInterface then
  1901. begin
  1902. UseDelegations;
  1903. if (aClass.InterfaceType=citCom) and (aClass.AncestorType=nil) then
  1904. IsCOMInterfaceRoot:=true;
  1905. end;
  1906. if (aClass.ObjKind=okClass) and (ScopeModule<>nil)
  1907. and (ClassScope.Interfaces<>nil) then
  1908. // when checking a single unit, mark all method+properties implementing the interfaces
  1909. MarkAllInterfaceImplementations(ClassScope);
  1910. end;
  1911. end
  1912. else if El is TPasRecordType then
  1913. begin
  1914. if (Mode<>paumAllPasUsable) and Resolver.IsTGUID(TPasRecordType(El)) then
  1915. for i:=0 to El.Members.Count-1 do
  1916. begin
  1917. Member:=TPasElement(El.Members[i]);
  1918. if Member is TPasVariable then
  1919. UseVariable(TPasVariable(Member),rraNone,true);
  1920. end;
  1921. end
  1922. else
  1923. RaiseNotSupported(20181229103139,El);
  1924. // members
  1925. AllPublished:=(Mode<>paumAllExports);
  1926. for i:=0 to El.Members.Count-1 do
  1927. begin
  1928. Member:=TPasElement(El.Members[i]);
  1929. if FirstTime and (Member is TPasProcedure) then
  1930. begin
  1931. Proc:=TPasProcedure(Member);
  1932. ProcScope:=Member.CustomData as TPasProcedureScope;
  1933. if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
  1934. begin
  1935. // this is an override
  1936. AddOverride(ProcScope.OverriddenProc,Member);
  1937. if ScopeModule<>nil then
  1938. begin
  1939. // when analyzing a single module, all overrides are assumed to be called
  1940. UseProcedure(Proc);
  1941. continue;
  1942. end;
  1943. end
  1944. else if (Proc.ClassType=TPasClassConstructor)
  1945. or (Proc.ClassType=TPasClassDestructor) then
  1946. begin
  1947. UseProcedure(Proc);
  1948. continue;
  1949. end;
  1950. if IsCOMInterfaceRoot then
  1951. begin
  1952. case lowercase(Member.Name) of
  1953. 'queryinterface':
  1954. if (Proc.ProcType.Args.Count=2) then
  1955. begin
  1956. UseProcedure(Proc);
  1957. continue;
  1958. end;
  1959. '_addref':
  1960. if Proc.ProcType.Args.Count=0 then
  1961. begin
  1962. UseProcedure(Proc);
  1963. continue;
  1964. end;
  1965. '_release':
  1966. if Proc.ProcType.Args.Count=0 then
  1967. begin
  1968. UseProcedure(Proc);
  1969. continue;
  1970. end;
  1971. end;
  1972. //writeln('TPasAnalyzer.UseClassType ',El.FullName,' ',Mode,' ',Member.Name);
  1973. end;
  1974. end
  1975. else if Member.ClassType=TPasAttributes then
  1976. continue; // attributes are never used directly
  1977. if AllPublished and (Member.Visibility=visPublished) then
  1978. begin
  1979. // include published
  1980. if not FirstTime then continue;
  1981. UseTypeInfo(Member);
  1982. end
  1983. else if Mode=paumElement then
  1984. continue
  1985. else if IsModuleInternal(Member) then
  1986. // private or strict private
  1987. continue
  1988. else if (Mode=paumAllPasUsable) and FirstTime
  1989. and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
  1990. begin
  1991. // non private property can be used by typeinfo by descendants in other units
  1992. UseTypeInfo(Member);
  1993. end
  1994. else
  1995. ; // else: class/record is in unit interface, mark all non private members
  1996. UseElement(Member,rraNone,true);
  1997. end;
  1998. if FirstTime and (ClassScope<>nil) then
  1999. begin
  2000. // method resolution
  2001. List:=ClassScope.Interfaces;
  2002. if List<>nil then
  2003. for i:=0 to List.Count-1 do
  2004. begin
  2005. o:=TObject(List[i]);
  2006. if o is TPasProperty then
  2007. begin
  2008. // interface delegation
  2009. // Note: This class is used. When the intftype is used, this delegation is used.
  2010. AddOverride(TPasType(aClass.Interfaces[i]),TPasProperty(o));
  2011. end
  2012. else if o is TPasClassIntfMap then
  2013. begin
  2014. Map:=TPasClassIntfMap(o);
  2015. while Map<>nil do
  2016. begin
  2017. ProcList:=Map.Procs;
  2018. if ProcList<>nil then
  2019. for j:=0 to ProcList.Count-1 do
  2020. begin
  2021. ImplProc:=TPasProcedure(ProcList[j]);
  2022. if ImplProc=nil then continue;
  2023. IntfProc:=TObject(Map.Intf.Members[j]) as TPasProcedure;
  2024. // This class is used. When the interface method is used, this method is used.
  2025. AddOverride(IntfProc,ImplProc);
  2026. end;
  2027. Map:=Map.AncestorMap;
  2028. end;
  2029. end
  2030. else
  2031. RaiseNotSupported(20180328224632,aClass,GetObjName(o));
  2032. end;
  2033. end;
  2034. end;
  2035. procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
  2036. var
  2037. i: Integer;
  2038. Member: TPasElement;
  2039. begin
  2040. if ElementVisited(El,pocClassConstructor) then exit;
  2041. for i:=0 to El.Members.Count-1 do
  2042. begin
  2043. Member:=TPasElement(El.Members[i]);
  2044. if (Member.ClassType=TPasClassConstructor) or (Member.ClassType=TPasClassDestructor) then
  2045. UseProcedure(TPasProcedure(Member));
  2046. end;
  2047. end;
  2048. procedure TPasAnalyzer.UseVariable(El: TPasVariable;
  2049. Access: TResolvedRefAccess; UseFull: boolean);
  2050. var
  2051. Usage: TPAElement;
  2052. UseRead, UseWrite: boolean;
  2053. procedure UpdateVarAccess(IsRead, IsWrite: boolean);
  2054. begin
  2055. if IsRead then
  2056. case Usage.Access of
  2057. paiaNone: begin Usage.Access:=paiaRead; UseRead:=true; end;
  2058. paiaRead: ;
  2059. paiaWrite: begin Usage.Access:=paiaWriteRead; UseRead:=true; end;
  2060. paiaReadWrite: ;
  2061. paiaWriteRead: ;
  2062. else RaiseInconsistency(20170311182420,'');
  2063. end;
  2064. if IsWrite then
  2065. case Usage.Access of
  2066. paiaNone: begin Usage.Access:=paiaWrite; UseWrite:=true; end;
  2067. paiaRead: begin Usage.Access:=paiaReadWrite; UseWrite:=true; end;
  2068. paiaWrite: ;
  2069. paiaReadWrite: ;
  2070. paiaWriteRead: ;
  2071. else RaiseInconsistency(20170311182536,'');
  2072. end;
  2073. end;
  2074. var
  2075. Prop: TPasProperty;
  2076. i: Integer;
  2077. IsRead, IsWrite, CanRead, CanWrite: Boolean;
  2078. ClassEl: TPasClassType;
  2079. begin
  2080. if El=nil then exit;
  2081. {$IFDEF VerbosePasAnalyzer}
  2082. writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
  2083. {$ENDIF}
  2084. if El.ClassType=TPasProperty then
  2085. begin
  2086. Prop:=TPasProperty(El);
  2087. if Prop.Parent is TPasClassType then
  2088. begin
  2089. ClassEl:=TPasClassType(Prop.Parent);
  2090. if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then
  2091. begin
  2092. UseFull:=true;
  2093. UseTypeInfo(Prop);
  2094. end;
  2095. end;
  2096. end
  2097. else
  2098. Prop:=nil;
  2099. IsRead:=false;
  2100. IsWrite:=false;
  2101. if UseFull then
  2102. if (Prop<>nil) then
  2103. begin
  2104. CanRead:=Resolver.GetPasPropertyGetter(Prop)<>nil;
  2105. CanWrite:=Resolver.GetPasPropertySetter(Prop)<>nil;
  2106. if CanRead then
  2107. begin
  2108. if CanWrite then
  2109. Access:=rraReadAndAssign
  2110. else
  2111. Access:=rraRead;
  2112. end
  2113. else
  2114. if CanWrite then
  2115. Access:=rraAssign
  2116. else
  2117. Access:=rraNone;
  2118. end
  2119. else
  2120. Access:=rraRead;
  2121. case Access of
  2122. rraNone: ;
  2123. rraRead: IsRead:=true;
  2124. rraAssign: IsWrite:=true;
  2125. rraReadAndAssign,
  2126. rraVarParam,
  2127. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2128. rraParamToUnknownProc: RaiseInconsistency(20170307153439,'');
  2129. else
  2130. RaiseInconsistency(20170308120949,'');
  2131. end;
  2132. UseRead:=false;
  2133. UseWrite:=false;
  2134. if MarkElementAsUsed(El) then
  2135. begin
  2136. // first access of this variable
  2137. Usage:=FindElement(El);
  2138. // first set flags
  2139. if El.Expr<>nil then
  2140. Usage.Access:=paiaWrite;
  2141. UpdateVarAccess(IsRead,IsWrite);
  2142. // then use recursively
  2143. UseElType(El,El.VarType,paumElement);
  2144. UseExpr(El.Expr);
  2145. UseExpr(El.LibraryName);
  2146. UseExpr(El.ExportName);
  2147. UseExpr(El.AbsoluteExpr);
  2148. if Prop<>nil then
  2149. begin
  2150. for i:=0 to Prop.Args.Count-1 do
  2151. UseElType(Prop,TPasArgument(Prop.Args[i]).ArgType,paumElement);
  2152. UseExpr(Prop.IndexExpr);
  2153. // ToDo: UseExpr(Prop.DispIDExpr);
  2154. // see UseTypeInfo: Prop.StoredAccessor, Prop.DefaultExpr
  2155. end;
  2156. end
  2157. else
  2158. begin
  2159. Usage:=FindElement(El);
  2160. if Usage=nil then
  2161. exit; // element outside of scope
  2162. // var is accessed another time
  2163. // first update flags
  2164. UpdateVarAccess(IsRead,IsWrite);
  2165. end;
  2166. // then use recursively
  2167. if Prop<>nil then
  2168. begin
  2169. {$IFDEF VerbosePasAnalyzer}
  2170. writeln('TPasAnalyzer.UseVariable Property=',Prop.FullName,
  2171. ' Ancestor=',GetElModName(Resolver.GetPasPropertyAncestor(Prop)),
  2172. ' UseRead=',UseRead,',Acc=',GetElModName(Resolver.GetPasPropertyGetter(Prop)),
  2173. ' UseWrite=',UseWrite,',Acc=',GetElModName(Resolver.GetPasPropertySetter(Prop)),
  2174. '');
  2175. {$ENDIF}
  2176. if UseRead then
  2177. UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
  2178. if UseWrite then
  2179. UseElement(Resolver.GetPasPropertySetter(Prop),rraAssign,false);
  2180. end;
  2181. end;
  2182. procedure TPasAnalyzer.UseResourcestring(El: TPasResString);
  2183. begin
  2184. if not MarkElementAsUsed(El) then exit;
  2185. UseExpr(El.Expr);
  2186. end;
  2187. procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
  2188. );
  2189. var
  2190. Usage: TPAElement;
  2191. IsRead, IsWrite: Boolean;
  2192. begin
  2193. IsRead:=false;
  2194. IsWrite:=false;
  2195. case Access of
  2196. rraNone: ;
  2197. rraRead: IsRead:=true;
  2198. rraAssign: IsWrite:=true;
  2199. rraReadAndAssign,
  2200. rraVarParam,
  2201. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2202. rraParamToUnknownProc: RaiseInconsistency(20170308121031,'');
  2203. else
  2204. RaiseInconsistency(20170308121037,'');
  2205. end;
  2206. if MarkElementAsUsed(El) then
  2207. begin
  2208. // first time
  2209. Usage:=FindElement(El);
  2210. end
  2211. else
  2212. begin
  2213. // used again
  2214. Usage:=FindElement(El);
  2215. if Usage=nil then
  2216. RaiseNotSupported(20170308121928,El);
  2217. end;
  2218. UpdateAccess(IsWrite, IsRead, Usage);
  2219. end;
  2220. procedure TPasAnalyzer.UseResultElement(El: TPasResultElement;
  2221. Access: TResolvedRefAccess);
  2222. var
  2223. IsRead, IsWrite: Boolean;
  2224. Usage: TPAElement;
  2225. begin
  2226. IsRead:=false;
  2227. IsWrite:=false;
  2228. case Access of
  2229. rraNone: ;
  2230. rraRead: IsRead:=true;
  2231. rraAssign: IsWrite:=true;
  2232. rraReadAndAssign,
  2233. rraVarParam,
  2234. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2235. rraParamToUnknownProc: RaiseInconsistency(20170308122319,'');
  2236. else
  2237. RaiseInconsistency(20170308122324,'');
  2238. end;
  2239. if MarkElementAsUsed(El) then
  2240. begin
  2241. // first time
  2242. Usage:=FindElement(El);
  2243. end
  2244. else
  2245. begin
  2246. // used again
  2247. Usage:=FindElement(El);
  2248. if Usage=nil then
  2249. RaiseNotSupported(20170308122333,El);
  2250. end;
  2251. UpdateAccess(IsWrite, IsRead, Usage);
  2252. end;
  2253. procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
  2254. var
  2255. C: TClass;
  2256. begin
  2257. if El=nil then exit;
  2258. C:=El.ClassType;
  2259. if C.InheritsFrom(TPasVariable) then
  2260. EmitVariableHints(TPasVariable(El))
  2261. else if C.InheritsFrom(TPasType) then
  2262. EmitTypeHints(TPasType(El))
  2263. else if C.InheritsFrom(TPasProcedure) then
  2264. EmitProcedureHints(TPasProcedure(El))
  2265. else if C=TPasMethodResolution then
  2266. else
  2267. RaiseInconsistency(20170312093126,'');
  2268. end;
  2269. procedure TPasAnalyzer.EmitSectionHints(Section: TPasSection);
  2270. var
  2271. i: Integer;
  2272. UsedModule, aModule: TPasModule;
  2273. UsesClause: TPasUsesClause;
  2274. Use: TPasUsesUnit;
  2275. PosEl: TPasElement;
  2276. begin
  2277. {$IFDEF VerbosePasAnalyzer}
  2278. writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
  2279. {$ENDIF}
  2280. // initialization, program or library sections
  2281. aModule:=Section.GetModule;
  2282. UsesClause:=Section.UsesClause;
  2283. for i:=0 to length(UsesClause)-1 do
  2284. begin
  2285. Use:=UsesClause[i];
  2286. if Use.Module is TPasModule then
  2287. begin
  2288. UsedModule:=TPasModule(Use.Module);
  2289. if CompareText(UsedModule.Name,'system')=0 then continue;
  2290. if not PAElementExists(UsedModule) then
  2291. begin
  2292. PosEl:=Use.Expr;
  2293. if PosEl=nil then PosEl:=Use;
  2294. EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
  2295. [UsedModule.Name,aModule.Name],PosEl);
  2296. end;
  2297. end;
  2298. end;
  2299. EmitDeclarationsHints(Section);
  2300. end;
  2301. procedure TPasAnalyzer.EmitDeclarationsHints(El: TPasDeclarations);
  2302. var
  2303. i: Integer;
  2304. Decl: TPasElement;
  2305. Usage: TPAElement;
  2306. begin
  2307. {$IFDEF VerbosePasAnalyzer}
  2308. writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
  2309. {$ENDIF}
  2310. for i:=0 to El.Declarations.Count-1 do
  2311. begin
  2312. Decl:=TPasElement(El.Declarations[i]);
  2313. if Decl is TPasVariable then
  2314. EmitVariableHints(TPasVariable(Decl))
  2315. else if Decl is TPasType then
  2316. EmitTypeHints(TPasType(Decl))
  2317. else if Decl is TPasProcedure then
  2318. EmitProcedureHints(TPasProcedure(Decl))
  2319. else if Decl.ClassType=TPasAttributes then
  2320. // no hints
  2321. else
  2322. begin
  2323. Usage:=FindElement(Decl);
  2324. if Usage=nil then
  2325. begin
  2326. // declaration was never used
  2327. EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
  2328. sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
  2329. end;
  2330. end;
  2331. end;
  2332. end;
  2333. procedure TPasAnalyzer.EmitTypeHints(El: TPasType);
  2334. var
  2335. C: TClass;
  2336. Usage: TPAElement;
  2337. i: Integer;
  2338. Member: TPasElement;
  2339. Members: TFPList;
  2340. begin
  2341. {$IFDEF VerbosePasAnalyzer}
  2342. writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
  2343. {$ENDIF}
  2344. Usage:=FindElement(El);
  2345. if Usage=nil then
  2346. begin
  2347. // the whole type was never used
  2348. if (El.Visibility in [visPrivate,visStrictPrivate]) then
  2349. EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
  2350. sPAPrivateTypeXNeverUsed,[El.FullName],El)
  2351. else
  2352. begin
  2353. if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
  2354. exit;
  2355. EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
  2356. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2357. end;
  2358. exit;
  2359. end;
  2360. // emit hints for sub elements
  2361. Members:=nil;
  2362. C:=El.ClassType;
  2363. if C=TPasRecordType then
  2364. Members:=TPasRecordType(El).Members
  2365. else if C=TPasClassType then
  2366. begin
  2367. if TPasClassType(El).IsForward then exit;
  2368. Members:=TPasClassType(El).Members;
  2369. end;
  2370. if Members<>nil then
  2371. for i:=0 to Members.Count-1 do
  2372. begin
  2373. Member:=TPasElement(Members[i]);
  2374. if Member.ClassType=TPasAttributes then continue;
  2375. EmitElementHints(Member);
  2376. end;
  2377. end;
  2378. procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);
  2379. var
  2380. Usage: TPAElement;
  2381. begin
  2382. {$IFDEF VerbosePasAnalyzer}
  2383. writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
  2384. {$ENDIF}
  2385. Usage:=FindElement(El);
  2386. if Usage=nil then
  2387. begin
  2388. // not used
  2389. if El.Visibility in [visPrivate,visStrictPrivate] then
  2390. begin
  2391. if El.ClassType=TPasConst then
  2392. EmitMessage(20170311234602,mtHint,nPAPrivateConstXNeverUsed,
  2393. sPAPrivateConstXNeverUsed,[El.FullName],El)
  2394. else if El.ClassType=TPasProperty then
  2395. EmitMessage(20170311234634,mtHint,nPAPrivatePropertyXNeverUsed,
  2396. sPAPrivatePropertyXNeverUsed,[El.FullName],El)
  2397. else
  2398. EmitMessage(20170311231412,mtHint,nPAPrivateFieldIsNeverUsed,
  2399. sPAPrivateFieldIsNeverUsed,[El.FullName],El);
  2400. end
  2401. else if El.ClassType=TPasVariable then
  2402. EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
  2403. sPALocalVariableNotUsed,[El.Name],El)
  2404. else
  2405. EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
  2406. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2407. end
  2408. else if Usage.Access=paiaWrite then
  2409. begin
  2410. // write without read
  2411. if (vmExternal in El.VarModifiers)
  2412. or ((El.Parent is TPasClassType) and (TPasClassType(El.Parent).IsExternal)) then
  2413. exit;
  2414. if El.Visibility in [visPrivate,visStrictPrivate] then
  2415. EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
  2416. sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
  2417. else
  2418. EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
  2419. sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);
  2420. end;
  2421. end;
  2422. procedure TPasAnalyzer.EmitProcedureHints(El: TPasProcedure);
  2423. var
  2424. Args: TFPList;
  2425. i: Integer;
  2426. Arg: TPasArgument;
  2427. Usage: TPAElement;
  2428. ProcScope: TPasProcedureScope;
  2429. PosEl: TPasElement;
  2430. DeclProc, ImplProc: TPasProcedure;
  2431. FuncType: TPasFunctionType;
  2432. begin
  2433. {$IFDEF VerbosePasAnalyzer}
  2434. writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
  2435. {$ENDIF}
  2436. ProcScope:=El.CustomData as TPasProcedureScope;
  2437. if ProcScope.DeclarationProc=nil then
  2438. DeclProc:=El
  2439. else
  2440. DeclProc:=ProcScope.DeclarationProc;
  2441. if ProcScope.ImplProc=nil then
  2442. ImplProc:=El
  2443. else
  2444. ImplProc:=ProcScope.ImplProc;
  2445. if not PAElementExists(DeclProc) then
  2446. begin
  2447. // procedure never used
  2448. if ProcScope.DeclarationProc=nil then
  2449. begin
  2450. if El.Visibility in [visPrivate,visStrictPrivate] then
  2451. EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
  2452. sPAPrivateMethodIsNeverUsed,[El.FullName],El)
  2453. else
  2454. EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
  2455. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2456. end;
  2457. exit;
  2458. end;
  2459. // procedure was used
  2460. if [pmAbstract,pmAssembler,pmExternal]*DeclProc.Modifiers<>[] then exit;
  2461. if [pmAssembler]*ImplProc.Modifiers<>[] then exit;
  2462. if El.Parent is TPasClassType then
  2463. begin
  2464. if TPasClassType(El.Parent).ObjKind=okInterface then exit;
  2465. end;
  2466. if ProcScope.DeclarationProc=nil then
  2467. begin
  2468. // check parameters
  2469. Args:=El.ProcType.Args;
  2470. for i:=0 to Args.Count-1 do
  2471. begin
  2472. Arg:=TPasArgument(Args[i]);
  2473. Usage:=FindElement(Arg);
  2474. if (Usage=nil) or (Usage.Access=paiaNone) then
  2475. begin
  2476. // parameter was never used
  2477. if (Arg.Parent is TPasProcedureType) and (Arg.Parent.Parent is TPasProcedure)
  2478. and ([pmVirtual,pmOverride]*TPasProcedure(Arg.Parent.Parent).Modifiers<>[]) then
  2479. EmitMessage(20180625153623,mtHint,nPAParameterInOverrideNotUsed,
  2480. sPAParameterInOverrideNotUsed,[Arg.Name],Arg)
  2481. else
  2482. EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
  2483. sPAParameterNotUsed,[Arg.Name],Arg);
  2484. end
  2485. else
  2486. begin
  2487. // parameter was used
  2488. if (Usage.Access=paiaWrite) and not (Arg.Access in [argOut,argVar]) then
  2489. EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed,
  2490. sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg);
  2491. end;
  2492. end;
  2493. // check result
  2494. if (El.ProcType is TPasFunctionType) then
  2495. begin
  2496. FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
  2497. PosEl:=FuncType.ResultEl;
  2498. if (ProcScope.ImplProc<>nil)
  2499. and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
  2500. PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
  2501. Usage:=FindElement(FuncType.ResultEl);
  2502. if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
  2503. // result was never used
  2504. EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
  2505. sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
  2506. else
  2507. begin
  2508. // result was used
  2509. end;
  2510. end;
  2511. end;
  2512. if El.Body<>nil then
  2513. begin
  2514. // check declarations
  2515. EmitDeclarationsHints(El.Body);
  2516. // ToDo: emit hints for statements
  2517. end;
  2518. end;
  2519. constructor TPasAnalyzer.Create;
  2520. var
  2521. m: TPAUseMode;
  2522. oc: TPAOtherCheckedEl;
  2523. begin
  2524. CreateTree;
  2525. for m in TPAUseMode do
  2526. FModeChecked[m]:=TPasAnalyzerKeySet.Create(
  2527. {$ifdef pas2js}
  2528. @PasElementToHashName
  2529. {$else}
  2530. @ComparePointer
  2531. {$endif}
  2532. ,nil
  2533. );
  2534. for oc in TPAOtherCheckedEl do
  2535. FOtherChecked[oc]:=TPasAnalyzerKeySet.Create(
  2536. {$ifdef pas2js}
  2537. @PasElementToHashName
  2538. {$else}
  2539. @ComparePointer
  2540. {$endif}
  2541. ,nil
  2542. );
  2543. FOverrideLists:=TPasAnalyzerKeySet.Create(
  2544. {$ifdef pas2js}
  2545. @PAOverrideList_ElToHashName,@PasElementToHashName
  2546. {$else}
  2547. @ComparePAOverrideLists,@CompareElementWithPAOverrideList
  2548. {$endif});
  2549. end;
  2550. destructor TPasAnalyzer.Destroy;
  2551. var
  2552. m: TPAUseMode;
  2553. oc: TPAOtherCheckedEl;
  2554. begin
  2555. Clear;
  2556. FreeAndNil(FOverrideLists);
  2557. FreeAndNil(FUsedElements);
  2558. for m in TPAUseMode do
  2559. FreeAndNil(FModeChecked[m]);
  2560. for oc in TPAOtherCheckedEl do
  2561. FreeAndNil(FOtherChecked[oc]);
  2562. inherited Destroy;
  2563. end;
  2564. procedure TPasAnalyzer.Clear;
  2565. var
  2566. m: TPAUseMode;
  2567. oc: TPAOtherCheckedEl;
  2568. begin
  2569. FOverrideLists.FreeItems;
  2570. FUsedElements.FreeItems;
  2571. for m in TPAUseMode do
  2572. FModeChecked[m].Clear;
  2573. for oc in TPAOtherCheckedEl do
  2574. FOtherChecked[oc].Clear;
  2575. end;
  2576. procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
  2577. var
  2578. Mode: TPAUseMode;
  2579. begin
  2580. {$IFDEF VerbosePasAnalyzer}
  2581. writeln('TPasAnalyzer.AnalyzeModule START ',GetElModName(aModule));
  2582. {$ENDIF}
  2583. if Resolver=nil then
  2584. RaiseInconsistency(20170314223032,'TPasAnalyzer.AnalyzeModule missing Resolver');
  2585. if FUsedElements.Count>0 then
  2586. RaiseInconsistency(20170315153243,'');
  2587. ScopeModule:=aModule;
  2588. if (aModule is TPasProgram) or (aModule is TPasLibrary) then
  2589. Mode:=paumAllExports
  2590. else
  2591. Mode:=paumAllPasUsable;
  2592. UseModule(aModule,Mode);
  2593. {$IFDEF VerbosePasAnalyzer}
  2594. writeln('TPasAnalyzer.AnalyzeModule END ',GetElModName(aModule));
  2595. {$ENDIF}
  2596. end;
  2597. procedure TPasAnalyzer.AnalyzeWholeProgram(aStartModule: TPasProgram);
  2598. begin
  2599. {$IFDEF VerbosePasAnalyzer}
  2600. writeln('TPasAnalyzer.AnalyzeWholeProgram START ',GetElModName(aStartModule));
  2601. {$ENDIF}
  2602. if Resolver=nil then
  2603. RaiseInconsistency(20170315153201,'TPasAnalyzer.AnalyzeWholeProgram missing Resolver');
  2604. if FUsedElements.Count>0 then
  2605. RaiseInconsistency(20170315153252,'');
  2606. ScopeModule:=nil;
  2607. UseModule(aStartModule,paumAllExports);
  2608. MarkElementAsUsed(aStartModule); // always mark the start
  2609. {$IFDEF VerbosePasAnalyzer}
  2610. writeln('TPasAnalyzer.AnalyzeWholeProgram END ',GetElModName(aStartModule));
  2611. {$ENDIF}
  2612. end;
  2613. procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
  2614. begin
  2615. {$IFDEF VerbosePasAnalyzer}
  2616. writeln('TPasAnalyzer.EmitModuleHints ',GetElModName(aModule));
  2617. {$ENDIF}
  2618. if aModule.ClassType=TPasProgram then
  2619. EmitSectionHints(TPasProgram(aModule).ProgramSection)
  2620. else if aModule.ClassType=TPasLibrary then
  2621. EmitSectionHints(TPasLibrary(aModule).LibrarySection)
  2622. else
  2623. begin
  2624. // unit
  2625. EmitSectionHints(aModule.InterfaceSection);
  2626. EmitSectionHints(aModule.ImplementationSection);
  2627. end;
  2628. //EmitBlockHints(aModule.InitializationSection);
  2629. //EmitBlockHints(aModule.FinalizationSection);
  2630. end;
  2631. function TPasAnalyzer.FindUsedElement(El: TPasElement): TPAElement;
  2632. var
  2633. ProcScope: TPasProcedureScope;
  2634. begin
  2635. if not IsIdentifier(El) then exit(nil);
  2636. if El is TPasProcedure then
  2637. begin
  2638. ProcScope:=El.CustomData as TPasProcedureScope;
  2639. if (ProcScope<>nil) and (ProcScope.DeclarationProc<>nil) then
  2640. El:=ProcScope.DeclarationProc;
  2641. end;
  2642. Result:=FindElement(El);
  2643. end;
  2644. function TPasAnalyzer.IsUsed(El: TPasElement): boolean;
  2645. begin
  2646. Result:=FindUsedElement(El)<>nil;
  2647. end;
  2648. function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
  2649. begin
  2650. Result:=FModeChecked[paumTypeInfo].ContainsItem(El);
  2651. end;
  2652. function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
  2653. begin
  2654. if El=nil then
  2655. exit(true);
  2656. if El.ClassType=TInterfaceSection then
  2657. exit(false);
  2658. if IsExport(El) then exit(false);
  2659. case El.Visibility of
  2660. visPrivate,visStrictPrivate: exit(true);
  2661. visPublished: exit(false);
  2662. end;
  2663. Result:=IsModuleInternal(El.Parent);
  2664. end;
  2665. function TPasAnalyzer.IsExport(El: TPasElement): boolean;
  2666. begin
  2667. if El is TPasVariable then
  2668. Result:=[vmExport,vmPublic]*TPasVariable(El).VarModifiers<>[]
  2669. else if El is TPasProcedure then
  2670. Result:=[pmExport,pmPublic]*TPasProcedure(El).Modifiers<>[]
  2671. else
  2672. Result:=false;
  2673. end;
  2674. function TPasAnalyzer.IsIdentifier(El: TPasElement): boolean;
  2675. var
  2676. C: TClass;
  2677. begin
  2678. C:=El.ClassType;
  2679. Result:=C.InheritsFrom(TPasType)
  2680. or C.InheritsFrom(TPasVariable)
  2681. or C.InheritsFrom(TPasProcedure)
  2682. or C.InheritsFrom(TPasModule)
  2683. or (C=TPasArgument)
  2684. or (C=TPasResString);
  2685. end;
  2686. function TPasAnalyzer.IsImplBlockEmpty(El: TPasImplBlock): boolean;
  2687. begin
  2688. Result:=true;
  2689. if (El=nil) or (El.Elements.Count=0) then exit;
  2690. Result:=false;
  2691. end;
  2692. procedure TPasAnalyzer.EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
  2693. MsgNumber: integer; Fmt: String;
  2694. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2695. PosEl: TPasElement);
  2696. var
  2697. Msg: TPAMessage;
  2698. El: TPasElement;
  2699. ProcScope: TPasProcedureScope;
  2700. ModScope: TPasModuleScope;
  2701. Scanner: TPascalScanner;
  2702. State: TWarnMsgState;
  2703. begin
  2704. {$IFDEF VerbosePasAnalyzer}
  2705. //writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  2706. {$ENDIF}
  2707. if MsgType>=mtWarning then
  2708. begin
  2709. El:=PosEl;
  2710. while El<>nil do
  2711. begin
  2712. if El is TPasProcedure then
  2713. begin
  2714. ProcScope:=El.CustomData as TPasProcedureScope;
  2715. if ProcScope.ImplProc<>nil then
  2716. ProcScope:=ProcScope.ImplProc.CustomData as TPasProcedureScope;
  2717. case MsgType of
  2718. mtHint: if not (bsHints in ProcScope.BoolSwitches) then exit;
  2719. mtNote: if not (bsNotes in ProcScope.BoolSwitches) then exit;
  2720. mtWarning: if not (bsWarnings in ProcScope.BoolSwitches) then exit;
  2721. end;
  2722. break;
  2723. end
  2724. else if El is TPasModule then
  2725. begin
  2726. ModScope:=TPasModule(El).CustomData as TPasModuleScope;
  2727. case MsgType of
  2728. mtHint: if not (bsHints in ModScope.BoolSwitches) then exit;
  2729. mtNote: if not (bsNotes in ModScope.BoolSwitches) then exit;
  2730. mtWarning: if not (bsWarnings in ModScope.BoolSwitches) then exit;
  2731. end;
  2732. break;
  2733. end;
  2734. El:=El.Parent;
  2735. end;
  2736. if (Resolver<>nil) and (Resolver.CurrentParser<>nil) then
  2737. begin
  2738. Scanner:=Resolver.CurrentParser.Scanner;
  2739. if Scanner<>nil then
  2740. begin
  2741. State:=Scanner.WarnMsgState[MsgNumber];
  2742. case State of
  2743. wmsOff:
  2744. begin
  2745. {$IFDEF VerbosePasAnalyzer}
  2746. writeln('TPasAnalyzer.EmitMessage ignoring [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  2747. {$ENDIF}
  2748. exit;
  2749. end;
  2750. wmsError:
  2751. MsgType:=mtError;
  2752. end;
  2753. end;
  2754. end;
  2755. end;
  2756. Msg:=TPAMessage.Create;
  2757. Msg.Id:=Id;
  2758. Msg.MsgType:=MsgType;
  2759. Msg.MsgNumber:=MsgNumber;
  2760. Msg.MsgPattern:=Fmt;
  2761. Msg.MsgText:=SafeFormat(Fmt,Args);
  2762. CreateMsgArgs(Msg.Args,Args);
  2763. Msg.PosEl:=PosEl;
  2764. Msg.Filename:=PosEl.SourceFilename;
  2765. Resolver.UnmangleSourceLineNumber(PosEl.SourceLinenumber,Msg.Row,Msg.Col);
  2766. EmitMessage(Msg);
  2767. end;
  2768. procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
  2769. begin
  2770. if not Assigned(OnMessage) then
  2771. begin
  2772. Msg.Release;
  2773. exit;
  2774. end;
  2775. {$IFDEF VerbosePasAnalyzer}
  2776. writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') "',Msg.MsgText,'" at ',Resolver.GetElementSourcePosStr(Msg.PosEl),' ScopeModule=',GetObjName(ScopeModule));
  2777. {$ENDIF}
  2778. try
  2779. OnMessage(Self,Msg);
  2780. finally
  2781. Msg.Release;
  2782. end;
  2783. end;
  2784. class function TPasAnalyzer.GetWarnIdentifierNumbers(Identifier: string; out
  2785. MsgNumbers: TIntegerDynArray): boolean;
  2786. procedure SetNumber(Number: integer);
  2787. begin
  2788. {$IF FPC_FULLVERSION>=30101}
  2789. MsgNumbers:=[Number];
  2790. {$ELSE}
  2791. Setlength(MsgNumbers,1);
  2792. MsgNumbers[0]:=Number;
  2793. {$ENDIF}
  2794. end;
  2795. begin
  2796. if Identifier='' then exit(false);
  2797. if Identifier[1] in ['0'..'9'] then exit(false);
  2798. Result:=true;
  2799. case UpperCase(Identifier) of
  2800. // Delphi+FPC
  2801. 'NO_RETVAL': SetNumber(nPAFunctionResultDoesNotSeemToBeSet); // Function result is not set.
  2802. else
  2803. Result:=false;
  2804. end;
  2805. end;
  2806. function TPasAnalyzer.GetUsedElements: TFPList;
  2807. begin
  2808. Result:=FUsedElements.GetList;
  2809. end;
  2810. end.