pexpr.pas 192 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Does parsing of expression for Free Pascal
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit pexpr;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. symtype,symdef,symbase,
  22. node,ncal,compinnr,
  23. tokens,globtype,globals,constexp,
  24. pgentype;
  25. type
  26. texprflag = (
  27. ef_accept_equal,
  28. ef_type_only,
  29. ef_had_specialize,
  30. ef_check_attr_suffix
  31. );
  32. texprflags = set of texprflag;
  33. { reads a whole expression }
  34. function expr(dotypecheck:boolean) : tnode;
  35. { reads an expression without assignements and .. }
  36. function comp_expr(flags:texprflags):tnode;
  37. { reads a single factor }
  38. function factor(getaddr:boolean;flags:texprflags) : tnode;
  39. procedure string_dec(var def: tdef; allowtypedef: boolean);
  40. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  41. { the ID token has to be consumed before calling this function }
  42. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  43. function get_intconst:TConstExprInt;
  44. function get_stringconst:string;
  45. { Does some postprocessing for a generic type (especially when nested types
  46. of the specialization are used) }
  47. procedure post_comp_expr_gendef(var def: tdef);
  48. implementation
  49. uses
  50. { common }
  51. cutils,cclasses,
  52. { global }
  53. verbose,
  54. systems,widestr,
  55. { symtable }
  56. symconst,symtable,symsym,symcpu,defutil,defcmp,
  57. { module }
  58. fmodule,ppu,
  59. { pass 1 }
  60. pass_1,
  61. nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
  62. { parser }
  63. scanner,
  64. pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
  65. ;
  66. function sub_expr(pred_level:Toperator_precedence;flags:texprflags;factornode:tnode):tnode;forward;
  67. const
  68. { true, if the inherited call is anonymous }
  69. anon_inherited : boolean = false;
  70. { last def found, only used by anon. inherited calls to insert proper type casts }
  71. srdef : tdef = nil;
  72. procedure string_dec(var def:tdef; allowtypedef: boolean);
  73. { reads a string type with optional length }
  74. { and returns a pointer to the string }
  75. { definition }
  76. var
  77. p : tnode;
  78. begin
  79. def:=cshortstringtype;
  80. consume(_STRING);
  81. if token=_LECKKLAMMER then
  82. begin
  83. if not(allowtypedef) then
  84. Message(parser_e_no_local_para_def);
  85. consume(_LECKKLAMMER);
  86. p:=comp_expr([ef_accept_equal]);
  87. if not is_constintnode(p) then
  88. begin
  89. Message(parser_e_illegal_expression);
  90. { error recovery }
  91. consume(_RECKKLAMMER);
  92. end
  93. else
  94. begin
  95. if (tordconstnode(p).value<=0) then
  96. begin
  97. Message(parser_e_invalid_string_size);
  98. tordconstnode(p).value:=255;
  99. end;
  100. if tordconstnode(p).value>255 then
  101. begin
  102. { longstring is currently unsupported (CEC)! }
  103. { t:=cstringdef.createlong(tordconstnode(p).value))}
  104. Message(parser_e_invalid_string_size);
  105. tordconstnode(p).value:=255;
  106. def:=cstringdef.createshort(int64(tordconstnode(p).value),true);
  107. end
  108. else
  109. if tordconstnode(p).value<>255 then
  110. def:=cstringdef.createshort(int64(tordconstnode(p).value),true);
  111. consume(_RECKKLAMMER);
  112. end;
  113. p.free;
  114. end
  115. else
  116. begin
  117. if cs_refcountedstrings in current_settings.localswitches then
  118. begin
  119. if m_default_unicodestring in current_settings.modeswitches then
  120. def:=cunicodestringtype
  121. else
  122. def:=cansistringtype
  123. end
  124. else
  125. def:=cshortstringtype;
  126. end;
  127. end;
  128. function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode;
  129. var
  130. p1,p2,argname : tnode;
  131. prev_in_args,
  132. old_named_args_allowed : boolean;
  133. begin
  134. if token=end_of_paras then
  135. begin
  136. parse_paras:=nil;
  137. exit;
  138. end;
  139. { save old values }
  140. prev_in_args:=in_args;
  141. old_named_args_allowed:=named_args_allowed;
  142. { set para parsing values }
  143. in_args:=true;
  144. named_args_allowed:=false;
  145. p2:=nil;
  146. repeat
  147. if __namedpara then
  148. begin
  149. if token=_COMMA then
  150. begin
  151. { empty parameter }
  152. p2:=ccallparanode.create(cnothingnode.create,p2);
  153. end
  154. else
  155. begin
  156. named_args_allowed:=true;
  157. p1:=comp_expr([ef_accept_equal]);
  158. named_args_allowed:=false;
  159. if found_arg_name then
  160. begin
  161. argname:=p1;
  162. p1:=comp_expr([ef_accept_equal]);
  163. p2:=ccallparanode.create(p1,p2);
  164. tcallparanode(p2).parametername:=argname;
  165. end
  166. else
  167. p2:=ccallparanode.create(p1,p2);
  168. found_arg_name:=false;
  169. end;
  170. end
  171. else
  172. begin
  173. p1:=comp_expr([ef_accept_equal]);
  174. p2:=ccallparanode.create(p1,p2);
  175. end;
  176. { it's for the str(l:5,s); }
  177. if __colon and (token=_COLON) then
  178. begin
  179. consume(_COLON);
  180. p1:=comp_expr([ef_accept_equal]);
  181. p2:=ccallparanode.create(p1,p2);
  182. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  183. if try_to_consume(_COLON) then
  184. begin
  185. p1:=comp_expr([ef_accept_equal]);
  186. p2:=ccallparanode.create(p1,p2);
  187. include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
  188. end
  189. end;
  190. until not try_to_consume(_COMMA);
  191. in_args:=prev_in_args;
  192. named_args_allowed:=old_named_args_allowed;
  193. parse_paras:=p2;
  194. end;
  195. function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode;
  196. var
  197. hp : tnode;
  198. hdef : tdef;
  199. temp : ttempcreatenode;
  200. newstatement : tstatementnode;
  201. begin
  202. { Properties are not allowed, because the write can
  203. be different from the read }
  204. if (nf_isproperty in p1.flags) then
  205. begin
  206. Message(type_e_variable_id_expected);
  207. { We can continue with the loading,
  208. it'll not create errors. Only the expected
  209. result can be wrong }
  210. end;
  211. hp:=p1;
  212. while assigned(hp) and
  213. (hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do
  214. hp:=tunarynode(hp).left;
  215. if not assigned(hp) then
  216. internalerror(200410121);
  217. if (hp.nodetype=calln) then
  218. begin
  219. typecheckpass(p1);
  220. result:=internalstatements(newstatement);
  221. hdef:=cpointerdef.getreusable(p1.resultdef);
  222. temp:=ctempcreatenode.create(hdef,sizeof(pint),tt_persistent,false);
  223. addstatement(newstatement,temp);
  224. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
  225. addstatement(newstatement,cassignmentnode.create(
  226. cderefnode.create(ctemprefnode.create(temp)),
  227. caddnode.create(ntyp,
  228. cderefnode.create(ctemprefnode.create(temp)),
  229. p2)));
  230. addstatement(newstatement,ctempdeletenode.create(temp));
  231. end
  232. else
  233. result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2));
  234. end;
  235. function statement_syssym(l : tinlinenumber) : tnode;
  236. var
  237. p1,p2,paras : tnode;
  238. err,
  239. prev_in_args : boolean;
  240. def : tdef;
  241. exit_procinfo: tprocinfo;
  242. begin
  243. prev_in_args:=in_args;
  244. case l of
  245. in_new_x :
  246. begin
  247. if afterassignment or in_args then
  248. statement_syssym:=new_function
  249. else
  250. statement_syssym:=new_dispose_statement(true);
  251. end;
  252. in_dispose_x :
  253. begin
  254. statement_syssym:=new_dispose_statement(false);
  255. end;
  256. in_ord_x :
  257. begin
  258. consume(_LKLAMMER);
  259. in_args:=true;
  260. p1:=comp_expr([ef_accept_equal]);
  261. consume(_RKLAMMER);
  262. p1:=geninlinenode(in_ord_x,false,p1);
  263. statement_syssym := p1;
  264. end;
  265. in_exit :
  266. begin
  267. statement_syssym:=nil;
  268. if try_to_consume(_LKLAMMER) then
  269. begin
  270. if not (m_mac in current_settings.modeswitches) then
  271. begin
  272. if not(try_to_consume(_RKLAMMER)) then
  273. begin
  274. p1:=comp_expr([ef_accept_equal]);
  275. consume(_RKLAMMER);
  276. if not assigned(current_procinfo) or
  277. (current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) or
  278. is_void(current_procinfo.procdef.returndef) then
  279. begin
  280. Message(parser_e_void_function);
  281. { recovery }
  282. p1.free;
  283. p1:=nil;
  284. end;
  285. end
  286. else
  287. p1:=nil;
  288. end
  289. else
  290. begin
  291. { non local exit ? }
  292. if current_procinfo.procdef.procsym.name<>pattern then
  293. begin
  294. exit_procinfo:=current_procinfo.parent;
  295. while assigned(exit_procinfo) do
  296. begin
  297. if exit_procinfo.procdef.procsym.name=pattern then
  298. break;
  299. exit_procinfo:=exit_procinfo.parent;
  300. end;
  301. if assigned(exit_procinfo) then
  302. begin
  303. if not(assigned(exit_procinfo.nestedexitlabel)) then
  304. begin
  305. include(current_procinfo.flags,pi_has_nested_exit);
  306. exclude(current_procinfo.procdef.procoptions,po_inline);
  307. if is_nested_pd(current_procinfo.procdef) then
  308. current_procinfo.set_needs_parentfp(exit_procinfo.procdef.parast.symtablelevel);
  309. exit_procinfo.nestedexitlabel:=clabelsym.create('$nestedexit');
  310. { the compiler is responsible to define this label }
  311. exit_procinfo.nestedexitlabel.defined:=true;
  312. exit_procinfo.nestedexitlabel.used:=true;
  313. exit_procinfo.nestedexitlabel.jumpbuf:=clocalvarsym.create('LABEL$_'+exit_procinfo.nestedexitlabel.name,vs_value,rec_jmp_buf,[]);
  314. exit_procinfo.procdef.localst.insert(exit_procinfo.nestedexitlabel);
  315. exit_procinfo.procdef.localst.insert(exit_procinfo.nestedexitlabel.jumpbuf);
  316. end;
  317. statement_syssym:=cgotonode.create(exit_procinfo.nestedexitlabel);
  318. tgotonode(statement_syssym).labelsym:=exit_procinfo.nestedexitlabel;
  319. end
  320. else
  321. Message(parser_e_macpas_exit_wrong_param);
  322. end;
  323. consume(_ID);
  324. consume(_RKLAMMER);
  325. p1:=nil;
  326. end
  327. end
  328. else
  329. p1:=nil;
  330. if not assigned(statement_syssym) then
  331. statement_syssym:=cexitnode.create(p1);
  332. end;
  333. in_break :
  334. begin
  335. statement_syssym:=cbreaknode.create
  336. end;
  337. in_continue :
  338. begin
  339. statement_syssym:=ccontinuenode.create
  340. end;
  341. in_leave :
  342. begin
  343. if m_mac in current_settings.modeswitches then
  344. statement_syssym:=cbreaknode.create
  345. else
  346. begin
  347. Message1(sym_e_id_not_found, orgpattern);
  348. statement_syssym:=cerrornode.create;
  349. end;
  350. end;
  351. in_cycle :
  352. begin
  353. if m_mac in current_settings.modeswitches then
  354. statement_syssym:=ccontinuenode.create
  355. else
  356. begin
  357. Message1(sym_e_id_not_found, orgpattern);
  358. statement_syssym:=cerrornode.create;
  359. end;
  360. end;
  361. in_typeof_x :
  362. begin
  363. consume(_LKLAMMER);
  364. in_args:=true;
  365. p1:=comp_expr([ef_accept_equal]);
  366. consume(_RKLAMMER);
  367. if p1.nodetype=typen then
  368. ttypenode(p1).allowed:=true;
  369. { Allow classrefdef, which is required for
  370. Typeof(self) in static class methods }
  371. if not(is_objc_class_or_protocol(p1.resultdef)) and
  372. not(is_java_class_or_interface(p1.resultdef)) and
  373. ((p1.resultdef.typ = objectdef) or
  374. (assigned(current_procinfo) and
  375. ((po_classmethod in current_procinfo.procdef.procoptions) or
  376. (po_staticmethod in current_procinfo.procdef.procoptions)) and
  377. (p1.resultdef.typ=classrefdef))) then
  378. statement_syssym:=geninlinenode(in_typeof_x,false,p1)
  379. else
  380. begin
  381. Message(parser_e_class_id_expected);
  382. p1.destroy;
  383. statement_syssym:=cerrornode.create;
  384. end;
  385. end;
  386. in_sizeof_x,
  387. in_bitsizeof_x :
  388. begin
  389. consume(_LKLAMMER);
  390. in_args:=true;
  391. p1:=comp_expr([ef_accept_equal]);
  392. consume(_RKLAMMER);
  393. if ((p1.nodetype<>typen) and
  394. (
  395. (is_object(p1.resultdef) and
  396. (oo_has_constructor in tobjectdef(p1.resultdef).objectoptions)) or
  397. is_open_array(p1.resultdef) or
  398. is_array_of_const(p1.resultdef) or
  399. is_open_string(p1.resultdef)
  400. )) or
  401. { keep the function call if it is a type parameter to avoid arithmetic errors due to constant folding }
  402. is_typeparam(p1.resultdef) then
  403. begin
  404. statement_syssym:=geninlinenode(in_sizeof_x,false,p1);
  405. { no packed bit support for these things }
  406. if l=in_bitsizeof_x then
  407. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
  408. { type sym is a generic parameter }
  409. if assigned(p1.resultdef.typesym) and (sp_generic_para in p1.resultdef.typesym.symoptions) then
  410. include(statement_syssym.flags,nf_generic_para);
  411. end
  412. else
  413. begin
  414. { allow helpers for SizeOf and BitSizeOf }
  415. if p1.nodetype=typen then
  416. ttypenode(p1).helperallowed:=true;
  417. if (p1.resultdef.typ=forwarddef) then
  418. Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
  419. if (l = in_sizeof_x) or
  420. (not((p1.nodetype = vecn) and
  421. is_packed_array(tvecnode(p1).left.resultdef)) and
  422. not((p1.nodetype = subscriptn) and
  423. is_packed_record_or_object(tsubscriptnode(p1).left.resultdef))) then
  424. begin
  425. statement_syssym:=cordconstnode.create(p1.resultdef.size,sizesinttype,true);
  426. if (l = in_bitsizeof_x) then
  427. statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
  428. end
  429. else
  430. statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sizesinttype,true);
  431. { type def is a struct with generic fields }
  432. if df_has_generic_fields in p1.resultdef.defoptions then
  433. include(statement_syssym.flags,nf_generic_para);
  434. { p1 not needed !}
  435. p1.destroy;
  436. end;
  437. end;
  438. in_typeinfo_x,
  439. in_objc_encode_x,
  440. in_gettypekind_x,
  441. in_ismanagedtype_x:
  442. begin
  443. if (l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x]) or
  444. (m_objectivec1 in current_settings.modeswitches) then
  445. begin
  446. consume(_LKLAMMER);
  447. in_args:=true;
  448. p1:=comp_expr([ef_accept_equal]);
  449. { When reading a class type it is parsed as loadvmtaddrn,
  450. typeinfo only needs the type so we remove the loadvmtaddrn }
  451. if p1.nodetype=loadvmtaddrn then
  452. begin
  453. p2:=tloadvmtaddrnode(p1).left;
  454. tloadvmtaddrnode(p1).left:=nil;
  455. p1.free;
  456. p1:=p2;
  457. end;
  458. if p1.nodetype=typen then
  459. begin
  460. ttypenode(p1).allowed:=true;
  461. { allow helpers for TypeInfo }
  462. if l in [in_typeinfo_x,in_gettypekind_x,in_ismanagedtype_x] then
  463. ttypenode(p1).helperallowed:=true;
  464. end;
  465. { else
  466. begin
  467. p1.destroy;
  468. p1:=cerrornode.create;
  469. Message(parser_e_illegal_parameter_list);
  470. end;}
  471. consume(_RKLAMMER);
  472. p2:=geninlinenode(l,false,p1);
  473. statement_syssym:=p2;
  474. end
  475. else
  476. begin
  477. Message1(sym_e_id_not_found, orgpattern);
  478. statement_syssym:=cerrornode.create;
  479. end;
  480. end;
  481. in_isconstvalue_x:
  482. begin
  483. consume(_LKLAMMER);
  484. in_args:=true;
  485. p1:=comp_expr([ef_accept_equal]);
  486. consume(_RKLAMMER);
  487. p2:=geninlinenode(l,false,p1);
  488. statement_syssym:=p2;
  489. end;
  490. in_aligned_x,
  491. in_unaligned_x,
  492. in_volatile_x:
  493. begin
  494. err:=false;
  495. consume(_LKLAMMER);
  496. in_args:=true;
  497. p1:=comp_expr([ef_accept_equal]);
  498. p2:=ccallparanode.create(p1,nil);
  499. p2:=geninlinenode(l,false,p2);
  500. consume(_RKLAMMER);
  501. statement_syssym:=p2;
  502. end;
  503. in_assigned_x :
  504. begin
  505. err:=false;
  506. consume(_LKLAMMER);
  507. in_args:=true;
  508. p1:=comp_expr([ef_accept_equal]);
  509. { When reading a class type it is parsed as loadvmtaddrn,
  510. typeinfo only needs the type so we remove the loadvmtaddrn }
  511. if p1.nodetype=loadvmtaddrn then
  512. begin
  513. p2:=tloadvmtaddrnode(p1).left;
  514. tloadvmtaddrnode(p1).left:=nil;
  515. p1.free;
  516. p1:=p2;
  517. end;
  518. if not codegenerror then
  519. begin
  520. case p1.resultdef.typ of
  521. procdef, { procvar }
  522. pointerdef,
  523. procvardef,
  524. classrefdef : ;
  525. objectdef :
  526. if not is_implicit_pointer_object_type(p1.resultdef) then
  527. begin
  528. Message(parser_e_illegal_parameter_list);
  529. err:=true;
  530. end;
  531. arraydef :
  532. if not is_dynamic_array(p1.resultdef) then
  533. begin
  534. Message(parser_e_illegal_parameter_list);
  535. err:=true;
  536. end;
  537. else
  538. if p1.resultdef.typ<>undefineddef then
  539. begin
  540. Message(parser_e_illegal_parameter_list);
  541. err:=true;
  542. end;
  543. end;
  544. end
  545. else
  546. err:=true;
  547. if not err then
  548. begin
  549. p2:=ccallparanode.create(p1,nil);
  550. p2:=geninlinenode(in_assigned_x,false,p2);
  551. end
  552. else
  553. begin
  554. p1.free;
  555. p2:=cerrornode.create;
  556. end;
  557. consume(_RKLAMMER);
  558. statement_syssym:=p2;
  559. end;
  560. in_addr_x :
  561. begin
  562. consume(_LKLAMMER);
  563. got_addrn:=true;
  564. p1:=factor(true,[]);
  565. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  566. if token<>_RKLAMMER then
  567. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  568. p1:=caddrnode.create(p1);
  569. got_addrn:=false;
  570. consume(_RKLAMMER);
  571. statement_syssym:=p1;
  572. end;
  573. {$ifdef i8086}
  574. in_faraddr_x :
  575. begin
  576. consume(_LKLAMMER);
  577. got_addrn:=true;
  578. p1:=factor(true,[]);
  579. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  580. if token<>_RKLAMMER then
  581. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  582. p1:=geninlinenode(in_faraddr_x,false,p1);
  583. got_addrn:=false;
  584. consume(_RKLAMMER);
  585. statement_syssym:=p1;
  586. end;
  587. {$endif i8086}
  588. in_ofs_x :
  589. begin
  590. if target_info.system in systems_managed_vm then
  591. message(parser_e_feature_unsupported_for_vm);
  592. consume(_LKLAMMER);
  593. got_addrn:=true;
  594. p1:=factor(true,[]);
  595. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  596. if token<>_RKLAMMER then
  597. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  598. p1:=caddrnode.create(p1);
  599. include(taddrnode(p1).addrnodeflags,anf_ofs);
  600. got_addrn:=false;
  601. { Ofs() returns a cardinal/qword, not a pointer }
  602. inserttypeconv_internal(p1,uinttype);
  603. consume(_RKLAMMER);
  604. statement_syssym:=p1;
  605. end;
  606. in_seg_x :
  607. begin
  608. consume(_LKLAMMER);
  609. got_addrn:=true;
  610. p1:=factor(true,[]);
  611. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  612. if token<>_RKLAMMER then
  613. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  614. p1:=geninlinenode(in_seg_x,false,p1);
  615. got_addrn:=false;
  616. consume(_RKLAMMER);
  617. statement_syssym:=p1;
  618. end;
  619. in_high_x,
  620. in_low_x :
  621. begin
  622. consume(_LKLAMMER);
  623. in_args:=true;
  624. p1:=comp_expr([ef_accept_equal]);
  625. p2:=geninlinenode(l,false,p1);
  626. consume(_RKLAMMER);
  627. statement_syssym:=p2;
  628. end;
  629. in_succ_x,
  630. in_pred_x :
  631. begin
  632. consume(_LKLAMMER);
  633. in_args:=true;
  634. p1:=comp_expr([ef_accept_equal]);
  635. p2:=geninlinenode(l,false,p1);
  636. consume(_RKLAMMER);
  637. statement_syssym:=p2;
  638. end;
  639. in_inc_x,
  640. in_dec_x :
  641. begin
  642. consume(_LKLAMMER);
  643. in_args:=true;
  644. p1:=comp_expr([ef_accept_equal]);
  645. if try_to_consume(_COMMA) then
  646. p2:=ccallparanode.create(comp_expr([ef_accept_equal]),nil)
  647. else
  648. p2:=nil;
  649. p2:=ccallparanode.create(p1,p2);
  650. statement_syssym:=geninlinenode(l,false,p2);
  651. consume(_RKLAMMER);
  652. end;
  653. in_slice_x:
  654. begin
  655. if not(in_args) then
  656. begin
  657. message(parser_e_illegal_slice);
  658. consume(_LKLAMMER);
  659. in_args:=true;
  660. comp_expr([ef_accept_equal]).free;
  661. if try_to_consume(_COMMA) then
  662. comp_expr([ef_accept_equal]).free;
  663. statement_syssym:=cerrornode.create;
  664. consume(_RKLAMMER);
  665. end
  666. else
  667. begin
  668. consume(_LKLAMMER);
  669. in_args:=true;
  670. p1:=comp_expr([ef_accept_equal]);
  671. Consume(_COMMA);
  672. if not(codegenerror) then
  673. p2:=ccallparanode.create(comp_expr([ef_accept_equal]),nil)
  674. else
  675. p2:=cerrornode.create;
  676. p2:=ccallparanode.create(p1,p2);
  677. statement_syssym:=geninlinenode(l,false,p2);
  678. consume(_RKLAMMER);
  679. end;
  680. end;
  681. in_initialize_x:
  682. begin
  683. statement_syssym:=inline_initialize;
  684. end;
  685. in_finalize_x:
  686. begin
  687. statement_syssym:=inline_finalize;
  688. end;
  689. in_copy_x:
  690. begin
  691. statement_syssym:=inline_copy;
  692. end;
  693. in_concat_x :
  694. begin
  695. statement_syssym:=inline_concat;
  696. end;
  697. in_read_x,
  698. in_readln_x,
  699. in_readstr_x:
  700. begin
  701. if try_to_consume(_LKLAMMER) then
  702. begin
  703. paras:=parse_paras(false,false,_RKLAMMER);
  704. consume(_RKLAMMER);
  705. end
  706. else
  707. paras:=nil;
  708. p1:=geninlinenode(l,false,paras);
  709. statement_syssym := p1;
  710. end;
  711. in_setlength_x:
  712. begin
  713. statement_syssym := inline_setlength;
  714. end;
  715. in_objc_selector_x:
  716. begin
  717. if (m_objectivec1 in current_settings.modeswitches) then
  718. begin
  719. consume(_LKLAMMER);
  720. in_args:=true;
  721. { don't turn procsyms into calls (getaddr = true) }
  722. p1:=factor(true,[]);
  723. p2:=geninlinenode(l,false,p1);
  724. consume(_RKLAMMER);
  725. statement_syssym:=p2;
  726. end
  727. else
  728. begin
  729. Message1(sym_e_id_not_found, orgpattern);
  730. statement_syssym:=cerrornode.create;
  731. end;
  732. end;
  733. in_length_x:
  734. begin
  735. consume(_LKLAMMER);
  736. in_args:=true;
  737. p1:=comp_expr([ef_accept_equal]);
  738. p2:=geninlinenode(l,false,p1);
  739. consume(_RKLAMMER);
  740. statement_syssym:=p2;
  741. end;
  742. in_write_x,
  743. in_writeln_x,
  744. in_writestr_x :
  745. begin
  746. if try_to_consume(_LKLAMMER) then
  747. begin
  748. paras:=parse_paras(true,false,_RKLAMMER);
  749. consume(_RKLAMMER);
  750. end
  751. else
  752. paras:=nil;
  753. p1 := geninlinenode(l,false,paras);
  754. statement_syssym := p1;
  755. end;
  756. in_str_x_string :
  757. begin
  758. consume(_LKLAMMER);
  759. paras:=parse_paras(true,false,_RKLAMMER);
  760. consume(_RKLAMMER);
  761. p1 := geninlinenode(l,false,paras);
  762. statement_syssym := p1;
  763. end;
  764. in_val_x:
  765. Begin
  766. consume(_LKLAMMER);
  767. in_args := true;
  768. p1:= ccallparanode.create(comp_expr([ef_accept_equal]), nil);
  769. consume(_COMMA);
  770. p2 := ccallparanode.create(comp_expr([ef_accept_equal]),p1);
  771. if try_to_consume(_COMMA) then
  772. p2 := ccallparanode.create(comp_expr([ef_accept_equal]),p2);
  773. consume(_RKLAMMER);
  774. p2 := geninlinenode(l,false,p2);
  775. statement_syssym := p2;
  776. End;
  777. in_include_x_y,
  778. in_exclude_x_y :
  779. begin
  780. consume(_LKLAMMER);
  781. in_args:=true;
  782. p1:=comp_expr([ef_accept_equal]);
  783. consume(_COMMA);
  784. p2:=comp_expr([ef_accept_equal]);
  785. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  786. consume(_RKLAMMER);
  787. end;
  788. in_pack_x_y_z,
  789. in_unpack_x_y_z :
  790. begin
  791. consume(_LKLAMMER);
  792. in_args:=true;
  793. p1:=comp_expr([ef_accept_equal]);
  794. consume(_COMMA);
  795. p2:=comp_expr([ef_accept_equal]);
  796. consume(_COMMA);
  797. paras:=comp_expr([ef_accept_equal]);
  798. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil))));
  799. consume(_RKLAMMER);
  800. end;
  801. in_assert_x_y :
  802. begin
  803. consume(_LKLAMMER);
  804. in_args:=true;
  805. p1:=comp_expr([ef_accept_equal]);
  806. if try_to_consume(_COMMA) then
  807. p2:=comp_expr([ef_accept_equal])
  808. else
  809. begin
  810. { then insert an empty string }
  811. p2:=cstringconstnode.createstr('');
  812. end;
  813. statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
  814. consume(_RKLAMMER);
  815. end;
  816. in_get_frame:
  817. begin
  818. statement_syssym:=geninlinenode(l,false,nil);
  819. end;
  820. (*
  821. in_get_caller_frame:
  822. begin
  823. if try_to_consume(_LKLAMMER) then
  824. begin
  825. {You used to call get_caller_frame as get_caller_frame(get_frame),
  826. however, as a stack frame may not exist, it does more harm than
  827. good, so ignore it.}
  828. in_args:=true;
  829. p1:=comp_expr([ef_accept_equal]);
  830. p1.destroy;
  831. consume(_RKLAMMER);
  832. end;
  833. statement_syssym:=geninlinenode(l,false,nil);
  834. end;
  835. *)
  836. in_default_x:
  837. begin
  838. consume(_LKLAMMER);
  839. in_args:=true;
  840. def:=nil;
  841. single_type(def,[stoAllowSpecialization]);
  842. statement_syssym:=cerrornode.create;
  843. if def<>generrordef then
  844. { "type expected" error is already done by single_type }
  845. if def.typ=forwarddef then
  846. Message1(type_e_type_is_not_completly_defined,tforwarddef(def).tosymname^)
  847. else
  848. begin
  849. statement_syssym.free;
  850. statement_syssym:=geninlinenode(in_default_x,false,ctypenode.create(def));
  851. end;
  852. { consume the right bracket here for a nicer error position }
  853. consume(_RKLAMMER);
  854. end;
  855. in_setstring_x_y_z:
  856. begin
  857. statement_syssym := inline_setstring;
  858. end;
  859. in_delete_x_y_z:
  860. begin
  861. statement_syssym:=inline_delete;
  862. end;
  863. in_insert_x_y_z:
  864. begin
  865. statement_syssym:=inline_insert;
  866. end;
  867. in_const_eh_return_data_regno:
  868. begin
  869. consume(_LKLAMMER);
  870. in_args:=true;
  871. p1:=comp_expr([ef_accept_equal]);
  872. p2:=geninlinenode(l,true,p1);
  873. consume(_RKLAMMER);
  874. statement_syssym:=p2;
  875. end;
  876. else
  877. internalerror(15);
  878. end;
  879. in_args:=prev_in_args;
  880. end;
  881. function maybe_load_methodpointer(st:TSymtable;var p1:tnode):boolean;
  882. var
  883. pd: tprocdef;
  884. begin
  885. maybe_load_methodpointer:=false;
  886. if not assigned(p1) then
  887. begin
  888. case st.symtabletype of
  889. withsymtable :
  890. begin
  891. if (st.defowner.typ=objectdef) then
  892. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  893. end;
  894. ObjectSymtable,
  895. recordsymtable:
  896. begin
  897. { Escape nested procedures }
  898. if assigned(current_procinfo) then
  899. begin
  900. pd:=current_procinfo.get_normal_proc.procdef;
  901. { We are calling from the static class method which has no self node }
  902. if assigned(pd) and pd.no_self_node then
  903. if st.symtabletype=recordsymtable then
  904. p1:=ctypenode.create(pd.struct)
  905. else
  906. p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
  907. else
  908. p1:=load_self_node;
  909. end
  910. else
  911. p1:=load_self_node;
  912. { We are calling a member }
  913. maybe_load_methodpointer:=true;
  914. end;
  915. else
  916. ;
  917. end;
  918. end;
  919. end;
  920. { reads the parameter for a subroutine call }
  921. procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  922. var
  923. membercall,
  924. prevafterassn : boolean;
  925. i : integer;
  926. para,p2 : tnode;
  927. currpara : tparavarsym;
  928. aprocdef : tprocdef;
  929. begin
  930. prevafterassn:=afterassignment;
  931. afterassignment:=false;
  932. membercall:=false;
  933. aprocdef:=nil;
  934. { when it is a call to a member we need to load the
  935. methodpointer first
  936. }
  937. membercall:=maybe_load_methodpointer(st,p1);
  938. { When we are expecting a procvar we also need
  939. to get the address in some cases }
  940. if assigned(getprocvardef) then
  941. begin
  942. if (block_type=bt_const) or
  943. getaddr then
  944. begin
  945. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  946. getaddr:=true;
  947. end
  948. else
  949. if ((m_tp_procvar in current_settings.modeswitches) or
  950. (m_mac_procvar in current_settings.modeswitches)) and
  951. not(token in [_CARET,_POINT,_LKLAMMER]) then
  952. begin
  953. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  954. if assigned(aprocdef) then
  955. getaddr:=true;
  956. end;
  957. end;
  958. { only need to get the address of the procedure? Check token because
  959. in the case of opening parenthesis is possible to get pointer to
  960. function result (lack of checking for token was the reason of
  961. tw10933.pp test failure) }
  962. if getaddr and (token<>_LKLAMMER) then
  963. begin
  964. { for now we don't support pointers to generic functions, but since
  965. this is only temporary we use a non translated message }
  966. if assigned(spezcontext) then
  967. begin
  968. comment(v_error, 'Pointers to generics functions not implemented');
  969. p1:=cerrornode.create;
  970. spezcontext.free;
  971. exit;
  972. end;
  973. { Retrieve info which procvar to call. For tp_procvar the
  974. aprocdef is already loaded above so we can reuse it }
  975. if not assigned(aprocdef) and
  976. assigned(getprocvardef) then
  977. aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef);
  978. { generate a methodcallnode or proccallnode }
  979. { we shouldn't convert things like @tcollection.load }
  980. p2:=cloadnode.create_procvar(sym,aprocdef,st);
  981. if assigned(p1) then
  982. begin
  983. { for loading methodpointer of an inherited function
  984. we use self as instance and load the address of
  985. the function directly and not through the vmt (PFV) }
  986. if (cnf_inherited in callflags) then
  987. begin
  988. include(tloadnode(p2).loadnodeflags,loadnf_inherited);
  989. p1.free;
  990. p1:=load_self_node;
  991. end;
  992. if (p1.nodetype<>typen) then
  993. tloadnode(p2).set_mp(p1)
  994. else
  995. begin
  996. typecheckpass(p1);
  997. if (p1.resultdef.typ=objectdef) then
  998. { so we can create the correct method pointer again in case
  999. this is a "objectprocvar:[email protected]" expression }
  1000. tloadnode(p2).symtable:=tobjectdef(p1.resultdef).symtable
  1001. else
  1002. p1.free;
  1003. end;
  1004. end;
  1005. p1:=p2;
  1006. { no postfix operators }
  1007. again:=false;
  1008. end
  1009. else
  1010. begin
  1011. para:=nil;
  1012. if anon_inherited then
  1013. begin
  1014. if not assigned(current_procinfo) then
  1015. internalerror(200305054);
  1016. for i:=0 to current_procinfo.procdef.paras.count-1 do
  1017. begin
  1018. currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
  1019. if not(vo_is_hidden_para in currpara.varoptions) then
  1020. begin
  1021. { inheritance by msgint? }
  1022. if assigned(srdef) then
  1023. { anonymous inherited via msgid calls only require a var parameter for
  1024. both methods, so we need some type casting here }
  1025. para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal(
  1026. cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vardef),
  1027. para)
  1028. else
  1029. para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
  1030. end;
  1031. end;
  1032. end
  1033. else
  1034. begin
  1035. if try_to_consume(_LKLAMMER) then
  1036. begin
  1037. para:=parse_paras(false,false,_RKLAMMER);
  1038. consume(_RKLAMMER);
  1039. end;
  1040. end;
  1041. { indicate if this call was generated by a member and
  1042. no explicit self is used, this is needed to determine
  1043. how to handle a destructor call (PFV) }
  1044. if membercall then
  1045. include(callflags,cnf_member_call);
  1046. if assigned(obj) then
  1047. begin
  1048. if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
  1049. internalerror(200310031);
  1050. p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
  1051. end
  1052. else
  1053. p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags,spezcontext);
  1054. end;
  1055. afterassignment:=prevafterassn;
  1056. end;
  1057. procedure handle_procvar(pv : tprocvardef;var p2 : tnode);
  1058. var
  1059. hp,hp2 : tnode;
  1060. hpp : ^tnode;
  1061. currprocdef : tprocdef;
  1062. begin
  1063. if not assigned(pv) then
  1064. internalerror(200301121);
  1065. if (m_tp_procvar in current_settings.modeswitches) or
  1066. (m_mac_procvar in current_settings.modeswitches) then
  1067. begin
  1068. hp:=p2;
  1069. hpp:=@p2;
  1070. while assigned(hp) and
  1071. (hp.nodetype=typeconvn) do
  1072. begin
  1073. hp:=ttypeconvnode(hp).left;
  1074. { save orignal address of the old tree so we can replace the node }
  1075. hpp:=@hp;
  1076. end;
  1077. if (hp.nodetype=calln) and
  1078. { a procvar can't have parameters! }
  1079. not assigned(tcallnode(hp).left) then
  1080. begin
  1081. currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byprocvardef(pv);
  1082. if assigned(currprocdef) then
  1083. begin
  1084. hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
  1085. if (po_methodpointer in pv.procoptions) then
  1086. tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
  1087. hp.free;
  1088. { replace the old callnode with the new loadnode }
  1089. hpp^:=hp2;
  1090. end;
  1091. end;
  1092. end;
  1093. end;
  1094. { the following procedure handles the access to a property symbol }
  1095. procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode);
  1096. var
  1097. paras : tnode;
  1098. p2 : tnode;
  1099. membercall : boolean;
  1100. callflags : tcallnodeflags;
  1101. propaccesslist : tpropaccesslist;
  1102. sym: tsym;
  1103. begin
  1104. { property parameters? read them only if the property really }
  1105. { has parameters }
  1106. paras:=nil;
  1107. if (ppo_hasparameters in propsym.propoptions) then
  1108. begin
  1109. if try_to_consume(_LECKKLAMMER) then
  1110. begin
  1111. paras:=parse_paras(false,false,_RECKKLAMMER);
  1112. consume(_RECKKLAMMER);
  1113. end;
  1114. end;
  1115. { indexed property }
  1116. if (ppo_indexed in propsym.propoptions) then
  1117. begin
  1118. p2:=cordconstnode.create(propsym.index,propsym.indexdef,true);
  1119. paras:=ccallparanode.create(p2,paras);
  1120. end;
  1121. { we need only a write property if a := follows }
  1122. { if not(afterassignment) and not(in_args) then }
  1123. if token=_ASSIGNMENT then
  1124. begin
  1125. if propsym.getpropaccesslist(palt_write,propaccesslist) then
  1126. begin
  1127. sym:=propaccesslist.firstsym^.sym;
  1128. case sym.typ of
  1129. procsym :
  1130. begin
  1131. callflags:=[];
  1132. { generate the method call }
  1133. membercall:=maybe_load_methodpointer(st,p1);
  1134. if membercall then
  1135. include(callflags,cnf_member_call);
  1136. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags,nil);
  1137. addsymref(sym);
  1138. paras:=nil;
  1139. consume(_ASSIGNMENT);
  1140. { read the expression }
  1141. if propsym.propdef.typ=procvardef then
  1142. getprocvardef:=tprocvardef(propsym.propdef);
  1143. p2:=comp_expr([ef_accept_equal]);
  1144. if assigned(getprocvardef) then
  1145. handle_procvar(getprocvardef,p2);
  1146. tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
  1147. { mark as property, both the tcallnode and the real call block }
  1148. include(p1.flags,nf_isproperty);
  1149. getprocvardef:=nil;
  1150. end;
  1151. fieldvarsym :
  1152. begin
  1153. { generate access code }
  1154. if not handle_staticfield_access(sym,p1) then
  1155. propaccesslist_to_node(p1,st,propaccesslist);
  1156. include(p1.flags,nf_isproperty);
  1157. consume(_ASSIGNMENT);
  1158. { read the expression }
  1159. p2:=comp_expr([ef_accept_equal]);
  1160. p1:=cassignmentnode.create(p1,p2);
  1161. end
  1162. else
  1163. begin
  1164. p1:=cerrornode.create;
  1165. Message(parser_e_no_procedure_to_access_property);
  1166. end;
  1167. end;
  1168. end
  1169. else
  1170. begin
  1171. p1:=cerrornode.create;
  1172. Message(parser_e_no_procedure_to_access_property);
  1173. end;
  1174. end
  1175. else
  1176. begin
  1177. if propsym.getpropaccesslist(palt_read,propaccesslist) then
  1178. begin
  1179. sym := propaccesslist.firstsym^.sym;
  1180. case sym.typ of
  1181. fieldvarsym :
  1182. begin
  1183. { generate access code }
  1184. if not handle_staticfield_access(sym,p1) then
  1185. propaccesslist_to_node(p1,st,propaccesslist);
  1186. include(p1.flags,nf_isproperty);
  1187. { catch expressions like "(propx):=1;" }
  1188. include(p1.flags,nf_no_lvalue);
  1189. end;
  1190. procsym :
  1191. begin
  1192. callflags:=[];
  1193. { generate the method call }
  1194. membercall:=maybe_load_methodpointer(st,p1);
  1195. if membercall then
  1196. include(callflags,cnf_member_call);
  1197. p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags,nil);
  1198. paras:=nil;
  1199. include(p1.flags,nf_isproperty);
  1200. include(p1.flags,nf_no_lvalue);
  1201. end
  1202. else
  1203. begin
  1204. p1:=cerrornode.create;
  1205. Message(type_e_mismatch);
  1206. end;
  1207. end;
  1208. end
  1209. else
  1210. begin
  1211. { error, no function to read property }
  1212. p1:=cerrornode.create;
  1213. Message(parser_e_no_procedure_to_access_property);
  1214. end;
  1215. end;
  1216. { release paras if not used }
  1217. if assigned(paras) then
  1218. paras.free;
  1219. end;
  1220. { the ID token has to be consumed before calling this function }
  1221. procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
  1222. var
  1223. isclassref:boolean;
  1224. isrecordtype:boolean;
  1225. isobjecttype:boolean;
  1226. begin
  1227. if sym=nil then
  1228. begin
  1229. { pattern is still valid unless
  1230. there is another ID just after the ID of sym }
  1231. Message1(sym_e_id_no_member,orgpattern);
  1232. p1.free;
  1233. p1:=cerrornode.create;
  1234. { try to clean up }
  1235. spezcontext.free;
  1236. again:=false;
  1237. end
  1238. else
  1239. begin
  1240. if assigned(p1) then
  1241. begin
  1242. if not assigned(p1.resultdef) then
  1243. do_typecheckpass(p1);
  1244. isclassref:=(p1.resultdef.typ=classrefdef);
  1245. isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
  1246. isobjecttype:=(p1.nodetype=typen) and is_object(p1.resultdef);
  1247. end
  1248. else
  1249. begin
  1250. isclassref:=false;
  1251. isrecordtype:=false;
  1252. isobjecttype:=false;
  1253. end;
  1254. if assigned(spezcontext) and not (sym.typ=procsym) then
  1255. internalerror(2015091801);
  1256. { we assume, that only procsyms and varsyms are in an object }
  1257. { symbol table, for classes, properties are allowed }
  1258. case sym.typ of
  1259. procsym:
  1260. begin
  1261. do_proc_call(sym,sym.owner,structh,
  1262. (getaddr and not(token in [_CARET,_POINT])),
  1263. again,p1,callflags,spezcontext);
  1264. { we need to know which procedure is called }
  1265. do_typecheckpass(p1);
  1266. { calling using classref? }
  1267. if (
  1268. isclassref or
  1269. (
  1270. (isobjecttype or
  1271. isrecordtype) and
  1272. not (cnf_inherited in callflags)
  1273. )
  1274. ) and
  1275. (p1.nodetype=calln) and
  1276. assigned(tcallnode(p1).procdefinition) then
  1277. begin
  1278. if not isobjecttype then
  1279. begin
  1280. if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
  1281. not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
  1282. Message(parser_e_only_class_members_via_class_ref);
  1283. end
  1284. else
  1285. begin
  1286. { with objects, you can also do this:
  1287. type
  1288. tparent = object
  1289. procedure test;
  1290. end;
  1291. tchild = object(tchild)
  1292. procedure test;
  1293. end;
  1294. procedure tparent.test;
  1295. begin
  1296. end;
  1297. procedure tchild.test;
  1298. begin
  1299. tparent.test;
  1300. end;
  1301. }
  1302. if (tcallnode(p1).procdefinition.proctypeoption<>potype_constructor) and
  1303. not(po_staticmethod in tcallnode(p1).procdefinition.procoptions) and
  1304. (not assigned(current_structdef) or
  1305. not def_is_related(current_structdef,structh)) then
  1306. begin
  1307. p1.free;
  1308. p1:=cerrornode.create;
  1309. Message(parser_e_only_static_members_via_object_type);
  1310. exit;
  1311. end;
  1312. end;
  1313. { in Java, constructors are not automatically inherited
  1314. -> calling a constructor from a parent type will create
  1315. an instance of that parent type! }
  1316. if is_javaclass(structh) and
  1317. (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1318. (tcallnode(p1).procdefinition.owner.defowner<>find_real_class_definition(tobjectdef(structh),false)) then
  1319. Message(parser_e_java_no_inherited_constructor);
  1320. { Provide a warning if we try to create an instance of a
  1321. abstract class using the type name of that class. We
  1322. must not provide a warning if we use a "class of"
  1323. variable of that type though as we don't know the
  1324. type of the class }
  1325. if (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) and
  1326. (oo_is_abstract in structh.objectoptions) and
  1327. assigned(tcallnode(p1).methodpointer) and
  1328. (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
  1329. Message1(type_w_instance_abstract_class,structh.RttiName);
  1330. end
  1331. end;
  1332. fieldvarsym:
  1333. begin
  1334. if not handle_staticfield_access(sym,p1) then
  1335. begin
  1336. if isclassref then
  1337. if assigned(p1) and
  1338. (
  1339. is_self_node(p1) or
  1340. (assigned(current_procinfo) and (current_procinfo.get_normal_proc.procdef.no_self_node) and
  1341. (current_procinfo.procdef.struct=structh))) then
  1342. Message(parser_e_only_class_members)
  1343. else
  1344. Message(parser_e_only_class_members_via_class_ref);
  1345. p1:=csubscriptnode.create(sym,p1);
  1346. end;
  1347. end;
  1348. propertysym:
  1349. begin
  1350. if isclassref and not (sp_static in sym.symoptions) then
  1351. Message(parser_e_only_class_members_via_class_ref);
  1352. handle_propertysym(tpropertysym(sym),sym.owner,p1);
  1353. end;
  1354. typesym:
  1355. begin
  1356. p1.free;
  1357. if try_to_consume(_LKLAMMER) then
  1358. begin
  1359. p1:=comp_expr([ef_accept_equal]);
  1360. consume(_RKLAMMER);
  1361. p1:=ctypeconvnode.create_explicit(p1,ttypesym(sym).typedef);
  1362. end
  1363. else
  1364. begin
  1365. p1:=ctypenode.create(ttypesym(sym).typedef);
  1366. if (is_class(ttypesym(sym).typedef) or
  1367. is_objcclass(ttypesym(sym).typedef) or
  1368. is_javaclass(ttypesym(sym).typedef)) and
  1369. not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1370. p1:=cloadvmtaddrnode.create(p1);
  1371. end;
  1372. end;
  1373. constsym:
  1374. begin
  1375. p1.free;
  1376. p1:=genconstsymtree(tconstsym(sym));
  1377. end;
  1378. staticvarsym:
  1379. begin
  1380. { typed constant is a staticvarsym
  1381. now they are absolutevarsym }
  1382. p1.free;
  1383. p1:=cloadnode.create(sym,sym.Owner);
  1384. end;
  1385. absolutevarsym:
  1386. begin
  1387. p1.free;
  1388. p1:=nil;
  1389. { typed constants are absolutebarsyms now to handle storage properly }
  1390. propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref);
  1391. end
  1392. else
  1393. internalerror(16);
  1394. end;
  1395. end;
  1396. end;
  1397. function handle_specialize_inline_specialization(var srsym:tsym;out srsymtable:tsymtable;out spezcontext:tspecializationcontext):boolean;
  1398. var
  1399. spezdef : tdef;
  1400. symname : tsymstr;
  1401. begin
  1402. result:=false;
  1403. spezcontext:=nil;
  1404. srsymtable:=nil;
  1405. if not assigned(srsym) then
  1406. message1(sym_e_id_no_member,orgpattern)
  1407. else
  1408. if not (srsym.typ in [typesym,procsym]) then
  1409. message(type_e_type_id_expected)
  1410. else
  1411. begin
  1412. if srsym.typ=typesym then
  1413. spezdef:=ttypesym(srsym).typedef
  1414. else
  1415. spezdef:=tdef(tprocsym(srsym).procdeflist[0]);
  1416. if (spezdef.typ=errordef) and (sp_generic_dummy in srsym.symoptions) then
  1417. symname:=srsym.RealName
  1418. else
  1419. symname:='';
  1420. spezdef:=generate_specialization_phase1(spezcontext,spezdef,symname);
  1421. case spezdef.typ of
  1422. errordef:
  1423. begin
  1424. spezcontext.free;
  1425. spezcontext:=nil;
  1426. srsym:=generrorsym;
  1427. end;
  1428. procdef:
  1429. begin
  1430. if block_type<>bt_body then
  1431. begin
  1432. message(parser_e_illegal_expression);
  1433. spezcontext.free;
  1434. spezcontext:=nil;
  1435. srsym:=generrorsym;
  1436. end
  1437. else
  1438. begin
  1439. srsym:=tprocdef(spezdef).procsym;
  1440. srsymtable:=srsym.owner;
  1441. result:=true;
  1442. end;
  1443. end;
  1444. objectdef,
  1445. recorddef,
  1446. arraydef,
  1447. procvardef:
  1448. begin
  1449. spezdef:=generate_specialization_phase2(spezcontext,tstoreddef(spezdef),false,'');
  1450. spezcontext.free;
  1451. spezcontext:=nil;
  1452. if spezdef<>generrordef then
  1453. begin
  1454. srsym:=spezdef.typesym;
  1455. srsymtable:=srsym.owner;
  1456. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1457. result:=true;
  1458. end;
  1459. end;
  1460. else
  1461. internalerror(2015070302);
  1462. end;
  1463. end;
  1464. end;
  1465. function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode;
  1466. var
  1467. srsym : tsym;
  1468. srsymtable : tsymtable;
  1469. erroroutresult,
  1470. isspecialize : boolean;
  1471. spezcontext : tspecializationcontext;
  1472. savedfilepos : tfileposinfo;
  1473. begin
  1474. spezcontext:=nil;
  1475. if sym=nil then
  1476. sym:=hdef.typesym;
  1477. { allow Ordinal(Value) for type declarations since it
  1478. can be an enummeration declaration or a set lke:
  1479. (OrdinalType(const1)..OrdinalType(const2) }
  1480. if (not typeonly or is_ordinal(hdef)) and
  1481. try_to_consume(_LKLAMMER) then
  1482. begin
  1483. result:=comp_expr([ef_accept_equal]);
  1484. consume(_RKLAMMER);
  1485. { type casts to class helpers aren't allowed }
  1486. if is_objectpascal_helper(hdef) then
  1487. Message(parser_e_no_category_as_types)
  1488. { recovery by not creating a conversion node }
  1489. else
  1490. result:=ctypeconvnode.create_explicit(result,hdef);
  1491. end
  1492. { not LKLAMMER }
  1493. else if (token=_POINT) and
  1494. (is_object(hdef) or is_record(hdef)) then
  1495. begin
  1496. consume(_POINT);
  1497. { handles calling methods declared in parent objects
  1498. using "parentobject.methodname()" }
  1499. if assigned(current_structdef) and
  1500. not(getaddr) and
  1501. def_is_related(current_structdef,hdef) then
  1502. begin
  1503. result:=ctypenode.create(hdef);
  1504. ttypenode(result).typesym:=sym;
  1505. if not (m_delphi in current_settings.modeswitches) and
  1506. (block_type in inline_specialization_block_types) and
  1507. (token=_ID) and
  1508. (idtoken=_SPECIALIZE) then
  1509. begin
  1510. consume(_ID);
  1511. if token<>_ID then
  1512. message(type_e_type_id_expected);
  1513. isspecialize:=true;
  1514. end
  1515. else
  1516. isspecialize:=false;
  1517. { search also in inherited methods }
  1518. searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,[ssf_search_helper]);
  1519. if isspecialize then
  1520. begin
  1521. consume(_ID);
  1522. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  1523. begin
  1524. result.free;
  1525. result:=cerrornode.create;
  1526. end;
  1527. end
  1528. else
  1529. begin
  1530. if assigned(srsym) then
  1531. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1532. consume(_ID);
  1533. end;
  1534. if result.nodetype<>errorn then
  1535. do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[],spezcontext)
  1536. else
  1537. spezcontext.free;
  1538. end
  1539. else
  1540. begin
  1541. { handles:
  1542. * @TObject.Load
  1543. * static methods and variables }
  1544. result:=ctypenode.create(hdef);
  1545. ttypenode(result).typesym:=sym;
  1546. if not (m_delphi in current_settings.modeswitches) and
  1547. (block_type in inline_specialization_block_types) and
  1548. (token=_ID) and
  1549. (idtoken=_SPECIALIZE) then
  1550. begin
  1551. consume(_ID);
  1552. if token<>_ID then
  1553. message(type_e_type_id_expected);
  1554. isspecialize:=true;
  1555. end
  1556. else
  1557. isspecialize:=false;
  1558. erroroutresult:=true;
  1559. { TP allows also @TMenu.Load if Load is only }
  1560. { defined in an anchestor class }
  1561. srsym:=search_struct_member(tabstractrecorddef(hdef),pattern);
  1562. if isspecialize and assigned(srsym) then
  1563. begin
  1564. consume(_ID);
  1565. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  1566. erroroutresult:=false;
  1567. end
  1568. else
  1569. begin
  1570. if assigned(srsym) then
  1571. begin
  1572. savedfilepos:=current_filepos;
  1573. consume(_ID);
  1574. if not (sp_generic_dummy in srsym.symoptions) or
  1575. not (token in [_LT,_LSHARPBRACKET]) then
  1576. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,savedfilepos)
  1577. else
  1578. result:=cspecializenode.create(result,getaddr,srsym);
  1579. erroroutresult:=false;
  1580. end
  1581. else
  1582. Message1(sym_e_id_no_member,orgpattern);
  1583. end;
  1584. if erroroutresult then
  1585. begin
  1586. result.free;
  1587. result:=cerrornode.create;
  1588. end
  1589. else
  1590. if result.nodetype<>specializen then
  1591. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],spezcontext);
  1592. end;
  1593. end
  1594. else
  1595. begin
  1596. { Normally here would be the check against the usage
  1597. of "TClassHelper.Something", but as that might be
  1598. used inside of system symbols like sizeof and
  1599. typeinfo this check is put into ttypenode.pass_1
  1600. (for "TClassHelper" alone) and tcallnode.pass_1
  1601. (for "TClassHelper.Something") }
  1602. { class reference ? }
  1603. if is_class(hdef) or
  1604. is_objcclass(hdef) or
  1605. { Java interfaces also can have loadvmtaddrnodes,
  1606. e.g. for expressions such as JLClass(intftype) }
  1607. is_java_class_or_interface(hdef) then
  1608. begin
  1609. if getaddr and (token=_POINT) and
  1610. not is_javainterface(hdef) then
  1611. begin
  1612. consume(_POINT);
  1613. { allows @Object.Method }
  1614. { also allows static methods and variables }
  1615. result:=ctypenode.create(hdef);
  1616. ttypenode(result).typesym:=sym;
  1617. { TP allows also @TMenu.Load if Load is only }
  1618. { defined in an anchestor class }
  1619. srsym:=search_struct_member(tobjectdef(hdef),pattern);
  1620. if assigned(srsym) then
  1621. begin
  1622. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1623. consume(_ID);
  1624. { in case of @Object.Method1.Method2, we have to call
  1625. Method1 -> create a loadvmtaddr node as self instead of
  1626. a typen (the typenode would be changed to self of the
  1627. current method in case Method1 is a constructor, see
  1628. mantis #24844) }
  1629. if not(block_type in [bt_type,bt_const_type,bt_var_type]) and
  1630. (srsym.typ=procsym) and
  1631. (token in [_CARET,_POINT]) then
  1632. result:=cloadvmtaddrnode.create(result);
  1633. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[],nil);
  1634. end
  1635. else
  1636. begin
  1637. Message1(sym_e_id_no_member,orgpattern);
  1638. consume(_ID);
  1639. end;
  1640. end
  1641. else
  1642. begin
  1643. result:=ctypenode.create(hdef);
  1644. ttypenode(result).typesym:=sym;
  1645. { For a type block we simply return only
  1646. the type. For all other blocks we return
  1647. a loadvmt node }
  1648. if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
  1649. result:=cloadvmtaddrnode.create(result);
  1650. end;
  1651. end
  1652. else
  1653. begin
  1654. result:=ctypenode.create(hdef);
  1655. ttypenode(result).typesym:=sym;
  1656. end;
  1657. end;
  1658. end;
  1659. {****************************************************************************
  1660. Factor
  1661. ****************************************************************************}
  1662. function real_const_node_from_pattern(s:string):tnode;
  1663. var
  1664. d : bestreal;
  1665. code : integer;
  1666. cur : currency;
  1667. begin
  1668. val(s,d,code);
  1669. if code<>0 then
  1670. begin
  1671. Message(parser_e_error_in_real);
  1672. d:=1.0;
  1673. end;
  1674. if current_settings.fputype=fpu_none then
  1675. begin
  1676. Message(parser_e_unsupported_real);
  1677. result:=cerrornode.create;
  1678. exit;
  1679. end;
  1680. if (current_settings.minfpconstprec=s32real) and
  1681. (d = single(d)) then
  1682. result:=crealconstnode.create(d,s32floattype)
  1683. else if (current_settings.minfpconstprec=s64real) and
  1684. (d = double(d)) then
  1685. result:=crealconstnode.create(d,s64floattype)
  1686. else
  1687. result:=crealconstnode.create(d,pbestrealtype^);
  1688. val(pattern,cur,code);
  1689. if code=0 then
  1690. trealconstnode(result).value_currency:=cur;
  1691. end;
  1692. {---------------------------------------------
  1693. PostFixOperators
  1694. ---------------------------------------------}
  1695. { returns whether or not p1 has been changed }
  1696. function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean): boolean;
  1697. { tries to avoid syntax errors after invalid qualifiers }
  1698. procedure recoverconsume_postfixops;
  1699. begin
  1700. repeat
  1701. if not try_to_consume(_CARET) then
  1702. if try_to_consume(_POINT) then
  1703. try_to_consume(_ID)
  1704. else if try_to_consume(_LECKKLAMMER) then
  1705. begin
  1706. repeat
  1707. comp_expr([ef_accept_equal]);
  1708. until not try_to_consume(_COMMA);
  1709. consume(_RECKKLAMMER);
  1710. end
  1711. else if try_to_consume(_LKLAMMER) then
  1712. begin
  1713. repeat
  1714. comp_expr([ef_accept_equal]);
  1715. until not try_to_consume(_COMMA);
  1716. consume(_RKLAMMER);
  1717. end
  1718. else
  1719. break;
  1720. until false;
  1721. end;
  1722. procedure handle_variantarray;
  1723. var
  1724. p4 : tnode;
  1725. newstatement : tstatementnode;
  1726. tempresultvariant,
  1727. temp : ttempcreatenode;
  1728. paras : tcallparanode;
  1729. newblock : tnode;
  1730. countindices : longint;
  1731. elements: tfplist;
  1732. arraydef: tdef;
  1733. begin
  1734. { create statements with call initialize the arguments and
  1735. call fpc_dynarr_setlength }
  1736. newblock:=internalstatements(newstatement);
  1737. { store all indices in a temporary array }
  1738. countindices:=0;
  1739. elements:=tfplist.Create;
  1740. repeat
  1741. p4:=comp_expr([ef_accept_equal]);
  1742. elements.add(p4);
  1743. until not try_to_consume(_COMMA);
  1744. arraydef:=carraydef.getreusable(s32inttype,elements.count);
  1745. temp:=ctempcreatenode.create(arraydef,arraydef.size,tt_persistent,false);
  1746. addstatement(newstatement,temp);
  1747. for countindices:=0 to elements.count-1 do
  1748. begin
  1749. addstatement(newstatement,
  1750. cassignmentnode.create(
  1751. cvecnode.create(
  1752. ctemprefnode.create(temp),
  1753. genintconstnode(countindices)
  1754. ),
  1755. tnode(elements[countindices])
  1756. )
  1757. );
  1758. end;
  1759. countindices:=elements.count;
  1760. elements.free;
  1761. consume(_RECKKLAMMER);
  1762. { we need only a write access if a := follows }
  1763. if token=_ASSIGNMENT then
  1764. begin
  1765. consume(_ASSIGNMENT);
  1766. p4:=comp_expr([ef_accept_equal]);
  1767. { create call to fpc_vararray_put }
  1768. paras:=ccallparanode.create(cordconstnode.create
  1769. (countindices,s32inttype,true),
  1770. ccallparanode.create(caddrnode.create_internal
  1771. (cvecnode.create(ctemprefnode.create(temp),genintconstnode(0))),
  1772. ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
  1773. ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
  1774. ,nil))));
  1775. addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras));
  1776. addstatement(newstatement,ctempdeletenode.create(temp));
  1777. end
  1778. else
  1779. begin
  1780. { create temp for result }
  1781. tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true);
  1782. addstatement(newstatement,tempresultvariant);
  1783. { create call to fpc_vararray_get }
  1784. paras:=ccallparanode.create(cordconstnode.create
  1785. (countindices,s32inttype,true),
  1786. ccallparanode.create(caddrnode.create_internal
  1787. (ctemprefnode.create(temp)),
  1788. ccallparanode.create(p1,
  1789. ccallparanode.create(
  1790. ctemprefnode.create(tempresultvariant)
  1791. ,nil))));
  1792. addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras));
  1793. addstatement(newstatement,ctempdeletenode.create(temp));
  1794. { the last statement should return the value as
  1795. location and type, this is done be referencing the
  1796. temp and converting it first from a persistent temp to
  1797. normal temp }
  1798. addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant));
  1799. addstatement(newstatement,ctemprefnode.create(tempresultvariant));
  1800. end;
  1801. p1:=newblock;
  1802. end;
  1803. function parse_array_constructor(arrdef:tarraydef): tnode;
  1804. var
  1805. newstatement,assstatement:tstatementnode;
  1806. arrnode:ttempcreatenode;
  1807. temp2:ttempcreatenode;
  1808. assnode:tnode;
  1809. paracount:integer;
  1810. begin
  1811. result:=internalstatements(newstatement);
  1812. { create temp for result }
  1813. arrnode:=ctempcreatenode.create(arrdef,arrdef.size,tt_persistent,true);
  1814. addstatement(newstatement,arrnode);
  1815. paracount:=0;
  1816. { check arguments and create an assignment calls }
  1817. if try_to_consume(_LKLAMMER) then
  1818. begin
  1819. assnode:=internalstatements(assstatement);
  1820. repeat
  1821. { arr[i] := param_i }
  1822. addstatement(assstatement,
  1823. cassignmentnode.create(
  1824. cvecnode.create(
  1825. ctemprefnode.create(arrnode),
  1826. cordconstnode.create(paracount,arrdef.rangedef,false)),
  1827. comp_expr([ef_accept_equal])));
  1828. inc(paracount);
  1829. until not try_to_consume(_COMMA);
  1830. consume(_RKLAMMER);
  1831. end
  1832. else
  1833. assnode:=nil;
  1834. { get temp for array of lengths }
  1835. temp2:=ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false);
  1836. addstatement(newstatement,temp2);
  1837. { one dimensional }
  1838. addstatement(newstatement,cassignmentnode.create(
  1839. ctemprefnode.create(temp2),
  1840. cordconstnode.create
  1841. (paracount,s32inttype,true)));
  1842. { create call to fpc_dynarr_setlength }
  1843. addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',
  1844. ccallparanode.create(caddrnode.create_internal
  1845. (ctemprefnode.create(temp2)),
  1846. ccallparanode.create(cordconstnode.create
  1847. (1,s32inttype,true),
  1848. ccallparanode.create(caddrnode.create_internal
  1849. (crttinode.create(tstoreddef(arrdef),initrtti,rdt_normal)),
  1850. ccallparanode.create(
  1851. ctypeconvnode.create_internal(
  1852. ctemprefnode.create(arrnode),voidpointertype),
  1853. nil))))
  1854. ));
  1855. { add assignment statememnts }
  1856. addstatement(newstatement,ctempdeletenode.create(temp2));
  1857. if assigned(assnode) then
  1858. addstatement(newstatement,assnode);
  1859. { the last statement should return the value as
  1860. location and type, this is done be referencing the
  1861. temp and converting it first from a persistent temp to
  1862. normal temp }
  1863. addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode));
  1864. addstatement(newstatement,ctemprefnode.create(arrnode));
  1865. end;
  1866. function try_type_helper(var node:tnode;def:tdef):boolean;
  1867. var
  1868. srsym : tsym;
  1869. srsymtable : tsymtable;
  1870. n : tnode;
  1871. newstatement : tstatementnode;
  1872. temp : ttempcreatenode;
  1873. extdef : tdef;
  1874. begin
  1875. result:=false;
  1876. if (token=_ID) and (block_type in [bt_body,bt_general,bt_except,bt_const]) then
  1877. begin
  1878. if not assigned(def) then
  1879. if node.nodetype=addrn then
  1880. { always use the pointer type for addr nodes as otherwise
  1881. we'll have an anonymous pointertype with no name }
  1882. def:=voidpointertype
  1883. else
  1884. def:=node.resultdef;
  1885. result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
  1886. if result then
  1887. begin
  1888. if not (srsymtable.symtabletype=objectsymtable) or
  1889. not is_objectpascal_helper(tdef(srsymtable.defowner)) then
  1890. internalerror(2013011401);
  1891. { convert const node to temp node of the extended type }
  1892. if node.nodetype in (nodetype_const+[addrn]) then
  1893. begin
  1894. extdef:=tobjectdef(srsymtable.defowner).extendeddef;
  1895. newstatement:=nil;
  1896. n:=internalstatements(newstatement);
  1897. temp:=ctempcreatenode.create(extdef,extdef.size,tt_persistent,false);
  1898. addstatement(newstatement,temp);
  1899. addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),node));
  1900. addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
  1901. addstatement(newstatement,ctemprefnode.create(temp));
  1902. node:=n;
  1903. do_typecheckpass(node)
  1904. end;
  1905. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  1906. consume(_ID);
  1907. do_member_read(nil,getaddr,srsym,node,again,[],nil);
  1908. end;
  1909. end;
  1910. end;
  1911. var
  1912. protsym : tpropertysym;
  1913. p2,p3 : tnode;
  1914. srsym : tsym;
  1915. srsymtable : TSymtable;
  1916. structh : tabstractrecorddef;
  1917. { shouldn't be used that often, so the extra overhead is ok to save
  1918. stack space }
  1919. dispatchstring : ansistring;
  1920. autoderef,
  1921. erroroutp1,
  1922. allowspecialize,
  1923. isspecialize,
  1924. found,
  1925. haderror,
  1926. nodechanged : boolean;
  1927. calltype: tdispcalltype;
  1928. valstr,expstr : string;
  1929. intval : qword;
  1930. code : integer;
  1931. strdef : tdef;
  1932. spezcontext : tspecializationcontext;
  1933. old_current_filepos : tfileposinfo;
  1934. label
  1935. skipreckklammercheck,
  1936. skippointdefcheck;
  1937. begin
  1938. result:=false;
  1939. again:=true;
  1940. while again do
  1941. begin
  1942. spezcontext:=nil;
  1943. { we need the resultdef }
  1944. do_typecheckpass_changed(p1,nodechanged);
  1945. result:=result or nodechanged;
  1946. if codegenerror then
  1947. begin
  1948. recoverconsume_postfixops;
  1949. exit;
  1950. end;
  1951. { handle token }
  1952. case token of
  1953. _CARET:
  1954. begin
  1955. consume(_CARET);
  1956. { support tp/mac procvar^ if the procvar returns a
  1957. pointer type }
  1958. if ((m_tp_procvar in current_settings.modeswitches) or
  1959. (m_mac_procvar in current_settings.modeswitches)) and
  1960. (p1.resultdef.typ=procvardef) and
  1961. (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then
  1962. begin
  1963. p1:=ccallnode.create_procvar(nil,p1);
  1964. typecheckpass(p1);
  1965. end;
  1966. { iso file buf access? }
  1967. if (m_isolike_io in current_settings.modeswitches) and
  1968. (p1.resultdef.typ=filedef) then
  1969. begin
  1970. case tfiledef(p1.resultdef).filetyp of
  1971. ft_text:
  1972. begin
  1973. p1:=cderefnode.create(ccallnode.createintern('fpc_getbuf_text',ccallparanode.create(p1,nil)));
  1974. typecheckpass(p1);
  1975. end;
  1976. ft_typed:
  1977. begin
  1978. p1:=cderefnode.create(ctypeconvnode.create_internal(ccallnode.createintern('fpc_getbuf_typedfile',ccallparanode.create(p1,nil)),
  1979. cpointerdef.getreusable(tfiledef(p1.resultdef).typedfiledef)));
  1980. typecheckpass(p1);
  1981. end;
  1982. else
  1983. internalerror(2019050530);
  1984. end;
  1985. end
  1986. else if not(p1.resultdef.typ in [pointerdef,undefineddef]) then
  1987. begin
  1988. { ^ as binary operator is a problem!!!! (FK) }
  1989. again:=false;
  1990. Message(parser_e_invalid_qualifier);
  1991. recoverconsume_postfixops;
  1992. p1.destroy;
  1993. p1:=cerrornode.create;
  1994. end
  1995. else
  1996. p1:=cderefnode.create(p1);
  1997. end;
  1998. _LECKKLAMMER:
  1999. begin
  2000. if is_class_or_interface_or_object(p1.resultdef) or
  2001. is_dispinterface(p1.resultdef) or
  2002. is_record(p1.resultdef) or
  2003. is_javaclass(p1.resultdef) then
  2004. begin
  2005. { default property }
  2006. protsym:=search_default_property(tabstractrecorddef(p1.resultdef));
  2007. if not(assigned(protsym)) then
  2008. begin
  2009. p1.destroy;
  2010. p1:=cerrornode.create;
  2011. again:=false;
  2012. message(parser_e_no_default_property_available);
  2013. end
  2014. else
  2015. begin
  2016. { The property symbol is referenced indirect }
  2017. protsym.IncRefCount;
  2018. handle_propertysym(protsym,protsym.owner,p1);
  2019. end;
  2020. end
  2021. else
  2022. begin
  2023. consume(_LECKKLAMMER);
  2024. repeat
  2025. { in all of the cases below, p1 is changed }
  2026. case p1.resultdef.typ of
  2027. pointerdef:
  2028. begin
  2029. { support delphi autoderef }
  2030. if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and
  2031. (m_autoderef in current_settings.modeswitches) then
  2032. p1:=cderefnode.create(p1);
  2033. p2:=comp_expr([ef_accept_equal]);
  2034. { Support Pbytevar[0..9] which returns array [0..9].}
  2035. if try_to_consume(_POINTPOINT) then
  2036. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2037. p1:=cvecnode.create(p1,p2);
  2038. end;
  2039. variantdef:
  2040. begin
  2041. handle_variantarray;
  2042. { the RECKKLAMMER is already read }
  2043. goto skipreckklammercheck;
  2044. end;
  2045. stringdef :
  2046. begin
  2047. p2:=comp_expr([ef_accept_equal]);
  2048. { Support string[0..9] which returns array [0..9] of char.}
  2049. if try_to_consume(_POINTPOINT) then
  2050. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2051. p1:=cvecnode.create(p1,p2);
  2052. end;
  2053. arraydef:
  2054. begin
  2055. p2:=comp_expr([ef_accept_equal]);
  2056. { support SEG:OFS for go32v2/msdos Mem[] }
  2057. if (target_info.system in [system_i386_go32v2,system_i386_watcom,system_i8086_msdos,system_i8086_win16,system_i8086_embedded]) and
  2058. (p1.nodetype=loadn) and
  2059. assigned(tloadnode(p1).symtableentry) and
  2060. assigned(tloadnode(p1).symtableentry.owner.name) and
  2061. (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
  2062. ((tloadnode(p1).symtableentry.name='MEM') or
  2063. (tloadnode(p1).symtableentry.name='MEMW') or
  2064. (tloadnode(p1).symtableentry.name='MEML')) then
  2065. begin
  2066. {$if defined(i8086)}
  2067. consume(_COLON);
  2068. inserttypeconv(p2,u16inttype);
  2069. inserttypeconv_internal(p2,u32inttype);
  2070. p3:=cshlshrnode.create(shln,p2,cordconstnode.create($10,s16inttype,false));
  2071. p2:=comp_expr([ef_accept_equal]);
  2072. inserttypeconv(p2,u16inttype);
  2073. inserttypeconv_internal(p2,u32inttype);
  2074. p2:=caddnode.create(addn,p2,p3);
  2075. case tloadnode(p1).symtableentry.name of
  2076. 'MEM': p2:=ctypeconvnode.create_internal(p2,bytefarpointertype);
  2077. 'MEMW': p2:=ctypeconvnode.create_internal(p2,wordfarpointertype);
  2078. 'MEML': p2:=ctypeconvnode.create_internal(p2,longintfarpointertype);
  2079. else
  2080. internalerror(2013053102);
  2081. end;
  2082. p1:=cderefnode.create(p2);
  2083. {$elseif defined(i386)}
  2084. if try_to_consume(_COLON) then
  2085. begin
  2086. p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2);
  2087. p2:=comp_expr([ef_accept_equal]);
  2088. p2:=caddnode.create(addn,p2,p3);
  2089. if try_to_consume(_POINTPOINT) then
  2090. { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
  2091. p2:=crangenode.create(p2,caddnode.create(addn,comp_expr([ef_accept_equal]),p3.getcopy));
  2092. p1:=cvecnode.create(p1,p2);
  2093. include(tvecnode(p1).flags,nf_memseg);
  2094. include(tvecnode(p1).flags,nf_memindex);
  2095. end
  2096. else
  2097. begin
  2098. if try_to_consume(_POINTPOINT) then
  2099. { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
  2100. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2101. p1:=cvecnode.create(p1,p2);
  2102. include(tvecnode(p1).flags,nf_memindex);
  2103. end;
  2104. {$else}
  2105. internalerror(2013053101);
  2106. {$endif}
  2107. end
  2108. else
  2109. begin
  2110. if try_to_consume(_POINTPOINT) then
  2111. { Support arrayvar[0..9] which returns array [0..9] of arraytype.}
  2112. p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
  2113. p1:=cvecnode.create(p1,p2);
  2114. end;
  2115. end;
  2116. else
  2117. begin
  2118. if p1.resultdef.typ<>undefineddef then
  2119. Message(parser_e_invalid_qualifier);
  2120. p1.destroy;
  2121. p1:=cerrornode.create;
  2122. comp_expr([ef_accept_equal]);
  2123. again:=false;
  2124. end;
  2125. end;
  2126. do_typecheckpass(p1);
  2127. until not try_to_consume(_COMMA);
  2128. consume(_RECKKLAMMER);
  2129. { handle_variantarray eats the RECKKLAMMER and jumps here }
  2130. skipreckklammercheck:
  2131. end;
  2132. end;
  2133. _POINT :
  2134. begin
  2135. consume(_POINT);
  2136. allowspecialize:=not (m_delphi in current_settings.modeswitches) and (block_type in inline_specialization_block_types);
  2137. if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
  2138. begin
  2139. //consume(_ID);
  2140. isspecialize:=true;
  2141. end
  2142. else
  2143. isspecialize:=false;
  2144. autoderef:=false;
  2145. if (p1.resultdef.typ=pointerdef) and
  2146. (m_autoderef in current_settings.modeswitches) and
  2147. { don't auto-deref objc.id, because then the code
  2148. below for supporting id.anyobjcmethod isn't triggered }
  2149. (p1.resultdef<>objc_idtype) then
  2150. begin
  2151. p1:=cderefnode.create(p1);
  2152. do_typecheckpass(p1);
  2153. autoderef:=true;
  2154. end;
  2155. { procvar.<something> can never mean anything so always
  2156. try to call it in case it returns a record/object/... }
  2157. maybe_call_procvar(p1,false);
  2158. if (p1.nodetype=ordconstn) and
  2159. not is_boolean(p1.resultdef) and
  2160. not is_enum(p1.resultdef) then
  2161. begin
  2162. { type helpers are checked first }
  2163. if (token=_ID) and try_type_helper(p1,nil) then
  2164. goto skippointdefcheck;
  2165. { only an "e" or "E" can follow an intconst with a ".", the
  2166. other case (another intconst) is handled by the scanner }
  2167. if (token=_ID) and (pattern[1]='E') then
  2168. begin
  2169. haderror:=false;
  2170. if length(pattern)>1 then
  2171. begin
  2172. expstr:=copy(pattern,2,length(pattern)-1);
  2173. val(expstr,intval,code);
  2174. if code<>0 then
  2175. begin
  2176. haderror:=true;
  2177. intval:=intval; // Hackfix the "var assigned but never used" note.
  2178. end;
  2179. end
  2180. else
  2181. expstr:='';
  2182. consume(token);
  2183. if tordconstnode(p1).value.signed then
  2184. str(tordconstnode(p1).value.svalue,valstr)
  2185. else
  2186. str(tordconstnode(p1).value.uvalue,valstr);
  2187. valstr:=valstr+'.0E';
  2188. if expstr='' then
  2189. case token of
  2190. _MINUS:
  2191. begin
  2192. consume(token);
  2193. if token=_INTCONST then
  2194. begin
  2195. valstr:=valstr+'-'+pattern;
  2196. consume(token);
  2197. end
  2198. else
  2199. haderror:=true;
  2200. end;
  2201. _PLUS:
  2202. begin
  2203. consume(token);
  2204. if token=_INTCONST then
  2205. begin
  2206. valstr:=valstr+pattern;
  2207. consume(token);
  2208. end
  2209. else
  2210. haderror:=true;
  2211. end;
  2212. _INTCONST:
  2213. begin
  2214. valstr:=valstr+pattern;
  2215. consume(_INTCONST);
  2216. end;
  2217. else
  2218. haderror:=true;
  2219. end
  2220. else
  2221. valstr:=valstr+expstr;
  2222. if haderror then
  2223. begin
  2224. Message(parser_e_error_in_real);
  2225. p2:=cerrornode.create;
  2226. end
  2227. else
  2228. p2:=real_const_node_from_pattern(valstr);
  2229. p1.free;
  2230. p1:=p2;
  2231. again:=false;
  2232. goto skippointdefcheck;
  2233. end
  2234. else
  2235. begin
  2236. { just convert the ordconst to a realconst }
  2237. p2:=crealconstnode.create(tordconstnode(p1).value,pbestrealtype^);
  2238. p1.free;
  2239. p1:=p2;
  2240. again:=false;
  2241. goto skippointdefcheck;
  2242. end;
  2243. end;
  2244. if (p1.nodetype=stringconstn) and (token=_ID) then
  2245. begin
  2246. { the def of a string const is an array }
  2247. case tstringconstnode(p1).cst_type of
  2248. cst_conststring:
  2249. if cs_refcountedstrings in current_settings.localswitches then
  2250. if m_default_unicodestring in current_settings.modeswitches then
  2251. strdef:=cunicodestringtype
  2252. else
  2253. strdef:=cansistringtype
  2254. else
  2255. strdef:=cshortstringtype;
  2256. cst_shortstring:
  2257. strdef:=cshortstringtype;
  2258. cst_ansistring:
  2259. { use getansistringdef? }
  2260. strdef:=cansistringtype;
  2261. cst_widestring:
  2262. strdef:=cwidestringtype;
  2263. cst_unicodestring:
  2264. strdef:=cunicodestringtype;
  2265. cst_longstring:
  2266. { let's see when someone stumbles upon this...}
  2267. internalerror(201301111);
  2268. end;
  2269. if try_type_helper(p1,strdef) then
  2270. goto skippointdefcheck;
  2271. end;
  2272. { this is skipped if label skippointdefcheck is used }
  2273. case p1.resultdef.typ of
  2274. recorddef:
  2275. begin
  2276. if isspecialize or (token=_ID) then
  2277. begin
  2278. erroroutp1:=true;
  2279. srsym:=nil;
  2280. structh:=tabstractrecorddef(p1.resultdef);
  2281. if isspecialize then
  2282. begin
  2283. { consume the specialize }
  2284. consume(_ID);
  2285. if token<>_ID then
  2286. consume(_ID)
  2287. else
  2288. begin
  2289. searchsym_in_record(structh,pattern,srsym,srsymtable);
  2290. consume(_ID);
  2291. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2292. erroroutp1:=false;
  2293. end;
  2294. end
  2295. else
  2296. begin
  2297. searchsym_in_record(structh,pattern,srsym,srsymtable);
  2298. if assigned(srsym) then
  2299. begin
  2300. old_current_filepos:=current_filepos;
  2301. consume(_ID);
  2302. if not (sp_generic_dummy in srsym.symoptions) or
  2303. not (token in [_LT,_LSHARPBRACKET]) then
  2304. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2305. else
  2306. p1:=cspecializenode.create(p1,getaddr,srsym);
  2307. erroroutp1:=false;
  2308. end
  2309. else
  2310. begin
  2311. Message1(sym_e_id_no_member,orgpattern);
  2312. { try to clean up }
  2313. consume(_ID);
  2314. end;
  2315. end;
  2316. if erroroutp1 then
  2317. begin
  2318. p1.free;
  2319. p1:=cerrornode.create;
  2320. end
  2321. else
  2322. if p1.nodetype<>specializen then
  2323. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2324. end
  2325. else
  2326. consume(_ID);
  2327. end;
  2328. enumdef:
  2329. begin
  2330. if token=_ID then
  2331. begin
  2332. srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern));
  2333. if assigned(srsym) and (srsym.typ=enumsym) and (p1.nodetype=typen) then
  2334. begin
  2335. p1.destroy;
  2336. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2337. p1:=genenumnode(tenumsym(srsym));
  2338. consume(_ID);
  2339. end
  2340. else
  2341. if not try_type_helper(p1,nil) then
  2342. begin
  2343. p1.destroy;
  2344. Message1(sym_e_id_no_member,orgpattern);
  2345. p1:=cerrornode.create;
  2346. consume(_ID);
  2347. end;
  2348. end;
  2349. end;
  2350. arraydef:
  2351. begin
  2352. if is_dynamic_array(p1.resultdef) then
  2353. begin
  2354. if token=_ID then
  2355. begin
  2356. if not try_type_helper(p1,nil) then
  2357. begin
  2358. if p1.nodetype=typen then
  2359. begin
  2360. if pattern='CREATE' then
  2361. begin
  2362. consume(_ID);
  2363. p2:=parse_array_constructor(tarraydef(p1.resultdef));
  2364. p1.destroy;
  2365. p1:=p2;
  2366. end
  2367. else
  2368. begin
  2369. Message2(scan_f_syn_expected,'CREATE',pattern);
  2370. p1.destroy;
  2371. p1:=cerrornode.create;
  2372. consume(_ID);
  2373. end;
  2374. end
  2375. else
  2376. begin
  2377. Message(parser_e_invalid_qualifier);
  2378. p1.destroy;
  2379. p1:=cerrornode.create;
  2380. consume(_ID);
  2381. end;
  2382. end;
  2383. end
  2384. else
  2385. begin
  2386. Message(parser_e_invalid_qualifier);
  2387. p1.destroy;
  2388. p1:=cerrornode.create;
  2389. consume(_ID);
  2390. end;
  2391. end
  2392. else
  2393. if (token<>_ID) or not try_type_helper(p1,nil) then
  2394. begin
  2395. Message(parser_e_invalid_qualifier);
  2396. p1.destroy;
  2397. p1:=cerrornode.create;
  2398. consume(_ID);
  2399. end;
  2400. end;
  2401. variantdef:
  2402. begin
  2403. { dispatch call? }
  2404. { lhs := v.ident[parameters] -> property get
  2405. lhs := v.ident(parameters) -> method call
  2406. v.ident[parameters] := rhs -> property put
  2407. v.ident(parameters) := rhs -> also property put }
  2408. if token=_ID then
  2409. begin
  2410. if not try_type_helper(p1,nil) then
  2411. begin
  2412. dispatchstring:=orgpattern;
  2413. consume(_ID);
  2414. calltype:=dct_method;
  2415. if try_to_consume(_LKLAMMER) then
  2416. begin
  2417. p2:=parse_paras(false,true,_RKLAMMER);
  2418. consume(_RKLAMMER);
  2419. end
  2420. else if try_to_consume(_LECKKLAMMER) then
  2421. begin
  2422. p2:=parse_paras(false,true,_RECKKLAMMER);
  2423. consume(_RECKKLAMMER);
  2424. calltype:=dct_propget;
  2425. end
  2426. else
  2427. p2:=nil;
  2428. { property setter? }
  2429. if (token=_ASSIGNMENT) and not(afterassignment) then
  2430. begin
  2431. consume(_ASSIGNMENT);
  2432. { read the expression }
  2433. p3:=comp_expr([ef_accept_equal]);
  2434. { concat value parameter too }
  2435. p2:=ccallparanode.create(p3,p2);
  2436. p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype);
  2437. end
  2438. else
  2439. { this is only an approximation
  2440. setting useresult if not necessary is only a waste of time, no more, no less (FK) }
  2441. if afterassignment or in_args or (token<>_SEMICOLON) then
  2442. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype)
  2443. else
  2444. p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype);
  2445. end;
  2446. end
  2447. else { Error }
  2448. Consume(_ID);
  2449. end;
  2450. classrefdef:
  2451. begin
  2452. erroroutp1:=true;
  2453. if token=_ID then
  2454. begin
  2455. srsym:=nil;
  2456. structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
  2457. if isspecialize then
  2458. begin
  2459. { consume the specialize }
  2460. consume(_ID);
  2461. if token<>_ID then
  2462. consume(_ID)
  2463. else
  2464. begin
  2465. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2466. consume(_ID);
  2467. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2468. erroroutp1:=false;
  2469. end;
  2470. end
  2471. else
  2472. begin
  2473. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2474. if assigned(srsym) then
  2475. begin
  2476. old_current_filepos:=current_filepos;
  2477. consume(_ID);
  2478. if not (sp_generic_dummy in srsym.symoptions) or
  2479. not (token in [_LT,_LSHARPBRACKET]) then
  2480. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2481. else
  2482. p1:=cspecializenode.create(p1,getaddr,srsym);
  2483. erroroutp1:=false;
  2484. end
  2485. else
  2486. begin
  2487. Message1(sym_e_id_no_member,orgpattern);
  2488. { try to clean up }
  2489. consume(_ID);
  2490. end;
  2491. end;
  2492. if erroroutp1 then
  2493. begin
  2494. p1.free;
  2495. p1:=cerrornode.create;
  2496. end
  2497. else
  2498. if p1.nodetype<>specializen then
  2499. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2500. end
  2501. else { Error }
  2502. Consume(_ID);
  2503. end;
  2504. objectdef:
  2505. begin
  2506. if isspecialize or (token=_ID) then
  2507. begin
  2508. erroroutp1:=true;
  2509. srsym:=nil;
  2510. structh:=tobjectdef(p1.resultdef);
  2511. if isspecialize then
  2512. begin
  2513. { consume the "specialize" }
  2514. consume(_ID);
  2515. if token<>_ID then
  2516. consume(_ID)
  2517. else
  2518. begin
  2519. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2520. consume(_ID);
  2521. if handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  2522. erroroutp1:=false;
  2523. end;
  2524. end
  2525. else
  2526. begin
  2527. searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,[ssf_search_helper]);
  2528. if assigned(srsym) then
  2529. begin
  2530. old_current_filepos:=current_filepos;
  2531. consume(_ID);
  2532. if not (sp_generic_dummy in srsym.symoptions) or
  2533. not (token in [_LT,_LSHARPBRACKET]) then
  2534. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg,old_current_filepos)
  2535. else
  2536. p1:=cspecializenode.create(p1,getaddr,srsym);
  2537. erroroutp1:=false;
  2538. end
  2539. else
  2540. begin
  2541. Message1(sym_e_id_no_member,orgpattern);
  2542. { try to clean up }
  2543. consume(_ID);
  2544. end;
  2545. end;
  2546. if erroroutp1 then
  2547. begin
  2548. p1.free;
  2549. p1:=cerrornode.create;
  2550. end
  2551. else
  2552. if p1.nodetype<>specializen then
  2553. do_member_read(structh,getaddr,srsym,p1,again,[],spezcontext);
  2554. end
  2555. else { Error }
  2556. Consume(_ID);
  2557. end;
  2558. pointerdef:
  2559. begin
  2560. if (p1.resultdef=objc_idtype) then
  2561. begin
  2562. { objc's id type can be used to call any
  2563. Objective-C method of any Objective-C class
  2564. type that's currently in scope }
  2565. if search_objc_method(pattern,srsym,srsymtable) then
  2566. begin
  2567. consume(_ID);
  2568. do_proc_call(srsym,srsymtable,nil,
  2569. (getaddr and not(token in [_CARET,_POINT])),
  2570. again,p1,[cnf_objc_id_call],nil);
  2571. { we need to know which procedure is called }
  2572. do_typecheckpass(p1);
  2573. end
  2574. else
  2575. begin
  2576. consume(_ID);
  2577. Message(parser_e_methode_id_expected);
  2578. end;
  2579. end
  2580. else
  2581. begin
  2582. if not try_type_helper(p1,nil) then
  2583. begin
  2584. Message(parser_e_invalid_qualifier);
  2585. if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then
  2586. Message(parser_h_maybe_deref_caret_missing);
  2587. end;
  2588. end
  2589. end;
  2590. else
  2591. begin
  2592. if autoderef then
  2593. begin
  2594. { always try with the not dereferenced node }
  2595. p2:=tderefnode(p1).left;
  2596. found:=try_type_helper(p2,nil);
  2597. if found then
  2598. begin
  2599. tderefnode(p1).left:=nil;
  2600. p1.destroy;
  2601. p1:=p2;
  2602. end;
  2603. end
  2604. else
  2605. found:=try_type_helper(p1,nil);
  2606. if not found then
  2607. begin
  2608. if p1.resultdef.typ<>undefineddef then
  2609. Message(parser_e_invalid_qualifier);
  2610. p1.destroy;
  2611. p1:=cerrornode.create;
  2612. { Error }
  2613. consume(_ID);
  2614. end;
  2615. end;
  2616. end;
  2617. { processing an ordconstnode avoids the resultdef check }
  2618. skippointdefcheck:
  2619. end;
  2620. else
  2621. begin
  2622. { is this a procedure variable ? }
  2623. if assigned(p1.resultdef) and
  2624. (p1.resultdef.typ=procvardef) then
  2625. begin
  2626. { Typenode for typecasting or expecting a procvar }
  2627. if (p1.nodetype=typen) or
  2628. (
  2629. assigned(getprocvardef) and
  2630. equal_defs(p1.resultdef,getprocvardef)
  2631. ) then
  2632. begin
  2633. if try_to_consume(_LKLAMMER) then
  2634. begin
  2635. p1:=comp_expr([ef_accept_equal]);
  2636. consume(_RKLAMMER);
  2637. p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
  2638. end
  2639. else
  2640. again:=false
  2641. end
  2642. else
  2643. begin
  2644. if try_to_consume(_LKLAMMER) then
  2645. begin
  2646. p2:=parse_paras(false,false,_RKLAMMER);
  2647. consume(_RKLAMMER);
  2648. p1:=ccallnode.create_procvar(p2,p1);
  2649. { proc():= is never possible }
  2650. if token=_ASSIGNMENT then
  2651. begin
  2652. Message(parser_e_illegal_expression);
  2653. p1.free;
  2654. p1:=cerrornode.create;
  2655. again:=false;
  2656. end;
  2657. end
  2658. else
  2659. again:=false;
  2660. end;
  2661. end
  2662. else
  2663. again:=false;
  2664. end;
  2665. end;
  2666. { we only try again if p1 was changed }
  2667. if again or
  2668. (p1.nodetype=errorn) then
  2669. result:=true;
  2670. end; { while again }
  2671. end;
  2672. function is_member_read(sym: tsym; st: tsymtable; var p1: tnode;
  2673. out memberparentdef: tdef): boolean;
  2674. var
  2675. hdef : tdef;
  2676. begin
  2677. result:=true;
  2678. memberparentdef:=nil;
  2679. case st.symtabletype of
  2680. ObjectSymtable,
  2681. recordsymtable:
  2682. begin
  2683. memberparentdef:=tdef(st.defowner);
  2684. exit;
  2685. end;
  2686. WithSymtable:
  2687. begin
  2688. if assigned(p1) then
  2689. internalerror(2007012002);
  2690. hdef:=tnode(twithsymtable(st).withrefnode).resultdef;
  2691. p1:=tnode(twithsymtable(st).withrefnode).getcopy;
  2692. if not(hdef.typ in [objectdef,classrefdef]) then
  2693. exit;
  2694. if (hdef.typ=classrefdef) then
  2695. hdef:=tclassrefdef(hdef).pointeddef;
  2696. memberparentdef:=hdef;
  2697. end;
  2698. else
  2699. result:=false;
  2700. end;
  2701. end;
  2702. {$maxfpuregisters 0}
  2703. function factor(getaddr:boolean;flags:texprflags) : tnode;
  2704. {---------------------------------------------
  2705. Factor_read_id
  2706. ---------------------------------------------}
  2707. procedure factor_read_id(out p1:tnode;out again:boolean);
  2708. function findwithsymtable : boolean;
  2709. var
  2710. hp : psymtablestackitem;
  2711. begin
  2712. result:=true;
  2713. hp:=symtablestack.stack;
  2714. while assigned(hp) do
  2715. begin
  2716. if hp^.symtable.symtabletype=withsymtable then
  2717. exit;
  2718. hp:=hp^.next;
  2719. end;
  2720. result:=false;
  2721. end;
  2722. var
  2723. srsym: tsym;
  2724. srsymtable: TSymtable;
  2725. hdef: tdef;
  2726. pd: tprocdef;
  2727. orgstoredpattern,
  2728. storedpattern: string;
  2729. callflags: tcallnodeflags;
  2730. t : ttoken;
  2731. consumeid,
  2732. wasgenericdummy,
  2733. allowspecialize,
  2734. isspecialize,
  2735. unit_found, tmpgetaddr: boolean;
  2736. dummypos,
  2737. tokenpos: tfileposinfo;
  2738. spezcontext : tspecializationcontext;
  2739. cufflags : tconsume_unitsym_flags;
  2740. begin
  2741. { allow post fix operators }
  2742. again:=true;
  2743. { preinitalize tokenpos }
  2744. tokenpos:=current_filepos;
  2745. p1:=nil;
  2746. spezcontext:=nil;
  2747. { avoid warning }
  2748. fillchar(dummypos,sizeof(dummypos),0);
  2749. allowspecialize:=not (m_delphi in current_settings.modeswitches) and
  2750. not (ef_had_specialize in flags) and
  2751. (block_type in inline_specialization_block_types);
  2752. if allowspecialize and (token=_ID) and (idtoken=_SPECIALIZE) then
  2753. begin
  2754. consume(_ID);
  2755. isspecialize:=true;
  2756. end
  2757. else
  2758. isspecialize:=ef_had_specialize in flags;
  2759. { first check for identifier }
  2760. if token<>_ID then
  2761. begin
  2762. srsym:=generrorsym;
  2763. srsymtable:=nil;
  2764. consume(_ID);
  2765. unit_found:=false;
  2766. end
  2767. else
  2768. begin
  2769. storedpattern:=pattern;
  2770. orgstoredpattern:=orgpattern;
  2771. { store the position of the token before consuming it }
  2772. tokenpos:=current_filepos;
  2773. consumeid:=true;
  2774. srsym:=nil;
  2775. if ef_check_attr_suffix in flags then
  2776. begin
  2777. if not (ef_type_only in flags) then
  2778. internalerror(2019063001);
  2779. consume(_ID);
  2780. consumeid:=false;
  2781. if token<>_POINT then
  2782. searchsym_type(storedpattern+custom_attribute_suffix,srsym,srsymtable);
  2783. end;
  2784. if not assigned(srsym) then
  2785. begin
  2786. if ef_type_only in flags then
  2787. searchsym_type(storedpattern,srsym,srsymtable)
  2788. else
  2789. searchsym(storedpattern,srsym,srsymtable);
  2790. end;
  2791. { handle unit specification like System.Writeln }
  2792. if not isspecialize then
  2793. begin
  2794. cufflags:=[];
  2795. if consumeid then
  2796. include(cufflags,cuf_consume_id);
  2797. if allowspecialize then
  2798. include(cufflags,cuf_allow_specialize);
  2799. if ef_check_attr_suffix in flags then
  2800. include(cufflags,cuf_check_attr_suffix);
  2801. unit_found:=try_consume_unitsym(srsym,srsymtable,t,cufflags,isspecialize,pattern);
  2802. if unit_found then
  2803. consumeid:=true;
  2804. end
  2805. else
  2806. begin
  2807. unit_found:=false;
  2808. t:=_ID;
  2809. end;
  2810. if consumeid then
  2811. begin
  2812. storedpattern:=pattern;
  2813. orgstoredpattern:=orgpattern;
  2814. { store the position of the token before consuming it }
  2815. tokenpos:=current_filepos;
  2816. consume(t);
  2817. end;
  2818. { named parameter support }
  2819. found_arg_name:=false;
  2820. if not(unit_found) and
  2821. not isspecialize and
  2822. named_args_allowed and
  2823. (token=_ASSIGNMENT) then
  2824. begin
  2825. found_arg_name:=true;
  2826. p1:=cstringconstnode.createstr(storedpattern);
  2827. consume(_ASSIGNMENT);
  2828. exit;
  2829. end;
  2830. if isspecialize then
  2831. begin
  2832. if not assigned(srsym) then
  2833. begin
  2834. identifier_not_found(orgstoredpattern,tokenpos);
  2835. srsym:=generrorsym;
  2836. srsymtable:=nil;
  2837. end
  2838. else
  2839. begin
  2840. {$push}
  2841. {$warn 5036 off}
  2842. hdef:=generate_specialization_phase1(spezcontext,nil,nil,orgstoredpattern,dummypos);
  2843. {$pop}
  2844. if hdef=generrordef then
  2845. begin
  2846. spezcontext.free;
  2847. spezcontext:=nil;
  2848. srsym:=generrorsym;
  2849. srsymtable:=nil;
  2850. end
  2851. else
  2852. begin
  2853. if hdef.typ in [objectdef,recorddef,procvardef,arraydef] then
  2854. begin
  2855. hdef:=generate_specialization_phase2(spezcontext,tstoreddef(hdef),false,'');
  2856. spezcontext.free;
  2857. spezcontext:=nil;
  2858. if hdef<>generrordef then
  2859. begin
  2860. srsym:=hdef.typesym;
  2861. srsymtable:=srsym.owner;
  2862. end
  2863. else
  2864. begin
  2865. srsym:=generrorsym;
  2866. srsymtable:=nil;
  2867. end;
  2868. end
  2869. else
  2870. if hdef.typ=procdef then
  2871. begin
  2872. if block_type<>bt_body then
  2873. begin
  2874. message(parser_e_illegal_expression);
  2875. srsym:=generrorsym;
  2876. srsymtable:=nil;
  2877. end
  2878. else
  2879. begin
  2880. srsym:=tprocdef(hdef).procsym;
  2881. srsymtable:=srsym.owner;
  2882. end;
  2883. end
  2884. else
  2885. internalerror(2015061204);
  2886. end;
  2887. end;
  2888. end;
  2889. wasgenericdummy:=false;
  2890. if assigned(srsym) and
  2891. (sp_generic_dummy in srsym.symoptions) and
  2892. (srsym.typ=typesym) and
  2893. (
  2894. (
  2895. (m_delphi in current_settings.modeswitches) and
  2896. not (token in [_LT, _LSHARPBRACKET]) and
  2897. (ttypesym(srsym).typedef.typ=undefineddef)
  2898. )
  2899. or
  2900. (
  2901. not (m_delphi in current_settings.modeswitches) and
  2902. not isspecialize and
  2903. (
  2904. not parse_generic or
  2905. not (
  2906. assigned(current_structdef) and
  2907. assigned(get_generic_in_hierarchy_by_name(srsym,current_structdef))
  2908. )
  2909. )
  2910. )
  2911. ) then
  2912. begin
  2913. srsym:=resolve_generic_dummysym(srsym.name);
  2914. if assigned(srsym) then
  2915. srsymtable:=srsym.owner
  2916. else
  2917. begin
  2918. srsymtable:=nil;
  2919. wasgenericdummy:=true;
  2920. end;
  2921. end;
  2922. { check hints, but only if it isn't a potential generic symbol;
  2923. that is checked in sub_expr if it isn't a generic }
  2924. if assigned(srsym) and
  2925. not (
  2926. (srsym.typ=typesym) and
  2927. (
  2928. (ttypesym(srsym).typedef.typ in [recorddef,objectdef,arraydef,procvardef,undefineddef]) or
  2929. (
  2930. (ttypesym(srsym).typedef.typ=errordef) and
  2931. (sp_generic_dummy in srsym.symoptions)
  2932. )
  2933. ) and
  2934. not (sp_generic_para in srsym.symoptions) and
  2935. (token in [_LT, _LSHARPBRACKET])
  2936. ) then
  2937. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  2938. { if nothing found give error and return errorsym }
  2939. if not assigned(srsym) or
  2940. { is this a generic dummy symbol? }
  2941. ((srsym.typ=typesym) and
  2942. assigned(ttypesym(srsym).typedef) and
  2943. (ttypesym(srsym).typedef.typ=undefineddef) and
  2944. not (sp_generic_para in srsym.symoptions) and
  2945. not (token in [_LT, _LSHARPBRACKET]) and
  2946. not (
  2947. { in non-Delphi modes the generic class' name without a
  2948. "specialization" or "<T>" may be used to identify the
  2949. current class }
  2950. (sp_generic_dummy in srsym.symoptions) and
  2951. assigned(current_structdef) and
  2952. (df_generic in current_structdef.defoptions) and
  2953. not (m_delphi in current_settings.modeswitches) and
  2954. assigned(get_generic_in_hierarchy_by_name(srsym,current_structdef))
  2955. )) and
  2956. { it could be a rename of a generic para }
  2957. { Note: if this generates false positives we'll need to
  2958. include a "basesym" to tsym to track the original
  2959. symbol }
  2960. not (sp_explicitrename in srsym.symoptions) then
  2961. begin
  2962. { if a generic is parsed and when we are inside an with block,
  2963. a symbol might not be defined }
  2964. if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) and
  2965. findwithsymtable then
  2966. begin
  2967. { create dummy symbol, it will be freed later on }
  2968. srsym:=tstoredsym.create(undefinedsym,'$undefinedsym');
  2969. srsymtable:=nil;
  2970. end
  2971. else
  2972. begin
  2973. if wasgenericdummy then
  2974. messagepos(tokenpos,parser_e_no_generics_as_types)
  2975. else
  2976. identifier_not_found(orgstoredpattern,tokenpos);
  2977. srsym:=generrorsym;
  2978. srsymtable:=nil;
  2979. end;
  2980. end;
  2981. end;
  2982. { Access to funcret or need to call the function? }
  2983. if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and
  2984. (vo_is_funcret in tabstractvarsym(srsym).varoptions) and
  2985. { result(x) is not allowed }
  2986. not(vo_is_result in tabstractvarsym(srsym).varoptions) and
  2987. (
  2988. (token=_LKLAMMER) or
  2989. (
  2990. (([m_tp7,m_delphi,m_mac,m_iso,m_extpas] * current_settings.modeswitches) <> []) and
  2991. (afterassignment or in_args)
  2992. )
  2993. ) then
  2994. begin
  2995. hdef:=tdef(srsym.owner.defowner);
  2996. if assigned(hdef) and
  2997. (hdef.typ=procdef) then
  2998. srsym:=tprocdef(hdef).procsym
  2999. else
  3000. begin
  3001. Message(parser_e_illegal_expression);
  3002. srsym:=generrorsym;
  3003. end;
  3004. srsymtable:=srsym.owner;
  3005. end;
  3006. begin
  3007. case srsym.typ of
  3008. absolutevarsym :
  3009. begin
  3010. if (tabsolutevarsym(srsym).abstyp=tovar) then
  3011. begin
  3012. p1:=nil;
  3013. propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref);
  3014. p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef);
  3015. include(p1.flags,nf_absolute);
  3016. end
  3017. else
  3018. p1:=cloadnode.create(srsym,srsymtable);
  3019. end;
  3020. staticvarsym,
  3021. localvarsym,
  3022. paravarsym,
  3023. fieldvarsym :
  3024. begin
  3025. { check if we are reading a field of an object/class/ }
  3026. { record. is_member_read() will deal with withsymtables }
  3027. { if needed. }
  3028. p1:=nil;
  3029. if is_member_read(srsym,srsymtable,p1,hdef) then
  3030. begin
  3031. { if the field was originally found in an }
  3032. { objectsymtable, it means it's part of self }
  3033. { if only method from which it was called is }
  3034. { not class static }
  3035. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  3036. { if we are accessing a owner procsym from the nested }
  3037. { class we need to call it as a class member }
  3038. if assigned(current_structdef) and
  3039. (((current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
  3040. (sp_static in srsym.symoptions)) then
  3041. if srsymtable.symtabletype=recordsymtable then
  3042. p1:=ctypenode.create(hdef)
  3043. else
  3044. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
  3045. else
  3046. begin
  3047. if assigned(current_procinfo) then
  3048. begin
  3049. pd:=current_procinfo.get_normal_proc.procdef;
  3050. if assigned(pd) and pd.no_self_node then
  3051. p1:=cloadvmtaddrnode.create(ctypenode.create(pd.struct))
  3052. else
  3053. p1:=load_self_node;
  3054. end
  3055. else
  3056. p1:=load_self_node;
  3057. end;
  3058. { now, if the field itself is part of an objectsymtab }
  3059. { (it can be even if it was found in a withsymtable, }
  3060. { e.g., "with classinstance do field := 5"), then }
  3061. { let do_member_read handle it }
  3062. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  3063. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
  3064. else
  3065. { otherwise it's a regular record subscript }
  3066. p1:=csubscriptnode.create(srsym,p1);
  3067. end
  3068. else
  3069. { regular non-field load }
  3070. p1:=cloadnode.create(srsym,srsymtable);
  3071. end;
  3072. syssym :
  3073. begin
  3074. p1:=statement_syssym(tsyssym(srsym).number);
  3075. end;
  3076. typesym :
  3077. begin
  3078. hdef:=ttypesym(srsym).typedef;
  3079. if not assigned(hdef) then
  3080. begin
  3081. again:=false;
  3082. end
  3083. else
  3084. begin
  3085. if (m_delphi in current_settings.modeswitches) and
  3086. (sp_generic_dummy in srsym.symoptions) and
  3087. (token in [_LT,_LSHARPBRACKET]) then
  3088. begin
  3089. if block_type in [bt_type,bt_const_type,bt_var_type] then
  3090. begin
  3091. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) or (srsym.typ=procsym) then
  3092. begin
  3093. spezcontext.free;
  3094. p1:=cerrornode.create;
  3095. if try_to_consume(_LKLAMMER) then
  3096. begin
  3097. parse_paras(false,false,_RKLAMMER);
  3098. consume(_RKLAMMER);
  3099. end;
  3100. end
  3101. else
  3102. begin
  3103. if srsym.typ<>typesym then
  3104. internalerror(2015071705);
  3105. hdef:=ttypesym(srsym).typedef;
  3106. p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
  3107. end;
  3108. end
  3109. else
  3110. p1:=cspecializenode.create(nil,getaddr,srsym)
  3111. end
  3112. else
  3113. begin
  3114. { We need to know if this unit uses Variants }
  3115. if ((hdef=cvarianttype) or (hdef=colevarianttype)) and
  3116. not(cs_compilesystem in current_settings.moduleswitches) then
  3117. include(current_module.moduleflags,mf_uses_variants);
  3118. p1:=handle_factor_typenode(hdef,getaddr,again,srsym,ef_type_only in flags);
  3119. end;
  3120. end;
  3121. end;
  3122. enumsym :
  3123. begin
  3124. p1:=genenumnode(tenumsym(srsym));
  3125. end;
  3126. constsym :
  3127. begin
  3128. if tconstsym(srsym).consttyp=constresourcestring then
  3129. begin
  3130. p1:=cloadnode.create(srsym,srsymtable);
  3131. do_typecheckpass(p1);
  3132. p1.resultdef:=getansistringdef;
  3133. end
  3134. else
  3135. p1:=genconstsymtree(tconstsym(srsym));
  3136. end;
  3137. procsym :
  3138. begin
  3139. p1:=nil;
  3140. { check if it's a method/class method }
  3141. if is_member_read(srsym,srsymtable,p1,hdef) then
  3142. begin
  3143. { if we are accessing a owner procsym from the nested }
  3144. { class we need to call it as a class member }
  3145. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and
  3146. assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then
  3147. p1:=cloadvmtaddrnode.create(ctypenode.create(hdef));
  3148. { not srsymtable.symtabletype since that can be }
  3149. { withsymtable as well }
  3150. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  3151. begin
  3152. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],spezcontext);
  3153. spezcontext:=nil;
  3154. end
  3155. else
  3156. { no procsyms in records (yet) }
  3157. internalerror(2007012006);
  3158. end
  3159. else
  3160. begin
  3161. { regular procedure/function call }
  3162. if not unit_found then
  3163. callflags:=[]
  3164. else
  3165. callflags:=[cnf_unit_specified];
  3166. { TP7 uglyness: @proc^ is parsed as (@proc)^,
  3167. but @notproc^ is parsed as @(notproc^) }
  3168. if m_tp_procvar in current_settings.modeswitches then
  3169. tmpgetaddr:=getaddr and not(token in [_POINT,_LECKKLAMMER])
  3170. else
  3171. tmpgetaddr:=getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER]);
  3172. do_proc_call(srsym,srsymtable,nil,tmpgetaddr,
  3173. again,p1,callflags,spezcontext);
  3174. spezcontext:=nil;
  3175. end;
  3176. end;
  3177. propertysym :
  3178. begin
  3179. p1:=nil;
  3180. { property of a class/object? }
  3181. if is_member_read(srsym,srsymtable,p1,hdef) then
  3182. begin
  3183. if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then
  3184. { if we are accessing a owner procsym from the nested }
  3185. { class or from a static class method we need to call }
  3186. { it as a class member }
  3187. if (assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef)) or
  3188. (assigned(current_procinfo) and current_procinfo.get_normal_proc.procdef.no_self_node) then
  3189. begin
  3190. p1:=ctypenode.create(hdef);
  3191. if not is_record(hdef) then
  3192. p1:=cloadvmtaddrnode.create(p1);
  3193. end
  3194. else
  3195. p1:=load_self_node;
  3196. { not srsymtable.symtabletype since that can be }
  3197. { withsymtable as well }
  3198. if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  3199. do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[],nil)
  3200. else
  3201. { no propertysyms in records (yet) }
  3202. internalerror(2009111510);
  3203. end
  3204. else
  3205. { no method pointer }
  3206. begin
  3207. handle_propertysym(tpropertysym(srsym),srsymtable,p1);
  3208. end;
  3209. end;
  3210. labelsym :
  3211. begin
  3212. { Support @label }
  3213. if getaddr then
  3214. begin
  3215. if srsym.owner<>current_procinfo.procdef.localst then
  3216. CGMessage(parser_e_label_outside_proc);
  3217. p1:=cloadnode.create(srsym,srsym.owner)
  3218. end
  3219. else
  3220. begin
  3221. consume(_COLON);
  3222. if tlabelsym(srsym).defined then
  3223. Message(sym_e_label_already_defined);
  3224. if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
  3225. begin
  3226. tlabelsym(srsym).nonlocal:=true;
  3227. include(current_procinfo.flags,pi_has_interproclabel);
  3228. end;
  3229. if tlabelsym(srsym).nonlocal and
  3230. (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
  3231. Message(sym_e_interprocgoto_into_init_final_code_not_allowed);
  3232. tlabelsym(srsym).defined:=true;
  3233. p1:=clabelnode.create(nil,tlabelsym(srsym));
  3234. tlabelsym(srsym).code:=p1;
  3235. end;
  3236. end;
  3237. undefinedsym :
  3238. begin
  3239. p1:=cnothingnode.Create;
  3240. p1.resultdef:=cundefineddef.create(true);
  3241. { clean up previously created dummy symbol }
  3242. srsym.free;
  3243. end;
  3244. errorsym :
  3245. begin
  3246. p1:=cerrornode.create;
  3247. if try_to_consume(_LKLAMMER) then
  3248. begin
  3249. parse_paras(false,false,_RKLAMMER);
  3250. consume(_RKLAMMER);
  3251. end;
  3252. end;
  3253. else
  3254. begin
  3255. p1:=cerrornode.create;
  3256. Message(parser_e_illegal_expression);
  3257. end;
  3258. end; { end case }
  3259. if assigned(spezcontext) then
  3260. internalerror(2015061207);
  3261. if assigned(p1) and (p1.nodetype<>errorn) then
  3262. p1.fileinfo:=tokenpos;
  3263. end;
  3264. end;
  3265. {---------------------------------------------
  3266. Factor_Read_Set
  3267. ---------------------------------------------}
  3268. { Read a set between [] }
  3269. function factor_read_set:tnode;
  3270. var
  3271. p1,p2 : tnode;
  3272. lastp,
  3273. buildp : tarrayconstructornode;
  3274. begin
  3275. buildp:=nil;
  3276. lastp:=nil;
  3277. { be sure that a least one arrayconstructn is used, also for an
  3278. empty [] }
  3279. if token=_RECKKLAMMER then
  3280. buildp:=carrayconstructornode.create(nil,buildp)
  3281. else
  3282. repeat
  3283. p1:=comp_expr([ef_accept_equal]);
  3284. if try_to_consume(_POINTPOINT) then
  3285. begin
  3286. p2:=comp_expr([ef_accept_equal]);
  3287. p1:=carrayconstructorrangenode.create(p1,p2);
  3288. end;
  3289. { insert at the end of the tree, to get the correct order }
  3290. if not assigned(buildp) then
  3291. begin
  3292. buildp:=carrayconstructornode.create(p1,nil);
  3293. lastp:=buildp;
  3294. end
  3295. else
  3296. begin
  3297. lastp.right:=carrayconstructornode.create(p1,nil);
  3298. lastp:=tarrayconstructornode(lastp.right);
  3299. end;
  3300. { there could be more elements }
  3301. until not try_to_consume(_COMMA);
  3302. buildp.allow_array_constructor:=block_type in [bt_body,bt_except];
  3303. factor_read_set:=buildp;
  3304. end;
  3305. function can_load_self_node: boolean;
  3306. begin
  3307. result:=false;
  3308. if (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
  3309. not assigned(current_structdef) or
  3310. not assigned(current_procinfo) then
  3311. exit;
  3312. result:=not current_procinfo.get_normal_proc.procdef.no_self_node;
  3313. end;
  3314. {---------------------------------------------
  3315. Factor (Main)
  3316. ---------------------------------------------}
  3317. var
  3318. l : longint;
  3319. ic : int64;
  3320. qc : qword;
  3321. p1 : tnode;
  3322. code : integer;
  3323. srsym : tsym;
  3324. srsymtable : TSymtable;
  3325. pd : tprocdef;
  3326. hclassdef : tobjectdef;
  3327. d : bestreal;
  3328. hs,hsorg : string;
  3329. hdef : tdef;
  3330. filepos : tfileposinfo;
  3331. callflags : tcallnodeflags;
  3332. idstr : tidstring;
  3333. spezcontext : tspecializationcontext;
  3334. isspecialize,
  3335. mightbegeneric,
  3336. useself,
  3337. dopostfix,
  3338. again,
  3339. updatefpos,
  3340. nodechanged : boolean;
  3341. begin
  3342. { can't keep a copy of p1 and compare pointers afterwards, because
  3343. p1 may be freed and reallocated in the same place! }
  3344. dopostfix:=true;
  3345. updatefpos:=false;
  3346. p1:=nil;
  3347. filepos:=current_tokenpos;
  3348. again:=false;
  3349. pd:=nil;
  3350. isspecialize:=false;
  3351. if token=_ID then
  3352. begin
  3353. again:=true;
  3354. { Handle references to self }
  3355. if (idtoken=_SELF) and can_load_self_node then
  3356. begin
  3357. p1:=load_self_node;
  3358. consume(_ID);
  3359. again:=true;
  3360. end
  3361. else
  3362. factor_read_id(p1,again);
  3363. if assigned(p1) then
  3364. begin
  3365. { factor_read_id will set the filepos to after the id,
  3366. and in case of _SELF the filepos will already be the
  3367. same as filepos (so setting it again doesn't hurt). }
  3368. p1.fileinfo:=filepos;
  3369. filepos:=current_tokenpos;
  3370. end;
  3371. { handle post fix operators }
  3372. if (p1.nodetype=specializen) then
  3373. { post fix operators are handled after specialization }
  3374. dopostfix:=false
  3375. else
  3376. if (m_delphi in current_settings.modeswitches) and
  3377. (block_type=bt_body) and
  3378. (token in [_LT,_LSHARPBRACKET]) then
  3379. begin
  3380. if p1.nodetype=typen then
  3381. idstr:=ttypenode(p1).typesym.name
  3382. else
  3383. if (p1.nodetype=loadvmtaddrn) and
  3384. (tloadvmtaddrnode(p1).left.nodetype=typen) then
  3385. idstr:=ttypenode(tloadvmtaddrnode(p1).left).typesym.name
  3386. else
  3387. if (p1.nodetype=loadn) then
  3388. idstr:=tloadnode(p1).symtableentry.name
  3389. else
  3390. idstr:='';
  3391. { if this is the case then the postfix handling is done in
  3392. sub_expr if necessary }
  3393. dopostfix:=not could_be_generic(idstr);
  3394. end;
  3395. { TP7 uglyness: @proc^ is parsed as (@proc)^, but @notproc^ is parsed
  3396. as @(notproc^) }
  3397. if (m_tp_procvar in current_settings.modeswitches) and (token=_CARET) and
  3398. getaddr and (p1.nodetype=loadn) and (tloadnode(p1).symtableentry.typ=procsym) then
  3399. dopostfix:=false;
  3400. { maybe an additional parameter instead of misusing hadspezialize? }
  3401. if dopostfix and not (ef_had_specialize in flags) then
  3402. updatefpos:=postfixoperators(p1,again,getaddr);
  3403. end
  3404. else
  3405. begin
  3406. updatefpos:=true;
  3407. case token of
  3408. _RETURN :
  3409. begin
  3410. consume(_RETURN);
  3411. p1:=nil;
  3412. if not(token in [_SEMICOLON,_ELSE,_END]) then
  3413. begin
  3414. p1:=comp_expr([ef_accept_equal]);
  3415. if not assigned(current_procinfo) or
  3416. (current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) or
  3417. is_void(current_procinfo.procdef.returndef) then
  3418. begin
  3419. Message(parser_e_void_function);
  3420. { recovery }
  3421. p1.free;
  3422. p1:=nil;
  3423. end;
  3424. end;
  3425. p1 := cexitnode.create(p1);
  3426. end;
  3427. _INHERITED :
  3428. begin
  3429. again:=true;
  3430. consume(_INHERITED);
  3431. if assigned(current_procinfo) and
  3432. assigned(current_structdef) and
  3433. ((current_structdef.typ=objectdef) or
  3434. ((target_info.system in systems_jvm) and
  3435. (current_structdef.typ=recorddef)))then
  3436. begin
  3437. { for record helpers in mode Delphi "inherited" is not
  3438. allowed }
  3439. if is_objectpascal_helper(current_structdef) and
  3440. (m_delphi in current_settings.modeswitches) and
  3441. (tobjectdef(current_structdef).helpertype=ht_record) then
  3442. Message(parser_e_inherited_not_in_record);
  3443. if (current_structdef.typ=objectdef) then
  3444. begin
  3445. hclassdef:=tobjectdef(current_structdef).childof;
  3446. { Objective-C categories *replace* methods in the class
  3447. they extend, or add methods to it. So calling an
  3448. inherited method always calls the method inherited from
  3449. the parent of the extended class }
  3450. if is_objccategory(current_structdef) then
  3451. hclassdef:=hclassdef.childof;
  3452. end
  3453. else if target_info.system in systems_jvm then
  3454. hclassdef:=java_fpcbaserecordtype
  3455. else
  3456. internalerror(2012012401);
  3457. spezcontext:=nil;
  3458. { if inherited; only then we need the method with
  3459. the same name }
  3460. if token <> _ID then
  3461. begin
  3462. hs:=current_procinfo.procdef.procsym.name;
  3463. hsorg:=current_procinfo.procdef.procsym.realname;
  3464. anon_inherited:=true;
  3465. { For message methods we need to search using the message
  3466. number or string }
  3467. pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]);
  3468. srdef:=nil;
  3469. if (po_msgint in pd.procoptions) then
  3470. searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable)
  3471. else
  3472. if (po_msgstr in pd.procoptions) then
  3473. searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
  3474. else
  3475. { helpers have their own ways of dealing with inherited }
  3476. if is_objectpascal_helper(current_structdef) then
  3477. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
  3478. else
  3479. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
  3480. end
  3481. else
  3482. begin
  3483. if not (m_delphi in current_settings.modeswitches) and
  3484. (block_type in inline_specialization_block_types) and
  3485. (token=_ID) and
  3486. (idtoken=_SPECIALIZE) then
  3487. begin
  3488. consume(_ID);
  3489. if token<>_ID then
  3490. message(parser_e_methode_id_expected);
  3491. isspecialize:=true;
  3492. end
  3493. else
  3494. isspecialize:=false;
  3495. hs:=pattern;
  3496. hsorg:=orgpattern;
  3497. consume(_ID);
  3498. anon_inherited:=false;
  3499. { helpers have their own ways of dealing with inherited }
  3500. if is_objectpascal_helper(current_structdef) then
  3501. searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
  3502. else
  3503. searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
  3504. if isspecialize and assigned(srsym) then
  3505. begin
  3506. if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
  3507. srsym:=nil;
  3508. end;
  3509. end;
  3510. if assigned(srsym) then
  3511. begin
  3512. mightbegeneric:=(m_delphi in current_settings.modeswitches) and
  3513. (token in [_LT,_LSHARPBRACKET]) and
  3514. (sp_generic_dummy in srsym.symoptions);
  3515. { load the procdef from the inherited class and
  3516. not from self }
  3517. case srsym.typ of
  3518. typesym,
  3519. procsym:
  3520. begin
  3521. { typesym is only a valid choice if we're dealing
  3522. with a potential generic }
  3523. if (srsym.typ=typesym) and not mightbegeneric then
  3524. begin
  3525. Message(parser_e_methode_id_expected);
  3526. p1:=cerrornode.create;
  3527. end
  3528. else
  3529. begin
  3530. useself:=false;
  3531. if is_objectpascal_helper(current_structdef) then
  3532. begin
  3533. { for a helper load the procdef either from the
  3534. extended type, from the parent helper or from
  3535. the extended type of the parent helper
  3536. depending on the def the found symbol belongs
  3537. to }
  3538. if (srsym.Owner.defowner.typ=objectdef) and
  3539. is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
  3540. if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
  3541. assigned(tobjectdef(current_structdef).childof) then
  3542. hdef:=tobjectdef(current_structdef).childof
  3543. else
  3544. begin
  3545. hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
  3546. useself:=true;
  3547. end
  3548. else
  3549. begin
  3550. hdef:=tdef(srsym.Owner.defowner);
  3551. useself:=true;
  3552. end;
  3553. end
  3554. else
  3555. hdef:=hclassdef;
  3556. if (po_classmethod in current_procinfo.procdef.procoptions) or
  3557. (po_staticmethod in current_procinfo.procdef.procoptions) then
  3558. hdef:=cclassrefdef.create(hdef);
  3559. if useself then
  3560. begin
  3561. p1:=ctypeconvnode.create_internal(load_self_node,hdef);
  3562. end
  3563. else
  3564. begin
  3565. p1:=ctypenode.create(hdef);
  3566. { we need to allow helpers here }
  3567. ttypenode(p1).helperallowed:=true;
  3568. end;
  3569. end;
  3570. end;
  3571. propertysym:
  3572. ;
  3573. else
  3574. begin
  3575. Message(parser_e_methode_id_expected);
  3576. p1:=cerrornode.create;
  3577. end;
  3578. end;
  3579. if mightbegeneric then
  3580. begin
  3581. p1:=cspecializenode.create_inherited(p1,getaddr,srsym,hclassdef);
  3582. end
  3583. else
  3584. begin
  3585. if not isspecialize then
  3586. check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
  3587. callflags:=[cnf_inherited];
  3588. include(current_procinfo.flags,pi_has_inherited);
  3589. if anon_inherited then
  3590. include(callflags,cnf_anon_inherited);
  3591. do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,spezcontext);
  3592. end;
  3593. if p1.nodetype=errorn then
  3594. spezcontext.free;
  3595. end
  3596. else
  3597. begin
  3598. if anon_inherited then
  3599. begin
  3600. { For message methods we need to call DefaultHandler }
  3601. if (po_msgint in pd.procoptions) or
  3602. (po_msgstr in pd.procoptions) then
  3603. begin
  3604. searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,[ssf_search_helper]);
  3605. if not assigned(srsym) or
  3606. (srsym.typ<>procsym) then
  3607. internalerror(200303171);
  3608. p1:=nil;
  3609. do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[],nil);
  3610. end
  3611. else
  3612. begin
  3613. { we need to ignore the inherited; }
  3614. p1:=cnothingnode.create;
  3615. end;
  3616. end
  3617. else
  3618. begin
  3619. Message1(sym_e_id_no_member,hsorg);
  3620. p1:=cerrornode.create;
  3621. end;
  3622. again:=false;
  3623. end;
  3624. { turn auto inheriting off }
  3625. anon_inherited:=false;
  3626. end
  3627. else
  3628. begin
  3629. { in case of records we use a more clear error message }
  3630. if assigned(current_structdef) and
  3631. (current_structdef.typ=recorddef) then
  3632. Message(parser_e_inherited_not_in_record)
  3633. else
  3634. Message(parser_e_generic_methods_only_in_methods);
  3635. again:=false;
  3636. p1:=cerrornode.create;
  3637. end;
  3638. if p1.nodetype<>specializen then
  3639. postfixoperators(p1,again,getaddr);
  3640. end;
  3641. _INTCONST :
  3642. begin
  3643. {Try first wether the value fits in an int64.}
  3644. val(pattern,ic,code);
  3645. if code=0 then
  3646. begin
  3647. consume(_INTCONST);
  3648. int_to_type(ic,hdef);
  3649. p1:=cordconstnode.create(ic,hdef,true);
  3650. end
  3651. else
  3652. begin
  3653. { try qword next }
  3654. val(pattern,qc,code);
  3655. if code=0 then
  3656. begin
  3657. consume(_INTCONST);
  3658. int_to_type(qc,hdef);
  3659. p1:=cordconstnode.create(qc,hdef,true);
  3660. end;
  3661. end;
  3662. if code<>0 then
  3663. begin
  3664. { finally float }
  3665. val(pattern,d,code);
  3666. if code<>0 then
  3667. begin
  3668. Message(parser_e_invalid_integer);
  3669. consume(_INTCONST);
  3670. l:=1;
  3671. p1:=cordconstnode.create(l,sinttype,true);
  3672. end
  3673. else
  3674. begin
  3675. consume(_INTCONST);
  3676. p1:=crealconstnode.create(d,pbestrealtype^);
  3677. end;
  3678. end
  3679. else
  3680. { the necessary range checking has already been done by val }
  3681. tordconstnode(p1).rangecheck:=false;
  3682. if token=_POINT then
  3683. begin
  3684. again:=true;
  3685. postfixoperators(p1,again,getaddr);
  3686. end;
  3687. end;
  3688. _REALNUMBER :
  3689. begin
  3690. p1:=real_const_node_from_pattern(pattern);
  3691. consume(_REALNUMBER);
  3692. if token=_POINT then
  3693. begin
  3694. again:=true;
  3695. postfixoperators(p1,again,getaddr);
  3696. end;
  3697. end;
  3698. _STRING :
  3699. begin
  3700. string_dec(hdef,true);
  3701. { STRING can be also a type cast }
  3702. if try_to_consume(_LKLAMMER) then
  3703. begin
  3704. p1:=comp_expr([ef_accept_equal]);
  3705. consume(_RKLAMMER);
  3706. p1:=ctypeconvnode.create_explicit(p1,hdef);
  3707. { handle postfix operators here e.g. string(a)[10] }
  3708. again:=true;
  3709. postfixoperators(p1,again,getaddr);
  3710. end
  3711. else
  3712. begin
  3713. p1:=ctypenode.create(hdef);
  3714. if token=_POINT then
  3715. begin
  3716. again:=true;
  3717. { handle type helpers here }
  3718. postfixoperators(p1,again,getaddr);
  3719. end;
  3720. end;
  3721. end;
  3722. _FILE :
  3723. begin
  3724. hdef:=cfiletype;
  3725. consume(_FILE);
  3726. { FILE can be also a type cast }
  3727. if try_to_consume(_LKLAMMER) then
  3728. begin
  3729. p1:=comp_expr([ef_accept_equal]);
  3730. consume(_RKLAMMER);
  3731. p1:=ctypeconvnode.create_explicit(p1,hdef);
  3732. { handle postfix operators here e.g. string(a)[10] }
  3733. again:=true;
  3734. postfixoperators(p1,again,getaddr);
  3735. end
  3736. else
  3737. begin
  3738. p1:=ctypenode.create(hdef);
  3739. end;
  3740. end;
  3741. _CSTRING :
  3742. begin
  3743. p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern),nil);
  3744. consume(_CSTRING);
  3745. if token in postfixoperator_tokens then
  3746. begin
  3747. again:=true;
  3748. postfixoperators(p1,again,getaddr);
  3749. end;
  3750. end;
  3751. _CCHAR :
  3752. begin
  3753. p1:=cordconstnode.create(ord(pattern[1]),cansichartype,true);
  3754. consume(_CCHAR);
  3755. if token=_POINT then
  3756. begin
  3757. again:=true;
  3758. postfixoperators(p1,again,getaddr);
  3759. end;
  3760. end;
  3761. _CWSTRING:
  3762. begin
  3763. if getlengthwidestring(patternw)=1 then
  3764. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true)
  3765. else
  3766. p1:=cstringconstnode.createunistr(patternw);
  3767. consume(_CWSTRING);
  3768. if token in postfixoperator_tokens then
  3769. begin
  3770. again:=true;
  3771. postfixoperators(p1,again,getaddr);
  3772. end;
  3773. end;
  3774. _CWCHAR:
  3775. begin
  3776. p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
  3777. consume(_CWCHAR);
  3778. if token=_POINT then
  3779. begin
  3780. again:=true;
  3781. postfixoperators(p1,again,getaddr);
  3782. end;
  3783. end;
  3784. _KLAMMERAFFE :
  3785. begin
  3786. consume(_KLAMMERAFFE);
  3787. got_addrn:=true;
  3788. { support both @<x> and @(<x>) }
  3789. if try_to_consume(_LKLAMMER) then
  3790. begin
  3791. p1:=factor(true,[]);
  3792. { inside parentheses a full expression is allowed, see also tests\webtbs\tb27517.pp }
  3793. if token<>_RKLAMMER then
  3794. p1:=sub_expr(opcompare,[ef_accept_equal],p1);
  3795. consume(_RKLAMMER);
  3796. end
  3797. else
  3798. p1:=factor(true,[]);
  3799. if (token in postfixoperator_tokens) and
  3800. { TP7 uglyness: @proc^ is parsed as (@proc)^, but @notproc^
  3801. is parsed as @(notproc^) }
  3802. not
  3803. (
  3804. (m_tp_procvar in current_settings.modeswitches) and
  3805. (token=_CARET) and (p1.nodetype=loadn) and (tloadnode(p1).symtableentry.typ=procsym)
  3806. )
  3807. then
  3808. begin
  3809. again:=true;
  3810. postfixoperators(p1,again,getaddr);
  3811. end;
  3812. got_addrn:=false;
  3813. p1:=caddrnode.create(p1);
  3814. p1.fileinfo:=filepos;
  3815. if cs_typed_addresses in current_settings.localswitches then
  3816. include(taddrnode(p1).addrnodeflags,anf_typedaddr);
  3817. { Store the procvar that we are expecting, the
  3818. addrn will use the information to find the correct
  3819. procdef or it will return an error }
  3820. if assigned(getprocvardef) and
  3821. (taddrnode(p1).left.nodetype = loadn) then
  3822. taddrnode(p1).getprocvardef:=getprocvardef;
  3823. if (token in postfixoperator_tokens) then
  3824. begin
  3825. again:=true;
  3826. postfixoperators(p1,again,getaddr);
  3827. end;
  3828. end;
  3829. _LKLAMMER :
  3830. begin
  3831. consume(_LKLAMMER);
  3832. p1:=comp_expr([ef_accept_equal]);
  3833. consume(_RKLAMMER);
  3834. { it's not a good solution
  3835. but (a+b)^ makes some problems }
  3836. if token in postfixoperator_tokens then
  3837. begin
  3838. again:=true;
  3839. postfixoperators(p1,again,getaddr);
  3840. end;
  3841. end;
  3842. _LECKKLAMMER :
  3843. begin
  3844. consume(_LECKKLAMMER);
  3845. p1:=factor_read_set;
  3846. consume(_RECKKLAMMER);
  3847. end;
  3848. _PLUS :
  3849. begin
  3850. consume(_PLUS);
  3851. p1:=factor(false,[]);
  3852. p1:=cunaryplusnode.create(p1);
  3853. end;
  3854. _MINUS :
  3855. begin
  3856. consume(_MINUS);
  3857. if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then
  3858. begin
  3859. { ugly hack, but necessary to be able to parse }
  3860. { -9223372036854775808 as int64 (JM) }
  3861. pattern := '-'+pattern;
  3862. p1:=sub_expr(oppower,[],nil);
  3863. { -1 ** 4 should be - (1 ** 4) and not
  3864. (-1) ** 4
  3865. This was the reason of tw0869.pp test failure PM }
  3866. if p1.nodetype=starstarn then
  3867. begin
  3868. if tbinarynode(p1).left.nodetype=ordconstn then
  3869. begin
  3870. tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value;
  3871. p1:=cunaryminusnode.create(p1);
  3872. end
  3873. else if tbinarynode(p1).left.nodetype=realconstn then
  3874. begin
  3875. trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real;
  3876. trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency;
  3877. p1:=cunaryminusnode.create(p1);
  3878. end
  3879. else
  3880. internalerror(20021029);
  3881. end;
  3882. end
  3883. else
  3884. begin
  3885. if m_isolike_unary_minus in current_settings.modeswitches then
  3886. p1:=sub_expr(opmultiply,[],nil)
  3887. else
  3888. p1:=sub_expr(oppower,[],nil);
  3889. p1:=cunaryminusnode.create(p1);
  3890. end;
  3891. end;
  3892. _OP_NOT :
  3893. begin
  3894. consume(_OP_NOT);
  3895. p1:=factor(false,[]);
  3896. p1:=cnotnode.create(p1);
  3897. end;
  3898. _NIL :
  3899. begin
  3900. consume(_NIL);
  3901. p1:=cnilnode.create;
  3902. { It's really ugly code nil^, but delphi allows it }
  3903. if token in [_CARET,_POINT] then
  3904. begin
  3905. again:=true;
  3906. postfixoperators(p1,again,getaddr);
  3907. end;
  3908. end;
  3909. _OBJCPROTOCOL:
  3910. begin
  3911. { The @protocol keyword is used in two ways in Objective-C:
  3912. 1) to declare protocols (~ Object Pascal interfaces)
  3913. 2) to obtain the metaclass (~ Object Pascal) "class of")
  3914. of a declared protocol
  3915. This code is for handling the second case. Because of 1),
  3916. we cannot simply use a system unit symbol.
  3917. }
  3918. consume(_OBJCPROTOCOL);
  3919. consume(_LKLAMMER);
  3920. p1:=factor(false,[]);
  3921. consume(_RKLAMMER);
  3922. p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
  3923. end;
  3924. else
  3925. begin
  3926. Message(parser_e_illegal_expression);
  3927. p1:=cerrornode.create;
  3928. { recover }
  3929. consume(token);
  3930. end;
  3931. end;
  3932. end;
  3933. { generate error node if no node is created }
  3934. if not assigned(p1) then
  3935. begin
  3936. {$ifdef EXTDEBUG}
  3937. Comment(V_Warning,'factor: p1=nil');
  3938. {$endif}
  3939. p1:=cerrornode.create;
  3940. updatefpos:=true;
  3941. end;
  3942. { get the resultdef for the node if nothing stops us }
  3943. if (not assigned(p1.resultdef)) and dopostfix then
  3944. begin
  3945. do_typecheckpass_changed(p1,nodechanged);
  3946. updatefpos:=updatefpos or nodechanged;
  3947. end;
  3948. if assigned(p1) and
  3949. updatefpos then
  3950. p1.fileinfo:=filepos;
  3951. factor:=p1;
  3952. end;
  3953. {$maxfpuregisters default}
  3954. procedure post_comp_expr_gendef(var def: tdef);
  3955. var
  3956. p1 : tnode;
  3957. again : boolean;
  3958. begin
  3959. if not assigned(def) then
  3960. internalerror(2011053001);
  3961. again:=false;
  3962. { handle potential typecasts, etc }
  3963. p1:=handle_factor_typenode(def,false,again,nil,false);
  3964. { parse postfix operators }
  3965. postfixoperators(p1,again,false);
  3966. if assigned(p1) and (p1.nodetype=typen) then
  3967. def:=ttypenode(p1).typedef
  3968. else
  3969. def:=generrordef;
  3970. end;
  3971. {****************************************************************************
  3972. Sub_Expr
  3973. ****************************************************************************}
  3974. function sub_expr(pred_level:Toperator_precedence;flags:texprflags;factornode:tnode):tnode;
  3975. {Reads a subexpression while the operators are of the current precedence
  3976. level, or any higher level. Replaces the old term, simpl_expr and
  3977. simpl2_expr.}
  3978. function istypenode(n:tnode):boolean;inline;
  3979. { Checks whether the given node is a type node or a VMT node containing a
  3980. typenode. This is used in the code for inline specializations in the
  3981. _LT branch below }
  3982. begin
  3983. result:=assigned(n) and
  3984. (
  3985. (n.nodetype=typen) or
  3986. (
  3987. (n.nodetype=loadvmtaddrn) and
  3988. (tloadvmtaddrnode(n).left.nodetype=typen)
  3989. )
  3990. );
  3991. end;
  3992. function gettypedef(n:tnode):tdef;inline;
  3993. { This returns the typedef that belongs to the given typenode or
  3994. loadvmtaddrnode. n must not be Nil! }
  3995. begin
  3996. if n.nodetype=typen then
  3997. result:=ttypenode(n).typedef
  3998. else
  3999. result:=ttypenode(tloadvmtaddrnode(n).left).typedef;
  4000. end;
  4001. function gettypedef(sym:tsym):tdef;inline;
  4002. begin
  4003. result:=nil;
  4004. case sym.typ of
  4005. typesym:
  4006. result:=ttypesym(sym).typedef;
  4007. procsym:
  4008. result:=tdef(tprocsym(sym).procdeflist[0]);
  4009. else
  4010. internalerror(2015092701);
  4011. end;
  4012. end;
  4013. function getgenericsym(n:tnode;out srsym:tsym):boolean;
  4014. var
  4015. srsymtable : tsymtable;
  4016. begin
  4017. srsym:=nil;
  4018. case n.nodetype of
  4019. typen:
  4020. srsym:=ttypenode(n).typedef.typesym;
  4021. loadvmtaddrn:
  4022. srsym:=ttypenode(tloadvmtaddrnode(n).left).typedef.typesym;
  4023. loadn:
  4024. if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then
  4025. srsym:=nil;
  4026. specializen:
  4027. srsym:=tspecializenode(n).sym;
  4028. { TODO : handle const nodes }
  4029. else
  4030. ;
  4031. end;
  4032. result:=assigned(srsym);
  4033. end;
  4034. function generate_inline_specialization(gendef:tdef;n:tnode;filepos:tfileposinfo;parseddef:tdef;gensym:tsym;p2:tnode):tnode;
  4035. var
  4036. again,
  4037. getaddr : boolean;
  4038. pload : tnode;
  4039. spezcontext : tspecializationcontext;
  4040. structdef,
  4041. inheriteddef : tabstractrecorddef;
  4042. callflags : tcallnodeflags;
  4043. begin
  4044. if n.nodetype=specializen then
  4045. begin
  4046. getaddr:=tspecializenode(n).getaddr;
  4047. pload:=tspecializenode(n).left;
  4048. inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
  4049. tspecializenode(n).left:=nil;
  4050. end
  4051. else
  4052. begin
  4053. getaddr:=false;
  4054. pload:=nil;
  4055. inheriteddef:=nil;
  4056. end;
  4057. if assigned(parseddef) and assigned(gensym) and assigned(p2) then
  4058. gendef:=generate_specialization_phase1(spezcontext,gendef,parseddef,gensym.realname,p2.fileinfo)
  4059. else
  4060. gendef:=generate_specialization_phase1(spezcontext,gendef);
  4061. case gendef.typ of
  4062. errordef:
  4063. begin
  4064. spezcontext.free;
  4065. spezcontext:=nil;
  4066. gensym:=generrorsym;
  4067. end;
  4068. objectdef,
  4069. recorddef,
  4070. procvardef,
  4071. arraydef:
  4072. begin
  4073. gendef:=generate_specialization_phase2(spezcontext,tstoreddef(gendef),false,'');
  4074. spezcontext.free;
  4075. spezcontext:=nil;
  4076. if gendef.typ=errordef then
  4077. gensym:=generrorsym
  4078. else
  4079. gensym:=gendef.typesym;
  4080. end;
  4081. procdef:
  4082. begin
  4083. if block_type<>bt_body then
  4084. begin
  4085. message(parser_e_illegal_expression);
  4086. gensym:=generrorsym;
  4087. end
  4088. else
  4089. begin
  4090. gensym:=tprocdef(gendef).procsym;
  4091. end;
  4092. end;
  4093. else
  4094. internalerror(2015092702);
  4095. end;
  4096. { in case of a class or a record the specialized generic
  4097. is always a classrefdef }
  4098. again:=false;
  4099. if assigned(pload) then
  4100. begin
  4101. result:=pload;
  4102. typecheckpass(result);
  4103. structdef:=inheriteddef;
  4104. if not assigned(structdef) then
  4105. case result.resultdef.typ of
  4106. objectdef,
  4107. recorddef:
  4108. begin
  4109. structdef:=tabstractrecorddef(result.resultdef);
  4110. end;
  4111. classrefdef:
  4112. begin
  4113. structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
  4114. end;
  4115. else
  4116. internalerror(2015092703);
  4117. end;
  4118. if not (structdef.typ in [recorddef,objectdef]) then
  4119. internalerror(2018092101);
  4120. if assigned(inheriteddef) then
  4121. begin
  4122. callflags:=[cnf_inherited];
  4123. include(current_procinfo.flags,pi_has_inherited);
  4124. end
  4125. else
  4126. callflags:=[];
  4127. do_member_read(structdef,getaddr,gensym,result,again,callflags,spezcontext);
  4128. spezcontext:=nil;
  4129. end
  4130. else
  4131. begin
  4132. if gensym.typ=procsym then
  4133. begin
  4134. result:=nil;
  4135. { check if it's a method/class method }
  4136. if is_member_read(gensym,gensym.owner,result,parseddef) then
  4137. begin
  4138. { if we are accessing a owner procsym from the nested }
  4139. { class we need to call it as a class member }
  4140. if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
  4141. assigned(current_structdef) and (current_structdef<>parseddef) and is_owned_by(current_structdef,parseddef) then
  4142. result:=cloadvmtaddrnode.create(ctypenode.create(parseddef));
  4143. { not srsymtable.symtabletype since that can be }
  4144. { withsymtable as well }
  4145. if (gensym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
  4146. begin
  4147. do_member_read(tabstractrecorddef(parseddef),getaddr,gensym,result,again,[],spezcontext);
  4148. spezcontext:=nil;
  4149. end
  4150. else
  4151. { no procsyms in records (yet) }
  4152. internalerror(2015092704);
  4153. end
  4154. else
  4155. begin
  4156. { regular procedure/function call }
  4157. do_proc_call(gensym,gensym.owner,nil,
  4158. (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
  4159. again,result,[],spezcontext);
  4160. spezcontext:=nil;
  4161. end;
  4162. end
  4163. else
  4164. { handle potential typecasts, etc }
  4165. result:=handle_factor_typenode(gendef,false,again,nil,false);
  4166. end;
  4167. { parse postfix operators }
  4168. if postfixoperators(result,again,false) then
  4169. if assigned(result) then
  4170. result.fileinfo:=filepos
  4171. else
  4172. result:=cerrornode.create;
  4173. spezcontext.free;
  4174. end;
  4175. label
  4176. SubExprStart;
  4177. var
  4178. p1,p2,ptmp : tnode;
  4179. oldt : Ttoken;
  4180. filepos : tfileposinfo;
  4181. gendef,parseddef : tdef;
  4182. gensym : tsym;
  4183. begin
  4184. SubExprStart:
  4185. if pred_level=highest_precedence then
  4186. begin
  4187. if factornode=nil then
  4188. p1:=factor(false,flags)
  4189. else
  4190. p1:=factornode;
  4191. end
  4192. else
  4193. p1:=sub_expr(succ(pred_level),flags+[ef_accept_equal],factornode);
  4194. repeat
  4195. if (token in [NOTOKEN..last_operator]) and
  4196. (token in operator_levels[pred_level]) and
  4197. ((token<>_EQ) or (ef_accept_equal in flags)) then
  4198. begin
  4199. oldt:=token;
  4200. filepos:=current_tokenpos;
  4201. consume(token);
  4202. if pred_level=highest_precedence then
  4203. p2:=factor(false,[])
  4204. else
  4205. p2:=sub_expr(succ(pred_level),flags+[ef_accept_equal],nil);
  4206. case oldt of
  4207. _PLUS :
  4208. p1:=caddnode.create(addn,p1,p2);
  4209. _MINUS :
  4210. p1:=caddnode.create(subn,p1,p2);
  4211. _STAR :
  4212. p1:=caddnode.create(muln,p1,p2);
  4213. _SLASH :
  4214. p1:=caddnode.create(slashn,p1,p2);
  4215. _EQ:
  4216. p1:=caddnode.create(equaln,p1,p2);
  4217. _GT :
  4218. p1:=caddnode.create(gtn,p1,p2);
  4219. _LT :
  4220. begin
  4221. { we need to decice whether we have an inline specialization
  4222. (type nodes to the left and right of "<", mode Delphi and
  4223. ">" or "," following) or a normal "<" comparison }
  4224. { TODO : p1 could be a non type if e.g. a variable with the
  4225. same name is defined in the same unit where the
  4226. generic is defined (though "same unit" is not
  4227. necessarily needed) }
  4228. if getgenericsym(p1,gensym) and
  4229. { Attention: when nested specializations are supported
  4230. p2 could be a loadn if a "<" follows }
  4231. istypenode(p2) and
  4232. (m_delphi in current_settings.modeswitches) and
  4233. { TODO : add _LT, _LSHARPBRACKET for nested specializations }
  4234. (token in [_GT,_RSHARPBRACKET,_COMMA]) then
  4235. begin
  4236. { this is an inline specialization }
  4237. { retrieve the defs of two nodes }
  4238. if p1.nodetype=specializen then
  4239. gendef:=gettypedef(tspecializenode(p1).sym)
  4240. else
  4241. gendef:=nil;
  4242. parseddef:=gettypedef(p2);
  4243. { check the hints for parseddef }
  4244. check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg,p1.fileinfo);
  4245. ptmp:=generate_inline_specialization(gendef,p1,filepos,parseddef,gensym,p2);
  4246. { we don't need these nodes anymore }
  4247. p1.free;
  4248. p2.free;
  4249. p1:=ptmp;
  4250. { with p1 now set we are in reality directly behind the
  4251. call to "factor" thus we need to call down to that
  4252. again }
  4253. { This is disabled until specializations on the right
  4254. hand side work as well, because
  4255. "not working expressions" is better than "half working
  4256. expressions" }
  4257. {factornode:=p1;
  4258. goto SubExprStart;}
  4259. end
  4260. else
  4261. begin
  4262. { this is a normal "<" comparison }
  4263. { potential generic types that are followed by a "<": }
  4264. { a) might not have their resultdef set }
  4265. if not assigned(p1.resultdef) then
  4266. do_typecheckpass(p1);
  4267. { b) are not checked whether they are an undefined def,
  4268. but not a generic parameter }
  4269. if (p1.nodetype=typen) and
  4270. (ttypenode(p1).typedef.typ=undefineddef) and
  4271. assigned(ttypenode(p1).typedef.typesym) and
  4272. not (sp_generic_para in ttypenode(p1).typedef.typesym.symoptions) then
  4273. begin
  4274. identifier_not_found(ttypenode(p1).typedef.typesym.RealName);
  4275. p1.Free;
  4276. p1:=cerrornode.create;
  4277. end;
  4278. { c) don't have their hints checked }
  4279. if istypenode(p1) then
  4280. begin
  4281. gendef:=gettypedef(p1);
  4282. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  4283. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  4284. end;
  4285. { Note: the second part of the expression will be needed
  4286. for nested specializations }
  4287. if istypenode(p2) {and
  4288. not (token in [_LT, _LSHARPBRACKET])} then
  4289. begin
  4290. gendef:=gettypedef(p2);
  4291. if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then
  4292. check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg);
  4293. end;
  4294. { create the comparison node for "<" }
  4295. p1:=caddnode.create(ltn,p1,p2)
  4296. end;
  4297. end;
  4298. _GTE :
  4299. p1:=caddnode.create(gten,p1,p2);
  4300. _LTE :
  4301. p1:=caddnode.create(lten,p1,p2);
  4302. _SYMDIF :
  4303. p1:=caddnode.create(symdifn,p1,p2);
  4304. _STARSTAR :
  4305. p1:=caddnode.create(starstarn,p1,p2);
  4306. _OP_AS,
  4307. _OP_IS :
  4308. begin
  4309. if (m_delphi in current_settings.modeswitches) and
  4310. (token in [_LT, _LSHARPBRACKET]) and
  4311. getgenericsym(p2,gensym) then
  4312. begin
  4313. { for now we're handling this as a generic declaration;
  4314. there could be cases though (because of operator
  4315. overloading) where this is the wrong decision... }
  4316. if gensym.typ=typesym then
  4317. gendef:=ttypesym(gensym).typedef
  4318. else
  4319. if gensym.typ=procsym then
  4320. gendef:=tdef(tprocsym(gensym).procdeflist[0])
  4321. else
  4322. internalerror(2015072401);
  4323. ptmp:=generate_inline_specialization(gendef,p2,filepos,nil,nil,nil);
  4324. { we don't need the old p2 anymore }
  4325. p2.Free;
  4326. p2:=ptmp;
  4327. { here we don't need to call back down to "factor", thus
  4328. no "goto" }
  4329. end;
  4330. { now generate the "is" or "as" node }
  4331. case oldt of
  4332. _OP_AS:
  4333. p1:=casnode.create(p1,p2);
  4334. _OP_IS:
  4335. p1:=cisnode.create(p1,p2);
  4336. else
  4337. internalerror(2019050528);
  4338. end;
  4339. end;
  4340. _OP_IN :
  4341. p1:=cinnode.create(p1,p2);
  4342. _OP_OR,
  4343. _PIPE {macpas only} :
  4344. begin
  4345. p1:=caddnode.create(orn,p1,p2);
  4346. if (oldt = _PIPE) then
  4347. include(p1.flags,nf_short_bool);
  4348. end;
  4349. _OP_AND,
  4350. _AMPERSAND {macpas only} :
  4351. begin
  4352. p1:=caddnode.create(andn,p1,p2);
  4353. if (oldt = _AMPERSAND) then
  4354. include(p1.flags,nf_short_bool);
  4355. end;
  4356. _OP_DIV :
  4357. p1:=cmoddivnode.create(divn,p1,p2);
  4358. _OP_NOT :
  4359. p1:=cnotnode.create(p1);
  4360. _OP_MOD :
  4361. begin
  4362. p1:=cmoddivnode.create(modn,p1,p2);
  4363. if m_isolike_mod in current_settings.modeswitches then
  4364. include(p1.flags,nf_isomod);
  4365. end;
  4366. _OP_SHL :
  4367. p1:=cshlshrnode.create(shln,p1,p2);
  4368. _OP_SHR :
  4369. p1:=cshlshrnode.create(shrn,p1,p2);
  4370. _OP_XOR :
  4371. p1:=caddnode.create(xorn,p1,p2);
  4372. _ASSIGNMENT :
  4373. p1:=cassignmentnode.create(p1,p2);
  4374. _NE :
  4375. p1:=caddnode.create(unequaln,p1,p2);
  4376. else
  4377. internalerror(2019050529);
  4378. end;
  4379. p1.fileinfo:=filepos;
  4380. end
  4381. else
  4382. break;
  4383. until false;
  4384. sub_expr:=p1;
  4385. end;
  4386. function comp_expr(flags:texprflags):tnode;
  4387. var
  4388. oldafterassignment : boolean;
  4389. p1 : tnode;
  4390. begin
  4391. oldafterassignment:=afterassignment;
  4392. afterassignment:=true;
  4393. p1:=sub_expr(opcompare,flags,nil);
  4394. { get the resultdef for this expression }
  4395. if not assigned(p1.resultdef) then
  4396. do_typecheckpass(p1);
  4397. afterassignment:=oldafterassignment;
  4398. comp_expr:=p1;
  4399. end;
  4400. function expr(dotypecheck : boolean) : tnode;
  4401. var
  4402. p1,p2 : tnode;
  4403. filepos : tfileposinfo;
  4404. oldafterassignment,
  4405. updatefpos : boolean;
  4406. oldflags : tnodeflags;
  4407. begin
  4408. oldafterassignment:=afterassignment;
  4409. p1:=sub_expr(opcompare,[ef_accept_equal],nil);
  4410. { get the resultdef for this expression }
  4411. if not assigned(p1.resultdef) and
  4412. dotypecheck then
  4413. do_typecheckpass(p1);
  4414. filepos:=current_tokenpos;
  4415. if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
  4416. afterassignment:=true;
  4417. updatefpos:=true;
  4418. case token of
  4419. _POINTPOINT :
  4420. begin
  4421. consume(_POINTPOINT);
  4422. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4423. p1:=crangenode.create(p1,p2);
  4424. end;
  4425. _ASSIGNMENT :
  4426. begin
  4427. consume(_ASSIGNMENT);
  4428. if assigned(p1.resultdef) and (p1.resultdef.typ=procvardef) then
  4429. getprocvardef:=tprocvardef(p1.resultdef);
  4430. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4431. if assigned(getprocvardef) then
  4432. handle_procvar(getprocvardef,p2);
  4433. getprocvardef:=nil;
  4434. p1:=cassignmentnode.create(p1,p2);
  4435. end;
  4436. _PLUSASN :
  4437. begin
  4438. consume(_PLUSASN);
  4439. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4440. p1:=gen_c_style_operator(addn,p1,p2);
  4441. end;
  4442. _MINUSASN :
  4443. begin
  4444. consume(_MINUSASN);
  4445. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4446. p1:=gen_c_style_operator(subn,p1,p2);
  4447. end;
  4448. _STARASN :
  4449. begin
  4450. consume(_STARASN );
  4451. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4452. p1:=gen_c_style_operator(muln,p1,p2);
  4453. end;
  4454. _SLASHASN :
  4455. begin
  4456. consume(_SLASHASN );
  4457. p2:=sub_expr(opcompare,[ef_accept_equal],nil);
  4458. p1:=gen_c_style_operator(slashn,p1,p2);
  4459. end;
  4460. else
  4461. updatefpos:=false;
  4462. end;
  4463. oldflags:=p1.flags;
  4464. { get the resultdef for this expression }
  4465. if not assigned(p1.resultdef) and
  4466. dotypecheck then
  4467. do_typecheckpass(p1);
  4468. { transfer generic paramter flag }
  4469. if nf_generic_para in oldflags then
  4470. include(p1.flags,nf_generic_para);
  4471. afterassignment:=oldafterassignment;
  4472. if updatefpos then
  4473. p1.fileinfo:=filepos;
  4474. expr:=p1;
  4475. end;
  4476. function get_intconst:TConstExprInt;
  4477. {Reads an expression, tries to evalute it and check if it is an integer
  4478. constant. Then the constant is returned.}
  4479. var
  4480. p:tnode;
  4481. begin
  4482. result:=0;
  4483. p:=comp_expr([ef_accept_equal]);
  4484. if not codegenerror then
  4485. begin
  4486. if (p.nodetype<>ordconstn) or
  4487. not(is_integer(p.resultdef)) then
  4488. Message(parser_e_illegal_expression)
  4489. else
  4490. result:=tordconstnode(p).value;
  4491. end;
  4492. p.free;
  4493. end;
  4494. function get_stringconst:string;
  4495. {Reads an expression, tries to evaluate it and checks if it is a string
  4496. constant. Then the constant is returned.}
  4497. var
  4498. p:tnode;
  4499. begin
  4500. get_stringconst:='';
  4501. p:=comp_expr([ef_accept_equal]);
  4502. if p.nodetype<>stringconstn then
  4503. begin
  4504. if (p.nodetype=ordconstn) and is_char(p.resultdef) then
  4505. get_stringconst:=char(int64(tordconstnode(p).value))
  4506. else
  4507. Message(parser_e_illegal_expression);
  4508. end
  4509. else
  4510. get_stringconst:=strpas(tstringconstnode(p).value_str);
  4511. p.free;
  4512. end;
  4513. end.