pasuseanalyzer.pas 97 KB

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