pasuseanalyzer.pas 96 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322
  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
  2204. and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
  2205. begin
  2206. // non private property can be used by typeinfo by descendants in other units
  2207. UseTypeInfo(Member);
  2208. end
  2209. else
  2210. ; // else: class/record is in unit interface, mark all non private members
  2211. UseElement(Member,rraNone,true);
  2212. end;
  2213. if FirstTime and (ClassScope<>nil) then
  2214. begin
  2215. // method resolution
  2216. List:=ClassScope.Interfaces;
  2217. if List<>nil then
  2218. for i:=0 to List.Count-1 do
  2219. begin
  2220. o:=TObject(List[i]);
  2221. if o is TPasProperty then
  2222. begin
  2223. // interface delegation
  2224. // Note: This class is used. When the intftype is used, this delegation is used.
  2225. AddOverride(TPasType(aClass.Interfaces[i]),TPasProperty(o));
  2226. end
  2227. else if o is TPasClassIntfMap then
  2228. begin
  2229. Map:=TPasClassIntfMap(o);
  2230. while Map<>nil do
  2231. begin
  2232. ProcList:=Map.Procs;
  2233. if ProcList<>nil then
  2234. for j:=0 to ProcList.Count-1 do
  2235. begin
  2236. ImplProc:=TPasProcedure(ProcList[j]);
  2237. if ImplProc=nil then continue;
  2238. IntfProc:=TObject(Map.Intf.Members[j]) as TPasProcedure;
  2239. // This class is used. When the interface method is used, this method is used.
  2240. AddOverride(IntfProc,ImplProc);
  2241. end;
  2242. Map:=Map.AncestorMap;
  2243. end;
  2244. end
  2245. else
  2246. RaiseNotSupported(20180328224632,aClass,GetObjName(o));
  2247. end;
  2248. end;
  2249. UseAttributes(El);
  2250. end;
  2251. procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
  2252. var
  2253. i: Integer;
  2254. Member: TPasElement;
  2255. begin
  2256. if ElementVisited(El,pocClassConstructor) then exit;
  2257. for i:=0 to El.Members.Count-1 do
  2258. begin
  2259. Member:=TPasElement(El.Members[i]);
  2260. if (Member.ClassType=TPasClassConstructor) or (Member.ClassType=TPasClassDestructor) then
  2261. UseProcedure(TPasProcedure(Member));
  2262. end;
  2263. end;
  2264. procedure TPasAnalyzer.UseSpecializeType(El: TPasSpecializeType;
  2265. Mode: TPAUseMode);
  2266. var
  2267. Param: TPasElement;
  2268. i: Integer;
  2269. begin
  2270. if not MarkElementAsUsed(El) then exit;
  2271. // El.DestType is the generic type, which is never used
  2272. if El.CustomData is TPasSpecializeTypeData then
  2273. UseElType(El,TPasSpecializeTypeData(El.CustomData).SpecializedType,Mode);
  2274. for i:=0 to El.Params.Count-1 do
  2275. begin
  2276. Param:=TPasElement(El.Params[i]);
  2277. if Param is TPasGenericTemplateType then continue;
  2278. UseElement(Param,rraRead,false);
  2279. end;
  2280. end;
  2281. procedure TPasAnalyzer.UseVariable(El: TPasVariable;
  2282. Access: TResolvedRefAccess; UseFull: boolean);
  2283. var
  2284. Usage: TPAElement;
  2285. UseRead, UseWrite: boolean;
  2286. procedure UpdateVarAccess(IsRead, IsWrite: boolean);
  2287. begin
  2288. if IsRead then
  2289. case Usage.Access of
  2290. paiaNone: begin Usage.Access:=paiaRead; UseRead:=true; end;
  2291. paiaRead: ;
  2292. paiaWrite: begin Usage.Access:=paiaWriteRead; UseRead:=true; end;
  2293. paiaReadWrite: ;
  2294. paiaWriteRead: ;
  2295. else RaiseInconsistency(20170311182420,'');
  2296. end;
  2297. if IsWrite then
  2298. case Usage.Access of
  2299. paiaNone: begin Usage.Access:=paiaWrite; UseWrite:=true; end;
  2300. paiaRead: begin Usage.Access:=paiaReadWrite; UseWrite:=true; end;
  2301. paiaWrite: ;
  2302. paiaReadWrite: ;
  2303. paiaWriteRead: ;
  2304. else RaiseInconsistency(20170311182536,'');
  2305. end;
  2306. end;
  2307. var
  2308. Prop: TPasProperty;
  2309. i: Integer;
  2310. IsRead, IsWrite, CanRead, CanWrite: Boolean;
  2311. ClassEl: TPasClassType;
  2312. begin
  2313. if El=nil then exit;
  2314. {$IFDEF VerbosePasAnalyzer}
  2315. writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
  2316. {$ENDIF}
  2317. if El.ClassType=TPasProperty then
  2318. begin
  2319. Prop:=TPasProperty(El);
  2320. if Prop.Parent is TPasClassType then
  2321. begin
  2322. ClassEl:=TPasClassType(Prop.Parent);
  2323. if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then
  2324. begin
  2325. UseFull:=true;
  2326. UseTypeInfo(Prop);
  2327. end;
  2328. end;
  2329. end
  2330. else
  2331. Prop:=nil;
  2332. IsRead:=false;
  2333. IsWrite:=false;
  2334. if UseFull then
  2335. if (Prop<>nil) then
  2336. begin
  2337. CanRead:=Resolver.GetPasPropertyGetter(Prop)<>nil;
  2338. CanWrite:=Resolver.GetPasPropertySetter(Prop)<>nil;
  2339. if CanRead then
  2340. begin
  2341. if CanWrite then
  2342. Access:=rraReadAndAssign
  2343. else
  2344. Access:=rraRead;
  2345. end
  2346. else
  2347. if CanWrite then
  2348. Access:=rraAssign
  2349. else
  2350. Access:=rraNone;
  2351. end
  2352. else
  2353. Access:=rraRead;
  2354. case Access of
  2355. rraNone: ;
  2356. rraRead: IsRead:=true;
  2357. rraAssign: IsWrite:=true;
  2358. rraReadAndAssign,
  2359. rraVarParam,
  2360. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2361. rraParamToUnknownProc: RaiseInconsistency(20170307153439,'');
  2362. else
  2363. RaiseInconsistency(20170308120949,'');
  2364. end;
  2365. UseRead:=false;
  2366. UseWrite:=false;
  2367. if MarkElementAsUsed(El) then
  2368. begin
  2369. // first access of this variable
  2370. Usage:=FindElement(El);
  2371. // first set flags
  2372. if El.Expr<>nil then
  2373. Usage.Access:=paiaWrite;
  2374. UpdateVarAccess(IsRead,IsWrite);
  2375. // then use recursively
  2376. UseElType(El,El.VarType,paumElement);
  2377. UseExpr(El.Expr);
  2378. UseExpr(El.LibraryName);
  2379. UseExpr(El.ExportName);
  2380. UseExpr(El.AbsoluteExpr);
  2381. if Prop<>nil then
  2382. begin
  2383. for i:=0 to Prop.Args.Count-1 do
  2384. UseElType(Prop,TPasArgument(Prop.Args[i]).ArgType,paumElement);
  2385. UseExpr(Prop.IndexExpr);
  2386. // ToDo: UseExpr(Prop.DispIDExpr);
  2387. // see UseTypeInfo: Prop.StoredAccessor, Prop.DefaultExpr
  2388. end;
  2389. end
  2390. else
  2391. begin
  2392. Usage:=FindElement(El);
  2393. if Usage=nil then
  2394. exit; // element outside of scope
  2395. // var is accessed another time
  2396. // first update flags
  2397. UpdateVarAccess(IsRead,IsWrite);
  2398. end;
  2399. // then use recursively
  2400. if Prop<>nil then
  2401. begin
  2402. {$IFDEF VerbosePasAnalyzer}
  2403. writeln('TPasAnalyzer.UseVariable Property=',Prop.FullName,
  2404. ' Ancestor=',GetElModName(Resolver.GetPasPropertyAncestor(Prop)),
  2405. ' UseRead=',UseRead,',Acc=',GetElModName(Resolver.GetPasPropertyGetter(Prop)),
  2406. ' UseWrite=',UseWrite,',Acc=',GetElModName(Resolver.GetPasPropertySetter(Prop)),
  2407. '');
  2408. {$ENDIF}
  2409. if UseRead then
  2410. UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
  2411. if UseWrite then
  2412. UseElement(Resolver.GetPasPropertySetter(Prop),rraAssign,false);
  2413. end;
  2414. end;
  2415. procedure TPasAnalyzer.UseResourcestring(El: TPasResString);
  2416. begin
  2417. if not MarkElementAsUsed(El) then exit;
  2418. UseExpr(El.Expr);
  2419. end;
  2420. procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
  2421. );
  2422. var
  2423. Usage: TPAElement;
  2424. IsRead, IsWrite: Boolean;
  2425. begin
  2426. IsRead:=false;
  2427. IsWrite:=false;
  2428. case Access of
  2429. rraNone: ;
  2430. rraRead: IsRead:=true;
  2431. rraAssign: IsWrite:=true;
  2432. rraReadAndAssign,
  2433. rraVarParam,
  2434. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2435. rraParamToUnknownProc: RaiseInconsistency(20170308121031,'');
  2436. else
  2437. RaiseInconsistency(20170308121037,'');
  2438. end;
  2439. if MarkElementAsUsed(El) then
  2440. begin
  2441. // first time
  2442. Usage:=FindElement(El);
  2443. end
  2444. else
  2445. begin
  2446. // used again
  2447. Usage:=FindElement(El);
  2448. if Usage=nil then
  2449. RaiseNotSupported(20170308121928,El);
  2450. end;
  2451. UpdateAccess(IsWrite, IsRead, Usage);
  2452. end;
  2453. procedure TPasAnalyzer.UseResultElement(El: TPasResultElement;
  2454. Access: TResolvedRefAccess);
  2455. var
  2456. IsRead, IsWrite: Boolean;
  2457. Usage: TPAElement;
  2458. begin
  2459. IsRead:=false;
  2460. IsWrite:=false;
  2461. case Access of
  2462. rraNone: ;
  2463. rraRead: IsRead:=true;
  2464. rraAssign: IsWrite:=true;
  2465. rraReadAndAssign,
  2466. rraVarParam,
  2467. rraOutParam: begin IsRead:=true; IsWrite:=true; end;
  2468. rraParamToUnknownProc: RaiseInconsistency(20170308122319,'');
  2469. else
  2470. RaiseInconsistency(20170308122324,'');
  2471. end;
  2472. if MarkElementAsUsed(El) then
  2473. begin
  2474. // first time
  2475. Usage:=FindElement(El);
  2476. end
  2477. else
  2478. begin
  2479. // used again
  2480. Usage:=FindElement(El);
  2481. if Usage=nil then
  2482. RaiseNotSupported(20170308122333,El);
  2483. end;
  2484. UpdateAccess(IsWrite, IsRead, Usage);
  2485. end;
  2486. procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
  2487. var
  2488. C: TClass;
  2489. begin
  2490. if El=nil then exit;
  2491. C:=El.ClassType;
  2492. if C.InheritsFrom(TPasVariable) then
  2493. EmitVariableHints(TPasVariable(El))
  2494. else if C.InheritsFrom(TPasType) then
  2495. EmitTypeHints(TPasType(El))
  2496. else if C.InheritsFrom(TPasProcedure) then
  2497. EmitProcedureHints(TPasProcedure(El))
  2498. else if C=TPasMethodResolution then
  2499. else
  2500. RaiseInconsistency(20170312093126,'');
  2501. end;
  2502. procedure TPasAnalyzer.EmitSectionHints(Section: TPasSection);
  2503. var
  2504. i: Integer;
  2505. UsedModule, aModule: TPasModule;
  2506. UsesClause: TPasUsesClause;
  2507. Use: TPasUsesUnit;
  2508. PosEl: TPasElement;
  2509. begin
  2510. {$IFDEF VerbosePasAnalyzer}
  2511. writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
  2512. {$ENDIF}
  2513. if Section=nil then exit;
  2514. // initialization, program or library sections
  2515. aModule:=Section.GetModule;
  2516. UsesClause:=Section.UsesClause;
  2517. for i:=0 to length(UsesClause)-1 do
  2518. begin
  2519. Use:=UsesClause[i];
  2520. if Use.Module is TPasModule then
  2521. begin
  2522. UsedModule:=TPasModule(Use.Module);
  2523. if CompareText(UsedModule.Name,'system')=0 then continue;
  2524. if not PAElementExists(UsedModule) then
  2525. begin
  2526. PosEl:=Use.Expr;
  2527. if PosEl=nil then PosEl:=Use;
  2528. EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
  2529. [UsedModule.Name,aModule.Name],PosEl);
  2530. end;
  2531. end;
  2532. end;
  2533. EmitDeclarationsHints(Section);
  2534. end;
  2535. procedure TPasAnalyzer.EmitDeclarationsHints(El: TPasDeclarations);
  2536. var
  2537. i: Integer;
  2538. Decl: TPasElement;
  2539. Usage: TPAElement;
  2540. begin
  2541. {$IFDEF VerbosePasAnalyzer}
  2542. writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
  2543. {$ENDIF}
  2544. for i:=0 to El.Declarations.Count-1 do
  2545. begin
  2546. Decl:=TPasElement(El.Declarations[i]);
  2547. if Decl is TPasVariable then
  2548. EmitVariableHints(TPasVariable(Decl))
  2549. else if Decl is TPasType then
  2550. EmitTypeHints(TPasType(Decl))
  2551. else if Decl is TPasProcedure then
  2552. EmitProcedureHints(TPasProcedure(Decl))
  2553. else if Decl.ClassType=TPasAttributes then
  2554. // no hints
  2555. else
  2556. begin
  2557. Usage:=FindElement(Decl);
  2558. if Usage=nil then
  2559. begin
  2560. // declaration was never used
  2561. if IsSpecializedGenericType(Decl) then
  2562. continue; // no hints for not used specializations
  2563. EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
  2564. sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
  2565. end;
  2566. end;
  2567. end;
  2568. end;
  2569. procedure TPasAnalyzer.EmitTypeHints(El: TPasType);
  2570. var
  2571. C: TClass;
  2572. Usage: TPAElement;
  2573. i: Integer;
  2574. Member, SpecEl: TPasElement;
  2575. Members: TFPList;
  2576. GenScope: TPasGenericScope;
  2577. SpecializedItems: TObjectList;
  2578. begin
  2579. {$IFDEF VerbosePasAnalyzer}
  2580. writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
  2581. {$ENDIF}
  2582. Usage:=FindElement(El);
  2583. if Usage=nil then
  2584. begin
  2585. // the whole type was never used
  2586. if IsSpecializedGenericType(El) then
  2587. exit; // no hints for not used specializations
  2588. if (El.CustomData is TPasGenericScope) then
  2589. begin
  2590. GenScope:=TPasGenericScope(El.CustomData);
  2591. SpecializedItems:=GenScope.SpecializedItems;
  2592. if SpecializedItems<>nil then
  2593. for i:=0 to SpecializedItems.Count-1 do
  2594. begin
  2595. SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
  2596. if FindElement(SpecEl)<>nil then
  2597. exit; // a specialization of this generic type is used -> the generic is used
  2598. end;
  2599. end;
  2600. if (El.Visibility in [visPrivate,visStrictPrivate]) then
  2601. EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
  2602. sPAPrivateTypeXNeverUsed,[El.FullName],El)
  2603. else
  2604. begin
  2605. if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
  2606. exit;
  2607. EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
  2608. sPALocalXYNotUsed,[El.ElementTypeName,GetElementNameAndParams(El)],El);
  2609. end;
  2610. exit;
  2611. end;
  2612. // emit hints for sub elements
  2613. Members:=nil;
  2614. C:=El.ClassType;
  2615. if C=TPasRecordType then
  2616. Members:=TPasRecordType(El).Members
  2617. else if C=TPasClassType then
  2618. begin
  2619. if TPasClassType(El).IsForward then exit;
  2620. Members:=TPasClassType(El).Members;
  2621. end;
  2622. if Members<>nil then
  2623. for i:=0 to Members.Count-1 do
  2624. begin
  2625. Member:=TPasElement(Members[i]);
  2626. if Member.ClassType=TPasAttributes then continue;
  2627. EmitElementHints(Member);
  2628. end;
  2629. end;
  2630. procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);
  2631. var
  2632. Usage: TPAElement;
  2633. begin
  2634. {$IFDEF VerbosePasAnalyzer}
  2635. writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
  2636. {$ENDIF}
  2637. Usage:=FindElement(El);
  2638. if Usage=nil then
  2639. begin
  2640. // not used
  2641. if El.Visibility in [visPrivate,visStrictPrivate] then
  2642. begin
  2643. if El.ClassType=TPasConst then
  2644. EmitMessage(20170311234602,mtHint,nPAPrivateConstXNeverUsed,
  2645. sPAPrivateConstXNeverUsed,[El.FullName],El)
  2646. else if El.ClassType=TPasProperty then
  2647. EmitMessage(20170311234634,mtHint,nPAPrivatePropertyXNeverUsed,
  2648. sPAPrivatePropertyXNeverUsed,[El.FullName],El)
  2649. else
  2650. EmitMessage(20170311231412,mtHint,nPAPrivateFieldIsNeverUsed,
  2651. sPAPrivateFieldIsNeverUsed,[El.FullName],El);
  2652. end
  2653. else if El.ClassType=TPasVariable then
  2654. begin
  2655. if El.Parent is TPasMembersType then
  2656. EmitMessage(20201229033108,mtHint,nPAFieldNotUsed,
  2657. sPAFieldNotUsed,[El.Name],El)
  2658. else
  2659. EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
  2660. sPALocalVariableNotUsed,[El.Name],El);
  2661. end
  2662. else
  2663. EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
  2664. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2665. end
  2666. else if Usage.Access=paiaWrite then
  2667. begin
  2668. // write without read
  2669. if (vmExternal in El.VarModifiers)
  2670. ����or (El.ClassType=TPasProperty)
  2671. or ((El.Parent is TPasClassType) and TPasClassType(El.Parent).IsExternal) then
  2672. exit;
  2673. if El.Visibility in [visPrivate,visStrictPrivate] then
  2674. EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
  2675. sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
  2676. else if El.Parent is TPasMembersType then
  2677. EmitMessage(20201229033618,mtHint,nPAFieldIsAssignedButNeverUsed,
  2678. sPAFieldIsAssignedButNeverUsed,[El.Name],El)
  2679. else
  2680. EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
  2681. sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);
  2682. end;
  2683. end;
  2684. procedure TPasAnalyzer.EmitProcedureHints(El: TPasProcedure);
  2685. var
  2686. Args: TFPList;
  2687. i: Integer;
  2688. Arg: TPasArgument;
  2689. Usage: TPAElement;
  2690. ProcScope: TPasProcedureScope;
  2691. DeclProc, ImplProc: TPasProcedure;
  2692. SpecializedItems: TObjectList;
  2693. SpecEl: TPasElement;
  2694. begin
  2695. {$IFDEF VerbosePasAnalyzer}
  2696. writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
  2697. {$ENDIF}
  2698. ProcScope:=El.CustomData as TPasProcedureScope;
  2699. if ProcScope.DeclarationProc=nil then
  2700. DeclProc:=El
  2701. else
  2702. DeclProc:=ProcScope.DeclarationProc;
  2703. if ProcScope.ImplProc=nil then
  2704. ImplProc:=El
  2705. else
  2706. ImplProc:=ProcScope.ImplProc;
  2707. if (ProcScope.ClassRecScope<>nil)
  2708. and (ProcScope.ClassRecScope.SpecializedFromItem<>nil) then
  2709. exit; // no hints for not used specializations
  2710. if not PAElementExists(DeclProc) then
  2711. begin
  2712. // procedure never used
  2713. if ProcScope.DeclarationProc<>nil then
  2714. exit;
  2715. if ProcScope.SpecializedFromItem<>nil then
  2716. exit; // no hint for not used specialized procedure
  2717. SpecializedItems:=ProcScope.SpecializedItems;
  2718. if SpecializedItems<>nil then
  2719. for i:=0 to SpecializedItems.Count-1 do
  2720. begin
  2721. SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
  2722. if FindElement(SpecEl)<>nil then
  2723. exit; // a specialization of this generic procedure is used
  2724. end;
  2725. if El.Visibility in [visPrivate,visStrictPrivate] then
  2726. EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
  2727. sPAPrivateMethodIsNeverUsed,[El.FullName],El)
  2728. else
  2729. EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
  2730. sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
  2731. exit;
  2732. end;
  2733. // procedure was used
  2734. if [pmAbstract,pmAssembler,pmExternal]*DeclProc.Modifiers<>[] then exit;
  2735. if [pmAssembler]*ImplProc.Modifiers<>[] then exit;
  2736. if El.Parent is TPasClassType then
  2737. begin
  2738. if TPasClassType(El.Parent).ObjKind=okInterface then exit;
  2739. end;
  2740. if ProcScope.DeclarationProc=nil then
  2741. begin
  2742. // check parameters
  2743. Args:=El.ProcType.Args;
  2744. for i:=0 to Args.Count-1 do
  2745. begin
  2746. Arg:=TPasArgument(Args[i]);
  2747. Usage:=FindElement(Arg);
  2748. if (Usage=nil) or (Usage.Access=paiaNone) then
  2749. begin
  2750. // parameter was never used
  2751. if (Arg.Parent is TPasProcedureType) and (Arg.Parent.Parent is TPasProcedure)
  2752. and ([pmVirtual,pmOverride]*TPasProcedure(Arg.Parent.Parent).Modifiers<>[]) then
  2753. EmitMessage(20180625153623,mtHint,nPAParameterInOverrideNotUsed,
  2754. sPAParameterInOverrideNotUsed,[Arg.Name],Arg)
  2755. else
  2756. EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
  2757. sPAParameterNotUsed,[Arg.Name],Arg);
  2758. end
  2759. else
  2760. begin
  2761. // parameter was used
  2762. if (Usage.Access=paiaWrite) and not (Arg.Access in [argOut,argVar]) then
  2763. EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed,
  2764. sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg);
  2765. end;
  2766. end;
  2767. // check result
  2768. if (El.ProcType is TPasFunctionType) then
  2769. EmitFunctionResultHints(TPasFunction(El));
  2770. end;
  2771. if El.Body<>nil then
  2772. begin
  2773. // check declarations
  2774. EmitDeclarationsHints(El.Body);
  2775. // ToDo: emit hints for statements
  2776. end;
  2777. end;
  2778. procedure TPasAnalyzer.EmitFunctionResultHints(El: TPasFunction);
  2779. var
  2780. FuncType: TPasFunctionType;
  2781. Usage: TPAElement;
  2782. TypeEl: TPasType;
  2783. Members: TFPList;
  2784. i: Integer;
  2785. Member: TPasElement;
  2786. HasFields: Boolean;
  2787. PosEl: TPasResultElement;
  2788. ProcScope: TPasProcedureScope;
  2789. begin
  2790. FuncType:=El.FuncType;
  2791. Usage:=FindElement(FuncType.ResultEl);
  2792. if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
  2793. begin
  2794. // result was never set
  2795. TypeEl:=Resolver.ResolveAliasType(FuncType.ResultEl.ResultType);
  2796. if TypeEl is TPasRecordType then
  2797. begin
  2798. Members:=TPasRecordType(TypeEl).Members;
  2799. HasFields:=false;
  2800. for i:=0 to Members.Count-1 do
  2801. begin
  2802. Member:=TPasElement(Members[i]);
  2803. if Member.ClassType=TPasVariable then
  2804. begin
  2805. HasFields:=true;
  2806. break;
  2807. end;
  2808. end;
  2809. if not HasFields then
  2810. // empty record -> no hint
  2811. exit;
  2812. end;
  2813. PosEl:=FuncType.ResultEl;
  2814. ProcScope:=El.CustomData as TPasProcedureScope;
  2815. if (ProcScope.ImplProc<>nil)
  2816. and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
  2817. PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
  2818. EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
  2819. sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
  2820. end
  2821. else
  2822. begin
  2823. // result was used
  2824. end;
  2825. end;
  2826. constructor TPasAnalyzer.Create;
  2827. var
  2828. m: TPAUseMode;
  2829. oc: TPAOtherCheckedEl;
  2830. begin
  2831. CreateTree;
  2832. for m in TPAUseMode do
  2833. FModeChecked[m]:=CreatePasElementSet;
  2834. for oc in TPAOtherCheckedEl do
  2835. FOtherChecked[oc]:=CreatePasElementSet;
  2836. FOverrideLists:=TPasAnalyzerKeySet.Create(
  2837. {$ifdef pas2js}
  2838. @PAOverrideList_ElToHashName,@PasElementToHashName
  2839. {$else}
  2840. @ComparePAOverrideLists,@CompareElementWithPAOverrideList
  2841. {$endif});
  2842. end;
  2843. destructor TPasAnalyzer.Destroy;
  2844. var
  2845. m: TPAUseMode;
  2846. oc: TPAOtherCheckedEl;
  2847. begin
  2848. Clear;
  2849. FreeAndNil(FOverrideLists);
  2850. FreeAndNil(FUsedElements);
  2851. for m in TPAUseMode do
  2852. FreeAndNil(FModeChecked[m]);
  2853. for oc in TPAOtherCheckedEl do
  2854. FreeAndNil(FOtherChecked[oc]);
  2855. inherited Destroy;
  2856. end;
  2857. procedure TPasAnalyzer.Clear;
  2858. var
  2859. m: TPAUseMode;
  2860. oc: TPAOtherCheckedEl;
  2861. begin
  2862. FOverrideLists.FreeItems;
  2863. FUsedElements.FreeItems;
  2864. for m in TPAUseMode do
  2865. FModeChecked[m].Clear;
  2866. for oc in TPAOtherCheckedEl do
  2867. FOtherChecked[oc].Clear;
  2868. end;
  2869. procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
  2870. var
  2871. Mode: TPAUseMode;
  2872. begin
  2873. {$IFDEF VerbosePasAnalyzer}
  2874. writeln('TPasAnalyzer.AnalyzeModule START ',GetElModName(aModule));
  2875. {$ENDIF}
  2876. if Resolver=nil then
  2877. RaiseInconsistency(20170314223032,'TPasAnalyzer.AnalyzeModule missing Resolver');
  2878. if FUsedElements.Count>0 then
  2879. RaiseInconsistency(20170315153243,'');
  2880. ScopeModule:=aModule;
  2881. if (aModule is TPasProgram) or (aModule is TPasLibrary) then
  2882. Mode:=paumAllExports
  2883. else
  2884. Mode:=paumAllPasUsable;
  2885. UseModule(aModule,Mode);
  2886. {$IFDEF VerbosePasAnalyzer}
  2887. writeln('TPasAnalyzer.AnalyzeModule END ',GetElModName(aModule));
  2888. {$ENDIF}
  2889. end;
  2890. procedure TPasAnalyzer.AnalyzeWholeProgram(aStartModule: TPasProgram);
  2891. begin
  2892. {$IFDEF VerbosePasAnalyzer}
  2893. writeln('TPasAnalyzer.AnalyzeWholeProgram START ',GetElModName(aStartModule));
  2894. {$ENDIF}
  2895. if Resolver=nil then
  2896. RaiseInconsistency(20170315153201,'TPasAnalyzer.AnalyzeWholeProgram missing Resolver');
  2897. if FUsedElements.Count>0 then
  2898. RaiseInconsistency(20170315153252,'');
  2899. ScopeModule:=nil;
  2900. UseModule(aStartModule,paumAllExports);
  2901. MarkElementAsUsed(aStartModule); // always mark the start
  2902. {$IFDEF VerbosePasAnalyzer}
  2903. writeln('TPasAnalyzer.AnalyzeWholeProgram END ',GetElModName(aStartModule));
  2904. {$ENDIF}
  2905. end;
  2906. procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
  2907. begin
  2908. {$IFDEF VerbosePasAnalyzer}
  2909. writeln('TPasAnalyzer.EmitModuleHints ',GetElModName(aModule));
  2910. {$ENDIF}
  2911. if aModule.ClassType=TPasProgram then
  2912. EmitSectionHints(TPasProgram(aModule).ProgramSection)
  2913. else if aModule.ClassType=TPasLibrary then
  2914. EmitSectionHints(TPasLibrary(aModule).LibrarySection)
  2915. else
  2916. begin
  2917. // unit
  2918. EmitSectionHints(aModule.InterfaceSection);
  2919. EmitSectionHints(aModule.ImplementationSection);
  2920. end;
  2921. //EmitBlockHints(aModule.InitializationSection);
  2922. //EmitBlockHints(aModule.FinalizationSection);
  2923. end;
  2924. function TPasAnalyzer.FindUsedElement(El: TPasElement): TPAElement;
  2925. var
  2926. ProcScope: TPasProcedureScope;
  2927. begin
  2928. if not IsIdentifier(El) then exit(nil);
  2929. if El is TPasProcedure then
  2930. begin
  2931. ProcScope:=El.CustomData as TPasProcedureScope;
  2932. if (ProcScope<>nil) and (ProcScope.DeclarationProc<>nil) then
  2933. El:=ProcScope.DeclarationProc;
  2934. end;
  2935. Result:=FindElement(El);
  2936. end;
  2937. function TPasAnalyzer.IsUsed(El: TPasElement): boolean;
  2938. begin
  2939. Result:=FindUsedElement(El)<>nil;
  2940. end;
  2941. function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
  2942. begin
  2943. Result:=FModeChecked[paumTypeInfo].ContainsItem(El);
  2944. end;
  2945. function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
  2946. begin
  2947. if El=nil then
  2948. exit(true);
  2949. if El.ClassType=TInterfaceSection then
  2950. exit(false);
  2951. if IsExport(El) then exit(false);
  2952. case El.Visibility of
  2953. visPrivate,visStrictPrivate: exit(true);
  2954. visPublished: exit(false);
  2955. end;
  2956. Result:=IsModuleInternal(El.Parent);
  2957. end;
  2958. function TPasAnalyzer.IsExport(El: TPasElement): boolean;
  2959. begin
  2960. if El is TPasVariable then
  2961. Result:=[vmExport,vmPublic]*TPasVariable(El).VarModifiers<>[]
  2962. else if El is TPasProcedure then
  2963. Result:=[pmExport,pmPublic]*TPasProcedure(El).Modifiers<>[]
  2964. else
  2965. Result:=false;
  2966. end;
  2967. function TPasAnalyzer.IsIdentifier(El: TPasElement): boolean;
  2968. var
  2969. C: TClass;
  2970. begin
  2971. C:=El.ClassType;
  2972. Result:=C.InheritsFrom(TPasType)
  2973. or C.InheritsFrom(TPasVariable)
  2974. or C.InheritsFrom(TPasProcedure)
  2975. or C.InheritsFrom(TPasModule)
  2976. or (C=TPasArgument)
  2977. or (C=TPasResString);
  2978. end;
  2979. function TPasAnalyzer.IsImplBlockEmpty(El: TPasImplBlock): boolean;
  2980. begin
  2981. Result:=true;
  2982. if (El=nil) or (El.Elements.Count=0) then exit;
  2983. Result:=false;
  2984. end;
  2985. function TPasAnalyzer.IsSpecializedGenericType(El: TPasElement): boolean;
  2986. begin
  2987. if (El is TPasGenericType) and (El.CustomData is TPasGenericScope)
  2988. and (TPasGenericScope(El.CustomData).SpecializedFromItem<>nil) then
  2989. exit(true);
  2990. Result:=false;
  2991. end;
  2992. procedure TPasAnalyzer.EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
  2993. MsgNumber: integer; Fmt: String;
  2994. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2995. PosEl: TPasElement);
  2996. var
  2997. Msg: TPAMessage;
  2998. El: TPasElement;
  2999. ProcScope: TPasProcedureScope;
  3000. ModScope: TPasModuleScope;
  3001. Scanner: TPascalScanner;
  3002. State: TWarnMsgState;
  3003. begin
  3004. {$IFDEF VerbosePasAnalyzer}
  3005. //writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  3006. {$ENDIF}
  3007. if MsgType>=mtWarning then
  3008. begin
  3009. El:=PosEl;
  3010. while El<>nil do
  3011. begin
  3012. if El is TPasProcedure then
  3013. begin
  3014. ProcScope:=El.CustomData as TPasProcedureScope;
  3015. if ProcScope.ImplProc<>nil then
  3016. ProcScope:=ProcScope.ImplProc.CustomData as TPasProcedureScope;
  3017. case MsgType of
  3018. mtHint: if not (bsHints in ProcScope.BoolSwitches) then exit;
  3019. mtNote: if not (bsNotes in ProcScope.BoolSwitches) then exit;
  3020. mtWarning: if not (bsWarnings in ProcScope.BoolSwitches) then exit;
  3021. end;
  3022. break;
  3023. end
  3024. else if El is TPasModule then
  3025. begin
  3026. ModScope:=TPasModule(El).CustomData as TPasModuleScope;
  3027. case MsgType of
  3028. mtHint: if not (bsHints in ModScope.BoolSwitches) then exit;
  3029. mtNote: if not (bsNotes in ModScope.BoolSwitches) then exit;
  3030. mtWarning: if not (bsWarnings in ModScope.BoolSwitches) then exit;
  3031. end;
  3032. break;
  3033. end;
  3034. El:=El.Parent;
  3035. end;
  3036. if (Resolver<>nil) and (Resolver.CurrentParser<>nil) then
  3037. begin
  3038. Scanner:=Resolver.CurrentParser.Scanner;
  3039. if Scanner<>nil then
  3040. begin
  3041. State:=Scanner.WarnMsgState[MsgNumber];
  3042. case State of
  3043. wmsOff:
  3044. begin
  3045. {$IFDEF VerbosePasAnalyzer}
  3046. writeln('TPasAnalyzer.EmitMessage ignoring [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
  3047. {$ENDIF}
  3048. exit;
  3049. end;
  3050. wmsError:
  3051. MsgType:=mtError;
  3052. end;
  3053. end;
  3054. end;
  3055. end;
  3056. Msg:=TPAMessage.Create;
  3057. Msg.Id:=Id;
  3058. Msg.MsgType:=MsgType;
  3059. Msg.MsgNumber:=MsgNumber;
  3060. Msg.MsgPattern:=Fmt;
  3061. Msg.MsgText:=SafeFormat(Fmt,Args);
  3062. CreateMsgArgs(Msg.Args,Args);
  3063. Msg.PosEl:=PosEl;
  3064. Msg.Filename:=PosEl.SourceFilename;
  3065. Resolver.UnmangleSourceLineNumber(PosEl.SourceLinenumber,Msg.Row,Msg.Col);
  3066. EmitMessage(Msg);
  3067. end;
  3068. procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
  3069. begin
  3070. if not Assigned(OnMessage) then
  3071. begin
  3072. Msg.Release;
  3073. exit;
  3074. end;
  3075. {$IFDEF VerbosePasAnalyzer}
  3076. writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') "',Msg.MsgText,'" at ',Resolver.GetElementSourcePosStr(Msg.PosEl),' ScopeModule=',GetObjName(ScopeModule));
  3077. {$ENDIF}
  3078. try
  3079. OnMessage(Self,Msg);
  3080. finally
  3081. Msg.Release;
  3082. end;
  3083. end;
  3084. class function TPasAnalyzer.GetWarnIdentifierNumbers(Identifier: string; out
  3085. MsgNumbers: TIntegerDynArray): boolean;
  3086. procedure SetNumber(Number: integer);
  3087. begin
  3088. {$IF FPC_FULLVERSION>=30101}
  3089. MsgNumbers:=[Number];
  3090. {$ELSE}
  3091. Setlength(MsgNumbers,1);
  3092. MsgNumbers[0]:=Number;
  3093. {$ENDIF}
  3094. end;
  3095. begin
  3096. if Identifier='' then exit(false);
  3097. if Identifier[1] in ['0'..'9'] then exit(false);
  3098. Result:=true;
  3099. case UpperCase(Identifier) of
  3100. // Delphi+FPC
  3101. 'NO_RETVAL': SetNumber(nPAFunctionResultDoesNotSeemToBeSet); // Function result is not set.
  3102. else
  3103. Result:=false;
  3104. end;
  3105. end;
  3106. function TPasAnalyzer.GetUsedElements: TFPList;
  3107. begin
  3108. Result:=FUsedElements.GetList;
  3109. end;
  3110. end.