pasresolver.pp 973 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075140761407714078140791408014081140821408314084140851408614087140881408914090140911409214093140941409514096140971409814099141001410114102141031410414105141061410714108141091411014111141121411314114141151411614117141181411914120141211412214123141241412514126141271412814129141301413114132141331413414135141361413714138141391414014141141421414314144141451414614147141481414914150141511415214153141541415514156141571415814159141601416114162141631416414165141661416714168141691417014171141721417314174141751417614177141781417914180141811418214183141841418514186141871418814189141901419114192141931419414195141961419714198141991420014201142021420314204142051420614207142081420914210142111421214213142141421514216142171421814219142201422114222142231422414225142261422714228142291423014231142321423314234142351423614237142381423914240142411424214243142441424514246142471424814249142501425114252142531425414255142561425714258142591426014261142621426314264142651426614267142681426914270142711427214273142741427514276142771427814279142801428114282142831428414285142861428714288142891429014291142921429314294142951429614297142981429914300143011430214303143041430514306143071430814309143101431114312143131431414315143161431714318143191432014321143221432314324143251432614327143281432914330143311433214333143341433514336143371433814339143401434114342143431434414345143461434714348143491435014351143521435314354143551435614357143581435914360143611436214363143641436514366143671436814369143701437114372143731437414375143761437714378143791438014381143821438314384143851438614387143881438914390143911439214393143941439514396143971439814399144001440114402144031440414405144061440714408144091441014411144121441314414144151441614417144181441914420144211442214423144241442514426144271442814429144301443114432144331443414435144361443714438144391444014441144421444314444144451444614447144481444914450144511445214453144541445514456144571445814459144601446114462144631446414465144661446714468144691447014471144721447314474144751447614477144781447914480144811448214483144841448514486144871448814489144901449114492144931449414495144961449714498144991450014501145021450314504145051450614507145081450914510145111451214513145141451514516145171451814519145201452114522145231452414525145261452714528145291453014531145321453314534145351453614537145381453914540145411454214543145441454514546145471454814549145501455114552145531455414555145561455714558145591456014561145621456314564145651456614567145681456914570145711457214573145741457514576145771457814579145801458114582145831458414585145861458714588145891459014591145921459314594145951459614597145981459914600146011460214603146041460514606146071460814609146101461114612146131461414615146161461714618146191462014621146221462314624146251462614627146281462914630146311463214633146341463514636146371463814639146401464114642146431464414645146461464714648146491465014651146521465314654146551465614657146581465914660146611466214663146641466514666146671466814669146701467114672146731467414675146761467714678146791468014681146821468314684146851468614687146881468914690146911469214693146941469514696146971469814699147001470114702147031470414705147061470714708147091471014711147121471314714147151471614717147181471914720147211472214723147241472514726147271472814729147301473114732147331473414735147361473714738147391474014741147421474314744147451474614747147481474914750147511475214753147541475514756147571475814759147601476114762147631476414765147661476714768147691477014771147721477314774147751477614777147781477914780147811478214783147841478514786147871478814789147901479114792147931479414795147961479714798147991480014801148021480314804148051480614807148081480914810148111481214813148141481514816148171481814819148201482114822148231482414825148261482714828148291483014831148321483314834148351483614837148381483914840148411484214843148441484514846148471484814849148501485114852148531485414855148561485714858148591486014861148621486314864148651486614867148681486914870148711487214873148741487514876148771487814879148801488114882148831488414885148861488714888148891489014891148921489314894148951489614897148981489914900149011490214903149041490514906149071490814909149101491114912149131491414915149161491714918149191492014921149221492314924149251492614927149281492914930149311493214933149341493514936149371493814939149401494114942149431494414945149461494714948149491495014951149521495314954149551495614957149581495914960149611496214963149641496514966149671496814969149701497114972149731497414975149761497714978149791498014981149821498314984149851498614987149881498914990149911499214993149941499514996149971499814999150001500115002150031500415005150061500715008150091501015011150121501315014150151501615017150181501915020150211502215023150241502515026150271502815029150301503115032150331503415035150361503715038150391504015041150421504315044150451504615047150481504915050150511505215053150541505515056150571505815059150601506115062150631506415065150661506715068150691507015071150721507315074150751507615077150781507915080150811508215083150841508515086150871508815089150901509115092150931509415095150961509715098150991510015101151021510315104151051510615107151081510915110151111511215113151141511515116151171511815119151201512115122151231512415125151261512715128151291513015131151321513315134151351513615137151381513915140151411514215143151441514515146151471514815149151501515115152151531515415155151561515715158151591516015161151621516315164151651516615167151681516915170151711517215173151741517515176151771517815179151801518115182151831518415185151861518715188151891519015191151921519315194151951519615197151981519915200152011520215203152041520515206152071520815209152101521115212152131521415215152161521715218152191522015221152221522315224152251522615227152281522915230152311523215233152341523515236152371523815239152401524115242152431524415245152461524715248152491525015251152521525315254152551525615257152581525915260152611526215263152641526515266152671526815269152701527115272152731527415275152761527715278152791528015281152821528315284152851528615287152881528915290152911529215293152941529515296152971529815299153001530115302153031530415305153061530715308153091531015311153121531315314153151531615317153181531915320153211532215323153241532515326153271532815329153301533115332153331533415335153361533715338153391534015341153421534315344153451534615347153481534915350153511535215353153541535515356153571535815359153601536115362153631536415365153661536715368153691537015371153721537315374153751537615377153781537915380153811538215383153841538515386153871538815389153901539115392153931539415395153961539715398153991540015401154021540315404154051540615407154081540915410154111541215413154141541515416154171541815419154201542115422154231542415425154261542715428154291543015431154321543315434154351543615437154381543915440154411544215443154441544515446154471544815449154501545115452154531545415455154561545715458154591546015461154621546315464154651546615467154681546915470154711547215473154741547515476154771547815479154801548115482154831548415485154861548715488154891549015491154921549315494154951549615497154981549915500155011550215503155041550515506155071550815509155101551115512155131551415515155161551715518155191552015521155221552315524155251552615527155281552915530155311553215533155341553515536155371553815539155401554115542155431554415545155461554715548155491555015551155521555315554155551555615557155581555915560155611556215563155641556515566155671556815569155701557115572155731557415575155761557715578155791558015581155821558315584155851558615587155881558915590155911559215593155941559515596155971559815599156001560115602156031560415605156061560715608156091561015611156121561315614156151561615617156181561915620156211562215623156241562515626156271562815629156301563115632156331563415635156361563715638156391564015641156421564315644156451564615647156481564915650156511565215653156541565515656156571565815659156601566115662156631566415665156661566715668156691567015671156721567315674156751567615677156781567915680156811568215683156841568515686156871568815689156901569115692156931569415695156961569715698156991570015701157021570315704157051570615707157081570915710157111571215713157141571515716157171571815719157201572115722157231572415725157261572715728157291573015731157321573315734157351573615737157381573915740157411574215743157441574515746157471574815749157501575115752157531575415755157561575715758157591576015761157621576315764157651576615767157681576915770157711577215773157741577515776157771577815779157801578115782157831578415785157861578715788157891579015791157921579315794157951579615797157981579915800158011580215803158041580515806158071580815809158101581115812158131581415815158161581715818158191582015821158221582315824158251582615827158281582915830158311583215833158341583515836158371583815839158401584115842158431584415845158461584715848158491585015851158521585315854158551585615857158581585915860158611586215863158641586515866158671586815869158701587115872158731587415875158761587715878158791588015881158821588315884158851588615887158881588915890158911589215893158941589515896158971589815899159001590115902159031590415905159061590715908159091591015911159121591315914159151591615917159181591915920159211592215923159241592515926159271592815929159301593115932159331593415935159361593715938159391594015941159421594315944159451594615947159481594915950159511595215953159541595515956159571595815959159601596115962159631596415965159661596715968159691597015971159721597315974159751597615977159781597915980159811598215983159841598515986159871598815989159901599115992159931599415995159961599715998159991600016001160021600316004160051600616007160081600916010160111601216013160141601516016160171601816019160201602116022160231602416025160261602716028160291603016031160321603316034160351603616037160381603916040160411604216043160441604516046160471604816049160501605116052160531605416055160561605716058160591606016061160621606316064160651606616067160681606916070160711607216073160741607516076160771607816079160801608116082160831608416085160861608716088160891609016091160921609316094160951609616097160981609916100161011610216103161041610516106161071610816109161101611116112161131611416115161161611716118161191612016121161221612316124161251612616127161281612916130161311613216133161341613516136161371613816139161401614116142161431614416145161461614716148161491615016151161521615316154161551615616157161581615916160161611616216163161641616516166161671616816169161701617116172161731617416175161761617716178161791618016181161821618316184161851618616187161881618916190161911619216193161941619516196161971619816199162001620116202162031620416205162061620716208162091621016211162121621316214162151621616217162181621916220162211622216223162241622516226162271622816229162301623116232162331623416235162361623716238162391624016241162421624316244162451624616247162481624916250162511625216253162541625516256162571625816259162601626116262162631626416265162661626716268162691627016271162721627316274162751627616277162781627916280162811628216283162841628516286162871628816289162901629116292162931629416295162961629716298162991630016301163021630316304163051630616307163081630916310163111631216313163141631516316163171631816319163201632116322163231632416325163261632716328163291633016331163321633316334163351633616337163381633916340163411634216343163441634516346163471634816349163501635116352163531635416355163561635716358163591636016361163621636316364163651636616367163681636916370163711637216373163741637516376163771637816379163801638116382163831638416385163861638716388163891639016391163921639316394163951639616397163981639916400164011640216403164041640516406164071640816409164101641116412164131641416415164161641716418164191642016421164221642316424164251642616427164281642916430164311643216433164341643516436164371643816439164401644116442164431644416445164461644716448164491645016451164521645316454164551645616457164581645916460164611646216463164641646516466164671646816469164701647116472164731647416475164761647716478164791648016481164821648316484164851648616487164881648916490164911649216493164941649516496164971649816499165001650116502165031650416505165061650716508165091651016511165121651316514165151651616517165181651916520165211652216523165241652516526165271652816529165301653116532165331653416535165361653716538165391654016541165421654316544165451654616547165481654916550165511655216553165541655516556165571655816559165601656116562165631656416565165661656716568165691657016571165721657316574165751657616577165781657916580165811658216583165841658516586165871658816589165901659116592165931659416595165961659716598165991660016601166021660316604166051660616607166081660916610166111661216613166141661516616166171661816619166201662116622166231662416625166261662716628166291663016631166321663316634166351663616637166381663916640166411664216643166441664516646166471664816649166501665116652166531665416655166561665716658166591666016661166621666316664166651666616667166681666916670166711667216673166741667516676166771667816679166801668116682166831668416685166861668716688166891669016691166921669316694166951669616697166981669916700167011670216703167041670516706167071670816709167101671116712167131671416715167161671716718167191672016721167221672316724167251672616727167281672916730167311673216733167341673516736167371673816739167401674116742167431674416745167461674716748167491675016751167521675316754167551675616757167581675916760167611676216763167641676516766167671676816769167701677116772167731677416775167761677716778167791678016781167821678316784167851678616787167881678916790167911679216793167941679516796167971679816799168001680116802168031680416805168061680716808168091681016811168121681316814168151681616817168181681916820168211682216823168241682516826168271682816829168301683116832168331683416835168361683716838168391684016841168421684316844168451684616847168481684916850168511685216853168541685516856168571685816859168601686116862168631686416865168661686716868168691687016871168721687316874168751687616877168781687916880168811688216883168841688516886168871688816889168901689116892168931689416895168961689716898168991690016901169021690316904169051690616907169081690916910169111691216913169141691516916169171691816919169201692116922169231692416925169261692716928169291693016931169321693316934169351693616937169381693916940169411694216943169441694516946169471694816949169501695116952169531695416955169561695716958169591696016961169621696316964169651696616967169681696916970169711697216973169741697516976169771697816979169801698116982169831698416985169861698716988169891699016991169921699316994169951699616997169981699917000170011700217003170041700517006170071700817009170101701117012170131701417015170161701717018170191702017021170221702317024170251702617027170281702917030170311703217033170341703517036170371703817039170401704117042170431704417045170461704717048170491705017051170521705317054170551705617057170581705917060170611706217063170641706517066170671706817069170701707117072170731707417075170761707717078170791708017081170821708317084170851708617087170881708917090170911709217093170941709517096170971709817099171001710117102171031710417105171061710717108171091711017111171121711317114171151711617117171181711917120171211712217123171241712517126171271712817129171301713117132171331713417135171361713717138171391714017141171421714317144171451714617147171481714917150171511715217153171541715517156171571715817159171601716117162171631716417165171661716717168171691717017171171721717317174171751717617177171781717917180171811718217183171841718517186171871718817189171901719117192171931719417195171961719717198171991720017201172021720317204172051720617207172081720917210172111721217213172141721517216172171721817219172201722117222172231722417225172261722717228172291723017231172321723317234172351723617237172381723917240172411724217243172441724517246172471724817249172501725117252172531725417255172561725717258172591726017261172621726317264172651726617267172681726917270172711727217273172741727517276172771727817279172801728117282172831728417285172861728717288172891729017291172921729317294172951729617297172981729917300173011730217303173041730517306173071730817309173101731117312173131731417315173161731717318173191732017321173221732317324173251732617327173281732917330173311733217333173341733517336173371733817339173401734117342173431734417345173461734717348173491735017351173521735317354173551735617357173581735917360173611736217363173641736517366173671736817369173701737117372173731737417375173761737717378173791738017381173821738317384173851738617387173881738917390173911739217393173941739517396173971739817399174001740117402174031740417405174061740717408174091741017411174121741317414174151741617417174181741917420174211742217423174241742517426174271742817429174301743117432174331743417435174361743717438174391744017441174421744317444174451744617447174481744917450174511745217453174541745517456174571745817459174601746117462174631746417465174661746717468174691747017471174721747317474174751747617477174781747917480174811748217483174841748517486174871748817489174901749117492174931749417495174961749717498174991750017501175021750317504175051750617507175081750917510175111751217513175141751517516175171751817519175201752117522175231752417525175261752717528175291753017531175321753317534175351753617537175381753917540175411754217543175441754517546175471754817549175501755117552175531755417555175561755717558175591756017561175621756317564175651756617567175681756917570175711757217573175741757517576175771757817579175801758117582175831758417585175861758717588175891759017591175921759317594175951759617597175981759917600176011760217603176041760517606176071760817609176101761117612176131761417615176161761717618176191762017621176221762317624176251762617627176281762917630176311763217633176341763517636176371763817639176401764117642176431764417645176461764717648176491765017651176521765317654176551765617657176581765917660176611766217663176641766517666176671766817669176701767117672176731767417675176761767717678176791768017681176821768317684176851768617687176881768917690176911769217693176941769517696176971769817699177001770117702177031770417705177061770717708177091771017711177121771317714177151771617717177181771917720177211772217723177241772517726177271772817729177301773117732177331773417735177361773717738177391774017741177421774317744177451774617747177481774917750177511775217753177541775517756177571775817759177601776117762177631776417765177661776717768177691777017771177721777317774177751777617777177781777917780177811778217783177841778517786177871778817789177901779117792177931779417795177961779717798177991780017801178021780317804178051780617807178081780917810178111781217813178141781517816178171781817819178201782117822178231782417825178261782717828178291783017831178321783317834178351783617837178381783917840178411784217843178441784517846178471784817849178501785117852178531785417855178561785717858178591786017861178621786317864178651786617867178681786917870178711787217873178741787517876178771787817879178801788117882178831788417885178861788717888178891789017891178921789317894178951789617897178981789917900179011790217903179041790517906179071790817909179101791117912179131791417915179161791717918179191792017921179221792317924179251792617927179281792917930179311793217933179341793517936179371793817939179401794117942179431794417945179461794717948179491795017951179521795317954179551795617957179581795917960179611796217963179641796517966179671796817969179701797117972179731797417975179761797717978179791798017981179821798317984179851798617987179881798917990179911799217993179941799517996179971799817999180001800118002180031800418005180061800718008180091801018011180121801318014180151801618017180181801918020180211802218023180241802518026180271802818029180301803118032180331803418035180361803718038180391804018041180421804318044180451804618047180481804918050180511805218053180541805518056180571805818059180601806118062180631806418065180661806718068180691807018071180721807318074180751807618077180781807918080180811808218083180841808518086180871808818089180901809118092180931809418095180961809718098180991810018101181021810318104181051810618107181081810918110181111811218113181141811518116181171811818119181201812118122181231812418125181261812718128181291813018131181321813318134181351813618137181381813918140181411814218143181441814518146181471814818149181501815118152181531815418155181561815718158181591816018161181621816318164181651816618167181681816918170181711817218173181741817518176181771817818179181801818118182181831818418185181861818718188181891819018191181921819318194181951819618197181981819918200182011820218203182041820518206182071820818209182101821118212182131821418215182161821718218182191822018221182221822318224182251822618227182281822918230182311823218233182341823518236182371823818239182401824118242182431824418245182461824718248182491825018251182521825318254182551825618257182581825918260182611826218263182641826518266182671826818269182701827118272182731827418275182761827718278182791828018281182821828318284182851828618287182881828918290182911829218293182941829518296182971829818299183001830118302183031830418305183061830718308183091831018311183121831318314183151831618317183181831918320183211832218323183241832518326183271832818329183301833118332183331833418335183361833718338183391834018341183421834318344183451834618347183481834918350183511835218353183541835518356183571835818359183601836118362183631836418365183661836718368183691837018371183721837318374183751837618377183781837918380183811838218383183841838518386183871838818389183901839118392183931839418395183961839718398183991840018401184021840318404184051840618407184081840918410184111841218413184141841518416184171841818419184201842118422184231842418425184261842718428184291843018431184321843318434184351843618437184381843918440184411844218443184441844518446184471844818449184501845118452184531845418455184561845718458184591846018461184621846318464184651846618467184681846918470184711847218473184741847518476184771847818479184801848118482184831848418485184861848718488184891849018491184921849318494184951849618497184981849918500185011850218503185041850518506185071850818509185101851118512185131851418515185161851718518185191852018521185221852318524185251852618527185281852918530185311853218533185341853518536185371853818539185401854118542185431854418545185461854718548185491855018551185521855318554185551855618557185581855918560185611856218563185641856518566185671856818569185701857118572185731857418575185761857718578185791858018581185821858318584185851858618587185881858918590185911859218593185941859518596185971859818599186001860118602186031860418605186061860718608186091861018611186121861318614186151861618617186181861918620186211862218623186241862518626186271862818629186301863118632186331863418635186361863718638186391864018641186421864318644186451864618647186481864918650186511865218653186541865518656186571865818659186601866118662186631866418665186661866718668186691867018671186721867318674186751867618677186781867918680186811868218683186841868518686186871868818689186901869118692186931869418695186961869718698186991870018701187021870318704187051870618707187081870918710187111871218713187141871518716187171871818719187201872118722187231872418725187261872718728187291873018731187321873318734187351873618737187381873918740187411874218743187441874518746187471874818749187501875118752187531875418755187561875718758187591876018761187621876318764187651876618767187681876918770187711877218773187741877518776187771877818779187801878118782187831878418785187861878718788187891879018791187921879318794187951879618797187981879918800188011880218803188041880518806188071880818809188101881118812188131881418815188161881718818188191882018821188221882318824188251882618827188281882918830188311883218833188341883518836188371883818839188401884118842188431884418845188461884718848188491885018851188521885318854188551885618857188581885918860188611886218863188641886518866188671886818869188701887118872188731887418875188761887718878188791888018881188821888318884188851888618887188881888918890188911889218893188941889518896188971889818899189001890118902189031890418905189061890718908189091891018911189121891318914189151891618917189181891918920189211892218923189241892518926189271892818929189301893118932189331893418935189361893718938189391894018941189421894318944189451894618947189481894918950189511895218953189541895518956189571895818959189601896118962189631896418965189661896718968189691897018971189721897318974189751897618977189781897918980189811898218983189841898518986189871898818989189901899118992189931899418995189961899718998189991900019001190021900319004190051900619007190081900919010190111901219013190141901519016190171901819019190201902119022190231902419025190261902719028190291903019031190321903319034190351903619037190381903919040190411904219043190441904519046190471904819049190501905119052190531905419055190561905719058190591906019061190621906319064190651906619067190681906919070190711907219073190741907519076190771907819079190801908119082190831908419085190861908719088190891909019091190921909319094190951909619097190981909919100191011910219103191041910519106191071910819109191101911119112191131911419115191161911719118191191912019121191221912319124191251912619127191281912919130191311913219133191341913519136191371913819139191401914119142191431914419145191461914719148191491915019151191521915319154191551915619157191581915919160191611916219163191641916519166191671916819169191701917119172191731917419175191761917719178191791918019181191821918319184191851918619187191881918919190191911919219193191941919519196191971919819199192001920119202192031920419205192061920719208192091921019211192121921319214192151921619217192181921919220192211922219223192241922519226192271922819229192301923119232192331923419235192361923719238192391924019241192421924319244192451924619247192481924919250192511925219253192541925519256192571925819259192601926119262192631926419265192661926719268192691927019271192721927319274192751927619277192781927919280192811928219283192841928519286192871928819289192901929119292192931929419295192961929719298192991930019301193021930319304193051930619307193081930919310193111931219313193141931519316193171931819319193201932119322193231932419325193261932719328193291933019331193321933319334193351933619337193381933919340193411934219343193441934519346193471934819349193501935119352193531935419355193561935719358193591936019361193621936319364193651936619367193681936919370193711937219373193741937519376193771937819379193801938119382193831938419385193861938719388193891939019391193921939319394193951939619397193981939919400194011940219403194041940519406194071940819409194101941119412194131941419415194161941719418194191942019421194221942319424194251942619427194281942919430194311943219433194341943519436194371943819439194401944119442194431944419445194461944719448194491945019451194521945319454194551945619457194581945919460194611946219463194641946519466194671946819469194701947119472194731947419475194761947719478194791948019481194821948319484194851948619487194881948919490194911949219493194941949519496194971949819499195001950119502195031950419505195061950719508195091951019511195121951319514195151951619517195181951919520195211952219523195241952519526195271952819529195301953119532195331953419535195361953719538195391954019541195421954319544195451954619547195481954919550195511955219553195541955519556195571955819559195601956119562195631956419565195661956719568195691957019571195721957319574195751957619577195781957919580195811958219583195841958519586195871958819589195901959119592195931959419595195961959719598195991960019601196021960319604196051960619607196081960919610196111961219613196141961519616196171961819619196201962119622196231962419625196261962719628196291963019631196321963319634196351963619637196381963919640196411964219643196441964519646196471964819649196501965119652196531965419655196561965719658196591966019661196621966319664196651966619667196681966919670196711967219673196741967519676196771967819679196801968119682196831968419685196861968719688196891969019691196921969319694196951969619697196981969919700197011970219703197041970519706197071970819709197101971119712197131971419715197161971719718197191972019721197221972319724197251972619727197281972919730197311973219733197341973519736197371973819739197401974119742197431974419745197461974719748197491975019751197521975319754197551975619757197581975919760197611976219763197641976519766197671976819769197701977119772197731977419775197761977719778197791978019781197821978319784197851978619787197881978919790197911979219793197941979519796197971979819799198001980119802198031980419805198061980719808198091981019811198121981319814198151981619817198181981919820198211982219823198241982519826198271982819829198301983119832198331983419835198361983719838198391984019841198421984319844198451984619847198481984919850198511985219853198541985519856198571985819859198601986119862198631986419865198661986719868198691987019871198721987319874198751987619877198781987919880198811988219883198841988519886198871988819889198901989119892198931989419895198961989719898198991990019901199021990319904199051990619907199081990919910199111991219913199141991519916199171991819919199201992119922199231992419925199261992719928199291993019931199321993319934199351993619937199381993919940199411994219943199441994519946199471994819949199501995119952199531995419955199561995719958199591996019961199621996319964199651996619967199681996919970199711997219973199741997519976199771997819979199801998119982199831998419985199861998719988199891999019991199921999319994199951999619997199981999920000200012000220003200042000520006200072000820009200102001120012200132001420015200162001720018200192002020021200222002320024200252002620027200282002920030200312003220033200342003520036200372003820039200402004120042200432004420045200462004720048200492005020051200522005320054200552005620057200582005920060200612006220063200642006520066200672006820069200702007120072200732007420075200762007720078200792008020081200822008320084200852008620087200882008920090200912009220093200942009520096200972009820099201002010120102201032010420105201062010720108201092011020111201122011320114201152011620117201182011920120201212012220123201242012520126201272012820129201302013120132201332013420135201362013720138201392014020141201422014320144201452014620147201482014920150201512015220153201542015520156201572015820159201602016120162201632016420165201662016720168201692017020171201722017320174201752017620177201782017920180201812018220183201842018520186201872018820189201902019120192201932019420195201962019720198201992020020201202022020320204202052020620207202082020920210202112021220213202142021520216202172021820219202202022120222202232022420225202262022720228202292023020231202322023320234202352023620237202382023920240202412024220243202442024520246202472024820249202502025120252202532025420255202562025720258202592026020261202622026320264202652026620267202682026920270202712027220273202742027520276202772027820279202802028120282202832028420285202862028720288202892029020291202922029320294202952029620297202982029920300203012030220303203042030520306203072030820309203102031120312203132031420315203162031720318203192032020321203222032320324203252032620327203282032920330203312033220333203342033520336203372033820339203402034120342203432034420345203462034720348203492035020351203522035320354203552035620357203582035920360203612036220363203642036520366203672036820369203702037120372203732037420375203762037720378203792038020381203822038320384203852038620387203882038920390203912039220393203942039520396203972039820399204002040120402204032040420405204062040720408204092041020411204122041320414204152041620417204182041920420204212042220423204242042520426204272042820429204302043120432204332043420435204362043720438204392044020441204422044320444204452044620447204482044920450204512045220453204542045520456204572045820459204602046120462204632046420465204662046720468204692047020471204722047320474204752047620477204782047920480204812048220483204842048520486204872048820489204902049120492204932049420495204962049720498204992050020501205022050320504205052050620507205082050920510205112051220513205142051520516205172051820519205202052120522205232052420525205262052720528205292053020531205322053320534205352053620537205382053920540205412054220543205442054520546205472054820549205502055120552205532055420555205562055720558205592056020561205622056320564205652056620567205682056920570205712057220573205742057520576205772057820579205802058120582205832058420585205862058720588205892059020591205922059320594205952059620597205982059920600206012060220603206042060520606206072060820609206102061120612206132061420615206162061720618206192062020621206222062320624206252062620627206282062920630206312063220633206342063520636206372063820639206402064120642206432064420645206462064720648206492065020651206522065320654206552065620657206582065920660206612066220663206642066520666206672066820669206702067120672206732067420675206762067720678206792068020681206822068320684206852068620687206882068920690206912069220693206942069520696206972069820699207002070120702207032070420705207062070720708207092071020711207122071320714207152071620717207182071920720207212072220723207242072520726207272072820729207302073120732207332073420735207362073720738207392074020741207422074320744207452074620747207482074920750207512075220753207542075520756207572075820759207602076120762207632076420765207662076720768207692077020771207722077320774207752077620777207782077920780207812078220783207842078520786207872078820789207902079120792207932079420795207962079720798207992080020801208022080320804208052080620807208082080920810208112081220813208142081520816208172081820819208202082120822208232082420825208262082720828208292083020831208322083320834208352083620837208382083920840208412084220843208442084520846208472084820849208502085120852208532085420855208562085720858208592086020861208622086320864208652086620867208682086920870208712087220873208742087520876208772087820879208802088120882208832088420885208862088720888208892089020891208922089320894208952089620897208982089920900209012090220903209042090520906209072090820909209102091120912209132091420915209162091720918209192092020921209222092320924209252092620927209282092920930209312093220933209342093520936209372093820939209402094120942209432094420945209462094720948209492095020951209522095320954209552095620957209582095920960209612096220963209642096520966209672096820969209702097120972209732097420975209762097720978209792098020981209822098320984209852098620987209882098920990209912099220993209942099520996209972099820999210002100121002210032100421005210062100721008210092101021011210122101321014210152101621017210182101921020210212102221023210242102521026210272102821029210302103121032210332103421035210362103721038210392104021041210422104321044210452104621047210482104921050210512105221053210542105521056210572105821059210602106121062210632106421065210662106721068210692107021071210722107321074210752107621077210782107921080210812108221083210842108521086210872108821089210902109121092210932109421095210962109721098210992110021101211022110321104211052110621107211082110921110211112111221113211142111521116211172111821119211202112121122211232112421125211262112721128211292113021131211322113321134211352113621137211382113921140211412114221143211442114521146211472114821149211502115121152211532115421155211562115721158211592116021161211622116321164211652116621167211682116921170211712117221173211742117521176211772117821179211802118121182211832118421185211862118721188211892119021191211922119321194211952119621197211982119921200212012120221203212042120521206212072120821209212102121121212212132121421215212162121721218212192122021221212222122321224212252122621227212282122921230212312123221233212342123521236212372123821239212402124121242212432124421245212462124721248212492125021251212522125321254212552125621257212582125921260212612126221263212642126521266212672126821269212702127121272212732127421275212762127721278212792128021281212822128321284212852128621287212882128921290212912129221293212942129521296212972129821299213002130121302213032130421305213062130721308213092131021311213122131321314213152131621317213182131921320213212132221323213242132521326213272132821329213302133121332213332133421335213362133721338213392134021341213422134321344213452134621347213482134921350213512135221353213542135521356213572135821359213602136121362213632136421365213662136721368213692137021371213722137321374213752137621377213782137921380213812138221383213842138521386213872138821389213902139121392213932139421395213962139721398213992140021401214022140321404214052140621407214082140921410214112141221413214142141521416214172141821419214202142121422214232142421425214262142721428214292143021431214322143321434214352143621437214382143921440214412144221443214442144521446214472144821449214502145121452214532145421455214562145721458214592146021461214622146321464214652146621467214682146921470214712147221473214742147521476214772147821479214802148121482214832148421485214862148721488214892149021491214922149321494214952149621497214982149921500215012150221503215042150521506215072150821509215102151121512215132151421515215162151721518215192152021521215222152321524215252152621527215282152921530215312153221533215342153521536215372153821539215402154121542215432154421545215462154721548215492155021551215522155321554215552155621557215582155921560215612156221563215642156521566215672156821569215702157121572215732157421575215762157721578215792158021581215822158321584215852158621587215882158921590215912159221593215942159521596215972159821599216002160121602216032160421605216062160721608216092161021611216122161321614216152161621617216182161921620216212162221623216242162521626216272162821629216302163121632216332163421635216362163721638216392164021641216422164321644216452164621647216482164921650216512165221653216542165521656216572165821659216602166121662216632166421665216662166721668216692167021671216722167321674216752167621677216782167921680216812168221683216842168521686216872168821689216902169121692216932169421695216962169721698216992170021701217022170321704217052170621707217082170921710217112171221713217142171521716217172171821719217202172121722217232172421725217262172721728217292173021731217322173321734217352173621737217382173921740217412174221743217442174521746217472174821749217502175121752217532175421755217562175721758217592176021761217622176321764217652176621767217682176921770217712177221773217742177521776217772177821779217802178121782217832178421785217862178721788217892179021791217922179321794217952179621797217982179921800218012180221803218042180521806218072180821809218102181121812218132181421815218162181721818218192182021821218222182321824218252182621827218282182921830218312183221833218342183521836218372183821839218402184121842218432184421845218462184721848218492185021851218522185321854218552185621857218582185921860218612186221863218642186521866218672186821869218702187121872218732187421875218762187721878218792188021881218822188321884218852188621887218882188921890218912189221893218942189521896218972189821899219002190121902219032190421905219062190721908219092191021911219122191321914219152191621917219182191921920219212192221923219242192521926219272192821929219302193121932219332193421935219362193721938219392194021941219422194321944219452194621947219482194921950219512195221953219542195521956219572195821959219602196121962219632196421965219662196721968219692197021971219722197321974219752197621977219782197921980219812198221983219842198521986219872198821989219902199121992219932199421995219962199721998219992200022001220022200322004220052200622007220082200922010220112201222013220142201522016220172201822019220202202122022220232202422025220262202722028220292203022031220322203322034220352203622037220382203922040220412204222043220442204522046220472204822049220502205122052220532205422055220562205722058220592206022061220622206322064220652206622067220682206922070220712207222073220742207522076220772207822079220802208122082220832208422085220862208722088220892209022091220922209322094220952209622097220982209922100221012210222103221042210522106221072210822109221102211122112221132211422115221162211722118221192212022121221222212322124221252212622127221282212922130221312213222133221342213522136221372213822139221402214122142221432214422145221462214722148221492215022151221522215322154221552215622157221582215922160221612216222163221642216522166221672216822169221702217122172221732217422175221762217722178221792218022181221822218322184221852218622187221882218922190221912219222193221942219522196221972219822199222002220122202222032220422205222062220722208222092221022211222122221322214222152221622217222182221922220222212222222223222242222522226222272222822229222302223122232222332223422235222362223722238222392224022241222422224322244222452224622247222482224922250222512225222253222542225522256222572225822259222602226122262222632226422265222662226722268222692227022271222722227322274222752227622277222782227922280222812228222283222842228522286222872228822289222902229122292222932229422295222962229722298222992230022301223022230322304223052230622307223082230922310223112231222313223142231522316223172231822319223202232122322223232232422325223262232722328223292233022331223322233322334223352233622337223382233922340223412234222343223442234522346223472234822349223502235122352223532235422355223562235722358223592236022361223622236322364223652236622367223682236922370223712237222373223742237522376223772237822379223802238122382223832238422385223862238722388223892239022391223922239322394223952239622397223982239922400224012240222403224042240522406224072240822409224102241122412224132241422415224162241722418224192242022421224222242322424224252242622427224282242922430224312243222433224342243522436224372243822439224402244122442224432244422445224462244722448224492245022451224522245322454224552245622457224582245922460224612246222463224642246522466224672246822469224702247122472224732247422475224762247722478224792248022481224822248322484224852248622487224882248922490224912249222493224942249522496224972249822499225002250122502225032250422505225062250722508225092251022511225122251322514225152251622517225182251922520225212252222523225242252522526225272252822529225302253122532225332253422535225362253722538225392254022541225422254322544225452254622547225482254922550225512255222553225542255522556225572255822559225602256122562225632256422565225662256722568225692257022571225722257322574225752257622577225782257922580225812258222583225842258522586225872258822589225902259122592225932259422595225962259722598225992260022601226022260322604226052260622607226082260922610226112261222613226142261522616226172261822619226202262122622226232262422625226262262722628226292263022631226322263322634226352263622637226382263922640226412264222643226442264522646226472264822649226502265122652226532265422655226562265722658226592266022661226622266322664226652266622667226682266922670226712267222673226742267522676226772267822679226802268122682226832268422685226862268722688226892269022691226922269322694226952269622697226982269922700227012270222703227042270522706227072270822709227102271122712227132271422715227162271722718227192272022721227222272322724227252272622727227282272922730227312273222733227342273522736227372273822739227402274122742227432274422745227462274722748227492275022751227522275322754227552275622757227582275922760227612276222763227642276522766227672276822769227702277122772227732277422775227762277722778227792278022781227822278322784227852278622787227882278922790227912279222793227942279522796227972279822799228002280122802228032280422805228062280722808228092281022811228122281322814228152281622817228182281922820228212282222823228242282522826228272282822829228302283122832228332283422835228362283722838228392284022841228422284322844228452284622847228482284922850228512285222853228542285522856228572285822859228602286122862228632286422865228662286722868228692287022871228722287322874228752287622877228782287922880228812288222883228842288522886228872288822889228902289122892228932289422895228962289722898228992290022901229022290322904229052290622907229082290922910229112291222913229142291522916229172291822919229202292122922229232292422925229262292722928229292293022931229322293322934229352293622937229382293922940229412294222943229442294522946229472294822949229502295122952229532295422955229562295722958229592296022961229622296322964229652296622967229682296922970229712297222973229742297522976229772297822979229802298122982229832298422985229862298722988229892299022991229922299322994229952299622997229982299923000230012300223003230042300523006230072300823009230102301123012230132301423015230162301723018230192302023021230222302323024230252302623027230282302923030230312303223033230342303523036230372303823039230402304123042230432304423045230462304723048230492305023051230522305323054230552305623057230582305923060230612306223063230642306523066230672306823069230702307123072230732307423075230762307723078230792308023081230822308323084230852308623087230882308923090230912309223093230942309523096230972309823099231002310123102231032310423105231062310723108231092311023111231122311323114231152311623117231182311923120231212312223123231242312523126231272312823129231302313123132231332313423135231362313723138231392314023141231422314323144231452314623147231482314923150231512315223153231542315523156231572315823159231602316123162231632316423165231662316723168231692317023171231722317323174231752317623177231782317923180231812318223183231842318523186231872318823189231902319123192231932319423195231962319723198231992320023201232022320323204232052320623207232082320923210232112321223213232142321523216232172321823219232202322123222232232322423225232262322723228232292323023231232322323323234232352323623237232382323923240232412324223243232442324523246232472324823249232502325123252232532325423255232562325723258232592326023261232622326323264232652326623267232682326923270232712327223273232742327523276232772327823279232802328123282232832328423285232862328723288232892329023291232922329323294232952329623297232982329923300233012330223303233042330523306233072330823309233102331123312233132331423315233162331723318233192332023321233222332323324233252332623327233282332923330233312333223333233342333523336233372333823339233402334123342233432334423345233462334723348233492335023351233522335323354233552335623357233582335923360233612336223363233642336523366233672336823369233702337123372233732337423375233762337723378233792338023381233822338323384233852338623387233882338923390233912339223393233942339523396233972339823399234002340123402234032340423405234062340723408234092341023411234122341323414234152341623417234182341923420234212342223423234242342523426234272342823429234302343123432234332343423435234362343723438234392344023441234422344323444234452344623447234482344923450234512345223453234542345523456234572345823459234602346123462234632346423465234662346723468234692347023471234722347323474234752347623477234782347923480234812348223483234842348523486234872348823489234902349123492234932349423495234962349723498234992350023501235022350323504235052350623507235082350923510235112351223513235142351523516235172351823519235202352123522235232352423525235262352723528235292353023531235322353323534235352353623537235382353923540235412354223543235442354523546235472354823549235502355123552235532355423555235562355723558235592356023561235622356323564235652356623567235682356923570235712357223573235742357523576235772357823579235802358123582235832358423585235862358723588235892359023591235922359323594235952359623597235982359923600236012360223603236042360523606236072360823609236102361123612236132361423615236162361723618236192362023621236222362323624236252362623627236282362923630236312363223633236342363523636236372363823639236402364123642236432364423645236462364723648236492365023651236522365323654236552365623657236582365923660236612366223663236642366523666236672366823669236702367123672236732367423675236762367723678236792368023681236822368323684236852368623687236882368923690236912369223693236942369523696236972369823699237002370123702237032370423705237062370723708237092371023711237122371323714237152371623717237182371923720237212372223723237242372523726237272372823729237302373123732237332373423735237362373723738237392374023741237422374323744237452374623747237482374923750237512375223753237542375523756237572375823759237602376123762237632376423765237662376723768237692377023771237722377323774237752377623777237782377923780237812378223783237842378523786237872378823789237902379123792237932379423795237962379723798237992380023801238022380323804238052380623807238082380923810238112381223813238142381523816238172381823819238202382123822238232382423825238262382723828238292383023831238322383323834238352383623837238382383923840238412384223843238442384523846238472384823849238502385123852238532385423855238562385723858238592386023861238622386323864238652386623867238682386923870238712387223873238742387523876238772387823879238802388123882238832388423885238862388723888238892389023891238922389323894238952389623897238982389923900239012390223903239042390523906239072390823909239102391123912239132391423915239162391723918239192392023921239222392323924239252392623927239282392923930239312393223933239342393523936239372393823939239402394123942239432394423945239462394723948239492395023951239522395323954239552395623957239582395923960239612396223963239642396523966239672396823969239702397123972239732397423975239762397723978239792398023981239822398323984239852398623987239882398923990239912399223993239942399523996239972399823999240002400124002240032400424005240062400724008240092401024011240122401324014240152401624017240182401924020240212402224023240242402524026240272402824029240302403124032240332403424035240362403724038240392404024041240422404324044240452404624047240482404924050240512405224053240542405524056240572405824059240602406124062240632406424065240662406724068240692407024071240722407324074240752407624077240782407924080240812408224083240842408524086240872408824089240902409124092240932409424095240962409724098240992410024101241022410324104241052410624107241082410924110241112411224113241142411524116241172411824119241202412124122241232412424125241262412724128241292413024131241322413324134241352413624137241382413924140241412414224143241442414524146241472414824149241502415124152241532415424155241562415724158241592416024161241622416324164241652416624167241682416924170241712417224173241742417524176241772417824179241802418124182241832418424185241862418724188241892419024191241922419324194241952419624197241982419924200242012420224203242042420524206242072420824209242102421124212242132421424215242162421724218242192422024221242222422324224242252422624227242282422924230242312423224233242342423524236242372423824239242402424124242242432424424245242462424724248242492425024251242522425324254242552425624257242582425924260242612426224263242642426524266242672426824269242702427124272242732427424275242762427724278242792428024281242822428324284242852428624287242882428924290242912429224293242942429524296242972429824299243002430124302243032430424305243062430724308243092431024311243122431324314243152431624317243182431924320243212432224323243242432524326243272432824329243302433124332243332433424335243362433724338243392434024341243422434324344243452434624347243482434924350243512435224353243542435524356243572435824359243602436124362243632436424365243662436724368243692437024371243722437324374243752437624377243782437924380243812438224383243842438524386243872438824389243902439124392243932439424395243962439724398243992440024401244022440324404244052440624407244082440924410244112441224413244142441524416244172441824419244202442124422244232442424425244262442724428244292443024431244322443324434244352443624437244382443924440244412444224443244442444524446244472444824449244502445124452244532445424455244562445724458244592446024461244622446324464244652446624467244682446924470244712447224473244742447524476244772447824479244802448124482244832448424485244862448724488244892449024491244922449324494244952449624497244982449924500245012450224503245042450524506245072450824509245102451124512245132451424515245162451724518245192452024521245222452324524245252452624527245282452924530245312453224533245342453524536245372453824539245402454124542245432454424545245462454724548245492455024551245522455324554245552455624557245582455924560245612456224563245642456524566245672456824569245702457124572245732457424575245762457724578245792458024581245822458324584245852458624587245882458924590245912459224593245942459524596245972459824599246002460124602246032460424605246062460724608246092461024611246122461324614246152461624617246182461924620246212462224623246242462524626246272462824629246302463124632246332463424635246362463724638246392464024641246422464324644246452464624647246482464924650246512465224653246542465524656246572465824659246602466124662246632466424665246662466724668246692467024671246722467324674246752467624677246782467924680246812468224683246842468524686246872468824689246902469124692246932469424695246962469724698246992470024701247022470324704247052470624707247082470924710247112471224713247142471524716247172471824719247202472124722247232472424725247262472724728247292473024731247322473324734247352473624737247382473924740247412474224743247442474524746247472474824749247502475124752247532475424755247562475724758247592476024761247622476324764247652476624767247682476924770247712477224773247742477524776247772477824779247802478124782247832478424785247862478724788247892479024791247922479324794247952479624797247982479924800248012480224803248042480524806248072480824809248102481124812248132481424815248162481724818248192482024821248222482324824248252482624827248282482924830248312483224833248342483524836248372483824839248402484124842248432484424845248462484724848248492485024851248522485324854248552485624857248582485924860248612486224863248642486524866248672486824869248702487124872248732487424875248762487724878248792488024881248822488324884248852488624887248882488924890248912489224893248942489524896248972489824899249002490124902249032490424905249062490724908249092491024911249122491324914249152491624917249182491924920249212492224923249242492524926249272492824929249302493124932249332493424935249362493724938249392494024941249422494324944249452494624947249482494924950249512495224953249542495524956249572495824959249602496124962249632496424965249662496724968249692497024971249722497324974249752497624977249782497924980249812498224983249842498524986249872498824989249902499124992249932499424995249962499724998249992500025001250022500325004250052500625007250082500925010250112501225013250142501525016250172501825019250202502125022250232502425025250262502725028250292503025031250322503325034250352503625037250382503925040250412504225043250442504525046250472504825049250502505125052250532505425055250562505725058250592506025061250622506325064250652506625067250682506925070250712507225073250742507525076250772507825079250802508125082250832508425085250862508725088250892509025091250922509325094250952509625097250982509925100251012510225103251042510525106251072510825109251102511125112251132511425115251162511725118251192512025121251222512325124251252512625127251282512925130251312513225133251342513525136251372513825139251402514125142251432514425145251462514725148251492515025151251522515325154251552515625157251582515925160251612516225163251642516525166251672516825169251702517125172251732517425175251762517725178251792518025181251822518325184251852518625187251882518925190251912519225193251942519525196251972519825199252002520125202252032520425205252062520725208252092521025211252122521325214252152521625217252182521925220252212522225223252242522525226252272522825229252302523125232252332523425235252362523725238252392524025241252422524325244252452524625247252482524925250252512525225253252542525525256252572525825259252602526125262252632526425265252662526725268252692527025271252722527325274252752527625277252782527925280252812528225283252842528525286252872528825289252902529125292252932529425295252962529725298252992530025301253022530325304253052530625307253082530925310253112531225313253142531525316253172531825319253202532125322253232532425325253262532725328253292533025331253322533325334253352533625337253382533925340253412534225343253442534525346253472534825349253502535125352253532535425355253562535725358253592536025361253622536325364253652536625367253682536925370253712537225373253742537525376253772537825379253802538125382253832538425385253862538725388253892539025391253922539325394253952539625397253982539925400254012540225403254042540525406254072540825409254102541125412254132541425415254162541725418254192542025421254222542325424254252542625427254282542925430254312543225433254342543525436254372543825439254402544125442254432544425445254462544725448254492545025451254522545325454254552545625457254582545925460254612546225463254642546525466254672546825469254702547125472254732547425475254762547725478254792548025481254822548325484254852548625487254882548925490254912549225493254942549525496254972549825499255002550125502255032550425505255062550725508255092551025511255122551325514255152551625517255182551925520255212552225523255242552525526255272552825529255302553125532255332553425535255362553725538255392554025541255422554325544255452554625547255482554925550255512555225553255542555525556255572555825559255602556125562255632556425565255662556725568255692557025571255722557325574255752557625577255782557925580255812558225583255842558525586255872558825589255902559125592255932559425595255962559725598255992560025601256022560325604256052560625607256082560925610256112561225613256142561525616256172561825619256202562125622256232562425625256262562725628256292563025631256322563325634256352563625637256382563925640256412564225643256442564525646256472564825649256502565125652256532565425655256562565725658256592566025661256622566325664256652566625667256682566925670256712567225673256742567525676256772567825679256802568125682256832568425685256862568725688256892569025691256922569325694256952569625697256982569925700257012570225703257042570525706257072570825709257102571125712257132571425715257162571725718257192572025721257222572325724257252572625727257282572925730257312573225733257342573525736257372573825739257402574125742257432574425745257462574725748257492575025751257522575325754257552575625757257582575925760257612576225763257642576525766257672576825769257702577125772257732577425775257762577725778257792578025781257822578325784257852578625787257882578925790257912579225793257942579525796257972579825799258002580125802258032580425805258062580725808258092581025811258122581325814258152581625817258182581925820258212582225823258242582525826258272582825829258302583125832258332583425835258362583725838258392584025841258422584325844258452584625847258482584925850258512585225853258542585525856258572585825859258602586125862258632586425865258662586725868258692587025871258722587325874258752587625877258782587925880258812588225883258842588525886258872588825889258902589125892258932589425895258962589725898258992590025901259022590325904259052590625907259082590925910259112591225913259142591525916259172591825919259202592125922259232592425925259262592725928259292593025931259322593325934259352593625937259382593925940259412594225943259442594525946259472594825949259502595125952259532595425955259562595725958259592596025961259622596325964259652596625967259682596925970259712597225973259742597525976259772597825979259802598125982259832598425985259862598725988259892599025991259922599325994259952599625997259982599926000260012600226003260042600526006260072600826009260102601126012260132601426015260162601726018260192602026021260222602326024260252602626027260282602926030260312603226033260342603526036260372603826039260402604126042260432604426045260462604726048260492605026051260522605326054260552605626057260582605926060260612606226063260642606526066260672606826069260702607126072260732607426075260762607726078260792608026081260822608326084260852608626087260882608926090260912609226093260942609526096260972609826099261002610126102261032610426105261062610726108261092611026111261122611326114261152611626117261182611926120261212612226123261242612526126261272612826129261302613126132261332613426135261362613726138261392614026141261422614326144261452614626147261482614926150261512615226153261542615526156261572615826159261602616126162261632616426165261662616726168261692617026171261722617326174261752617626177261782617926180261812618226183261842618526186261872618826189261902619126192261932619426195261962619726198261992620026201262022620326204262052620626207262082620926210262112621226213262142621526216262172621826219262202622126222262232622426225262262622726228262292623026231262322623326234262352623626237262382623926240262412624226243262442624526246262472624826249262502625126252262532625426255262562625726258262592626026261262622626326264262652626626267262682626926270262712627226273262742627526276262772627826279262802628126282262832628426285262862628726288262892629026291262922629326294262952629626297262982629926300263012630226303263042630526306263072630826309263102631126312263132631426315263162631726318263192632026321263222632326324263252632626327263282632926330263312633226333263342633526336263372633826339263402634126342263432634426345263462634726348263492635026351263522635326354263552635626357263582635926360263612636226363263642636526366263672636826369263702637126372263732637426375263762637726378263792638026381263822638326384263852638626387263882638926390263912639226393263942639526396263972639826399264002640126402264032640426405264062640726408264092641026411264122641326414264152641626417264182641926420264212642226423264242642526426264272642826429264302643126432264332643426435264362643726438264392644026441264422644326444264452644626447264482644926450264512645226453264542645526456264572645826459264602646126462264632646426465264662646726468264692647026471264722647326474264752647626477264782647926480264812648226483264842648526486264872648826489264902649126492264932649426495264962649726498264992650026501265022650326504265052650626507265082650926510265112651226513265142651526516265172651826519265202652126522265232652426525265262652726528265292653026531265322653326534265352653626537265382653926540265412654226543265442654526546265472654826549265502655126552265532655426555265562655726558265592656026561265622656326564265652656626567265682656926570265712657226573265742657526576265772657826579265802658126582265832658426585265862658726588265892659026591265922659326594265952659626597265982659926600266012660226603266042660526606266072660826609266102661126612266132661426615266162661726618266192662026621266222662326624266252662626627266282662926630266312663226633266342663526636266372663826639266402664126642266432664426645266462664726648266492665026651266522665326654266552665626657266582665926660266612666226663266642666526666266672666826669266702667126672266732667426675266762667726678266792668026681266822668326684266852668626687266882668926690266912669226693266942669526696266972669826699267002670126702267032670426705267062670726708267092671026711267122671326714267152671626717267182671926720267212672226723267242672526726267272672826729267302673126732267332673426735267362673726738267392674026741267422674326744267452674626747267482674926750267512675226753267542675526756267572675826759267602676126762267632676426765267662676726768267692677026771267722677326774267752677626777267782677926780267812678226783267842678526786267872678826789267902679126792267932679426795267962679726798267992680026801268022680326804268052680626807268082680926810268112681226813268142681526816268172681826819268202682126822268232682426825268262682726828268292683026831268322683326834268352683626837268382683926840268412684226843268442684526846268472684826849268502685126852268532685426855268562685726858268592686026861268622686326864268652686626867268682686926870268712687226873268742687526876268772687826879268802688126882268832688426885268862688726888268892689026891268922689326894268952689626897268982689926900269012690226903269042690526906269072690826909269102691126912269132691426915269162691726918269192692026921269222692326924269252692626927269282692926930269312693226933269342693526936269372693826939269402694126942269432694426945269462694726948269492695026951269522695326954269552695626957269582695926960269612696226963269642696526966269672696826969269702697126972269732697426975269762697726978269792698026981269822698326984269852698626987269882698926990269912699226993269942699526996269972699826999270002700127002270032700427005270062700727008270092701027011270122701327014270152701627017270182701927020270212702227023270242702527026270272702827029270302703127032270332703427035270362703727038270392704027041270422704327044270452704627047270482704927050270512705227053270542705527056270572705827059270602706127062270632706427065270662706727068270692707027071270722707327074270752707627077270782707927080270812708227083270842708527086270872708827089270902709127092270932709427095270962709727098270992710027101271022710327104271052710627107271082710927110271112711227113271142711527116271172711827119271202712127122271232712427125271262712727128271292713027131271322713327134271352713627137271382713927140271412714227143271442714527146271472714827149271502715127152271532715427155271562715727158271592716027161271622716327164271652716627167271682716927170271712717227173271742717527176271772717827179271802718127182271832718427185271862718727188271892719027191271922719327194271952719627197271982719927200272012720227203272042720527206272072720827209272102721127212272132721427215272162721727218272192722027221272222722327224272252722627227272282722927230272312723227233272342723527236272372723827239272402724127242272432724427245272462724727248272492725027251272522725327254272552725627257272582725927260272612726227263272642726527266272672726827269272702727127272272732727427275272762727727278272792728027281272822728327284272852728627287272882728927290272912729227293272942729527296272972729827299273002730127302273032730427305273062730727308273092731027311273122731327314273152731627317273182731927320273212732227323273242732527326273272732827329273302733127332273332733427335273362733727338273392734027341273422734327344273452734627347273482734927350273512735227353273542735527356273572735827359273602736127362273632736427365273662736727368273692737027371273722737327374273752737627377273782737927380273812738227383273842738527386273872738827389273902739127392273932739427395273962739727398273992740027401274022740327404274052740627407274082740927410274112741227413274142741527416274172741827419274202742127422274232742427425274262742727428274292743027431274322743327434274352743627437274382743927440274412744227443274442744527446274472744827449274502745127452274532745427455274562745727458274592746027461274622746327464274652746627467274682746927470274712747227473274742747527476274772747827479274802748127482274832748427485274862748727488274892749027491274922749327494274952749627497274982749927500275012750227503275042750527506275072750827509275102751127512275132751427515275162751727518275192752027521275222752327524275252752627527275282752927530275312753227533275342753527536275372753827539275402754127542275432754427545275462754727548275492755027551275522755327554275552755627557275582755927560275612756227563275642756527566275672756827569275702757127572275732757427575275762757727578275792758027581275822758327584275852758627587275882758927590275912759227593275942759527596275972759827599276002760127602276032760427605276062760727608276092761027611276122761327614276152761627617276182761927620276212762227623276242762527626276272762827629276302763127632276332763427635276362763727638276392764027641276422764327644276452764627647276482764927650276512765227653276542765527656276572765827659276602766127662276632766427665276662766727668276692767027671276722767327674276752767627677276782767927680276812768227683276842768527686276872768827689276902769127692276932769427695276962769727698276992770027701277022770327704277052770627707277082770927710277112771227713277142771527716277172771827719277202772127722277232772427725277262772727728277292773027731277322773327734277352773627737277382773927740277412774227743277442774527746277472774827749277502775127752277532775427755277562775727758277592776027761277622776327764277652776627767277682776927770277712777227773277742777527776277772777827779277802778127782277832778427785277862778727788277892779027791277922779327794277952779627797277982779927800278012780227803278042780527806278072780827809278102781127812278132781427815278162781727818278192782027821278222782327824278252782627827278282782927830278312783227833278342783527836278372783827839278402784127842278432784427845278462784727848278492785027851278522785327854278552785627857278582785927860278612786227863278642786527866278672786827869278702787127872278732787427875278762787727878278792788027881278822788327884278852788627887278882788927890278912789227893278942789527896278972789827899279002790127902279032790427905279062790727908279092791027911279122791327914279152791627917279182791927920279212792227923279242792527926279272792827929279302793127932279332793427935279362793727938279392794027941279422794327944279452794627947279482794927950279512795227953279542795527956279572795827959279602796127962279632796427965279662796727968279692797027971279722797327974279752797627977279782797927980279812798227983279842798527986279872798827989279902799127992279932799427995279962799727998279992800028001280022800328004280052800628007280082800928010280112801228013280142801528016280172801828019280202802128022280232802428025280262802728028280292803028031280322803328034280352803628037280382803928040280412804228043280442804528046280472804828049280502805128052280532805428055280562805728058280592806028061280622806328064280652806628067280682806928070280712807228073280742807528076280772807828079280802808128082280832808428085280862808728088280892809028091280922809328094280952809628097280982809928100281012810228103281042810528106281072810828109281102811128112281132811428115281162811728118281192812028121281222812328124281252812628127281282812928130281312813228133281342813528136281372813828139281402814128142281432814428145281462814728148281492815028151281522815328154281552815628157281582815928160281612816228163281642816528166281672816828169281702817128172281732817428175281762817728178281792818028181281822818328184281852818628187281882818928190281912819228193281942819528196281972819828199282002820128202282032820428205282062820728208282092821028211282122821328214282152821628217282182821928220282212822228223282242822528226282272822828229282302823128232282332823428235282362823728238282392824028241282422824328244282452824628247282482824928250282512825228253282542825528256282572825828259282602826128262282632826428265282662826728268282692827028271282722827328274282752827628277282782827928280282812828228283282842828528286282872828828289282902829128292282932829428295282962829728298282992830028301283022830328304283052830628307283082830928310283112831228313283142831528316283172831828319283202832128322283232832428325283262832728328283292833028331283322833328334283352833628337283382833928340283412834228343283442834528346283472834828349283502835128352283532835428355283562835728358283592836028361283622836328364283652836628367283682836928370283712837228373283742837528376283772837828379283802838128382283832838428385283862838728388283892839028391283922839328394283952839628397283982839928400284012840228403284042840528406284072840828409284102841128412284132841428415284162841728418284192842028421284222842328424284252842628427284282842928430284312843228433284342843528436284372843828439284402844128442284432844428445284462844728448284492845028451284522845328454284552845628457284582845928460284612846228463284642846528466284672846828469284702847128472284732847428475284762847728478284792848028481284822848328484
  1. {
  2. This file is part of the Free Component Library
  3. Pascal resolver
  4. Copyright (c) 2019 Mattias Gaertner [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Abstract:
  12. Resolves references by setting TPasElement.CustomData as TResolvedReference.
  13. Creates search scopes for elements with sub identifiers by setting
  14. TPasElement.CustomData as TPasScope: unit, program, library, interface,
  15. implementation, procs
  16. Works:
  17. - built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
  18. - references in statements, error if not found
  19. - interface and implementation types, vars, const
  20. - params, local types, vars, const
  21. - nested procedures
  22. - nested forward procs, nested must be resolved before proc body
  23. - program/library/implementation forward procs
  24. - search in used units
  25. - unitname.identifier
  26. - alias types, 'type a=b'
  27. - type alias type 'type a=type b'
  28. - choose the most compatible overloaded procedure
  29. - while..do
  30. - repeat..until
  31. - if..then..else
  32. - binary operators
  33. - case..of
  34. - check duplicate values
  35. - try..finally..except, on, else, raise
  36. - for loop
  37. - fail to write a loop var inside the loop
  38. - spot duplicates
  39. - type cast base types
  40. - char
  41. - ord(), chr()
  42. - record
  43. - variants
  44. - const param makes children const too
  45. - const TRecordValues
  46. - function default(record type): record
  47. - advanced records:
  48. - $modeswitch AdvancedRecords
  49. - visibility public, private, strict private
  50. - sub type
  51. - const, var, class var
  52. - function/procedure/class function/class procedure
  53. - property, class property, default property
  54. - constructor
  55. - RTTI
  56. - class:
  57. - forward declaration
  58. - instance.a
  59. - find ancestor, search in ancestors
  60. - virtual, abstract, override
  61. - method body
  62. - Self
  63. - inherited
  64. - property
  65. - read var, read function
  66. - write var, write function
  67. - stored function
  68. - defaultexpr
  69. - is and as operator
  70. - nil
  71. - constructor result type, rrfNewInstance
  72. - destructor call type: rrfFreeInstance
  73. - type cast
  74. - class of
  75. - class method, property, var, const
  76. - class-of.constructor
  77. - class-of typecast upwards/downwards
  78. - class-of option to allow is-operator
  79. - typecast Self in class method upwards/downwards
  80. - property with params
  81. - default property
  82. - visibility, override: warn and fix if lower
  83. - events, proc type of object
  84. - sealed
  85. - $M+ / $TYPEINFO use visPublished as default visibility
  86. - note: constructing class with abstract method
  87. - with..do
  88. - enums - TPasEnumType, TPasEnumValue
  89. - propagate to parent scopes
  90. - function ord(): integer
  91. - function low(ordinal): ordinal
  92. - function high(ordinal): ordinal
  93. - function pred(ordinal): ordinal
  94. - function high(ordinal): ordinal
  95. - cast integer to enum, enum to integer
  96. - $ScopedEnums
  97. - sets - TPasSetType
  98. - set of char
  99. - set of integer
  100. - set of boolean
  101. - set of enum
  102. - ranges 'a'..'z' 2..5
  103. - operators: +, -, *, ><, <=, >=
  104. - in-operator
  105. - assign operators: +=, -=, *=
  106. - include(), exclude()
  107. - typed const: check expr type
  108. - function length(const array or string): integer
  109. - procedure setlength(var array or string; newlength: integer)
  110. - ranges TPasRangeType
  111. - procedure exit, procedure exit(const function result)
  112. - check if types only refer types+const
  113. - check const expression types, e.g. bark on "const c:string=3;"
  114. - procedure inc/dec(var ordinal; decr: ordinal = 1)
  115. - function Assigned(Pointer or Class or Class-Of): boolean
  116. - arrays TPasArrayType
  117. - TPasEnumType, char, integer, range
  118. - low, high, length, setlength, assigned
  119. - function concat(array1,array2,...): array
  120. - function copy(array): array, copy(a,start), copy(a,start,end)
  121. - insert(item; var array; index: integer)
  122. - delete(var array; start, count: integer)
  123. - element
  124. - multi dimensional
  125. - const
  126. - open array, override, pass array literal, pass var
  127. - type cast array to arrays with same dimensions and compatible element type
  128. - static array range checking
  129. - const array of char = string
  130. - a:=[...] // assignation using constant array
  131. - a:=[[...],[...]]
  132. - a:=[...]+[...] a+[] []+a modeswitch arrayoperators
  133. - delphi: var a: dynarray = []; // square bracket initialization
  134. - check if var initexpr fits vartype: var a: type = expr;
  135. - built-in functions high, low for range types
  136. - procedure type
  137. - call
  138. - as function result
  139. - as parameter
  140. - Delphi without @
  141. - @@ operator
  142. - FPC equal and not equal
  143. - "is nested"
  144. - bark on arguments access mismatch
  145. - function without params: mark if call or address, rrfImplicitCallWithoutParams
  146. - procedure break, procedure continue
  147. - built-in functions pred, succ for range type and enums
  148. - untyped parameters
  149. - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
  150. - built-in procedure writestr(var s: string; Args: arguments...); varargs
  151. - pointer TPasPointerType
  152. - nil, assigned(), typecast, class, classref, dynarray, procvar
  153. - forward declaration
  154. - cycle detection
  155. - TypedPointer^, (@Some)^
  156. - = operator: TypedPointer, @Some, UntypedPointer
  157. - TypedPointer:=TypedPointer
  158. - TypedPointer:=@Some
  159. - pointer[index], (@i)[index]
  160. - dispose(pointerofrecord), new(pointerofrecord)
  161. - $PointerMath on|off
  162. - emit hints
  163. - platform, deprecated, experimental, library, unimplemented
  164. - hiding ancestor method
  165. - hiding other unit identifier
  166. - dotted unitnames
  167. - eval:
  168. - nil, true, false
  169. - range checking:
  170. - integer ranges
  171. - boolean ranges
  172. - enum ranges
  173. - char ranges
  174. - +, -, *, div, mod, /, shl, shr, or, and, xor, in, ^^, ><
  175. - =, <>, <, <=, >, >=
  176. - ord(), low(), high(), pred(), succ(), length()
  177. - string[index]
  178. - call(param)
  179. - a:=value
  180. - arr[index]
  181. - resourcestrings
  182. - custom ranges
  183. - enum: low(), high(), pred(), succ(), ord(), rg(int), int(rg), enum:=rg,
  184. rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
  185. array[rg], low(array), high(array)
  186. - for..in..do :
  187. - type boolean, char, byte, shortint, word, smallint, longword, longint
  188. - type enum range, char range, integer range
  189. - type/var set of: enum, enum range, integer, integer range, char, char range
  190. - array var
  191. - function: enumerator
  192. - class
  193. - var modifier 'absolute'
  194. - Assert(bool[,string])
  195. - interfaces
  196. - $interfaces com|corba|default
  197. - root interface for com: delphi: IInterface, objfpc: IUnknown
  198. - method resolution
  199. - delegation via property implements: intftype, classtype
  200. - IntfVar as IntfType, intfvar as classtype, ObjVar as IntfType
  201. - IntfVar is IntfType, intfvar is classtype, ObjVar is IntfType
  202. - intftype(ObjVar), classtype(IntfVar)
  203. - default property
  204. - visibility public
  205. - $M+
  206. - class interfaces, check duplicates
  207. - assigned()
  208. - IntfVar:=nil, IntfVar:=IntfVar, IntfVar:=ObjVar, ObjVar:=IntfVar
  209. - IntfVar=IntfVar2
  210. - currency
  211. - eval type TResEvalCurrency
  212. - eval +, -, *, /, ^^
  213. - float*currency and currency*float computes to currency
  214. - type alias type overloads
  215. - $writeableconst off $J-
  216. - $warn identifier ON|off|error|default
  217. - anonymous methods:
  218. - assign in proc and program begin and initialization p:=procedure begin end
  219. - pass as arg doit(procedure begin end)
  220. - modifiers assembler varargs cdecl
  221. - typecast
  222. - with
  223. - self
  224. - built-in procedure Val(const s: string; var e: enumtype; out Code: integertype);
  225. - intrinsic functions Lo and Hi, depending on $mode (ObjFPC or Delphi):
  226. - In $MODE DELPHI:
  227. function Lo/Hi(i: <any integer type>): Byte
  228. - In $MODE OBJFPC:
  229. function Lo/Hi(i: Byte/ShortInt/Word/SmallInt): Byte
  230. function Lo/Hi(i: LongWord/LongInt/UIntSingle/IntSingle): Word
  231. function Lo/Hi(i: QWord/Int64/UIntDouble/IntDouble): LongWord
  232. - helpers:
  233. - class
  234. - record
  235. - type helper for simple type variables
  236. - InterfaceHelpers for fast gathering of helpers from uses sections
  237. - "inherited" and "inherited name" for Delphi and ObjFPC
  238. - for i in typehelped
  239. - nested: type, const, class var
  240. - visibility
  241. - property
  242. - helper method, Self as var argument
  243. ToDo:
  244. - operator overload
  245. - operator enumerator
  246. - binaryexpr
  247. - advanced records
  248. - Include/Exclude for set of int/char/bool
  249. - error if property method resolution is not used
  250. - $H-hintpos$H+
  251. - $pop, $push
  252. - $RTTI inherited|explicit
  253. - range checking:
  254. - property defaultvalue
  255. - IntSet:=[-1]
  256. - CharSet:=[#13]
  257. - proc: check if forward and impl default values match
  258. - call array of proc without ()
  259. - attributes
  260. - type helpers
  261. - record/class helpers
  262. - array of const
  263. - generics, nested param lists
  264. - object
  265. - futures
  266. - TPasFileType
  267. - labels
  268. - $zerobasedstrings on|off
  269. - FOR_LOOP_VAR_VARPAR passing a loop var to a var parameter gives a warning
  270. - FOR_VARIABLE warning if using a global var as loop var
  271. - COMPARISON_FALSE COMPARISON_TRUE Comparison always evaluates to False
  272. - USE_BEFORE_DEF Variable '%s' might not have been initialized
  273. - FOR_LOOP_VAR_UNDEF FOR-Loop variable '%s' may be undefined after loop
  274. - TYPEINFO_IMPLICITLY_ADDED Published caused RTTI ($M+) to be added to type '%s'
  275. - IMPLICIT_STRING_CAST Implicit string cast from '%s' to '%s'
  276. - IMPLICIT_STRING_CAST_LOSS Implicit string cast with potential data loss from '%s' to '%s'
  277. - off by default: EXPLICIT_STRING_CAST Explicit string cast from '%s' to '%s'
  278. - off by default: EXPLICIT_STRING_CAST_LOSS Explicit string cast with potential data loss from '%s' to '%s'
  279. - IMPLICIT_INTEGER_CAST_LOSS Implicit integer cast with potential data loss from '%s' to '%s'
  280. - IMPLICIT_CONVERSION_LOSS Implicit conversion may lose significant digits from '%s' to '%s'
  281. - COMBINING_SIGNED_UNSIGNED64 Combining signed type and unsigned 64-bit type - treated as an unsigned type
  282. -
  283. Debug flags: -d<x>
  284. VerbosePasResolver
  285. Notes:
  286. Functions and function types without parameters:
  287. property P read f; // use function f, not its result
  288. f. // implicit resolve f once if param less function or function type
  289. f[] // implicit resolve f once if a param less function or function type
  290. @f; use function f, not its result
  291. @p.f; @ operator applies to f, not p
  292. @f(); @ operator applies to result of f
  293. f(); use f's result
  294. FuncVar:=Func; if mode=objfpc: incompatible
  295. if mode=delphi: implicit addr of function f
  296. if f=g then : can implicit resolve each side once
  297. p(f), f as var parameter: can implicit
  298. }
  299. unit PasResolver;
  300. {$mode objfpc}{$H+}
  301. {$inline on}
  302. {$ifdef fpc}
  303. {$define UsePChar}
  304. {$define HasInt64}
  305. {$endif}
  306. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  307. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  308. interface
  309. uses
  310. {$ifdef pas2js}
  311. js,
  312. {$IFDEF NODEJS}
  313. NodeJSFS,
  314. {$ENDIF}
  315. {$endif}
  316. Classes, SysUtils, Math, Types, contnrs,
  317. PasTree, PScanner, PParser, PasResolveEval;
  318. const
  319. ParserMaxEmbeddedColumn = 2048;
  320. ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
  321. po_Resolver = [
  322. po_ResolveStandardTypes,
  323. po_NoOverloadedProcs,
  324. po_KeepClassForward,
  325. po_ArrayRangeExpr,
  326. po_CheckModeswitches,
  327. po_CheckCondFunction];
  328. type
  329. TResolverBaseType = (
  330. btNone, // undefined
  331. btCustom, // provided by descendant resolver
  332. btContext, // any source declared type with LoTypeEl/HiTypeEl
  333. btModule,
  334. btUntyped, // TPasArgument without ArgType
  335. btChar, // char
  336. {$ifdef FPC_HAS_CPSTRING}
  337. btAnsiChar, // ansichar
  338. {$endif}
  339. btWideChar, // widechar
  340. btString, // string
  341. {$ifdef FPC_HAS_CPSTRING}
  342. btAnsiString, // ansistring
  343. btShortString, // shortstring
  344. btRawByteString, // rawbytestring
  345. {$endif}
  346. btWideString, // widestring
  347. btUnicodeString,// unicodestring
  348. btSingle, // single 1.5E-45..3.4E38, digits 7-8, bytes 4
  349. btDouble, // double 5.0E-324..1.7E308, digits 15-16, bytes 8
  350. btExtended, // extended platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
  351. btCExtended, // cextended
  352. btCurrency, // as int64 div 10000, float, not ordinal
  353. btBoolean, // boolean
  354. btByteBool, // bytebool true=not zero
  355. btWordBool, // wordbool true=not zero
  356. btLongBool, // longbool true=not zero
  357. {$ifdef HasInt64}
  358. btQWordBool, // qwordbool true=not zero
  359. {$endif}
  360. btByte, // byte 0..255
  361. btShortInt, // shortint -128..127
  362. btWord, // word unsigned 2 bytes
  363. btSmallInt, // smallint signed 2 bytes
  364. btUIntSingle, // unsigned integer range of single 22bit
  365. btIntSingle, // integer range of single 23bit
  366. btLongWord, // longword unsigned 4 bytes
  367. btLongint, // longint signed 4 bytes
  368. btUIntDouble, // unsigned integer range of double 52bit
  369. btIntDouble, // integer range of double 53bit
  370. {$ifdef HasInt64}
  371. btQWord, // qword 0..18446744073709551615, bytes 8
  372. btInt64, // int64 -9223372036854775808..9223372036854775807, bytes 8
  373. btComp, // as Int64, not ordinal
  374. {$endif}
  375. btPointer, // pointer or canonical pointer (e.g. @something)
  376. {$ifdef fpc}
  377. btFile, // file
  378. btText, // text
  379. btVariant, // variant
  380. {$endif}
  381. btNil, // nil = pointer, class, procedure, method, ...
  382. btProc, // TPasProcedure
  383. btBuiltInProc, // TPasUnresolvedSymbolRef with CustomData is TResElDataBuiltInProc
  384. btArrayProperty,// IdentEl is TPasProperty with Args.Count>0, LoTypeEl=nil
  385. btSet, // set of '', see SubType
  386. btArrayLit, // [] array literal (TParamsExpr, TArrayValues, TBinaryExpr), see SubType
  387. btArrayOrSet, // [] can be set or array literal, see SubType
  388. btRange // a..b see SubType
  389. );
  390. TResolveBaseTypes = set of TResolverBaseType;
  391. const
  392. btIntMax = {$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  393. btUIntMax = {$ifdef HasInt64}btQWord{$else}btUIntDouble{$endif};
  394. btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
  395. btLongWord,btLongint,btIntDouble,btUIntDouble
  396. {$ifdef HasInt64}
  397. ,btQWord,btInt64,btComp
  398. {$endif}];
  399. btAllIntegerNoQWord = btAllInteger{$ifdef HasInt64}-[btQWord]{$endif};
  400. btAllChars = [btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar];
  401. btAllStrings = [btString,
  402. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btShortString,btRawByteString,{$endif}
  403. btWideString,btUnicodeString];
  404. btAllStringAndChars = btAllStrings+btAllChars;
  405. btAllStringPointer = [btString,
  406. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btRawByteString,{$endif}
  407. btWideString,btUnicodeString];
  408. btAllFloats = [btSingle,btDouble,
  409. btExtended,btCExtended,btCurrency];
  410. btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool
  411. {$ifdef HasInt64},btQWordBool{$endif}];
  412. btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
  413. btAllRanges = btArrayRangeTypes+[btRange];
  414. btAllWithSubType = [btSet, btArrayLit, btArrayOrSet, btRange];
  415. btAllStandardTypes = [
  416. btChar,
  417. {$ifdef FPC_HAS_CPSTRING}
  418. btAnsiChar,
  419. {$endif}
  420. btWideChar,
  421. btString,
  422. {$ifdef FPC_HAS_CPSTRING}
  423. btAnsiString,
  424. btShortString,
  425. btRawByteString,
  426. {$endif}
  427. btWideString,
  428. btUnicodeString,
  429. btSingle,
  430. btDouble,
  431. btExtended,
  432. btCExtended,
  433. btCurrency,
  434. btBoolean,
  435. btByteBool,
  436. btWordBool,
  437. btLongBool,
  438. {$ifdef HasInt64}
  439. btQWordBool,
  440. {$endif}
  441. btByte,
  442. btShortInt,
  443. btWord,
  444. btSmallInt,
  445. btLongWord,
  446. btLongint,
  447. {$ifdef HasInt64}
  448. btQWord,
  449. btInt64,
  450. btComp,
  451. {$endif}
  452. btPointer
  453. {$ifdef fpc}
  454. ,btFile,
  455. btText,
  456. btVariant
  457. {$endif}
  458. ];
  459. ResBaseTypeNames: array[TResolverBaseType] of string =(
  460. 'None',
  461. 'Custom',
  462. 'Context',
  463. 'Module',
  464. 'Untyped',
  465. 'Char',
  466. {$ifdef FPC_HAS_CPSTRING}
  467. 'AnsiChar',
  468. {$endif}
  469. 'WideChar',
  470. 'String',
  471. {$ifdef FPC_HAS_CPSTRING}
  472. 'AnsiString',
  473. 'ShortString',
  474. 'RawByteString',
  475. {$endif}
  476. 'WideString',
  477. 'UnicodeString',
  478. 'Single',
  479. 'Double',
  480. 'Extended',
  481. 'CExtended',
  482. 'Currency',
  483. 'Boolean',
  484. 'ByteBool',
  485. 'WordBool',
  486. 'LongBool',
  487. {$ifdef HasInt64}
  488. 'QWordBool',
  489. {$endif}
  490. 'Byte',
  491. 'ShortInt',
  492. 'Word',
  493. 'SmallInt',
  494. 'UIntSingle',
  495. 'IntSingle',
  496. 'LongWord',
  497. 'Longint',
  498. 'UIntDouble',
  499. 'IntDouble',
  500. {$ifdef HasInt64}
  501. 'QWord',
  502. 'Int64',
  503. 'Comp',
  504. {$endif}
  505. 'Pointer',
  506. {$ifdef fpc}
  507. 'File',
  508. 'Text',
  509. 'Variant',
  510. {$endif}
  511. 'Nil',
  512. 'Procedure/Function',
  513. 'BuiltInProc',
  514. 'array property',
  515. 'set',
  516. 'array',
  517. 'set or array literal',
  518. 'range..'
  519. );
  520. type
  521. TResolverBuiltInProc = (
  522. bfCustom,
  523. bfLength,
  524. bfSetLength,
  525. bfInclude,
  526. bfExclude,
  527. bfBreak,
  528. bfContinue,
  529. bfExit,
  530. bfInc,
  531. bfDec,
  532. bfAssigned,
  533. bfChr,
  534. bfOrd,
  535. bfLow,
  536. bfHigh,
  537. bfPred,
  538. bfSucc,
  539. bfStrProc,
  540. bfStrFunc,
  541. bfWriteStr,
  542. bfVal,
  543. bfLo,
  544. bfHi,
  545. bfConcatArray,
  546. bfConcatString,
  547. bfCopyArray,
  548. bfInsertArray,
  549. bfDeleteArray,
  550. bfTypeInfo,
  551. bfAssert,
  552. bfNew,
  553. bfDispose,
  554. bfDefault
  555. );
  556. TResolverBuiltInProcs = set of TResolverBuiltInProc;
  557. const
  558. ResolverBuiltInProcNames: array[TResolverBuiltInProc] of string = (
  559. 'Custom',
  560. 'Length',
  561. 'SetLength',
  562. 'Include',
  563. 'Exclude',
  564. 'Break',
  565. 'Continue',
  566. 'Exit',
  567. 'Inc',
  568. 'Dec',
  569. 'Assigned',
  570. 'Chr',
  571. 'Ord',
  572. 'Low',
  573. 'High',
  574. 'Pred',
  575. 'Succ',
  576. 'Str',
  577. 'Str',
  578. 'WriteStr',
  579. 'Val',
  580. 'Lo',
  581. 'Hi',
  582. 'Concat',
  583. 'Concat',
  584. 'Copy',
  585. 'Insert',
  586. 'Delete',
  587. 'TypeInfo',
  588. 'Assert',
  589. 'New',
  590. 'Dispose',
  591. 'Default'
  592. );
  593. bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
  594. const
  595. ResolverResultVar = 'Result';
  596. {$IFDEF CheckPasTreeRefCount}
  597. RefIdInferenceParamsExpr = 'InferenceParamsExpr';
  598. {$ENDIF}
  599. type
  600. {$ifdef pas2js}
  601. TPasResIterate = procedure(Item, Arg: pointer) of object;
  602. { TPasResHashList }
  603. TPasResHashList = class
  604. private
  605. FItems: TJSObject;
  606. public
  607. constructor Create; reintroduce;
  608. procedure Add(const aName: string; Item: Pointer);
  609. function Find(const aName: string): Pointer;
  610. procedure ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  611. procedure Clear;
  612. procedure Remove(const aName: string);
  613. end;
  614. {$else}
  615. TPasResHashList = TFPHashList;
  616. {$endif}
  617. type
  618. { EPasResolve }
  619. EPasResolve = class(Exception)
  620. private
  621. FPasElement: TPasElement;
  622. procedure SetPasElement(AValue: TPasElement);
  623. public
  624. Id: TMaxPrecInt;
  625. MsgType: TMessageType;
  626. MsgNumber: integer;
  627. MsgPattern: String;
  628. Args: TMessageArgs;
  629. SourcePos: TPasSourcePos;
  630. destructor Destroy; override;
  631. property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
  632. end;
  633. type
  634. { TUnresolvedPendingRef }
  635. TUnresolvedPendingRef = class(TPasUnresolvedSymbolRef)
  636. public
  637. Element: TPasType; // TPasClassOfType or TPasPointerType
  638. end;
  639. { TPasSpecializeTypeData - CustomData of TPasSpecializeType
  640. for the generic type see TPasSpecializeType(Element).DestType }
  641. TPasSpecializeTypeData = Class(TResolveData)
  642. public
  643. SpecializedType: TPasGenericType;
  644. end;
  645. TPRSpecializeStep = (
  646. prssNone,
  647. prssInterfaceBuilding,
  648. prssInterfaceFinished,
  649. prssImplementationBuilding,
  650. prssImplementationFinished
  651. );
  652. { TPRSpecializedItem }
  653. TPRSpecializedItem = class
  654. private
  655. FSpecializedEl: TPasElement;
  656. public
  657. GenericEl: TPasElement;
  658. Step: TPRSpecializeStep; // how much of the specialized element has been created
  659. FirstSpecialize: TPasElement;
  660. Params: TPasTypeArray;
  661. SpecializedConstraints: TPasElementArray;
  662. destructor Destroy; override;
  663. property SpecializedEl: TPasElement read FSpecializedEl;
  664. end;
  665. { TPRSpecializedTypeItem }
  666. TPRSpecializedTypeItem = class(TPRSpecializedItem)
  667. private
  668. FSpecializedType: TPasGenericType;
  669. procedure SetSpecializedType(AValue: TPasGenericType);
  670. public
  671. HeaderScope: TObject;
  672. ImplProcs: TFPList;
  673. destructor Destroy; override;
  674. property SpecializedType: TPasGenericType read FSpecializedType write SetSpecializedType;
  675. end;
  676. { TPRSpecializedProcItem }
  677. TPRSpecializedProcItem = class(TPRSpecializedItem)
  678. private
  679. FSpecializedProc: TPasProcedure;
  680. procedure SetSpecializedProc(const AValue: TPasProcedure);
  681. public
  682. ImplProc: TPasProcedure;
  683. destructor Destroy; override;
  684. property SpecializedProc: TPasProcedure read FSpecializedProc write SetSpecializedProc;
  685. end;
  686. TPSRefAccess = (
  687. psraNone,
  688. psraRead,
  689. psraWrite,
  690. psraReadWrite,
  691. psraWriteRead,
  692. psraTypeInfo
  693. );
  694. { TPasScopeReference }
  695. TPasScopeReference = class
  696. private
  697. FElement: TPasElement;
  698. procedure SetElement(const AValue: TPasElement);
  699. public
  700. {$IFDEF VerbosePasResolver}
  701. Owner: TObject;
  702. {$ENDIF}
  703. Access: TPSRefAccess;
  704. NextSameName: TPasScopeReference;
  705. destructor Destroy; override;
  706. property Element: TPasElement read FElement write SetElement;
  707. end;
  708. TPasScope = class;
  709. { TPasScopeReferences - used by TPasAnalyzer to store references of a proc or initialization section }
  710. TPasScopeReferences = class
  711. private
  712. FScope: TPasScope;
  713. procedure OnClearItem(Item, Dummy: pointer);
  714. procedure OnCollectItem(Item, aList: pointer);
  715. public
  716. References: TPasResHashList; // hash list of TPasScopeReference
  717. constructor Create(aScope: TPasScope);
  718. destructor Destroy; override;
  719. procedure Clear;
  720. function Add(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  721. function Find(const aName: string): TPasScopeReference;
  722. function GetList: TFPList;
  723. property Scope: TPasScope read FScope;
  724. end;
  725. TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
  726. Data: Pointer; var Abort: boolean) of object;
  727. { TPasScope -
  728. Elements like TPasClassType use TPasScope descendants as CustomData for
  729. their sub identifiers.
  730. TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
  731. }
  732. TPasScope = Class(TResolveData)
  733. public
  734. VisibilityContext: TPasElement; // used to check if the current context
  735. // is allowed to access a private/protected element
  736. class function IsStoredInElement: boolean; virtual;
  737. class function FreeOnPop: boolean; virtual;
  738. procedure IterateElements(const aName: string; StartScope: TPasScope;
  739. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  740. var Abort: boolean); virtual;
  741. procedure WriteIdentifiers(Prefix: string); virtual;
  742. end;
  743. TPasScopeClass = class of TPasScope;
  744. TPasScopeArray = array of TPasScope;
  745. TPasModuleScopeFlag = (
  746. pmsfAssertSearched, // assert constructors searched
  747. pmsfRangeErrorNeeded, // somewhere is range checking on
  748. pmsfRangeErrorSearched // ERangeError constructor searched
  749. );
  750. TPasModuleScopeFlags = set of TPasModuleScopeFlag;
  751. { TPasModuleScope }
  752. TPasModuleScope = class(TPasScope)
  753. private
  754. FAssertClass: TPasClassType;
  755. FAssertDefConstructor: TPasConstructor;
  756. FAssertMsgConstructor: TPasConstructor;
  757. FRangeErrorClass: TPasClassType;
  758. FRangeErrorConstructor: TPasConstructor;
  759. FSystemTVarRec: TPasRecordType;
  760. procedure SetAssertClass(const AValue: TPasClassType);
  761. procedure SetAssertDefConstructor(const AValue: TPasConstructor);
  762. procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
  763. procedure SetRangeErrorClass(const AValue: TPasClassType);
  764. procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
  765. procedure SetSystemTVarRec(const AValue: TPasRecordType);
  766. public
  767. FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
  768. PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
  769. Flags: TPasModuleScopeFlags;
  770. BoolSwitches: TBoolSwitches;
  771. constructor Create; override;
  772. destructor Destroy; override;
  773. procedure IterateElements(const aName: string; StartScope: TPasScope;
  774. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  775. var Abort: boolean); override;
  776. property AssertClass: TPasClassType read FAssertClass write SetAssertClass;
  777. property AssertDefConstructor: TPasConstructor read FAssertDefConstructor write SetAssertDefConstructor;
  778. property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
  779. property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
  780. property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
  781. property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
  782. end;
  783. TPasModuleScopeClass = class of TPasModuleScope;
  784. TPasIdentifierKind = (
  785. pikNone, // not yet initialized
  786. pikBaseType, // e.g. longint
  787. pikBuiltInProc, // e.g. High(), SetLength()
  788. pikSimple, // simple vars, consts, types, enums
  789. pikProc, // may need parameter list with round brackets
  790. pikNamespace
  791. );
  792. TPasIdentifierKinds = set of TPasIdentifierKind;
  793. { TPasIdentifier }
  794. TPasIdentifier = Class(TObject)
  795. private
  796. FElement: TPasElement;
  797. procedure SetElement(AValue: TPasElement);
  798. public
  799. {$IFDEF VerbosePasResolver}
  800. Owner: TObject;
  801. {$ENDIF}
  802. Identifier: String;
  803. NextSameIdentifier: TPasIdentifier; // next identifier with same name
  804. Kind: TPasIdentifierKind;
  805. destructor Destroy; override;
  806. property Element: TPasElement read FElement write SetElement;
  807. end;
  808. TPasIdentifierArray = array of TPasIdentifier;
  809. { TPasIdentifierScope - elements with a list of sub identifiers }
  810. TPasIdentifierScope = Class(TPasScope)
  811. private
  812. FItems: TPasResHashList; // hashlist of TPasIdentifier
  813. procedure InternalAdd(Item: TPasIdentifier);
  814. procedure OnClearItem(Item, Dummy: pointer);
  815. procedure OnCollectItem(Item, List: pointer);
  816. protected
  817. procedure OnWriteItem(Item, Dummy: pointer);
  818. public
  819. constructor Create; override;
  820. destructor Destroy; override;
  821. function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
  822. function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
  823. function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
  824. function AddIdentifier(const Identifier: String; El: TPasElement;
  825. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  826. function FindElement(const aName: string): TPasElement;
  827. procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
  828. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  829. var Abort: boolean);
  830. procedure IterateElements(const aName: string; StartScope: TPasScope;
  831. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  832. var Abort: boolean); override;
  833. procedure WriteIdentifiers(Prefix: string); override;
  834. procedure WriteLocalIdentifiers(Prefix: string); virtual;
  835. function GetLocalIdentifiers: TFPList; virtual;
  836. end;
  837. TPasIdentifierScopeArray = array of TPasIdentifierScope;
  838. { TPasDefaultScope - root scope }
  839. TPasDefaultScope = class(TPasIdentifierScope)
  840. public
  841. class function IsStoredInElement: boolean; override;
  842. end;
  843. { TPasIterateFilterData }
  844. TPasIterateFilterData = record
  845. OnIterate: TIterateScopeElement;
  846. Data: Pointer;
  847. end;
  848. PPasIterateFilterData = ^TPasIterateFilterData;
  849. { TPRHelperEntry }
  850. TPRHelperEntry = class
  851. public
  852. Added: integer; // Added is bigger when it was added later to the list
  853. HelperForType: TPasType; // alias resolved
  854. Helper: TPasClassType;
  855. end;
  856. TPRHelperEntryArray = array of TPRHelperEntry;
  857. { TPasSectionScope - e.g. interface, implementation, program, library }
  858. TPasSectionScope = Class(TPasIdentifierScope)
  859. private
  860. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  861. Data: Pointer; var Abort: boolean);
  862. public
  863. UsesScopes: TFPList; // list of TPasSectionScope
  864. UsesFinished: boolean;
  865. Finished: boolean;
  866. BoolSwitches: TBoolSwitches;
  867. ModeSwitches: TModeSwitches;
  868. Helpers: TPRHelperEntryArray; // only created for interface. Sorted ascending ComparePRHelperEntries
  869. constructor Create; override;
  870. destructor Destroy; override;
  871. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  872. procedure IterateElements(const aName: string; StartScope: TPasScope;
  873. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  874. var Abort: boolean); override;
  875. procedure WriteIdentifiers(Prefix: string); override;
  876. end;
  877. TPasSectionScopeClass = class of TPasSectionScope;
  878. { TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
  879. TPasInitialFinalizationScope = Class(TPasScope)
  880. public
  881. References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
  882. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  883. destructor Destroy; override;
  884. end;
  885. TPasInitialFinalizationScopeClass = class of TPasInitialFinalizationScope;
  886. { TPasEnumTypeScope }
  887. TPasEnumTypeScope = Class(TPasIdentifierScope)
  888. public
  889. CanonicalSet: TPasSetType;
  890. destructor Destroy; override;
  891. end;
  892. { TPasGenericParamsScope - used during parsing TPasGenericTemplateType(s) }
  893. TPasGenericParamsScope = Class(TPasIdentifierScope)
  894. public
  895. GenericType: TPasGenericType;
  896. end;
  897. TPSGenericStep = (
  898. psgsNone,
  899. psgsInterfaceParsed,
  900. psgsImplementationParsed
  901. );
  902. { TPasGenericScope }
  903. TPasGenericScope = Class(TPasIdentifierScope)
  904. public
  905. // for generic type:
  906. SpecializedItems: TObjectList; // list of TPRSpecializedItem
  907. GenericStep: TPSGenericStep; // how much of the generic was parsed
  908. // for specialized type:
  909. SpecializedFromItem: TPRSpecializedItem;
  910. destructor Destroy; override;
  911. end;
  912. { TPasArrayScope }
  913. TPasArrayScope = Class(TPasGenericScope)
  914. public
  915. end;
  916. { TPasProcTypeScope }
  917. TPasProcTypeScope = Class(TPasGenericScope)
  918. public
  919. end;
  920. { TPasClassOrRecordScope }
  921. TPasClassOrRecordScope = Class(TPasGenericScope)
  922. public
  923. DefaultProperty: TPasProperty;
  924. ClassConstructor: TPasClassConstructor;
  925. ClassDestructor: TPasClassDestructor;
  926. end;
  927. { TPasRecordScope }
  928. TPasRecordScope = Class(TPasClassOrRecordScope)
  929. end;
  930. TPasClassScopeFlag = (
  931. pcsfAncestorResolved,
  932. pcsfSealed,
  933. pcsfPublished // default visibility is published due to $M directive
  934. );
  935. TPasClassScopeFlags = set of TPasClassScopeFlag;
  936. { TPasClassIntfMap }
  937. TPasClassIntfMap = class
  938. public
  939. Element: TPasElement;
  940. Intf: TPasClassType;
  941. Procs: TFPList;// maps Interface-member-index to TPasProcedure
  942. AncestorMap: TPasClassIntfMap;// AncestorMap.Element=Element, AncestorMap.Intf=DirectAncestor
  943. destructor Destroy; override;
  944. end;
  945. { TPasClassScope }
  946. TPasClassScope = Class(TPasClassOrRecordScope)
  947. public
  948. AncestorScope: TPasClassScope;
  949. CanonicalClassOf: TPasClassOfType;
  950. DirectAncestor: TPasType; // TPasClassType or TPasAliasType, see GetPasClassAncestor
  951. // Note: TPasClassType.AncestorType might be nil and DirectAncestor is "TObject"
  952. Flags: TPasClassScopeFlags;
  953. AbstractProcs: TArrayOfPasProcedure;
  954. Interfaces: TFPList; // list corresponds to TPasClassType(Element).Interfaces,
  955. // elements: TPasProperty for 'implements', or TPasClassIntfMap
  956. destructor Destroy; override;
  957. end;
  958. TPasClassScopeClass = class of TPasClassScope;
  959. { TPasGroupScope }
  960. TPasGroupScope = Class(TPasIdentifierScope)
  961. public
  962. Scopes: TPasIdentifierScopeArray;
  963. Count: integer;
  964. procedure Add(Scope: TPasIdentifierScope);
  965. destructor Destroy; override;
  966. function GetFirstNonHelperScope: TPasIdentifierScope;
  967. class function IsStoredInElement: boolean; override;
  968. function FindAncestorIdentifier(const Identifier: String): TPasIdentifier;
  969. function FindAncestorElement(const Identifier: String): TPasElement;
  970. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  971. procedure IterateElements(const aName: string; StartScope: TPasScope;
  972. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  973. var Abort: boolean); override;
  974. procedure WriteIdentifiers(Prefix: string); override;
  975. end;
  976. TPasProcedureScopeFlag = (
  977. ppsfIsGroupOverload, // mode objfpc: one overload is enough for all procs in same scope
  978. ppsfIsSpecialized
  979. );
  980. TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
  981. { TPasProcedureScope }
  982. TPasProcedureScope = Class(TPasGenericScope)
  983. public
  984. DeclarationProc: TPasProcedure; // the corresponding forward declaration
  985. ImplProc: TPasProcedure; // the corresponding proc with Body
  986. OverriddenProc: TPasProcedure; // the ancestor proc with same signature
  987. ClassRecScope: TPasClassOrRecordScope;
  988. GroupScope: TPasGroupScope; // set during parsing a method body
  989. SelfArg: TPasArgument;
  990. Flags: TPasProcedureScopeFlags;
  991. BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
  992. ModeSwitches: TModeSwitches; // at proc start
  993. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  994. procedure IterateElements(const aName: string; StartScope: TPasScope;
  995. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  996. var Abort: boolean); override;
  997. function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
  998. procedure WriteIdentifiers(Prefix: string); override;
  999. destructor Destroy; override;
  1000. public
  1001. References: TPasScopeReferences; // created by TPasAnalyzer in DeclrationProc
  1002. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  1003. function GetReferences: TFPList;
  1004. end;
  1005. TPasProcedureScopeClass = class of TPasProcedureScope;
  1006. { TPasPropertyScope }
  1007. TPasPropertyScope = Class(TPasIdentifierScope)
  1008. public
  1009. AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
  1010. otherwise it is a redeclaration }
  1011. destructor Destroy; override;
  1012. end;
  1013. { TPasExceptOnScope }
  1014. TPasExceptOnScope = Class(TPasIdentifierScope)
  1015. end;
  1016. TPasWithScope = class;
  1017. TPasWithExprScopeFlag = (
  1018. wesfNeedTmpVar,
  1019. wesfOnlyTypeMembers,
  1020. wesfIsClassOf,
  1021. wesfConstParent // not writable
  1022. );
  1023. TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
  1024. { TPasWithExprScope }
  1025. TPasWithExprScope = Class(TPasScope)
  1026. public
  1027. WithScope: TPasWithScope; // owner
  1028. Index: integer;
  1029. Expr: TPasExpr;
  1030. Scope: TPasGroupScope;
  1031. ClassRecScope: TPasClassOrRecordScope;
  1032. Flags: TPasWithExprScopeFlags;
  1033. class function IsStoredInElement: boolean; override;
  1034. class function FreeOnPop: boolean; override;
  1035. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1036. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1037. var Abort: boolean); override;
  1038. procedure WriteIdentifiers(Prefix: string); override;
  1039. destructor Destroy; override;
  1040. end;
  1041. TPasWithExprScopeClass = class of TPasWithExprScope;
  1042. { TPasWithScope }
  1043. TPasWithScope = Class(TPasScope)
  1044. public
  1045. // Element is the TPasImplWithDo
  1046. ExpressionScopes: TObjectList; // list of TPasWithExprScope
  1047. constructor Create; override;
  1048. destructor Destroy; override;
  1049. end;
  1050. { TPasForLoopScope }
  1051. TPasForLoopScope = Class(TPasScope)
  1052. public
  1053. GetEnumerator: TPasFunction;
  1054. MoveNext: TPasFunction;
  1055. Current: TPasProperty;
  1056. end;
  1057. { TPasSubExprScope - base class for sub scopes aka dotted scopes }
  1058. TPasSubExprScope = Class(TPasIdentifierScope)
  1059. public
  1060. class function IsStoredInElement: boolean; override;
  1061. end;
  1062. { TPasDotBaseScope }
  1063. TPasDotBaseScope = Class(TPasSubExprScope)
  1064. public
  1065. GroupScope: TPasGroupScope;
  1066. OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
  1067. ConstParent: boolean;
  1068. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1069. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1070. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1071. var Abort: boolean); override;
  1072. procedure WriteIdentifiers(Prefix: string); override;
  1073. destructor Destroy; override;
  1074. end;
  1075. { TPasModuleDotScope - scope for searching unitname.<identifier> }
  1076. TPasModuleDotScope = Class(TPasDotBaseScope)
  1077. private
  1078. FModule: TPasModule;
  1079. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  1080. Data: Pointer; var Abort: boolean);
  1081. procedure SetModule(AValue: TPasModule);
  1082. public
  1083. ImplementationScope: TPasSectionScope;
  1084. InterfaceScope: TPasSectionScope;
  1085. SystemScope: TPasDefaultScope;
  1086. destructor Destroy; override;
  1087. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1088. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1089. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1090. var Abort: boolean); override;
  1091. procedure WriteIdentifiers(Prefix: string); override;
  1092. property Module: TPasModule read FModule write SetModule;
  1093. end;
  1094. { TPasDotEnumTypeScope - used for EnumType.EnumValue }
  1095. TPasDotEnumTypeScope = Class(TPasDotBaseScope)
  1096. public
  1097. EnumScope: TPasEnumTypeScope;
  1098. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1099. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1100. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1101. var Abort: boolean); override;
  1102. procedure WriteIdentifiers(Prefix: string); override;
  1103. end;
  1104. { TPasDotClassOrRecordScope }
  1105. TPasDotClassOrRecordScope = Class(TPasDotBaseScope)
  1106. public
  1107. ClassRecScope: TPasClassOrRecordScope;
  1108. end;
  1109. { TPasDotClassScope - used for aClass.subidentifier }
  1110. TPasDotClassScope = Class(TPasDotClassOrRecordScope)
  1111. public
  1112. IsClassOf: boolean; // true if aClassOf.
  1113. end;
  1114. { TPasInheritedScope - used for inherited; and inherited Name() }
  1115. TPasInheritedScope = Class(TPasDotClassOrRecordScope)
  1116. public
  1117. AncestorScope: TPasClassScope;
  1118. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1119. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1120. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1121. var Abort: boolean); override;
  1122. procedure WriteIdentifiers(Prefix: string); override;
  1123. end;
  1124. { TPasDotHelperScope }
  1125. TPasDotHelperScope = class(TPasDotBaseScope)
  1126. end;
  1127. TResolvedReferenceFlag = (
  1128. rrfDotScope, // found reference via a dot scope (TPasDotBaseScope)
  1129. rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
  1130. rrfNoImplicitCallWithoutParams, // a TPrimitiveExpr is not an implicit call
  1131. rrfNewInstance, // constructor call (without it call constructor as normal method)
  1132. rrfFreeInstance, // destructor call (without it call destructor as normal method)
  1133. rrfVMT, // use VMT for call
  1134. rrfConstInherited // parent is const and this child is too
  1135. );
  1136. TResolvedReferenceFlags = set of TResolvedReferenceFlag;
  1137. type
  1138. { TResolvedRefContext }
  1139. TResolvedRefContext = Class
  1140. end;
  1141. TResolvedRefAccess = (
  1142. rraNone,
  1143. rraRead, // expression is read
  1144. rraAssign, // expression is LHS assign
  1145. rraReadAndAssign, // expression is LHS +=, -=, *=, /=
  1146. rraVarParam, // expression is passed to a var parameter
  1147. rraOutParam, // expression is passed to an out parameter
  1148. rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
  1149. // will later be changed to rraRead, rraVarParam, rraOutParam
  1150. );
  1151. TPRResolveVarAccesses = set of TResolvedRefAccess;
  1152. const
  1153. rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
  1154. ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
  1155. psraNone, // rraNone
  1156. psraRead, // rraRead
  1157. psraWrite, // rraAssign
  1158. psraReadWrite, // rraReadAndAssign
  1159. psraReadWrite, // rraVarParam
  1160. psraWrite, // rraOutParam
  1161. psraNone // rraParamToUnknownProc
  1162. );
  1163. type
  1164. { TResolvedReference - CustomData for normal references }
  1165. TResolvedReference = Class(TResolveData)
  1166. private
  1167. FDeclaration: TPasElement;
  1168. procedure SetDeclaration(AValue: TPasElement);
  1169. public
  1170. Flags: TResolvedReferenceFlags;
  1171. Access: TResolvedRefAccess;
  1172. Context: TResolvedRefContext;
  1173. WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
  1174. destructor Destroy; override;
  1175. property Declaration: TPasElement read FDeclaration write SetDeclaration;
  1176. end;
  1177. { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
  1178. TResolvedRefCtxConstructor = Class(TResolvedRefContext)
  1179. public
  1180. Typ: TPasType;
  1181. end;
  1182. { TResolvedRefCtxAttrProc - constructor of an attribute }
  1183. TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
  1184. public
  1185. Proc: TPasConstructor;
  1186. end;
  1187. TPasResolverResultFlag = (
  1188. rrfReadable,
  1189. rrfWritable,
  1190. rrfAssignable, // not writable in general, e.g. aString[1]:=
  1191. rrfCanBeStatement
  1192. );
  1193. TPasResolverResultFlags = set of TPasResolverResultFlag;
  1194. type
  1195. { TPasResolverResult }
  1196. TPasResolverResult = record
  1197. BaseType: TResolverBaseType;
  1198. SubType: TResolverBaseType; // for btSet, btArrayLit, btArrayOrSet, btRange
  1199. IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
  1200. LoTypeEl: TPasType; // can be nil for const expression, all alias resolved
  1201. HiTypeEl: TPasType; // same as LoTypeEl, except alias types are not resolved
  1202. ExprEl: TPasExpr;
  1203. Flags: TPasResolverResultFlags;
  1204. end;
  1205. PPasResolverResult = ^TPasResolverResult;
  1206. TPasResolverResultArray = array of TPasResolverResult;
  1207. type
  1208. TPasResolverComputeFlag = (
  1209. rcSetReferenceFlags, // set flags of references while computing type, used by Resolve* methods
  1210. rcNoImplicitProc, // do not call a function without params, includes rcNoImplicitProcType
  1211. rcNoImplicitProcType, // do not call a proc type without params
  1212. rcConstant, // resolve a constant expression, error if not computable
  1213. rcType // resolve a type expression
  1214. );
  1215. TPasResolverComputeFlags = set of TPasResolverComputeFlag;
  1216. TResElDataBuiltInSymbol = Class(TResolveData)
  1217. public
  1218. end;
  1219. { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
  1220. TResElDataBaseType = Class(TResElDataBuiltInSymbol)
  1221. public
  1222. BaseType: TResolverBaseType;
  1223. end;
  1224. TResElDataBaseTypeClass = class of TResElDataBaseType;
  1225. TResElDataBuiltInProc = Class;
  1226. TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
  1227. Exp: TPasExpr; RaiseOnError: boolean): integer of object;
  1228. TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1229. out ResolvedEl: TPasResolverResult) of object;
  1230. TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1231. Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
  1232. TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
  1233. Params: TParamsExpr) of object;
  1234. TBuiltInProcFlag = (
  1235. bipfCanBeStatement // a call is enough for a simple statement
  1236. );
  1237. TBuiltInProcFlags = set of TBuiltInProcFlag;
  1238. { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
  1239. TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
  1240. public
  1241. Proc: TPasUnresolvedSymbolRef;
  1242. Signature: string;
  1243. BuiltIn: TResolverBuiltInProc;
  1244. GetCallCompatibility: TOnGetCallCompatibility;
  1245. GetCallResult: TOnGetCallResult;
  1246. Eval: TOnEvalBIFunction;
  1247. FinishParamsExpression: TOnFinishParamsExpr;
  1248. Flags: TBuiltInProcFlags;
  1249. destructor Destroy; override;
  1250. end;
  1251. { TPRFindData }
  1252. TPRFindData = record
  1253. ErrorPosEl: TPasElement;
  1254. Found: TPasElement;
  1255. ElScope: TPasScope; // Where Found was found
  1256. StartScope: TPasScope; // where the search started
  1257. end;
  1258. PPRFindData = ^TPRFindData;
  1259. TPRFindGenericData = record
  1260. Find: TPRFindData;
  1261. TemplateCount: integer;
  1262. end;
  1263. PPRFindGenericData = ^TPRFindGenericData;
  1264. TPasResolverOption = (
  1265. proFixCaseOfOverrides, // fix Name of overriding proc/property to the overriden proc/property
  1266. proClassPropertyNonStatic, // class property accessors can be non static
  1267. proPropertyAsVarParam, // allows to pass a property as a var/out argument
  1268. proClassOfIs, // class-of supports is and as operator
  1269. proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
  1270. proOpenAsDynArrays, // open arrays work like dynamic arrays
  1271. //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
  1272. //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
  1273. proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
  1274. proMethodAddrAsPointer // can assign @method to a pointer
  1275. );
  1276. TPasResolverOptions = set of TPasResolverOption;
  1277. TPasResolverStep = (
  1278. prsInit,
  1279. prsParsing,
  1280. prsFinishingModule,
  1281. prsFinishedModule
  1282. );
  1283. TPasResolverSteps = set of TPasResolverStep;
  1284. TPRResolveAlias = (
  1285. prraNone, // do not resolve alias
  1286. prraSimple, // resolve alias, but not type alias
  1287. prraAlias // resolve alias and type alias
  1288. );
  1289. TPRProcTypeDescFlag = (
  1290. prptdUseName, // add name if available
  1291. prptdAddPaths, // add full paths to types
  1292. prptdResolveSimpleAlias
  1293. );
  1294. TPRProcTypeDescFlags = set of TPRProcTypeDescFlag;
  1295. TPRParentParams = record
  1296. InlineSpec: TInlineSpecializeExpr;
  1297. Params: TParamsExpr;
  1298. end;
  1299. TPRTemplateCompOp = (
  1300. prtcoAssignToTempl,
  1301. prtcoAssignFromTempl,
  1302. prtcoEqual
  1303. );
  1304. { TPasResolver }
  1305. TPasResolver = Class(TPasTreeContainer)
  1306. private
  1307. type
  1308. TResolveDataListKind = (lkBuiltIn,lkModule);
  1309. function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
  1310. function GetScopes(Index: integer): TPasScope; inline;
  1311. private
  1312. FActiveHelpers: TPRHelperEntryArray; // sorted ascending ComparePRHelperEntries
  1313. FAnonymousElTypePostfix: String;
  1314. FBaseTypeChar: TResolverBaseType;
  1315. FBaseTypeExtended: TResolverBaseType;
  1316. FBaseTypeLength: TResolverBaseType;
  1317. FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
  1318. FBaseTypeString: TResolverBaseType;
  1319. FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
  1320. FDefaultNameSpace: String;
  1321. FDefaultScope: TPasDefaultScope;
  1322. FDynArrayMaxIndex: TMaxPrecInt;
  1323. FDynArrayMinIndex: TMaxPrecInt;
  1324. FLastCreatedData: array[TResolveDataListKind] of TResolveData;
  1325. FLastElement: TPasElement;
  1326. FLastMsg: string;
  1327. FLastMsgArgs: TMessageArgs;
  1328. FLastMsgElement: TPasElement;
  1329. FLastMsgId: TMaxPrecInt;
  1330. FLastMsgNumber: integer;
  1331. FLastMsgPattern: string;
  1332. FLastMsgType: TMessageType;
  1333. FLastSourcePos: TPasSourcePos;
  1334. FOptions: TPasResolverOptions;
  1335. FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
  1336. FRootElement: TPasModule;
  1337. FScopeClass_Class: TPasClassScopeClass;
  1338. FScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass;
  1339. FScopeClass_Module: TPasModuleScopeClass;
  1340. FScopeClass_Proc: TPasProcedureScopeClass;
  1341. FScopeClass_Section: TPasSectionScopeClass;
  1342. FScopeClass_WithExpr: TPasWithExprScopeClass;
  1343. FScopeCount: integer;
  1344. FScopes: TPasScopeArray; // stack of scopes
  1345. FStep: TPasResolverStep;
  1346. FStoreSrcColumns: boolean;
  1347. FStashScopeCount: integer;
  1348. FStashScopes: TPasScopeArray; // stack of scopes
  1349. FTopScope: TPasScope;
  1350. procedure ClearResolveDataList(Kind: TResolveDataListKind);
  1351. function GetBaseTypeNames(bt: TResolverBaseType): string;
  1352. function GetBuiltInProcs(bp: TResolverBuiltInProc): TResElDataBuiltInProc;
  1353. protected
  1354. const
  1355. cExact = 0;
  1356. cGenericExact = cExact+1;
  1357. cAliasExact = cGenericExact+1;
  1358. cCompatible = cAliasExact+1;
  1359. cIntToIntConversion = ord(High(TResolverBaseType));
  1360. cFloatToFloatConversion = 2*cIntToIntConversion;
  1361. cTypeConversion = cExact+10000; // e.g. TObject to Pointer
  1362. cLossyConversion = cExact+100000;
  1363. cIntToFloatConversion = cExact+400000; // int to float is worse than bigint to smallint
  1364. cIncompatible = High(integer);
  1365. var
  1366. cTGUIDToString: integer;
  1367. cStringToTGUID: integer;
  1368. cInterfaceToTGUID: integer;
  1369. cInterfaceToString: integer;
  1370. type
  1371. TFindCallElData = record
  1372. Params: TParamsExpr;
  1373. TemplCnt: integer;
  1374. Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
  1375. LastProc: TPasProcedure;
  1376. ElScope, StartScope: TPasScope;
  1377. Distance: integer; // compatibility distance
  1378. Count: integer;
  1379. List: TFPList; // if not nil then collect all found elements here
  1380. end;
  1381. PFindCallElData = ^TFindCallElData;
  1382. TFindProcKind = (
  1383. fpkProcDeclaration, // search declaration for a body
  1384. fpkProc, // check overloads for a proc
  1385. fpkMethod // check overloads for a method
  1386. );
  1387. TFindProcData = record
  1388. Proc: TPasProcedure;
  1389. Args: TFPList; // List of TPasArgument objects
  1390. Kind: TFindProcKind;
  1391. FoundOverloadModifier: boolean;
  1392. FoundInSameScope: integer;
  1393. Found: TPasProcedure;
  1394. ElScope, StartScope: TPasScope;
  1395. FoundNonProc: TPasElement;
  1396. end;
  1397. PFindProcData = ^TFindProcData;
  1398. procedure OnFindFirst_PreferNoParams(El: TPasElement; ElScope, StartScope: TPasScope;
  1399. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1400. procedure OnFindFirst(El: TPasElement; ElScope, StartScope: TPasScope;
  1401. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1402. procedure OnFindFirst_GenericEl(El: TPasElement; ElScope, StartScope: TPasScope;
  1403. FindFirstGenericData: Pointer; var Abort: boolean); virtual;
  1404. procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
  1405. FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
  1406. procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
  1407. FindProcData: Pointer; var Abort: boolean); virtual;
  1408. procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
  1409. FindProcData: Pointer; var Abort: boolean); virtual;
  1410. function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
  1411. function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
  1412. Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
  1413. protected
  1414. procedure SetCurrentParser(AValue: TPasParser); override;
  1415. procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
  1416. State: TWarnMsgState; var Handled: boolean); virtual;
  1417. procedure SetRootElement(const AValue: TPasModule); virtual;
  1418. procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
  1419. function AddIdentifier(Scope: TPasIdentifierScope;
  1420. const aName: String; El: TPasElement;
  1421. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  1422. procedure AddModule(El: TPasModule); virtual;
  1423. procedure AddSection(El: TPasSection); virtual;
  1424. procedure AddInitialFinalizationSection(El: TPasImplBlock); virtual;
  1425. procedure AddType(El: TPasType); virtual;
  1426. procedure AddArrayType(El: TPasArrayType; TypeParams: TFPList); virtual;
  1427. procedure AddRecordType(El: TPasRecordType; TypeParams: TFPList); virtual;
  1428. procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual;
  1429. procedure AddVariable(El: TPasVariable); virtual;
  1430. procedure AddResourceString(El: TPasResString); virtual;
  1431. procedure AddEnumType(El: TPasEnumType); virtual;
  1432. procedure AddEnumValue(El: TPasEnumValue); virtual;
  1433. procedure AddProperty(El: TPasProperty); virtual;
  1434. procedure AddProcedureType(El: TPasProcedureType; TypeParams: TFPList); virtual;
  1435. procedure AddProcedure(El: TPasProcedure; TypeParams: TFPList); virtual;
  1436. procedure AddProcedureBody(El: TProcedureBody); virtual;
  1437. procedure AddArgument(El: TPasArgument); virtual;
  1438. procedure AddFunctionResult(El: TPasResultElement); virtual;
  1439. procedure AddGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1440. procedure AddExceptOn(El: TPasImplExceptOn); virtual;
  1441. procedure AddWithDo(El: TPasImplWithDo); virtual;
  1442. procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
  1443. procedure ResolveImplElement(El: TPasImplElement); virtual;
  1444. procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
  1445. procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
  1446. procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
  1447. procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
  1448. procedure ResolveImplAssign(El: TPasImplAssign); virtual;
  1449. procedure ResolveImplSimple(El: TPasImplSimple); virtual;
  1450. procedure ResolveImplRaise(El: TPasImplRaise); virtual;
  1451. procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
  1452. procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
  1453. procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
  1454. procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
  1455. procedure ResolveInheritedCall(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1456. procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1457. procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1458. procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1459. procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
  1460. procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1461. procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; TemplParams: TFPList;
  1462. Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string = ''); virtual;
  1463. procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1464. procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1465. procedure ResolveArrayParamsArgs(Params: TParamsExpr;
  1466. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
  1467. function ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  1468. const ResolvedValue: TPasResolverResult;
  1469. Access: TResolvedRefAccess): boolean; virtual;
  1470. procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
  1471. procedure ResolveArrayValues(El: TArrayValues); virtual;
  1472. procedure ResolveRecordValues(El: TRecordValues); virtual;
  1473. procedure ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr; Access: TResolvedRefAccess); virtual;
  1474. function ResolveAccessor(Expr: TPasExpr): TPasElement;
  1475. procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
  1476. Access: TResolvedRefAccess); virtual;
  1477. procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
  1478. function MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType): boolean; virtual;
  1479. procedure MarkArrayExprRecursive(Expr: TPasExpr; ArrType: TPasArrayType); virtual;
  1480. procedure FinishModule(CurModule: TPasModule); virtual;
  1481. procedure FinishUsesClause; virtual;
  1482. procedure FinishSection(Section: TPasSection); virtual;
  1483. procedure FinishInterfaceSection(Section: TPasSection); virtual;
  1484. procedure FinishTypeSection(El: TPasElement); virtual;
  1485. procedure FinishTypeSectionEl(El: TPasType); virtual;
  1486. procedure FinishTypeDef(El: TPasType); virtual;
  1487. procedure FinishEnumType(El: TPasEnumType); virtual;
  1488. procedure FinishSetType(El: TPasSetType); virtual;
  1489. procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
  1490. procedure FinishRangeType(El: TPasRangeType); virtual;
  1491. procedure FinishConstRangeExpr(RangeExpr: TBinaryExpr;
  1492. out LeftResolved, RightResolved: TPasResolverResult);
  1493. procedure FinishRecordType(El: TPasRecordType); virtual;
  1494. procedure FinishClassType(El: TPasClassType); virtual;
  1495. procedure FinishClassOfType(El: TPasClassOfType); virtual;
  1496. procedure FinishPointerType(El: TPasPointerType); virtual;
  1497. procedure FinishArrayType(El: TPasArrayType); virtual;
  1498. procedure FinishAliasType(El: TPasAliasType); virtual;
  1499. procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1500. procedure FinishSpecializeType(El: TPasSpecializeType); virtual;
  1501. procedure FinishResourcestring(El: TPasResString); virtual;
  1502. procedure FinishProcedure(Proc: TPasProcedure); virtual;
  1503. procedure FinishProcedureType(El: TPasProcedureType); virtual;
  1504. procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
  1505. procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
  1506. procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
  1507. procedure FinishExceptOnExpr; virtual;
  1508. procedure FinishExceptOnStatement; virtual;
  1509. procedure FinishWithDo(El: TPasImplWithDo); virtual;
  1510. procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual;
  1511. procedure FinishDeclaration(El: TPasElement); virtual;
  1512. procedure FinishVariable(El: TPasVariable); virtual;
  1513. procedure FinishProperty(PropEl: TPasProperty); virtual;
  1514. procedure FinishArgument(El: TPasArgument); virtual;
  1515. procedure FinishAncestors(aClass: TPasClassType); virtual;
  1516. procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
  1517. procedure FinishAttributes(El: TPasAttributes); virtual;
  1518. procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
  1519. procedure FinishPropertyParamAccess(Params: TParamsExpr;
  1520. Prop: TPasProperty); virtual;
  1521. procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
  1522. procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
  1523. procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
  1524. function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
  1525. procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  1526. procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
  1527. function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
  1528. procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
  1529. procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
  1530. IsOverride: boolean);
  1531. procedure CheckPendingForwardProcs(El: TPasElement);
  1532. procedure CheckPointerCycle(El: TPasPointerType);
  1533. procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
  1534. procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
  1535. Flags: TPasResolverComputeFlags); virtual;
  1536. procedure ComputeBinaryExpr(Bin: TBinaryExpr;
  1537. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1538. StartEl: TPasElement);
  1539. procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
  1540. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1541. var LeftResolved, RightResolved: TPasResolverResult); virtual;
  1542. function ComputeAddStringRes(
  1543. const LeftResolved, RightResolved: TPasResolverResult; ExprEl: TPasExpr;
  1544. out ResolvedEl: TPasResolverResult): boolean; virtual;
  1545. procedure ComputeArgumentAndExpr(
  1546. Arg: TPasArgument; out ArgResolved: TPasResolverResult;
  1547. Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  1548. SetReferenceFlags: boolean);
  1549. procedure ComputeArrayParams(Params: TParamsExpr;
  1550. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1551. StartEl: TPasElement);
  1552. procedure ComputeArrayParams_Class(Params: TParamsExpr;
  1553. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  1554. Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
  1555. procedure ComputeFuncParams(Params: TParamsExpr;
  1556. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1557. StartEl: TPasElement);
  1558. procedure ComputeTypeCast(ToLoType, ToHiType: TPasType;
  1559. Param: TPasExpr; const ParamResolved: TPasResolverResult;
  1560. out ResolvedEl: TPasResolverResult;
  1561. Flags: TPasResolverComputeFlags); virtual;
  1562. procedure ComputeSetParams(Params: TParamsExpr;
  1563. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1564. StartEl: TPasElement);
  1565. procedure ComputeDereference(El: TUnaryExpr; var ResolvedEl: TPasResolverResult);
  1566. procedure ComputeArrayValuesExpectedType(El: TArrayValues; out ResolvedEl: TPasResolverResult;
  1567. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1568. procedure ComputeRecordValues(El: TRecordValues; out ResolvedEl: TPasResolverResult;
  1569. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1570. procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
  1571. function CheckTypeCastClassInstanceToClass(
  1572. const FromClassRes, ToClassRes: TPasResolverResult;
  1573. ErrorEl: TPasElement): integer; virtual;
  1574. procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
  1575. const LHS, RHS: TPasResolverResult);
  1576. function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
  1577. ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
  1578. procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
  1579. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  1580. procedure ConvertRangeToElement(var ResolvedEl: TPasResolverResult);
  1581. function IsCharLiteral(const Value: string; ErrorPos: TPasElement): TResolverBaseType; virtual;
  1582. function CheckForIn(Loop: TPasImplForLoop;
  1583. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1584. function CheckForInClassOrRec(Loop: TPasImplForLoop;
  1585. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1586. function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
  1587. MinCount: integer; RaiseOnError: boolean): boolean;
  1588. function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1589. MaxCount: integer; RaiseOnError: boolean): integer;
  1590. function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
  1591. const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
  1592. function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  1593. function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  1594. procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
  1595. Params: TParamsExpr); virtual;
  1596. function FindClassTypeAndConstructor(const aUnitName, aClassName: string;
  1597. out aClass: TPasClassType; out aConstructor: TPasConstructor;
  1598. ErrorEl: TPasElement): boolean; virtual;
  1599. procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
  1600. procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
  1601. function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
  1602. function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
  1603. function FindDefaultConstructor(aClass: TPasClassType): TPasConstructor; virtual;
  1604. protected
  1605. // constant evaluation
  1606. fExprEvaluator: TResExprEvaluator;
  1607. procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
  1608. MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
  1609. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); virtual;
  1610. function OnExprEvalIdentifier(Sender: TResExprEvaluator;
  1611. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1612. function OnExprEvalParams(Sender: TResExprEvaluator;
  1613. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1614. procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
  1615. var MsgType: TMessageType); virtual;
  1616. function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
  1617. protected
  1618. // generic/specialize
  1619. type
  1620. TScopeStashState = record
  1621. ScopeCount: integer;
  1622. StashCount: integer;
  1623. end;
  1624. procedure AddGenericTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1625. Scope: TPasIdentifierScope);
  1626. procedure AddSpecializedTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1627. SpecializedItem: TPRSpecializedItem; Scope: TPasIdentifierScope;
  1628. CheckConstraints: boolean);
  1629. function CreateInferenceTypesForCall(Params: TParamsExpr;
  1630. TargetProc: TPasProcedure): TFPList;
  1631. function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  1632. Params: TFPList): TPasElement;
  1633. function CheckGenericConstraintFitsParam(ParamType: TPasType;
  1634. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1635. TemplType: TPasGenericTemplateType; ConEl: TPasElement;
  1636. Operation: TPRTemplateCompOp;
  1637. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1638. ): integer;
  1639. function CheckTemplateFitsParam(ParamType: TPasType;
  1640. GenTempl: TPasGenericTemplateType;
  1641. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1642. Operation: TPRTemplateCompOp;
  1643. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1644. ): integer;
  1645. function CheckTemplateFitsParamRes(GenTempl: TPasGenericTemplateType;
  1646. const ResolvedEl: TPasResolverResult;
  1647. Operation: TPRTemplateCompOp;
  1648. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1649. ): integer;
  1650. procedure CheckTemplateFitsTemplate(ParamTemplType,
  1651. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  1652. function CreateSpecializedItem(El: TPasElement; GenericEl: TPasElement;
  1653. const ParamsResolved: TPasTypeArray): TPRSpecializedItem; virtual;
  1654. procedure InitSpecializeScopes(El: TPasElement; out State: TScopeStashState); virtual;
  1655. procedure RestoreSpecializeScopes(const State: TScopeStashState); virtual;
  1656. procedure SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem); virtual;
  1657. procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem); virtual;
  1658. procedure SpecializeMembers(GenMembersType, SpecMembersType: TPasMembersType); virtual;
  1659. procedure SpecializeMembersImpl(GenericType, SpecType: TPasMembersType;
  1660. SpecializedItem: TPRSpecializedTypeItem); virtual;
  1661. procedure SpecializeGenImplProc(GenDeclProc, SpecDeclProc: TPasProcedure;
  1662. SpecializedItem: TPRSpecializedItem); virtual;
  1663. procedure SpecializeElement(GenEl, SpecEl: TPasElement);
  1664. procedure SpecializePasElementProperties(GenEl, SpecEl: TPasElement);
  1665. procedure SpecializeVariable(GenEl, SpecEl: TPasVariable; Finish: boolean);
  1666. procedure SpecializeConst(GenEl, SpecEl: TPasConst);
  1667. procedure SpecializeProperty(GenEl, SpecEl: TPasProperty);
  1668. procedure SpecializeElType(GenEl, SpecEl: TPasElement;
  1669. GenElType: TPasType; var SpecElType: TPasType);
  1670. procedure SpecializeElExpr(GenEl, SpecEl: TPasElement;
  1671. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  1672. procedure SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  1673. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  1674. procedure SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  1675. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  1676. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1677. procedure SpecializeElList(GenEl, SpecEl: TPasElement;
  1678. GenList, SpecList: TFPList; AllowReferences: boolean
  1679. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1680. procedure SpecializeElArray(GenEl, SpecEl: TPasElement;
  1681. GenList: TPasElementArray; var SpecList: TPasElementArray; AllowReferences: boolean
  1682. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1683. procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure; SpecializedItem: TPRSpecializedItem);
  1684. procedure SpecializeOperator(GenEl, SpecEl: TPasOperator);
  1685. procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  1686. procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  1687. procedure SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  1688. procedure SpecializeSpecializeType(GenEl, SpecEl: TPasSpecializeType);
  1689. procedure SpecializeGenericTemplateType(GenEl, SpecEl: TPasGenericTemplateType);
  1690. procedure SpecializeArgument(GenEl, SpecEl: TPasArgument);
  1691. procedure SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  1692. procedure SpecializeImplAsmStatement(GenEl, SpecEl: TPasImplAsmStatement);
  1693. procedure SpecializeImplRepeatUntil(GenEl, SpecEl: TPasImplRepeatUntil);
  1694. procedure SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  1695. procedure SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  1696. procedure SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  1697. procedure SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  1698. procedure SpecializeImplCaseStatement(GenEl, SpecEl: TPasImplCaseStatement);
  1699. procedure SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  1700. procedure SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  1701. procedure SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  1702. procedure SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  1703. procedure SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  1704. procedure SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  1705. procedure SpecializeExpr(GenEl, SpecEl: TPasExpr);
  1706. procedure SpecializeExprArray(GenEl, SpecEl: TPasElement;
  1707. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  1708. procedure SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  1709. procedure SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  1710. procedure SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  1711. procedure SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  1712. procedure SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  1713. procedure SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  1714. procedure SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  1715. procedure SpecializeInlineSpecializeExpr(GenEl, SpecEl: TInlineSpecializeExpr);
  1716. procedure SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  1717. procedure SpecializeResString(GenEl, SpecEl: TPasResString);
  1718. procedure SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  1719. procedure SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  1720. procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  1721. procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType; SpecializedItem: TPRSpecializedTypeItem);
  1722. procedure SpecializeRecordType(GenEl, SpecEl: TPasRecordType; SpecializedItem: TPRSpecializedTypeItem);
  1723. procedure SpecializeClassType(GenEl, SpecEl: TPasClassType; SpecializedItem: TPRSpecializedTypeItem);
  1724. procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  1725. procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  1726. procedure SpecializeSetType(GenEl, SpecEl: TPasSetType);
  1727. procedure SpecializeVariant(GenEl, SpecEl: TPasVariant);
  1728. procedure SpecializeStringType(GenEl, SpecEl: TPasStringType);
  1729. procedure SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  1730. procedure SpecializeMethodResolution(GenEl, SpecEl: TPasMethodResolution);
  1731. protected
  1732. // custom types (added by descendant resolvers)
  1733. function CheckAssignCompatibilityCustom(
  1734. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1735. RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
  1736. function CheckEqualCompatibilityCustomType(
  1737. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1738. RaiseOnIncompatible: boolean): integer; virtual;
  1739. protected
  1740. // built-in functions
  1741. function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1742. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1743. procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1744. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1745. procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  1746. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1747. function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1748. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1749. procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1750. Params: TParamsExpr); virtual;
  1751. function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1752. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1753. procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1754. Params: TParamsExpr); virtual;
  1755. function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1756. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1757. function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1758. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1759. function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1760. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1761. function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1762. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1763. procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1764. Params: TParamsExpr); virtual;
  1765. function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1766. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1767. procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1768. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1769. procedure BI_Assigned_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1770. Params: TParamsExpr); virtual;
  1771. function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1772. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1773. procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1774. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1775. procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  1776. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1777. function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1778. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1779. procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1780. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1781. procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  1782. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1783. function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1784. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1785. procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1786. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1787. procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  1788. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1789. function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1790. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1791. procedure BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1792. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1793. procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  1794. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1795. function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  1796. const ParamResolved: TPasResolverResult; ArgNo: integer;
  1797. RaiseOnError: boolean): integer;
  1798. function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1799. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1800. procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1801. Params: TParamsExpr); virtual;
  1802. function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1803. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1804. procedure BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1805. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1806. procedure BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  1807. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1808. function BI_WriteStrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1809. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1810. procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1811. Params: TParamsExpr); virtual;
  1812. function BI_Val_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1813. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1814. procedure BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1815. Params: TParamsExpr); virtual;
  1816. function BI_LoHi_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1817. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1818. procedure BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1819. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1820. procedure BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  1821. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1822. function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1823. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1824. procedure BI_ConcatArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1825. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1826. function BI_ConcatString_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1827. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1828. procedure BI_ConcatString_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1829. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1830. procedure BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  1831. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1832. function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1833. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1834. procedure BI_CopyArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1835. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1836. function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1837. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1838. procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1839. Params: TParamsExpr); virtual;
  1840. function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1841. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1842. procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1843. Params: TParamsExpr); virtual;
  1844. function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1845. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1846. procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1847. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1848. function BI_Assert_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1849. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1850. procedure BI_Assert_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1851. Params: TParamsExpr); virtual;
  1852. function BI_New_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1853. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1854. procedure BI_New_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1855. Params: TParamsExpr); virtual;
  1856. function BI_Dispose_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1857. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1858. procedure BI_Dispose_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1859. Params: TParamsExpr); virtual;
  1860. function BI_Default_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1861. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1862. procedure BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1863. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1864. procedure BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  1865. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1866. public
  1867. constructor Create;
  1868. destructor Destroy; override;
  1869. procedure Clear; virtual; // does not free built-in identifiers
  1870. // overrides of TPasTreeContainer
  1871. function CreateElement(AClass: TPTreeElement; const AName: String;
  1872. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1873. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1874. overload; override;
  1875. function CreateElement(AClass: TPTreeElement; const AName: String;
  1876. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1877. const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
  1878. overload; override;
  1879. function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; override;
  1880. function FindUnit(const AName, InFilename: String;
  1881. NameExpr, InFileExpr: TPasExpr): TPasModule; virtual; abstract;
  1882. function FindElement(const aName: String): TPasElement; override; // used by TPasParser
  1883. function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser
  1884. function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
  1885. NoProcsWithArgs: boolean): TPasElement;
  1886. function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
  1887. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  1888. function FindFirstEl(const AName: String; out Data: TPRFindData;
  1889. ErrorPosEl: TPasElement): TPasElement;
  1890. procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  1891. function FindGenericEl(const AName: string; TemplateCount: integer;
  1892. out Find: TPRFindData; ErrorPosEl: TPasElement): TPasElement; virtual;
  1893. procedure IterateElements(const aName: string;
  1894. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1895. var Abort: boolean); virtual;
  1896. procedure CheckFoundElement(const FindData: TPRFindData;
  1897. Ref: TResolvedReference); virtual;
  1898. procedure CheckFoundElementVisibility(const FindData: TPRFindData;
  1899. Ref: TResolvedReference); virtual;
  1900. function GetVisibilityContext: TPasElement;
  1901. procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1902. procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1903. procedure FinishTypeAlias(var NewType: TPasType); override;
  1904. function IsUnitIntfFinished(AModule: TPasModule): boolean;
  1905. procedure NotifyPendingUsedInterfaces; virtual;
  1906. function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
  1907. function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
  1908. procedure UsedInterfacesFinished(Section: TPasSection); virtual;
  1909. function NeedArrayValues(El: TPasElement): boolean; override;
  1910. function GetDefaultClassVisibility(AClass: TPasClassType
  1911. ): TPasMemberVisibility; override;
  1912. procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  1913. Before: boolean; var Handled: boolean); override;
  1914. // built in types and functions
  1915. procedure ClearBuiltInIdentifiers; virtual;
  1916. procedure AddObjFPCBuiltInIdentifiers(
  1917. const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
  1918. const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
  1919. function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
  1920. function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  1921. function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
  1922. function AddBuiltInProc(const aName: string; Signature: string;
  1923. const GetCallCompatibility: TOnGetCallCompatibility;
  1924. const GetCallResult: TOnGetCallResult;
  1925. const EvalConst: TOnEvalBIFunction = nil;
  1926. const FinishParamsExpr: TOnFinishParamsExpr = nil;
  1927. const BuiltIn: TResolverBuiltInProc = bfCustom;
  1928. const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
  1929. // add extra TResolveData (E.CustomData) to free list
  1930. procedure AddResolveData(El: TPasElement; Data: TResolveData;
  1931. Kind: TResolveDataListKind);
  1932. function CreateReference(DeclEl, RefEl: TPasElement;
  1933. Access: TResolvedRefAccess;
  1934. FindData: PPRFindData = nil): TResolvedReference; virtual;
  1935. // scopes
  1936. function GetLocalScope: TPasScope; inline;
  1937. function GetParentLocalScope: TPasScope; inline;
  1938. function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
  1939. function CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean = true): TPasGroupScope; virtual;
  1940. procedure GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope; HiType: TPasType; WithTopHelpers: boolean = true);
  1941. procedure PopScope;
  1942. procedure PopWithScope(El: TPasImplWithDo);
  1943. procedure PopGenericParamScope(El: TPasGenericType); virtual;
  1944. procedure PushScope(Scope: TPasScope); overload;
  1945. function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
  1946. function PushGroupScope(HiType: TPasType): TPasGroupScope;
  1947. function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  1948. function PushClassDotScope(var CurClassType: TPasClassType; WithTopHelpers: boolean = true): TPasDotClassScope;
  1949. function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  1950. function PushInheritedScope(ClassOrRec: TPasMembersType;
  1951. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  1952. function PushEnumDotScope(HiType: TPasType; EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  1953. function PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  1954. function PushTemplateDotScope(TemplType: TPasGenericTemplateType; ErrorEl: TPasElement): TPasDotBaseScope;
  1955. function PushDotScope(HiType: TPasType): TPasDotBaseScope;
  1956. function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  1957. function StashScopes(NewScopeCnt: integer): integer; // returns old StashDepth
  1958. function StashSubExprScopes: integer; // returns old StashDepth
  1959. procedure RestoreStashedScopes(StashDepth: integer);
  1960. function GetCurrentProcScope(ErrorEl: TPasElement): TPasProcedureScope;
  1961. function GetProcScope(El: TPasElement): TPasProcedureScope;
  1962. function GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  1963. function GetSelfScope(El: TPasElement): TPasProcedureScope;
  1964. procedure AddHelper(Helper: TPasClassType; var List: TPRHelperEntryArray);
  1965. procedure AddActiveHelper(Helper: TPasClassType); virtual;
  1966. // log and messages
  1967. class function MangleSourceLineNumber(Line, Column: integer): integer;
  1968. class procedure UnmangleSourceLineNumber(LineNumber: integer;
  1969. out Line, Column: integer);
  1970. class function GetDbgSourcePosStr(El: TPasElement): string;
  1971. function GetElementSourcePosStr(El: TPasElement): string;
  1972. procedure SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  1973. Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1974. PosEl: TPasElement);
  1975. procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  1976. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1977. PosEl: TPasElement); overload;
  1978. class function GetWarnIdentifierNumbers(Identifier: string;
  1979. out MsgNumbers: TIntegerDynArray): boolean; virtual;
  1980. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasResolverResult;
  1981. out GotDesc, ExpDesc: String); overload;
  1982. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
  1983. out GotDesc, ExpDesc: String); overload;
  1984. procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
  1985. Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1986. ErrorPosEl: TPasElement); virtual;
  1987. procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
  1988. procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
  1989. procedure RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
  1990. procedure RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string; El: TPasElement);
  1991. procedure RaiseXExpectedButYFound(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  1992. procedure RaiseXExpectedButTypeYFound(id: TMaxPrecInt; const X: string; Y: TPasType; El: TPasElement);
  1993. procedure RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C,X,Y: string; El: TPasElement);
  1994. procedure RaiseContextXInvalidY(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  1995. procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  1996. procedure RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement; IdentEl: TPasElement);
  1997. procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  1998. procedure RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  1999. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2000. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  2001. procedure RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  2002. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2003. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  2004. procedure RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  2005. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2006. const GotType, ExpType: TPasResolverResult;
  2007. ErrorEl: TPasElement);
  2008. procedure RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt; ErrorEl: TPasElement);
  2009. procedure RaiseInvalidProcTypeModifier(id: TMaxPrecInt; ProcType: TPasProcedureType;
  2010. ptm: TProcTypeModifier; ErrorEl: TPasElement);
  2011. procedure RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  2012. pm: TProcedureModifier; ErrorEl: TPasElement);
  2013. procedure WriteScopes;
  2014. procedure WriteScopesShort(Title: string);
  2015. // find value and type of an element
  2016. procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
  2017. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  2018. function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2019. function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2020. // checking compatibilility
  2021. function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same
  2022. function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
  2023. function IndexOfGenericParam(Params: TPasExprArray): integer;
  2024. procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt; ErrorEl: TPasElement);
  2025. function CheckCallProcCompatibility(ProcType: TPasProcedureType;
  2026. Params: TParamsExpr; RaiseOnError: boolean;
  2027. SetReferenceFlags: boolean = false): integer;
  2028. function CheckCallPropertyCompatibility(PropEl: TPasProperty;
  2029. Params: TParamsExpr; RaiseOnError: boolean): integer;
  2030. function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  2031. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
  2032. function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
  2033. ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  2034. function CheckAssignCompatibilityUserType(
  2035. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2036. RaiseOnIncompatible: boolean): integer;
  2037. function CheckAssignCompatibilityArrayType(
  2038. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2039. RaiseOnIncompatible: boolean): integer;
  2040. function CheckAssignCompatibilityPointerType(LTypeEl, RTypeEl: TPasType;
  2041. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2042. function CheckEqualCompatibilityUserType(
  2043. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2044. RaiseOnIncompatible: boolean): integer; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  2045. function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
  2046. function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
  2047. ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
  2048. function CheckTypeCastArray(FromType, ToType: TPasArrayType;
  2049. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  2050. function CheckSrcIsADstType(
  2051. const ResolvedSrcType, ResolvedDestType: TPasResolverResult): integer;
  2052. function CheckClassIsClass(SrcType, DestType: TPasType): integer; virtual;
  2053. function CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  2054. function GetClassImplementsIntf(ClassEl, Intf: TPasClassType): TPasClassType;
  2055. function CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  2056. function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
  2057. IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
  2058. function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): integer;
  2059. function CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  2060. ResolveAlias: TPRResolveAlias): integer;
  2061. function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  2062. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  2063. function CheckAssignCompatibility(const LHS, RHS: TPasElement;
  2064. RaiseOnIncompatible: boolean = true; ErrorEl: TPasElement = nil): integer;
  2065. procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  2066. procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
  2067. RValue: TResEvalValue; RHS: TPasExpr); virtual;
  2068. function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
  2069. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2070. function CheckEqualElCompatibility(Left, Right: TPasElement;
  2071. ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2072. SetReferenceFlags: boolean = false): integer;
  2073. function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
  2074. LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2075. RErrorEl: TPasElement = nil): integer;
  2076. function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
  2077. function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
  2078. PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
  2079. function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
  2080. // utility functions
  2081. function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
  2082. function GetElModeSwitches(El: TPasElement): TModeSwitches;
  2083. function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
  2084. function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  2085. function GetProcTypeDescription(ProcType: TPasProcedureType;
  2086. Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
  2087. function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
  2088. function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
  2089. function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2090. function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2091. function GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  2092. function GetProcTemplateTypes(Proc: TPasProcedure): TFPList; // list of TPasGenericTemplateType
  2093. function GetProcName(Proc: TPasProcedure; WithTemplates: boolean = true): string;
  2094. function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
  2095. function GetPasPropertyType(El: TPasProperty): TPasType;
  2096. function GetPasPropertyArgs(El: TPasProperty): TFPList;
  2097. function GetPasPropertyGetter(El: TPasProperty): TPasElement;
  2098. function GetPasPropertySetter(El: TPasProperty): TPasElement;
  2099. function GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  2100. function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  2101. function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  2102. function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
  2103. function GetParentProcBody(El: TPasElement): TProcedureBody;
  2104. function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
  2105. function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
  2106. function GetLoop(El: TPasElement): TPasImplElement;
  2107. function ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean = true): TPasType;
  2108. function ResolveAliasTypeEl(El: TPasElement): TPasType; inline;
  2109. function ExprIsAddrTarget(El: TPasExpr): boolean;
  2110. function IsNameExpr(El: TPasExpr): boolean; inline; // TPrimitiveExpr with Kind=pekIdent
  2111. function GetNameExprValue(El: TPasExpr): string; // TPrimitiveExpr with Kind=pekIdent
  2112. function GetNextDottedExpr(El: TPasExpr): TPasExpr;
  2113. function GetLeftMostExpr(El: TPasExpr): TPasExpr;
  2114. function GetRightMostExpr(El: TPasExpr): TPasExpr;
  2115. procedure GetParamsOfNameExpr(El: TPasExpr; out ParentParams: TPRParentParams);
  2116. function GetInlineSpecOfNameExpr(El: TPasExpr): TInlineSpecializeExpr;
  2117. function GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  2118. function GetPathStart(El: TPasExpr): TPasExpr;
  2119. function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  2120. function ParentNeedsExprResult(El: TPasExpr): boolean;
  2121. function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
  2122. function GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  2123. function GetSetType(const ResolvedSet: TPasResolverResult): TPasSetType;
  2124. function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
  2125. function IsOpenArray(TypeEl: TPasType): boolean;
  2126. function IsDynOrOpenArray(TypeEl: TPasType): boolean;
  2127. function IsArrayOfConst(TypeEl: TPasType): boolean;
  2128. function GetArrayElType(ArrType: TPasArrayType): TPasType;
  2129. function IsVarInit(Expr: TPasExpr): boolean;
  2130. function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  2131. function IsClassMethod(El: TPasElement): boolean;
  2132. function IsClassField(El: TPasElement): boolean;
  2133. function GetFunctionType(El: TPasElement): TPasFunctionType;
  2134. function MethodIsStatic(El: TPasProcedure): boolean;
  2135. function IsMethod(El: TPasProcedure): boolean;
  2136. function IsHelperMethod(El: TPasElement): boolean; virtual;
  2137. function IsHelper(El: TPasElement): boolean;
  2138. function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
  2139. function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
  2140. function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
  2141. function IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  2142. function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  2143. function IsTypeCast(Params: TParamsExpr): boolean;
  2144. function IsGenericTemplType(const ResolvedEl: TPasResolverResult): boolean;
  2145. function GetTypeParameterCount(aType: TPasGenericType): integer;
  2146. function GetGenericConstraintKeyword(El: TPasElement): TToken;
  2147. function GetGenericConstraintErrorEl(ConstraintEl, TemplType: TPasElement): TPasElement;
  2148. function IsFullySpecialized(El: TPasGenericType): boolean;
  2149. function IsInterfaceType(const ResolvedEl: TPasResolverResult;
  2150. IntfType: TPasClassInterfaceType): boolean; overload;
  2151. function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
  2152. function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
  2153. function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
  2154. function IsCustomAttribute(El: TPasElement): boolean; virtual;
  2155. function IsSystemUnit(El: TPasModule): boolean; virtual;
  2156. function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
  2157. function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
  2158. function ProcNeedsParams(El: TPasProcedureType): boolean;
  2159. function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
  2160. function GetTopLvlProc(El: TPasElement): TPasProcedure;
  2161. function GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  2162. function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  2163. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
  2164. function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
  2165. function HasTypeInfo(El: TPasType): boolean; virtual;
  2166. function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
  2167. function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2168. function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2169. procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
  2170. function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: TMaxPrecInt): boolean;
  2171. function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
  2172. function GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt): TResolverBaseType; // returns BaseTypeExtended if too big
  2173. function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2174. function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2175. function IsElementSkipped(El: TPasElement): boolean; virtual;
  2176. function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
  2177. function GetLastSection: TPasSection;
  2178. function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  2179. isLoFunc: Boolean; out Mask: LongWord): Integer;
  2180. public
  2181. // options
  2182. property Options: TPasResolverOptions read FOptions write FOptions;
  2183. property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
  2184. write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
  2185. property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
  2186. property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
  2187. property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
  2188. property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
  2189. property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
  2190. property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
  2191. property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
  2192. property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
  2193. property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
  2194. property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
  2195. // parsed values
  2196. property DefaultNameSpace: String read FDefaultNameSpace;
  2197. property RootElement: TPasModule read FRootElement write SetRootElement;
  2198. property Step: TPasResolverStep read FStep;
  2199. property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers;
  2200. // scopes
  2201. property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
  2202. If true Line and Column is mangled together in TPasElement.SourceLineNumber.
  2203. Use method UnmangleSourceLineNumber to extract. }
  2204. property Scopes[Index: integer]: TPasScope read GetScopes;
  2205. property ScopeCount: integer read FScopeCount;
  2206. property TopScope: TPasScope read FTopScope;
  2207. property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
  2208. property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
  2209. property ScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass read FScopeClass_InitialFinalization write FScopeClass_InitialFinalization;
  2210. property ScopeClass_Module: TPasModuleScopeClass read FScopeClass_Module write FScopeClass_Module;
  2211. property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
  2212. property ScopeClass_Section: TPasSectionScopeClass read FScopeClass_Section write FScopeClass_Section;
  2213. property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
  2214. // last element
  2215. property LastElement: TPasElement read FLastElement;
  2216. property LastMsg: string read FLastMsg write FLastMsg;
  2217. property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
  2218. property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
  2219. property LastMsgId: TMaxPrecInt read FLastMsgId write FLastMsgId;
  2220. property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
  2221. property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
  2222. property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
  2223. property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
  2224. end;
  2225. function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
  2226. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2227. function GetClassAncestorsDbg(El: TPasClassType): string;
  2228. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2229. function GetElementTypeName(El: TPasElement): string; overload;
  2230. function GetElementTypeName(C: TPasElementBaseClass): string; overload;
  2231. function GetElementDbgPath(El: TPasElement): string; overload;
  2232. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2233. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2234. BaseType: TResolverBaseType; IdentEl: TPasElement;
  2235. LoTypeEl, HiTypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
  2236. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2237. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2238. Flags: TPasResolverResultFlags); overload;
  2239. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2240. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2241. Flags: TPasResolverResultFlags); overload;
  2242. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2243. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2244. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2245. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2246. function ChompDottedIdentifier(const Identifier: string): string;
  2247. function FirstDottedIdentifier(const Identifier: string): string;
  2248. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2249. {$IF FPC_FULLVERSION<30101}
  2250. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2251. {$ENDIF}
  2252. function DotExprToName(Expr: TPasExpr): string;
  2253. function NoNil(o: TObject): TObject;
  2254. function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
  2255. function dbgs(const a: TResolvedRefAccess): string; overload;
  2256. function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
  2257. function dbgs(const a: TPSRefAccess): string; overload;
  2258. implementation
  2259. function GetTreeDbg(El: TPasElement; Indent: integer): string;
  2260. procedure LineBreak(SubIndent: integer);
  2261. begin
  2262. Inc(Indent,SubIndent);
  2263. Result:=Result+LineEnding+StringOfChar(' ',Indent);
  2264. end;
  2265. var
  2266. i, l: Integer;
  2267. begin
  2268. if El=nil then exit('nil');
  2269. Result:=El.Name+':'+El.ClassName+'=';
  2270. if El is TPasExpr then
  2271. begin
  2272. if El.ClassType<>TBinaryExpr then
  2273. Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
  2274. if El.ClassType=TUnaryExpr then
  2275. Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
  2276. else if El.ClassType=TBinaryExpr then
  2277. Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
  2278. +OpcodeStrings[TPasExpr(El).OpCode]
  2279. +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
  2280. else if El.ClassType=TPrimitiveExpr then
  2281. Result:=Result+TPrimitiveExpr(El).Value
  2282. else if El.ClassType=TBoolConstExpr then
  2283. Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
  2284. else if El.ClassType=TNilExpr then
  2285. Result:=Result+'nil'
  2286. else if El.ClassType=TInheritedExpr then
  2287. Result:=Result+'inherited'
  2288. else if El.ClassType=TSelfExpr then
  2289. Result:=Result+'Self'
  2290. else if El.ClassType=TParamsExpr then
  2291. begin
  2292. LineBreak(2);
  2293. Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
  2294. l:=length(TParamsExpr(El).Params);
  2295. if l>0 then
  2296. begin
  2297. inc(Indent,2);
  2298. for i:=0 to l-1 do
  2299. begin
  2300. LineBreak(0);
  2301. Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
  2302. if i<l-1 then
  2303. Result:=Result+','
  2304. end;
  2305. dec(Indent,2);
  2306. end;
  2307. Result:=Result+')';
  2308. end
  2309. else if El.ClassType=TRecordValues then
  2310. begin
  2311. Result:=Result+'(';
  2312. l:=length(TRecordValues(El).Fields);
  2313. if l>0 then
  2314. begin
  2315. inc(Indent,2);
  2316. for i:=0 to l-1 do
  2317. begin
  2318. LineBreak(0);
  2319. Result:=Result+TRecordValues(El).Fields[i].Name+':'
  2320. +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
  2321. if i<l-1 then
  2322. Result:=Result+','
  2323. end;
  2324. dec(Indent,2);
  2325. end;
  2326. Result:=Result+')';
  2327. end
  2328. else if El.ClassType=TArrayValues then
  2329. begin
  2330. Result:=Result+'[';
  2331. l:=length(TArrayValues(El).Values);
  2332. if l>0 then
  2333. begin
  2334. inc(Indent,2);
  2335. for i:=0 to l-1 do
  2336. begin
  2337. LineBreak(0);
  2338. Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
  2339. if i<l-1 then
  2340. Result:=Result+','
  2341. end;
  2342. dec(Indent,2);
  2343. end;
  2344. Result:=Result+']';
  2345. end;
  2346. end
  2347. else if El is TPasProcedure then
  2348. begin
  2349. Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
  2350. end
  2351. else if El is TPasProcedureType then
  2352. begin
  2353. if TPasProcedureType(El).IsReferenceTo then
  2354. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2355. Result:=Result+'(';
  2356. l:=TPasProcedureType(El).Args.Count;
  2357. if l>0 then
  2358. begin
  2359. inc(Indent,2);
  2360. for i:=0 to l-1 do
  2361. begin
  2362. LineBreak(0);
  2363. Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
  2364. if i<l-1 then
  2365. Result:=Result+';'
  2366. end;
  2367. dec(Indent,2);
  2368. end;
  2369. Result:=Result+')';
  2370. if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
  2371. Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
  2372. if TPasProcedureType(El).IsOfObject then
  2373. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  2374. if TPasProcedureType(El).IsNested then
  2375. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2376. if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
  2377. Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
  2378. end
  2379. else if El.ClassType=TPasResultElement then
  2380. Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
  2381. else if El.ClassType=TPasArgument then
  2382. begin
  2383. if AccessNames[TPasArgument(El).Access]<>'' then
  2384. Result:=Result+AccessNames[TPasArgument(El).Access];
  2385. if TPasArgument(El).ArgType=nil then
  2386. Result:=Result+'untyped'
  2387. else
  2388. Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
  2389. end
  2390. else if El.ClassType=TPasUnresolvedSymbolRef then
  2391. begin
  2392. if El.CustomData is TResElDataBuiltInProc then
  2393. Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
  2394. end;
  2395. end;
  2396. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2397. var
  2398. HiTypeEl: TPasType;
  2399. begin
  2400. Result:='[bt='+ResBaseTypeNames[T.BaseType];
  2401. if T.SubType<>btNone then
  2402. Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
  2403. Result:=Result
  2404. +' Ident='+GetObjName(T.IdentEl);
  2405. HiTypeEl:=ResolveSimpleAliasType(T.HiTypeEl);
  2406. if HiTypeEl<>T.LoTypeEl then
  2407. Result:=Result+' LoType='+GetObjName(T.LoTypeEl)+' HiTypeEl='+GetObjName(HiTypeEl)
  2408. else
  2409. Result:=Result+' Type='+GetObjName(T.LoTypeEl);
  2410. Result:=Result
  2411. +' Expr='+GetObjName(T.ExprEl)
  2412. +' Flags='+ResolverResultFlagsToStr(T.Flags)
  2413. +']';
  2414. end;
  2415. function GetClassAncestorsDbg(El: TPasClassType): string;
  2416. function GetClassDesc(C: TPasClassType): string;
  2417. var
  2418. Module: TPasModule;
  2419. begin
  2420. if C.IsExternal then
  2421. Result:='class external '
  2422. else
  2423. Result:='class ';
  2424. Module:=C.GetModule;
  2425. if Module<>nil then
  2426. Result:=Result+Module.Name+'.';
  2427. Result:=Result+GetElementDbgPath(C);
  2428. end;
  2429. var
  2430. Scope, AncestorScope: TPasClassScope;
  2431. AncestorEl: TPasClassType;
  2432. begin
  2433. if El=nil then exit('nil');
  2434. Result:=GetClassDesc(El);
  2435. if El.CustomData is TPasClassScope then
  2436. begin
  2437. Scope:=TPasClassScope(El.CustomData);
  2438. AncestorScope:=Scope.AncestorScope;
  2439. while AncestorScope<>nil do
  2440. begin
  2441. Result:=Result+LineEnding+' ';
  2442. AncestorEl:=NoNil(AncestorScope.Element) as TPasClassType;
  2443. Result:=Result+GetClassDesc(AncestorEl);
  2444. AncestorScope:=AncestorScope.AncestorScope;
  2445. end;
  2446. end;
  2447. end;
  2448. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2449. var
  2450. f: TPasResolverResultFlag;
  2451. s: string;
  2452. begin
  2453. Result:='';
  2454. for f in Flags do
  2455. begin
  2456. if Result<>'' then Result:=Result+',';
  2457. str(f,s);
  2458. Result:=Result+s;
  2459. end;
  2460. Result:='['+Result+']';
  2461. end;
  2462. function GetElementTypeName(El: TPasElement): string;
  2463. var
  2464. C: TClass;
  2465. begin
  2466. if El=nil then
  2467. exit('?');
  2468. C:=El.ClassType;
  2469. if C=TPrimitiveExpr then
  2470. Result:=ExprKindNames[TPrimitiveExpr(El).Kind]
  2471. else if C=TUnaryExpr then
  2472. Result:='unary '+OpcodeStrings[TUnaryExpr(El).OpCode]
  2473. else if C=TBinaryExpr then
  2474. Result:=ExprKindNames[TBinaryExpr(El).Kind]
  2475. else if C=TPasClassType then
  2476. Result:=ObjKindNames[TPasClassType(El).ObjKind]
  2477. else if C=TPasUnresolvedSymbolRef then
  2478. Result:=El.Name
  2479. else
  2480. begin
  2481. Result:=GetElementTypeName(TPasElementBaseClass(C));
  2482. if Result='' then
  2483. Result:=El.ElementTypeName;
  2484. end;
  2485. end;
  2486. function GetElementTypeName(C: TPasElementBaseClass): string;
  2487. begin
  2488. if C=nil then
  2489. exit('nil');
  2490. if C=TPrimitiveExpr then
  2491. Result:='primitive expression'
  2492. else if C=TUnaryExpr then
  2493. Result:='unary expression'
  2494. else if C=TBinaryExpr then
  2495. Result:='binary expression'
  2496. else if C=TBoolConstExpr then
  2497. Result:='boolean const'
  2498. else if C=TNilExpr then
  2499. Result:='nil'
  2500. else if C=TPasAliasType then
  2501. Result:='alias'
  2502. else if C=TPasPointerType then
  2503. Result:='pointer'
  2504. else if C=TPasTypeAliasType then
  2505. Result:='type alias'
  2506. else if C=TPasClassOfType then
  2507. Result:='class of'
  2508. else if C=TPasSpecializeType then
  2509. Result:='specialize'
  2510. else if C=TInlineSpecializeExpr then
  2511. Result:='inline-specialize'
  2512. else if C=TPasRangeType then
  2513. Result:='range'
  2514. else if C=TPasArrayType then
  2515. Result:='array'
  2516. else if C=TPasFileType then
  2517. Result:='file'
  2518. else if C=TPasEnumValue then
  2519. Result:='enum value'
  2520. else if C=TPasEnumType then
  2521. Result:='enum type'
  2522. else if C=TPasSetType then
  2523. Result:='set'
  2524. else if C=TPasRecordType then
  2525. Result:='record'
  2526. else if C=TPasClassType then
  2527. Result:='class'
  2528. else if C=TPasArgument then
  2529. Result:='parameter'
  2530. else if C=TPasProcedureType then
  2531. Result:='procedural type'
  2532. else if C=TPasResultElement then
  2533. Result:='function result'
  2534. else if C=TPasFunctionType then
  2535. Result:='functional type'
  2536. else if C=TPasStringType then
  2537. Result:='string[]'
  2538. else if C=TPasVariable then
  2539. Result:='var'
  2540. else if C=TPasExportSymbol then
  2541. Result:='export'
  2542. else if C=TPasConst then
  2543. Result:='const'
  2544. else if C=TPasProperty then
  2545. Result:='property'
  2546. else if C=TPasProcedure then
  2547. Result:='procedure'
  2548. else if C=TPasFunction then
  2549. Result:='function'
  2550. else if C=TPasOperator then
  2551. Result:='operator'
  2552. else if C=TPasClassOperator then
  2553. Result:='class operator'
  2554. else if C=TPasConstructor then
  2555. Result:='constructor'
  2556. else if C=TPasClassConstructor then
  2557. Result:='class constructor'
  2558. else if C=TPasDestructor then
  2559. Result:='destructor'
  2560. else if C=TPasClassDestructor then
  2561. Result:='class destructor'
  2562. else if C=TPasClassProcedure then
  2563. Result:='class procedure'
  2564. else if C=TPasClassFunction then
  2565. Result:='class function'
  2566. else if C=TPasAnonymousProcedure then
  2567. Result:='anonymous procedure'
  2568. else if C=TPasAnonymousFunction then
  2569. Result:='anonymous function'
  2570. else if C=TPasMethodResolution then
  2571. Result:='method resolution'
  2572. else if C=TInterfaceSection then
  2573. Result:='interfacesection'
  2574. else if C=TImplementationSection then
  2575. Result:='implementation'
  2576. else if C=TProgramSection then
  2577. Result:='program section'
  2578. else if C=TLibrarySection then
  2579. Result:='library section'
  2580. else
  2581. Result:=C.ClassName;
  2582. end;
  2583. function GetElementDbgPath(El: TPasElement): string;
  2584. begin
  2585. if El=nil then exit('nil');
  2586. Result:='';
  2587. while El<>nil do
  2588. begin
  2589. if Result<>'' then Result:='.'+Result;
  2590. if El.Name<>'' then
  2591. Result:=El.Name+Result
  2592. else
  2593. Result:=GetElementTypeName(El)+Result;
  2594. El:=El.Parent;
  2595. end;
  2596. end;
  2597. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2598. var
  2599. C: TClass;
  2600. begin
  2601. while aType<>nil do
  2602. begin
  2603. C:=aType.ClassType;
  2604. if (C=TPasAliasType) then
  2605. aType:=TPasAliasType(aType).DestType
  2606. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  2607. and (aType.CustomData is TResolvedReference) then
  2608. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  2609. else
  2610. exit(aType);
  2611. end;
  2612. Result:=nil;
  2613. end;
  2614. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2615. BaseType: TResolverBaseType; IdentEl: TPasElement; LoTypeEl,
  2616. HiTypeEl: TPasType; Flags: TPasResolverResultFlags);
  2617. begin
  2618. if IdentEl is TPasExpr then
  2619. raise Exception.Create('20170729101017');
  2620. ResolvedType.BaseType:=BaseType;
  2621. ResolvedType.SubType:=btNone;
  2622. ResolvedType.IdentEl:=IdentEl;
  2623. ResolvedType.HiTypeEl:=HiTypeEl;
  2624. ResolvedType.LoTypeEl:=LoTypeEl;
  2625. ResolvedType.ExprEl:=nil;
  2626. ResolvedType.Flags:=Flags;
  2627. end;
  2628. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2629. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2630. Flags: TPasResolverResultFlags);
  2631. begin
  2632. ResolvedType.BaseType:=BaseType;
  2633. ResolvedType.SubType:=btNone;
  2634. ResolvedType.IdentEl:=nil;
  2635. ResolvedType.HiTypeEl:=HiTypeEl;
  2636. ResolvedType.LoTypeEl:=LoTypeEl;
  2637. ResolvedType.ExprEl:=nil;
  2638. ResolvedType.Flags:=Flags;
  2639. end;
  2640. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2641. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2642. Flags: TPasResolverResultFlags);
  2643. begin
  2644. ResolvedType.BaseType:=BaseType;
  2645. ResolvedType.SubType:=btNone;
  2646. ResolvedType.IdentEl:=nil;
  2647. ResolvedType.HiTypeEl:=HiTypeEl;
  2648. ResolvedType.LoTypeEl:=LoTypeEl;
  2649. ResolvedType.ExprEl:=ExprEl;
  2650. ResolvedType.Flags:=Flags;
  2651. end;
  2652. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2653. begin
  2654. Result:=true;
  2655. if Proc.IsExternal then exit(false);
  2656. if Proc.IsForward then exit;
  2657. if Proc.Parent.ClassType=TInterfaceSection then exit;
  2658. if Proc.Parent.ClassType=TPasClassType then
  2659. begin
  2660. // a method declaration
  2661. if not Proc.IsAbstract then exit;
  2662. end;
  2663. Result:=false;
  2664. end;
  2665. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2666. var
  2667. C: TClass;
  2668. begin
  2669. if Proc.IsForward or Proc.IsExternal then exit(false);
  2670. C:=Proc.Parent.ClassType;
  2671. if (C=TInterfaceSection) or C.InheritsFrom(TPasClassType) then exit(false);
  2672. Result:=true;
  2673. end;
  2674. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2675. var
  2676. Data: TObject;
  2677. begin
  2678. if Proc.IsOverload then
  2679. exit(true);
  2680. Data:=Proc.CustomData;
  2681. Result:=(Data is TPasProcedureScope)
  2682. and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
  2683. end;
  2684. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2685. var
  2686. i: Integer;
  2687. begin
  2688. if length(List)=0 then exit;
  2689. for i:=0 to length(List)-1 do
  2690. TPRHelperEntry(List[i]).Free;
  2691. List:=nil;
  2692. end;
  2693. function ChompDottedIdentifier(const Identifier: string): string;
  2694. var
  2695. p: Integer;
  2696. begin
  2697. Result:=Identifier;
  2698. p:=length(Identifier);
  2699. while (p>0) do
  2700. begin
  2701. if Identifier[p]='.' then
  2702. break;
  2703. dec(p);
  2704. end;
  2705. Result:=LeftStr(Identifier,p-1);
  2706. end;
  2707. function FirstDottedIdentifier(const Identifier: string): string;
  2708. var
  2709. p: SizeInt;
  2710. begin
  2711. p:=Pos('.',Identifier);
  2712. if p<1 then
  2713. Result:=Identifier
  2714. else
  2715. Result:=LeftStr(Identifier,p-1);
  2716. end;
  2717. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2718. var
  2719. l: Integer;
  2720. begin
  2721. l:=length(Prefix);
  2722. if (l>length(Identifier))
  2723. or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
  2724. exit(false);
  2725. Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
  2726. end;
  2727. function DotExprToName(Expr: TPasExpr): string;
  2728. var
  2729. C: TClass;
  2730. Prim: TPrimitiveExpr;
  2731. Bin: TBinaryExpr;
  2732. s: String;
  2733. begin
  2734. Result:='';
  2735. if Expr=nil then exit;
  2736. C:=Expr.ClassType;
  2737. if C=TPrimitiveExpr then
  2738. begin
  2739. Prim:=TPrimitiveExpr(Expr);
  2740. case Prim.Kind of
  2741. pekIdent,pekString: Result:=Prim.Value;
  2742. pekSelf: Result:='Self';
  2743. else
  2744. EPasResolve.Create('[20180309155400] DotExprToName '+GetObjName(Prim)+' '+ExprKindNames[Prim.Kind]);
  2745. end;
  2746. end
  2747. else if C=TBinaryExpr then
  2748. begin
  2749. Bin:=TBinaryExpr(Expr);
  2750. if Bin.OpCode=eopSubIdent then
  2751. begin
  2752. Result:=DotExprToName(Bin.left);
  2753. if Result='' then exit;
  2754. s:=DotExprToName(Bin.right);
  2755. if s='' then exit('');
  2756. Result:=Result+'.'+s;
  2757. end;
  2758. end;
  2759. end;
  2760. function NoNil(o: TObject): TObject;
  2761. begin
  2762. if o=nil then
  2763. raise Exception.Create('');
  2764. Result:=o;
  2765. end;
  2766. {$IF FPC_FULLVERSION<30101}
  2767. function IsValidIdent(const Ident: string; AllowDots: Boolean;
  2768. StrictDots: Boolean): Boolean;
  2769. const
  2770. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2771. AlphaNum = Alpha + ['0'..'9'];
  2772. Dot = '.';
  2773. var
  2774. First: Boolean;
  2775. I, Len: Integer;
  2776. begin
  2777. Len := Length(Ident);
  2778. if Len < 1 then
  2779. Exit(False);
  2780. First := True;
  2781. for I := 1 to Len do
  2782. begin
  2783. if First then
  2784. begin
  2785. Result := Ident[I] in Alpha;
  2786. First := False;
  2787. end
  2788. else if AllowDots and (Ident[I] = Dot) then
  2789. begin
  2790. if StrictDots then
  2791. begin
  2792. Result := I < Len;
  2793. First := True;
  2794. end;
  2795. end
  2796. else
  2797. Result := Ident[I] in AlphaNum;
  2798. if not Result then
  2799. Break;
  2800. end;
  2801. end;
  2802. {$ENDIF}
  2803. function dbgs(const Flags: TPasResolverComputeFlags): string;
  2804. var
  2805. s: string;
  2806. f: TPasResolverComputeFlag;
  2807. begin
  2808. Result:='';
  2809. for f in Flags do
  2810. if f in Flags then
  2811. begin
  2812. if Result<>'' then Result:=Result+',';
  2813. str(f,s);
  2814. Result:=Result+s;
  2815. end;
  2816. Result:='['+Result+']';
  2817. end;
  2818. function dbgs(const a: TResolvedRefAccess): string;
  2819. begin
  2820. str(a,Result);
  2821. end;
  2822. function dbgs(const Flags: TResolvedReferenceFlags): string;
  2823. var
  2824. s: string;
  2825. f: TResolvedReferenceFlag;
  2826. begin
  2827. Result:='';
  2828. for f in Flags do
  2829. if f in Flags then
  2830. begin
  2831. if Result<>'' then Result:=Result+',';
  2832. str(f,s);
  2833. Result:=Result+s;
  2834. end;
  2835. Result:='['+Result+']';
  2836. end;
  2837. function dbgs(const a: TPSRefAccess): string;
  2838. begin
  2839. str(a,Result);
  2840. end;
  2841. { TPRSpecializedItem }
  2842. destructor TPRSpecializedItem.Destroy;
  2843. var
  2844. i: Integer;
  2845. begin
  2846. for i:=0 to length(SpecializedConstraints)-1 do
  2847. TPasElement(SpecializedConstraints[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  2848. SetLength(SpecializedConstraints,0);
  2849. inherited Destroy;
  2850. end;
  2851. { TPRSpecializedTypeItem }
  2852. procedure TPRSpecializedTypeItem.SetSpecializedType(AValue: TPasGenericType);
  2853. begin
  2854. if FSpecializedType=AValue then Exit;
  2855. if FSpecializedType<>nil then
  2856. FSpecializedType.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  2857. FSpecializedEl:=AValue;
  2858. FSpecializedType:=AValue;
  2859. if FSpecializedType<>nil then
  2860. FSpecializedType.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  2861. end;
  2862. destructor TPRSpecializedTypeItem.Destroy;
  2863. var
  2864. i: Integer;
  2865. begin
  2866. if ImplProcs<>nil then
  2867. begin
  2868. for i:=0 to ImplProcs.Count-1 do
  2869. TPasElement(ImplProcs[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  2870. ImplProcs.Free;
  2871. ImplProcs:=nil;
  2872. end;
  2873. HeaderScope.Free;
  2874. HeaderScope:=nil;
  2875. SpecializedType:=nil;
  2876. inherited Destroy;
  2877. end;
  2878. { TPRSpecializedProcItem }
  2879. procedure TPRSpecializedProcItem.SetSpecializedProc(const AValue: TPasProcedure
  2880. );
  2881. begin
  2882. if FSpecializedProc=AValue then Exit;
  2883. if FSpecializedProc<>nil then
  2884. FSpecializedProc.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  2885. FSpecializedEl:=AValue;
  2886. FSpecializedProc:=AValue;
  2887. if FSpecializedProc<>nil then
  2888. FSpecializedProc.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  2889. end;
  2890. destructor TPRSpecializedProcItem.Destroy;
  2891. begin
  2892. if ImplProc<>nil then
  2893. TPasElement(ImplProc).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  2894. SpecializedProc:=nil;
  2895. inherited Destroy;
  2896. end;
  2897. { TPasGenericScope }
  2898. destructor TPasGenericScope.Destroy;
  2899. begin
  2900. if SpecializedItems<>nil then
  2901. begin
  2902. SpecializedItems.Free;
  2903. SpecializedItems:=nil;
  2904. end;
  2905. inherited Destroy;
  2906. end;
  2907. { TPasInheritedScope }
  2908. function TPasInheritedScope.FindIdentifier(const Identifier: String
  2909. ): TPasIdentifier;
  2910. var
  2911. aClassScope: TPasClassScope;
  2912. begin
  2913. Result:=inherited FindIdentifier(Identifier);
  2914. if Result<>nil then exit;
  2915. aClassScope:=AncestorScope;
  2916. while aClassScope<>nil do
  2917. begin
  2918. Result:=aClassScope.FindIdentifier(Identifier);
  2919. if Result<>nil then exit;
  2920. aClassScope:=aClassScope.AncestorScope;
  2921. end;
  2922. end;
  2923. procedure TPasInheritedScope.IterateElements(const aName: string;
  2924. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2925. Data: Pointer; var Abort: boolean);
  2926. var
  2927. aClassScope: TPasClassScope;
  2928. begin
  2929. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2930. if Abort then exit;
  2931. aClassScope:=AncestorScope;
  2932. while aClassScope<>nil do
  2933. begin
  2934. aClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2935. if Abort then exit;
  2936. aClassScope:=aClassScope.AncestorScope;
  2937. end;
  2938. end;
  2939. procedure TPasInheritedScope.WriteIdentifiers(Prefix: string);
  2940. var
  2941. aClassScope: TPasClassScope;
  2942. begin
  2943. inherited WriteIdentifiers(Prefix);
  2944. aClassScope:=AncestorScope;
  2945. while aClassScope<>nil do
  2946. begin
  2947. aClassScope.WriteIdentifiers(Prefix);
  2948. aClassScope:=aClassScope.AncestorScope;
  2949. end;
  2950. end;
  2951. { TPasDotEnumTypeScope }
  2952. function TPasDotEnumTypeScope.FindIdentifier(const Identifier: String
  2953. ): TPasIdentifier;
  2954. begin
  2955. Result:=EnumScope.FindLocalIdentifier(Identifier);
  2956. if Result<>nil then exit;
  2957. Result:=inherited FindIdentifier(Identifier);
  2958. end;
  2959. procedure TPasDotEnumTypeScope.IterateElements(const aName: string;
  2960. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2961. Data: Pointer; var Abort: boolean);
  2962. begin
  2963. EnumScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2964. if Abort then exit;
  2965. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2966. end;
  2967. procedure TPasDotEnumTypeScope.WriteIdentifiers(Prefix: string);
  2968. begin
  2969. EnumScope.WriteIdentifiers(Prefix);
  2970. inherited WriteIdentifiers(Prefix);
  2971. end;
  2972. { TPasGroupScope }
  2973. procedure TPasGroupScope.Add(Scope: TPasIdentifierScope);
  2974. var
  2975. i: Integer;
  2976. begin
  2977. for i:=0 to Count-1 do
  2978. if Scopes[i]=Scope then exit; // already added
  2979. if Scope.FreeOnPop then
  2980. raise Exception.Create('TPasGroupScope.Add '+GetObjName(Scope)+' '+GetObjName(Scope.Element));
  2981. if Count=length(Scopes) then
  2982. SetLength(Scopes,Count*2+4);
  2983. Scopes[Count]:=Scope;
  2984. inc(Count);
  2985. end;
  2986. destructor TPasGroupScope.Destroy;
  2987. begin
  2988. Scopes:=nil;
  2989. Count:=0;
  2990. inherited Destroy;
  2991. end;
  2992. function TPasGroupScope.GetFirstNonHelperScope: TPasIdentifierScope;
  2993. var
  2994. i: Integer;
  2995. Scope: TPasIdentifierScope;
  2996. begin
  2997. for i:=0 to Count-1 do
  2998. begin
  2999. Scope:=Scopes[i];
  3000. if (Scope.ClassType<>TPasClassScope)
  3001. or (TPasClassType(Scope.Element).HelperForType=nil) then
  3002. exit(Scope);
  3003. end;
  3004. Result:=nil;
  3005. end;
  3006. class function TPasGroupScope.IsStoredInElement: boolean;
  3007. begin
  3008. Result:=false;
  3009. end;
  3010. function TPasGroupScope.FindAncestorIdentifier(const Identifier: String
  3011. ): TPasIdentifier;
  3012. var
  3013. i: Integer;
  3014. begin
  3015. for i:=1 to Count-1 do
  3016. begin
  3017. Result:=Scopes[i].FindIdentifier(Identifier);
  3018. if Result<>nil then exit;
  3019. end;
  3020. Result:=nil;
  3021. end;
  3022. function TPasGroupScope.FindAncestorElement(const Identifier: String
  3023. ): TPasElement;
  3024. var
  3025. Item: TPasIdentifier;
  3026. begin
  3027. Item:=FindAncestorIdentifier(Identifier);
  3028. if Item<>nil then
  3029. Result:=Item.Element
  3030. else
  3031. Result:=nil;
  3032. end;
  3033. function TPasGroupScope.FindIdentifier(const Identifier: String
  3034. ): TPasIdentifier;
  3035. var
  3036. i: Integer;
  3037. begin
  3038. for i:=0 to Count-1 do
  3039. begin
  3040. Result:=Scopes[i].FindIdentifier(Identifier);
  3041. if Result<>nil then exit;
  3042. end;
  3043. Result:=nil;
  3044. end;
  3045. procedure TPasGroupScope.IterateElements(const aName: string;
  3046. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3047. Data: Pointer; var Abort: boolean);
  3048. var
  3049. i: Integer;
  3050. begin
  3051. for i:=0 to Count-1 do
  3052. begin
  3053. Scopes[i].IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
  3054. if Abort then exit;
  3055. end;
  3056. end;
  3057. procedure TPasGroupScope.WriteIdentifiers(Prefix: string);
  3058. var
  3059. i: Integer;
  3060. begin
  3061. for i:=0 to Count-1 do
  3062. Scopes[i].WriteIdentifiers(Prefix+'Group['+IntToStr(i)+'/'+IntToStr(Count)+']');
  3063. end;
  3064. {$ifdef pas2js}
  3065. { TPasResHashList }
  3066. constructor TPasResHashList.Create;
  3067. begin
  3068. FItems:=TJSObject.new;
  3069. end;
  3070. procedure TPasResHashList.Add(const aName: string; Item: Pointer);
  3071. begin
  3072. FItems['%'+aName]:=Item;
  3073. end;
  3074. function TPasResHashList.Find(const aName: string): Pointer;
  3075. begin
  3076. if FItems.hasOwnProperty('%'+aName) then
  3077. Result:=Pointer(FItems['%'+aName])
  3078. else
  3079. Result:=nil;
  3080. end;
  3081. procedure TPasResHashList.ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  3082. var
  3083. key: string;
  3084. begin
  3085. for key in FItems do
  3086. if FItems.hasOwnProperty(key) then
  3087. Proc(Pointer(FItems[key]),Arg);
  3088. end;
  3089. procedure TPasResHashList.Clear;
  3090. begin
  3091. FItems:=TJSObject.new;
  3092. end;
  3093. procedure TPasResHashList.Remove(const aName: string);
  3094. begin
  3095. if FItems.hasOwnProperty('%'+aName) then
  3096. JSDelete(FItems,'%'+aName);
  3097. end;
  3098. {$endif}
  3099. { TResElDataBuiltInProc }
  3100. destructor TResElDataBuiltInProc.Destroy;
  3101. begin
  3102. ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TResElDataBuiltInProc.Proc'{$ENDIF});
  3103. inherited Destroy;
  3104. end;
  3105. { TPasClassIntfMap }
  3106. destructor TPasClassIntfMap.Destroy;
  3107. begin
  3108. Element:=nil;
  3109. Intf:=nil;
  3110. FreeAndNil(Procs);
  3111. FreeAndNil(AncestorMap);
  3112. inherited Destroy;
  3113. end;
  3114. { TPasInitialFinalizationScope }
  3115. function TPasInitialFinalizationScope.AddReference(El: TPasElement;
  3116. Access: TPSRefAccess): TPasScopeReference;
  3117. begin
  3118. if References=nil then
  3119. References:=TPasScopeReferences.Create(Self);
  3120. Result:=References.Add(El,Access);
  3121. end;
  3122. destructor TPasInitialFinalizationScope.Destroy;
  3123. begin
  3124. FreeAndNil(References);
  3125. inherited Destroy;
  3126. end;
  3127. { TPasScopeReference }
  3128. procedure TPasScopeReference.SetElement(const AValue: TPasElement);
  3129. begin
  3130. if FElement=AValue then Exit;
  3131. if FElement<>nil then
  3132. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3133. FElement:=AValue;
  3134. if FElement<>nil then
  3135. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3136. end;
  3137. destructor TPasScopeReference.Destroy;
  3138. begin
  3139. {$IFDEF VerbosePasResolverMem}
  3140. writeln('TPasProcScopeReference.Destroy START ',ClassName,' "',GetObjName(Element),'"');
  3141. {$ENDIF}
  3142. Element:=nil;
  3143. inherited Destroy;
  3144. {$IFDEF VerbosePasResolverMem}
  3145. writeln('TPasProcScopeReference.Destroy END ',ClassName);
  3146. {$ENDIF}
  3147. end;
  3148. { TPasScopeReferences }
  3149. procedure TPasScopeReferences.OnClearItem(Item, Dummy: pointer);
  3150. var
  3151. Ref: TPasScopeReference absolute Item;
  3152. Ref2: TPasScopeReference;
  3153. begin
  3154. if Dummy=nil then ;
  3155. //writeln('TPasProcedureScope.OnClearReferenceItem ',GetObjName(Ref.Element));
  3156. while Ref<>nil do
  3157. begin
  3158. Ref2:=Ref;
  3159. Ref:=Ref.NextSameName;
  3160. Ref2.Free;
  3161. end;
  3162. end;
  3163. procedure TPasScopeReferences.OnCollectItem(Item, aList: pointer);
  3164. var
  3165. Ref: TPasScopeReference absolute Item;
  3166. List: TFPList absolute aList;
  3167. begin
  3168. while Ref<>nil do
  3169. begin
  3170. List.Add(Ref);
  3171. Ref:=Ref.NextSameName;
  3172. end;
  3173. end;
  3174. constructor TPasScopeReferences.Create(aScope: TPasScope);
  3175. begin
  3176. References:=TPasResHashList.Create;
  3177. FScope:=aScope;
  3178. end;
  3179. destructor TPasScopeReferences.Destroy;
  3180. begin
  3181. Clear;
  3182. {$ifdef pas2js}
  3183. References:=nil;
  3184. {$else}
  3185. FreeAndNil(References);
  3186. {$endif}
  3187. inherited Destroy;
  3188. end;
  3189. procedure TPasScopeReferences.Clear;
  3190. begin
  3191. if References=nil then exit;
  3192. References.ForEachCall(@OnClearItem,nil);
  3193. References.Clear;
  3194. end;
  3195. function TPasScopeReferences.Add(El: TPasElement; Access: TPSRefAccess
  3196. ): TPasScopeReference;
  3197. var
  3198. LoName: String;
  3199. OldItem, Item, LastItem: TPasScopeReference;
  3200. begin
  3201. LoName:=lowercase(El.Name);
  3202. OldItem:=TPasScopeReference(References.Find(LoName));
  3203. Item:=OldItem;
  3204. LastItem:=nil;
  3205. while Item<>nil do
  3206. begin
  3207. if Item.Element=El then
  3208. begin
  3209. // already marked as used -> combine access
  3210. case Access of
  3211. psraNone: ;
  3212. psraRead:
  3213. case Item.Access of
  3214. psraNone: Item.Access:=Access;
  3215. //psraRead: ;
  3216. psraWrite: Item.Access:=psraWriteRead;
  3217. //psraReadWrite: ;
  3218. //psraWriteRead: ;
  3219. //psraTypeInfo: ;
  3220. end;
  3221. psraWrite:
  3222. case Item.Access of
  3223. psraNone: Item.Access:=Access;
  3224. psraRead: Item.Access:=psraReadWrite;
  3225. //psraWrite: ;
  3226. //psraReadWrite: ;
  3227. //psraWriteRead: ;
  3228. //psraTypeInfo: ;
  3229. end;
  3230. psraReadWrite:
  3231. case Item.Access of
  3232. psraNone: Item.Access:=Access;
  3233. psraRead: Item.Access:=psraReadWrite;
  3234. psraWrite: Item.Access:=psraWriteRead;
  3235. //psraReadWrite: ;
  3236. //psraWriteRead: ;
  3237. //psraTypeInfo: ;
  3238. end;
  3239. psraWriteRead:
  3240. case Item.Access of
  3241. psraNone: Item.Access:=Access;
  3242. psraRead: Item.Access:=psraReadWrite;
  3243. psraWrite: Item.Access:=psraWriteRead;
  3244. //psraReadWrite: ;
  3245. //psraWriteRead: ;
  3246. //psraTypeInfo: ;
  3247. end;
  3248. psraTypeInfo: Item.Access:=psraTypeInfo;
  3249. else
  3250. raise EPasResolve.Create(GetObjName(El)+' unknown Access');
  3251. end;
  3252. exit(Item);
  3253. end;
  3254. LastItem:=Item;
  3255. Item:=Item.NextSameName;
  3256. end;
  3257. // new reference
  3258. Item:=TPasScopeReference.Create;
  3259. Item.Element:=El;
  3260. Item.Access:=Access;
  3261. if LastItem=nil then
  3262. begin
  3263. References.Add(LoName,Item);
  3264. {$IFDEF VerbosePCUFiler}
  3265. if TPasScopeReference(References.Find(LoName))<>Item then
  3266. raise EPasResolve.Create('20180219230028');
  3267. {$ENDIF}
  3268. end
  3269. else
  3270. LastItem.NextSameName:=Item;
  3271. Result:=Item;
  3272. end;
  3273. function TPasScopeReferences.Find(const aName: string): TPasScopeReference;
  3274. var
  3275. LoName: String;
  3276. begin
  3277. if References=nil then exit(nil);
  3278. LoName:=lowercase(aName);
  3279. Result:=TPasScopeReference(References.Find(LoName));
  3280. end;
  3281. function TPasScopeReferences.GetList: TFPList;
  3282. begin
  3283. Result:=TFPList.Create;
  3284. if References=nil then exit;
  3285. References.ForEachCall(@OnCollectItem,Result);
  3286. end;
  3287. { TPasPropertyScope }
  3288. destructor TPasPropertyScope.Destroy;
  3289. begin
  3290. {$IFDEF VerbosePasResolverMem}
  3291. writeln('TPasPropertyScope.Destroy START ',ClassName);
  3292. {$ENDIF}
  3293. AncestorProp:=nil;
  3294. inherited Destroy;
  3295. {$IFDEF VerbosePasResolverMem}
  3296. writeln('TPasPropertyScope.Destroy END',ClassName);
  3297. {$ENDIF}
  3298. end;
  3299. { TPasEnumTypeScope }
  3300. destructor TPasEnumTypeScope.Destroy;
  3301. begin
  3302. {$IFDEF VerbosePasResolverMem}
  3303. writeln('TPasEnumTypeScope.Destroy START ',ClassName);
  3304. {$ENDIF}
  3305. ReleaseAndNil(TPasElement(CanonicalSet){$IFDEF CheckPasTreeRefCount},'TPasEnumTypeScope.CanonicalSet'{$ENDIF});
  3306. inherited Destroy;
  3307. {$IFDEF VerbosePasResolverMem}
  3308. writeln('TPasEnumTypeScope.Destroy END ',ClassName);
  3309. {$ENDIF}
  3310. end;
  3311. { TPasDotBaseScope }
  3312. function TPasDotBaseScope.FindIdentifier(const Identifier: String
  3313. ): TPasIdentifier;
  3314. begin
  3315. Result:=GroupScope.FindIdentifier(Identifier);
  3316. end;
  3317. procedure TPasDotBaseScope.IterateElements(const aName: string;
  3318. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3319. Data: Pointer; var Abort: boolean);
  3320. begin
  3321. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3322. end;
  3323. procedure TPasDotBaseScope.WriteIdentifiers(Prefix: string);
  3324. begin
  3325. GroupScope.WriteIdentifiers(Prefix);
  3326. end;
  3327. destructor TPasDotBaseScope.Destroy;
  3328. begin
  3329. FreeAndNil(GroupScope);
  3330. inherited Destroy;
  3331. end;
  3332. { TPasWithExprScope }
  3333. class function TPasWithExprScope.IsStoredInElement: boolean;
  3334. begin
  3335. Result:=false;
  3336. end;
  3337. class function TPasWithExprScope.FreeOnPop: boolean;
  3338. begin
  3339. Result:=false;
  3340. end;
  3341. procedure TPasWithExprScope.IterateElements(const aName: string;
  3342. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3343. Data: Pointer; var Abort: boolean);
  3344. begin
  3345. Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3346. end;
  3347. procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
  3348. begin
  3349. {AllowWriteln}
  3350. writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
  3351. Scope.WriteIdentifiers(Prefix);
  3352. {AllowWriteln-}
  3353. end;
  3354. destructor TPasWithExprScope.Destroy;
  3355. begin
  3356. FreeAndNil(Scope);
  3357. inherited Destroy;
  3358. end;
  3359. { TPasWithScope }
  3360. constructor TPasWithScope.Create;
  3361. begin
  3362. inherited Create;
  3363. ExpressionScopes:=TObjectList.Create(true);
  3364. end;
  3365. destructor TPasWithScope.Destroy;
  3366. begin
  3367. {$IFDEF VerbosePasResolverMem}
  3368. writeln('TPasWithScope.Destroy START ',ClassName);
  3369. {$ENDIF}
  3370. FreeAndNil(ExpressionScopes);
  3371. inherited Destroy;
  3372. {$IFDEF VerbosePasResolverMem}
  3373. writeln('TPasWithScope.Destroy END ',ClassName);
  3374. {$ENDIF}
  3375. end;
  3376. { TPasProcedureScope }
  3377. function TPasProcedureScope.FindIdentifier(const Identifier: String
  3378. ): TPasIdentifier;
  3379. begin
  3380. Result:=inherited FindIdentifier(Identifier);
  3381. if (Result<>nil) or (GroupScope=nil) then exit;
  3382. Result:=GroupScope.FindIdentifier(Identifier);
  3383. end;
  3384. procedure TPasProcedureScope.IterateElements(const aName: string;
  3385. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3386. Data: Pointer; var Abort: boolean);
  3387. begin
  3388. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3389. if Abort then exit;
  3390. if GroupScope=nil then exit;
  3391. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3392. end;
  3393. function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
  3394. var
  3395. Proc: TPasProcedure;
  3396. El: TPasElement;
  3397. begin
  3398. Result:=Self;
  3399. repeat
  3400. if Result.ClassRecScope<>nil then exit;
  3401. Proc:=TPasProcedure(Result.Element);
  3402. El:=Proc.Parent;
  3403. repeat
  3404. if El=nil then exit(nil);
  3405. if El is TProcedureBody then break;
  3406. El:=El.Parent;
  3407. until false;
  3408. Proc:=El.Parent as TPasProcedure;
  3409. Result:=TPasProcedureScope(Proc.CustomData);
  3410. until false;
  3411. end;
  3412. procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
  3413. begin
  3414. inherited WriteIdentifiers(Prefix);
  3415. if GroupScope<>nil then
  3416. GroupScope.WriteIdentifiers(Prefix+'GS ');
  3417. end;
  3418. destructor TPasProcedureScope.Destroy;
  3419. begin
  3420. {$IFDEF VerbosePasResolverMem}
  3421. writeln('TPasProcedureScope.Destroy START ',ClassName);
  3422. {$ENDIF}
  3423. FreeAndNil(References);
  3424. FreeAndNil(GroupScope);
  3425. inherited Destroy;
  3426. ReleaseAndNil(TPasElement(SelfArg){$IFDEF CheckPasTreeRefCount},'TPasProcedureScope.SelfArg'{$ENDIF});
  3427. {$IFDEF VerbosePasResolverMem}
  3428. writeln('TPasProcedureScope.Destroy END ',ClassName);
  3429. {$ENDIF}
  3430. end;
  3431. function TPasProcedureScope.AddReference(El: TPasElement; Access: TPSRefAccess
  3432. ): TPasScopeReference;
  3433. begin
  3434. if References=nil then
  3435. References:=TPasScopeReferences.Create(Self);
  3436. Result:=References.Add(El,Access);
  3437. end;
  3438. function TPasProcedureScope.GetReferences: TFPList;
  3439. begin
  3440. if References=nil then
  3441. Result:=TFPList.Create
  3442. else
  3443. Result:=References.GetList;
  3444. end;
  3445. { TPasClassScope }
  3446. destructor TPasClassScope.Destroy;
  3447. var
  3448. i: Integer;
  3449. o: TObject;
  3450. begin
  3451. if Interfaces<>nil then
  3452. begin
  3453. for i:=0 to Interfaces.Count-1 do
  3454. begin
  3455. o:=TObject(Interfaces[i]);
  3456. if o=nil then
  3457. else if o is TPasProperty then
  3458. else if o is TPasClassIntfMap then
  3459. o.Free
  3460. else
  3461. raise Exception.Create('[20180322132757] '+GetElementDbgPath(Element)+' i='+IntToStr(i)+' '+GetObjName(o));
  3462. end;
  3463. FreeAndNil(Interfaces);
  3464. end;
  3465. if CanonicalClassOf<>nil then
  3466. begin
  3467. CanonicalClassOf.Parent:=nil;
  3468. ReleaseAndNil(TPasElement(CanonicalClassOf){$IFDEF CheckPasTreeRefCount},'TPasClassScope.CanonicalClassOf'{$ENDIF});
  3469. end;
  3470. inherited Destroy;
  3471. end;
  3472. { TPasIdentifier }
  3473. procedure TPasIdentifier.SetElement(AValue: TPasElement);
  3474. begin
  3475. if FElement=AValue then Exit;
  3476. if Element<>nil then
  3477. Element.Release{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3478. FElement:=AValue;
  3479. if Element<>nil then
  3480. Element.AddRef{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3481. end;
  3482. destructor TPasIdentifier.Destroy;
  3483. begin
  3484. {$IFDEF VerbosePasResolverMem}
  3485. writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
  3486. {$ENDIF}
  3487. Element:=nil;
  3488. inherited Destroy;
  3489. {$IFDEF VerbosePasResolverMem}
  3490. writeln('TPasIdentifier.Destroy END ',ClassName);
  3491. {$ENDIF}
  3492. end;
  3493. { EPasResolve }
  3494. procedure EPasResolve.SetPasElement(AValue: TPasElement);
  3495. begin
  3496. if FPasElement=AValue then Exit;
  3497. if PasElement<>nil then
  3498. PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3499. FPasElement:=AValue;
  3500. if PasElement<>nil then
  3501. PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3502. end;
  3503. destructor EPasResolve.Destroy;
  3504. begin
  3505. {$IFDEF VerbosePasResolverMem}
  3506. writeln('EPasResolve.Destroy START ',ClassName);
  3507. {$ENDIF}
  3508. PasElement:=nil;
  3509. inherited Destroy;
  3510. {$IFDEF VerbosePasResolverMem}
  3511. writeln('EPasResolve.Destroy END ',ClassName);
  3512. {$ENDIF}
  3513. end;
  3514. { TResolvedReference }
  3515. procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
  3516. begin
  3517. if FDeclaration=AValue then Exit;
  3518. if Declaration<>nil then
  3519. Declaration.Release{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3520. FDeclaration:=AValue;
  3521. if Declaration<>nil then
  3522. Declaration.AddRef{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3523. end;
  3524. destructor TResolvedReference.Destroy;
  3525. begin
  3526. {$IFDEF VerbosePasResolverMem}
  3527. writeln('TResolvedReference.Destroy START ',ClassName);
  3528. {$ENDIF}
  3529. Declaration:=nil;
  3530. FreeAndNil(Context);
  3531. inherited Destroy;
  3532. {$IFDEF VerbosePasResolverMem}
  3533. writeln('TResolvedReference.Destroy END ',ClassName);
  3534. {$ENDIF}
  3535. end;
  3536. { TPasSubExprScope }
  3537. class function TPasSubExprScope.IsStoredInElement: boolean;
  3538. begin
  3539. Result:=false;
  3540. end;
  3541. { TPasModuleDotScope }
  3542. procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
  3543. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3544. var
  3545. FilterData: PPasIterateFilterData absolute Data;
  3546. begin
  3547. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3548. exit; // skip used units
  3549. // call the original iterator
  3550. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3551. end;
  3552. procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
  3553. begin
  3554. if FModule=AValue then Exit;
  3555. if Module<>nil then
  3556. Module.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3557. FModule:=AValue;
  3558. if Module<>nil then
  3559. Module.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3560. end;
  3561. destructor TPasModuleDotScope.Destroy;
  3562. begin
  3563. {$IFDEF VerbosePasResolverMem}
  3564. writeln('TPasSubModuleScope.Destroy START ',ClassName);
  3565. {$ENDIF}
  3566. Module:=nil;
  3567. inherited Destroy;
  3568. {$IFDEF VerbosePasResolverMem}
  3569. writeln('TPasSubModuleScope.Destroy END ',ClassName);
  3570. {$ENDIF}
  3571. end;
  3572. function TPasModuleDotScope.FindIdentifier(const Identifier: String
  3573. ): TPasIdentifier;
  3574. function Find(Scope: TPasIdentifierScope): boolean;
  3575. var
  3576. Found: TPasIdentifier;
  3577. C: TClass;
  3578. begin
  3579. if Scope=nil then exit(false);
  3580. Found:=Scope.FindLocalIdentifier(Identifier);
  3581. FindIdentifier:=Found;
  3582. if Found=nil then exit(false);
  3583. C:=Found.Element.ClassType;
  3584. Result:=(C<>TPasModule) and (C<>TPasUsesUnit);
  3585. end;
  3586. begin
  3587. Result:=nil;
  3588. if Find(ImplementationScope) then exit;
  3589. if Find(InterfaceScope) then exit;
  3590. Find(SystemScope);
  3591. end;
  3592. procedure TPasModuleDotScope.IterateElements(const aName: string;
  3593. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3594. Data: Pointer; var Abort: boolean);
  3595. var
  3596. FilterData: TPasIterateFilterData;
  3597. function Iterate(Scope: TPasIdentifierScope): boolean;
  3598. begin
  3599. if Scope=nil then exit(false);
  3600. Scope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3601. Result:=Abort;
  3602. end;
  3603. begin
  3604. FilterData.OnIterate:=OnIterateElement;
  3605. FilterData.Data:=Data;
  3606. if Iterate(ImplementationScope) then exit;
  3607. if Iterate(InterfaceScope) then exit;
  3608. Iterate(SystemScope);
  3609. end;
  3610. procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
  3611. begin
  3612. if ImplementationScope<>nil then
  3613. ImplementationScope.WriteIdentifiers(Prefix+' ');
  3614. if InterfaceScope<>nil then
  3615. InterfaceScope.WriteIdentifiers(Prefix+' ');
  3616. if SystemScope<>nil then
  3617. SystemScope.WriteIdentifiers(Prefix+' ');
  3618. end;
  3619. { TPasSectionScope }
  3620. procedure TPasSectionScope.OnInternalIterate(El: TPasElement; ElScope,
  3621. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3622. var
  3623. FilterData: PPasIterateFilterData absolute Data;
  3624. begin
  3625. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3626. exit; // skip used units
  3627. // call the original iterator
  3628. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3629. end;
  3630. constructor TPasSectionScope.Create;
  3631. begin
  3632. inherited Create;
  3633. UsesScopes:=TFPList.Create;
  3634. end;
  3635. destructor TPasSectionScope.Destroy;
  3636. begin
  3637. {$IFDEF VerbosePasResolverMem}
  3638. writeln('TPasSectionScope.Destroy START ',ClassName);
  3639. {$ENDIF}
  3640. ClearHelperList(Helpers);
  3641. FreeAndNil(UsesScopes);
  3642. inherited Destroy;
  3643. {$IFDEF VerbosePasResolverMem}
  3644. writeln('TPasSectionScope.Destroy END ',ClassName);
  3645. {$ENDIF}
  3646. end;
  3647. function TPasSectionScope.FindIdentifier(const Identifier: String
  3648. ): TPasIdentifier;
  3649. var
  3650. i: Integer;
  3651. UsesScope: TPasIdentifierScope;
  3652. C: TClass;
  3653. begin
  3654. Result:=inherited FindIdentifier(Identifier);
  3655. if Result<>nil then
  3656. exit;
  3657. for i:=UsesScopes.Count-1 downto 0 do
  3658. begin
  3659. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3660. {$IFDEF VerbosePasResolver}
  3661. writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
  3662. {$ENDIF}
  3663. Result:=UsesScope.FindLocalIdentifier(Identifier);
  3664. if Result<>nil then
  3665. begin
  3666. C:=Result.Element.ClassType;
  3667. if (C<>TPasModule) and (C<>TPasUsesUnit) then
  3668. exit;
  3669. end;
  3670. end;
  3671. end;
  3672. procedure TPasSectionScope.IterateElements(const aName: string;
  3673. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3674. Data: Pointer; var Abort: boolean);
  3675. var
  3676. i: Integer;
  3677. UsesScope: TPasSectionScope;
  3678. FilterData: TPasIterateFilterData;
  3679. begin
  3680. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3681. if Abort then exit;
  3682. FilterData.OnIterate:=OnIterateElement;
  3683. FilterData.Data:=Data;
  3684. for i:=UsesScopes.Count-1 downto 0 do
  3685. begin
  3686. UsesScope:=TPasSectionScope(UsesScopes[i]);
  3687. {$IFDEF VerbosePasResolver}
  3688. writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',UsesScope.Element.ParentPath,':',GetObjName(UsesScope.Element));
  3689. {$ENDIF}
  3690. UsesScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3691. if Abort then exit;
  3692. end;
  3693. end;
  3694. procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
  3695. var
  3696. i: Integer;
  3697. UsesScope: TPasIdentifierScope;
  3698. SubPrefix: String;
  3699. begin
  3700. {AllowWriteln}
  3701. inherited WriteIdentifiers(Prefix);
  3702. SubPrefix:=Prefix+' ';
  3703. for i:=UsesScopes.Count-1 downto 0 do
  3704. begin
  3705. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3706. writeln(Prefix+' Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
  3707. UsesScope.FItems.ForEachCall(@OnWriteItem,Pointer(SubPrefix));
  3708. end;
  3709. {AllowWriteln-}
  3710. end;
  3711. { TPasModuleScope }
  3712. procedure TPasModuleScope.SetAssertClass(const AValue: TPasClassType);
  3713. begin
  3714. if FAssertClass=AValue then Exit;
  3715. if FAssertClass<>nil then
  3716. FAssertClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3717. FAssertClass:=AValue;
  3718. if FAssertClass<>nil then
  3719. FAssertClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3720. end;
  3721. procedure TPasModuleScope.SetAssertDefConstructor(const AValue: TPasConstructor
  3722. );
  3723. begin
  3724. if FAssertDefConstructor=AValue then Exit;
  3725. if FAssertDefConstructor<>nil then
  3726. FAssertDefConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3727. FAssertDefConstructor:=AValue;
  3728. if FAssertDefConstructor<>nil then
  3729. FAssertDefConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3730. end;
  3731. procedure TPasModuleScope.SetAssertMsgConstructor(const AValue: TPasConstructor
  3732. );
  3733. begin
  3734. if FAssertMsgConstructor=AValue then Exit;
  3735. if FAssertMsgConstructor<>nil then
  3736. FAssertMsgConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3737. FAssertMsgConstructor:=AValue;
  3738. if FAssertMsgConstructor<>nil then
  3739. FAssertMsgConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3740. end;
  3741. procedure TPasModuleScope.SetRangeErrorClass(const AValue: TPasClassType);
  3742. begin
  3743. if FRangeErrorClass=AValue then Exit;
  3744. if FRangeErrorClass<>nil then
  3745. FRangeErrorClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3746. FRangeErrorClass:=AValue;
  3747. if FRangeErrorClass<>nil then
  3748. FRangeErrorClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3749. end;
  3750. procedure TPasModuleScope.SetRangeErrorConstructor(const AValue: TPasConstructor
  3751. );
  3752. begin
  3753. if FRangeErrorConstructor=AValue then Exit;
  3754. if FRangeErrorConstructor<>nil then
  3755. FRangeErrorConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3756. FRangeErrorConstructor:=AValue;
  3757. if FRangeErrorConstructor<>nil then
  3758. FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3759. end;
  3760. procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
  3761. begin
  3762. if FSystemTVarRec=AValue then Exit;
  3763. if FSystemTVarRec<>nil then
  3764. FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3765. FSystemTVarRec:=AValue;
  3766. if FSystemTVarRec<>nil then
  3767. FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3768. end;
  3769. constructor TPasModuleScope.Create;
  3770. begin
  3771. inherited Create;
  3772. PendingResolvers:=TFPList.Create;
  3773. end;
  3774. destructor TPasModuleScope.Destroy;
  3775. begin
  3776. AssertClass:=nil;
  3777. AssertDefConstructor:=nil;
  3778. AssertMsgConstructor:=nil;
  3779. RangeErrorClass:=nil;
  3780. RangeErrorConstructor:=nil;
  3781. SystemTVarRec:=nil;
  3782. FreeAndNil(PendingResolvers);
  3783. inherited Destroy;
  3784. end;
  3785. procedure TPasModuleScope.IterateElements(const aName: string;
  3786. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3787. Data: Pointer; var Abort: boolean);
  3788. begin
  3789. if CompareText(aName,FirstName)<>0 then exit;
  3790. OnIterateElement(Element,Self,StartScope,Data,Abort);
  3791. end;
  3792. { TPasDefaultScope }
  3793. class function TPasDefaultScope.IsStoredInElement: boolean;
  3794. begin
  3795. Result:=false;
  3796. end;
  3797. { TPasScope }
  3798. class function TPasScope.IsStoredInElement: boolean;
  3799. begin
  3800. Result:=true;
  3801. end;
  3802. class function TPasScope.FreeOnPop: boolean;
  3803. begin
  3804. Result:=not IsStoredInElement;
  3805. end;
  3806. procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
  3807. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  3808. var Abort: boolean);
  3809. begin
  3810. if aName='' then ;
  3811. if StartScope=nil then ;
  3812. if Data=nil then ;
  3813. if OnIterateElement=nil then ;
  3814. if Abort then ;
  3815. end;
  3816. procedure TPasScope.WriteIdentifiers(Prefix: string);
  3817. begin
  3818. {AllowWriteln}
  3819. writeln(Prefix,'(',ClassName,') Element: ',GetObjName(Element));
  3820. {AllowWriteln-}
  3821. end;
  3822. { TPasIdentifierScope }
  3823. // inline
  3824. function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
  3825. ): TPasIdentifier;
  3826. begin
  3827. Result:=TPasIdentifier(FItems.Find(lowercase(Identifier)));
  3828. end;
  3829. procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
  3830. var
  3831. PasIdentifier: TPasIdentifier absolute Item;
  3832. Ident: TPasIdentifier;
  3833. begin
  3834. if Dummy=nil then ;
  3835. //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  3836. while PasIdentifier<>nil do
  3837. begin
  3838. Ident:=PasIdentifier;
  3839. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  3840. Ident.Free;
  3841. end;
  3842. end;
  3843. procedure TPasIdentifierScope.OnCollectItem(Item, List: pointer);
  3844. var
  3845. PasIdentifier: TPasIdentifier absolute Item;
  3846. FPList: TFPList absolute List;
  3847. begin
  3848. FPList.Add(PasIdentifier);
  3849. end;
  3850. procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
  3851. var
  3852. PasIdentifier: TPasIdentifier absolute Item;
  3853. Prefix: String;
  3854. begin
  3855. {AllowWriteln}
  3856. Prefix:=String(Dummy);
  3857. while PasIdentifier<>nil do
  3858. begin
  3859. writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
  3860. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  3861. end;
  3862. {AllowWriteln-}
  3863. end;
  3864. procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
  3865. var
  3866. OldItem: TPasIdentifier;
  3867. LoName: string;
  3868. {$ifdef pas2js}
  3869. {$ELSE}
  3870. Index: Integer;
  3871. {$ENDIF}
  3872. begin
  3873. LoName:=lowercase(Item.Identifier);
  3874. {$ifdef pas2js}
  3875. OldItem:=TPasIdentifier(FItems.Find(LoName));
  3876. if OldItem<>nil then
  3877. begin
  3878. // insert LIFO - last in, first out
  3879. Item.NextSameIdentifier:=OldItem;
  3880. end;
  3881. FItems.Add(LoName,Item);
  3882. {$IFDEF VerbosePasResolver}
  3883. if Item.Owner<>nil then
  3884. raise Exception.Create('20160925184110');
  3885. Item.Owner:=Self;
  3886. {$ENDIF}
  3887. {$IFDEF VerbosePasResolver}
  3888. if FindIdentifier(Item.Identifier)<>Item then
  3889. raise Exception.Create('20181018173201');
  3890. {$ENDIF}
  3891. {$else}
  3892. Index:=FItems.FindIndexOf(LoName);
  3893. {$IFDEF VerbosePasResolver}
  3894. if Item.Owner<>nil then
  3895. raise Exception.Create('20160925184110');
  3896. Item.Owner:=Self;
  3897. {$ENDIF}
  3898. //writeln(' Index=',Index);
  3899. if Index>=0 then
  3900. begin
  3901. // insert LIFO - last in, first out
  3902. OldItem:=TPasIdentifier(FItems.List^[Index].Data);
  3903. {$IFDEF VerbosePasResolver}
  3904. if lowercase(OldItem.Identifier)<>LoName then
  3905. raise Exception.Create('20160925183438');
  3906. {$ENDIF}
  3907. Item.NextSameIdentifier:=OldItem;
  3908. FItems.List^[Index].Data:=Item;
  3909. end
  3910. else
  3911. begin
  3912. FItems.Add(LoName, Item);
  3913. {$IFDEF VerbosePasResolver}
  3914. if FindIdentifier(Item.Identifier)<>Item then
  3915. raise Exception.Create('20160925183849');
  3916. {$ENDIF}
  3917. end;
  3918. {$endif}
  3919. end;
  3920. constructor TPasIdentifierScope.Create;
  3921. begin
  3922. FItems:=TPasResHashList.Create;
  3923. end;
  3924. destructor TPasIdentifierScope.Destroy;
  3925. begin
  3926. {$IFDEF VerbosePasResolverMem}
  3927. writeln('TPasIdentifierScope.Destroy START ',ClassName);
  3928. {$ENDIF}
  3929. FItems.ForEachCall(@OnClearItem,nil);
  3930. {$ifdef pas2js}
  3931. FItems:=nil;
  3932. {$else}
  3933. FItems.Clear;
  3934. FreeAndNil(FItems);
  3935. {$endif}
  3936. inherited Destroy;
  3937. {$IFDEF VerbosePasResolverMem}
  3938. writeln('TPasIdentifierScope.Destroy END ',ClassName);
  3939. {$ENDIF}
  3940. end;
  3941. function TPasIdentifierScope.FindIdentifier(const Identifier: String
  3942. ): TPasIdentifier;
  3943. begin
  3944. Result:=FindLocalIdentifier(Identifier);
  3945. {$IFDEF VerbosePasResolver}
  3946. {AllowWriteln}
  3947. if (Result<>nil) and (Result.Owner<>Self) then
  3948. begin
  3949. writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  3950. raise Exception.Create('20160925184159');
  3951. end;
  3952. {AllowWriteln-}
  3953. {$ENDIF}
  3954. end;
  3955. function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
  3956. var
  3957. Identifier, PrevIdentifier: TPasIdentifier;
  3958. LoName: string;
  3959. begin
  3960. LoName:=lowercase(El.Name);
  3961. Identifier:=TPasIdentifier(FItems.Find(LoName));
  3962. FindLocalIdentifier(El.Name);
  3963. PrevIdentifier:=nil;
  3964. Result:=false;
  3965. while Identifier<>nil do
  3966. begin
  3967. {$IFDEF VerbosePasResolver}
  3968. if (Identifier.Owner<>Self) then
  3969. raise Exception.Create('20160925184159');
  3970. {$ENDIF}
  3971. if Identifier.Element=El then
  3972. begin
  3973. if PrevIdentifier<>nil then
  3974. begin
  3975. PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
  3976. Identifier.Free;
  3977. Identifier:=PrevIdentifier.NextSameIdentifier;
  3978. end
  3979. else
  3980. begin
  3981. FItems.Remove({$ifdef pas2js}LoName{$else}Identifier{$endif});
  3982. PrevIdentifier:=Identifier;
  3983. Identifier:=Identifier.NextSameIdentifier;
  3984. PrevIdentifier.Free;
  3985. PrevIdentifier:=nil;
  3986. if Identifier<>nil then
  3987. FItems.Add(LoName,Identifier);
  3988. end;
  3989. Result:=true;
  3990. continue;
  3991. end;
  3992. PrevIdentifier:=Identifier;
  3993. Identifier:=Identifier.NextSameIdentifier;
  3994. end;
  3995. end;
  3996. function TPasIdentifierScope.AddIdentifier(const Identifier: String;
  3997. El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
  3998. var
  3999. Item: TPasIdentifier;
  4000. begin
  4001. //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
  4002. Item:=TPasIdentifier.Create;
  4003. Item.Identifier:=Identifier;
  4004. Item.Element:=El;
  4005. Item.Kind:=Kind;
  4006. InternalAdd(Item);
  4007. //writeln('TPasIdentifierScope.AddIdentifier END');
  4008. Result:=Item;
  4009. end;
  4010. function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
  4011. var
  4012. Item: TPasIdentifier;
  4013. begin
  4014. //writeln('TPasIdentifierScope.FindElement "',aName,'"');
  4015. Item:=FindIdentifier(aName);
  4016. if Item=nil then
  4017. Result:=nil
  4018. else
  4019. Result:=Item.Element;
  4020. //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
  4021. end;
  4022. procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
  4023. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4024. Data: Pointer; var Abort: boolean);
  4025. var
  4026. Item: TPasIdentifier;
  4027. {$IFDEF VerbosePasResolver}
  4028. OldElement: TPasElement;
  4029. {$ENDIF}
  4030. begin
  4031. Item:=FindLocalIdentifier(aName);
  4032. while Item<>nil do
  4033. begin
  4034. //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
  4035. {$IFDEF VerbosePasResolver}
  4036. OldElement:=Item.Element;
  4037. {$ENDIF}
  4038. OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
  4039. {$IFDEF VerbosePasResolver}
  4040. if OldElement<>Item.Element then
  4041. raise Exception.Create('20160925183503');
  4042. {$ENDIF}
  4043. if Abort then exit;
  4044. Item:=Item.NextSameIdentifier;
  4045. end;
  4046. end;
  4047. procedure TPasIdentifierScope.IterateElements(const aName: string;
  4048. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4049. Data: Pointer; var Abort: boolean);
  4050. begin
  4051. IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
  4052. end;
  4053. procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
  4054. begin
  4055. inherited WriteIdentifiers(Prefix);
  4056. WriteLocalIdentifiers(Prefix+' ');
  4057. end;
  4058. procedure TPasIdentifierScope.WriteLocalIdentifiers(Prefix: string);
  4059. begin
  4060. FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
  4061. end;
  4062. function TPasIdentifierScope.GetLocalIdentifiers: TFPList;
  4063. begin
  4064. Result:=TFPList.Create;
  4065. FItems.ForEachCall(@OnCollectItem,Result);
  4066. end;
  4067. { TPasResolver }
  4068. // inline
  4069. function TPasResolver.GetBaseTypes(bt: TResolverBaseType
  4070. ): TPasUnresolvedSymbolRef;
  4071. begin
  4072. Result:=FBaseTypes[bt];
  4073. end;
  4074. // inline
  4075. function TPasResolver.GetScopes(Index: integer): TPasScope;
  4076. begin
  4077. Result:=FScopes[Index];
  4078. end;
  4079. // inline
  4080. function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
  4081. begin
  4082. Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
  4083. end;
  4084. // inline
  4085. function TPasResolver.IsGenericTemplType(const ResolvedEl: TPasResolverResult
  4086. ): boolean;
  4087. begin
  4088. Result:=(ResolvedEl.BaseType=btContext)
  4089. and (ResolvedEl.LoTypeEl.ClassType=TPasGenericTemplateType);
  4090. end;
  4091. // inline
  4092. function TPasResolver.GetLocalScope: TPasScope;
  4093. begin
  4094. Result:=TopScope;
  4095. if Result.ClassType=TPasGroupScope then
  4096. Result:=TPasGroupScope(Result).Scopes[0];
  4097. end;
  4098. // inline
  4099. function TPasResolver.GetParentLocalScope: TPasScope;
  4100. begin
  4101. Result:=Scopes[ScopeCount-2];
  4102. if Result.ClassType=TPasGroupScope then
  4103. Result:=TPasGroupScope(Result).Scopes[0];
  4104. end;
  4105. function TPasResolver.GetNameExprValue(El: TPasExpr): string;
  4106. begin
  4107. if El=nil then
  4108. Result:=''
  4109. else if El.ClassType=TPrimitiveExpr then
  4110. begin
  4111. if TPrimitiveExpr(El).Kind=pekIdent then
  4112. Result:=TPrimitiveExpr(El).Value
  4113. else
  4114. Result:='';
  4115. end
  4116. else
  4117. Result:='';
  4118. end;
  4119. function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
  4120. // returns TPrimitiveExpr (Kind=pekIdent)
  4121. var
  4122. Bin: TBinaryExpr;
  4123. C: TClass;
  4124. begin
  4125. Result:=nil;
  4126. if El=nil then exit;
  4127. repeat
  4128. if not (El.Parent is TBinaryExpr) then exit;
  4129. Bin:=TBinaryExpr(El.Parent);
  4130. if Bin.OpCode<>eopSubIdent then exit;
  4131. if El=Bin.right then
  4132. El:=Bin
  4133. else
  4134. begin
  4135. El:=Bin.right;
  4136. // find left most
  4137. repeat
  4138. C:=El.ClassType;
  4139. if C=TPrimitiveExpr then
  4140. begin
  4141. if TPrimitiveExpr(El).Kind<>pekIdent then
  4142. RaiseNotYetImplemented(20170502163825,El);
  4143. exit(El);
  4144. end
  4145. else if C=TBinaryExpr then
  4146. begin
  4147. if TBinaryExpr(El).OpCode<>eopSubIdent then
  4148. RaiseNotYetImplemented(20170502163718,El);
  4149. El:=TBinaryExpr(El).left;
  4150. end
  4151. else if C=TParamsExpr then
  4152. begin
  4153. if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
  4154. RaiseNotYetImplemented(20170502163908,El);
  4155. El:=TParamsExpr(El).Value;
  4156. end;
  4157. until El=nil;
  4158. RaiseNotYetImplemented(20170502163953,Bin);
  4159. end;
  4160. until false;
  4161. end;
  4162. function TPasResolver.GetLeftMostExpr(El: TPasExpr): TPasExpr;
  4163. var
  4164. C: TClass;
  4165. begin
  4166. Result:=El;
  4167. while Result<>nil do
  4168. begin
  4169. El:=Result;
  4170. C:=Result.ClassType;
  4171. if C=TBinaryExpr then
  4172. begin
  4173. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4174. exit;
  4175. Result:=TBinaryExpr(Result).left;
  4176. end
  4177. else if C=TParamsExpr then
  4178. begin
  4179. if not (TParamsExpr(Result).Kind in [pekFuncParams,pekArrayParams]) then
  4180. exit;
  4181. Result:=TParamsExpr(Result).Value;
  4182. end
  4183. else
  4184. exit;
  4185. end;
  4186. end;
  4187. function TPasResolver.GetRightMostExpr(El: TPasExpr): TPasExpr;
  4188. var
  4189. C: TClass;
  4190. begin
  4191. Result:=El;
  4192. while Result<>nil do
  4193. begin
  4194. El:=Result;
  4195. C:=Result.ClassType;
  4196. if C=TBinaryExpr then
  4197. begin
  4198. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4199. exit;
  4200. Result:=TBinaryExpr(Result).right;
  4201. end
  4202. else
  4203. exit;
  4204. end;
  4205. end;
  4206. procedure TPasResolver.GetParamsOfNameExpr(El: TPasExpr; out
  4207. ParentParams: TPRParentParams);
  4208. // Checks is El is the name expression of a call or array access
  4209. // For example: a.b.El() a.El[]
  4210. // Note: TPasParser guarantees that there is at most one TBinaryExpr
  4211. // and one TInlineSpecializeExpr between El and TParamsExpr
  4212. var
  4213. Parent: TPasElement;
  4214. Bin: TBinaryExpr;
  4215. Params: TParamsExpr;
  4216. InlineSpec: TInlineSpecializeExpr;
  4217. begin
  4218. ParentParams.InlineSpec:=nil;
  4219. ParentParams.Params:=nil;
  4220. if not IsNameExpr(El) then exit;
  4221. Parent:=El.Parent;
  4222. if Parent=nil then exit;
  4223. if Parent.ClassType=TBinaryExpr then
  4224. begin
  4225. Bin:=TBinaryExpr(Parent);
  4226. if (Bin.OpCode<>eopSubIdent) or (Bin.right<>El) then
  4227. exit;
  4228. El:=Bin;
  4229. Parent:=El.Parent;
  4230. end;
  4231. if Parent.ClassType=TInlineSpecializeExpr then
  4232. begin
  4233. InlineSpec:=TInlineSpecializeExpr(Parent);
  4234. if InlineSpec.NameExpr<>El then exit;
  4235. ParentParams.InlineSpec:=InlineSpec;
  4236. El:=InlineSpec;
  4237. Parent:=El.Parent;
  4238. if Parent=nil then exit;
  4239. end;
  4240. if Parent.ClassType<>TParamsExpr then exit;
  4241. Params:=TParamsExpr(Parent);
  4242. if Params.Value<>El then exit;
  4243. if not (Params.Kind in [pekFuncParams,pekArrayParams]) then exit;
  4244. ParentParams.Params:=Params;
  4245. end;
  4246. function TPasResolver.GetInlineSpecOfNameExpr(El: TPasExpr
  4247. ): TInlineSpecializeExpr;
  4248. var
  4249. Parent: TPasElement;
  4250. begin
  4251. Result:=nil;
  4252. if not IsNameExpr(El) then exit;
  4253. Parent:=El.Parent;
  4254. if Parent=nil then exit;
  4255. if Parent is TBinaryExpr then
  4256. begin
  4257. if (TBinaryExpr(Parent).OpCode<>eopSubIdent)
  4258. or (TBinaryExpr(Parent).right<>El) then
  4259. exit;
  4260. El:=TBinaryExpr(Parent); // continue
  4261. Parent:=El.Parent;
  4262. end;
  4263. if Parent.ClassType<>TInlineSpecializeExpr then exit;
  4264. Result:=TInlineSpecializeExpr(Parent);
  4265. if Result.NameExpr<>El then
  4266. Result:=nil;
  4267. end;
  4268. function TPasResolver.GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  4269. var
  4270. Value: TResEvalValue;
  4271. begin
  4272. if not (InFileExpr is TPrimitiveExpr) then
  4273. RaiseXExpectedButYFound(20180221234828,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4274. Value:=ExprEvaluator.Eval(TPrimitiveExpr(InFileExpr),[refConst]);
  4275. try
  4276. if (Value=nil) then
  4277. RaiseXExpectedButYFound(20180222000004,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4278. case Value.Kind of
  4279. {$ifdef FPC_HAS_CPSTRING}
  4280. revkString:
  4281. Result:=ExprEvaluator.GetUTF8Str(TResEvalString(Value).S,InFileExpr);
  4282. revkUnicodeString:
  4283. Result:=UTF8Encode(TResEvalUTF16(Value).S);
  4284. {$else}
  4285. revkUnicodeString:
  4286. Result:=TResEvalUTF16(Value).S;
  4287. {$endif}
  4288. else
  4289. RaiseXExpectedButYFound(20180222000122,'string literal',Value.AsDebugString,InFileExpr);
  4290. end;
  4291. finally
  4292. ReleaseEvalValue(Value);
  4293. end;
  4294. end;
  4295. function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
  4296. // get leftmost name element (e.g. TPrimitiveExpr)
  4297. // nil if not found
  4298. var
  4299. C: TClass;
  4300. begin
  4301. Result:=nil;
  4302. while El<>nil do
  4303. begin
  4304. C:=El.ClassType;
  4305. if C=TPrimitiveExpr then
  4306. exit(El)
  4307. else if C=TBinaryExpr then
  4308. begin
  4309. if TBinaryExpr(El).OpCode=eopSubIdent then
  4310. El:=TBinaryExpr(El).left
  4311. else
  4312. exit;
  4313. end
  4314. else if C=TParamsExpr then
  4315. El:=TParamsExpr(El).Value
  4316. else
  4317. exit;
  4318. end;
  4319. end;
  4320. function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  4321. // if the expression is a constructor newinstance call,
  4322. // return the element referring the constructor
  4323. // else nil
  4324. var
  4325. C: TClass;
  4326. begin
  4327. Result:=nil;
  4328. while El<>nil do
  4329. begin
  4330. if (El.CustomData is TResolvedReference)
  4331. and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
  4332. exit(El);
  4333. C:=El.ClassType;
  4334. if C=TBinaryExpr then
  4335. begin
  4336. if TBinaryExpr(El).OpCode=eopSubIdent then
  4337. El:=TBinaryExpr(El).right
  4338. else
  4339. exit;
  4340. end
  4341. else if C=TParamsExpr then
  4342. El:=TParamsExpr(El).Value
  4343. else
  4344. exit;
  4345. end;
  4346. end;
  4347. procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
  4348. var
  4349. El: TPasElement;
  4350. RData: TResolveData;
  4351. begin
  4352. // clear CustomData
  4353. while FLastCreatedData[Kind]<>nil do
  4354. begin
  4355. RData:=FLastCreatedData[Kind];
  4356. El:=RData.Element;
  4357. El.CustomData:=nil;
  4358. FLastCreatedData[Kind]:=RData.Next;
  4359. RData.Free;
  4360. end;
  4361. end;
  4362. function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
  4363. begin
  4364. if FBaseTypes[bt]<>nil then
  4365. Result:=FBaseTypes[bt].Name
  4366. else
  4367. Result:=ResBaseTypeNames[bt];
  4368. end;
  4369. function TPasResolver.GetBuiltInProcs(bp: TResolverBuiltInProc
  4370. ): TResElDataBuiltInProc;
  4371. begin
  4372. Result:=FBuiltInProcs[bp];
  4373. end;
  4374. procedure TPasResolver.SetRootElement(const AValue: TPasModule);
  4375. begin
  4376. if FRootElement=AValue then Exit;
  4377. FRootElement:=AValue;
  4378. end;
  4379. procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope,
  4380. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4381. var
  4382. Data: PPRFindData absolute FindFirstElementData;
  4383. ok: Boolean;
  4384. begin
  4385. ok:=true;
  4386. if (El is TPasProcedure)
  4387. and ProcNeedsParams(TPasProcedure(El).ProcType) then
  4388. // found a proc, but it needs parameters -> remember the first and continue
  4389. ok:=false;
  4390. if ok or (Data^.Found=nil) then
  4391. begin
  4392. Data^.Found:=El;
  4393. Data^.ElScope:=ElScope;
  4394. Data^.StartScope:=StartScope;
  4395. end;
  4396. if ok then
  4397. Abort:=true;
  4398. end;
  4399. procedure TPasResolver.OnFindFirst(El: TPasElement; ElScope,
  4400. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4401. var
  4402. Data: PPRFindData absolute FindFirstElementData;
  4403. begin
  4404. Data^.Found:=El;
  4405. Data^.ElScope:=ElScope;
  4406. Data^.StartScope:=StartScope;
  4407. Abort:=true;
  4408. end;
  4409. procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
  4410. StartScope: TPasScope; FindFirstGenericData: Pointer; var Abort: boolean);
  4411. var
  4412. Data: PPRFindGenericData absolute FindFirstGenericData;
  4413. GenericTemplateTypes: TFPList;
  4414. begin
  4415. if El is TPasGenericType then
  4416. GenericTemplateTypes:=TPasGenericType(El).GenericTemplateTypes
  4417. else if El is TPasProcedure then
  4418. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(El))
  4419. else
  4420. exit;
  4421. if GenericTemplateTypes=nil then exit;
  4422. if GenericTemplateTypes.Count<>Data^.TemplateCount then
  4423. exit;
  4424. Data^.Find.Found:=El;
  4425. Data^.Find.ElScope:=ElScope;
  4426. Data^.Find.StartScope:=StartScope;
  4427. Abort:=true;
  4428. end;
  4429. procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
  4430. StartScope: TPasScope; FindCallElData: Pointer; var Abort: boolean);
  4431. var
  4432. Data: PFindCallElData absolute FindCallElData;
  4433. Proc, PrevProc: TPasProcedure;
  4434. Distance: integer;
  4435. BuiltInProc: TResElDataBuiltInProc;
  4436. CandidateFound: Boolean;
  4437. VarType, TypeEl: TPasType;
  4438. C: TClass;
  4439. ProcScope: TPasProcedureScope;
  4440. Templates: TFPList;
  4441. begin
  4442. {$IFDEF VerbosePasResolver}
  4443. writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
  4444. {$ENDIF}
  4445. CandidateFound:=false;
  4446. if (El is TPasProcedure) then
  4447. begin
  4448. // identifier is a proc
  4449. Proc:=TPasProcedure(El);
  4450. PrevProc:=nil;
  4451. if Data^.Found=Proc then
  4452. begin
  4453. // this proc was already found. This happens when this is the forward
  4454. // declaration or a previously found implementation.
  4455. Data^.ElScope:=ElScope;
  4456. Data^.StartScope:=StartScope;
  4457. exit;
  4458. end;
  4459. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4460. if ProcScope.DeclarationProc<>nil then
  4461. begin
  4462. // this proc has a forward declaration -> use that instead
  4463. Proc:=ProcScope.DeclarationProc;
  4464. El:=Proc;
  4465. end;
  4466. if Data^.Found is TPasProcedure then
  4467. begin
  4468. // there is already a previous proc
  4469. PrevProc:=TPasProcedure(Data^.Found);
  4470. if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
  4471. begin
  4472. if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
  4473. begin
  4474. Abort:=true;
  4475. exit;
  4476. end;
  4477. end
  4478. else
  4479. begin
  4480. // mode objfpc
  4481. if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
  4482. // mode objfpc: procs in same context have implicit overload
  4483. else
  4484. begin
  4485. // mode objfpc, different context
  4486. if not ProcHasGroupOverload(Data^.LastProc) then
  4487. begin
  4488. Abort:=true;
  4489. exit;
  4490. end;
  4491. end;
  4492. end;
  4493. if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
  4494. and (PrevProc.Parent.ClassType=TPasClassType) then
  4495. begin
  4496. // there was already a perfect proc in a descendant
  4497. Abort:=true;
  4498. exit;
  4499. end;
  4500. // check if previous found proc is override of found proc
  4501. if IsProcOverride(Proc,PrevProc) then
  4502. begin
  4503. // previous found proc is override of found proc -> skip
  4504. exit;
  4505. end;
  4506. end;
  4507. if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
  4508. Abort:=true; // stop searching after this proc
  4509. CandidateFound:=true;
  4510. if Data^.TemplCnt>0 then
  4511. begin
  4512. // proc must have templates
  4513. Templates:=GetProcTemplateTypes(Proc);
  4514. if (Templates=nil) or (Templates.Count<>Data^.TemplCnt) then
  4515. Distance:=cIncompatible
  4516. else
  4517. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4518. end
  4519. else
  4520. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4521. {$IFDEF VerbosePasResolver}
  4522. writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
  4523. ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',Data^.Distance,
  4524. ' Signature={',GetProcTypeDescription(Proc.ProcType,[prptdUseName,prptdAddPaths]),'}',
  4525. ' Abort=',Abort);
  4526. {$ENDIF}
  4527. Data^.LastProc:=Proc;
  4528. end
  4529. else if El is TPasType then
  4530. begin
  4531. TypeEl:=ResolveAliasType(TPasType(El));
  4532. C:=TypeEl.ClassType;
  4533. if Data^.TemplCnt<>0 then
  4534. begin
  4535. if (not C.InheritsFrom(TPasGenericType))
  4536. or (GetTypeParameterCount(TPasGenericType(TypeEl))<>Data^.TemplCnt)
  4537. then
  4538. exit;
  4539. end;
  4540. if C=TPasUnresolvedSymbolRef then
  4541. begin
  4542. if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
  4543. begin
  4544. // call of built-in proc
  4545. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  4546. if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
  4547. and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
  4548. begin
  4549. // str function can only be used within an expression
  4550. // str procedure can only be used outside an expression
  4551. {$IFDEF VerbosePasResolver}
  4552. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
  4553. {$ENDIF}
  4554. exit;
  4555. end;
  4556. Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
  4557. {$IFDEF VerbosePasResolver}
  4558. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
  4559. {$ENDIF}
  4560. CandidateFound:=true;
  4561. end
  4562. else if TypeEl.CustomData is TResElDataBaseType then
  4563. begin
  4564. // type cast to base type
  4565. Abort:=true; // can't be overloaded
  4566. if Data^.Found<>nil then exit;
  4567. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4568. {$IFDEF VerbosePasResolver}
  4569. writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
  4570. {$ENDIF}
  4571. CandidateFound:=true;
  4572. end;
  4573. end
  4574. else if (C=TPasClassType)
  4575. or (C=TPasClassOfType)
  4576. or (C=TPasPointerType)
  4577. or (C=TPasRecordType)
  4578. or (C=TPasEnumType)
  4579. or (C=TPasProcedureType)
  4580. or (C=TPasFunctionType)
  4581. or (C=TPasArrayType)
  4582. or (C=TPasRangeType)
  4583. or (C=TPasGenericTemplateType) then
  4584. begin
  4585. // type cast to user type
  4586. Abort:=true; // can't be overloaded
  4587. if Data^.Found<>nil then exit;
  4588. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4589. {$IFDEF VerbosePasResolver}
  4590. writeln('TPasResolver.OnFindCallElements type cast to "',GetObjName(El),'" Distance=',Distance);
  4591. {$ENDIF}
  4592. CandidateFound:=true;
  4593. end;
  4594. end
  4595. else if El is TPasVariable then
  4596. begin
  4597. Abort:=true; // can't be overloaded
  4598. if Data^.Found<>nil then exit;
  4599. if Data^.TemplCnt<>0 then exit;
  4600. if El.ClassType=TPasProperty then
  4601. VarType:=GetPasPropertyType(TPasProperty(El))
  4602. else
  4603. VarType:=TPasVariable(El).VarType;
  4604. VarType:=ResolveAliasType(VarType);
  4605. if VarType is TPasProcedureType then
  4606. begin
  4607. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4608. {$IFDEF VerbosePasResolver}
  4609. writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
  4610. {$ENDIF}
  4611. CandidateFound:=true;
  4612. end;
  4613. end
  4614. else if El.ClassType=TPasArgument then
  4615. begin
  4616. Abort:=true; // can't be overloaded
  4617. if Data^.Found<>nil then exit;
  4618. if Data^.TemplCnt<>0 then exit;
  4619. VarType:=ResolveAliasType(TPasArgument(El).ArgType);
  4620. if VarType is TPasProcedureType then
  4621. begin
  4622. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4623. {$IFDEF VerbosePasResolver}
  4624. writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
  4625. {$ENDIF}
  4626. CandidateFound:=true;
  4627. end;
  4628. end;
  4629. if not CandidateFound then
  4630. begin
  4631. // El does not support the () operator
  4632. Abort:=true;
  4633. if Data^.Found=nil then
  4634. begin
  4635. // El is the first element found -> raise error
  4636. // ToDo: use the ( as error position
  4637. RaiseMsg(20170216151525,nIllegalQualifierAfter,sIllegalQualifierAfter,
  4638. ['(',El.ElementTypeName],Data^.Params);
  4639. end;
  4640. exit;
  4641. end;
  4642. // El is a candidate (might be incompatible)
  4643. if (Data^.Found=nil)
  4644. or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
  4645. begin
  4646. {$IFDEF VerbosePasResolver}
  4647. writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
  4648. {$ENDIF}
  4649. Data^.Found:=El;
  4650. Data^.ElScope:=ElScope;
  4651. Data^.StartScope:=StartScope;
  4652. Data^.Distance:=Distance;
  4653. Data^.Count:=1;
  4654. if Data^.List<>nil then
  4655. begin
  4656. Data^.List.Clear;
  4657. Data^.List.Add(El);
  4658. end;
  4659. end
  4660. else if Distance=cIncompatible then
  4661. // another candidate, but it is incompatible -> ignore
  4662. {$IFDEF VerbosePasResolver}
  4663. writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
  4664. {$ENDIF}
  4665. else if (Data^.Distance=Distance)
  4666. or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)
  4667. and ((Distance>=cIntToFloatConversion)=(Data^.Distance>=cIntToFloatConversion))) then
  4668. begin
  4669. // found another similar compatible one -> collect
  4670. // Note: cLossyConversion is better than cIntToFloatConversion, not similar
  4671. {$IFDEF VerbosePasResolver}
  4672. writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
  4673. {$ENDIF}
  4674. inc(Data^.Count);
  4675. if (Data^.List<>nil) then
  4676. begin
  4677. if (Data^.List.IndexOf(El)>=0) then
  4678. begin
  4679. {$IFDEF VerbosePasResolver}
  4680. writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
  4681. ' ',GetElementSourcePosStr(El),
  4682. ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
  4683. ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
  4684. );
  4685. {$ENDIF}
  4686. RaiseInternalError(20160924230805);
  4687. end;
  4688. Data^.List.Add(El);
  4689. end;
  4690. end
  4691. else if (Distance<Data^.Distance) then
  4692. begin
  4693. // found a better one
  4694. {$IFDEF VerbosePasResolver}
  4695. writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4696. {$ENDIF}
  4697. if (Distance<cLossyConversion)
  4698. or ((Distance>=cIntToFloatConversion)<>(Data^.Distance>=cIntToFloatConversion)) then
  4699. begin
  4700. // found a good one
  4701. {$IFDEF VerbosePasResolver}
  4702. writeln('TPasResolver.OnFindCallElements Found a good candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4703. {$ENDIF}
  4704. Data^.Count:=1;
  4705. if Data^.List<>nil then
  4706. Data^.List.Clear;
  4707. end
  4708. else
  4709. begin
  4710. // found another lossy one
  4711. // -> collect them
  4712. {$IFDEF VerbosePasResolver}
  4713. writeln('TPasResolver.OnFindCallElements Found another lossy candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4714. {$ENDIF}
  4715. inc(Data^.Count);
  4716. end;
  4717. Data^.Found:=El;
  4718. Data^.ElScope:=ElScope;
  4719. Data^.StartScope:=StartScope;
  4720. Data^.Distance:=Distance;
  4721. if Data^.List<>nil then
  4722. Data^.List.Add(El);
  4723. end
  4724. else
  4725. begin
  4726. // found a worse one
  4727. end;
  4728. end;
  4729. procedure TPasResolver.OnFindProc(El: TPasElement; ElScope,
  4730. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  4731. var
  4732. Data: PFindProcData absolute FindProcData;
  4733. Proc: TPasProcedure;
  4734. Store, SameScope: Boolean;
  4735. ProcScope: TPasProcedureScope;
  4736. procedure CountProcInSameScope;
  4737. begin
  4738. inc(Data^.FoundInSameScope);
  4739. if Proc.IsOverload then
  4740. Data^.FoundOverloadModifier:=true;
  4741. end;
  4742. begin
  4743. //writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  4744. if not (El is TPasProcedure) then
  4745. begin
  4746. // identifier is not a proc
  4747. if (El is TPasVariable) then
  4748. begin
  4749. if TPasVariable(El).Visibility=visStrictPrivate then
  4750. exit; // not visible
  4751. if (TPasVariable(El).Visibility=visPrivate)
  4752. and (El.GetModule<>StartScope.Element.GetModule) then
  4753. exit; // not visible
  4754. end;
  4755. Data^.FoundNonProc:=El;
  4756. Abort:=true;
  4757. if (El.CustomData is TResElDataBuiltInProc) then
  4758. begin
  4759. if Data^.FoundOverloadModifier or Data^.Proc.IsOverload then
  4760. exit; // no hint
  4761. end;
  4762. case Data^.Kind of
  4763. fpkProc:
  4764. // proc hides a non proc
  4765. if (Data^.Proc.GetModule=El.GetModule) then
  4766. // forbidden within same module
  4767. RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
  4768. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
  4769. else
  4770. begin
  4771. // give a hint
  4772. if Data^.Proc.Parent is TPasMembersType then
  4773. begin
  4774. if El.Visibility=visStrictPrivate then
  4775. else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
  4776. else
  4777. LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
  4778. [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4779. end;
  4780. end;
  4781. fpkMethod:
  4782. // method hides a non proc
  4783. RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
  4784. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4785. end;
  4786. exit;
  4787. end;
  4788. // identifier is a proc
  4789. Proc:=TPasProcedure(El);
  4790. if El=Data^.Proc then
  4791. begin
  4792. // found itself -> this is normal when searching for overloads
  4793. CountProcInSameScope;
  4794. exit;
  4795. end;
  4796. {$IFDEF VerbosePasResolver}
  4797. writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
  4798. {$ENDIF}
  4799. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  4800. case Data^.Kind of
  4801. fpkProc:
  4802. SameScope:=Data^.Proc.GetModule=Proc.GetModule;
  4803. fpkMethod:
  4804. SameScope:=Data^.Proc.Parent=Proc.Parent;
  4805. else
  4806. // use OnFindProcDeclaration instead
  4807. RaiseNotYetImplemented(20191010123525,Data^.Proc);
  4808. end;
  4809. if SameScope then
  4810. begin
  4811. // same scope
  4812. if (msObjfpc in CurrentParser.CurrentModeswitches) then
  4813. begin
  4814. if ProcHasGroupOverload(Data^.Proc) then
  4815. Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
  4816. else if ProcHasGroupOverload(Proc) then
  4817. Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
  4818. end;
  4819. if Store then
  4820. begin
  4821. // same scope, same signature
  4822. // Note: forward declaration was already handled in FinishProcedureHeader
  4823. RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
  4824. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4825. end
  4826. else
  4827. begin
  4828. // same scope, different signature
  4829. if (msDelphi in CurrentParser.CurrentModeswitches) then
  4830. begin
  4831. // Delphi does not allow different procs without 'overload' in a scope
  4832. if not Proc.IsOverload then
  4833. RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
  4834. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  4835. else if not Data^.Proc.IsOverload then
  4836. RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
  4837. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4838. end
  4839. else
  4840. begin
  4841. // ObjFPC allows different procs without 'overload' modifier
  4842. end;
  4843. CountProcInSameScope;
  4844. end;
  4845. end
  4846. else
  4847. begin
  4848. // different scopes
  4849. if Data^.Proc.IsOverride then
  4850. else if Data^.Proc.IsReintroduced then
  4851. else
  4852. begin
  4853. if Store
  4854. or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
  4855. and not ProcHasGroupOverload(Data^.Proc)) then
  4856. begin
  4857. if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
  4858. // give a hint, that method hides a virtual method in ancestor
  4859. LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
  4860. sMethodHidesMethodOfBaseType,
  4861. [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  4862. else
  4863. begin
  4864. // Delphi/FPC do not give a message when hiding a non virtual method
  4865. // -> emit Hint with other message id
  4866. if (Data^.Proc.Parent is TPasMembersType) then
  4867. begin
  4868. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4869. if (Proc.Visibility=visStrictPrivate)
  4870. or ((Proc.Visibility=visPrivate)
  4871. and (Proc.GetModule<>Data^.Proc.GetModule)) then
  4872. // a private private is hidden by definition -> no hint
  4873. else if (ProcScope.ImplProc<>nil) // not abstract, external
  4874. and (not ProcHasImplElements(ProcScope.ImplProc)) then
  4875. // hidden method has implementation, but no statements -> useless
  4876. // -> do not give a hint for hiding this useless method
  4877. // Note: if this happens in the same unit, the body was not yet parsed
  4878. else if (Proc is TPasConstructor)
  4879. and (Data^.Proc.ClassType=Proc.ClassType) then
  4880. // do not give a hint for hiding a constructor
  4881. else if Store then
  4882. begin
  4883. // method hides ancestor method with same signature
  4884. LogMsg(20190316152656,mtHint,
  4885. nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
  4886. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4887. end
  4888. else
  4889. begin
  4890. //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
  4891. LogMsg(20171118214523,mtHint,
  4892. nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
  4893. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4894. end;
  4895. end;
  4896. end;
  4897. Abort:=true;
  4898. end;
  4899. end;
  4900. end;
  4901. if Store then
  4902. begin
  4903. Data^.Found:=Proc;
  4904. Data^.ElScope:=ElScope;
  4905. Data^.StartScope:=StartScope;
  4906. Abort:=true;
  4907. end;
  4908. end;
  4909. procedure TPasResolver.OnFindProcDeclaration(El: TPasElement; ElScope,
  4910. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  4911. var
  4912. Data: PFindProcData absolute FindProcData;
  4913. Proc: TPasProcedure;
  4914. Store: Boolean;
  4915. begin
  4916. //writeln('TPasResolver.OnFindProcDeclaration START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  4917. if not (El is TPasProcedure) then
  4918. begin
  4919. // identifier is not a proc
  4920. Data^.FoundNonProc:=El;
  4921. Abort:=true;
  4922. exit;
  4923. end;
  4924. if El=Data^.Proc then
  4925. // found itself -> this is normal when searching for overloads
  4926. exit;
  4927. // identifier is a proc
  4928. Proc:=TPasProcedure(El);
  4929. {$IFDEF VerbosePasResolver}
  4930. writeln('TPasResolver.OnFindProcDeclaration ',GetTreeDbg(El,2));
  4931. {$ENDIF}
  4932. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  4933. if Store then
  4934. begin
  4935. Data^.Found:=Proc;
  4936. Data^.ElScope:=ElScope;
  4937. Data^.StartScope:=StartScope;
  4938. Abort:=true;
  4939. end;
  4940. end;
  4941. function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
  4942. ): boolean;
  4943. begin
  4944. if ProcParentA=ProcParentB then exit(true);
  4945. if (ProcParentA.ClassType=TInterfaceSection) then
  4946. begin
  4947. if (ProcParentB.ClassType=TImplementationSection)
  4948. and (ProcParentB.Parent=ProcParentA.Parent) then
  4949. exit(true);
  4950. end
  4951. else if (ProcParentB.ClassType=TInterfaceSection) then
  4952. begin
  4953. if (ProcParentA.ClassType=TImplementationSection)
  4954. and (ProcParentA.Parent=ProcParentB.Parent) then
  4955. exit(true);
  4956. end;
  4957. Result:=false;
  4958. end;
  4959. function TPasResolver.FindProcSameSignature(const ProcName: string;
  4960. Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
  4961. ): TPasProcedure;
  4962. var
  4963. FindData: TFindProcData;
  4964. Abort: boolean;
  4965. begin
  4966. FindData:=Default(TFindProcData);
  4967. FindData.Proc:=Proc;
  4968. FindData.Args:=Proc.ProcType.Args;
  4969. FindData.Kind:=fpkProcDeclaration;
  4970. Abort:=false;
  4971. //writeln('TPasResolver.FindProcSameSignature ',ProcName,' OnlyLocal=',OnlyLocal);
  4972. if OnlyLocal then
  4973. Scope.IterateLocalElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort)
  4974. else
  4975. Scope.IterateElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort);
  4976. Result:=FindData.Found;
  4977. end;
  4978. procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
  4979. var
  4980. Scanner: TPascalScanner;
  4981. begin
  4982. //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
  4983. if AValue=CurrentParser then exit;
  4984. Clear;
  4985. inherited SetCurrentParser(AValue);
  4986. if CurrentParser<>nil then
  4987. begin
  4988. CurrentParser.Options:=CurrentParser.Options+po_Resolver;
  4989. if CurrentParser.Scanner<>nil then
  4990. begin
  4991. Scanner:=CurrentParser.Scanner;
  4992. if (Scanner.OnWarnDirective=nil) then
  4993. Scanner.OnWarnDirective:=@ScannerWarnDirective;
  4994. Scanner.SetNonToken(tkself);
  4995. end;
  4996. end;
  4997. end;
  4998. procedure TPasResolver.ScannerWarnDirective(Sender: TObject;
  4999. Identifier: string; State: TWarnMsgState; var Handled: boolean);
  5000. var
  5001. MsgNumbers: TIntegerDynArray;
  5002. i: Integer;
  5003. begin
  5004. if not GetWarnIdentifierNumbers(Identifier,MsgNumbers) then exit;
  5005. Handled:=true;
  5006. for i:=0 to length(MsgNumbers)-1 do
  5007. TPascalScanner(Sender).WarnMsgState[MsgNumbers[i]]:=State;
  5008. end;
  5009. procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
  5010. AllowDescendants: boolean);
  5011. var
  5012. Scope: TPasScope;
  5013. begin
  5014. Scope:=TopScope;
  5015. if Scope=nil then
  5016. RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
  5017. if Scope.ClassType<>ExpectedClass then
  5018. if (not AllowDescendants) or (not Scope.InheritsFrom(ExpectedClass)) then
  5019. RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+Scope.ClassName);
  5020. end;
  5021. function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
  5022. const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
  5023. ): TPasIdentifier;
  5024. function SkipGenericTypes(Identifier: TPasIdentifier;
  5025. TypeParamCnt: integer): TPasIdentifier;
  5026. var
  5027. CurEl: TPasElement;
  5028. begin
  5029. while Identifier<>nil do
  5030. begin
  5031. CurEl:=Identifier.Element;
  5032. if not (CurEl is TPasGenericType) then break;
  5033. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then break;
  5034. Identifier:=Identifier.NextSameIdentifier;
  5035. end;
  5036. Result:=Identifier;
  5037. end;
  5038. var
  5039. Group: TPasGroupScope;
  5040. Identifier, OlderIdentifier: TPasIdentifier;
  5041. OlderEl: TPasElement;
  5042. C: TClass;
  5043. i, TypeParamCnt: Integer;
  5044. OtherScope: TPasIdentifierScope;
  5045. ParentScope: TPasScope;
  5046. IsGeneric: Boolean;
  5047. begin
  5048. if aName='' then exit(nil);
  5049. if Scope is TPasGroupScope then
  5050. begin
  5051. Group:=TPasGroupScope(Scope);
  5052. Scope:=Group.Scopes[0];
  5053. end
  5054. else
  5055. Group:=nil;
  5056. if El is TPasGenericType then
  5057. begin
  5058. IsGeneric:=true;
  5059. TypeParamCnt:=GetTypeParameterCount(TPasGenericType(El));
  5060. end
  5061. else
  5062. begin
  5063. IsGeneric:=false;
  5064. TypeParamCnt:=0;
  5065. end;
  5066. if (El.Visibility=visPublished) then
  5067. begin
  5068. C:=El.ClassType;
  5069. if (C=TPasProperty) or (C=TPasVariable) then
  5070. // Note: VarModifiers are not yet set
  5071. else if (C=TPasProcedure) or (C=TPasFunction) then
  5072. // ok
  5073. else
  5074. RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  5075. end;
  5076. if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty) then
  5077. begin
  5078. // check duplicate in ancestors and helpers
  5079. for i:=1 to Group.Count-1 do
  5080. begin
  5081. OtherScope:=Group.Scopes[i];
  5082. OlderIdentifier:=OtherScope.FindLocalIdentifier(aName);
  5083. if IsGeneric then
  5084. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5085. while OlderIdentifier<>nil do
  5086. begin
  5087. OlderEl:=OlderIdentifier.Element;
  5088. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  5089. if OlderEl is TPasVariable then
  5090. begin
  5091. if TPasVariable(OlderEl).Visibility=visStrictPrivate then
  5092. continue; // OlderEl is hidden
  5093. if (TPasVariable(OlderEl).Visibility=visPrivate)
  5094. and (OlderEl.GetModule<>El.GetModule) then
  5095. continue; // OlderEl is hidden
  5096. end;
  5097. RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
  5098. [aName,GetElementSourcePosStr(OlderEl)],El);
  5099. end;
  5100. end;
  5101. end;
  5102. Identifier:=Scope.AddIdentifier(aName,El,Kind);
  5103. // check duplicate in current scope
  5104. OlderIdentifier:=Identifier.NextSameIdentifier;
  5105. if IsGeneric then
  5106. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5107. if OlderIdentifier<>nil then
  5108. begin
  5109. OlderEl:=OlderIdentifier.Element;
  5110. if (OlderEl.ClassType=TPasEnumValue)
  5111. and (OlderEl.Parent.Parent<>Scope.Element) then
  5112. begin
  5113. // this enum was propagated from a sub type -> remove enum from this scope
  5114. if OlderIdentifier.NextSameIdentifier<>nil then
  5115. RaiseNotYetImplemented(20190807114726,El,GetElementSourcePosStr(OlderEl));
  5116. Scope.RemoveLocalIdentifier(OlderEl);
  5117. OlderIdentifier:=nil;
  5118. OlderEl:=nil;
  5119. end
  5120. else if (El.Visibility=visPublished) and (El is TPasProcedure)
  5121. and (OlderEl is TPasProcedure) then
  5122. // published method bites method in same scope
  5123. RaiseMsg(20190626175432,nDuplicatePublishedMethodXAtY,
  5124. sDuplicatePublishedMethodXAtY,
  5125. [aName,GetElementSourcePosStr(OlderEl)],El)
  5126. else if (Identifier.Kind=pikSimple)
  5127. or (OlderIdentifier.Kind=pikSimple) then
  5128. // duplicate identifier
  5129. RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
  5130. [aName,GetElementSourcePosStr(OlderEl)],El);
  5131. end;
  5132. if (Scope=TopScope) and (Scope is TPasSectionScope) then
  5133. begin
  5134. ParentScope:=Scopes[ScopeCount-2];
  5135. if ParentScope is TPasSectionScope then
  5136. begin
  5137. OlderIdentifier:=TPasSectionScope(ParentScope).FindLocalIdentifier(aName);
  5138. if IsGeneric then
  5139. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5140. if OlderIdentifier<>nil then
  5141. begin
  5142. OlderEl:=OlderIdentifier.Element;
  5143. if (Identifier.Kind=pikSimple)
  5144. or (OlderIdentifier.Kind=pikSimple) then
  5145. RaiseMsg(20190818141630,nDuplicateIdentifier,sDuplicateIdentifier,
  5146. [aName,GetElementSourcePosStr(OlderEl)],El);
  5147. end;
  5148. end;
  5149. end;
  5150. Result:=Identifier;
  5151. end;
  5152. procedure TPasResolver.FinishModule(CurModule: TPasModule);
  5153. var
  5154. CurModuleClass: TClass;
  5155. i: Integer;
  5156. ModScope: TPasModuleScope;
  5157. begin
  5158. {$IFDEF VerbosePasResolver}
  5159. writeln('TPasResolver.FinishModule START ',CurModule.Name);
  5160. {$ENDIF}
  5161. FStep:=prsFinishingModule;
  5162. CurModuleClass:=CurModule.ClassType;
  5163. ModScope:=CurModule.CustomData as TPasModuleScope;
  5164. if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
  5165. begin
  5166. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  5167. FindRangeErrorConstructors(CurModule);
  5168. end;
  5169. if (CurModuleClass=TPasProgram) then
  5170. begin
  5171. FinishSection(TPasProgram(CurModule).ProgramSection);
  5172. // resolve begin..end block
  5173. ResolveImplBlock(CurModule.InitializationSection);
  5174. end
  5175. else if (CurModuleClass=TPasLibrary) then
  5176. begin
  5177. FinishSection(TPasLibrary(CurModule).LibrarySection);
  5178. // resolve begin..end block
  5179. ResolveImplBlock(CurModule.InitializationSection);
  5180. end
  5181. else if (CurModuleClass=TPasModule) then
  5182. begin
  5183. // unit
  5184. FinishSection(CurModule.InterfaceSection);
  5185. FinishSection(CurModule.ImplementationSection);
  5186. if CurModule.FinalizationSection<>nil then
  5187. // finalization section finished -> resolve
  5188. ResolveImplBlock(CurModule.FinalizationSection);
  5189. if CurModule.InitializationSection<>nil then
  5190. // initialization section finished -> resolve
  5191. ResolveImplBlock(CurModule.InitializationSection);
  5192. end
  5193. else
  5194. RaiseInternalError(20160922163327); // unknown module
  5195. // check all methods have bodies
  5196. // and all forward classes and pointers are resolved
  5197. for i:=0 to FPendingForwardProcs.Count-1 do
  5198. CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
  5199. FPendingForwardProcs.Clear;
  5200. // close all sections
  5201. while (TopScope<>nil) and (TopScope.ClassType=ScopeClass_Section) do
  5202. PopScope;
  5203. CheckTopScope(FScopeClass_Module);
  5204. PopScope;
  5205. FStep:=prsFinishedModule;
  5206. if (CurrentParser<>nil) and (CurrentParser.Scanner<>nil) then
  5207. begin
  5208. CurrentParser.NextToken;
  5209. if CurrentParser.Scanner.CurToken<>tkEOF then
  5210. LogMsg(20180628131456,mtHint,nTextAfterFinalIgnored,sTextAfterFinalIgnored,
  5211. [],nil);
  5212. end;
  5213. {$IFDEF VerbosePasResolver}
  5214. writeln('TPasResolver.FinishModule END ',CurModule.Name);
  5215. {$ENDIF}
  5216. end;
  5217. procedure TPasResolver.FinishUsesClause;
  5218. var
  5219. Section, CurSection: TPasSection;
  5220. i, j: Integer;
  5221. PublicEl, UseModule: TPasElement;
  5222. Scope: TPasSectionScope;
  5223. UsesScope: TPasSectionScope;
  5224. UseUnit: TPasUsesUnit;
  5225. FirstName: String;
  5226. p: SizeInt;
  5227. OldIdentifier: TPasIdentifier;
  5228. IntfHelpers: TPRHelperEntryArray;
  5229. begin
  5230. CheckTopScope(ScopeClass_Section);
  5231. Scope:=TPasSectionScope(TopScope);
  5232. Section:=TPasSection(Scope.Element);
  5233. {$IFDEF VerbosePasResolver}
  5234. writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
  5235. {$ENDIF}
  5236. if Scope.UsesFinished then
  5237. RaiseInternalError(20180305145220);
  5238. Scope.UsesFinished:=true;
  5239. for i:=0 to Section.UsesList.Count-1 do
  5240. begin
  5241. UseUnit:=Section.UsesClause[i];
  5242. {$IFDEF VerbosePasResolver}
  5243. writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
  5244. {$ENDIF}
  5245. UseModule:=UseUnit.Module;
  5246. // check used unit
  5247. PublicEl:=nil;
  5248. if (UseModule.ClassType=TPasLibrary) then
  5249. PublicEl:=TPasLibrary(UseModule).LibrarySection
  5250. else if (UseModule.ClassType=TPasModule) then
  5251. PublicEl:=TPasModule(UseModule).InterfaceSection
  5252. else
  5253. RaiseXExpectedButYFound(20170503004803,'unit',GetElementTypeName(UseModule),UseUnit);
  5254. if PublicEl=nil then
  5255. RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
  5256. if PublicEl.CustomData=nil then
  5257. RaiseInternalError(20160922163358,'uses element has no resolver data: '
  5258. +UseUnit.Name+'->'+GetObjName(PublicEl));
  5259. if not (PublicEl.CustomData is TPasSectionScope) then
  5260. RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
  5261. +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
  5262. UsesScope:=TPasSectionScope(PublicEl.CustomData);
  5263. // check if module was already used by a different name
  5264. j:=i;
  5265. CurSection:=Section;
  5266. repeat
  5267. dec(j);
  5268. if j<0 then
  5269. begin
  5270. if CurSection.ClassType<>TImplementationSection then
  5271. break;
  5272. CurSection:=CurSection.GetModule.InterfaceSection;
  5273. if CurSection=nil then break;
  5274. j:=length(CurSection.UsesClause)-1;
  5275. if j<0 then break;
  5276. end;
  5277. if CurSection.UsesClause[j].Module=UseModule then
  5278. RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
  5279. [UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
  5280. until false;
  5281. // add full uses name
  5282. AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
  5283. // add scope
  5284. {$IFDEF VerbosePasResolver}
  5285. writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
  5286. {$ENDIF}
  5287. Scope.UsesScopes.Add(UsesScope);
  5288. // add helpers
  5289. IntfHelpers:=UsesScope.Helpers;
  5290. for j:=0 to length(IntfHelpers)-1 do
  5291. AddActiveHelper(TPRHelperEntry(IntfHelpers[j]).Helper);
  5292. EmitElementHints(Section,UseUnit);
  5293. end;
  5294. // Add first name of dotted unitname (top level subnamespace) as identifier
  5295. for i:=Section.UsesList.Count-1 downto 0 do
  5296. begin
  5297. UseUnit:=Section.UsesClause[i];
  5298. FirstName:=UseUnit.Name;
  5299. p:=Pos('.',FirstName);
  5300. if p<1 then continue;
  5301. FirstName:=LeftStr(FirstName,p-1);
  5302. OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
  5303. if (OldIdentifier=nil) then
  5304. AddIdentifier(Scope,FirstName,UseUnit,pikNamespace);
  5305. end;
  5306. // Note: a sub identifier (e.g. a class member) hides all unitnames starting
  5307. // with this identifier
  5308. end;
  5309. procedure TPasResolver.FinishSection(Section: TPasSection);
  5310. // Note: can be called multiple times for a section
  5311. var
  5312. Scope: TPasSectionScope;
  5313. begin
  5314. Scope:=Section.CustomData as TPasSectionScope;
  5315. if Scope.Finished then exit;
  5316. Scope.Finished:=true;
  5317. if Section is TInterfaceSection then
  5318. FinishInterfaceSection(Section);
  5319. end;
  5320. procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
  5321. begin
  5322. {$IFDEF VerboseUnitQueue}
  5323. writeln('TPasResolver.FinishInterfaceSection ',GetObjName(RootElement));
  5324. {$ENDIF}
  5325. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  5326. if not IsUnitIntfFinished(Section.GetModule) then
  5327. RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+RootElement.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
  5328. {$ENDIF}
  5329. NotifyPendingUsedInterfaces;
  5330. if Section=nil then ;
  5331. end;
  5332. procedure TPasResolver.FinishTypeSection(El: TPasElement);
  5333. procedure FinishDeclarations(El: TPasDeclarations);
  5334. var
  5335. i: Integer;
  5336. Decl: TPasElement;
  5337. begin
  5338. for i:=0 to El.Declarations.Count-1 do
  5339. begin
  5340. Decl:=TPasElement(El.Declarations[i]);
  5341. if Decl is TPasType then
  5342. FinishTypeSectionEl(TPasType(Decl));
  5343. end;
  5344. end;
  5345. procedure FinishMembersType(El: TPasMembersType);
  5346. var
  5347. i: Integer;
  5348. Decl: TPasElement;
  5349. begin
  5350. for i:=0 to El.Members.Count-1 do
  5351. begin
  5352. Decl:=TPasElement(El.Members[i]);
  5353. if Decl is TPasType then
  5354. FinishTypeSectionEl(TPasType(Decl));
  5355. end;
  5356. end;
  5357. begin
  5358. // resolve pending forwards
  5359. if El is TPasDeclarations then
  5360. FinishDeclarations(TPasDeclarations(El))
  5361. else if El is TPasMembersType then
  5362. FinishMembersType(TPasMembersType(El))
  5363. else
  5364. RaiseNotYetImplemented(20181226105933,El);
  5365. end;
  5366. procedure TPasResolver.FinishTypeSectionEl(El: TPasType);
  5367. function ReplaceDestType(Decl: TPasType; var DestType: TPasType;
  5368. const DestName: string; MustExist: boolean; ErrorEl: TPasElement
  5369. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF}): boolean;
  5370. // returns true if replaces
  5371. var
  5372. Abort: boolean;
  5373. Data: TPRFindData;
  5374. OldDestType: TPasType;
  5375. begin
  5376. Abort:=false;
  5377. Data:=Default(TPRFindData);
  5378. Data.ErrorPosEl:=ErrorEl;
  5379. (TopScope as TPasIdentifierScope).IterateElements(DestName,
  5380. TopScope,@OnFindFirst,@Data,Abort);
  5381. //writeln('ReplaceDestType ',GetObjName(El),' DestType=',GetObjName(DestType),' DestType.Parent=',GetObjName(DestType.Parent),' RefCount=',DestType.RefCount);
  5382. if Data.Found=nil then
  5383. if MustExist then
  5384. begin
  5385. RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl);
  5386. end
  5387. else
  5388. exit(false);
  5389. if Data.Found=DestType then exit;
  5390. if Decl is TPasClassOfType then
  5391. begin
  5392. if (Data.Found.ClassType<>TPasClassType)
  5393. or (TPasClassType(Data.Found).ObjKind<>okClass) then
  5394. RaiseXExpectedButYFound(20170216151548,'class',GetElementTypeName(Data.Found),ErrorEl);
  5395. end;
  5396. // replace unresolved
  5397. OldDestType:=DestType;
  5398. DestType:=TPasType(Data.Found);
  5399. DestType.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5400. OldDestType.Release{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5401. CheckUseAsType(DestType,20190123100649,El);
  5402. // check cycles
  5403. if Decl is TPasPointerType then
  5404. CheckPointerCycle(TPasPointerType(Decl));
  5405. Result:=true;
  5406. end;
  5407. var
  5408. C: TClass;
  5409. ClassOfEl: TPasClassOfType;
  5410. TypeEl: TPasType;
  5411. UnresolvedEl: TUnresolvedPendingRef;
  5412. OldClassType: TPasClassType;
  5413. PtrType: TPasPointerType;
  5414. begin
  5415. C:=El.ClassType;
  5416. if C=TPasClassType then
  5417. begin
  5418. if TPasClassType(El).IsForward
  5419. and not (TPasClassType(El).CustomData is TResolvedReference) then
  5420. RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[El.Name],El);
  5421. end
  5422. else if (C=TPasClassOfType) then
  5423. begin
  5424. ClassOfEl:=TPasClassOfType(El);
  5425. TypeEl:=ResolveAliasType(ClassOfEl.DestType);
  5426. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5427. begin
  5428. // forward class-of -> resolve now
  5429. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5430. {$IFDEF VerbosePasResolver}
  5431. writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',TypeEl.Name,'"');
  5432. {$ENDIF}
  5433. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,TypeEl.Name,true,UnresolvedEl
  5434. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5435. end
  5436. else if TypeEl.ClassType=TPasClassType then
  5437. begin
  5438. // class-of has found a type
  5439. // another later in the same type section has priority -> check
  5440. OldClassType:=TypeEl as TPasClassType;
  5441. if OldClassType.Parent=ClassOfEl.Parent then
  5442. exit; // class in same type section -> ok
  5443. // class not in same type section -> check
  5444. {$IFDEF VerbosePasResolver}
  5445. writeln('TPasResolver.FinishTypeSection improving "',ClassOfEl.Name,'" = class of resolved "',TypeEl.Name,'"');
  5446. {$ENDIF}
  5447. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,ClassOfEl.DestType.Name,false,ClassOfEl
  5448. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5449. end;
  5450. end
  5451. else if C=TPasPointerType then
  5452. begin
  5453. PtrType:=TPasPointerType(El);
  5454. TypeEl:=ResolveAliasType(PtrType.DestType);
  5455. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5456. begin
  5457. // forward pointer -> resolve now
  5458. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5459. {$IFDEF VerbosePasResolver}
  5460. writeln('TPasResolver.FinishTypeSection resolving "',PtrType.Name,'" = pointer of unresolved "',TypeEl.Name,'"');
  5461. {$ENDIF}
  5462. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,true,UnresolvedEl
  5463. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5464. end
  5465. else
  5466. begin
  5467. // pointer-of has found a type
  5468. // another later in the same type section has priority -> check
  5469. if TypeEl.Parent=PtrType.Parent then
  5470. exit; // class in same type section -> ok
  5471. // dest not in same type section -> check
  5472. {$IFDEF VerbosePasResolver}
  5473. writeln('TPasResolver.FinishTypeSection improving "',PtrType.Name,'" = pointer of resolved "',TypeEl.Name,'"');
  5474. {$ENDIF}
  5475. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,false,PtrType
  5476. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5477. end;
  5478. end;
  5479. end;
  5480. procedure TPasResolver.FinishTypeDef(El: TPasType);
  5481. var
  5482. C: TClass;
  5483. begin
  5484. {$IFDEF VerbosePasResolver}
  5485. //writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
  5486. {$ENDIF}
  5487. C:=El.ClassType;
  5488. if C=TPasEnumType then
  5489. FinishEnumType(TPasEnumType(El))
  5490. else if C=TPasSetType then
  5491. FinishSetType(TPasSetType(El))
  5492. else if C=TPasRangeType then
  5493. FinishRangeType(TPasRangeType(El))
  5494. else if C=TPasRecordType then
  5495. FinishRecordType(TPasRecordType(El))
  5496. else if C=TPasClassType then
  5497. FinishClassType(TPasClassType(El))
  5498. else if C=TPasClassOfType then
  5499. FinishClassOfType(TPasClassOfType(El))
  5500. else if C=TPasPointerType then
  5501. FinishPointerType(TPasPointerType(El))
  5502. else if C=TPasArrayType then
  5503. FinishArrayType(TPasArrayType(El))
  5504. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  5505. FinishAliasType(TPasAliasType(El))
  5506. else if (C=TPasPointerType) then
  5507. EmitTypeHints(El,TPasPointerType(El).DestType)
  5508. else if C=TPasGenericTemplateType then
  5509. FinishGenericTemplateType(TPasGenericTemplateType(El))
  5510. else if C=TPasSpecializeType then
  5511. FinishSpecializeType(TPasSpecializeType(El));
  5512. end;
  5513. procedure TPasResolver.FinishEnumType(El: TPasEnumType);
  5514. begin
  5515. if TopScope.Element=El then
  5516. PopScope;
  5517. end;
  5518. procedure TPasResolver.FinishSetType(El: TPasSetType);
  5519. function GetEnumTypePosEl: TPasElement;
  5520. begin
  5521. Result:=El.EnumType;
  5522. if Result.Parent<>El then
  5523. Result:=El;
  5524. end;
  5525. var
  5526. BaseTypeData: TResElDataBaseType;
  5527. StartResolved, EndResolved: TPasResolverResult;
  5528. RangeExpr: TBinaryExpr;
  5529. C: TClass;
  5530. EnumType: TPasType;
  5531. begin
  5532. EnumType:=ResolveAliasType(El.EnumType);
  5533. C:=EnumType.ClassType;
  5534. if C=TPasEnumType then
  5535. begin
  5536. FinishSubElementType(El,EnumType);
  5537. exit;
  5538. end
  5539. else if C=TPasRangeType then
  5540. begin
  5541. RangeExpr:=TPasRangeType(EnumType).RangeExpr;
  5542. if (RangeExpr.Parent=El) and (RangeExpr.CustomData=nil) then
  5543. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5544. FinishSubElementType(El,EnumType);
  5545. exit;
  5546. end
  5547. else if C=TPasUnresolvedSymbolRef then
  5548. begin
  5549. if EnumType.CustomData is TResElDataBaseType then
  5550. begin
  5551. BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
  5552. if BaseTypeData.BaseType in (btAllChars+[btBoolean,btByte]) then
  5553. exit;
  5554. RaiseXExpectedButYFound(20170216151553,'char or boolean',
  5555. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5556. end;
  5557. end;
  5558. RaiseXExpectedButYFound(20170216151557,'enum type',
  5559. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5560. end;
  5561. procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
  5562. var
  5563. Decl: TPasDeclarations;
  5564. EnumScope: TPasEnumTypeScope;
  5565. begin
  5566. EmitTypeHints(Parent,El);
  5567. if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
  5568. if Parent.Name='' then
  5569. RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5570. if not (Parent.Parent is TPasDeclarations) then
  5571. RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5572. if El.Parent<>Parent then
  5573. RaiseNotYetImplemented(20190215085011,Parent);
  5574. // give anonymous sub type a name
  5575. El.Name:=Parent.Name+AnonymousElTypePostfix;
  5576. {$IFDEF VerbosePasResolver}
  5577. writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
  5578. {$ENDIF}
  5579. Decl:=TPasDeclarations(Parent.Parent);
  5580. Decl.Declarations.Add(El);
  5581. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
  5582. El.Parent:=Decl;
  5583. Decl.Types.Add(El);
  5584. if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
  5585. begin
  5586. // anonymous enumtype
  5587. EnumScope:=TPasEnumTypeScope(El.CustomData);
  5588. if EnumScope.CanonicalSet<>Parent then
  5589. begin
  5590. // When a TPasEnumType is created a CanonicalSet is created.
  5591. // Release the autocreated CanonicalSet and use the parent.
  5592. if EnumScope.CanonicalSet<>nil then
  5593. EnumScope.CanonicalSet.Release{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5594. EnumScope.CanonicalSet:=TPasSetType(Parent);
  5595. Parent.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5596. end;
  5597. end;
  5598. end;
  5599. procedure TPasResolver.FinishRangeType(El: TPasRangeType);
  5600. var
  5601. RangeExpr: TBinaryExpr;
  5602. StartResolved, EndResolved: TPasResolverResult;
  5603. begin
  5604. RangeExpr:=El.RangeExpr;
  5605. ResolveExpr(RangeExpr.left,rraRead);
  5606. ResolveExpr(RangeExpr.right,rraRead);
  5607. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5608. end;
  5609. procedure TPasResolver.FinishConstRangeExpr(RangeExpr: TBinaryExpr; out
  5610. LeftResolved, RightResolved: TPasResolverResult);
  5611. // for example Left..Right
  5612. var
  5613. RgValue: TResEvalValue;
  5614. Left, Right: TPasExpr;
  5615. begin
  5616. Left:=RangeExpr.left;
  5617. Right:=RangeExpr.right;
  5618. {$IFDEF VerbosePasResEval}
  5619. writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
  5620. {$ENDIF}
  5621. // check type compatibility
  5622. ComputeElement(Left,LeftResolved,[rcConstant]);
  5623. ComputeElement(Right,RightResolved,[rcConstant]);
  5624. CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
  5625. RgValue:=Eval(RangeExpr,[refConst]);
  5626. ReleaseEvalValue(RgValue);
  5627. end;
  5628. procedure TPasResolver.FinishRecordType(El: TPasRecordType);
  5629. var
  5630. Scope: TPasRecordScope;
  5631. begin
  5632. if TopScope.Element<>El then
  5633. RaiseNotYetImplemented(20190801232042,El);
  5634. Scope:=El.CustomData as TPasRecordScope;
  5635. Scope.GenericStep:=psgsInterfaceParsed;
  5636. PopScope;
  5637. end;
  5638. procedure TPasResolver.FinishClassType(El: TPasClassType);
  5639. type
  5640. TMethResolution = record
  5641. InterfaceIndex: integer;
  5642. ProcClassType: TPasProcedureClass;
  5643. InterfaceName: string;
  5644. ImplementName: string;
  5645. ResolutionEl: TPasMethodResolution;
  5646. Count: integer; // needed to check if method resolution is used
  5647. end;
  5648. var
  5649. ClassScope: TPasClassScope;
  5650. i, j, k: Integer;
  5651. IntfType: TPasClassType;
  5652. Resolutions: array of TMethResolution;
  5653. Map: TPasClassIntfMap;
  5654. o: TObject;
  5655. Member, Parent: TPasElement;
  5656. IntfProc: TPasProcedure;
  5657. FindData: TFindProcData;
  5658. Abort: boolean;
  5659. MethRes: TPasMethodResolution;
  5660. ResolvedEl: TPasResolverResult;
  5661. ProcName, IntfProcName: String;
  5662. Expr: TPasExpr;
  5663. SectionScope: TPasSectionScope;
  5664. SpecializedItems: TObjectList;
  5665. SpecializedItem: TPRSpecializedTypeItem;
  5666. OldScopeState: TScopeStashState;
  5667. begin
  5668. Resolutions:=nil;
  5669. ClassScope:=nil;
  5670. if not El.IsForward then
  5671. begin
  5672. if TopScope.Element<>El then
  5673. RaiseInternalError(20180322142534,GetObjName(El)+'<>'+GetObjName(TopScope.Element));
  5674. ClassScope:=El.CustomData as TPasClassScope;
  5675. if ClassScope=nil then
  5676. RaiseNotYetImplemented(20190803204709,El);
  5677. if El.ObjKind=okClass then
  5678. begin
  5679. if (El.Interfaces.Count>0) then
  5680. begin
  5681. if (ClassScope.Interfaces=nil) then
  5682. RaiseInternalError(20180408162725,'');
  5683. if (ClassScope.Interfaces.Count<>El.Interfaces.Count) then
  5684. RaiseInternalError(20180408162746,'');
  5685. end
  5686. else if ClassScope.Interfaces<>nil then
  5687. RaiseInternalError(20180408162803,'');
  5688. // check explicit method resolutions, e.g. procedure intf.intfproc = implproc
  5689. for i:=0 to El.Members.Count-1 do
  5690. begin
  5691. Member:=TPasElement(El.Members[i]);
  5692. if not (Member is TPasMethodResolution) then continue;
  5693. MethRes:=TPasMethodResolution(Member);
  5694. // get interface
  5695. ComputeElement(MethRes.InterfaceName,ResolvedEl,[rcNoImplicitProc]);
  5696. if not (ResolvedEl.IdentEl is TPasType) then
  5697. RaiseInternalError(20180323135729,GetResolverResultDbg(ResolvedEl));
  5698. j:=El.Interfaces.IndexOf(ResolvedEl.IdentEl);
  5699. if j<0 then
  5700. RaiseInternalError(20180323135900,GetResolverResultDbg(ResolvedEl));
  5701. // get class-interface-map, check delegations
  5702. o:=TObject(ClassScope.Interfaces[j]);
  5703. if o is TPasProperty then
  5704. RaiseMsg(20180323140046,nCannotMixMethodResolutionAndDelegationAtX,
  5705. sCannotMixMethodResolutionAndDelegationAtX,
  5706. [GetElementSourcePosStr(TPasProperty(o))],MethRes.InterfaceName);
  5707. if o=nil then
  5708. o:=CreateClassIntfMap(El,j);
  5709. Map:=TPasClassIntfMap(o);
  5710. // get interface proc name
  5711. Expr:=MethRes.InterfaceProc;
  5712. if not (Expr is TPrimitiveExpr) then
  5713. RaiseXExpectedButYFound(20180327162230,'method name',GetElementTypeName(Expr),Expr);
  5714. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5715. RaiseXExpectedButYFound(20180327162236,'method name',GetElementTypeName(Expr),Expr);
  5716. IntfProcName:=TPrimitiveExpr(Expr).Value;
  5717. // get implementation proc name
  5718. Expr:=MethRes.ImplementationProc;
  5719. if not (Expr is TPrimitiveExpr) then
  5720. RaiseXExpectedButYFound(20180327152115,'method name',GetElementTypeName(Expr),Expr);
  5721. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5722. RaiseXExpectedButYFound(20180327152157,'method name',GetElementTypeName(Expr),Expr);
  5723. ProcName:=TPrimitiveExpr(Expr).Value;
  5724. for k:=0 to length(Resolutions)-1 do
  5725. with Resolutions[k] do
  5726. if (InterfaceIndex=j) and (ProcClassType=MethRes.ProcClass)
  5727. and (InterfaceName=IntfProcName) then
  5728. RaiseMsg(20180327164626,nDuplicateIdentifier,sDuplicateIdentifier,
  5729. [GetElementTypeName(ProcClassType)+' '+Map.Intf.Name+'.'+InterfaceName,
  5730. GetElementSourcePosStr(ResolutionEl)],MethRes.InterfaceProc);
  5731. // add resolution
  5732. k:=length(Resolutions);
  5733. SetLength(Resolutions,k+1);
  5734. with Resolutions[k] do
  5735. begin
  5736. InterfaceIndex:=j;
  5737. ProcClassType:=MethRes.ProcClass;
  5738. InterfaceName:=IntfProcName;
  5739. ImplementName:=ProcName;
  5740. ResolutionEl:=MethRes;
  5741. Count:=0;
  5742. end;
  5743. end;
  5744. // method resolution
  5745. for i:=0 to El.Interfaces.Count-1 do
  5746. begin
  5747. o:=TObject(ClassScope.Interfaces[i]);
  5748. //writeln('TPasResolver.FinishClassType class=',GetObjName(El),' i=',i,' Intf=',GetObjName(TObject(El.Interfaces[i])),' Map=',GetObjName(o));
  5749. if o is TPasProperty then
  5750. continue; // interface implemented via a property
  5751. if o=nil then
  5752. o:=CreateClassIntfMap(El,i);
  5753. Map:=TPasClassIntfMap(o);
  5754. while Map<>nil do
  5755. begin
  5756. IntfType:=Map.Intf;
  5757. //writeln('TPasResolver.FinishClassType ',GetObjName(Map),' ',GetObjName(IntfType),' Count=',IntfType.Members.Count);
  5758. for j:=0 to IntfType.Members.Count-1 do
  5759. begin
  5760. Member:=TPasElement(IntfType.Members[j]);
  5761. if not (Member is TPasProcedure) then continue;
  5762. IntfProc:=TPasProcedure(Member);
  5763. ProcName:=IntfProc.Name;
  5764. // check resolutions
  5765. for k:=0 to length(Resolutions)-1 do
  5766. with Resolutions[k] do
  5767. begin
  5768. if (InterfaceIndex=i) and (ProcClassType=IntfProc.ClassType)
  5769. and SameText(InterfaceName,IntfProc.Name) then
  5770. begin
  5771. ProcName:=ImplementName;
  5772. inc(Count);
  5773. end;
  5774. end;
  5775. // search interface method in class
  5776. FindData:=Default(TFindProcData);
  5777. FindData.Proc:=IntfProc;
  5778. FindData.Args:=IntfProc.ProcType.Args;
  5779. FindData.Kind:=fpkProcDeclaration;
  5780. Abort:=false;
  5781. IterateElements(ProcName,@OnFindProcDeclaration,@FindData,Abort);
  5782. if FindData.Found=nil then
  5783. RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
  5784. sNoMatchingImplForIntfMethodXFound,
  5785. [GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
  5786. Map.Procs[j]:=FindData.Found;
  5787. end;
  5788. Map:=Map.AncestorMap;
  5789. end;
  5790. end;
  5791. // ToDo: hint if method resolution is not used
  5792. end;
  5793. if El.ObjKind in okAllHelpers then
  5794. begin
  5795. // activate helper
  5796. AddActiveHelper(El);
  5797. // cache helpers in interface, so other modules don't have to search
  5798. Parent:=El.Parent;
  5799. while Parent<>nil do
  5800. begin
  5801. if Parent.ClassType=TInterfaceSection then
  5802. begin
  5803. SectionScope:=Parent.CustomData as TPasSectionScope;
  5804. AddHelper(El,SectionScope.Helpers);
  5805. break;
  5806. end;
  5807. Parent:=Parent.Parent;
  5808. end;
  5809. end;
  5810. end;
  5811. if TopScope.Element=El then
  5812. PopScope // pop TPasClassScope
  5813. else
  5814. ; // e.g. class forward
  5815. if TopScope is TPasGenericParamsScope then
  5816. PopGenericParamScope(El);
  5817. if not El.IsForward then
  5818. begin
  5819. ClassScope.GenericStep:=psgsInterfaceParsed;
  5820. SpecializedItems:=ClassScope.SpecializedItems;
  5821. if SpecializedItems<>nil then
  5822. // finish interfaces of started specializations
  5823. for i:=0 to SpecializedItems.Count-1 do
  5824. begin
  5825. SpecializedItem:=TPRSpecializedTypeItem(SpecializedItems[i]);
  5826. SpecializedItem.GenericEl:=El;
  5827. if SpecializedItem.Step<>prssNone then continue;
  5828. InitSpecializeScopes(El,OldScopeState);
  5829. {$IFDEF VerbosePasResolver}
  5830. WriteScopesShort('TPasResolver.FinishClassType Finishing specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  5831. {$ENDIF}
  5832. SpecializeGenericIntf(SpecializedItem);
  5833. {$IFDEF VerbosePasResolver}
  5834. WriteScopesShort('TPasResolver.FinishClassType Finished specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  5835. {$ENDIF}
  5836. RestoreSpecializeScopes(OldScopeState);
  5837. {$IFDEF VerbosePasResolver}
  5838. WriteScopesShort('TPasResolver.FinishClassType RestoreStashedScopes '+GetObjName(SpecializedItem.SpecializedType));
  5839. {$ENDIF}
  5840. end;
  5841. end;
  5842. end;
  5843. procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
  5844. var
  5845. TypeEl: TPasType;
  5846. begin
  5847. TypeEl:=ResolveAliasType(El.DestType);
  5848. if TypeEl is TUnresolvedPendingRef then
  5849. begin
  5850. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5851. exit;
  5852. end;
  5853. if (TypeEl is TPasClassType) and (TPasClassType(TypeEl).ObjKind=okClass) then exit;
  5854. RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5855. [El.DestType.Name,'class'],El);
  5856. end;
  5857. procedure TPasResolver.FinishPointerType(El: TPasPointerType);
  5858. var
  5859. TypeEl: TPasType;
  5860. begin
  5861. TypeEl:=ResolveAliasType(El.DestType);
  5862. if TypeEl is TUnresolvedPendingRef then
  5863. begin
  5864. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5865. exit;
  5866. end;
  5867. if El.DestType.Parent=El then
  5868. RaiseMsg(20180429094237,nNotYetImplemented,sNotYetImplemented,['pointer of anonymous type'], El.DestType);
  5869. CheckUseAsType(El.DestType,20190123095118,El);
  5870. CheckPointerCycle(El);
  5871. end;
  5872. procedure TPasResolver.FinishArrayType(El: TPasArrayType);
  5873. var
  5874. i: Integer;
  5875. Expr: TPasExpr;
  5876. RangeResolved: TPasResolverResult;
  5877. TypeEl: TPasType;
  5878. Parent: TPasArrayType;
  5879. Scope: TPasArrayScope;
  5880. begin
  5881. // check cycles
  5882. Parent:=El;
  5883. repeat
  5884. if Parent=El.ElType then
  5885. RaiseMsg(20190807104630,nIllegalExpression,sIllegalExpression,[],El);
  5886. if Parent.Parent is TPasArrayType then
  5887. Parent:=TPasArrayType(Parent.Parent)
  5888. else
  5889. break;
  5890. until false;
  5891. for i:=0 to length(El.Ranges)-1 do
  5892. begin
  5893. Expr:=El.Ranges[i];
  5894. ResolveExpr(Expr,rraRead);
  5895. ComputeElement(Expr,RangeResolved,[rcConstant]);
  5896. if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
  5897. begin
  5898. {$IFDEF VerbosePasResolver}
  5899. writeln('TPasResolver.FinishArrayType ',GetResolverResultDbg(RangeResolved));
  5900. {$ENDIF}
  5901. RaiseXExpectedButYFound(20170216151607,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5902. end;
  5903. if (RangeResolved.BaseType=btRange) then
  5904. begin
  5905. if (RangeResolved.SubType in btArrayRangeTypes) then
  5906. // range, e.g. 1..2
  5907. else if RangeResolved.SubType=btContext then
  5908. begin
  5909. TypeEl:=RangeResolved.LoTypeEl;
  5910. if TypeEl is TPasRangeType then
  5911. // custom range
  5912. else if TypeEl is TPasEnumType then
  5913. // anonymous enum range
  5914. else
  5915. RaiseXExpectedButYFound(20171009193629,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5916. end
  5917. else
  5918. RaiseXExpectedButYFound(20171009193514,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5919. end
  5920. else if RangeResolved.BaseType in btArrayRangeTypes then
  5921. // full range, e.g. array[char]
  5922. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasEnumType) then
  5923. // e.g. array[enumtype]
  5924. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasGenericTemplateType) then
  5925. // e.g. Tarr<T> = array[T] of ...
  5926. else if RangeResolved.IdentEl<>nil then
  5927. RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr)
  5928. else
  5929. RaiseXExpectedButYFound(20190830215123,'range',GetResolverResultDescription(RangeResolved),Expr);
  5930. end;
  5931. if El.ElType=nil then
  5932. begin
  5933. // array of const
  5934. if length(El.Ranges)>0 then
  5935. RaiseNotYetImplemented(20190215102529,El);
  5936. FindTVarRec(El);
  5937. end
  5938. else
  5939. begin
  5940. CheckUseAsType(El.ElType,20190123095401,El);
  5941. FinishSubElementType(El,El.ElType);
  5942. end;
  5943. if El.CustomData is TPasArrayScope then
  5944. begin
  5945. Scope:=TPasArrayScope(El.CustomData);
  5946. Scope.GenericStep:=psgsImplementationParsed;
  5947. end;
  5948. if TopScope.Element=El then
  5949. PopScope;
  5950. end;
  5951. procedure TPasResolver.FinishAliasType(El: TPasAliasType);
  5952. var
  5953. aType: TPasType;
  5954. begin
  5955. aType:=ResolveAliasType(El);
  5956. if (aType is TPasMembersType) and (aType.CustomData=nil) then
  5957. exit;
  5958. if (aType is TPasGenericType)
  5959. and (GetTypeParameterCount(TPasGenericType(aType))>0) then
  5960. RaiseMsg(20190818135830,nXExpectedButYFound,sXExpectedButYFound,
  5961. ['type',GetTypeDescription(aType)],El);
  5962. EmitTypeHints(El,TPasAliasType(El).DestType);
  5963. end;
  5964. procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
  5965. var
  5966. ConEl: TPasElement;
  5967. procedure RaiseCannotBeTogether(const Id: TMaxPrecInt; const X,Y: string);
  5968. begin
  5969. RaiseMsg(Id,nConstraintXAndConstraintYCannotBeTogether,
  5970. sConstraintXAndConstraintYCannotBeTogether,[X,Y],
  5971. GetGenericConstraintErrorEl(ConEl,El));
  5972. end;
  5973. procedure RaiseXIsNotAValidConstraint(const Id: TMaxPrecInt; const X: string);
  5974. begin
  5975. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[X],
  5976. GetGenericConstraintErrorEl(ConEl,El));
  5977. end;
  5978. var
  5979. i: Integer;
  5980. IsClass, IsRecord, IsConstructor: Boolean;
  5981. LastType: TPasType;
  5982. MemberType: TPasMembersType;
  5983. aClass: TPasClassType;
  5984. ConToken: TToken;
  5985. ResolvedEl: TPasResolverResult;
  5986. begin
  5987. {$IFDEF VerbosePasResolver}
  5988. writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
  5989. {$ENDIF}
  5990. IsClass:=false;
  5991. IsRecord:=false;
  5992. IsConstructor:=false;
  5993. LastType:=nil;
  5994. for i:=0 to length(El.Constraints)-1 do
  5995. begin
  5996. ConEl:=El.Constraints[i];
  5997. ConToken:=GetGenericConstraintKeyword(ConEl);
  5998. case ConToken of
  5999. tkclass:
  6000. begin
  6001. if IsClass then
  6002. RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
  6003. sConstraintXSpecifiedMoreThanOnce,['class'],ConEl);
  6004. if IsRecord then
  6005. RaiseCannotBeTogether(20190720202516,'record','class');
  6006. if LastType<>nil then
  6007. RaiseCannotBeTogether(20190720205708,LastType.Name,'class');
  6008. IsClass:=true;
  6009. end;
  6010. tkrecord:
  6011. begin
  6012. if IsRecord then
  6013. RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
  6014. sConstraintXSpecifiedMoreThanOnce,['record'],ConEl);
  6015. if IsClass then
  6016. RaiseCannotBeTogether(20190720203039,'class','record');
  6017. if IsConstructor then
  6018. RaiseCannotBeTogether(20190720203056,'constructor','record');
  6019. if LastType<>nil then
  6020. RaiseCannotBeTogether(20190720205938,LastType.Name,'record');
  6021. IsRecord:=true;
  6022. end;
  6023. tkconstructor:
  6024. begin
  6025. if IsConstructor then
  6026. RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
  6027. sConstraintXSpecifiedMoreThanOnce,['constructor'],ConEl);
  6028. if IsRecord then
  6029. RaiseCannotBeTogether(20190720203148,'record','constructor');
  6030. if LastType<>nil then
  6031. RaiseCannotBeTogether(20190720210005,LastType.Name,'constructor');
  6032. IsConstructor:=true;
  6033. end;
  6034. else
  6035. if not (ConEl is TPasType) then
  6036. RaiseXIsNotAValidConstraint(20190912215619,GetElementTypeName(ConEl));
  6037. // type identifier: class, record or interface
  6038. ComputeElement(ConEl,ResolvedEl,[rcType]);
  6039. if ResolvedEl.BaseType<>btContext then
  6040. RaiseXIsNotAValidConstraint(20190914105144,GetElementTypeName(ConEl));
  6041. if IsRecord then
  6042. RaiseCannotBeTogether(20190720210130,'record',ResolvedEl.HiTypeEl.Name);
  6043. if IsClass then
  6044. RaiseCannotBeTogether(20190720210202,'class',ResolvedEl.HiTypeEl.Name);
  6045. if IsConstructor then
  6046. RaiseCannotBeTogether(20190720210244,'constructor',ResolvedEl.HiTypeEl.Name);
  6047. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  6048. begin
  6049. // ok
  6050. if length(El.Constraints)>1 then
  6051. RaiseXIsNotAValidConstraint(20190831213645,ResolvedEl.HiTypeEl.Name);
  6052. end
  6053. else if ResolvedEl.LoTypeEl is TPasMembersType then
  6054. begin
  6055. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  6056. if MemberType is TPasClassType then
  6057. begin
  6058. aClass:=TPasClassType(MemberType);
  6059. case aClass.ObjKind of
  6060. okClass:
  6061. begin
  6062. // there can be at most one classtype constraint
  6063. if LastType<>nil then
  6064. RaiseCannotBeTogether(20190720210351,LastType.Name,MemberType.Name);
  6065. end;
  6066. okInterface:
  6067. begin
  6068. // there can be multiple interfacetype constraint
  6069. if not (LastType is TPasClassType) then
  6070. RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name);
  6071. if TPasClassType(LastType).ObjKind<>okInterface then
  6072. RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
  6073. end
  6074. else
  6075. RaiseXIsNotAValidConstraint(20190720210919,MemberType.Name);
  6076. end;
  6077. end
  6078. else
  6079. RaiseXIsNotAValidConstraint(20190720210809,MemberType.Name);
  6080. end
  6081. else
  6082. RaiseXIsNotAValidConstraint(20190720204604,GetResolverResultDescription(ResolvedEl,true));
  6083. LastType:=ResolvedEl.LoTypeEl;
  6084. end; // end of case
  6085. end; // end of for
  6086. end;
  6087. procedure TPasResolver.FinishSpecializeType(El: TPasSpecializeType);
  6088. var
  6089. Params, GenericTemplateList: TFPList;
  6090. P: TPasElement;
  6091. DestType: TPasType;
  6092. i, ScopeDepth: Integer;
  6093. GenType: TPasGenericType;
  6094. begin
  6095. {$IFDEF VerbosePasResolver}
  6096. //writeln('TPasResolver.FinishSpecializeType ');
  6097. {$ENDIF}
  6098. // resolve Params
  6099. ScopeDepth:=StashSubExprScopes;
  6100. Params:=El.Params;
  6101. if Params.Count=0 then
  6102. RaiseMsg(20190724114416,nMissingParameterX,sMissingParameterX,['type'],El);
  6103. for i:=0 to Params.Count-1 do
  6104. begin
  6105. P:=TPasElement(Params[i]);
  6106. if P is TPasExpr then
  6107. ResolveExpr(TPasExpr(P),rraRead)
  6108. else if P is TPasType then
  6109. else
  6110. RaiseMsg(20190728113336,nXExpectedButYFound,sXExpectedButYFound,['type identifier',GetObjName(P)+' parameter '+IntToStr(i+1)],El);
  6111. end;
  6112. RestoreStashedScopes(ScopeDepth);
  6113. // check DestType
  6114. DestType:=El.DestType;
  6115. if DestType=nil then
  6116. RaiseMsg(20190725184734,nIdentifierNotFound,sIdentifierNotFound,['specialize type'],El)
  6117. else if not (DestType is TPasGenericType) then
  6118. RaiseMsg(20190725193552,nXExpectedButYFound,sXExpectedButYFound,['generic type',DestType.Name],El);
  6119. GenType:=TPasGenericType(DestType);
  6120. // Note: there can be TBird, TBird<T> and TBird<T,U>
  6121. GenericTemplateList:=GenType.GenericTemplateTypes;
  6122. if GenericTemplateList=nil then
  6123. RaiseMsg(20190725194222,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6124. ['type '+DestType.Name],El);
  6125. if GenericTemplateList.Count<>Params.Count then
  6126. RaiseMsg(20190801222656,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6127. ['type '+DestType.Name],El);
  6128. GetSpecializedEl(El,GenType,Params);
  6129. end;
  6130. procedure TPasResolver.FinishResourcestring(El: TPasResString);
  6131. var
  6132. ResolvedEl: TPasResolverResult;
  6133. begin
  6134. ResolveExpr(El.Expr,rraRead);
  6135. ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
  6136. if not (ResolvedEl.BaseType in btAllStringAndChars) then
  6137. RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
  6138. end;
  6139. procedure TPasResolver.FinishProcedure(Proc: TPasProcedure);
  6140. var
  6141. i: Integer;
  6142. Body: TProcedureBody;
  6143. SubEl: TPasElement;
  6144. SubProcScope, ProcScope, DeclProcScope: TPasProcedureScope;
  6145. SpecializedItem: TPRSpecializedItem;
  6146. begin
  6147. {$IFDEF VerbosePasResolver}
  6148. writeln('TPasResolver.FinishProcedure START');
  6149. {$ENDIF}
  6150. CheckTopScope(FScopeClass_Proc);
  6151. ProcScope:=TPasProcedureScope(TopScope);
  6152. if ProcScope.Element<>Proc then
  6153. RaiseInternalError(20170220163043);
  6154. SpecializedItem:=ProcScope.SpecializedFromItem;
  6155. if SpecializedItem<>nil then
  6156. begin
  6157. if SpecializedItem.Step<prssImplementationBuilding then
  6158. RaiseNotYetImplemented(20190920184908,Proc);
  6159. if SpecializedItem.Step>prssImplementationBuilding then
  6160. RaiseNotYetImplemented(20190920185123,Proc);
  6161. end;
  6162. Body:=Proc.Body;
  6163. if Body<>nil then
  6164. begin
  6165. StoreScannerFlagsInProc(ProcScope);
  6166. if Body.Body is TPasImplAsmStatement then
  6167. Proc.Modifiers:=Proc.Modifiers+[pmAssembler];
  6168. ResolveImplBlock(Body.Body);
  6169. // check if all nested forward procs are resolved
  6170. for i:=0 to Body.Declarations.Count-1 do
  6171. begin
  6172. SubEl:=TPasElement(Body.Declarations[i]);
  6173. if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
  6174. begin
  6175. SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
  6176. if SubProcScope.ImplProc=nil then
  6177. RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
  6178. [GetElementTypeName(SubEl),SubEl.Name],SubEl);
  6179. end;
  6180. end;
  6181. if ProcScope.GroupScope<>nil then
  6182. begin
  6183. ProcScope.GroupScope.Free;
  6184. ProcScope.GroupScope:=nil;
  6185. end;
  6186. ProcScope.GenericStep:=psgsImplementationParsed;
  6187. if ProcScope.DeclarationProc<>nil then
  6188. begin
  6189. DeclProcScope:=ProcScope.DeclarationProc.CustomData as TPasProcedureScope;
  6190. DeclProcScope.GenericStep:=psgsImplementationParsed;
  6191. end;
  6192. end
  6193. else if ProcScope.GroupScope<>nil then
  6194. RaiseInternalError(20190122142142,GetObjName(Proc));
  6195. if TopScope.Element<>Proc then
  6196. RaiseInternalError(20190806094032);
  6197. PopScope;
  6198. if ProcScope.GenericStep=psgsImplementationParsed then
  6199. begin
  6200. if ProcScope.DeclarationProc<>nil then
  6201. ProcScope:=TPasProcedureScope(ProcScope.DeclarationProc.CustomData);
  6202. if ProcScope.SpecializedItems<>nil then
  6203. FinishSpecializations(ProcScope);
  6204. end;
  6205. end;
  6206. procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
  6207. var
  6208. ProcName: String;
  6209. FindData: TFindProcData;
  6210. DeclProc, Proc, ParentProc: TPasProcedure;
  6211. Abort, HasDots, IsClassConDestructor: boolean;
  6212. DeclProcScope, ProcScope: TPasProcedureScope;
  6213. ParentScope: TPasIdentifierScope;
  6214. pm: TProcedureModifier;
  6215. ptm: TProcTypeModifier;
  6216. ObjKind: TPasObjKind;
  6217. ParentBody: TProcedureBody;
  6218. HelperForType: TPasType;
  6219. Args, TemplTypes: TFPList;
  6220. Arg: TPasArgument;
  6221. ProcTypeScope: TPasProcTypeScope;
  6222. begin
  6223. if TopScope.Element=El then
  6224. begin
  6225. ProcTypeScope:=El.CustomData as TPasProcTypeScope;
  6226. ProcTypeScope.GenericStep:=psgsImplementationParsed;
  6227. PopScope;
  6228. end;
  6229. if El.Parent is TPasProcedure then
  6230. Proc:=TPasProcedure(El.Parent)
  6231. else
  6232. Proc:=nil;
  6233. if (Proc<>nil) and (Proc.ProcType=El) then
  6234. begin
  6235. // finished header of a procedure declaration
  6236. CheckTopScope(FScopeClass_Proc);
  6237. {$IFDEF VerbosePasResolver}
  6238. writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
  6239. {$ENDIF}
  6240. ProcName:=Proc.Name;
  6241. ProcScope:=Proc.CustomData as TPasProcedureScope;
  6242. TemplTypes:=GetProcTemplateTypes(Proc);
  6243. if (TemplTypes<>nil) then
  6244. begin
  6245. // Proc is parametrized
  6246. if (Proc is TPasConstructor) or (Proc is TPasDestructor) then
  6247. RaiseMsg(20190911104114,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6248. [Proc.ElementTypeName],Proc);
  6249. if Proc.IsVirtual or Proc.IsDynamic or Proc.IsMessage or Proc.IsOverride then
  6250. RaiseMsg(20190911112925,nXMethodsCannotHaveTypeParams,
  6251. sXMethodsCannotHaveTypeParams,['virtual, dynamic or message'],El);
  6252. end;
  6253. if El is TPasFunctionType then
  6254. CheckUseAsType(TPasFunctionType(El).ResultEl.ResultType,20190123095743,TPasFunctionType(El).ResultEl);
  6255. if (proProcTypeWithoutIsNested in Options) and El.IsNested then
  6256. RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
  6257. ParentBody:=GetParentProcBody(Proc.Parent);
  6258. if (ParentBody<>nil) then
  6259. begin
  6260. // nested sub proc
  6261. if TemplTypes<>nil then
  6262. RaiseMsg(20190912173450,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6263. ['nested '+Proc.ElementTypeName],Proc);
  6264. if not (proProcTypeWithoutIsNested in Options) then
  6265. El.IsNested:=true;
  6266. // inherit 'of Object'
  6267. ParentProc:=ParentBody.Parent as TPasProcedure;
  6268. if ParentProc.ProcType.IsOfObject then
  6269. El.IsOfObject:=true;
  6270. end;
  6271. if El.IsReferenceTo then
  6272. begin
  6273. if El.IsNested then
  6274. RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
  6275. if El.IsOfObject then
  6276. RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
  6277. end;
  6278. if Proc.IsExternal then
  6279. begin
  6280. for pm in Proc.Modifiers do
  6281. if not (pm in [pmVirtual, pmDynamic, pmOverride,
  6282. pmOverload, pmMessage, pmReintroduce,
  6283. pmExternal, pmDispId,
  6284. pmfar]) then
  6285. RaiseMsg(20170216151616,nInvalidXModifierY,
  6286. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ModifierNames[pm]],Proc);
  6287. for ptm in Proc.ProcType.Modifiers do
  6288. if not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo]) then
  6289. RaiseMsg(20170411171224,nInvalidXModifierY,
  6290. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ProcTypeModifiers[ptm]],Proc);
  6291. end;
  6292. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6293. or (Proc.ClassType=TPasClassDestructor);
  6294. if IsClassConDestructor then
  6295. begin
  6296. // class constructor/destructor
  6297. if Proc.IsVirtual then
  6298. RaiseMsg(20181231150237,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual'],Proc);
  6299. if Proc.IsOverride then
  6300. RaiseMsg(20181231150305,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'override'],Proc);
  6301. if Proc.IsDynamic then
  6302. RaiseMsg(20181231150319,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'dynamic'],Proc);
  6303. if Proc.IsStatic then
  6304. RaiseMsg(20190216214651,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6305. if El.Args.Count>0 then
  6306. RaiseMsg(20181231150404,nXCannotHaveParameters,sXCannotHaveParameters,[GetElementTypeName(Proc)],Proc);
  6307. end;
  6308. HasDots:=Pos('.',ProcName)>1;
  6309. if Proc.Parent is TPasClassType then
  6310. begin
  6311. // method declaration
  6312. ObjKind:=TPasClassType(Proc.Parent).ObjKind;
  6313. case ObjKind of
  6314. okInterface,okDispInterface:
  6315. begin
  6316. if Proc.IsVirtual then
  6317. RaiseMsg(20180321234324,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6318. if Proc.IsOverride then
  6319. RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6320. if TemplTypes<>nil then
  6321. RaiseMsg(20190912153024,nXMethodsCannotHaveTypeParams,sXMethodsCannotHaveTypeParams,['interface'],Proc);
  6322. end;
  6323. okClassHelper,okRecordHelper,okTypeHelper:
  6324. begin
  6325. if Proc.IsAbstract then
  6326. RaiseMsg(20190116215744,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'abstract'],Proc);
  6327. {if msDelphi in CurrentParser.CurrentModeswitches then
  6328. begin
  6329. // Delphi allows virtual/override in class helpers
  6330. // But using them crashes in Delphi 10.3
  6331. // -> do not support them
  6332. end
  6333. }
  6334. if Proc.IsVirtual then
  6335. RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6336. if Proc.IsOverride then
  6337. RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6338. HelperForType:=ResolveAliasType(TPasClassType(Proc.Parent).HelperForType);
  6339. if (not Proc.IsStatic) and IsClassMethod(Proc) and not IsClassConDestructor then
  6340. begin
  6341. // non static class methods require a class
  6342. if (not (HelperForType.ClassType=TPasClassType))
  6343. or (TPasClassType(HelperForType).ObjKind<>okClass) then
  6344. RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
  6345. end;
  6346. if Proc.ClassType=TPasDestructor then
  6347. RaiseMsg(20190302151019,nXIsNotSupported,sXIsNotSupported,['destructor'],Proc);
  6348. if (Proc.ClassType=TPasConstructor)
  6349. and (HelperForType.ClassType=TPasClassType)
  6350. and (TPasClassType(HelperForType).ObjKind<>okClass) then
  6351. RaiseMsg(20190302151514,nXIsNotSupported,sXIsNotSupported,['constructor'],Proc);
  6352. end;
  6353. end;
  6354. if Proc.IsAbstract then
  6355. begin
  6356. if not Proc.IsVirtual then
  6357. RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract without virtual'],Proc);
  6358. if Proc.IsOverride then
  6359. RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract, override'],Proc);
  6360. end;
  6361. if Proc.IsVirtual and Proc.IsOverride then
  6362. RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual, override'],Proc);
  6363. if Proc.IsReintroduced and Proc.IsOverride then
  6364. RaiseMsg(20171119111845,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'reintroduce, override'],Proc);
  6365. if Proc.IsForward then
  6366. RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'forward'],Proc);
  6367. if Proc.IsStatic then
  6368. if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
  6369. RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6370. end
  6371. else if Proc.Parent is TPasRecordType then
  6372. begin
  6373. if (Proc.ClassType=TPasConstructor)
  6374. and ((El.Args.Count=0)
  6375. or (TPasArgument(El.Args[0]).ValueExpr<>nil)) then
  6376. RaiseMsg(20181226231333,nParameterlessConstructorsNotAllowedInRecords,
  6377. sParameterlessConstructorsNotAllowedInRecords,[],El);
  6378. if Proc.IsReintroduced then
  6379. RaiseMsg(20181218195735,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'reintroduce'],Proc);
  6380. if Proc.IsVirtual then
  6381. RaiseMsg(20181218195431,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'virtual'],Proc);
  6382. if Proc.IsOverride then
  6383. RaiseMsg(20181218195437,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'override'],Proc);
  6384. if Proc.IsAbstract then
  6385. RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
  6386. if Proc.IsForward then
  6387. RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
  6388. if IsClassMethod(Proc) and not IsClassConDestructor then
  6389. begin
  6390. // Note: class constructor/destructor must not be static
  6391. if not Proc.IsStatic then
  6392. RaiseMsg(20190106121503,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,['records'],Proc);
  6393. end
  6394. else if Proc.IsStatic then
  6395. RaiseMsg(20190206150922,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6396. end
  6397. else
  6398. begin
  6399. // intf proc, forward proc, proc body, method body, anonymous proc
  6400. if Proc.IsAbstract then
  6401. RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
  6402. if Proc.IsVirtual then
  6403. RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
  6404. if Proc.IsOverride then
  6405. RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
  6406. if Proc.IsMessage then
  6407. RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
  6408. if Proc.IsStatic then
  6409. RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
  6410. if (not HasDots)
  6411. and (Proc.GetProcTypeEnum in [
  6412. ptClassOperator,
  6413. ptConstructor, ptDestructor,
  6414. ptClassProcedure, ptClassFunction,
  6415. ptClassConstructor, ptClassDestructor
  6416. ]) then
  6417. RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
  6418. end;
  6419. ProcScope.GenericStep:=psgsInterfaceParsed;
  6420. if HasDots then
  6421. begin
  6422. FinishMethodImplHeader(Proc);
  6423. exit;
  6424. end;
  6425. // finish interface/implementation/nested procedure/method declaration
  6426. if (ProcName='')
  6427. and not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction]) then
  6428. RaiseNotYetImplemented(20160922163407,El);
  6429. if (El is TPasFunctionType) and not (ppsfIsSpecialized in ProcScope.Flags) then
  6430. EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
  6431. if Proc.PublicName<>nil then
  6432. ResolveExpr(Proc.PublicName,rraRead);
  6433. if Proc.LibraryExpr<>nil then
  6434. ResolveExpr(Proc.LibraryExpr,rraRead);
  6435. if Proc.LibrarySymbolName<>nil then
  6436. ResolveExpr(Proc.LibrarySymbolName,rraRead);
  6437. if Proc.DispIDExpr<>nil then
  6438. ResolveExpr(Proc.DispIDExpr,rraRead);
  6439. if Proc.MessageExpr<>nil then
  6440. begin
  6441. // message modifier
  6442. ResolveExpr(Proc.MessageExpr,rraRead);
  6443. Args:=Proc.ProcType.Args;
  6444. if Args.Count<>1 then
  6445. RaiseMsg(20190303223701,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6446. Arg:=TPasArgument(Args[0]);
  6447. if not (Arg.Access in [argVar,argOut]) then
  6448. RaiseMsg(20190303223834,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6449. if (Proc.ClassType<>TPasProcedure)
  6450. and (Proc.ClassType<>TPasFunction) then
  6451. RaiseMsg(20190303224128,nXExpectedButYFound,sXExpectedButYFound,['procedure name(var Msg);message id;',GetElementTypeName(El)],El);
  6452. end;
  6453. if Proc.Parent is TPasMembersType then
  6454. begin
  6455. FinishMethodDeclHeader(Proc);
  6456. exit;
  6457. end;
  6458. // finish interface/implementation/nested procedure
  6459. if (ProcName<>'') and ProcNeedsBody(Proc) then
  6460. begin
  6461. if ppsfIsSpecialized in ProcScope.Flags then
  6462. begin
  6463. if ProcScope.DeclarationProc<>nil then
  6464. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6465. end
  6466. else
  6467. begin
  6468. // check if there is a forward declaration
  6469. //writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2]));
  6470. ParentScope:=GetParentLocalScope as TPasIdentifierScope;
  6471. //writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc));
  6472. DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true);
  6473. //writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
  6474. //if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc));
  6475. if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
  6476. DeclProc:=FindProcSameSignature(ProcName,Proc,
  6477. (Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true);
  6478. //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
  6479. if (DeclProc<>nil) then
  6480. begin
  6481. if ProcNeedsImplProc(DeclProc) then
  6482. begin
  6483. // found forward declaration
  6484. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6485. if DeclProcScope.ImplProc<>nil then
  6486. RaiseMsg(20180318222430,nDuplicateIdentifier,sDuplicateIdentifier,
  6487. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],Proc);
  6488. // connect
  6489. {$IFDEF VerbosePasResolver}
  6490. writeln('TPasResolver.FinishProcedureHeader forward found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
  6491. {$ENDIF}
  6492. CheckProcSignatureMatch(DeclProc,Proc,false);
  6493. DeclProcScope.ImplProc:=Proc;
  6494. ProcScope.DeclarationProc:=DeclProc;
  6495. // remove ImplProc from scope
  6496. ParentScope.RemoveLocalIdentifier(Proc);
  6497. // replace arguments with declaration arguments
  6498. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6499. exit;
  6500. end
  6501. else
  6502. RaiseMsg(20180318220543,nDuplicateIdentifier,sDuplicateIdentifier,
  6503. [DeclProc.Name,GetElementSourcePosStr(DeclProc)],Proc);
  6504. end;
  6505. end;
  6506. end
  6507. else
  6508. begin
  6509. // forward declaration
  6510. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6511. StoreScannerFlagsInProc(ProcScope);
  6512. end;
  6513. if ProcName<>'' then
  6514. begin
  6515. // check for invalid overloads
  6516. FindData:=Default(TFindProcData);
  6517. FindData.Proc:=Proc;
  6518. FindData.Args:=Proc.ProcType.Args;
  6519. FindData.Kind:=fpkProc;
  6520. Abort:=false;
  6521. IterateElements(ProcName,@OnFindProc,@FindData,Abort);
  6522. end;
  6523. end
  6524. else if El.Name<>'' then
  6525. begin
  6526. // finished proc type, e.g. type TProcedure = procedure;
  6527. end
  6528. else
  6529. RaiseNotYetImplemented(20160922163411,El.Parent,'anonymous procedure type');
  6530. end;
  6531. procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
  6532. procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
  6533. begin
  6534. LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
  6535. sVirtualMethodXHasLowerVisibility,[Proc.Name,
  6536. VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
  6537. VisibilityNames[OverloadProc.Visibility]],Proc);
  6538. Proc.Visibility:=OverloadProc.Visibility;
  6539. end;
  6540. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  6541. procedure Delete(var A: TArrayOfPasProcedure; Index, Count: integer); overload;
  6542. var
  6543. i: Integer;
  6544. begin
  6545. if Index<0 then
  6546. RaiseInternalError(20171227121538);
  6547. if Index+Count>length(A) then
  6548. RaiseInternalError(20171227121156);
  6549. for i:=Index+Count to length(A)-1 do
  6550. A[i-Count]:=A[i];
  6551. SetLength(A,length(A)-Count);
  6552. end;
  6553. procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
  6554. var
  6555. i: Integer;
  6556. begin
  6557. if Index<0 then
  6558. RaiseInternalError(20171227121544);
  6559. if Index>length(A) then
  6560. RaiseInternalError(20171227121558);
  6561. SetLength(A,length(A)+1);
  6562. for i:=length(A)-1 downto Index+1 do
  6563. A[i]:=A[i-1];
  6564. A[Index]:=Item;
  6565. end;
  6566. {$ENDIF}
  6567. var
  6568. Abort, IsClassConDestructor: boolean;
  6569. ClassOrRecScope: TPasClassOrRecordScope;
  6570. FindData: TFindProcData;
  6571. OverloadProc: TPasProcedure;
  6572. ProcScope: TPasProcedureScope;
  6573. i: Integer;
  6574. ParentScope: TPasScope;
  6575. TemplTypes: TFPList;
  6576. begin
  6577. if not (ptmStatic in Proc.ProcType.Modifiers) then
  6578. Proc.ProcType.IsOfObject:=true;
  6579. ProcScope:=TopScope as TPasProcedureScope;
  6580. ParentScope:=Scopes[ScopeCount-2];
  6581. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6582. StoreScannerFlagsInProc(ProcScope);
  6583. ClassOrRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope;
  6584. ProcScope.ClassRecScope:=ClassOrRecScope;
  6585. TemplTypes:=GetProcTemplateTypes(Proc);
  6586. FindData:=Default(TFindProcData);
  6587. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6588. or (Proc.ClassType=TPasClassDestructor);
  6589. if IsClassConDestructor then
  6590. begin
  6591. if TemplTypes<>nil then
  6592. RaiseNotYetImplemented(20190911105953,Proc);
  6593. end
  6594. else
  6595. begin
  6596. FindData.Proc:=Proc;
  6597. FindData.Args:=Proc.ProcType.Args;
  6598. FindData.Kind:=fpkMethod;
  6599. Abort:=false;
  6600. ParentScope.IterateElements(Proc.Name,ClassOrRecScope,
  6601. @OnFindProc,@FindData,Abort);
  6602. end;
  6603. if FindData.Found=nil then
  6604. begin
  6605. // no overload
  6606. if Proc.IsOverride then
  6607. RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
  6608. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6609. end
  6610. else
  6611. begin
  6612. // overload found
  6613. OverloadProc:=FindData.Found;
  6614. // Note: 'inherited;' needs the OverriddenProc, even without 'override' modifier
  6615. ProcScope.OverriddenProc:=OverloadProc;
  6616. if Proc.IsOverride then
  6617. begin
  6618. if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
  6619. // the OverloadProc fits the signature, but is not virtual
  6620. RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
  6621. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6622. // override a virtual method
  6623. CheckProcSignatureMatch(OverloadProc,Proc,true);
  6624. // check visibility
  6625. if Proc.Visibility<>OverloadProc.Visibility then
  6626. case Proc.Visibility of
  6627. visPrivate,visStrictPrivate:
  6628. if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
  6629. VisibilityLowered(Proc,OverloadProc);
  6630. visProtected,visStrictProtected:
  6631. if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
  6632. VisibilityLowered(Proc,OverloadProc);
  6633. visPublic:
  6634. if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
  6635. VisibilityLowered(Proc,OverloadProc);
  6636. visPublished: ;
  6637. else
  6638. RaiseNotYetImplemented(20170325003315,Proc,'visibility');
  6639. end;
  6640. // check name case
  6641. if proFixCaseOfOverrides in Options then
  6642. Proc.Name:=OverloadProc.Name;
  6643. // remove abstract
  6644. if OverloadProc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6645. for i:=length(TPasClassScope(ClassOrRecScope).AbstractProcs)-1 downto 0 do
  6646. if TPasClassScope(ClassOrRecScope).AbstractProcs[i]=OverloadProc then
  6647. Delete(TPasClassScope(ClassOrRecScope).AbstractProcs,i,1);
  6648. end;
  6649. end;
  6650. // add abstract
  6651. if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6652. Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
  6653. length(TPasClassScope(ClassOrRecScope).AbstractProcs));
  6654. end;
  6655. procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
  6656. var
  6657. ProcName: String;
  6658. ClassRecType: TPasMembersType;
  6659. ImplProcScope, DeclProcScope: TPasProcedureScope;
  6660. DeclProc: TPasProcedure;
  6661. ClassOrRecScope: TPasClassOrRecordScope;
  6662. SelfArg: TPasArgument;
  6663. p: Integer;
  6664. SelfType, LoSelfType: TPasType;
  6665. LastNamePart: TProcedureNamePart;
  6666. begin
  6667. if ImplProc.IsExternal then
  6668. RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'external'],ImplProc);
  6669. if ImplProc.IsExported then
  6670. RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'export'],ImplProc);
  6671. ProcName:=ImplProc.Name;
  6672. ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
  6673. ClassOrRecScope:=ImplProcScope.ClassRecScope;
  6674. if ClassOrRecScope=nil then
  6675. RaiseInternalError(20161013172346);
  6676. ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
  6677. if ImplProcScope.GroupScope=nil then
  6678. RaiseInternalError(20190120135017);
  6679. if ImplProc.NameParts<>nil then
  6680. begin
  6681. LastNamePart:=TProcedureNamePart(ImplProc.NameParts[ImplProc.NameParts.Count-1]);
  6682. ProcName:=LastNamePart.Name;
  6683. end
  6684. else
  6685. begin
  6686. // remove path from ProcName
  6687. repeat
  6688. p:=Pos('.',ProcName);
  6689. if p<1 then break;
  6690. Delete(ProcName,1,p);
  6691. until false;
  6692. end;
  6693. if ImplProcScope.DeclarationProc=nil then
  6694. begin
  6695. {$IFDEF VerbosePasResolver}
  6696. writeln('TPasResolver.FinishMethodImplHeader searching declaration "',ImplProc.Name,'" ...');
  6697. {$ENDIF}
  6698. // search ImplProc in class
  6699. if not IsValidIdent(ProcName) then
  6700. RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
  6701. // search proc in class/record
  6702. if ImplProc.ClassType=TPasClassConstructor then
  6703. DeclProc:=ClassOrRecScope.ClassConstructor
  6704. else if ImplProc.ClassType=TPasClassDestructor then
  6705. DeclProc:=ClassOrRecScope.ClassDestructor
  6706. else
  6707. DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
  6708. if DeclProc=nil then
  6709. RaiseIdentifierNotFound(20170216151720,GetProcName(ImplProc),ImplProc.ProcType);
  6710. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6711. ImplProc.ProcType.IsOfObject:=DeclProc.ProcType.IsOfObject;
  6712. // connect method declaration and body
  6713. if DeclProcScope.ImplProc<>nil then
  6714. RaiseMsg(20180212094546,nDuplicateIdentifier,sDuplicateIdentifier,
  6715. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],
  6716. ImplProc);
  6717. if DeclProc.IsAbstract then
  6718. RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
  6719. if DeclProc.IsExternal then
  6720. RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
  6721. CheckProcSignatureMatch(DeclProc,ImplProc,false);
  6722. ImplProcScope.DeclarationProc:=DeclProc;
  6723. DeclProcScope.ImplProc:=ImplProc;
  6724. // replace arguments in scope with declaration arguments
  6725. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  6726. end
  6727. else if ppsfIsSpecialized in ImplProcScope.Flags then
  6728. begin
  6729. {$IFDEF VerbosePasResolver}
  6730. writeln('TPasResolver.FinishMethodImplHeader specialized "',ImplProc.Name,'" ...');
  6731. {$ENDIF}
  6732. DeclProc:=ImplProcScope.DeclarationProc;
  6733. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6734. if DeclProcScope.ImplProc<>ImplProc then
  6735. RaiseNotYetImplemented(20190804182220,ImplProc);
  6736. // replace arguments in scope with declaration arguments
  6737. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  6738. end
  6739. else
  6740. RaiseNotYetImplemented(20190804181222,ImplProc);
  6741. if not DeclProc.IsStatic then
  6742. begin
  6743. // add 'Self'
  6744. if (DeclProc.ClassType=TPasClassConstructor)
  6745. or (DeclProc.ClassType=TPasClassDestructor) then
  6746. // actually class constructor/destructor are static
  6747. else if (DeclProc.ClassType=TPasClassProcedure)
  6748. or (DeclProc.ClassType=TPasClassFunction) then
  6749. begin
  6750. if (ClassOrRecScope is TPasClassScope)
  6751. and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
  6752. begin
  6753. // 'Self' in a method is the hidden classtype argument
  6754. // Note: this is true in classes, adv records and helpers
  6755. SelfArg:=TPasArgument.Create('Self',DeclProc);
  6756. ImplProcScope.SelfArg:=SelfArg;
  6757. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  6758. SelfArg.Access:=argConst;
  6759. SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
  6760. SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  6761. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  6762. end
  6763. else
  6764. RaiseInternalError(20190106121745);
  6765. end
  6766. else
  6767. begin
  6768. // 'Self' in a method is the hidden instance argument
  6769. SelfArg:=TPasArgument.Create('Self',DeclProc);
  6770. ImplProcScope.SelfArg:=SelfArg;
  6771. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  6772. SelfType:=ClassRecType;
  6773. if (SelfType.ClassType=TPasClassType)
  6774. and (TPasClassType(SelfType).HelperForType<>nil) then
  6775. begin
  6776. // in a helper Self is a var argument of the helped variable
  6777. SelfType:=TPasClassType(SelfType).HelperForType;
  6778. end;
  6779. LoSelfType:=ResolveAliasType(SelfType);
  6780. if (LoSelfType is TPasClassType)
  6781. and (TPasClassType(LoSelfType).ObjKind=okClass) then
  6782. SelfArg.Access:=argConst
  6783. else
  6784. SelfArg.Access:=argVar;
  6785. SelfArg.ArgType:=SelfType;
  6786. SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  6787. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  6788. end;
  6789. end;
  6790. {$IFDEF VerbosePasResolver}
  6791. writeln('TPasResolver.FinishMethodImplHeader END "',ImplProc.Name,'" ...');
  6792. {$ENDIF}
  6793. end;
  6794. procedure TPasResolver.FinishSpecializations(Scope: TPasGenericScope);
  6795. var
  6796. SpecializedItems: TObjectList;
  6797. i: Integer;
  6798. begin
  6799. SpecializedItems:=Scope.SpecializedItems;
  6800. if SpecializedItems=nil then exit;
  6801. for i:=0 to SpecializedItems.Count-1 do
  6802. SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
  6803. end;
  6804. procedure TPasResolver.FinishExceptOnExpr;
  6805. var
  6806. El: TPasImplExceptOn;
  6807. ResolvedType: TPasResolverResult;
  6808. begin
  6809. CheckTopScope(TPasExceptOnScope);
  6810. El:=TPasImplExceptOn(FTopScope.Element);
  6811. ComputeElement(El.TypeEl,ResolvedType,[rcType]);
  6812. CheckIsClass(El.TypeEl,ResolvedType);
  6813. end;
  6814. procedure TPasResolver.FinishExceptOnStatement;
  6815. begin
  6816. //writeln('TPasResolver.FinishExceptOnStatement START');
  6817. CheckTopScope(TPasExceptOnScope);
  6818. ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
  6819. PopScope;
  6820. end;
  6821. procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
  6822. begin
  6823. PopWithScope(El);
  6824. end;
  6825. procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop);
  6826. var
  6827. VarResolved, StartResolved, EndResolved,
  6828. OrigStartResolved: TPasResolverResult;
  6829. EnumeratorFound, HasInValues: Boolean;
  6830. InRange, VarRange: TResEvalValue;
  6831. InRangeInt, VarRangeInt: TResEvalRangeInt;
  6832. bt: TResolverBaseType;
  6833. TypeEl, ElType: TPasType;
  6834. C: TClass;
  6835. begin
  6836. CreateScope(Loop,TPasForLoopScope);
  6837. // loop var
  6838. ResolveExpr(Loop.VariableName,rraReadAndAssign);
  6839. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  6840. if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
  6841. RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
  6842. // resolve start expression
  6843. ResolveExpr(Loop.StartExpr,rraRead);
  6844. ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
  6845. case Loop.LoopType of
  6846. ltNormal,ltDown:
  6847. begin
  6848. // start value
  6849. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  6850. RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
  6851. [],StartResolved,VarResolved,Loop.StartExpr);
  6852. CheckAssignExprRange(VarResolved,Loop.StartExpr);
  6853. // end value
  6854. ResolveExpr(Loop.EndExpr,rraRead);
  6855. ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
  6856. if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
  6857. RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
  6858. [],EndResolved,VarResolved,Loop.EndExpr);
  6859. CheckAssignExprRange(VarResolved,Loop.EndExpr);
  6860. end;
  6861. ltIn:
  6862. begin
  6863. // check range
  6864. EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
  6865. if (not EnumeratorFound)
  6866. and not (StartResolved.IdentEl is TPasType)
  6867. and (rrfReadable in StartResolved.Flags) then
  6868. begin
  6869. EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
  6870. end;
  6871. if not EnumeratorFound then
  6872. begin
  6873. VarRange:=nil;
  6874. InRange:=nil;
  6875. try
  6876. OrigStartResolved:=StartResolved;
  6877. if StartResolved.IdentEl is TPasType then
  6878. begin
  6879. // e.g. for e in TEnum do
  6880. TypeEl:=StartResolved.LoTypeEl;
  6881. if TypeEl is TPasArrayType then
  6882. begin
  6883. if length(TPasArrayType(TypeEl).Ranges)=1 then
  6884. InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
  6885. end;
  6886. if InRange=nil then
  6887. InRange:=EvalTypeRange(TypeEl,[]);
  6888. {$IFDEF VerbosePasResolver}
  6889. {AllowWriteln}
  6890. if InRange<>nil then
  6891. writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
  6892. else
  6893. writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
  6894. {AllowWriteln-}
  6895. {$ENDIF}
  6896. end
  6897. else if rrfReadable in StartResolved.Flags then
  6898. begin
  6899. // value (variable or expression)
  6900. bt:=StartResolved.BaseType;
  6901. if bt in [btSet,btArrayOrSet] then
  6902. begin
  6903. if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
  6904. InRange:=Eval(StartResolved.ExprEl,[]);
  6905. if InRange=nil then
  6906. InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
  6907. end
  6908. else if bt=btContext then
  6909. begin
  6910. TypeEl:=StartResolved.LoTypeEl;
  6911. C:=TypeEl.ClassType;
  6912. if C=TPasArrayType then
  6913. begin
  6914. ElType:=GetArrayElType(TPasArrayType(TypeEl));
  6915. ComputeElement(ElType,StartResolved,[rcType]);
  6916. StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
  6917. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  6918. RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
  6919. [],StartResolved,VarResolved,Loop.StartExpr);
  6920. EnumeratorFound:=true;
  6921. end;
  6922. end
  6923. else
  6924. begin
  6925. bt:=GetActualBaseType(bt);
  6926. case bt of
  6927. {$ifdef FPC_HAS_CPSTRING}
  6928. btAnsiString:
  6929. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  6930. {$endif}
  6931. btUnicodeString:
  6932. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  6933. end;
  6934. end;
  6935. end;
  6936. if (not EnumeratorFound) and (InRange<>nil) then
  6937. begin
  6938. // for v in <constant> do
  6939. // -> check if same type
  6940. VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
  6941. if VarRange=nil then
  6942. RaiseXExpectedButYFound(20171109191528,'range',
  6943. GetResolverResultDescription(VarResolved),Loop.VariableName);
  6944. //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  6945. //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
  6946. case InRange.Kind of
  6947. revkRangeInt,revkSetOfInt:
  6948. begin
  6949. InRangeInt:=TResEvalRangeInt(InRange);
  6950. case VarRange.Kind of
  6951. revkRangeInt:
  6952. begin
  6953. VarRangeInt:=TResEvalRangeInt(VarRange);
  6954. HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
  6955. case InRangeInt.ElKind of
  6956. revskEnum:
  6957. if (VarRangeInt.ElKind<>revskEnum)
  6958. or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
  6959. RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
  6960. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6961. revskInt:
  6962. if VarRangeInt.ElKind<>revskInt then
  6963. RaiseXExpectedButYFound(20171109200752,'integer',
  6964. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6965. revskChar:
  6966. if VarRangeInt.ElKind<>revskChar then
  6967. RaiseXExpectedButYFound(20171109200753,'char',
  6968. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6969. revskBool:
  6970. if VarRangeInt.ElKind<>revskBool then
  6971. RaiseXExpectedButYFound(20171109200754,'boolean',
  6972. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6973. else
  6974. if HasInValues then
  6975. RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
  6976. end;
  6977. if HasInValues then
  6978. begin
  6979. if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
  6980. begin
  6981. {$IFDEF VerbosePasResolver}
  6982. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  6983. {$ENDIF}
  6984. fExprEvaluator.EmitRangeCheckConst(20171109201428,
  6985. InRangeInt.ElementAsString(InRangeInt.RangeStart),
  6986. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  6987. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  6988. end;
  6989. if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
  6990. begin
  6991. {$IFDEF VerbosePasResolver}
  6992. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  6993. {$ENDIF}
  6994. fExprEvaluator.EmitRangeCheckConst(20171109201429,
  6995. InRangeInt.ElementAsString(InRangeInt.RangeEnd),
  6996. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  6997. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  6998. end;
  6999. end;
  7000. EnumeratorFound:=true;
  7001. end;
  7002. else
  7003. {$IFDEF VerbosePasResolver}
  7004. writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  7005. {$ENDIF}
  7006. end;
  7007. end;
  7008. else
  7009. {$IFDEF VerbosePasResolver}
  7010. writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
  7011. {$ENDIF}
  7012. end;
  7013. end;
  7014. if not EnumeratorFound then
  7015. begin
  7016. {$IFDEF VerbosePasResolver}
  7017. {AllowWriteln}
  7018. writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
  7019. if VarRange<>nil then
  7020. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
  7021. {AllowWriteln-}
  7022. {$ENDIF}
  7023. RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  7024. [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
  7025. end;
  7026. finally
  7027. ReleaseEvalValue(VarRange);
  7028. ReleaseEvalValue(InRange);
  7029. end;
  7030. end;
  7031. end;
  7032. else
  7033. RaiseNotYetImplemented(20171108221334,Loop);
  7034. end;
  7035. end;
  7036. procedure TPasResolver.FinishDeclaration(El: TPasElement);
  7037. var
  7038. C: TClass;
  7039. begin
  7040. C:=El.ClassType;
  7041. if (C=TPasVariable) or (C=TPasConst) then
  7042. FinishVariable(TPasVariable(El))
  7043. else if C=TPasProperty then
  7044. FinishProperty(TPasProperty(El))
  7045. else if C=TPasArgument then
  7046. FinishArgument(TPasArgument(El))
  7047. else if C=TPasMethodResolution then
  7048. FinishMethodResolution(TPasMethodResolution(El))
  7049. else if C=TPasAttributes then
  7050. FinishAttributes(TPasAttributes(El))
  7051. else
  7052. begin
  7053. {$IFDEF VerbosePasResolver}
  7054. writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
  7055. {$ENDIF}
  7056. RaiseNotYetImplemented(20180127121557,El);
  7057. end;
  7058. end;
  7059. procedure TPasResolver.FinishVariable(El: TPasVariable);
  7060. var
  7061. ResolvedAbs: TPasResolverResult;
  7062. C: TClass;
  7063. Value: TResEvalValue;
  7064. begin
  7065. if (El.Visibility=visPublished) then
  7066. begin
  7067. if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
  7068. RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  7069. end;
  7070. if El.Expr<>nil then
  7071. ResolveExpr(El.Expr,rraRead);
  7072. if El.VarType<>nil then
  7073. begin
  7074. if (El.Parent is TPasRecordType) and (El.VarType=El.Parent) then
  7075. RaiseMsg(20181218173631,nTypeXIsNotYetCompletelyDefined,
  7076. sTypeXIsNotYetCompletelyDefined,[El.VarType.Name],El);
  7077. CheckUseAsType(El.VarType,20190123095916,El);
  7078. if El.Expr<>nil then
  7079. CheckAssignCompatibility(El,El.Expr,true);
  7080. end
  7081. else if El.Expr<>nil then
  7082. begin
  7083. // no VarType, has Expr, e.g. const a = Expr
  7084. Value:=Eval(El.Expr,[refConstExt]); // e.g. const Tau = 2*PI
  7085. ReleaseEvalValue(Value);
  7086. end;
  7087. if El.AbsoluteExpr<>nil then
  7088. begin
  7089. if El.ClassType=TPasConst then
  7090. RaiseMsg(20180201225530,nXModifierMismatchY,sXModifierMismatchY,
  7091. ['absolute','const'],El.AbsoluteExpr);
  7092. if El.VarType=nil then
  7093. RaiseMsg(20171225235125,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7094. if vmExternal in El.VarModifiers then
  7095. RaiseMsg(20171226104221,nXModifierMismatchY,sXModifierMismatchY,
  7096. ['absolute','external'],El.AbsoluteExpr);
  7097. {$IFDEF VerbosePasResolver}
  7098. writeln('TPasResolver.FinishVariable El=',GetObjName(El),' Absolute="',GetObjName(El.AbsoluteExpr),'"');
  7099. {$ENDIF}
  7100. ResolveExpr(El.AbsoluteExpr,rraRead);
  7101. ComputeElement(El.AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
  7102. if (not (rrfReadable in ResolvedAbs.Flags))
  7103. or (ResolvedAbs.IdentEl=nil) then
  7104. RaiseVarExpected(20171225234734,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7105. C:=ResolvedAbs.IdentEl.ClassType;
  7106. if (C=TPasVariable)
  7107. or (C=TPasArgument)
  7108. or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
  7109. else
  7110. RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7111. if not (rrfReadable in ResolvedAbs.Flags) then
  7112. RaiseVarExpected(20171225235249,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7113. // check for cycles
  7114. if ResolvedAbs.IdentEl=El then
  7115. RaiseMsg(20171226000703,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7116. end;
  7117. if El.VarType<>nil then
  7118. EmitTypeHints(El,El.VarType);
  7119. end;
  7120. procedure TPasResolver.FinishProperty(PropEl: TPasProperty);
  7121. var
  7122. PropType: TPasType;
  7123. ClassOrRecScope: TPasClassOrRecordScope;
  7124. ClassScope: TPasClassScope;
  7125. AncestorProp: TPasProperty;
  7126. IndexExpr: TPasExpr;
  7127. procedure GetPropType;
  7128. var
  7129. AncEl: TPasElement;
  7130. GroupScope: TPasGroupScope;
  7131. begin
  7132. if PropType<>nil then exit;
  7133. AncEl:=nil;
  7134. if (ClassScope<>nil) and (ClassScope.AncestorScope<>nil) then
  7135. begin
  7136. CheckTopScope(TPasGroupScope);
  7137. GroupScope:=TPasGroupScope(TopScope);
  7138. AncEl:=GroupScope.FindAncestorElement(PropEl.Name);
  7139. end;
  7140. if AncEl is TPasProperty then
  7141. begin
  7142. // override or redeclaration property
  7143. AncestorProp:=TPasProperty(AncEl);
  7144. TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncestorProp;
  7145. if proFixCaseOfOverrides in Options then
  7146. PropEl.Name:=AncestorProp.Name;
  7147. end
  7148. else
  7149. AncestorProp:=nil;
  7150. if PropEl.VarType<>nil then
  7151. begin
  7152. // new property or redeclaration
  7153. PropType:=PropEl.VarType;
  7154. CheckUseAsType(PropEl.VarType,20190123100011,PropEl);
  7155. end
  7156. else
  7157. begin
  7158. // property override
  7159. if AncestorProp=nil then
  7160. RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
  7161. // check property versus class property
  7162. if PropEl.ClassType<>AncestorProp.ClassType then
  7163. RaiseXExpectedButYFound(20170216151744,GetElementTypeName(AncestorProp),GetElementTypeName(PropEl),PropEl);
  7164. // get inherited type
  7165. PropType:=GetPasPropertyType(AncestorProp);
  7166. // update DefaultProperty
  7167. if ClassScope=nil then
  7168. RaiseNotYetImplemented(20181231130642,PropEl);
  7169. if ClassScope.DefaultProperty=AncestorProp then
  7170. ClassScope.DefaultProperty:=PropEl;
  7171. end;
  7172. end;
  7173. function CheckClassAccessorStatic(ProcIsStatic: boolean): boolean;
  7174. begin
  7175. if ClassScope=nil then
  7176. // record: class getter/setter must be static
  7177. Result:=ProcIsStatic=true
  7178. else if proClassPropertyNonStatic in Options then
  7179. Result:=true // both allowed
  7180. else
  7181. Result:=ProcIsStatic=true;
  7182. end;
  7183. procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
  7184. ProcArg: TPasArgument; ErrorEl: TPasElement);
  7185. var
  7186. ProcArgResolved: TPasResolverResult;
  7187. begin
  7188. // check access: const, ...
  7189. if not (ProcArg.Access in [argDefault,argConst]) then
  7190. RaiseMsg(20170924202437,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7191. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7192. AccessDescriptions[argConst]],ErrorEl);
  7193. // check argument type
  7194. if ProcArg.ArgType=nil then
  7195. RaiseMsg(20170924202531,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7196. [IntToStr(ArgNo),'untyped',GetTypeDescription(IndexResolved)],ErrorEl)
  7197. else
  7198. begin
  7199. if CheckParamCompatibility(IndexExpr,ProcArg,ArgNo,true)=cIncompatible then
  7200. begin
  7201. ComputeElement(ProcArg.ArgType,ProcArgResolved,[rcType]);
  7202. RaiseIncompatibleTypeRes(20170924203829,nIncompatibleTypeArgNo,
  7203. [IntToStr(ArgNo)],ProcArgResolved,IndexResolved,ErrorEl);
  7204. end;
  7205. end;
  7206. end;
  7207. procedure CheckArgs(Proc: TPasProcedure; const IndexVal: TResEvalValue;
  7208. const IndexResolved: TPasResolverResult; ErrorEl: TPasElement);
  7209. var
  7210. ArgNo: Integer;
  7211. PropArg, ProcArg: TPasArgument;
  7212. PropArgResolved, ProcArgResolved: TPasResolverResult;
  7213. NeedCheckingAccess: Boolean;
  7214. begin
  7215. ArgNo:=0;
  7216. while ArgNo<PropEl.Args.Count do
  7217. begin
  7218. if ArgNo>=Proc.ProcType.Args.Count then
  7219. RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
  7220. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7221. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  7222. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7223. inc(ArgNo);
  7224. // check access: var, const, ...
  7225. NeedCheckingAccess:=false;
  7226. if PropArg.Access<>ProcArg.Access then
  7227. begin
  7228. if (PropArg.Access in [argDefault, argConst])
  7229. and (ProcArg.Access in [argDefault, argConst]) then
  7230. begin
  7231. // passing an arg as default to const or const to default
  7232. if (PropArg.ArgType<>nil)
  7233. and (ProcArg.ArgType<>nil) then
  7234. NeedCheckingAccess:=true;
  7235. end;
  7236. if not NeedCheckingAccess then
  7237. RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7238. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7239. AccessDescriptions[PropArg.Access]],ErrorEl);
  7240. end;
  7241. // check argument type
  7242. if PropArg.ArgType=nil then
  7243. begin
  7244. if ProcArg.ArgType<>nil then
  7245. RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7246. [IntToStr(ArgNo),GetElementTypeName(ProcArg.ArgType),'untyped'],ErrorEl);
  7247. end
  7248. else if ProcArg.ArgType=nil then
  7249. RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7250. [IntToStr(ArgNo),'untyped',GetElementTypeName(PropArg.ArgType)],ErrorEl)
  7251. else
  7252. begin
  7253. ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
  7254. ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
  7255. if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
  7256. RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7257. [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
  7258. if PropArgResolved.LoTypeEl=nil then
  7259. RaiseInternalError(20161010125255);
  7260. if ProcArgResolved.LoTypeEl=nil then
  7261. RaiseInternalError(20161010125304);
  7262. if not IsSameType(PropArgResolved.HiTypeEl,ProcArgResolved.HiTypeEl,prraSimple) then
  7263. RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
  7264. [IntToStr(ArgNo)],ProcArgResolved.HiTypeEl,PropArgResolved.HiTypeEl,ErrorEl);
  7265. end;
  7266. if NeedCheckingAccess then
  7267. begin
  7268. // passing an arg as default to const or const to default
  7269. // e.g.
  7270. // function GetItems(const i: integer): byte;
  7271. // property Items[i: integer]: byte read GetItems;
  7272. // => allowed for simple types
  7273. if not (PropArgResolved.BaseType in (btAllBooleans+btAllInteger+btAllStringAndChars+btAllFloats)) then
  7274. RaiseMsg(20181007181647,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7275. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7276. AccessDescriptions[PropArg.Access]],ErrorEl);
  7277. end;
  7278. end;
  7279. if IndexVal<>nil then
  7280. begin
  7281. if ArgNo>=Proc.ProcType.Args.Count then
  7282. RaiseMsg(20170924202334,nWrongNumberOfParametersForCallTo,
  7283. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7284. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7285. CheckIndexArg(ArgNo,IndexResolved,ProcArg,ErrorEl);
  7286. end;
  7287. end;
  7288. procedure CheckImplements;
  7289. var
  7290. i, j: Integer;
  7291. Expr: TPasExpr;
  7292. ResolvedEl: TPasResolverResult;
  7293. aClass, PropClassType: TPasClassType;
  7294. IntfType, OrigIntfType, PropTypeRes: TPasType;
  7295. o: TObject;
  7296. begin
  7297. if not (PropEl.Parent is TPasClassType) then
  7298. RaiseInternalError(20180323172125,GetElementDbgPath(PropEl));
  7299. aClass:=TPasClassType(PropEl.Parent);
  7300. if PropEl.Args.Count>0 then
  7301. RaiseMsg(20180323170952,nImplementsDoesNotSupportArrayProperty,
  7302. sImplementsDoesNotSupportArrayProperty,[],PropEl.Implements[0]);
  7303. if IndexExpr<>nil then
  7304. RaiseMsg(20180323171354,nImplementsDoesNotSupportIndex,
  7305. sImplementsDoesNotSupportIndex,[],PropEl.Implements[0]);
  7306. if GetPasPropertyGetter(PropEl)=nil then
  7307. RaiseMsg(20180323221322,nImplPropMustHaveReadSpec,
  7308. sImplPropMustHaveReadSpec,[],PropEl.Implements[0]);
  7309. for i:=0 to length(PropEl.Implements)-1 do
  7310. begin
  7311. // resolve expression
  7312. Expr:=PropEl.Implements[i];
  7313. ResolveExpr(Expr,rraRead);
  7314. // check expr is an interface type
  7315. ComputeElement(Expr,ResolvedEl,[rcType,rcNoImplicitProc]);
  7316. if not (ResolvedEl.IdentEl is TPasType) then
  7317. if ResolvedEl.IdentEl=nil then
  7318. RaiseXExpectedButYFound(20180323171911,'interface',
  7319. GetElementTypeName(ResolvedEl.LoTypeEl),Expr)
  7320. else
  7321. RaiseXExpectedButYFound(20180323224846,'interface',
  7322. GetElementTypeName(ResolvedEl.IdentEl),Expr);
  7323. OrigIntfType:=TPasType(ResolvedEl.IdentEl);
  7324. IntfType:=ResolveAliasType(OrigIntfType);
  7325. if (not (IntfType is TPasClassType))
  7326. or (TPasClassType(IntfType).ObjKind<>okInterface) then
  7327. RaiseXExpectedButYFound(20180323172904,'interface',
  7328. GetElementTypeName(OrigIntfType),Expr);
  7329. // check it is one of the current implemented interfaces (not of ancestors)
  7330. j:=IndexOfImplementedInterface(aClass,IntfType);
  7331. if j<0 then
  7332. RaiseMsg(20180323172420,nImplementsUsedOnUnimplIntf,sImplementsUsedOnUnimplIntf,
  7333. [OrigIntfType.Name],Expr);
  7334. // check property type fits
  7335. PropTypeRes:=ResolveAliasType(PropType);
  7336. if not (PropTypeRes is TPasClassType) then
  7337. RaiseMsg(20180323222334,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7338. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7339. PropClassType:=TPasClassType(PropTypeRes);
  7340. case PropClassType.ObjKind of
  7341. okClass:
  7342. // e.g. property Obj: ClassType read Getter implements IntfType
  7343. // check ClassType or ancestors implements IntfType
  7344. if GetClassImplementsIntf(PropClassType,TPasClassType(IntfType))=nil then
  7345. RaiseMsg(20180323223324,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7346. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7347. okInterface:
  7348. // e.g. property IntfVar: IntfType read Getter implements IntfType2
  7349. // check that IntfType is IntfType2
  7350. if CheckClassIsClass(PropType,IntfType)=cIncompatible then
  7351. RaiseIncompatibleType(20180323173746,nIncompatibleTypesGotExpected,
  7352. [],OrigIntfType,PropType,Expr);
  7353. else
  7354. RaiseMsg(20180323222821,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7355. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7356. end;
  7357. // map
  7358. o:=TObject(ClassScope.Interfaces[j]);
  7359. if o is TPasProperty then
  7360. RaiseMsg(20180323174240,nDuplicateImplementsForIntf,sDuplicateImplementsForIntf,
  7361. [OrigIntfType.Name,GetElementSourcePosStr(TPasProperty(o))],Expr)
  7362. else if o is TPasClassIntfMap then
  7363. begin
  7364. // properties are checked before method resolutions
  7365. RaiseInternalError(20180323175919,GetElementDbgPath(PropEl));
  7366. end
  7367. else if o<>nil then
  7368. RaiseInternalError(20180323174342,GetObjName(o))
  7369. else
  7370. ClassScope.Interfaces[j]:=PropEl;
  7371. end;
  7372. end;
  7373. procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
  7374. const IndexResolved: TPasResolverResult);
  7375. var
  7376. ResolvedEl: TPasResolverResult;
  7377. Value: TResEvalValue;
  7378. Proc: TPasProcedure;
  7379. ResultType, TypeEl: TPasType;
  7380. aVar: TPasVariable;
  7381. IdentEl: TPasElement;
  7382. ExpArgCnt: Integer;
  7383. ProcArg: TPasArgument;
  7384. begin
  7385. ResolveExpr(Expr,rraRead);
  7386. ComputeElement(Expr,ResolvedEl,[rcNoImplicitProc]);
  7387. IdentEl:=ResolvedEl.IdentEl;
  7388. if IdentEl is TPasProcedure then
  7389. begin
  7390. // function
  7391. Proc:=TPasProcedure(IdentEl);
  7392. // check if member
  7393. if not (Expr is TPrimitiveExpr) then
  7394. RaiseXExpectedButYFound(20170923202002,'member function','foreign '+GetElementTypeName(Proc),Expr);
  7395. if Proc.ClassType<>TPasFunction then
  7396. RaiseXExpectedButYFound(20170216151925,'function',GetElementTypeName(Proc),Expr);
  7397. // check function result type
  7398. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7399. if not IsBaseType(ResultType,btBoolean,true) then
  7400. RaiseXExpectedButYFound(20170923200836,'function: boolean',
  7401. 'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
  7402. // check arg count
  7403. ExpArgCnt:=0;
  7404. if IndexVal<>nil then
  7405. inc(ExpArgCnt);
  7406. if Proc.ProcType.Args.Count<>ExpArgCnt then
  7407. RaiseMsg(20170923200840,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7408. [Proc.Name],Expr);
  7409. if IndexVal<>nil then
  7410. begin
  7411. // check arg type
  7412. ProcArg:=TPasArgument(Proc.ProcType.Args[0]);
  7413. CheckIndexArg(1,IndexResolved,ProcArg,Expr);
  7414. end;
  7415. exit;
  7416. end;
  7417. if (IdentEl<>nil)
  7418. and ((IdentEl.ClassType=TPasVariable)
  7419. or ((IdentEl.ClassType=TPasConst) and not TPasConst(IdentEl).IsConst)) then
  7420. begin
  7421. // field
  7422. aVar:=TPasVariable(IdentEl);
  7423. // check if member
  7424. if not (Expr is TPrimitiveExpr) then
  7425. RaiseXExpectedButYFound(20170923202003,'member variable','foreign '+GetElementTypeName(aVar),Expr);
  7426. // check type boolean
  7427. TypeEl:=aVar.VarType;
  7428. TypeEl:=ResolveAliasType(TypeEl);
  7429. if not IsBaseType(TypeEl,btBoolean,true) then
  7430. RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
  7431. [],TypeEl,BaseTypes[btBoolean],Expr);
  7432. // check class var
  7433. if (vmClass in PropEl.VarModifiers)<>(vmClass in aVar.VarModifiers) then
  7434. if vmClass in PropEl.VarModifiers then
  7435. RaiseXExpectedButYFound(20170409214351,'class var','var',Expr)
  7436. else
  7437. RaiseXExpectedButYFound(20170409214359,'var','class var',Expr);
  7438. exit;
  7439. end;
  7440. if (ResolvedEl.BaseType=btBoolean) and (ResolvedEl.ExprEl<>nil) then
  7441. begin
  7442. // try evaluating const boolean
  7443. Value:=Eval(Expr,[refConst]);
  7444. if Value<>nil then
  7445. try
  7446. if Value.Kind<>revkBool then
  7447. RaiseXExpectedButYFound(20170923200256,'boolean',GetResolverResultDescription(ResolvedEl),Expr);
  7448. exit;
  7449. finally
  7450. ReleaseEvalValue(Value);
  7451. end;
  7452. end;
  7453. RaiseXExpectedButYFound(20170923194234,'identifier',GetResolverResultDescription(ResolvedEl),Expr);
  7454. end;
  7455. var
  7456. ResultType, aType: TPasType;
  7457. MembersType: TPasMembersType;
  7458. AccEl: TPasElement;
  7459. Proc: TPasProcedure;
  7460. Arg: TPasArgument;
  7461. PropArgCount, NeedArgCnt: Integer;
  7462. PropTypeResolved, DefaultResolved, IndexResolved,
  7463. AncIndexResolved: TPasResolverResult;
  7464. m: TVariableModifier;
  7465. IndexVal: TResEvalValue;
  7466. AncIndexExpr: TPasExpr;
  7467. CurClass: TPasClassType;
  7468. begin
  7469. CheckTopScope(TPasPropertyScope);
  7470. PopScope;
  7471. if PropEl.Visibility=visPublished then
  7472. for m in PropEl.VarModifiers do
  7473. if not (m in [vmExternal]) then
  7474. RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
  7475. ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
  7476. PropType:=nil;
  7477. MembersType:=PropEl.Parent as TPasMembersType;
  7478. ClassOrRecScope:=NoNil(MembersType.CustomData) as TPasClassOrRecordScope;
  7479. ClassScope:=nil;
  7480. CurClass:=nil;
  7481. if ClassOrRecScope is TPasClassScope then
  7482. begin
  7483. ClassScope:=TPasClassScope(ClassOrRecScope);
  7484. CurClass:=TPasClassType(MembersType);
  7485. end;
  7486. AncestorProp:=nil;
  7487. GetPropType;
  7488. IndexVal:=nil;
  7489. try
  7490. if PropEl.IndexExpr<>nil then
  7491. begin
  7492. // index specifier
  7493. // -> check if simple value
  7494. IndexExpr:=PropEl.IndexExpr;
  7495. ResolveExpr(IndexExpr,rraRead);
  7496. end
  7497. else
  7498. IndexExpr:=GetPasPropertyIndex(PropEl);
  7499. if IndexExpr<>nil then
  7500. begin
  7501. ComputeElement(IndexExpr,IndexResolved,[rcConstant]);
  7502. IndexVal:=Eval(IndexExpr,[refConst]);
  7503. case IndexVal.Kind of
  7504. revkBool,
  7505. revkInt, revkUInt,
  7506. revkFloat,
  7507. revkCurrency,
  7508. {$ifdef FPC_HAS_CPSTRING}
  7509. revkString,
  7510. {$endif}
  7511. revkUnicodeString,
  7512. revkEnum: ; // ok
  7513. else
  7514. RaiseXExpectedButYFound(20170924202837,'ordinal',GetTypeDescription(IndexResolved),PropEl.IndexExpr);
  7515. end;
  7516. if (PropEl.IndexExpr<>nil) and (PropEl.VarType=nil) then
  7517. begin
  7518. // check if index is compatible to ancestor index specifier
  7519. AncIndexExpr:=GetPasPropertyIndex(AncestorProp);
  7520. if AncIndexExpr=nil then
  7521. begin
  7522. // ancestor had no index specifier
  7523. if PropEl.ReadAccessor=nil then
  7524. begin
  7525. AccEl:=GetPasPropertyGetter(AncestorProp);
  7526. if AccEl is TPasProcedure then
  7527. RaiseMsg(20171002144103,nAddingIndexSpecifierRequiresNewX,
  7528. sAddingIndexSpecifierRequiresNewX,['read'],IndexExpr);
  7529. end;
  7530. if PropEl.WriteAccessor=nil then
  7531. begin
  7532. AccEl:=GetPasPropertySetter(AncestorProp);
  7533. if AccEl is TPasProcedure then
  7534. RaiseMsg(20171002144419,nAddingIndexSpecifierRequiresNewX,
  7535. sAddingIndexSpecifierRequiresNewX,['write'],IndexExpr);
  7536. end;
  7537. if PropEl.StoredAccessor=nil then
  7538. begin
  7539. AccEl:=GetPasPropertyStoredExpr(AncestorProp);
  7540. if AccEl<>nil then
  7541. begin
  7542. ComputeElement(AccEl,AncIndexResolved,[rcNoImplicitProc]);
  7543. if AncIndexResolved.IdentEl is TPasProcedure then
  7544. RaiseMsg(20171002144644,nAddingIndexSpecifierRequiresNewX,
  7545. sAddingIndexSpecifierRequiresNewX,['stored'],IndexExpr);
  7546. end;
  7547. end;
  7548. end
  7549. else
  7550. // ancestor had already an index specifier -> check same type
  7551. CheckEqualElCompatibility(PropEl.IndexExpr,AncIndexExpr,PropEl.IndexExpr,true);
  7552. end;
  7553. end;
  7554. if PropEl.ReadAccessor<>nil then
  7555. begin
  7556. // check compatibility
  7557. AccEl:=ResolveAccessor(PropEl.ReadAccessor);
  7558. if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
  7559. begin
  7560. if (PropEl.Args.Count>0) then
  7561. RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),PropEl.ReadAccessor);
  7562. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7563. RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
  7564. [],PropType,TPasVariable(AccEl).VarType,PropEl.ReadAccessor);
  7565. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7566. if vmClass in PropEl.VarModifiers then
  7567. RaiseXExpectedButYFound(20170216151828,'class var','var',PropEl.ReadAccessor)
  7568. else
  7569. RaiseXExpectedButYFound(20170216151831,'var','class var',PropEl.ReadAccessor);
  7570. end
  7571. else if AccEl is TPasProcedure then
  7572. begin
  7573. // check function
  7574. Proc:=TPasProcedure(AccEl);
  7575. if (vmClass in PropEl.VarModifiers) then
  7576. begin
  7577. if Proc.ClassType<>TPasClassFunction then
  7578. RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
  7579. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7580. if Proc.IsStatic then
  7581. RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
  7582. else
  7583. RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
  7584. end
  7585. else
  7586. begin
  7587. if Proc.ClassType<>TPasFunction then
  7588. RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),PropEl.ReadAccessor);
  7589. end;
  7590. // check function result type
  7591. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7592. if not IsSameType(ResultType,PropType,prraAlias) then
  7593. RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
  7594. GetTypeDescription(ResultType,true),PropEl.ReadAccessor);
  7595. // check args
  7596. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  7597. NeedArgCnt:=PropEl.Args.Count;
  7598. if IndexVal<>nil then
  7599. inc(NeedArgCnt);
  7600. if Proc.ProcType.Args.Count<>NeedArgCnt then
  7601. RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7602. [Proc.Name],PropEl.ReadAccessor);
  7603. end
  7604. else
  7605. RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),PropEl.ReadAccessor);
  7606. end;
  7607. if PropEl.WriteAccessor<>nil then
  7608. begin
  7609. // check compatibility
  7610. AccEl:=ResolveAccessor(PropEl.WriteAccessor);
  7611. if (AccEl.ClassType=TPasVariable)
  7612. or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
  7613. begin
  7614. if (PropEl.Args.Count>0) then
  7615. RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),PropEl.WriteAccessor);
  7616. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7617. RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
  7618. [],PropType,TPasVariable(AccEl).VarType,PropEl.WriteAccessor);
  7619. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7620. if vmClass in PropEl.VarModifiers then
  7621. RaiseXExpectedButYFound(20170216151858,'class var','var',PropEl.WriteAccessor)
  7622. else
  7623. RaiseXExpectedButYFound(20170216151900,'var','class var',PropEl.WriteAccessor);
  7624. end
  7625. else if AccEl is TPasProcedure then
  7626. begin
  7627. // check procedure
  7628. Proc:=TPasProcedure(AccEl);
  7629. if (vmClass in PropEl.VarModifiers) then
  7630. begin
  7631. if Proc.ClassType<>TPasClassProcedure then
  7632. RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
  7633. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7634. if Proc.IsStatic then
  7635. RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
  7636. else
  7637. RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
  7638. end
  7639. else
  7640. begin
  7641. if Proc.ClassType<>TPasProcedure then
  7642. RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
  7643. end;
  7644. // check args
  7645. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  7646. // check write arg
  7647. PropArgCount:=PropEl.Args.Count;
  7648. if IndexVal<>nil then
  7649. inc(PropArgCount);
  7650. if Proc.ProcType.Args.Count<>PropArgCount+1 then
  7651. RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7652. [Proc.Name],PropEl.WriteAccessor);
  7653. Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
  7654. if not (Arg.Access in [argDefault,argConst]) then
  7655. RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7656. [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
  7657. AccessDescriptions[argConst]],PropEl.WriteAccessor);
  7658. if not IsSameType(Arg.ArgType,PropType,prraAlias) then
  7659. RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
  7660. [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
  7661. end
  7662. else
  7663. RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
  7664. end
  7665. else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
  7666. RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
  7667. if length(PropEl.Implements)>0 then
  7668. CheckImplements;
  7669. if PropEl.StoredAccessor<>nil then
  7670. begin
  7671. // check compatibility
  7672. CheckStoredAccessor(PropEl.StoredAccessor,IndexVal,IndexResolved);
  7673. end;
  7674. if PropEl.DefaultExpr<>nil then
  7675. begin
  7676. // check compatibility with type
  7677. ResolveExpr(PropEl.DefaultExpr,rraRead);
  7678. ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
  7679. ComputeElement(PropType,PropTypeResolved,[rcType]);
  7680. PropTypeResolved.IdentEl:=PropEl;
  7681. PropTypeResolved.Flags:=[rrfReadable];
  7682. CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
  7683. end;
  7684. if PropEl.IsDefault then
  7685. begin
  7686. if (CurClass<>nil) and (CurClass.HelperForType<>nil) then
  7687. begin
  7688. aType:=ResolveAliasType(CurClass.HelperForType);
  7689. if not (aType is TPasMembersType) then
  7690. RaiseMsg(20190117125004,nDefaultPropertyNotAllowedInHelperForX,
  7691. sDefaultPropertyNotAllowedInHelperForX,
  7692. [GetTypeDescription(CurClass.HelperForType)],PropEl);
  7693. end;
  7694. // set default array property
  7695. if (ClassOrRecScope.DefaultProperty<>nil)
  7696. and (ClassOrRecScope.DefaultProperty.Parent=PropEl.Parent) then
  7697. RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
  7698. ClassOrRecScope.DefaultProperty:=PropEl;
  7699. end;
  7700. EmitTypeHints(PropEl,PropEl.VarType);
  7701. finally
  7702. ReleaseEvalValue(IndexVal);
  7703. end;
  7704. end;
  7705. procedure TPasResolver.FinishArgument(El: TPasArgument);
  7706. procedure CheckHasGenTemplRef(Arg: TPasArgument);
  7707. procedure Check(Parent: TPasElement; Cur: TPasType; TemplTypes: TFPList);
  7708. var
  7709. C: TClass;
  7710. Arr: TPasArrayType;
  7711. begin
  7712. if Cur=nil then exit;
  7713. C:=Cur.ClassType;
  7714. if C=TPasGenericTemplateType then
  7715. begin
  7716. if TemplTypes.IndexOf(Cur)>=0 then
  7717. RaiseMsg(20191007213121,nParamOfThisTypeCannotHaveDefVal,sParamOfThisTypeCannotHaveDefVal,[],El);
  7718. end
  7719. else if Cur.Parent<>Parent then
  7720. exit
  7721. else if C=TPasArrayType then
  7722. begin
  7723. Arr:=TPasArrayType(Cur);
  7724. Check(Arr,Arr.ElType,TemplTypes);
  7725. end;
  7726. end;
  7727. var
  7728. Proc: TPasProcedure;
  7729. TemplTypes: TFPList;
  7730. begin
  7731. if Arg.ArgType=nil then exit;
  7732. if not (Arg.Parent is TPasProcedureType) then exit;
  7733. if not (Arg.Parent.Parent is TPasProcedure) then exit;
  7734. Proc:=TPasProcedure(Arg.Parent.Parent);
  7735. TemplTypes:=GetProcTemplateTypes(Proc);
  7736. if TemplTypes=nil then exit;
  7737. Check(Arg,Arg.ArgType,TemplTypes);
  7738. end;
  7739. var
  7740. IsDelphi: Boolean;
  7741. begin
  7742. if El.ArgType<>nil then
  7743. CheckUseAsType(El.ArgType,20190123100049,El);
  7744. if El.ValueExpr<>nil then
  7745. begin
  7746. ResolveExpr(El.ValueExpr,rraRead);
  7747. if El.ArgType<>nil then
  7748. begin
  7749. CheckAssignCompatibility(El,El.ValueExpr,true);
  7750. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  7751. if IsDelphi then
  7752. CheckHasGenTemplRef(El);
  7753. end;
  7754. end;
  7755. EmitTypeHints(El,El.ArgType);
  7756. end;
  7757. procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
  7758. // called when the ancestor and interface list of a class has been parsed,
  7759. // before parsing the class elements
  7760. var
  7761. DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
  7762. AncestorClassEl: TPasClassType;
  7763. function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
  7764. begin
  7765. Result:=SameText(c.Name,DefAncestorName)
  7766. and (c.Parent is TPasSection);
  7767. end;
  7768. procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
  7769. var
  7770. CurEl: TPasElement;
  7771. begin
  7772. AncestorClassEl:=nil;
  7773. if SameText(aClass.Name,DefAncestorName) then
  7774. begin
  7775. if IsDefaultAncestor(aClass,DefAncestorName) then exit;
  7776. RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
  7777. end;
  7778. CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false);
  7779. if not (CurEl is TPasType) then
  7780. RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
  7781. DirectAncestor:=TPasType(CurEl);
  7782. CurEl:=ResolveAliasType(DirectAncestor);
  7783. if not (CurEl is TPasClassType) then
  7784. RaiseXExpectedButYFound(20170216151941,Expected,GetElementTypeName(DirectAncestor),aClass);
  7785. AncestorClassEl:=TPasClassType(CurEl);
  7786. end;
  7787. var
  7788. ClassScope, AncestorClassScope: TPasClassScope;
  7789. AncestorType, El: TPasType;
  7790. i: Integer;
  7791. aModifier, DefAncestorName: String;
  7792. IsSealed, IsDelphi: Boolean;
  7793. CanonicalSelf: TPasClassOfType;
  7794. Decl: TPasElement;
  7795. j, TypeParamCnt: integer;
  7796. IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
  7797. ResIntfList, Members: TFPList;
  7798. GroupScope: TPasGroupScope;
  7799. C: TClass;
  7800. begin
  7801. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  7802. if aClass.IsForward then
  7803. begin
  7804. PopGenericParamScope(aClass);
  7805. // check for duplicate forwards
  7806. C:=aClass.Parent.ClassType;
  7807. if C.InheritsFrom(TPasDeclarations) then
  7808. Members:=TPasDeclarations(aClass.Parent).Declarations
  7809. else if (C=TPasClassType) or (C=TPasRecordType) then
  7810. Members:=TPasMembersType(aClass.Parent).Members
  7811. else
  7812. RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
  7813. TypeParamCnt:=GetTypeParameterCount(aClass);
  7814. for i:=0 to Members.Count-1 do
  7815. begin
  7816. Decl:=TPasElement(Members[i]);
  7817. if (CompareText(Decl.Name,aClass.Name)<>0)
  7818. or (Decl=aClass) then continue;
  7819. if (Decl is TPasGenericType)
  7820. and (GetTypeParameterCount(TPasGenericType(Decl))<>TypeParamCnt) then
  7821. continue;
  7822. RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
  7823. [Decl.Name,GetElementSourcePosStr(Decl)],aClass);
  7824. end;
  7825. if TypeParamCnt>0 then
  7826. begin
  7827. // A generic forward needs TPasClassScope to store the specialized types.
  7828. // Will later be transferred to the actual class.
  7829. CreateScope(aClass,ScopeClass_Class);
  7830. end;
  7831. exit;
  7832. end;
  7833. // not forward, actual declaration ...
  7834. case aClass.ObjKind of
  7835. okClass:
  7836. begin
  7837. AncestorType:=ResolveAliasType(aClass.AncestorType);
  7838. if (AncestorType is TPasClassType)
  7839. and (TPasClassType(AncestorType).ObjKind=okInterface)
  7840. and not isDelphi then
  7841. begin
  7842. // e.g. type c = class(intf)
  7843. // ObjFPC allows to omit TObject as default ancestor, Delphi does not
  7844. aClass.Interfaces.Insert(0,aClass.AncestorType);
  7845. aClass.AncestorType:=nil;
  7846. end;
  7847. end;
  7848. okInterface:
  7849. begin
  7850. if aClass.IsExternal then
  7851. RaiseMsg(20180321115831,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  7852. if not (aClass.InterfaceType in [citCom,citCorba]) then
  7853. RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
  7854. [CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
  7855. end;
  7856. okClassHelper,okRecordHelper,okTypeHelper:
  7857. begin
  7858. if aClass.IsExternal then
  7859. RaiseMsg(20190116192722,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  7860. HelperForType:=ResolveAliasType(aClass.HelperForType);
  7861. if (aClass=HelperForType) or (aClass.HasParent(HelperForType)) then
  7862. RaiseMsg(20190118190935,nTypeXIsNotYetCompletelyDefined,
  7863. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7864. case aClass.ObjKind of
  7865. okClassHelper:
  7866. begin
  7867. if not (HelperForType is TPasClassType) then
  7868. RaiseXExpectedButYFound(20190116194751,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  7869. if TPasClassType(HelperForType).ObjKind<>okClass then
  7870. RaiseXExpectedButYFound(20190116194855,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  7871. if TPasClassType(HelperForType).IsForward then
  7872. RaiseMsg(20190116194931,nTypeXIsNotYetCompletelyDefined,
  7873. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7874. end;
  7875. okRecordHelper:
  7876. if isDelphi then
  7877. begin
  7878. if (HelperForType.ClassType=TPasRecordType)
  7879. or (HelperForType.ClassType=TPasArrayType)
  7880. or (HelperForType.ClassType=TPasSetType)
  7881. or (HelperForType.ClassType=TPasEnumType)
  7882. or (HelperForType.ClassType=TPasRangeType)
  7883. then
  7884. // ok
  7885. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  7886. and (HelperForType.CustomData is TResElDataBaseType)) then
  7887. else
  7888. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByARecordHelper,
  7889. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  7890. end
  7891. else
  7892. begin
  7893. // mode objfpc
  7894. if (HelperForType.ClassType=TPasRecordType) then
  7895. else
  7896. RaiseMsg(20190116200519,nTypeXCannotBeExtendedByARecordHelper,
  7897. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  7898. end;
  7899. okTypeHelper:
  7900. begin
  7901. if (HelperForType.ClassType=TPasRecordType)
  7902. or (HelperForType.ClassType=TPasArrayType)
  7903. or (HelperForType.ClassType=TPasSetType)
  7904. or (HelperForType.ClassType=TPasEnumType)
  7905. or (HelperForType.ClassType=TPasRangeType)
  7906. then
  7907. // ok
  7908. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  7909. and (HelperForType.CustomData is TResElDataBaseType)) then
  7910. else if (HelperForType.ClassType=TPasClassType)
  7911. and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
  7912. begin
  7913. if TPasClassType(HelperForType).IsForward then
  7914. RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
  7915. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7916. end
  7917. else
  7918. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
  7919. sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass);
  7920. end;
  7921. end;
  7922. end
  7923. else
  7924. RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
  7925. end;
  7926. IsSealed:=false;
  7927. for i:=0 to aClass.Modifiers.Count-1 do
  7928. begin
  7929. aModifier:=lowercase(aClass.Modifiers[i]);
  7930. case aModifier of
  7931. 'sealed': IsSealed:=true;
  7932. 'abstract': ;
  7933. else
  7934. RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
  7935. end;
  7936. end;
  7937. AncestorClassEl:=nil;
  7938. DirectAncestor:=aClass.AncestorType;
  7939. AncestorType:=ResolveAliasType(DirectAncestor);
  7940. if AncestorType=nil then
  7941. begin
  7942. if DirectAncestor<>nil then
  7943. RaiseInternalError(20180321151851,GetObjName(DirectAncestor));
  7944. // use default ancestor
  7945. DefAncestorName:='';
  7946. case aClass.ObjKind of
  7947. okClass:
  7948. begin
  7949. DefAncestorName:='TObject';
  7950. if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
  7951. begin
  7952. // ok, no ancestor
  7953. AncestorClassEl:=nil;
  7954. end
  7955. else
  7956. begin
  7957. // search default ancestor TObject
  7958. FindDefaultAncestor(DefAncestorName,'class type');
  7959. if TPasClassType(AncestorClassEl).ObjKind<>okClass then
  7960. RaiseXExpectedButYFound(20180321145626,'class type',GetElementTypeName(AncestorClassEl),aClass);
  7961. end;
  7962. end;
  7963. okInterface:
  7964. begin
  7965. if aClass.InterfaceType=citCom then
  7966. begin
  7967. if isDelphi then
  7968. DefAncestorName:='IInterface'
  7969. else
  7970. DefAncestorName:='IUnknown';
  7971. if IsDefaultAncestor(aClass,DefAncestorName) then
  7972. AncestorClassEl:=nil
  7973. else
  7974. begin
  7975. // search default ancestor interface
  7976. FindDefaultAncestor(DefAncestorName,'interface type');
  7977. if TPasClassType(AncestorClassEl).ObjKind<>okInterface then
  7978. RaiseXExpectedButYFound(20180321145725,'interface type',
  7979. GetElementTypeName(AncestorClassEl),aClass);
  7980. end;
  7981. end;
  7982. end;
  7983. okClassHelper,okRecordHelper,okTypeHelper: ; // no root ancestor
  7984. end;
  7985. end
  7986. else if AncestorType.ClassType<>TPasClassType then
  7987. RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
  7988. else if aClass=AncestorType then
  7989. RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
  7990. else
  7991. begin
  7992. AncestorClassEl:=TPasClassType(AncestorType);
  7993. if AncestorClassEl.ObjKind<>aClass.ObjKind then
  7994. RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
  7995. GetElementTypeName(AncestorClassEl)+' type',aClass);
  7996. if aClass.ObjKind in okAllHelpers then
  7997. begin
  7998. HelperForType:=ResolveAliasType(aClass.HelperForType);
  7999. AncestorHelperFor:=ResolveAliasType(AncestorClassEl.HelperForType);
  8000. if IsSameType(HelperForType,AncestorHelperFor,prraNone) then
  8001. // helper for same type as ancestor helper -> ok
  8002. else if (HelperForType is TPasClassType)
  8003. and (AncestorHelperFor is TPasClassType)
  8004. and (CheckClassIsClass(HelperForType,AncestorHelperFor)<>cIncompatible) then
  8005. // helper for descendant class of ancestor helper for -> ok
  8006. else
  8007. RaiseMsg(20190116203931,nDerivedXMustExtendASubClassY,sDerivedXMustExtendASubClassY,
  8008. [GetElementTypeName(aClass),AncestorClassEl.HelperForType.Name],aClass);
  8009. end;
  8010. EmitTypeHints(aClass,AncestorClassEl);
  8011. end;
  8012. AncestorClassScope:=nil;
  8013. if AncestorClassEl=nil then
  8014. begin
  8015. // root class e.g. TObject, IUnknown, helper
  8016. end
  8017. else
  8018. begin
  8019. // inherited class
  8020. if AncestorClassEl.IsForward then
  8021. RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
  8022. sCantUseForwardDeclarationAsAncestor,[AncestorClassEl.Name],aClass);
  8023. if aClass.IsExternal and not AncestorClassEl.IsExternal then
  8024. RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
  8025. [AncestorClassEl.Name],aClass);
  8026. AncestorClassScope:=AncestorClassEl.CustomData as TPasClassScope;
  8027. if pcsfSealed in AncestorClassScope.Flags then
  8028. RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedXY,
  8029. sCannotCreateADescendantOfTheSealedXY,
  8030. [GetElementTypeName(AncestorClassEl),AncestorClassEl.Name],aClass);
  8031. // check for cycle
  8032. El:=AncestorClassEl;
  8033. repeat
  8034. if El=aClass then
  8035. RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
  8036. if (El.ClassType=TPasAliasType)
  8037. or (El.ClassType=TPasTypeAliasType)
  8038. or (El.ClassType=TPasSpecializeType)
  8039. then
  8040. El:=TPasAliasType(El).DestType
  8041. else if El.ClassType=TPasClassType then
  8042. El:=TPasClassType(El).AncestorType
  8043. else
  8044. RaiseNotYetImplemented(20190825195203,aClass,GetObjName(El));
  8045. until El=nil;
  8046. end;
  8047. if TopScope is TPasGenericParamsScope then
  8048. PopGenericParamScope(aClass);
  8049. // start scope for members
  8050. {$IFDEF VerbosePasResolver}
  8051. //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
  8052. {$ENDIF}
  8053. if aClass.CustomData=nil then
  8054. ClassScope:=TPasClassScope(CreateScope(aClass,ScopeClass_Class))
  8055. else
  8056. begin
  8057. // has already the scope, e.g. scope moved from a generic forward
  8058. ClassScope:=aClass.CustomData as TPasClassScope;
  8059. if pcsfAncestorResolved in ClassScope.Flags then
  8060. RaiseNotYetImplemented(20190803203715,aClass);
  8061. end;
  8062. Include(ClassScope.Flags,pcsfAncestorResolved);
  8063. if IsSealed then
  8064. Include(ClassScope.Flags,pcsfSealed);
  8065. AddGenericTemplateIdentifiers(aClass.GenericTemplateTypes,ClassScope);
  8066. ClassScope.DirectAncestor:=DirectAncestor;
  8067. if AncestorClassEl<>nil then
  8068. begin
  8069. ClassScope.AncestorScope:=AncestorClassScope;
  8070. ClassScope.DefaultProperty:=AncestorClassScope.DefaultProperty;
  8071. if pcsfPublished in AncestorClassScope.Flags then
  8072. Include(ClassScope.Flags,pcsfPublished);
  8073. ClassScope.AbstractProcs:=copy(AncestorClassScope.AbstractProcs);
  8074. end;
  8075. if bsTypeInfo in CurrentParser.Scanner.CurrentBoolSwitches then
  8076. Include(ClassScope.Flags,pcsfPublished);
  8077. if aClass.ObjKind in ([okClass]+okAllHelpers) then
  8078. begin
  8079. // create canonical class-of for the "Self" in non static class functions
  8080. CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
  8081. ClassScope.CanonicalClassOf:=CanonicalSelf;
  8082. {$IFDEF CheckPasTreeRefCount}CanonicalSelf.RefIds.Add('TPasClassScope.CanonicalClassOf');{$ENDIF}
  8083. CanonicalSelf.DestType:=aClass;
  8084. aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
  8085. CanonicalSelf.Visibility:=visStrictPrivate;
  8086. CanonicalSelf.SourceFilename:=aClass.SourceFilename;
  8087. CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
  8088. end;
  8089. // push scope (must be done after setting aClass.AncestorScope)
  8090. GroupScope:=PushGroupScope(aClass);
  8091. GroupScope.VisibilityContext:=aClass;
  8092. // check interfaces
  8093. if aClass.Interfaces.Count>0 then
  8094. begin
  8095. if not (aClass.ObjKind in [okClass]) then
  8096. RaiseXExpectedButYFound(20180322001341,'one ancestor',
  8097. IntToStr(1+aClass.Interfaces.Count),aClass);
  8098. if aClass.IsExternal then
  8099. RaiseMsg(20180324183641,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8100. ResIntfList:=TFPList.Create;
  8101. try
  8102. for i:=0 to aClass.Interfaces.Count-1 do
  8103. begin
  8104. IntfType:=TPasType(aClass.Interfaces[i]);
  8105. IntfTypeRes:=ResolveAliasType(IntfType);
  8106. if IntfTypeRes=nil then
  8107. RaiseMsg(20180322140044,nCantUseForwardDeclarationAsAncestor,
  8108. sCantUseForwardDeclarationAsAncestor,[IntfType.Name],aClass);
  8109. if not (IntfTypeRes is TPasClassType) then
  8110. RaiseXExpectedButYFound(20180322001051,'interface type',
  8111. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8112. if TPasClassType(IntfTypeRes).ObjKind<>okInterface then
  8113. RaiseXExpectedButYFound(20180322001143,'interface type',
  8114. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8115. j:=ResIntfList.IndexOf(IntfTypeRes);
  8116. if j>=0 then
  8117. RaiseMsg(20180322001505,nDuplicateIdentifier,sDuplicateIdentifier,
  8118. [IntfType.Name,IntToStr(j+1)],aClass); // todo: jump to interface list
  8119. ResIntfList.Add(IntfTypeRes);
  8120. end;
  8121. finally
  8122. ResIntfList.Free;
  8123. end;
  8124. // create interfaces maps
  8125. ClassScope.Interfaces:=TFPList.Create;
  8126. ClassScope.Interfaces.Count:=aClass.Interfaces.Count;
  8127. end;
  8128. end;
  8129. procedure TPasResolver.FinishMethodResolution(El: TPasMethodResolution);
  8130. var
  8131. ResolvedEl: TPasResolverResult;
  8132. aClass, IntfType: TPasClassType;
  8133. i: Integer;
  8134. IntfProc: TPasProcedure;
  8135. Expr: TPasExpr;
  8136. ProcName: String;
  8137. IntfScope: TPasClassScope;
  8138. Identifier: TPasIdentifier;
  8139. begin
  8140. // procedure InterfaceName.InterfaceProc = ...
  8141. // check InterfaceName
  8142. ResolveExpr(El.InterfaceName,rraRead);
  8143. ComputeElement(El.InterfaceName,ResolvedEl,[rcType,rcNoImplicitProc]);
  8144. if not (ResolvedEl.IdentEl is TPasType) then
  8145. RaiseXExpectedButYFound(20180323132601,'interface type',
  8146. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8147. aClass:=El.Parent as TPasClassType;
  8148. i:=IndexOfImplementedInterface(aClass,TPasType(ResolvedEl.IdentEl));
  8149. if i<0 then
  8150. RaiseXExpectedButYFound(20180323133055,'interface type',
  8151. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8152. IntfType:=TPasClassType(ResolveAliasType(TPasClassType(aClass.Interfaces[i])));
  8153. // check InterfaceProc
  8154. Expr:=El.InterfaceProc;
  8155. if not (Expr is TPrimitiveExpr) then
  8156. RaiseXExpectedButYFound(20180327152808,'method name',GetElementTypeName(Expr),Expr);
  8157. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  8158. RaiseXExpectedButYFound(20180327152841,'method name',GetElementTypeName(Expr),Expr);
  8159. ProcName:=TPrimitiveExpr(Expr).Value;
  8160. IntfScope:=IntfType.CustomData as TPasClassScope;
  8161. IntfProc:=nil;
  8162. while IntfScope<>nil do
  8163. begin
  8164. Identifier:=IntfScope.FindLocalIdentifier(ProcName);
  8165. while Identifier<>nil do
  8166. begin
  8167. if not (Identifier.Element is TPasProcedure) then
  8168. RaiseXExpectedButYFound(20180327153110,'interface method',GetElementTypeName(Identifier.Element),Expr);
  8169. IntfProc:=TPasProcedure(Identifier.Element);
  8170. if IntfProc.ClassType=El.ProcClass then
  8171. break;
  8172. Identifier:=Identifier.NextSameIdentifier;
  8173. end;
  8174. IntfScope:=IntfScope.AncestorScope;
  8175. end;
  8176. if IntfProc=nil then
  8177. RaiseIdentifierNotFound(20180327153044,ProcName,Expr);
  8178. CreateReference(IntfProc,Expr,rraRead);
  8179. if IntfProc.ClassType<>El.ProcClass then
  8180. RaiseXExpectedButYFound(20180323144107,GetElementTypeName(El.ProcClass),GetElementTypeName(IntfProc),El.InterfaceProc);
  8181. // Note: do not create map here. CheckImplements in FinishProperty must be called before.
  8182. // El.ImplementationProc is resolved in FinishClassType
  8183. end;
  8184. procedure TPasResolver.FinishAttributes(El: TPasAttributes);
  8185. var
  8186. i, j: Integer;
  8187. NameExpr, Expr: TPasExpr;
  8188. Bin: TBinaryExpr;
  8189. LeftResolved, ParamResolved: TPasResolverResult;
  8190. aModule: TPasModule;
  8191. LTypeEl: TPasType;
  8192. AttrName: String;
  8193. Data: TPRFindData;
  8194. CurEl, DeclEl: TPasElement;
  8195. ClassEl: TPasClassType;
  8196. aConstructor: TPasConstructor;
  8197. Args: TFPList;
  8198. AttrRef, ParamRef: TResolvedReference;
  8199. DotScope: TPasDotBaseScope;
  8200. Params: TPasExprArray;
  8201. begin
  8202. for i:=0 to length(El.Calls)-1 do
  8203. begin
  8204. NameExpr:=El.Calls[i];
  8205. {$IFDEF VerbosePasResolver}
  8206. //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
  8207. {$ENDIF}
  8208. if NameExpr is TParamsExpr then
  8209. NameExpr:=TParamsExpr(NameExpr).Value;
  8210. DotScope:=nil;
  8211. if NameExpr is TBinaryExpr then
  8212. begin
  8213. Bin:=TBinaryExpr(NameExpr);
  8214. ResolveExpr(Bin.left,rraRead);
  8215. ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
  8216. if LeftResolved.BaseType=btModule then
  8217. begin
  8218. // e.g. unitname.identifier
  8219. // => search in interface and if this is our module in the implementation
  8220. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  8221. DotScope:=PushModuleDotScope(aModule);
  8222. end
  8223. else if (LeftResolved.BaseType=btContext)
  8224. and (LeftResolved.IdentEl is TPasType)
  8225. and (LeftResolved.LoTypeEl is TPasMembersType) then
  8226. begin
  8227. // classtype.identifier or recordtype.identifier
  8228. LTypeEl:=LeftResolved.LoTypeEl;
  8229. if LTypeEl.ClassType=TPasClassType then
  8230. begin
  8231. DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
  8232. DotScope.OnlyTypeMembers:=true;
  8233. end
  8234. else if LTypeEl.ClassType=TPasRecordType then
  8235. begin
  8236. DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
  8237. DotScope.OnlyTypeMembers:=true;
  8238. end
  8239. else
  8240. RaiseNotYetImplemented(20190221124930,Bin);
  8241. end
  8242. else
  8243. RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
  8244. ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
  8245. NameExpr:=Bin.right;
  8246. end;
  8247. // find attribute class
  8248. if not IsNameExpr(NameExpr) then
  8249. RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
  8250. ['identifier',GetElementTypeName(Bin)],NameExpr);
  8251. AttrName:=TPrimitiveExpr(NameExpr).Value;
  8252. CurEl:=nil;
  8253. if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
  8254. begin
  8255. // first search AttrName+'Attibute'
  8256. CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
  8257. end;
  8258. // then search the name
  8259. if CurEl=nil then
  8260. CurEl:=FindFirstEl(AttrName,Data,NameExpr);
  8261. if DotScope<>nil then
  8262. PopScope;
  8263. {$IFDEF VerbosePasResolver}
  8264. writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
  8265. {$ENDIF}
  8266. // check if found element is a TCustomAttribute
  8267. if CurEl=nil then
  8268. begin
  8269. LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
  8270. [AttrName],NameExpr);
  8271. continue;
  8272. end;
  8273. if not IsCustomAttribute(CurEl) then
  8274. RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8275. [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
  8276. ClassEl:=TPasClassType(CurEl);
  8277. AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
  8278. if ClassEl.IsAbstract then
  8279. // Delphi silently skips attributes using abstract classes/methods
  8280. LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8281. sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
  8282. // search constructor "Create" using the params
  8283. DotScope:=PushClassDotScope(ClassEl);
  8284. DotScope.OnlyTypeMembers:=true;
  8285. Expr:=El.Calls[i];
  8286. if Expr is TParamsExpr then
  8287. begin
  8288. // attribute with params
  8289. if Expr.Kind<>pekFuncParams then
  8290. begin
  8291. {$IFDEF VerbosePasResolver}
  8292. writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
  8293. {$ENDIF}
  8294. RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
  8295. ['(','['],Expr);
  8296. end;
  8297. // first resolve params
  8298. ResolveParamsExprParams(TParamsExpr(Expr));
  8299. // then resolve call 'Create'
  8300. ResolveFuncParamsExprName(Expr,nil,TParamsExpr(Expr),rraRead,'Create');
  8301. // then check that each parameter is a constant expression
  8302. Params:=TParamsExpr(Expr).Params;
  8303. for j:=0 to length(Params)-1 do
  8304. ComputeElement(Params[j],ParamResolved,[rcConstant]);
  8305. // check if call is constructor
  8306. ParamRef:=Expr.CustomData as TResolvedReference;
  8307. DeclEl:=ParamRef.Declaration;
  8308. if DeclEl.ClassType<>TPasConstructor then
  8309. RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
  8310. aConstructor:=TPasConstructor(DeclEl);
  8311. end
  8312. else
  8313. begin
  8314. // attribute without params
  8315. // -> resolve call 'Create'
  8316. DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false);
  8317. if DeclEl=nil then
  8318. RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
  8319. // check call is constructor
  8320. if DeclEl.ClassType<>TPasConstructor then
  8321. RaiseXExpectedButYFound(20190221145003,'constructor Create',
  8322. GetElementTypeName(DeclEl),NameExpr);
  8323. aConstructor:=TPasConstructor(DeclEl);
  8324. // check constructor without needed args
  8325. Args:=aConstructor.ProcType.Args;
  8326. if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
  8327. RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
  8328. sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
  8329. end;
  8330. if aConstructor.IsAbstract then
  8331. LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8332. sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
  8333. // store reference to constructor in NameExpr
  8334. if AttrRef.Context<>nil then
  8335. RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
  8336. AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
  8337. TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
  8338. PopScope;
  8339. end;
  8340. end;
  8341. procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
  8342. Params: TParamsExpr);
  8343. var
  8344. ParamAccess: TResolvedRefAccess;
  8345. i: Integer;
  8346. ArrParams: TPasExprArray;
  8347. begin
  8348. ArrParams:=Params.Params;
  8349. for i:=0 to length(ArrParams)-1 do
  8350. begin
  8351. ParamAccess:=rraRead;
  8352. if i<ProcType.Args.Count then
  8353. case TPasArgument(ProcType.Args[i]).Access of
  8354. argVar: ParamAccess:=rraVarParam;
  8355. argOut: ParamAccess:=rraOutParam;
  8356. end;
  8357. AccessExpr(ArrParams[i],ParamAccess);
  8358. end;
  8359. CheckCallProcCompatibility(ProcType,Params,false,true);
  8360. end;
  8361. procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
  8362. Prop: TPasProperty);
  8363. var
  8364. i: Integer;
  8365. ParamAccess: TResolvedRefAccess;
  8366. begin
  8367. for i:=0 to length(Params.Params)-1 do
  8368. begin
  8369. ParamAccess:=rraRead;
  8370. if i<Prop.Args.Count then
  8371. case TPasArgument(Prop.Args[i]).Access of
  8372. argVar: ParamAccess:=rraVarParam;
  8373. argOut: ParamAccess:=rraOutParam;
  8374. end;
  8375. AccessExpr(Params.Params[i],ParamAccess);
  8376. end;
  8377. end;
  8378. procedure TPasResolver.FinishCallArgAccess(Expr: TPasExpr;
  8379. Access: TResolvedRefAccess);
  8380. var
  8381. ResolvedEl: TPasResolverResult;
  8382. Flags: TPasResolverComputeFlags;
  8383. begin
  8384. AccessExpr(Expr,Access);
  8385. Flags:=[rcSetReferenceFlags];
  8386. if Access<>rraRead then
  8387. Include(Flags,rcNoImplicitProc);
  8388. ComputeElement(Expr,ResolvedEl,Flags);
  8389. end;
  8390. procedure TPasResolver.FinishInitialFinalization(El: TPasImplBlock);
  8391. begin
  8392. if El=nil then ;
  8393. CheckTopScope(ScopeClass_InitialFinalization);
  8394. PopScope;
  8395. end;
  8396. procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
  8397. begin
  8398. while aType<>nil do
  8399. begin
  8400. if EmitElementHints(PosEl,aType) then
  8401. exit; // give only hints for the nearest
  8402. if aType.InheritsFrom(TPasAliasType) then
  8403. aType:=TPasAliasType(aType).DestType
  8404. else if aType.ClassType=TPasPointerType then
  8405. aType:=TPasPointerType(aType).DestType
  8406. else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
  8407. and (aType.CustomData is TResolvedReference) then
  8408. aType:=TPasType(TResolvedReference(aType.CustomData).Declaration)
  8409. else
  8410. exit;
  8411. end;
  8412. end;
  8413. function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
  8414. begin
  8415. if IsElementSkipped(El) then
  8416. RaiseNotYetImplemented(20170927160030,PosEl,GetObjName(El));
  8417. if El.Hints=[] then exit(false);
  8418. Result:=true;
  8419. if hDeprecated in El.Hints then
  8420. begin
  8421. if El.HintMessage<>'' then
  8422. LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
  8423. [El.Name,El.HintMessage],PosEl)
  8424. else
  8425. LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
  8426. [El.Name],PosEl);
  8427. end;
  8428. if hLibrary in El.Hints then
  8429. LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
  8430. [El.Name],PosEl);
  8431. if hPlatform in El.Hints then
  8432. LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
  8433. [El.Name],PosEl);
  8434. if hExperimental in El.Hints then
  8435. LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
  8436. [El.Name],PosEl);
  8437. if hUnimplemented in El.Hints then
  8438. LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
  8439. [El.Name],PosEl);
  8440. end;
  8441. procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  8442. var
  8443. ModScope: TPasModuleScope;
  8444. begin
  8445. if ppsfIsSpecialized in ProcScope.Flags then exit;
  8446. ProcScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  8447. if bsRangeChecks in ProcScope.BoolSwitches then
  8448. begin
  8449. ModScope:=RootElement.CustomData as TPasModuleScope;
  8450. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  8451. end;
  8452. end;
  8453. procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
  8454. ImplProcScope: TPasProcedureScope);
  8455. var
  8456. DeclProc, ImplProc: TPasProcedure;
  8457. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8458. i, j: Integer;
  8459. DeclArg, ImplArg: TPasArgument;
  8460. Identifier: TPasIdentifier;
  8461. ImplNameParts: TProcedureNameParts;
  8462. ImplNamePart: TProcedureNamePart;
  8463. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8464. begin
  8465. ImplProc:=ImplProcScope.Element as TPasProcedure;
  8466. DeclProc:=ImplProcScope.DeclarationProc;
  8467. // redirect impl generic template types with declaration types
  8468. ImplNameParts:=ImplProc.NameParts;
  8469. if ImplNameParts<>nil then
  8470. begin
  8471. // For example: "procedure TA<T>.Fly<U>;"
  8472. // The generic type templates (e.g. "T") are in the class
  8473. // -> remove generic type templates from proc scope
  8474. for i:=0 to ImplNameParts.Count-2 do
  8475. begin
  8476. ImplNamePart:=TProcedureNamePart(ImplNameParts[i]);
  8477. ImplTemplates:=ImplNamePart.Templates;
  8478. if ImplTemplates=nil then continue;
  8479. for j:=0 to ImplTemplates.Count-1 do
  8480. begin
  8481. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[j]);
  8482. ImplProcScope.RemoveLocalIdentifier(ImplTemplType);
  8483. end;
  8484. end;
  8485. // redirect implproc parameters to declproc parameters
  8486. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8487. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8488. if ImplTemplates<>nil then
  8489. begin
  8490. if (DeclTemplates=nil) or (ImplTemplates.Count<>DeclTemplates.Count) then
  8491. RaiseNotYetImplemented(20190912153602,ImplProc); // inconsistency
  8492. for i:=0 to ImplTemplates.Count-1 do
  8493. begin
  8494. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8495. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8496. Identifier:=ImplProcScope.FindLocalIdentifier(ImplTemplType.Name);
  8497. if Identifier.Element<>ImplTemplType then
  8498. RaiseInternalError(20190912154009,GetObjName(DeclTemplType)+' '+GetObjName(ImplTemplType));
  8499. Identifier.Element:=DeclTemplType;
  8500. Identifier.Identifier:=DeclTemplType.Name;
  8501. end;
  8502. end
  8503. else if DeclTemplates<>nil then
  8504. // declproc is parametrized, implproc is not
  8505. RaiseNotYetImplemented(20190912153439,ImplProc); // inconsistency
  8506. end;
  8507. // redirect impl arguments to declaration args
  8508. ImplArgs:=ImplProc.ProcType.Args;
  8509. DeclArgs:=DeclProc.ProcType.Args;
  8510. for i:=0 to DeclArgs.Count-1 do
  8511. begin
  8512. DeclArg:=TPasArgument(DeclArgs[i]);
  8513. if i<ImplArgs.Count then
  8514. begin
  8515. ImplArg:=TPasArgument(ImplArgs[i]);
  8516. Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
  8517. //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
  8518. if Identifier.Element<>ImplArg then
  8519. RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
  8520. Identifier.Element:=DeclArg;
  8521. Identifier.Identifier:=DeclArg.Name;
  8522. end
  8523. else
  8524. RaiseNotYetImplemented(20170203161826,ImplProc);
  8525. end;
  8526. if DeclProc.ProcType is TPasFunctionType then
  8527. begin
  8528. // redirect implementation 'Result' to declaration FuncType.ResultEl
  8529. Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
  8530. if Identifier.Element is TPasResultElement then
  8531. Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
  8532. end;
  8533. end;
  8534. function TPasResolver.CreateClassIntfMap(El: TPasClassType; Index: integer
  8535. ): TPasClassIntfMap;
  8536. var
  8537. IntfType: TPasClassType;
  8538. Map: TPasClassIntfMap;
  8539. ClassScope: TPasClassScope;
  8540. begin
  8541. ClassScope:=El.CustomData as TPasClassScope;
  8542. if ClassScope.Interfaces[Index]<>nil then
  8543. RaiseInternalError(20180322141916,GetElementDbgPath(El)+' '+IntToStr(Index)+' '+GetObjName(TObject(ClassScope.Interfaces[Index])));
  8544. IntfType:=TPasClassType(ResolveAliasType(TPasType(El.Interfaces[Index])));
  8545. Map:=nil;
  8546. while IntfType<>nil do
  8547. begin
  8548. if Map=nil then
  8549. begin
  8550. Map:=TPasClassIntfMap.Create;
  8551. Map.Element:=El;
  8552. Result:=Map;
  8553. ClassScope.Interfaces[Index]:=Map;
  8554. end
  8555. else
  8556. begin
  8557. Map.AncestorMap:=TPasClassIntfMap.Create;
  8558. Map:=Map.AncestorMap;
  8559. Map.Element:=El;
  8560. end;
  8561. Map.Intf:=IntfType;
  8562. Map.Procs:=TFPList.Create;
  8563. Map.Procs.Count:=IntfType.Members.Count;
  8564. IntfType:=GetPasClassAncestor(IntfType,true) as TPasClassType;
  8565. end;
  8566. end;
  8567. procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
  8568. const ResolvedEl: TPasResolverResult);
  8569. begin
  8570. if ResolvedEl.BaseType=btBoolean then exit;
  8571. if IsGenericTemplType(ResolvedEl) then exit;
  8572. RaiseXExpectedButYFound(20170216152135,
  8573. BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
  8574. end;
  8575. procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
  8576. ImplProc: TPasProcedure; IsOverride: boolean);
  8577. var
  8578. i: Integer;
  8579. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8580. DeclName, ImplName: String;
  8581. ImplResult, DeclResult: TPasType;
  8582. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8583. begin
  8584. if ImplProc.ClassType<>DeclProc.ClassType then
  8585. RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
  8586. if ImplProc.CallingConvention<>DeclProc.CallingConvention then
  8587. RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
  8588. DeclArgs:=DeclProc.ProcType.Args;
  8589. ImplArgs:=ImplProc.ProcType.Args;
  8590. if DeclArgs.Count<>ImplArgs.Count then
  8591. RaiseNotYetImplemented(20190912110642,ImplProc);
  8592. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8593. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8594. if DeclTemplates<>nil then
  8595. begin
  8596. // DeclProc has templates
  8597. if IsOverride then
  8598. RaiseNotYetImplemented(20190912113857,ImplProc); // inconsistency
  8599. if ImplTemplates=nil then
  8600. RaiseMsg(20190912144529,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8601. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8602. // declaration proc has template type aka is parametrized
  8603. // -> check template types
  8604. if ImplTemplates.Count<>DeclTemplates.Count then
  8605. RaiseMsg(20190912145320,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8606. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplates[0]))],ImplProc);
  8607. for i:=0 to DeclTemplates.Count-1 do
  8608. begin
  8609. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8610. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8611. if not SameText(DeclTemplType.Name,ImplTemplType.Name) then
  8612. RaiseMsg(20190912150311,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8613. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplType))],ImplTemplType);
  8614. if length(ImplTemplType.Constraints)>0 then
  8615. RaiseMsg(20190912150739,nImplMustNotRepeatConstraints,sImplMustNotRepeatConstraints,[],ImplTemplType);
  8616. end;
  8617. end
  8618. else if ImplTemplates<>nil then
  8619. begin
  8620. // ImplProc has templates, DeclProc does not
  8621. RaiseMsg(20190912113857,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8622. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8623. end;
  8624. if not IsOverride then
  8625. begin
  8626. // check argument names
  8627. for i:=0 to DeclArgs.Count-1 do
  8628. begin
  8629. DeclName:=TPasArgument(DeclArgs[i]).Name;
  8630. ImplName:=TPasArgument(ImplArgs[i]).Name;
  8631. if CompareText(DeclName,ImplName)<>0 then
  8632. RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
  8633. sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
  8634. end;
  8635. end;
  8636. if ImplProc.ProcType is TPasFunctionType then
  8637. begin
  8638. // check result type
  8639. ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
  8640. DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
  8641. if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
  8642. RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
  8643. [],DeclResult,ImplResult,ImplProc);
  8644. end;
  8645. end;
  8646. procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
  8647. var
  8648. i: Integer;
  8649. begin
  8650. if Block=nil then exit;
  8651. for i:=0 to Block.Elements.Count-1 do
  8652. ResolveImplElement(TPasImplElement(Block.Elements[i]));
  8653. end;
  8654. procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
  8655. var
  8656. C: TClass;
  8657. begin
  8658. //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
  8659. if El=nil then exit;
  8660. C:=El.ClassType;
  8661. if C=TPasImplBeginBlock then
  8662. ResolveImplBlock(TPasImplBeginBlock(El))
  8663. else if C=TPasImplAssign then
  8664. ResolveImplAssign(TPasImplAssign(El))
  8665. else if C=TPasImplSimple then
  8666. ResolveImplSimple(TPasImplSimple(El))
  8667. else if C=TPasImplBlock then
  8668. ResolveImplBlock(TPasImplBlock(El))
  8669. else if C=TPasImplRepeatUntil then
  8670. begin
  8671. ResolveImplBlock(TPasImplBlock(El));
  8672. ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
  8673. end
  8674. else if C=TPasImplIfElse then
  8675. begin
  8676. ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
  8677. ResolveImplElement(TPasImplIfElse(El).IfBranch);
  8678. ResolveImplElement(TPasImplIfElse(El).ElseBranch);
  8679. end
  8680. else if C=TPasImplWhileDo then
  8681. begin
  8682. ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
  8683. ResolveImplElement(TPasImplWhileDo(El).Body);
  8684. end
  8685. else if C=TPasImplCaseOf then
  8686. ResolveImplCaseOf(TPasImplCaseOf(El))
  8687. else if C=TPasImplLabelMark then
  8688. ResolveImplLabelMark(TPasImplLabelMark(El))
  8689. else if C=TPasImplForLoop then
  8690. // the header was already resolved
  8691. ResolveImplElement(TPasImplForLoop(El).Body)
  8692. else if C=TPasImplTry then
  8693. begin
  8694. ResolveImplBlock(TPasImplTry(El));
  8695. ResolveImplBlock(TPasImplTry(El).FinallyExcept);
  8696. ResolveImplBlock(TPasImplTry(El).ElseBranch);
  8697. end
  8698. else if C=TPasImplExceptOn then
  8699. // handled in FinishExceptOnStatement
  8700. else if C=TPasImplRaise then
  8701. ResolveImplRaise(TPasImplRaise(El))
  8702. else if C=TPasImplCommand then
  8703. begin
  8704. if TPasImplCommand(El).Command<>'' then
  8705. RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
  8706. end
  8707. else if C=TPasImplAsmStatement then
  8708. ResolveImplAsm(TPasImplAsmStatement(El))
  8709. else if C=TPasImplWithDo then
  8710. ResolveImplWithDo(TPasImplWithDo(El))
  8711. else
  8712. RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
  8713. end;
  8714. procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
  8715. type
  8716. TRangeItem = record
  8717. RangeStart, RangeEnd: TMaxPrecInt;
  8718. Expr: TPasExpr;
  8719. aString: UnicodeString;
  8720. // Note: for case-of-string:
  8721. // single values are stored in aString and RangeStart=1, RangeEnd=0
  8722. // ranges are stored as aString='', RangeStart, RangeEnd
  8723. end;
  8724. PRangeItem = ^TRangeItem;
  8725. function CreateValues(const ResolvedEl: TPasResolverResult;
  8726. var ValueSet: TResEvalSet): boolean;
  8727. var
  8728. CaseExprType: TPasType;
  8729. begin
  8730. Result:=false;
  8731. if ResolvedEl.BaseType in btAllInteger then
  8732. begin
  8733. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  8734. Result:=true;
  8735. end
  8736. else if ResolvedEl.BaseType in btAllBooleans then
  8737. begin
  8738. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  8739. Result:=true;
  8740. end
  8741. else if ResolvedEl.BaseType in btAllChars then
  8742. begin
  8743. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  8744. Result:=true;
  8745. end
  8746. else if ResolvedEl.BaseType in btAllStrings then
  8747. Result:=true
  8748. else if ResolvedEl.BaseType=btContext then
  8749. begin
  8750. CaseExprType:=ResolvedEl.LoTypeEl;
  8751. if CaseExprType.ClassType=TPasEnumType then
  8752. begin
  8753. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  8754. Result:=true;
  8755. end;
  8756. end
  8757. else if ResolvedEl.BaseType=btRange then
  8758. begin
  8759. if ResolvedEl.SubType in btAllInteger then
  8760. begin
  8761. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  8762. Result:=true;
  8763. end
  8764. else if ResolvedEl.SubType in btAllBooleans then
  8765. begin
  8766. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  8767. Result:=true;
  8768. end
  8769. else if ResolvedEl.SubType in btAllChars then
  8770. begin
  8771. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  8772. Result:=true;
  8773. end
  8774. else if ResolvedEl.SubType=btContext then
  8775. begin
  8776. CaseExprType:=ResolvedEl.LoTypeEl;
  8777. if CaseExprType.ClassType=TPasEnumType then
  8778. begin
  8779. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  8780. Result:=true;
  8781. end;
  8782. end;
  8783. end;
  8784. end;
  8785. function AddRangeItem(Values: TFPList; const RangeStart, RangeEnd: TMaxPrecInt;
  8786. Expr: TPasExpr): PRangeItem;
  8787. begin
  8788. New(Result);
  8789. Result^.RangeStart:=RangeStart;
  8790. Result^.RangeEnd:=RangeEnd;
  8791. Result^.Expr:=Expr;
  8792. Values.Add(Result);
  8793. end;
  8794. function AddValue(Value: TResEvalValue; Values: TFPList; ValueSet: TResEvalSet;
  8795. Expr: TPasExpr): boolean;
  8796. function AddString(const s: UnicodeString): boolean;
  8797. var
  8798. Dupl: TPasExpr;
  8799. i, o: Integer;
  8800. Item: PRangeItem;
  8801. begin
  8802. if length(s)=1 then
  8803. o:=ord(s[1])
  8804. else
  8805. o:=-1;
  8806. for i:=0 to Values.Count-1 do
  8807. begin
  8808. Item:=PRangeItem(Values[i]);
  8809. if (Item^.aString=s)
  8810. or ((o>=Item^.RangeStart) and (o<=Item^.RangeEnd)) then
  8811. begin
  8812. Dupl:=PRangeItem(Values[i])^.Expr;
  8813. RaiseMsg(20180424220139,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  8814. ['string',GetElementSourcePosStr(Dupl)],Expr);
  8815. end;
  8816. end;
  8817. Item:=AddRangeItem(Values,1,0,Expr);
  8818. Item^.aString:=s;
  8819. Result:=true;
  8820. end;
  8821. function AddStringRange(CharStart, CharEnd: TMaxPrecInt): boolean;
  8822. var
  8823. i, o: Integer;
  8824. s: UnicodeString;
  8825. Item: PRangeItem;
  8826. Dupl: TPasExpr;
  8827. begin
  8828. if CharEnd>$ffff then
  8829. RaiseNotYetImplemented(20180501221359,Expr,Value.AsDebugString);
  8830. for i:=0 to Values.Count-1 do
  8831. begin
  8832. Item:=PRangeItem(Values[i]);
  8833. s:=Item^.aString;
  8834. if length(s)=1 then
  8835. o:=ord(s[1])
  8836. else
  8837. o:=-1;
  8838. if ((o>=CharStart) and (o<=CharEnd))
  8839. or ((Item^.RangeStart<=CharEnd) and (Item^.RangeEnd>=CharStart)) then
  8840. begin
  8841. Dupl:=PRangeItem(Values[i])^.Expr;
  8842. RaiseMsg(20180501223914,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  8843. ['string',GetElementSourcePosStr(Dupl)],Expr);
  8844. end;
  8845. end;
  8846. AddRangeItem(Values,CharStart,CharEnd,Expr);
  8847. Result:=true;
  8848. end;
  8849. var
  8850. RangeStart, RangeEnd: TMaxPrecInt;
  8851. i: Integer;
  8852. Item: PRangeItem;
  8853. begin
  8854. {$IFDEF VerbosePasResolver}
  8855. //writeln('TPasResolver.ResolveImplCaseOf.AddValue Value={',Value.AsDebugString,'} Values.Count=',Values.Count);
  8856. {$ENDIF}
  8857. Result:=true;
  8858. case Value.Kind of
  8859. revkBool:
  8860. begin
  8861. RangeStart:=ord(TResEvalBool(Value).B);
  8862. RangeEnd:=RangeStart;
  8863. end;
  8864. revkInt:
  8865. begin
  8866. RangeStart:=TResEvalInt(Value).Int;
  8867. RangeEnd:=RangeStart;
  8868. end;
  8869. revkUInt:
  8870. begin
  8871. // Note: when FPC compares int64 with qword it converts the qword to an int64
  8872. if TResEvalUInt(Value).UInt>HighIntAsUInt then
  8873. ExprEvaluator.EmitRangeCheckConst(20180424212414,Value.AsString,
  8874. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  8875. RangeStart:=TResEvalUInt(Value).UInt;
  8876. RangeEnd:=RangeStart;
  8877. end;
  8878. {$ifdef FPC_HAS_CPSTRING}
  8879. revkString:
  8880. if ValueSet=nil then
  8881. exit(AddString(ExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Expr)))
  8882. else
  8883. begin
  8884. RangeStart:=fExprEvaluator.StringToOrd(Value,nil);
  8885. if RangeStart>$ffff then
  8886. exit(false);
  8887. RangeEnd:=RangeStart;
  8888. end;
  8889. {$endif}
  8890. revkUnicodeString:
  8891. if ValueSet=nil then
  8892. exit(AddString(TResEvalUTF16(Value).S))
  8893. else
  8894. begin
  8895. if length(TResEvalUTF16(Value).S)<>1 then
  8896. exit(false);
  8897. RangeStart:=ord(TResEvalUTF16(Value).S[1]);
  8898. RangeEnd:=RangeStart;
  8899. end;
  8900. revkEnum:
  8901. begin
  8902. RangeStart:=TResEvalEnum(Value).Index;
  8903. RangeEnd:=RangeStart;
  8904. end;
  8905. revkRangeInt:
  8906. if ValueSet=nil then
  8907. exit(AddStringRange(TResEvalRangeInt(Value).RangeStart,TResEvalRangeInt(Value).RangeEnd))
  8908. else
  8909. begin
  8910. RangeStart:=TResEvalRangeInt(Value).RangeStart;
  8911. RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
  8912. end;
  8913. revkRangeUInt:
  8914. begin
  8915. // Note: when FPC compares int64 with qword it converts the qword to an int64
  8916. if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
  8917. ExprEvaluator.EmitRangeCheckConst(20180424212648,Value.AsString,
  8918. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  8919. RangeStart:=TResEvalRangeUInt(Value).RangeStart;
  8920. RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
  8921. end;
  8922. else
  8923. Result:=false;
  8924. end;
  8925. if ValueSet=nil then
  8926. RaiseNotYetImplemented(20180424215728,Expr,Value.AsDebugString);
  8927. i:=ValueSet.Intersects(RangeStart,RangeEnd);
  8928. if i<0 then
  8929. begin
  8930. ValueSet.Add(RangeStart,RangeEnd);
  8931. AddRangeItem(Values,RangeStart,RangeEnd,Expr);
  8932. exit(true);
  8933. end;
  8934. // duplicate value -> show where
  8935. for i:=0 to Values.Count-1 do
  8936. begin
  8937. Item:=PRangeItem(Values[i]);
  8938. if (Item^.RangeStart>RangeEnd) or (Item^.RangeEnd<RangeStart) then continue;
  8939. RaiseMsg(20180424214305,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  8940. [Value.AsString,GetElementSourcePosStr(Item^.Expr)],Expr);
  8941. end;
  8942. Result:=false;
  8943. end;
  8944. var
  8945. i, j: Integer;
  8946. El: TPasElement;
  8947. Stat: TPasImplCaseStatement;
  8948. CaseExprResolved, OfExprResolved: TPasResolverResult;
  8949. OfExpr: TPasExpr;
  8950. ok: Boolean;
  8951. Values: TFPList; // list of PRangeItem
  8952. ValueSet: TResEvalSet;
  8953. Value: TResEvalValue;
  8954. Item: PRangeItem;
  8955. begin
  8956. ResolveExpr(CaseOf.CaseExpr,rraRead);
  8957. ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
  8958. ok:=false;
  8959. Values:=TFPList.Create;
  8960. ValueSet:=nil;
  8961. Value:=nil;
  8962. try
  8963. if (rrfReadable in CaseExprResolved.Flags) then
  8964. ok:=CreateValues(CaseExprResolved,ValueSet);
  8965. if not ok then
  8966. begin
  8967. if not IsGenericTemplType(CaseExprResolved) then
  8968. RaiseXExpectedButYFound(20170216151952,'ordinal expression',
  8969. GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
  8970. end;
  8971. for i:=0 to CaseOf.Elements.Count-1 do
  8972. begin
  8973. El:=TPasElement(CaseOf.Elements[i]);
  8974. if El.ClassType=TPasImplCaseStatement then
  8975. begin
  8976. Stat:=TPasImplCaseStatement(El);
  8977. for j:=0 to Stat.Expressions.Count-1 do
  8978. begin
  8979. //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
  8980. OfExpr:=TPasExpr(Stat.Expressions[j]);
  8981. ResolveExpr(OfExpr,rraRead);
  8982. ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
  8983. if OfExprResolved.BaseType=btRange then
  8984. ConvertRangeToElement(OfExprResolved);
  8985. if not ok then
  8986. continue;
  8987. CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
  8988. Value:=Eval(OfExpr,[refConstExt]);
  8989. if Value<>nil then
  8990. begin
  8991. if Value.Kind=revkExternal then
  8992. begin
  8993. // external const
  8994. end
  8995. else if not AddValue(Value,Values,ValueSet,OfExpr) then
  8996. RaiseIncompatibleTypeRes(20180424210815,nIncompatibleTypesGotExpected,
  8997. [],OfExprResolved,CaseExprResolved,OfExpr);
  8998. ReleaseEvalValue(Value);
  8999. end
  9000. else
  9001. RaiseMsg(20180518102047,nConstantExpressionExpected,sConstantExpressionExpected,[],OfExpr);
  9002. end;
  9003. ResolveImplElement(Stat.Body);
  9004. end
  9005. else if El.ClassType=TPasImplCaseElse then
  9006. ResolveImplBlock(TPasImplCaseElse(El))
  9007. else
  9008. RaiseNotYetImplemented(20160922163448,El);
  9009. end;
  9010. // Note: CaseOf.ElseBranch was already resolved via Elements
  9011. finally
  9012. ReleaseEvalValue(Value);
  9013. ValueSet.Free;
  9014. for i:=0 to Values.Count-1 do
  9015. begin
  9016. Item:=PRangeItem(Values[i]);
  9017. Dispose(Item);
  9018. end;
  9019. Values.Free;
  9020. end;
  9021. end;
  9022. procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
  9023. begin
  9024. RaiseNotYetImplemented(20161014141636,Mark);
  9025. end;
  9026. procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
  9027. // Note: the expressions were already resolved during parsing
  9028. // and the scopes were already stored in a TPasWithScope.
  9029. // -> simply push them onto the scope stack
  9030. var
  9031. i: Integer;
  9032. WithScope: TPasWithScope;
  9033. ExprScope: TPasWithExprScope;
  9034. begin
  9035. if not (El.CustomData is TPasWithScope) then
  9036. RaiseInternalError(20181210175349);
  9037. WithScope:=TPasWithScope(El.CustomData);
  9038. PushScope(WithScope);
  9039. for i:=0 to WithScope.ExpressionScopes.Count-1 do
  9040. begin
  9041. ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
  9042. PushScope(ExprScope);
  9043. end;
  9044. ResolveImplElement(El.Body);
  9045. PopWithScope(El);
  9046. end;
  9047. procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  9048. begin
  9049. if El=nil then ;
  9050. end;
  9051. procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
  9052. var
  9053. LeftResolved, RightResolved: TPasResolverResult;
  9054. Flags: TPasResolverComputeFlags;
  9055. Access: TResolvedRefAccess;
  9056. Value: TResEvalValue;
  9057. begin
  9058. if El.Kind=akDefault then
  9059. Access:=rraAssign
  9060. else
  9061. Access:=rraReadAndAssign;
  9062. ResolveExpr(El.left,Access);
  9063. {$IFDEF VerbosePasResolver}
  9064. writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
  9065. {$ENDIF}
  9066. // check LHS can be assigned
  9067. ComputeElement(El.left,LeftResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  9068. CheckCanBeLHS(LeftResolved,true,GetRightMostExpr(El.left));
  9069. // compute RHS
  9070. ResolveExpr(El.right,rraRead);
  9071. Flags:=[rcSetReferenceFlags];
  9072. if IsProcedureType(LeftResolved,true) then
  9073. begin
  9074. if (msDelphi in CurrentParser.CurrentModeswitches) then
  9075. Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
  9076. else
  9077. Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
  9078. end;
  9079. {$IFDEF VerbosePasResolver}
  9080. writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
  9081. {$ENDIF}
  9082. ComputeElement(El.right,RightResolved,Flags);
  9083. {$IFDEF VerbosePasResolver}
  9084. writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
  9085. {$ENDIF}
  9086. case El.Kind of
  9087. akDefault:
  9088. begin
  9089. CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
  9090. CheckAssignExprRange(LeftResolved,El.right);
  9091. if (LeftResolved.BaseType=btContext) and (LeftResolved.LoTypeEl.ClassType=TPasArrayType) then
  9092. MarkArrayExprRecursive(El.right,TPasArrayType(LeftResolved.LoTypeEl));
  9093. end;
  9094. akAdd, akMinus,akMul,akDivision:
  9095. begin
  9096. if (LeftResolved.BaseType in btAllInteger) and (El.Kind in [akAdd,akMinus,akMul]) then
  9097. begin
  9098. if (not (rrfReadable in RightResolved.Flags))
  9099. or not (RightResolved.BaseType in btAllInteger) then
  9100. RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9101. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9102. end
  9103. else if (LeftResolved.BaseType in btAllStrings) and (El.Kind=akAdd) then
  9104. begin
  9105. if (not (rrfReadable in RightResolved.Flags))
  9106. or not (RightResolved.BaseType in btAllStringAndChars) then
  9107. RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9108. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9109. end
  9110. else if (LeftResolved.BaseType in btAllFloats)
  9111. and (El.Kind in [akAdd,akMinus,akMul,akDivision]) then
  9112. begin
  9113. if (not (rrfReadable in RightResolved.Flags))
  9114. or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  9115. RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9116. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9117. end
  9118. else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
  9119. begin
  9120. if (not (rrfReadable in RightResolved.Flags))
  9121. or not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  9122. RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9123. [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9124. if (LeftResolved.SubType=RightResolved.SubType)
  9125. or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
  9126. or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
  9127. then
  9128. else
  9129. RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9130. ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9131. end
  9132. else if LeftResolved.BaseType=btContext then
  9133. begin
  9134. if (LeftResolved.LoTypeEl.ClassType=TPasArrayType) and (El.Kind=akAdd)
  9135. and (rrfReadable in RightResolved.Flags)
  9136. and IsDynArray(LeftResolved.LoTypeEl) then
  9137. begin
  9138. // DynArr+=...
  9139. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,El,true);
  9140. exit;
  9141. end
  9142. else
  9143. RaiseIncompatibleTypeRes(20180615235749,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9144. end
  9145. else
  9146. RaiseIncompatibleTypeRes(20180208115707,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9147. // store const expression result
  9148. Value:=Eval(El.right,[]);
  9149. ReleaseEvalValue(Value);
  9150. end;
  9151. else
  9152. RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
  9153. end;
  9154. end;
  9155. procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
  9156. var
  9157. ExprResolved: TPasResolverResult;
  9158. Expr: TPasExpr;
  9159. begin
  9160. Expr:=El.expr;
  9161. ResolveExpr(Expr,rraRead);
  9162. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  9163. if (rrfCanBeStatement in ExprResolved.Flags) then
  9164. exit;
  9165. {$IFDEF VerbosePasResolver}
  9166. writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  9167. {$ENDIF}
  9168. RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
  9169. end;
  9170. procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
  9171. var
  9172. ResolvedEl: TPasResolverResult;
  9173. begin
  9174. if El.ExceptObject<>nil then
  9175. begin
  9176. ResolveExpr(El.ExceptObject,rraRead);
  9177. ComputeElement(El.ExceptObject,ResolvedEl,[rcSetReferenceFlags]);
  9178. CheckIsClass(El.ExceptObject,ResolvedEl);
  9179. if ResolvedEl.IdentEl<>nil then
  9180. begin
  9181. if (ResolvedEl.IdentEl is TPasVariable)
  9182. or (ResolvedEl.IdentEl is TPasArgument)
  9183. or (ResolvedEl.IdentEl is TPasResultElement) then
  9184. else
  9185. begin
  9186. {$IFDEF VerbosePasResolver}
  9187. writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
  9188. {$ENDIF}
  9189. RaiseXExpectedButYFound(20170216152133,
  9190. 'variable',GetElementTypeName(ResolvedEl.IdentEl),El.ExceptObject);
  9191. end;
  9192. end
  9193. else if ResolvedEl.ExprEl<>nil then
  9194. else
  9195. RaiseXExpectedButYFound(201702303145230,
  9196. 'variable',GetResolverResultDbg(ResolvedEl),El.ExceptObject);
  9197. if not (rrfReadable in ResolvedEl.Flags) then
  9198. RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
  9199. end;
  9200. if El.ExceptAddr<>nil then
  9201. ResolveExpr(El.ExceptAddr,rraRead);
  9202. end;
  9203. procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
  9204. var
  9205. Primitive: TPrimitiveExpr;
  9206. ElClass: TClass;
  9207. begin
  9208. {$IFDEF VerbosePasResolver}
  9209. writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
  9210. {$ENDIF}
  9211. if El=nil then
  9212. RaiseNotYetImplemented(20160922163453,El);
  9213. ElClass:=El.ClassType;
  9214. if ElClass=TPrimitiveExpr then
  9215. begin
  9216. Primitive:=TPrimitiveExpr(El);
  9217. case Primitive.Kind of
  9218. pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
  9219. pekNumber: ;
  9220. pekString: ;
  9221. pekNil,pekBoolConst: ;
  9222. else
  9223. RaiseNotYetImplemented(20160922163451,El);
  9224. end;
  9225. end
  9226. else if ElClass=TUnaryExpr then
  9227. ResolveExpr(TUnaryExpr(El).Operand,Access)
  9228. else if ElClass=TBinaryExpr then
  9229. ResolveBinaryExpr(TBinaryExpr(El),Access)
  9230. else if ElClass=TParamsExpr then
  9231. ResolveParamsExpr(TParamsExpr(El),Access)
  9232. else if ElClass=TBoolConstExpr then
  9233. else if ElClass=TNilExpr then
  9234. else if ElClass=TInheritedExpr then
  9235. ResolveInherited(TInheritedExpr(El),Access)
  9236. else if ElClass=TArrayValues then
  9237. begin
  9238. if Access<>rraRead then
  9239. RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9240. [],El);
  9241. ResolveArrayValues(TArrayValues(El));
  9242. end
  9243. else if ElClass=TRecordValues then
  9244. begin
  9245. if Access<>rraRead then
  9246. RaiseMsg(20180429103024,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9247. [],El);
  9248. ResolveRecordValues(TRecordValues(El));
  9249. end
  9250. else if ElClass=TProcedureExpr then
  9251. // resolved by FinishScope(stProcedure)
  9252. else if ElClass=TInlineSpecializeExpr then
  9253. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(El),Access)
  9254. else
  9255. RaiseNotYetImplemented(20170222184329,El);
  9256. if El.format1<>nil then
  9257. ResolveExpr(El.format1,rraRead);
  9258. if El.format2<>nil then
  9259. ResolveExpr(El.format2,rraRead);
  9260. end;
  9261. procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
  9262. var
  9263. ResolvedCond: TPasResolverResult;
  9264. begin
  9265. ResolveExpr(El,rraRead);
  9266. ComputeElement(El,ResolvedCond,[rcSetReferenceFlags]);
  9267. CheckConditionExpr(El,ResolvedCond);
  9268. end;
  9269. procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
  9270. Access: TResolvedRefAccess);
  9271. var
  9272. FindData: TPRFindData;
  9273. DeclEl: TPasElement;
  9274. Proc, ImplProc: TPasProcedure;
  9275. Ref: TResolvedReference;
  9276. BuiltInProc: TResElDataBuiltInProc;
  9277. p: SizeInt;
  9278. DottedName: String;
  9279. Bin: TBinaryExpr;
  9280. ProcScope: TPasProcedureScope;
  9281. ParentParams: TPRParentParams;
  9282. TypeCnt: Integer;
  9283. InlParams, TemplTypes: TFPList;
  9284. begin
  9285. {$IFDEF VerbosePasResolver}
  9286. writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
  9287. {$ENDIF}
  9288. GetParamsOfNameExpr(El,ParentParams);
  9289. if ParentParams.InlineSpec<>nil then
  9290. InlParams:=ParentParams.InlineSpec.Params
  9291. else
  9292. InlParams:=nil;
  9293. //writeln('TPasResolver.ResolveNameExpr Inline=',GetObjName(ParentParams.InlineSpec),' Params=',GetObjName(ParentParams.Params),' ',GetObjPath(El));
  9294. if ParentParams.Params<>nil then
  9295. begin
  9296. case ParentParams.Params.Kind of
  9297. pekFuncParams:
  9298. ResolveFuncParamsExprName(El,InlParams,ParentParams.Params,Access);
  9299. pekArrayParams:
  9300. ResolveArrayParamsExprName(El,ParentParams.Params,Access);
  9301. else
  9302. RaiseNotYetImplemented(20190912190428,El,GetObjPath(ParentParams.Params));
  9303. end;
  9304. exit;
  9305. end;
  9306. if ParentParams.InlineSpec<>nil then
  9307. begin
  9308. TypeCnt:=InlParams.Count;
  9309. // ToDo: generic functions without params
  9310. DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
  9311. if DeclEl<>nil then
  9312. begin
  9313. // GenType<params> -> create specialize type/proc
  9314. DeclEl:=GetSpecializedEl(ParentParams.InlineSpec,DeclEl,InlParams);
  9315. end
  9316. else
  9317. RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El);
  9318. end
  9319. else
  9320. DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
  9321. if DeclEl.ClassType=TPasUsesUnit then
  9322. begin
  9323. // the first name of a unit matches -> find unit with longest match
  9324. FindLongestUnitName(DeclEl,El);
  9325. FindData.Found:=DeclEl;
  9326. end;
  9327. Ref:=CreateReference(DeclEl,El,Access,@FindData);
  9328. CheckFoundElement(FindData,Ref);
  9329. if DeclEl is TPasProcedure then
  9330. begin
  9331. // identifier is a proc and args brackets are missing
  9332. Proc:=TPasProcedure(DeclEl);
  9333. if ParentParams.InlineSpec=nil then
  9334. begin
  9335. TemplTypes:=GetProcTemplateTypes(Proc);
  9336. if (TemplTypes<>nil) then
  9337. // implicit function specialization without bracket
  9338. RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
  9339. sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
  9340. end;
  9341. if El.Parent.ClassType=TPasProperty then
  9342. // a property accessor does not need args -> ok
  9343. // Note: the detailed tests are in FinishProperty
  9344. else
  9345. begin
  9346. // examples: funca or @proca or a.funca or @a.funca ...
  9347. if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
  9348. and (El.ClassType=TPrimitiveExpr)
  9349. and (El.Parent.ClassType=TPasImplAssign)
  9350. and (TPasImplAssign(El.Parent).left=El) then
  9351. begin
  9352. // e.g. funcname:=
  9353. ProcScope:=Proc.CustomData as TPasProcedureScope;
  9354. ImplProc:=ProcScope.ImplProc;
  9355. if ImplProc=nil then
  9356. ImplProc:=Proc;
  9357. if El.HasParent(ImplProc) then
  9358. begin
  9359. // "FuncA:=" within FuncA -> redirect to ResultEl
  9360. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  9361. exit;
  9362. end;
  9363. end;
  9364. if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
  9365. begin
  9366. {$IFDEF VerbosePasResolver}
  9367. writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
  9368. {$ENDIF}
  9369. RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
  9370. sWrongNumberOfParametersForCallTo,[Proc.Name],El);
  9371. end;
  9372. end;
  9373. end
  9374. else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  9375. begin
  9376. if DeclEl.CustomData is TResElDataBuiltInProc then
  9377. begin
  9378. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  9379. BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
  9380. end;
  9381. end
  9382. else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
  9383. begin
  9384. // unit reference
  9385. // dotted unit name needs a ref for each expression identifier
  9386. // Note: El is the first TPrimitiveExpr of the dotted unit name reference
  9387. DottedName:=DeclEl.Name;
  9388. repeat
  9389. p:=Pos('.',DottedName);
  9390. if p<1 then break;
  9391. Delete(DottedName,1,p);
  9392. El:=GetNextDottedExpr(El);
  9393. if El=nil then
  9394. RaiseInternalError(20170503002012);
  9395. CreateReference(DeclEl,El,Access);
  9396. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
  9397. begin
  9398. Bin:=TBinaryExpr(El.Parent);
  9399. while Bin.OpCode=eopSubIdent do
  9400. begin
  9401. CreateReference(DeclEl,Bin,Access);
  9402. if not (Bin.Parent is TBinaryExpr) then break;
  9403. if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
  9404. Bin:=TBinaryExpr(Bin.Parent);
  9405. end;
  9406. end;
  9407. until false;
  9408. end;
  9409. end;
  9410. procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
  9411. Access: TResolvedRefAccess);
  9412. var
  9413. SelfScope: TPasProcedureScope;
  9414. AncestorScope: TPasClassScope;
  9415. ClassRecScope: TPasClassOrRecordScope;
  9416. DeclProc, AncestorProc: TPasProcedure;
  9417. aClass: TPasClassType;
  9418. HelperForType: TPasType;
  9419. InhScope: TPasInheritedScope;
  9420. begin
  9421. {$IFDEF VerbosePasResolver}
  9422. writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
  9423. {$ENDIF}
  9424. if (El.Parent.ClassType=TBinaryExpr)
  9425. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  9426. begin
  9427. // e.g. 'inherited Proc;'
  9428. ResolveInheritedCall(TBinaryExpr(El.Parent),Access);
  9429. exit;
  9430. end;
  9431. // 'inherited;' without expression
  9432. SelfScope:=GetCurrentSelfScope(El);
  9433. if SelfScope=nil then
  9434. RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9435. DeclProc:=SelfScope.DeclarationProc;
  9436. if DeclProc=nil then
  9437. RaiseNotYetImplemented(20190121172251,El);
  9438. ClassRecScope:=SelfScope.ClassRecScope;
  9439. if not (ClassRecScope is TPasClassScope) then
  9440. begin
  9441. // inherited in record method
  9442. RaiseMsg(20181218194022,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9443. ['inherited'],El);
  9444. end;
  9445. AncestorProc:=nil;
  9446. // inherited in class/interface/helper method
  9447. aClass:=ClassRecScope.Element as TPasClassType;
  9448. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9449. //writeln('TPasResolver.ResolveInherited aClass=',GetObjName(aClass),' HelperForType=',GetObjName(HelperForType));
  9450. if HelperForType is TPasMembersType then
  9451. begin
  9452. // inherited; inside helper -> skip helper ancestors and search in HelperForType
  9453. if msDelphi in CurrentParser.CurrentModeswitches then
  9454. begin
  9455. // Delphi skips ancestors and HelperForType
  9456. if not (HelperForType is TPasClassType) then
  9457. // 'inherited;' without ancestor class is silently ignored
  9458. exit;
  9459. AncestorScope:=TPasClassScope(HelperForType.CustomData).AncestorScope;
  9460. if AncestorScope=nil then
  9461. // 'inherited;' without ancestor class is silently ignored
  9462. exit;
  9463. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9464. end
  9465. else
  9466. begin
  9467. // ObjFPC searches first in HelperForType and its ancestors, then in
  9468. // own ancestors
  9469. AncestorScope:=TPasClassScope(aClass.CustomData).AncestorScope;
  9470. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9471. AncestorScope);
  9472. end;
  9473. end
  9474. else
  9475. begin
  9476. // inherited; inside class/interface method
  9477. // -> search in ancestor and its helper(s)
  9478. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9479. if AncestorScope=nil then
  9480. // 'inherited;' without ancestor class is silently ignored
  9481. exit;
  9482. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9483. end;
  9484. AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
  9485. PopScope;
  9486. if AncestorProc=nil then
  9487. // 'inherited;' without ancestor DeclProc is silently ignored
  9488. exit;
  9489. if not (AncestorProc.Parent is TPasMembersType) then
  9490. RaiseNotYetImplemented(20190121181234,El); // inconsistency
  9491. CreateReference(AncestorProc,El,Access);
  9492. if AncestorProc.IsAbstract then
  9493. RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
  9494. sAbstractMethodsCannotBeCalledDirectly,[],El);
  9495. end;
  9496. procedure TPasResolver.ResolveInheritedCall(El: TBinaryExpr;
  9497. Access: TResolvedRefAccess);
  9498. // El.OpCode=eopNone
  9499. // El.left is TInheritedExpr
  9500. // El.right is the identifier and parameters
  9501. var
  9502. SelfScope: TPasProcedureScope;
  9503. ClassRecScope: TPasClassOrRecordScope;
  9504. AncestorClass, aClass: TPasClassType;
  9505. HelperForType: TPasType;
  9506. OnlyTypeMembers: Boolean;
  9507. Proc: TPasProcedure;
  9508. AncestorScope: TPasClassScope;
  9509. InhScope: TPasInheritedScope;
  9510. begin
  9511. {$IFDEF VerbosePasResolver}
  9512. writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El));
  9513. {$ENDIF}
  9514. SelfScope:=GetCurrentSelfScope(El);
  9515. if SelfScope=nil then
  9516. RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9517. ClassRecScope:=SelfScope.ClassRecScope;
  9518. if not (ClassRecScope is TPasClassScope) then
  9519. // inherited in a method of a record
  9520. RaiseMsg(20181218194436,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9521. ['inherited'],El);
  9522. Proc:=TPasProcedure(SelfScope.Element);
  9523. OnlyTypeMembers:=IsClassMethod(Proc);
  9524. // inherited in a method of a class/interface/helper
  9525. aClass:=TPasClassType(ClassRecScope.Element);
  9526. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9527. if aClass.ObjKind in okAllHelpers then
  9528. begin
  9529. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9530. if HelperForType is TPasMembersType then
  9531. begin
  9532. // record helper(ancestor) for aRecord
  9533. // or class helper(ancestor) for aClass
  9534. // -> search in helperfortype, then in ancestors
  9535. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9536. AncestorScope);
  9537. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9538. ResolveExpr(El.right,Access);
  9539. PopScope;
  9540. exit;
  9541. end
  9542. else
  9543. begin
  9544. // type helper(ancestortype) for simpletype -> search in ancestortype
  9545. end;
  9546. end
  9547. else
  9548. begin
  9549. // class or interface -> search in ancestor and its helpers
  9550. end;
  9551. // search in ancestor and its helpers
  9552. if AncestorScope=nil then
  9553. RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
  9554. // search call in ancestor
  9555. AncestorClass:=TPasClassType(AncestorScope.Element);
  9556. InhScope:=PushInheritedScope(AncestorClass,true,nil);
  9557. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9558. ResolveExpr(El.right,Access);
  9559. PopScope;
  9560. end;
  9561. procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
  9562. Access: TResolvedRefAccess);
  9563. begin
  9564. {$IFDEF VerbosePasResolver}
  9565. //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
  9566. {$ENDIF}
  9567. ResolveExpr(El.left,rraRead);
  9568. if El.right=nil then exit;
  9569. case El.OpCode of
  9570. eopNone:
  9571. case El.Kind of
  9572. pekRange:
  9573. ResolveExpr(El.right,rraRead);
  9574. else
  9575. if El.left.ClassType=TInheritedExpr then
  9576. else
  9577. begin
  9578. {$IFDEF VerbosePasResolver}
  9579. writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
  9580. {$ENDIF}
  9581. RaiseNotYetImplemented(20160922163456,El);
  9582. end;
  9583. end;
  9584. eopAdd,
  9585. eopSubtract,
  9586. eopMultiply,
  9587. eopDivide,
  9588. eopDiv,
  9589. eopMod,
  9590. eopPower,
  9591. eopShr,
  9592. eopShl,
  9593. eopNot,
  9594. eopAnd,
  9595. eopOr,
  9596. eopXor,
  9597. eopEqual,
  9598. eopNotEqual,
  9599. eopLessThan,
  9600. eopGreaterThan,
  9601. eopLessthanEqual,
  9602. eopGreaterThanEqual,
  9603. eopIn,
  9604. eopIs,
  9605. eopAs,
  9606. eopSymmetricaldifference:
  9607. ResolveExpr(El.right,rraRead);
  9608. eopSubIdent:
  9609. ResolveSubIdent(El,Access);
  9610. else
  9611. RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
  9612. end;
  9613. end;
  9614. procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
  9615. Access: TResolvedRefAccess);
  9616. procedure ResolveRight; inline;
  9617. begin
  9618. ResolveExpr(El.right,Access);
  9619. PopScope;
  9620. end;
  9621. function SearchInTypeHelpers(HiType: TPasType; IdentEl: TPasElement): boolean;
  9622. var
  9623. DotScope: TPasDotBaseScope;
  9624. begin
  9625. if HiType=nil then exit(false);
  9626. DotScope:=PushHelperDotScope(HiType);
  9627. if DotScope=nil then exit(false);
  9628. if IdentEl is TPasType then
  9629. // e.g. TFlag.HelperProc
  9630. DotScope.OnlyTypeMembers:=true;
  9631. ResolveRight;
  9632. Result:=true;
  9633. end;
  9634. var
  9635. aModule: TPasModule;
  9636. ClassEl: TPasClassType;
  9637. ClassScope: TPasDotClassScope;
  9638. LeftResolved: TPasResolverResult;
  9639. Left: TPasExpr;
  9640. RecordEl: TPasRecordType;
  9641. RecordScope: TPasDotClassOrRecordScope;
  9642. LLoTypeEl, LHiTypeEl: TPasType;
  9643. DotScope: TPasDotBaseScope;
  9644. SetType: TPasSetType;
  9645. begin
  9646. if El.CustomData is TResolvedReference then
  9647. exit; // for example, when a.b has a dotted unit name
  9648. Left:=El.left;
  9649. //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
  9650. ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
  9651. if LeftResolved.BaseType=btModule then
  9652. begin
  9653. // e.g. unitname.identifier
  9654. // => search in interface and if this is our module in the implementation
  9655. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  9656. PushModuleDotScope(aModule);
  9657. ResolveRight;
  9658. exit;
  9659. end
  9660. else if LeftResolved.LoTypeEl=nil then
  9661. begin
  9662. // illegal qualifier, see below
  9663. end
  9664. else
  9665. begin
  9666. LHiTypeEl:=LeftResolved.HiTypeEl;
  9667. LLoTypeEl:=LeftResolved.LoTypeEl;
  9668. if (LLoTypeEl.ClassType=TPasPointerType)
  9669. and ElHasModeSwitch(El,msAutoDeref)
  9670. and (rrfReadable in LeftResolved.Flags)
  9671. then
  9672. begin
  9673. // a.b -> a^.b
  9674. LHiTypeEl:=TPasPointerType(LLoTypeEl).DestType;
  9675. LLoTypeEl:=ResolveAliasType(LHiTypeEl);
  9676. Include(LeftResolved.Flags,rrfWritable);
  9677. end;
  9678. if LLoTypeEl.ClassType=TPasClassType then
  9679. begin
  9680. ClassEl:=TPasClassType(LLoTypeEl);
  9681. if ClassEl.HelperForType<>nil then
  9682. RaiseHelpersCannotBeUsedAsType(20190123093438,El);
  9683. ClassScope:=PushClassDotScope(ClassEl);
  9684. if LeftResolved.IdentEl is TPasType then
  9685. // e.g. TFPMemoryImage.FindHandlerFromExtension()
  9686. ClassScope.OnlyTypeMembers:=true
  9687. else
  9688. // e.g. Image.Width
  9689. ClassScope.OnlyTypeMembers:=false;
  9690. ResolveRight;
  9691. exit;
  9692. end
  9693. else if LLoTypeEl.ClassType=TPasClassOfType then
  9694. begin
  9695. // e.g. ImageClass.FindHandlerFromExtension()
  9696. ClassEl:=ResolveAliasType(TPasClassOfType(LLoTypeEl).DestType) as TPasClassType;
  9697. ClassScope:=PushClassDotScope(ClassEl);
  9698. ClassScope.OnlyTypeMembers:=true;
  9699. ClassScope.IsClassOf:=true;
  9700. ResolveRight;
  9701. exit;
  9702. end
  9703. else if LLoTypeEl.ClassType=TPasRecordType then
  9704. begin
  9705. RecordEl:=TPasRecordType(LLoTypeEl);
  9706. RecordScope:=PushRecordDotScope(RecordEl);
  9707. RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
  9708. if LeftResolved.IdentEl is TPasType then
  9709. // e.g. TPoint.PointInCircle
  9710. RecordScope.OnlyTypeMembers:=true
  9711. else
  9712. begin
  9713. // e.g. aPoint.X
  9714. AccessExpr(El.left,Access);
  9715. RecordScope.OnlyTypeMembers:=false;
  9716. end;
  9717. ResolveRight;
  9718. exit;
  9719. end
  9720. else if LLoTypeEl.ClassType=TPasEnumType then
  9721. begin
  9722. if (LeftResolved.IdentEl is TPasType)
  9723. and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
  9724. begin
  9725. // e.g. TShiftState.ssAlt
  9726. DotScope:=PushEnumDotScope(LHiTypeEl,TPasEnumType(LLoTypeEl));
  9727. DotScope.OnlyTypeMembers:=true;
  9728. ResolveRight;
  9729. exit;
  9730. end;
  9731. end
  9732. else if LLoTypeEl.ClassType=TPasGenericTemplateType then
  9733. begin
  9734. DotScope:=PushTemplateDotScope(TPasGenericTemplateType(LLoTypeEl),El);
  9735. if DotScope<>nil then
  9736. begin
  9737. if LeftResolved.IdentEl is TPasType then
  9738. // e.g. T.Member
  9739. DotScope.OnlyTypeMembers:=true
  9740. else
  9741. // e.g. VarOfTypeT.Member
  9742. DotScope.OnlyTypeMembers:=false;
  9743. ResolveRight;
  9744. exit;
  9745. end;
  9746. end;
  9747. // default: search for type helpers
  9748. if (LeftResolved.BaseType in btAllStandardTypes)
  9749. or (LeftResolved.BaseType=btContext)
  9750. or (LeftResolved.BaseType=btCustom) then
  9751. begin
  9752. if SearchInTypeHelpers(LeftResolved.HiTypeEl,LeftResolved.IdentEl) then exit;
  9753. end
  9754. else if LeftResolved.BaseType=btSet then
  9755. begin
  9756. SetType:=GetSetType(LeftResolved);
  9757. if SearchInTypeHelpers(SetType,LeftResolved.IdentEl) then exit;
  9758. end;
  9759. end;
  9760. {$IFDEF VerbosePasResolver}
  9761. writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
  9762. {$ENDIF}
  9763. RaiseMsg(20170216152157,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9764. ['.',GetResolverResultDescription(LeftResolved)],El);
  9765. end;
  9766. procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
  9767. Access: TResolvedRefAccess);
  9768. begin
  9769. if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
  9770. begin
  9771. {$IFDEF VerbosePasResolver}
  9772. writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
  9773. {$ENDIF}
  9774. RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  9775. end;
  9776. // first resolve params
  9777. ResolveParamsExprParams(Params);
  9778. // then resolve the call, typecast, array, set
  9779. if (Params.Kind=pekFuncParams) then
  9780. ResolveFuncParamsExpr(Params,Access)
  9781. else if (Params.Kind=pekArrayParams) then
  9782. ResolveArrayParamsExpr(Params,Access)
  9783. else if (Params.Kind=pekSet) then
  9784. ResolveSetParamsExpr(Params)
  9785. else
  9786. RaiseNotYetImplemented(20160922163501,Params);
  9787. end;
  9788. procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
  9789. var
  9790. ScopeDepth, i: integer;
  9791. ParamAccess: TResolvedRefAccess;
  9792. Pars: TPasExprArray;
  9793. begin
  9794. ScopeDepth:=StashSubExprScopes;
  9795. if Params.Kind in [pekFuncParams,pekArrayParams] then
  9796. ParamAccess:=rraParamToUnknownProc
  9797. else
  9798. ParamAccess:=rraRead;
  9799. Pars:=Params.Params;
  9800. for i:=0 to length(Pars)-1 do
  9801. ResolveExpr(Pars[i],ParamAccess);
  9802. RestoreStashedScopes(ScopeDepth);
  9803. end;
  9804. procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
  9805. Access: TResolvedRefAccess);
  9806. var
  9807. Value: TPasExpr;
  9808. SubParams: TParamsExpr;
  9809. ResolvedEl: TPasResolverResult;
  9810. begin
  9811. Value:=Params.Value;
  9812. if Value is TBinaryExpr then
  9813. begin
  9814. // Note: a.b() is the same as (a.b)()
  9815. // Note: a.b().c is stored as
  9816. // TBinaryExpr eopSubIdent
  9817. // / \
  9818. // left = TParamsExpr right = TPrimitiveExpr 'c'
  9819. // Value = TBinaryExpr
  9820. // / \
  9821. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  9822. if (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) then
  9823. Value:=TBinaryExpr(Value).right;
  9824. if IsNameExpr(Value) then
  9825. begin
  9826. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  9827. if not (Value.CustomData is TResolvedReference) then
  9828. RaiseNotYetImplemented(20190115140557,Params);
  9829. // already resolved
  9830. exit;
  9831. end
  9832. else if Value.ClassType=TInlineSpecializeExpr then
  9833. begin
  9834. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  9835. // already resolved
  9836. exit;
  9837. end;
  9838. // ToDo: (a+b)()
  9839. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  9840. RaiseNotYetImplemented(20190115140809,Params);
  9841. end
  9842. else if IsNameExpr(Value) then
  9843. ResolveFuncParamsExprName(Value,nil,Params,Access)
  9844. else if Value.ClassType=TInlineSpecializeExpr then
  9845. begin
  9846. // e.g. Name<>()
  9847. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),rraRead);
  9848. end
  9849. else if Value.ClassType=TParamsExpr then
  9850. begin
  9851. SubParams:=TParamsExpr(Value);
  9852. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  9853. begin
  9854. // e.g. Name()() or Name[]()
  9855. ResolveParamsExpr(SubParams,rraRead);
  9856. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  9857. if IsProcedureType(ResolvedEl,true) then
  9858. begin
  9859. CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
  9860. FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
  9861. exit;
  9862. end
  9863. end;
  9864. RaiseMsg(20170216152202,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9865. ['(',SubParams.ElementTypeName],Params);
  9866. end
  9867. else
  9868. RaiseNotYetImplemented(20161014085118,Params.Value);
  9869. end;
  9870. procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
  9871. TemplParams: TFPList; Params: TParamsExpr; Access: TResolvedRefAccess;
  9872. CallName: string);
  9873. procedure RaiseMultiFit;
  9874. var
  9875. FindCallData: TFindCallElData;
  9876. Msg: String;
  9877. i: Integer;
  9878. El: TPasElement;
  9879. Abort: boolean;
  9880. begin
  9881. FindCallData:=Default(TFindCallElData);
  9882. FindCallData.Params:=Params;
  9883. FindCallData.List:=TFPList.Create;
  9884. try
  9885. Abort:=false;
  9886. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  9887. Msg:='';
  9888. for i:=0 to FindCallData.List.Count-1 do
  9889. begin
  9890. El:=TPasElement(FindCallData.List[i]);
  9891. {$IFDEF VerbosePasResolver}
  9892. writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
  9893. {$ENDIF}
  9894. // emit a hint for each candidate
  9895. if El is TPasProcedure then
  9896. LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
  9897. [GetProcTypeDescription(TPasProcedure(El).ProcType,
  9898. [prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
  9899. Msg:=Msg+', '+GetElementSourcePosStr(El);
  9900. end;
  9901. finally
  9902. FindCallData.List.Free;
  9903. end;
  9904. RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
  9905. sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
  9906. end;
  9907. procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
  9908. var
  9909. i: Integer;
  9910. begin
  9911. if ParamAccess=rraParamToUnknownProc then exit;
  9912. for i:=0 to length(Params.Params)-1 do
  9913. FinishCallArgAccess(Params.Params[i],ParamAccess);
  9914. end;
  9915. procedure CheckTemplParams(GenTemplates, TemplParams: TFPList);
  9916. var
  9917. i: Integer;
  9918. Param, PosEl: TPasElement;
  9919. ResolvedEl: TPasResolverResult;
  9920. begin
  9921. for i:=0 to TemplParams.Count-1 do
  9922. begin
  9923. Param:=TPasElement(TemplParams[i]);
  9924. ComputeElement(Param,ResolvedEl,[rcType]);
  9925. if Param is TPasExpr then
  9926. PosEl:=Param
  9927. else
  9928. PosEl:=Params;
  9929. if CheckTemplateFitsParamRes(TPasGenericTemplateType(GenTemplates[i]),
  9930. ResolvedEl,prtcoAssignToTempl,PosEl)=cIncompatible then
  9931. // should have raise error
  9932. RaiseNotYetImplemented(20190919095604,PosEl,GetResolverResultDbg(ResolvedEl));
  9933. end;
  9934. end;
  9935. var
  9936. FindCallData: TFindCallElData;
  9937. Abort: boolean;
  9938. FoundEl: TPasElement;
  9939. Ref: TResolvedReference;
  9940. FindData: TPRFindData;
  9941. BuiltInProc: TResElDataBuiltInProc;
  9942. ResolvedEl: TPasResolverResult;
  9943. TypeEl: TPasType;
  9944. C: TClass;
  9945. TemplParamsCnt: Integer;
  9946. GenTemplates, InferenceParams: TFPList;
  9947. begin
  9948. // e.g. Name() -> find compatible
  9949. {$IFDEF VerbosePasResolver}
  9950. //writeln('TPasResolver.ResolveFuncParamsExprName NameExpr=',GetObjName(NameExpr),' TemplParams=',TemplParams<>nil,' CallName="',CallName,'"');
  9951. {$ENDIF}
  9952. if CallName<>'' then
  9953. else if NameExpr.ClassType=TPrimitiveExpr then
  9954. CallName:=TPrimitiveExpr(NameExpr).Value
  9955. else
  9956. RaiseNotYetImplemented(20190115143539,NameExpr);
  9957. FindCallData:=Default(TFindCallElData);
  9958. FindCallData.Params:=Params;
  9959. if TemplParams<>nil then
  9960. begin
  9961. TemplParamsCnt:=TemplParams.Count;
  9962. FindCallData.TemplCnt:=TemplParamsCnt;
  9963. end
  9964. else
  9965. TemplParamsCnt:=0;
  9966. Abort:=false;
  9967. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  9968. FoundEl:=FindCallData.Found;
  9969. if FoundEl=nil then
  9970. RaiseIdentifierNotFound(20170216152544,CallName,NameExpr);
  9971. if FindCallData.Distance=cIncompatible then
  9972. begin
  9973. // FoundEl one element, but it was incompatible => raise error
  9974. {$IFDEF VerbosePasResolver}
  9975. writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
  9976. WriteScopes;
  9977. {$ENDIF}
  9978. if FoundEl is TPasProcedure then
  9979. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true)
  9980. else if FoundEl is TPasProcedureType then
  9981. CheckTypeCast(TPasProcedureType(FoundEl),Params,true)
  9982. else if FoundEl.ClassType=TPasUnresolvedSymbolRef then
  9983. begin
  9984. if FoundEl.CustomData is TResElDataBuiltInProc then
  9985. begin
  9986. BuiltInProc:=TResElDataBuiltInProc(FoundEl.CustomData);
  9987. BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
  9988. end
  9989. else if FoundEl.CustomData is TResElDataBaseType then
  9990. CheckTypeCast(TPasUnresolvedSymbolRef(FoundEl),Params,true)
  9991. else
  9992. RaiseNotYetImplemented(20161006132825,FoundEl);
  9993. end
  9994. else if FoundEl is TPasType then
  9995. // Note: check TPasType after TPasUnresolvedSymbolRef
  9996. CheckTypeCast(TPasType(FoundEl),Params,true)
  9997. else if FoundEl is TPasVariable then
  9998. begin
  9999. TypeEl:=ResolveAliasType(TPasVariable(FoundEl).VarType);
  10000. if TypeEl is TPasProcedureType then
  10001. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  10002. else
  10003. RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10004. ['(',TypeEl.ElementTypeName],Params);
  10005. end
  10006. else if FoundEl is TPasArgument then
  10007. begin
  10008. TypeEl:=ResolveAliasType(TPasArgument(FoundEl).ArgType);
  10009. if TypeEl is TPasProcedureType then
  10010. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  10011. else
  10012. RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10013. ['(',TypeEl.ElementTypeName],Params);
  10014. end
  10015. else
  10016. RaiseNotYetImplemented(20161003134755,FoundEl);
  10017. // missing raise exception
  10018. RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FoundEl));
  10019. end;
  10020. if FindCallData.Count>1 then
  10021. begin
  10022. // multiple overloads fit
  10023. if (FoundEl is TPasProcedure)
  10024. and (IndexOfGenericParam(Params.Params)>=0) then
  10025. // generic params -> ignore ambiguity
  10026. else
  10027. // => search again and list the candidates
  10028. RaiseMultiFit;
  10029. end;
  10030. // check template params
  10031. if FoundEl is TPasProcedure then
  10032. GenTemplates:=GetProcTemplateTypes(TPasProcedure(FoundEl))
  10033. else if FoundEl is TPasGenericType then
  10034. GenTemplates:=TPasGenericType(FoundEl).GenericTemplateTypes
  10035. else
  10036. GenTemplates:=nil;
  10037. if TemplParamsCnt>0 then
  10038. begin
  10039. // check template types
  10040. if GenTemplates=nil then
  10041. RaiseMsg(20190919100922,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  10042. [FoundEl.Name],NameExpr);
  10043. if TemplParamsCnt<>GenTemplates.Count then
  10044. RaiseMsg(20190919101051,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10045. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10046. CheckTemplParams(GenTemplates,TemplParams);
  10047. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
  10048. end
  10049. else if (GenTemplates<>nil) and (GenTemplates.Count>0) then
  10050. begin
  10051. if (FoundEl is TPasProcedure)
  10052. and (msImplicitFunctionSpec in CurrentParser.CurrentModeswitches) then
  10053. begin
  10054. // GenericProc() -> create template types by inference
  10055. InferenceParams:=CreateInferenceTypesForCall(Params,TPasProcedure(FoundEl));
  10056. try
  10057. CheckTemplParams(GenTemplates,InferenceParams);
  10058. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
  10059. finally
  10060. ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
  10061. FreeAndNil(InferenceParams);
  10062. end;
  10063. // check if params fit the implicit specialized function
  10064. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
  10065. end
  10066. else
  10067. // GenericType() -> missing type params
  10068. RaiseMsg(20190919120728,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10069. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10070. end;
  10071. // FoundEl compatible element -> create reference
  10072. Ref:=CreateReference(FoundEl,NameExpr,rraRead);
  10073. if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
  10074. Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
  10075. FindData:=Default(TPRFindData);
  10076. FindData.ErrorPosEl:=NameExpr;
  10077. FindData.StartScope:=FindCallData.StartScope;
  10078. FindData.ElScope:=FindCallData.ElScope;
  10079. FindData.Found:=FoundEl;
  10080. CheckFoundElement(FindData,Ref);
  10081. // set param expression Access flags
  10082. if FoundEl is TPasProcedure then
  10083. begin
  10084. // now it is known which overloaded proc to call
  10085. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10086. begin
  10087. {$IFDEF VerbosePasResolver}
  10088. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10089. {$ENDIF}
  10090. RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10091. end;
  10092. FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
  10093. end
  10094. else if FoundEl is TPasType then
  10095. begin
  10096. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  10097. C:=TypeEl.ClassType;
  10098. if (C=TPasClassType)
  10099. or (C=TPasClassOfType)
  10100. or (C=TPasRecordType)
  10101. or (C=TPasEnumType)
  10102. or (C=TPasSetType)
  10103. or (C=TPasPointerType)
  10104. or (C=TPasArrayType)
  10105. or (C=TPasRangeType)
  10106. or (C=TPasGenericTemplateType) then
  10107. begin
  10108. // type cast
  10109. FinishUntypedParams(Access);
  10110. end
  10111. else if (C=TPasProcedureType)
  10112. or (C=TPasFunctionType) then
  10113. begin
  10114. // type cast to proc type
  10115. AccessExpr(Params.Params[0],Access);
  10116. end
  10117. else if C=TPasUnresolvedSymbolRef then
  10118. begin
  10119. if TypeEl.CustomData is TResElDataBuiltInProc then
  10120. begin
  10121. // call built-in proc
  10122. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  10123. if Assigned(BuiltInProc.FinishParamsExpression) then
  10124. BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
  10125. else
  10126. FinishUntypedParams(rraRead);
  10127. end
  10128. else if TypeEl.CustomData is TResElDataBaseType then
  10129. begin
  10130. // type cast to base type
  10131. FinishUntypedParams(Access);
  10132. end
  10133. else
  10134. begin
  10135. {$IFDEF VerbosePasResolver}
  10136. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10137. {$ENDIF}
  10138. RaiseNotYetImplemented(20170325145720,Params);
  10139. end;
  10140. end
  10141. else
  10142. begin
  10143. {$IFDEF VerbosePasResolver}
  10144. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10145. {$ENDIF}
  10146. RaiseMsg(20170306121908,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10147. ['(',TypeEl.ElementTypeName],Params);
  10148. end;
  10149. end
  10150. else
  10151. begin
  10152. // FoundEl is not a type, maybe a var
  10153. ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10154. TypeEl:=ResolvedEl.LoTypeEl;
  10155. if TypeEl is TPasProcedureType then
  10156. begin
  10157. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10158. begin
  10159. {$IFDEF VerbosePasResolver}
  10160. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10161. {$ENDIF}
  10162. RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10163. end;
  10164. FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
  10165. exit;
  10166. end;
  10167. {$IFDEF VerbosePasResolver}
  10168. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
  10169. {$ENDIF}
  10170. RaiseMsg(20170306104301,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10171. ['(',TypeEl.ElementTypeName],Params);
  10172. end;
  10173. end;
  10174. procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
  10175. Access: TResolvedRefAccess);
  10176. var
  10177. ResolvedEl: TPasResolverResult;
  10178. Value: TPasExpr;
  10179. SubParams: TParamsExpr;
  10180. begin
  10181. Value:=Params.Value;
  10182. if Value=nil then
  10183. RaiseInternalError(20180423093120,GetObjName(Params));
  10184. if IsNameExpr(Value) then
  10185. begin
  10186. // e.g. Name[]
  10187. ResolveArrayParamsExprName(Value,Params,Access);
  10188. exit;
  10189. end
  10190. else if Value.ClassType=TParamsExpr then
  10191. begin
  10192. SubParams:=TParamsExpr(Value);
  10193. // e.g. Name()[] or Name[][] or [][]
  10194. ResolveExpr(SubParams,rraRead);
  10195. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10196. if Value.CustomData=nil then
  10197. CreateReference(ResolvedEl.LoTypeEl,Value,Access);
  10198. ResolvedEl.IdentEl:=nil;
  10199. end
  10200. else if Value.InheritsFrom(TUnaryExpr) then
  10201. begin
  10202. ResolveExpr(TUnaryExpr(Value).Operand,Access);
  10203. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  10204. end
  10205. else if Value is TBinaryExpr then
  10206. begin
  10207. // Note: a.b[] is the same as (a.b)[]
  10208. // Note: a.b[].c is stored as
  10209. // TBinaryExpr eopSubIdent
  10210. // / \
  10211. // left = TParamsExpr right = TPrimitiveExpr 'c'
  10212. // Value = TBinaryExpr
  10213. // / \
  10214. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  10215. while (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) do
  10216. Value:=TBinaryExpr(Value).right;
  10217. if IsNameExpr(Value) then
  10218. begin
  10219. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10220. if not (Value.CustomData is TResolvedReference) then
  10221. RaiseNotYetImplemented(20190115144534,Params);
  10222. // already resolved
  10223. exit;
  10224. end
  10225. else
  10226. begin
  10227. // ToDo: (a+b)[]
  10228. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  10229. RaiseNotYetImplemented(20190115144539,Params);
  10230. end;
  10231. end
  10232. else
  10233. RaiseNotYetImplemented(20160927212610,Value);
  10234. {$IFDEF VerbosePasResolver}
  10235. writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
  10236. {$ENDIF}
  10237. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10238. end;
  10239. procedure TPasResolver.ResolveArrayParamsExprName(NameExpr: TPasExpr;
  10240. Params: TParamsExpr; Access: TResolvedRefAccess);
  10241. // e.g. a.NameExpr[]
  10242. var
  10243. ArrayName: String;
  10244. FindData: TPRFindData;
  10245. Ref: TResolvedReference;
  10246. DeclEl: TPasElement;
  10247. Proc, ImplProc: TPasProcedure;
  10248. ProcScope: TPasProcedureScope;
  10249. ResolvedEl: TPasResolverResult;
  10250. begin
  10251. if (NameExpr.ClassType=TPrimitiveExpr)
  10252. and (TPrimitiveExpr(NameExpr).Kind=pekIdent) then
  10253. // e.g. Name[]
  10254. ArrayName:=TPrimitiveExpr(NameExpr).Value
  10255. else if NameExpr.ClassType=TInlineSpecializeExpr then
  10256. RaiseMsg(20190912190518,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10257. ['[','inline specialize'],Params)
  10258. else
  10259. RaiseNotYetImplemented(20190131154557,NameExpr);
  10260. DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true);
  10261. Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData);
  10262. CheckFoundElement(FindData,Ref);
  10263. if DeclEl is TPasProcedure then
  10264. begin
  10265. Proc:=TPasProcedure(DeclEl);
  10266. if (Access=rraAssign)
  10267. and (Proc.ProcType is TPasFunctionType)
  10268. and (Params.Parent.ClassType=TPasImplAssign)
  10269. and (TPasImplAssign(Params.Parent).left=Params) then
  10270. begin
  10271. // e.g. funcname[]:=
  10272. ProcScope:=Proc.CustomData as TPasProcedureScope;
  10273. ImplProc:=ProcScope.ImplProc;
  10274. if ImplProc=nil then
  10275. ImplProc:=Proc;
  10276. if Params.HasParent(ImplProc) then
  10277. begin
  10278. // "FuncA[]:=" within FuncA -> redirect to ResultEl
  10279. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  10280. end;
  10281. end;
  10282. end;
  10283. ComputeElement(NameExpr,ResolvedEl,[rcSetReferenceFlags]);
  10284. {$IFDEF VerbosePasResolver}
  10285. writeln('TPasResolver.ResolveArrayParamsExprName NameExp=',GetObjName(NameExpr),' ',GetResolverResultDbg(ResolvedEl));
  10286. {$ENDIF}
  10287. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10288. end;
  10289. procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
  10290. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
  10291. procedure ReadAccessParamValue;
  10292. var
  10293. Left: TPasExpr;
  10294. Ref: TResolvedReference;
  10295. begin
  10296. if Access=rraAssign then
  10297. begin
  10298. // ArrayStringPointer[]:=
  10299. // -> writing the element needs reading the value
  10300. Left:=Params.Value;
  10301. if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode=eopSubIdent) then
  10302. Left:=TBinaryExpr(Left).right;
  10303. if Left.CustomData is TResolvedReference then
  10304. begin
  10305. Ref:=TResolvedReference(Left.CustomData);
  10306. if Ref.Access=rraAssign then
  10307. Ref.Access:=rraReadAndAssign;
  10308. end;
  10309. end;
  10310. end;
  10311. function CheckStringOrPointerIndex(IsStringIndex: boolean): boolean;
  10312. var
  10313. ArgExp: TPasExpr;
  10314. ResolvedArg: TPasResolverResult;
  10315. begin
  10316. ReadAccessParamValue;
  10317. if not IsStringIndex then
  10318. begin
  10319. // pointer
  10320. if not ElHasBoolSwitch(Params,bsPointerMath) then
  10321. exit(false);
  10322. end;
  10323. Result:=true;
  10324. if not (rrfReadable in ResolvedValue.Flags) then
  10325. RaiseXExpectedButYFound(20170216152548,'index',GetElementTypeName(ResolvedValue.LoTypeEl),Params);
  10326. // check single argument
  10327. if length(Params.Params)<1 then
  10328. RaiseMsg(20170216152204,nMissingParameterX,
  10329. sMissingParameterX,[BoolToStr(IsStringIndex,'character index','index')],Params)
  10330. else if length(Params.Params)>1 then
  10331. RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
  10332. // check argument is integer
  10333. ArgExp:=Params.Params[0];
  10334. ComputeElement(ArgExp,ResolvedArg,[rcSetReferenceFlags]);
  10335. if not (ResolvedArg.BaseType in btAllInteger) then
  10336. RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10337. [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
  10338. if not (rrfReadable in ResolvedArg.Flags) then
  10339. RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10340. ['type','value'],ArgExp);
  10341. AccessExpr(ArgExp,rraRead);
  10342. end;
  10343. var
  10344. PropEl: TPasProperty;
  10345. i: Integer;
  10346. TypeEl: TPasType;
  10347. C: TClass;
  10348. begin
  10349. if ResolvedValue.BaseType in btAllStrings then
  10350. begin
  10351. // string -> check that ResolvedValue is not merely a type, but has a value
  10352. if CheckStringOrPointerIndex(true) then
  10353. exit;
  10354. end
  10355. else if (ResolvedValue.IdentEl is TPasProperty)
  10356. and (GetPasPropertyArgs(TPasProperty(ResolvedValue.IdentEl)).Count>0) then
  10357. begin
  10358. PropEl:=TPasProperty(ResolvedValue.IdentEl);
  10359. CheckCallPropertyCompatibility(PropEl,Params,true);
  10360. FinishPropertyParamAccess(Params,PropEl);
  10361. exit;
  10362. end
  10363. else if ResolvedValue.BaseType=btPointer then
  10364. begin
  10365. if CheckStringOrPointerIndex(false) then
  10366. exit;
  10367. end
  10368. else if ResolvedValue.BaseType=btContext then
  10369. begin
  10370. TypeEl:=ResolvedValue.LoTypeEl;
  10371. C:=TypeEl.ClassType;
  10372. if (C=TPasClassType)
  10373. or (C=TPasRecordType)
  10374. or (C=TPasClassOfType) then
  10375. begin
  10376. if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,Access) then
  10377. exit;
  10378. end
  10379. else if C=TPasArrayType then
  10380. begin
  10381. if ResolvedValue.IdentEl is TPasType then
  10382. RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10383. ['[',ResolvedValue.IdentEl.ElementTypeName],Params);
  10384. ReadAccessParamValue;
  10385. CheckCallArrayCompatibility(TPasArrayType(TypeEl),Params,true,true);
  10386. for i:=0 to length(Params.Params)-1 do
  10387. AccessExpr(Params.Params[i],rraRead);
  10388. exit;
  10389. end
  10390. else if C=TPasPointerType then
  10391. begin
  10392. if CheckStringOrPointerIndex(false) then exit;
  10393. end;
  10394. end;
  10395. RaiseMsg(20170216152217,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10396. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10397. end;
  10398. function TPasResolver.ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  10399. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess): boolean;
  10400. var
  10401. PropEl: TPasProperty;
  10402. Value: TPasExpr;
  10403. Group: TPasGroupScope;
  10404. i: Integer;
  10405. Scope: TPasIdentifierScope;
  10406. HiType, LoType: TPasType;
  10407. IsClassOf: Boolean;
  10408. begin
  10409. HiType:=ResolvedValue.HiTypeEl;
  10410. LoType:=ResolvedValue.LoTypeEl;
  10411. IsClassOf:=LoType.ClassType=TPasClassOfType;
  10412. if IsClassOf then
  10413. begin
  10414. HiType:=TPasClassOfType(LoType).DestType;
  10415. LoType:=ResolveAliasType(LoType);
  10416. end;
  10417. Group:=CreateGroupScope(HiType);
  10418. PropEl:=nil;
  10419. for i:=0 to Group.Count-1 do
  10420. begin
  10421. Scope:=Group.Scopes[i];
  10422. if Scope is TPasClassOrRecordScope then
  10423. begin
  10424. PropEl:=TPasClassOrRecordScope(Scope).DefaultProperty;
  10425. if PropEl<>nil then break;
  10426. end;
  10427. end;
  10428. Group.Free;
  10429. if PropEl=nil then exit(false);
  10430. // class/record/interface has default property
  10431. if (IsClassOf or (ResolvedValue.IdentEl is TPasType)) and (not PropEl.IsClass) then
  10432. RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10433. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10434. Value:=Params.Value;
  10435. if Value.CustomData is TResolvedReference then
  10436. SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
  10437. CreateReference(PropEl,Params,Access);
  10438. CheckCallPropertyCompatibility(PropEl,Params,true);
  10439. FinishPropertyParamAccess(Params,PropEl);
  10440. Result:=true;
  10441. end;
  10442. procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
  10443. // e.g. resolving '[1,2..3]'
  10444. var
  10445. i: Integer;
  10446. Param: TPasExpr;
  10447. ParamResolved: TPasResolverResult;
  10448. begin
  10449. {$IFDEF VerbosePasResolver}
  10450. writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
  10451. {$ENDIF}
  10452. if Params.Value<>nil then
  10453. RaiseNotYetImplemented(20160930135910,Params);
  10454. for i:=0 to length(Params.Params)-1 do
  10455. begin
  10456. Param:=Params.Params[i];
  10457. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType,rcSetReferenceFlags]);
  10458. end;
  10459. end;
  10460. procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
  10461. var
  10462. i: Integer;
  10463. begin
  10464. for i:=0 to length(El.Values)-1 do
  10465. ResolveExpr(El.Values[i],rraRead);
  10466. end;
  10467. procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
  10468. function GetMember(RecType: TPasRecordType; const aName: string): TPasElement;
  10469. var
  10470. i: Integer;
  10471. begin
  10472. for i:=0 to RecType.Members.Count-1 do
  10473. begin
  10474. Result:=TPasElement(RecType.Members[i]);
  10475. if SameText(Result.Name,aName) then
  10476. exit;
  10477. end;
  10478. if RecType.VariantEl is TPasVariable then
  10479. begin
  10480. Result:=TPasVariable(RecType.VariantEl);
  10481. if SameText(Result.Name,aName) then
  10482. exit;
  10483. end;
  10484. if RecType.Variants<>nil then
  10485. for i:=0 to RecType.Variants.Count-1 do
  10486. begin
  10487. Result:=GetMember(TPasVariant(RecType.Variants[i]).Members,aName);
  10488. if Result<>nil then
  10489. exit;
  10490. end;
  10491. Result:=nil;
  10492. end;
  10493. var
  10494. i, j: Integer;
  10495. Member: TPasElement;
  10496. RecType: TPasRecordType;
  10497. Field: PRecordValuesItem;
  10498. s: String;
  10499. ResolvedEl: TPasResolverResult;
  10500. begin
  10501. {$IFDEF VerbosePasResolver}
  10502. writeln('TPasResolver.ResolveRecordValues ',El.Fields[0].Name,' ',GetObjName(El.Parent),' ',GetObjName(El.Parent.Parent));
  10503. {$ENDIF}
  10504. ComputeElement(El,ResolvedEl,[]);
  10505. if (ResolvedEl.BaseType<>btContext)
  10506. or (ResolvedEl.LoTypeEl.ClassType<>TPasRecordType) then
  10507. begin
  10508. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  10509. [],'record value',GetTypeDescription(ResolvedEl),El);
  10510. end;
  10511. RecType:=TPasRecordType(ResolvedEl.LoTypeEl);
  10512. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(El.Parent),' ',GetObjName(RecType));
  10513. for i:=0 to length(El.Fields)-1 do
  10514. begin
  10515. Field:[email protected][i];
  10516. // check member exists
  10517. Member:=GetMember(RecType,Field^.Name);
  10518. if Member=nil then
  10519. RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
  10520. if Member.ClassType<>TPasVariable then
  10521. RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10522. [],Field^.ValueExp);
  10523. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10524. RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10525. ['record assignment'],Field^.ValueExp);
  10526. CreateReference(Member,Field^.NameExp,rraAssign);
  10527. // check duplicates
  10528. for j:=0 to i-1 do
  10529. if SameText(Field^.Name,El.Fields[j].Name) then
  10530. RaiseMsg(20180429104942,nDuplicateIdentifier,sDuplicateIdentifier,
  10531. [Field^.Name,GetElementSourcePosStr(El.Fields[j].NameExp)],Field^.NameExp);
  10532. // resolve expression
  10533. ResolveExpr(El.Fields[i].ValueExp,rraRead);
  10534. // check compatible
  10535. CheckAssignCompatibility(Member,Field^.ValueExp);
  10536. end;
  10537. // hint for missing fields
  10538. s:='';
  10539. for i:=0 to RecType.Members.Count-1 do
  10540. begin
  10541. Member:=TPasElement(RecType.Members[i]);
  10542. if Member.ClassType<>TPasVariable then continue;
  10543. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10544. continue;
  10545. j:=length(El.Fields)-1;
  10546. while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
  10547. dec(j);
  10548. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(Member),' ',j);
  10549. if j<0 then
  10550. begin
  10551. if s<>'' then s:=s+', ';
  10552. if length(s)>30 then
  10553. begin
  10554. s:=s+'...';
  10555. break;
  10556. end;
  10557. s:=s+Member.Name;
  10558. end;
  10559. end;
  10560. // ToDo: hint for missing variants
  10561. if s<>'' then
  10562. LogMsg(20180429121127,mtHint,nMissingFieldsX,sMissingFieldsX,[s],El);
  10563. end;
  10564. procedure TPasResolver.ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr;
  10565. Access: TResolvedRefAccess);
  10566. begin
  10567. // params are TPasTypes and already resolved
  10568. if El.Params.Count=0 then
  10569. RaiseMsg(20190916155014,nMissingParameterX,sMissingParameterX,['type'],El);
  10570. // resolve name
  10571. // Note: ResolveNameExpr considers the params
  10572. ResolveExpr(El.NameExpr,Access);
  10573. end;
  10574. function TPasResolver.ResolveAccessor(Expr: TPasExpr): TPasElement;
  10575. function SubResolvePrimitive(Prim: TPrimitiveExpr): TPasElement;
  10576. var
  10577. FindData: TPRFindData;
  10578. Ref: TResolvedReference;
  10579. Scope: TPasScope;
  10580. Abort: boolean;
  10581. begin
  10582. if Prim.Kind<>pekIdent then
  10583. RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
  10584. // search in class and ancestors, not in unit interface
  10585. Scope:=TopScope;
  10586. FindData:=Default(TPRFindData);
  10587. FindData.ErrorPosEl:=Expr;
  10588. Abort:=false;
  10589. Scope.IterateElements(Prim.Value,Scope,@OnFindFirst,@FindData,Abort);
  10590. Result:=FindData.Found;
  10591. if Result=nil then
  10592. RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
  10593. Ref:=CreateReference(Result,Prim,rraRead);
  10594. CheckFoundElementVisibility(FindData,Ref);
  10595. end;
  10596. var
  10597. Prim: TPrimitiveExpr;
  10598. DeclEl: TPasElement;
  10599. begin
  10600. if Expr.ClassType=TBinaryExpr then
  10601. begin
  10602. DeclEl:=nil;
  10603. if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
  10604. begin
  10605. Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
  10606. DeclEl:=SubResolvePrimitive(Prim);
  10607. if not (DeclEl is TPasMembersType) then
  10608. RaiseXExpectedButYFound(20170216151752,'class',GetElementTypeName(DeclEl),Prim);
  10609. end
  10610. else
  10611. RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10612. if TBinaryExpr(Expr).OpCode<>eopSubIdent then
  10613. RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10614. if DeclEl.ClassType=TPasClassType then
  10615. PushClassDotScope(TPasClassType(DeclEl))
  10616. else if DeclEl.ClassType=TPasRecordType then
  10617. PushRecordDotScope(TPasRecordType(DeclEl))
  10618. else
  10619. RaiseMsg(20190123145559,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10620. Expr:=TBinaryExpr(Expr).right;
  10621. Result:=ResolveAccessor(Expr);
  10622. PopScope;
  10623. end
  10624. else if Expr.ClassType=TPrimitiveExpr then
  10625. begin
  10626. Prim:=TPrimitiveExpr(Expr);
  10627. Result:=SubResolvePrimitive(Prim);
  10628. end
  10629. else
  10630. RaiseNotYetImplemented(20160922163436,Expr);
  10631. end;
  10632. procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
  10633. Ref: TResolvedReference; Access: TResolvedRefAccess);
  10634. begin
  10635. if (Ref.Access=Access) then exit;
  10636. if Access in [rraNone,rraParamToUnknownProc] then
  10637. exit;
  10638. if Expr=nil then ;
  10639. case Ref.Access of
  10640. rraNone,rraParamToUnknownProc:
  10641. Ref.Access:=Access;
  10642. rraRead:
  10643. if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
  10644. Ref.Access:=rraReadAndAssign
  10645. else
  10646. exit;
  10647. rraAssign,rraOutParam:
  10648. if Access in [rraRead,rraReadAndAssign,rraVarParam] then
  10649. Ref.Access:=rraReadAndAssign
  10650. else
  10651. exit;
  10652. rraReadAndAssign: exit;
  10653. rraVarParam: exit;
  10654. else
  10655. RaiseInternalError(20170403163727);
  10656. end;
  10657. end;
  10658. procedure TPasResolver.AccessExpr(Expr: TPasExpr;
  10659. Access: TResolvedRefAccess);
  10660. // called after a call target was found, called for each element
  10661. // to change the rraParamToUnknownProc value to Access
  10662. var
  10663. Ref: TResolvedReference;
  10664. Bin: TBinaryExpr;
  10665. Params: TParamsExpr;
  10666. ValueResolved: TPasResolverResult;
  10667. C: TClass;
  10668. begin
  10669. if (Expr.CustomData is TResolvedReference) then
  10670. begin
  10671. Ref:=TResolvedReference(Expr.CustomData);
  10672. SetResolvedRefAccess(Expr,Ref,Access);
  10673. end;
  10674. C:=Expr.ClassType;
  10675. if C=TBinaryExpr then
  10676. begin
  10677. Bin:=TBinaryExpr(Expr);
  10678. if Bin.OpCode in [eopSubIdent,eopNone] then
  10679. AccessExpr(Bin.right,Access);
  10680. end
  10681. else if C=TParamsExpr then
  10682. begin
  10683. Params:=TParamsExpr(Expr);
  10684. case Params.Kind of
  10685. pekFuncParams:
  10686. if IsTypeCast(Params) then
  10687. FinishCallArgAccess(Params.Params[0],Access)
  10688. else
  10689. AccessExpr(Params.Value,Access);
  10690. pekArrayParams:
  10691. begin
  10692. ComputeElement(Params.Value,ValueResolved,[]);
  10693. if IsDynArray(ValueResolved.LoTypeEl,false)
  10694. or (ValueResolved.BaseType=btPointer) then
  10695. // when accessing an element of a dynamic array the array is read
  10696. AccessExpr(Params.Value,rraRead)
  10697. else
  10698. AccessExpr(Params.Value,Access);
  10699. // Note: an element of an open or static array or a string is connected to the variable
  10700. end;
  10701. pekSet:
  10702. if Access<>rraRead then
  10703. RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  10704. else
  10705. RaiseNotYetImplemented(20170403173831,Params);
  10706. end;
  10707. end
  10708. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  10709. // ok
  10710. else if (Access in [rraRead,rraParamToUnknownProc])
  10711. and ((C=TPrimitiveExpr)
  10712. or (C=TNilExpr)
  10713. or (C=TBoolConstExpr)
  10714. or (C=TProcedureExpr)) then
  10715. // ok
  10716. else if C=TUnaryExpr then
  10717. AccessExpr(TUnaryExpr(Expr).Operand,Access)
  10718. else
  10719. begin
  10720. {$IFDEF VerbosePasResolver}
  10721. writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  10722. {$ENDIF}
  10723. RaiseNotYetImplemented(20170306102158,Expr);
  10724. end;
  10725. end;
  10726. function TPasResolver.MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType
  10727. ): boolean;
  10728. var
  10729. Ref: TResolvedReference;
  10730. begin
  10731. if Expr.CustomData=nil then
  10732. begin
  10733. // mark set expression as array
  10734. CreateReference(ArrayType,Expr,rraRead);
  10735. Result:=true;
  10736. end
  10737. else if Expr.CustomData is TResolvedReference then
  10738. begin
  10739. // already set
  10740. Result:=false;
  10741. // check consistency
  10742. Ref:=TResolvedReference(Expr.CustomData);
  10743. if not (Ref.Declaration is TPasArrayType) then
  10744. begin
  10745. {$IFDEF VerbosePasResolver}
  10746. writeln('TPasResolver.MarkArrayExpr Expr=',GetObjName(Expr),' Ref.Declaration=',GetObjName(Ref.Declaration),' ',Ref.Declaration.ParentPath);
  10747. {$ENDIF}
  10748. RaiseNotYetImplemented(20180618102230,Expr,GetObjName(Ref.Declaration));
  10749. end;
  10750. end
  10751. else
  10752. // already set with something else
  10753. RaiseNotYetImplemented(20180618102408,Expr,GetObjName(Expr.CustomData));
  10754. end;
  10755. procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
  10756. ArrType: TPasArrayType);
  10757. procedure Traverse(CurExpr: TPasExpr; ArrayType: TPasArrayType; RgIndex: integer);
  10758. var
  10759. Params: TPasExprArray;
  10760. i: Integer;
  10761. ResolvedElType: TPasResolverResult;
  10762. ParamsExpr: TParamsExpr;
  10763. BuiltInProc: TResElDataBuiltInProc;
  10764. Ref: TResolvedReference;
  10765. begin
  10766. if IsArrayOperatorAdd(CurExpr) then
  10767. begin
  10768. Traverse(TBinaryExpr(CurExpr).left,ArrayType,RgIndex);
  10769. Traverse(TBinaryExpr(CurExpr).right,ArrayType,RgIndex);
  10770. end
  10771. else if CurExpr.ClassType=TParamsExpr then
  10772. begin
  10773. ParamsExpr:=TParamsExpr(CurExpr);
  10774. Params:=ParamsExpr.Params;
  10775. if CurExpr.Kind=pekSet then
  10776. begin
  10777. MarkArrayExpr(ParamsExpr,ArrayType);
  10778. // traverse into nested expressions, e.g. [ A, B ]
  10779. if length(Params)=0 then exit;
  10780. inc(RgIndex);
  10781. if RgIndex>length(ArrayType.Ranges) then
  10782. begin
  10783. if ArrayType.ElType=nil then
  10784. exit; // elements are not arrays
  10785. ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
  10786. if (ResolvedElType.BaseType=btContext)
  10787. and (ResolvedElType.LoTypeEl is TPasArrayType) then
  10788. begin
  10789. ArrayType:=TPasArrayType(ResolvedElType.LoTypeEl);
  10790. RgIndex:=0;
  10791. end
  10792. else
  10793. exit; // elements are not arrays
  10794. end;
  10795. for i:=0 to length(Params)-1 do
  10796. Traverse(Params[i],ArrayType,RgIndex);
  10797. end
  10798. else if CurExpr.Kind=pekFuncParams then
  10799. begin
  10800. if TParamsExpr(CurExpr).Value.CustomData is TResolvedReference then
  10801. begin
  10802. Ref:=TResolvedReference(TParamsExpr(CurExpr).Value.CustomData);
  10803. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  10804. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  10805. begin
  10806. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  10807. if BuiltInProc.BuiltIn=bfConcatArray then
  10808. begin
  10809. // concat(array1,array2,...)
  10810. for i:=0 to length(Params)-1 do
  10811. Traverse(Params[i],ArrayType,RgIndex);
  10812. end
  10813. else if BuiltInProc.BuiltIn=bfCopyArray then
  10814. // copy(array,...)
  10815. Traverse(Params[0],ArrayType,RgIndex);
  10816. end;
  10817. end;
  10818. end;
  10819. end;
  10820. end;
  10821. begin
  10822. Traverse(Expr,ArrType,0);
  10823. end;
  10824. procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
  10825. var
  10826. i: Integer;
  10827. DeclEl: TPasElement;
  10828. Proc: TPasProcedure;
  10829. aClassOrRec: TPasMembersType;
  10830. ClassOrRecScope: TPasClassOrRecordScope;
  10831. begin
  10832. if IsElementSkipped(El) then exit;
  10833. if El is TPasDeclarations then
  10834. begin
  10835. for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
  10836. begin
  10837. DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
  10838. if DeclEl is TPasProcedure then
  10839. begin
  10840. Proc:=TPasProcedure(DeclEl);
  10841. if ProcNeedsImplProc(Proc)
  10842. and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
  10843. RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
  10844. [GetElementTypeName(Proc),Proc.Name],Proc);
  10845. end;
  10846. end;
  10847. end
  10848. else if El is TPasMembersType then
  10849. begin
  10850. aClassOrRec:=TPasMembersType(El);
  10851. if (aClassOrRec is TPasClassType) then
  10852. begin
  10853. if (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface]) then
  10854. exit;
  10855. if TPasClassType(aClassOrRec).IsForward then
  10856. exit;
  10857. if TPasClassType(aClassOrRec).IsExternal then
  10858. exit;
  10859. end;
  10860. ClassOrRecScope:=aClassOrRec.CustomData as TPasClassOrRecordScope;
  10861. if ClassOrRecScope.SpecializedFromItem<>nil then
  10862. exit;
  10863. // finish implementation of (generic) class/record
  10864. if ClassOrRecScope.GenericStep<>psgsInterfaceParsed then
  10865. RaiseNotYetImplemented(20190804115324,El);
  10866. for i:=0 to aClassOrRec.Members.Count-1 do
  10867. begin
  10868. DeclEl:=TPasElement(aClassOrRec.Members[i]);
  10869. if DeclEl is TPasProcedure then
  10870. begin
  10871. Proc:=TPasProcedure(DeclEl);
  10872. if Proc.IsAbstract or Proc.IsExternal then continue;
  10873. if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
  10874. begin
  10875. {$IFDEF VerbosePasResolver}
  10876. writeln('TPasResolver.CheckPendingForwardProcs Proc.ParentPath=',Proc.PathName);
  10877. {$ENDIF}
  10878. RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
  10879. [GetElementTypeName(Proc),Proc.Name],Proc);
  10880. end;
  10881. end;
  10882. end;
  10883. ClassOrRecScope.GenericStep:=psgsImplementationParsed;
  10884. if ClassOrRecScope.SpecializedItems<>nil then
  10885. FinishSpecializations(ClassOrRecScope);
  10886. end;
  10887. end;
  10888. procedure TPasResolver.CheckPointerCycle(El: TPasPointerType);
  10889. var
  10890. C: TClass;
  10891. CurEl, Dest: TPasType;
  10892. begin
  10893. CurEl:=El;
  10894. while CurEl<>nil do
  10895. begin
  10896. C:=CurEl.ClassType;
  10897. if C=TPasPointerType then
  10898. Dest:=TPasPointerType(CurEl).DestType
  10899. else if C.InheritsFrom(TPasAliasType) then
  10900. Dest:=TPasAliasType(CurEl).DestType
  10901. else
  10902. exit;
  10903. if Dest=El then
  10904. RaiseMsg(20180422165758,nTypeCycleFound,sTypeCycleFound,[],El);
  10905. CurEl:=Dest;
  10906. end;
  10907. end;
  10908. procedure TPasResolver.CheckGenericTemplateTypes(El: TPasGenericType);
  10909. var
  10910. GenTemplates: TFPList;
  10911. i: Integer;
  10912. TemplType: TPasGenericTemplateType;
  10913. begin
  10914. GenTemplates:=El.GenericTemplateTypes;
  10915. if (GenTemplates=nil) or (GenTemplates.Count=0) then
  10916. RaiseNotYetImplemented(20190726184902,El,'emty generic template list');
  10917. // template names must differ from generic type name
  10918. for i:=0 to GenTemplates.Count-1 do
  10919. begin
  10920. TemplType:=TPasGenericTemplateType(GenTemplates[i]);
  10921. if SameText(TemplType.Name,El.Name) then
  10922. RaiseMsg(20190801101444,nDuplicateIdentifier,sDuplicateIdentifier,[
  10923. TemplType.Name,GetElementSourcePosStr(El)],TemplType);
  10924. end;
  10925. end;
  10926. procedure TPasResolver.ComputeUnaryNot(El: TUnaryExpr;
  10927. var ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  10928. begin
  10929. RaiseMsg(20180208121532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  10930. [OpcodeStrings[El.OpCode],GetResolverResultDescription(ResolvedEl)],El);
  10931. if Flags=[] then ;
  10932. end;
  10933. procedure TPasResolver.AddModule(El: TPasModule);
  10934. var
  10935. C: TClass;
  10936. ModScope: TPasModuleScope;
  10937. begin
  10938. if TopScope<>DefaultScope then
  10939. RaiseInvalidScopeForElement(20160922163504,El);
  10940. ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module));
  10941. ModScope.VisibilityContext:=El;
  10942. ModScope.FirstName:=FirstDottedIdentifier(El.Name);
  10943. C:=El.ClassType;
  10944. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  10945. FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
  10946. else
  10947. FDefaultNameSpace:='';
  10948. ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  10949. end;
  10950. procedure TPasResolver.AddSection(El: TPasSection);
  10951. // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
  10952. // Note: implementation scope is within the interface scope
  10953. var
  10954. Scope: TPasSectionScope;
  10955. begin
  10956. if TopScope is TPasSectionScope then
  10957. FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
  10958. if TopScope is TPasModuleScope then
  10959. TPasModuleScope(TopScope).BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  10960. {$IFDEF VerbosePasResolver}
  10961. if FPendingForwardProcs.IndexOf(El)=0 then
  10962. RaiseNotYetImplemented(20190804114718,El);
  10963. {$ENDIF}
  10964. FPendingForwardProcs.Add(El); // check forward declarations at the end
  10965. Scope:=TPasSectionScope(PushScope(El,ScopeClass_Section));
  10966. Scope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  10967. Scope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  10968. end;
  10969. procedure TPasResolver.AddInitialFinalizationSection(El: TPasImplBlock);
  10970. begin
  10971. PushScope(El,ScopeClass_InitialFinalization);
  10972. end;
  10973. procedure TPasResolver.AddType(El: TPasType);
  10974. begin
  10975. if (El.Name='') then exit; // sub type
  10976. {$IFDEF VerbosePasResolver}
  10977. writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
  10978. {$ENDIF}
  10979. if not (TopScope is TPasIdentifierScope) then
  10980. RaiseInvalidScopeForElement(20160922163506,El);
  10981. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  10982. end;
  10983. procedure TPasResolver.AddArrayType(El: TPasArrayType; TypeParams: TFPList);
  10984. var
  10985. Scope: TPasArrayScope;
  10986. begin
  10987. {$IFDEF VerbosePasResolver}
  10988. writeln('TPasResolver.AddArrayType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  10989. {$ENDIF}
  10990. if TypeParams<>nil then
  10991. begin
  10992. El.SetGenericTemplates(TypeParams);
  10993. TypeParams:=El.GenericTemplateTypes;
  10994. CheckGenericTemplateTypes(El);
  10995. end;
  10996. PopGenericParamScope(El);
  10997. if El.Name<>'' then begin
  10998. if not (TopScope is TPasIdentifierScope) then
  10999. RaiseInvalidScopeForElement(20190812215622,El);
  11000. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11001. if TypeParams<>nil then
  11002. begin
  11003. Scope:=TPasArrayScope(PushScope(El,TPasArrayScope));
  11004. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11005. end;
  11006. end else if TypeParams<>nil then
  11007. RaiseNotYetImplemented(20190812215851,El);
  11008. end;
  11009. procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList);
  11010. var
  11011. Scope: TPasRecordScope;
  11012. begin
  11013. {$IFDEF VerbosePasResolver}
  11014. writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11015. {$ENDIF}
  11016. if TypeParams<>nil then
  11017. begin
  11018. El.SetGenericTemplates(TypeParams);
  11019. TypeParams:=El.GenericTemplateTypes;
  11020. CheckGenericTemplateTypes(El);
  11021. end;
  11022. PopGenericParamScope(El);
  11023. if not (TopScope is TPasIdentifierScope) then
  11024. RaiseInvalidScopeForElement(20160922163508,El);
  11025. if El.Name<>'' then begin
  11026. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11027. {$IFDEF VerbosePasResolver}
  11028. if FPendingForwardProcs.IndexOf(El)=0 then
  11029. RaiseNotYetImplemented(20190804114737,El);
  11030. {$ENDIF}
  11031. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11032. end;
  11033. if El.Parent.ClassType<>TPasVariant then
  11034. begin
  11035. Scope:=TPasRecordScope(PushScope(El,TPasRecordScope));
  11036. Scope.VisibilityContext:=El;
  11037. if TypeParams<>nil then
  11038. begin
  11039. // generic array
  11040. if El.Name='' then
  11041. RaiseNotYetImplemented(20190812220821,El);
  11042. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11043. end;
  11044. end;
  11045. end;
  11046. procedure TPasResolver.AddClassType(El: TPasClassType; TypeParams: TFPList);
  11047. // Note: IsForward is not yet set!
  11048. var
  11049. Duplicate: TPasIdentifier;
  11050. ForwardDecl: TPasClassType;
  11051. CurScope, LocalScope: TPasIdentifierScope;
  11052. GenTemplCnt, i, j: Integer;
  11053. ClassScope: TPasClassScope;
  11054. ForwGenTempl, ActGenTempl: TPasGenericTemplateType;
  11055. ForwConstraints, ActConstraints: TPasElementArray;
  11056. DuplEl, ForwConstraint, ActConstraint: TPasElement;
  11057. ForwToken, ActToken: TToken;
  11058. ForwConstraintResolved, ActConstraintResolved: TPasResolverResult;
  11059. begin
  11060. // Beware: El.ObjKind is not yet set!
  11061. {$IFDEF VerbosePasResolver}
  11062. //writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
  11063. {$ENDIF}
  11064. if not (TopScope is TPasIdentifierScope) then
  11065. RaiseInvalidScopeForElement(20160922163510,El);
  11066. if TypeParams=nil then
  11067. begin
  11068. GenTemplCnt:=0;
  11069. if TopScope is TPasGenericParamsScope then
  11070. RaiseNotYetImplemented(20190831205006,El,GetObjName(TopScope));
  11071. CurScope:=TPasIdentifierScope(TopScope);
  11072. end
  11073. else
  11074. begin
  11075. if not (TopScope is TPasGenericParamsScope) then
  11076. RaiseInvalidScopeForElement(20190831205038,El,GetObjName(TopScope));
  11077. CurScope:=TPasIdentifierScope(Scopes[ScopeCount-2]);
  11078. GenTemplCnt:=TypeParams.Count;
  11079. El.SetGenericTemplates(TypeParams);
  11080. TypeParams:=El.GenericTemplateTypes;
  11081. CheckGenericTemplateTypes(El);
  11082. end;
  11083. if CurScope is TPasGroupScope then
  11084. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11085. else
  11086. LocalScope:=CurScope;
  11087. Duplicate:=LocalScope.FindLocalIdentifier(El.Name);
  11088. while Duplicate<>nil do
  11089. begin
  11090. DuplEl:=Duplicate.Element;
  11091. if (DuplEl is TPasGenericType)
  11092. and (GetTypeParameterCount(TPasGenericType(DuplEl))=GenTemplCnt) then
  11093. break;
  11094. Duplicate:=Duplicate.NextSameIdentifier;
  11095. end;
  11096. //if Duplicate<>nil then
  11097. //writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
  11098. if (Duplicate<>nil)
  11099. and (Duplicate.Element is TPasClassType)
  11100. and TPasClassType(Duplicate.Element).IsForward
  11101. and (Duplicate.Element.Parent=El.Parent)
  11102. then
  11103. begin
  11104. // forward declaration found
  11105. ForwardDecl:=TPasClassType(Duplicate.Element);
  11106. {$IFDEF VerbosePasResolver}
  11107. writeln(' Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
  11108. {$ENDIF}
  11109. if GenTemplCnt>0 then
  11110. begin
  11111. // check generic constraints match exactly
  11112. for i:=0 to GenTemplCnt-1 do
  11113. begin
  11114. ForwGenTempl:=TPasGenericTemplateType(ForwardDecl.GenericTemplateTypes[i]);
  11115. ActGenTempl:=TPasGenericTemplateType(TypeParams[i]);
  11116. if not SameText(ForwGenTempl.Name,ActGenTempl.Name) then
  11117. RaiseMsg(20190814114811,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11118. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11119. ForwConstraints:=ForwGenTempl.Constraints;
  11120. ActConstraints:=ActGenTempl.Constraints;
  11121. if length(ForwConstraints)<>length(ActConstraints) then
  11122. RaiseMsg(20190814121031,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11123. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11124. for j:=0 to length(ForwConstraints)-1 do
  11125. begin
  11126. ForwConstraint:=ForwConstraints[j];
  11127. ActConstraint:=ActConstraints[j];
  11128. ForwToken:=GetGenericConstraintKeyword(ForwConstraint);
  11129. ActToken:=GetGenericConstraintKeyword(ActConstraint);
  11130. if ForwToken<>ActToken then
  11131. RaiseMsg(20190814121139,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11132. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwConstraint)],
  11133. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11134. if ForwToken=tkEOF then
  11135. begin
  11136. ComputeElement(ForwConstraint,ForwConstraintResolved,[rcType]);
  11137. ComputeElement(ActConstraint,ActConstraintResolved,[rcType]);
  11138. if CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,
  11139. ActConstraintResolved.LoTypeEl,prraNone)<>cExact then
  11140. RaiseMsg(20190814121509,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11141. [GetTypeDescription(ActGenTempl),
  11142. GetElementSourcePosStr(GetGenericConstraintErrorEl(ForwConstraint,ForwGenTempl))],
  11143. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11144. end;
  11145. end;
  11146. end;
  11147. end;
  11148. if ForwardDecl.CustomData<>nil then
  11149. begin
  11150. // move the classscope to the real declaration
  11151. ClassScope:=ForwardDecl.CustomData as TPasClassScope;
  11152. if El.CustomData<>nil then
  11153. RaiseInternalError(20190803202959,'real class has already customdata');
  11154. ForwardDecl.CustomData:=nil;
  11155. El.CustomData:=ClassScope;
  11156. ClassScope.Element:=El;
  11157. end;
  11158. // create a ref from the forward to the real declaration
  11159. CreateReference(El,ForwardDecl,rraRead);
  11160. // change the cache item
  11161. Duplicate.Element:=El;
  11162. end
  11163. else
  11164. AddIdentifier(CurScope,El.Name,El,pikSimple);
  11165. if TypeParams<>nil then
  11166. begin
  11167. // Parsing the ancestor+interface list requires the type params.
  11168. // AddGenericTemplateIdentifiers not needed, already in TPasGenericParamsScope
  11169. end;
  11170. {$IFDEF VerbosePasResolver}
  11171. if FPendingForwardProcs.IndexOf(El)>=0 then
  11172. RaiseNotYetImplemented(20190804114746,El);
  11173. {$ENDIF}
  11174. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11175. end;
  11176. procedure TPasResolver.AddVariable(El: TPasVariable);
  11177. begin
  11178. if (El.Name='') then exit; // anonymous var
  11179. {$IFDEF VerbosePasResolver}
  11180. writeln('TPasResolver.AddVariable ',GetObjName(El));
  11181. {$ENDIF}
  11182. if not (TopScope is TPasIdentifierScope) then
  11183. RaiseInvalidScopeForElement(20160929205730,El);
  11184. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11185. end;
  11186. procedure TPasResolver.AddResourceString(El: TPasResString);
  11187. var
  11188. C: TClass;
  11189. begin
  11190. {$IFDEF VerbosePasResolver}
  11191. writeln('TPasResolver.AddResourceString ',GetObjName(El));
  11192. {$ENDIF}
  11193. if not (TopScope is TPasIdentifierScope) then
  11194. RaiseInvalidScopeForElement(20171004092114,El);
  11195. C:=El.Parent.ClassType;
  11196. if not C.InheritsFrom(TPasSection) then
  11197. RaiseNotYetImplemented(20171004092518,El);
  11198. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11199. end;
  11200. procedure TPasResolver.AddEnumType(El: TPasEnumType);
  11201. var
  11202. CanonicalSet: TPasSetType;
  11203. EnumScope: TPasEnumTypeScope;
  11204. begin
  11205. {$IFDEF VerbosePasResolver}
  11206. writeln('TPasResolver.AddEnumType ',GetObjName(El));
  11207. {$ENDIF}
  11208. if not (TopScope is TPasIdentifierScope) then
  11209. RaiseInvalidScopeForElement(20160929205732,El);
  11210. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11211. EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
  11212. // add canonical set
  11213. if El.Parent is TPasSetType then
  11214. begin
  11215. // anonymous enumtype, e.g. "set of ()"
  11216. CanonicalSet:=TPasSetType(El.Parent);
  11217. CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11218. end
  11219. else
  11220. begin
  11221. CanonicalSet:=TPasSetType.Create('',El);
  11222. {$IFDEF CheckPasTreeRefCount}CanonicalSet.RefIds.Add('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11223. CanonicalSet.EnumType:=El;
  11224. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSetType.EnumType'){$ENDIF};
  11225. end;
  11226. EnumScope.CanonicalSet:=CanonicalSet;
  11227. end;
  11228. procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
  11229. var
  11230. i: Integer;
  11231. Scope: TPasScope;
  11232. Old: TPasIdentifier;
  11233. ClassOrRec: TPasMembersType;
  11234. begin
  11235. {$IFDEF VerbosePasResolver}
  11236. writeln('TPasResolver.AddEnumValue ',GetObjName(El));
  11237. {$ENDIF}
  11238. if not (TopScope is TPasEnumTypeScope) then
  11239. RaiseInvalidScopeForElement(20160929205736,El);
  11240. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11241. // propagate enum to parent scopes
  11242. // TEnum = (red, green); -> dot not propagate
  11243. // TFlags = set of (red,blue); -> propagate
  11244. if (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches)
  11245. and not (El.Parent.Parent is TPasSetType) then
  11246. exit;
  11247. for i:=ScopeCount-2 downto 0 do
  11248. begin
  11249. Scope:=Scopes[i];
  11250. if Scope is TPasGroupScope then
  11251. Scope:=TPasGroupScope(Scope).Scopes[0];
  11252. if Scope is TPasClassOrRecordScope then
  11253. begin
  11254. // class or record: add if not duplicate
  11255. Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
  11256. if Old=nil then
  11257. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11258. ClassOrRec:=Scope.Element as TPasMembersType;
  11259. if GetTypeParameterCount(ClassOrRec)>0 then
  11260. break; // enums in generics do not propagate
  11261. end
  11262. else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
  11263. begin
  11264. // procedure or section: check for duplicate and add
  11265. Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
  11266. if Old<>nil then
  11267. RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
  11268. [El.Name,GetElementSourcePosStr(Old.Element)],El);
  11269. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11270. break;
  11271. end
  11272. else
  11273. break;
  11274. end;
  11275. end;
  11276. procedure TPasResolver.AddProperty(El: TPasProperty);
  11277. begin
  11278. if (El.Name='') then
  11279. RaiseNotYetImplemented(20160922163518,El);
  11280. {$IFDEF VerbosePasResolver}
  11281. writeln('TPasResolver.AddProperty ',GetObjName(El));
  11282. {$ENDIF}
  11283. if not (GetLocalScope is TPasClassOrRecordScope) then
  11284. RaiseInvalidScopeForElement(20160922163520,El);
  11285. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11286. PushScope(El,TPasPropertyScope);
  11287. end;
  11288. procedure TPasResolver.AddProcedureType(El: TPasProcedureType;
  11289. TypeParams: TFPList);
  11290. var
  11291. Scope: TPasProcTypeScope;
  11292. begin
  11293. if El.Name<>'' then begin
  11294. {$IFDEF VerbosePasResolver}
  11295. writeln('TPasResolver.AddProcedureType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11296. {$ENDIF}
  11297. if El.Parent is TPasProcedure then
  11298. RaiseNotYetImplemented(20190911102852,El,GetObjPath(El.Parent));
  11299. if TypeParams<>nil then
  11300. begin
  11301. El.SetGenericTemplates(TypeParams);
  11302. TypeParams:=El.GenericTemplateTypes;
  11303. CheckGenericTemplateTypes(El);
  11304. end;
  11305. PopGenericParamScope(El);
  11306. if not (TopScope is TPasIdentifierScope) then
  11307. RaiseInvalidScopeForElement(20190813193703,El);
  11308. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11309. if TypeParams<>nil then
  11310. begin
  11311. Scope:=TPasProcTypeScope(PushScope(El,TPasProcTypeScope));
  11312. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11313. end;
  11314. end else if TypeParams<>nil then
  11315. RaiseNotYetImplemented(20190813193745,El);
  11316. end;
  11317. procedure TPasResolver.AddProcedure(El: TPasProcedure; TypeParams: TFPList);
  11318. procedure AddClassConDestructor(ClassOrRecordScope: TPasClassOrRecordScope;
  11319. var Field: TPasProcedure);
  11320. begin
  11321. if Field<>nil then
  11322. RaiseMsg(20181231144353,nMultipleXinTypeYNameZCAandB,
  11323. sMultipleXinTypeYNameZCAandB,[GetElementTypeName(El),
  11324. GetElementTypeName(ClassOrRecordScope.Element),
  11325. ClassOrRecordScope.Element.Name,Field.Name,El.Name],El);
  11326. Field:=El;
  11327. end;
  11328. function FindBestMembersType(const ClassOrRecName: string;
  11329. TypeParamCnt: integer; Scope: TPasIdentifierScope;
  11330. var Best: TPasMembersType; ErrorPos: TPasElement): integer;
  11331. // returns number of candidates
  11332. var
  11333. Identifier: TPasIdentifier;
  11334. CurEl: TPasElement;
  11335. begin
  11336. Result:=0;
  11337. Identifier:=Scope.FindLocalIdentifier(ClassOrRecName);
  11338. while Identifier<>nil do
  11339. begin
  11340. CurEl:=Identifier.Element;
  11341. if not (CurEl is TPasMembersType) then
  11342. RaiseXExpectedButYFound(20170216152557,
  11343. 'class',CurEl.Name+':'+GetElementTypeName(CurEl),ErrorPos);
  11344. inc(Result);
  11345. if Best=nil then
  11346. Best:=TPasMembersType(CurEl);
  11347. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
  11348. begin
  11349. // fits
  11350. Best:=TPasMembersType(CurEl);
  11351. exit;
  11352. end;
  11353. Identifier:=Identifier.NextSameIdentifier;
  11354. end;
  11355. end;
  11356. function FindMembersType(Scope: TPasIdentifierScope;
  11357. const ClassOrRecName: string; TypeParamCnt: integer; IsDelphi: boolean;
  11358. ErrorPos: TPasElement): TPasMembersType;
  11359. var
  11360. Found: integer;
  11361. begin
  11362. Result:=nil;
  11363. if Scope<>nil then
  11364. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,Scope,Result,ErrorPos)
  11365. else if TopScope is TPasIdentifierScope then
  11366. begin
  11367. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11368. TPasIdentifierScope(TopScope),Result,ErrorPos);
  11369. if (Result=nil) or (TypeParamCnt<>GetTypeParameterCount(Result)) then
  11370. begin
  11371. if (TopScope is TPasSectionScope)
  11372. and (ScopeCount>1) and (Scopes[ScopeCount-2] is TPasSectionScope) then
  11373. // search in unit interface too
  11374. Found:=Found+FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11375. TPasIdentifierScope(Scopes[ScopeCount-2]),Result,ErrorPos);
  11376. end;
  11377. end;
  11378. if Result=nil then
  11379. RaiseMsg(20190818112356,nClassXNotFoundInThisModule,sClassXNotFoundInThisModule,
  11380. [ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11381. if TypeParamCnt=GetTypeParameterCount(Result) then
  11382. exit; // fits perfectly
  11383. if (not IsDelphi) and (TypeParamCnt=0) and (Found=1) then
  11384. exit; // in objfpc type params can be omitted if there is only one type
  11385. // found one or more, but type param count do not fit
  11386. RaiseMsg(20190818112856,nXExpectedButYFound,sXExpectedButYFound,
  11387. [Result.Name+GetGenericParamCommas(GetTypeParameterCount(Result)),
  11388. ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11389. end;
  11390. procedure CheckTemplateNames;
  11391. var
  11392. i, j: Integer;
  11393. NamePart: TProcedureNamePart;
  11394. TemplTypes: TFPList;
  11395. TemplType: TPasGenericTemplateType;
  11396. begin
  11397. for i:=0 to TypeParams.Count-1 do
  11398. begin
  11399. NamePart:=TProcedureNamePart(TypeParams[i]);
  11400. TemplTypes:=NamePart.Templates;
  11401. if TemplTypes=nil then continue;
  11402. for j:=0 to TemplTypes.Count-1 do
  11403. begin
  11404. TemplType:=TPasGenericTemplateType(TemplTypes[j]);
  11405. if SameText(TemplType.Name,El.Name) then
  11406. RaiseMsg(20190912174817,nDuplicateIdentifier,sDuplicateIdentifier,
  11407. [],TemplType);
  11408. end;
  11409. end;
  11410. end;
  11411. var
  11412. ProcName, aClassName: String;
  11413. p: SizeInt;
  11414. ClassOrRecType: TPasMembersType;
  11415. ProcScope: TPasProcedureScope;
  11416. HasDot, IsClassConDestructor, IsDelphi: Boolean;
  11417. ClassOrRecScope: TPasClassOrRecordScope;
  11418. C: TClass;
  11419. CurScope: TPasScope;
  11420. LocalScope: TPasScope;
  11421. Level, TypeParamCount, i: Integer;
  11422. NamePart: TProcedureNamePart;
  11423. TemplType, FoundTemplType: TPasGenericTemplateType;
  11424. begin
  11425. {$IFDEF VerbosePasResolver}
  11426. writeln('TPasResolver.AddProcedure ',GetObjName(El));
  11427. {$ENDIF}
  11428. if TypeParams<>nil then
  11429. begin
  11430. // move type param elements to El
  11431. El.SetNameParts(TypeParams);
  11432. TypeParams:=El.NameParts;
  11433. if TopScope is TPasGenericParamsScope then
  11434. PopScope;
  11435. CheckTemplateNames;
  11436. end;
  11437. CurScope:=TopScope;
  11438. if CurScope.ClassType=TPasGroupScope then
  11439. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11440. else
  11441. LocalScope:=CurScope;
  11442. ProcName:=El.Name;
  11443. if El.Name<>'' then
  11444. begin
  11445. // named proc
  11446. if not (LocalScope is TPasIdentifierScope) then
  11447. RaiseInvalidScopeForElement(20160922163522,El);
  11448. end
  11449. else
  11450. begin
  11451. // anonymous proc
  11452. if TypeParams<>nil then
  11453. RaiseNotYetImplemented(20190818101856,El);
  11454. C:=LocalScope.ClassType;
  11455. if (C=ScopeClass_InitialFinalization)
  11456. or C.InheritsFrom(TPasProcedureScope)
  11457. or (C=TPasWithScope)
  11458. or (C=ScopeClass_WithExpr)
  11459. or (C=TPasExceptOnScope)
  11460. or (C=TPasForLoopScope) then
  11461. // ok
  11462. else
  11463. RaiseInvalidScopeForElement(20181210173134,El);
  11464. end;
  11465. // Note: El.ProcType is nil ! It is parsed later.
  11466. HasDot:=Pos('.',ProcName)>1;
  11467. if (TypeParams<>nil) then
  11468. if HasDot<>(TypeParams.Count>1) then
  11469. RaiseNotYetImplemented(20190818093923,El);
  11470. IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
  11471. or (El.ClassType=TPasClassDestructor);
  11472. ClassOrRecType:=nil;
  11473. if El.CustomData is TPasProcedureScope then
  11474. begin
  11475. // adding a specialized implementation proc
  11476. ProcScope:=TPasProcedureScope(El.CustomData);
  11477. if ProcScope.DeclarationProc<>nil then
  11478. TypeParams:=ProcScope.DeclarationProc.NameParts;
  11479. ClassOrRecScope:=ProcScope.ClassRecScope;
  11480. if ClassOrRecScope<>nil then
  11481. begin
  11482. ClassOrRecType:=TPasMembersType(ClassOrRecScope.Element);
  11483. if GetTypeParameterCount(ClassOrRecType)>0 then
  11484. RaiseNotYetImplemented(20190804175518,El);
  11485. if ProcScope.GroupScope<>nil then
  11486. RaiseNotYetImplemented(20190804175451,El);
  11487. if (not HasDot) and IsClassConDestructor then
  11488. begin
  11489. if El.ClassType=TPasClassConstructor then
  11490. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11491. else
  11492. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11493. end;
  11494. end;
  11495. PushScope(ProcScope);
  11496. end
  11497. else
  11498. begin
  11499. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  11500. if (not HasDot) and IsClassConDestructor then
  11501. begin
  11502. if ProcName='' then
  11503. RaiseNotYetImplemented(20181231145302,El);
  11504. if not (LocalScope is TPasClassOrRecordScope) then
  11505. RaiseInvalidScopeForElement(20181231143831,El);
  11506. ClassOrRecScope:=TPasClassOrRecordScope(LocalScope);
  11507. if El.ClassType=TPasClassConstructor then
  11508. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11509. else
  11510. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11511. if TypeParams<>nil then
  11512. RaiseMsg(20190818094753,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  11513. [El.ElementTypeName],El);
  11514. end;
  11515. if (not HasDot) and (ProcName<>'')
  11516. and not IsClassConDestructor // the name of a class con/destructor is irrelevant and cannot be referenced
  11517. then
  11518. begin
  11519. // add proc name to scope
  11520. AddIdentifier(TPasIdentifierScope(CurScope),ProcName,El,pikProc);
  11521. end;
  11522. ProcScope:=TPasProcedureScope(CreateScope(El,FScopeClass_Proc));
  11523. ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
  11524. if HasDot then
  11525. begin
  11526. // method implementation -> search class
  11527. {$IFDEF VerbosePasResolver}
  11528. writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
  11529. {$ENDIF}
  11530. ClassOrRecType:=nil;
  11531. Level:=0;
  11532. repeat
  11533. inc(Level);
  11534. p:=Pos('.',ProcName);
  11535. if p<1 then
  11536. begin
  11537. if ClassOrRecType=nil then
  11538. RaiseInternalError(20161013170829);
  11539. break;
  11540. end;
  11541. aClassName:=LeftStr(ProcName,p-1);
  11542. Delete(ProcName,1,p);
  11543. TypeParamCount:=0;
  11544. if TypeParams<>nil then
  11545. begin
  11546. // e.g. aclassname<T>.
  11547. if Level>TypeParams.Count then
  11548. RaiseNotYetImplemented(20190818122217,El);
  11549. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11550. if NamePart.Name<>aClassName then
  11551. RaiseNotYetImplemented(20190818102541,El,IntToStr(Level)+': '+NamePart.Name+'<>'+aClassName);
  11552. if NamePart.Templates<>nil then
  11553. begin
  11554. TypeParamCount:=NamePart.Templates.Count;
  11555. for i:=0 to TypeParamCount-1 do
  11556. begin
  11557. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11558. if length(TemplType.Constraints)>0 then
  11559. RaiseMsg(20190818102850,nIllegalQualifierAfter,sIllegalQualifierAfter,
  11560. [':',TemplType.name],TemplType);
  11561. end;
  11562. end;
  11563. end
  11564. else
  11565. NamePart:=nil;
  11566. {$IFDEF VerbosePasResolver}
  11567. writeln('TPasResolver.AddProcedure searching class "',aClassName,GetGenericParamCommas(TypeParamCount),'" ProcName="',ProcName,'" ...');
  11568. {$ENDIF}
  11569. if not IsValidIdent(aClassName) then
  11570. RaiseNotYetImplemented(20161013170844,El);
  11571. if ClassOrRecType<>nil then
  11572. begin
  11573. ClassOrRecScope:=TPasClassOrRecordScope(ClassOrRecType.CustomData);
  11574. ClassOrRecType:=FindMembersType(ClassOrRecScope,aClassName,
  11575. TypeParamCount,IsDelphi,El);
  11576. end
  11577. else
  11578. ClassOrRecType:=FindMembersType(nil,aClassName,
  11579. TypeParamCount,IsDelphi,El);
  11580. if ClassOrRecType is TPasClassType then
  11581. begin
  11582. if not (TPasClassType(ClassOrRecType).ObjKind in
  11583. ([okClass]+okAllHelpers)) then
  11584. begin
  11585. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  11586. RaiseXExpectedButYFound(20180321161722,'class',
  11587. aClassname+GetGenericParamCommas(GetTypeParameterCount(ClassOrRecType))+':'+GetElementTypeName(ClassOrRecType),El);
  11588. end
  11589. end;
  11590. if ClassOrRecType.GetModule<>El.GetModule then
  11591. RaiseNotYetImplemented(20190818120051,El);
  11592. if NamePart<>nil then
  11593. begin
  11594. // check that all type param names match
  11595. for i:=0 to TypeParamCount-1 do
  11596. begin
  11597. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11598. FoundTemplType:=TPasGenericTemplateType(ClassOrRecType.GenericTemplateTypes[i]);
  11599. if not SameText(TemplType.Name,FoundTemplType.Name) then
  11600. RaiseMsg(20190822014652,nXExpectedButYFound,
  11601. sXExpectedButYFound,[FoundTemplType.Name,TemplType.Name],TemplType);
  11602. end;
  11603. end;
  11604. until false;
  11605. if not IsValidIdent(ProcName) then
  11606. RaiseNotYetImplemented(20161013170956,El);
  11607. ProcScope.VisibilityContext:=ClassOrRecType;
  11608. ProcScope.ClassRecScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
  11609. if TypeParams<>nil then
  11610. begin
  11611. if Level<>TypeParams.Count then
  11612. RaiseNotYetImplemented(20190818122315,El);
  11613. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11614. if NamePart.Name<>ProcName then
  11615. RaiseNotYetImplemented(20190818122551,El,IntToStr(Level)+': '+NamePart.Name+'<>'+ProcName);
  11616. end;
  11617. end
  11618. else
  11619. begin
  11620. // HasDot=false
  11621. end;
  11622. PushScope(ProcScope);
  11623. end;// end source proc, not specialized
  11624. if HasDot then
  11625. begin
  11626. // create GroupScope
  11627. ProcScope.GroupScope:=CreateGroupScope(ClassOrRecType);
  11628. while ClassOrRecType.Parent is TPasMembersType do
  11629. begin
  11630. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  11631. GroupScope_AddTypeAndAncestors(ProcScope.GroupScope,ClassOrRecType);
  11632. end;
  11633. end;
  11634. // add generic params to scope
  11635. if TypeParams<>nil then
  11636. begin
  11637. NamePart:=TProcedureNamePart(TypeParams[TypeParams.Count-1]);
  11638. if NamePart<>nil then
  11639. AddGenericTemplateIdentifiers(NamePart.Templates,ProcScope);
  11640. end;
  11641. end;
  11642. procedure TPasResolver.AddArgument(El: TPasArgument);
  11643. var
  11644. ProcType: TPasProcedureType;
  11645. i: Integer;
  11646. Arg: TPasArgument;
  11647. CurScope: TPasScope;
  11648. begin
  11649. if (El.Name='') then
  11650. RaiseInternalError(20160922163526,GetObjName(El));
  11651. {$IFDEF VerbosePasResolver}
  11652. writeln('TPasResolver.AddArgument ',GetObjName(El));
  11653. {$ENDIF}
  11654. CurScope:=TopScope;
  11655. if (CurScope=nil) then
  11656. RaiseInvalidScopeForElement(20160922163529,El);
  11657. if El.Parent.ClassType=TPasProperty then
  11658. begin
  11659. if CurScope.ClassType<>TPasPropertyScope then
  11660. RaiseInvalidScopeForElement(20161014124530,El);
  11661. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  11662. end
  11663. else if El.Parent is TPasProcedureType then
  11664. begin
  11665. ProcType:=TPasProcedureType(El.Parent);
  11666. if ProcType.Parent is TPasProcedure then
  11667. begin
  11668. if CurScope.ClassType<>FScopeClass_Proc then
  11669. RaiseInvalidScopeForElement(20160922163529,El,GetObjName(TopScope));
  11670. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  11671. end
  11672. else
  11673. begin
  11674. for i:=0 to ProcType.Args.Count-1 do
  11675. begin
  11676. Arg:=TPasArgument(ProcType.Args[i]);
  11677. if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
  11678. RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
  11679. end;
  11680. end;
  11681. end
  11682. else
  11683. RaiseNotYetImplemented(20161014124937,El);
  11684. end;
  11685. procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
  11686. var
  11687. CurScope: TPasScope;
  11688. begin
  11689. CurScope:=TopScope;
  11690. if CurScope.ClassType<>FScopeClass_Proc then exit;
  11691. if El.Parent is TPasProcedureType then
  11692. begin
  11693. if not (El.Parent.Parent is TPasProcedure) then
  11694. exit;
  11695. end
  11696. else if not (El.Parent is TPasProcedure) then
  11697. exit;
  11698. AddIdentifier(TPasProcedureScope(CurScope),ResolverResultVar,El,pikSimple);
  11699. end;
  11700. procedure TPasResolver.AddGenericTemplateType(El: TPasGenericTemplateType);
  11701. var
  11702. ParamScope: TPasGenericParamsScope;
  11703. OldIdentifier: TPasIdentifier;
  11704. begin
  11705. if TopScope is TPasGenericParamsScope then
  11706. begin
  11707. ParamScope:=TPasGenericParamsScope(TopScope);
  11708. if ParamScope.Element.Parent<>El.Parent then
  11709. RaiseNotYetImplemented(20190831203132,El,GetObjName(ParamScope.Element));
  11710. end
  11711. else
  11712. begin
  11713. if El.CustomData<>nil then
  11714. RaiseNotYetImplemented(20190831202627,El,GetObjName(El.CustomData));
  11715. ParamScope:=TPasGenericParamsScope.Create;
  11716. AddResolveData(El,ParamScope,lkModule);
  11717. PushScope(ParamScope);
  11718. end;
  11719. OldIdentifier:=ParamScope.FindIdentifier(El.Name);
  11720. if OldIdentifier<>nil then
  11721. RaiseMsg(20190831202920,nDuplicateIdentifier,sDuplicateIdentifier,
  11722. [OldIdentifier.Identifier,GetElementSourcePosStr(OldIdentifier.Element)],El);
  11723. ParamScope.AddIdentifier(El.Name,El,pikSimple);
  11724. end;
  11725. procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
  11726. begin
  11727. PushScope(El,TPasExceptOnScope);
  11728. end;
  11729. procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
  11730. begin
  11731. if TPasWithScope.FreeOnPop then
  11732. RaiseInternalError(20181210162344);
  11733. PushScope(El,TPasWithScope);
  11734. end;
  11735. procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
  11736. begin
  11737. if El=nil then ;
  11738. CheckTopScope(FScopeClass_Proc);
  11739. end;
  11740. procedure TPasResolver.WriteScopes;
  11741. {AllowWriteln}
  11742. var
  11743. i: Integer;
  11744. Scope: TPasScope;
  11745. begin
  11746. writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
  11747. for i:=ScopeCount-1 downto 0 do
  11748. begin
  11749. Scope:=Scopes[i];
  11750. writeln(' ',i,'/',ScopeCount,' ',GetObjName(Scope));
  11751. Scope.WriteIdentifiers(' ');
  11752. end;
  11753. {AllowWriteln-}
  11754. end;
  11755. procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
  11756. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11757. StartEl: TPasElement);
  11758. var
  11759. LeftResolved, RightResolved: TPasResolverResult;
  11760. begin
  11761. if (Bin.OpCode=eopSubIdent)
  11762. or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
  11763. begin
  11764. // Note: bin.left was already resolved via ResolveSubIdent
  11765. ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
  11766. exit;
  11767. end;
  11768. if Bin.OpCode in [eopEqual,eopNotEqual] then
  11769. begin
  11770. if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
  11771. rcSetReferenceFlags in Flags)=cIncompatible then
  11772. RaiseInternalError(20161007215912);
  11773. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  11774. Bin,[rrfReadable]);
  11775. exit;
  11776. end;
  11777. ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
  11778. ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
  11779. // ToDo: check operator overloading
  11780. ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
  11781. end;
  11782. procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
  11783. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11784. var LeftResolved, RightResolved: TPasResolverResult);
  11785. procedure SetBaseType(BaseType: TResolverBaseType);
  11786. begin
  11787. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  11788. Bin,[rrfReadable]);
  11789. end;
  11790. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  11791. begin
  11792. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  11793. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,Flags);
  11794. end;
  11795. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  11796. begin
  11797. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  11798. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,Flags);
  11799. end;
  11800. var
  11801. ElTypeResolved: TPasResolverResult;
  11802. LeftTypeEl, RightTypeEl: TPasType;
  11803. begin
  11804. if LeftResolved.BaseType=btRange then
  11805. ConvertRangeToElement(LeftResolved);
  11806. if RightResolved.BaseType=btRange then
  11807. ConvertRangeToElement(RightResolved);
  11808. //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  11809. if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
  11810. begin
  11811. // cannot yet be decided
  11812. case Bin.OpCode of
  11813. eopEqual, eopNotEqual,
  11814. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual,
  11815. eopIn,eopIs:
  11816. begin
  11817. SetBaseType(btBoolean);
  11818. exit;
  11819. end;
  11820. eopAs:
  11821. begin
  11822. SetRightValueExpr([rrfReadable]);
  11823. exit;
  11824. end;
  11825. end;
  11826. ResolvedEl:=LeftResolved;
  11827. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  11828. exit;
  11829. end;
  11830. if LeftResolved.BaseType in btAllInteger then
  11831. begin
  11832. if (rrfReadable in LeftResolved.Flags)
  11833. and (rrfReadable in RightResolved.Flags) then
  11834. begin
  11835. if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  11836. case Bin.OpCode of
  11837. eopNone:
  11838. if (Bin.Kind=pekRange) then
  11839. begin
  11840. if not (RightResolved.BaseType in btAllInteger) then
  11841. RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
  11842. // use left type for result
  11843. SetLeftValueExpr([rrfReadable]);
  11844. if Bin.Parent is TPasRangeType then
  11845. begin
  11846. ResolvedEl.LoTypeEl:=TPasRangeType(Bin.Parent);
  11847. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  11848. end;
  11849. exit;
  11850. end;
  11851. eopAdd, eopSubtract,
  11852. eopMultiply, eopDiv, eopMod,
  11853. eopPower,
  11854. eopShl, eopShr,
  11855. eopAnd, eopOr, eopXor:
  11856. begin
  11857. if RightResolved.BaseType in btAllFloats then
  11858. // use right type for result
  11859. SetRightValueExpr([rrfReadable])
  11860. else
  11861. // use left type for result
  11862. SetLeftValueExpr([rrfReadable]);
  11863. exit;
  11864. end;
  11865. eopLessThan,
  11866. eopGreaterThan,
  11867. eopLessthanEqual,
  11868. eopGreaterThanEqual:
  11869. begin
  11870. SetBaseType(btBoolean);
  11871. exit;
  11872. end;
  11873. eopDivide:
  11874. begin
  11875. SetBaseType(BaseTypeExtended);
  11876. exit;
  11877. end;
  11878. end
  11879. else if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  11880. begin
  11881. if (Bin.OpCode=eopIn) and (RightResolved.SubType in btAllInteger) then
  11882. begin
  11883. SetBaseType(btBoolean);
  11884. exit;
  11885. end;
  11886. end
  11887. else if RightResolved.BaseType=btPointer then
  11888. begin
  11889. if (Bin.OpCode in [eopAdd,eopSubtract])
  11890. and ElHasBoolSwitch(Bin,bsPointerMath) then
  11891. begin
  11892. // integer+CanonicalPointer
  11893. SetResolverValueExpr(ResolvedEl,btPointer,
  11894. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,[rrfReadable]);
  11895. exit;
  11896. end;
  11897. end
  11898. else if RightResolved.BaseType=btContext then
  11899. begin
  11900. RightTypeEl:=RightResolved.LoTypeEl;
  11901. if RightTypeEl.ClassType=TPasPointerType then
  11902. begin
  11903. if (Bin.OpCode in [eopAdd,eopSubtract])
  11904. and ElHasBoolSwitch(Bin,bsPointerMath) then
  11905. begin
  11906. // integer+TypedPointer
  11907. RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
  11908. SetResolverValueExpr(ResolvedEl,btPointer,
  11909. ResolveAliasType(RightTypeEl),RightTypeEl,Bin,[rrfReadable]);
  11910. exit;
  11911. end;
  11912. end;
  11913. end;
  11914. end;
  11915. end
  11916. else if LeftResolved.BaseType in btAllBooleans then
  11917. begin
  11918. if (rrfReadable in LeftResolved.Flags)
  11919. and (RightResolved.BaseType in btAllBooleans)
  11920. and (rrfReadable in RightResolved.Flags) then
  11921. case Bin.OpCode of
  11922. eopNone:
  11923. if Bin.Kind=pekRange then
  11924. begin
  11925. SetResolverValueExpr(ResolvedEl,btRange,
  11926. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  11927. Bin,[rrfReadable]);
  11928. ResolvedEl.SubType:=LeftResolved.BaseType;
  11929. exit;
  11930. end;
  11931. eopAnd, eopOr, eopXor:
  11932. begin
  11933. // use left type for result
  11934. SetLeftValueExpr([rrfReadable]);
  11935. exit;
  11936. end;
  11937. end;
  11938. end
  11939. else if LeftResolved.BaseType in btAllStringAndChars then
  11940. begin
  11941. if (rrfReadable in LeftResolved.Flags)
  11942. and (rrfReadable in RightResolved.Flags) then
  11943. begin
  11944. if (RightResolved.BaseType in btAllStringAndChars) then
  11945. case Bin.OpCode of
  11946. eopNone:
  11947. if (Bin.Kind=pekRange) and (LeftResolved.BaseType in btAllChars) then
  11948. begin
  11949. if not (RightResolved.BaseType in btAllChars) then
  11950. RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
  11951. SetResolverValueExpr(ResolvedEl,btRange,
  11952. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  11953. Bin,[rrfReadable]);
  11954. ResolvedEl.SubType:=LeftResolved.BaseType;
  11955. exit;
  11956. end;
  11957. eopAdd:
  11958. if RightResolved.BaseType in btAllStringAndChars then
  11959. if ComputeAddStringRes(LeftResolved,RightResolved,Bin,ResolvedEl) then
  11960. exit;
  11961. eopLessThan,
  11962. eopGreaterThan,
  11963. eopLessthanEqual,
  11964. eopGreaterThanEqual:
  11965. begin
  11966. SetBaseType(btBoolean);
  11967. exit;
  11968. end;
  11969. end
  11970. else if (RightResolved.BaseType in [btSet,btArrayOrSet])
  11971. and (RightResolved.SubType in btAllChars)
  11972. and (LeftResolved.BaseType in btAllChars) then
  11973. begin
  11974. case Bin.OpCode of
  11975. eopIn:
  11976. begin
  11977. SetBaseType(btBoolean);
  11978. exit;
  11979. end;
  11980. end;
  11981. end
  11982. end
  11983. end
  11984. else if LeftResolved.BaseType in btAllFloats then
  11985. begin
  11986. if (rrfReadable in LeftResolved.Flags)
  11987. and (RightResolved.BaseType in (btAllInteger+btAllFloats))
  11988. and (rrfReadable in RightResolved.Flags) then
  11989. case Bin.OpCode of
  11990. eopAdd, eopSubtract,
  11991. eopMultiply, eopDivide, eopMod,
  11992. eopPower:
  11993. begin
  11994. if (RightResolved.BaseType=btCurrency)
  11995. or ((RightResolved.BaseType in btAllFloats)
  11996. and (RightResolved.BaseType>LeftResolved.BaseType)) then
  11997. // use right side as result
  11998. SetRightValueExpr([rrfReadable])
  11999. else
  12000. // use left side as result
  12001. SetLeftValueExpr([rrfReadable]);
  12002. exit;
  12003. end;
  12004. eopLessThan,
  12005. eopGreaterThan,
  12006. eopLessthanEqual,
  12007. eopGreaterThanEqual:
  12008. begin
  12009. SetBaseType(btBoolean);
  12010. exit;
  12011. end;
  12012. end;
  12013. end
  12014. else if LeftResolved.BaseType=btPointer then
  12015. begin
  12016. if (rrfReadable in LeftResolved.Flags)
  12017. and (rrfReadable in RightResolved.Flags) then
  12018. begin
  12019. if (RightResolved.BaseType in btAllInteger) then
  12020. case Bin.OpCode of
  12021. eopAdd,eopSubtract:
  12022. if ElHasBoolSwitch(Bin,bsPointerMath) then
  12023. begin
  12024. // pointer+integer -> pointer
  12025. SetResolverValueExpr(ResolvedEl,btPointer,
  12026. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,[rrfReadable]);
  12027. exit;
  12028. end;
  12029. end
  12030. else if RightResolved.BaseType=btPointer then
  12031. case Bin.OpCode of
  12032. eopLessThan,
  12033. eopGreaterThan,
  12034. eopLessthanEqual,
  12035. eopGreaterThanEqual:
  12036. begin
  12037. SetBaseType(btBoolean);
  12038. exit;
  12039. end;
  12040. end;
  12041. end;
  12042. end
  12043. else if LeftResolved.BaseType=btContext then
  12044. begin
  12045. LeftTypeEl:=LeftResolved.LoTypeEl;
  12046. case Bin.OpCode of
  12047. eopNone:
  12048. if Bin.Kind=pekRange then
  12049. begin
  12050. if (rrfReadable in LeftResolved.Flags)
  12051. and (rrfReadable in RightResolved.Flags) then
  12052. begin
  12053. CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
  12054. ResolvedEl:=LeftResolved;
  12055. ResolvedEl.IdentEl:=nil;
  12056. ResolvedEl.SubType:=ResolvedEl.BaseType;
  12057. ResolvedEl.BaseType:=btRange;
  12058. ResolvedEl.ExprEl:=Bin;
  12059. exit;
  12060. end;
  12061. end;
  12062. eopIn:
  12063. if (rrfReadable in LeftResolved.Flags)
  12064. and (rrfReadable in RightResolved.Flags) then
  12065. begin
  12066. if LeftResolved.BaseType in btArrayRangeTypes then
  12067. begin
  12068. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12069. RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12070. if LeftResolved.BaseType in btAllBooleans then
  12071. begin
  12072. if not (RightResolved.SubType in btAllBooleans) then
  12073. RaiseXExpectedButYFound(20170216152610,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12074. end
  12075. else if LeftResolved.BaseType in btAllChars then
  12076. begin
  12077. if not (RightResolved.SubType in btAllChars) then
  12078. RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12079. end
  12080. else if not (RightResolved.SubType in btAllInteger) then
  12081. RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12082. SetBaseType(btBoolean);
  12083. exit;
  12084. end
  12085. else if (LeftResolved.BaseType=btContext)
  12086. and (LeftTypeEl.ClassType=TPasEnumType) then
  12087. begin
  12088. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12089. RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.LoTypeEl.Name,GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12090. RightTypeEl:=RightResolved.LoTypeEl;
  12091. if LeftTypeEl=RightTypeEl then
  12092. // enum in setofenum
  12093. else if RightResolved.LoTypeEl.ClassType=TPasRangeType then
  12094. begin
  12095. ComputeElement(TPasRangeType(RightTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
  12096. if LeftTypeEl<>ElTypeResolved.LoTypeEl then
  12097. RaiseXExpectedButYFound(20171109215833,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12098. end
  12099. else
  12100. RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12101. SetBaseType(btBoolean);
  12102. exit;
  12103. end
  12104. else
  12105. RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
  12106. sInOperatorExpectsSetElementButGot,[GetElementTypeName(LeftResolved.LoTypeEl)],Bin);
  12107. end;
  12108. eopIs:
  12109. begin
  12110. RightTypeEl:=RightResolved.LoTypeEl;
  12111. if (LeftTypeEl is TPasClassType) then
  12112. begin
  12113. if not (rrfReadable in LeftResolved.Flags) then
  12114. RaiseIncompatibleTypeRes(20180204124637,nOperatorIsNotOverloadedAOpB,
  12115. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12116. if (LeftResolved.IdentEl is TPasType) then
  12117. RaiseIncompatibleTypeRes(20180204124638,nOperatorIsNotOverloadedAOpB,
  12118. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12119. // left side is a class instance
  12120. if (RightResolved.IdentEl is TPasType)
  12121. and (RightTypeEl is TPasClassType) then
  12122. begin
  12123. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12124. begin
  12125. if CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible then
  12126. begin
  12127. // e.g. if obj is TFPMemoryImage then ;
  12128. // Note: at compile time the check is reversed: right must inherit from left
  12129. SetBaseType(btBoolean);
  12130. exit;
  12131. end
  12132. else if CheckSrcIsADstType(LeftResolved,RightResolved)<>cIncompatible then
  12133. begin
  12134. // e.g. if Image is TObject then ;
  12135. // This is useful after some unchecked typecast -> allow
  12136. SetBaseType(btBoolean);
  12137. exit;
  12138. end;
  12139. end
  12140. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12141. begin
  12142. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12143. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12144. begin
  12145. // e.g. if classintvar is intftype then ;
  12146. SetBaseType(btBoolean);
  12147. exit;
  12148. end;
  12149. end
  12150. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12151. begin
  12152. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12153. and (not TPasClassType(RightTypeEl).IsExternal) then
  12154. begin
  12155. // e.g. if intfvar is classtype then ;
  12156. SetBaseType(btBoolean);
  12157. exit;
  12158. end;
  12159. end;
  12160. {$IFDEF VerbosePasResolver}
  12161. writeln('TPasResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)));
  12162. writeln('TPasResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
  12163. {$ENDIF}
  12164. end
  12165. else if (RightTypeEl is TPasClassOfType)
  12166. and (rrfReadable in RightResolved.Flags) then
  12167. begin
  12168. // e.g. if Image is ImageClass then ;
  12169. if (CheckClassesAreRelated(LeftResolved.LoTypeEl,
  12170. TPasClassOfType(RightTypeEl).DestType)<>cIncompatible) then
  12171. begin
  12172. SetBaseType(btBoolean);
  12173. exit;
  12174. end;
  12175. end
  12176. else
  12177. RaiseXExpectedButYFound(20170216152625,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12178. end
  12179. else if (proClassOfIs in Options) and (LeftTypeEl is TPasClassOfType)
  12180. and (rrfReadable in LeftResolved.Flags) then
  12181. begin
  12182. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  12183. RaiseIncompatibleTypeRes(20180204124657,nOperatorIsNotOverloadedAOpB,
  12184. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12185. // left side is class-of variable
  12186. LeftTypeEl:=ResolveAliasType(TPasClassOfType(LeftTypeEl).DestType);
  12187. if (RightResolved.IdentEl is TPasType)
  12188. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  12189. begin
  12190. // e.g. if ImageClass is TFPMemoryImage then ;
  12191. // Note: at compile time the check is reversed: right must inherit from left
  12192. if CheckClassIsClass(RightResolved.LoTypeEl,LeftTypeEl)<>cIncompatible then
  12193. begin
  12194. SetBaseType(btBoolean);
  12195. exit;
  12196. end
  12197. end
  12198. else if (RightTypeEl is TPasClassOfType) then
  12199. begin
  12200. // e.g. if ImageClassA is ImageClassB then ;
  12201. // or if ImageClassA is TFPImageClass then ;
  12202. RightTypeEl:=ResolveAliasType(TPasClassOfType(RightTypeEl).DestType);
  12203. if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl)<>cIncompatible) then
  12204. begin
  12205. SetBaseType(btBoolean);
  12206. exit;
  12207. end
  12208. end
  12209. else
  12210. RaiseXExpectedButYFound(20170322105252,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12211. end
  12212. else if LeftResolved.LoTypeEl=nil then
  12213. begin
  12214. {$IFDEF VerbosePasResolver}
  12215. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12216. {$ENDIF}
  12217. RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12218. [BaseTypeNames[LeftResolved.BaseType]],Bin.left);
  12219. end
  12220. else
  12221. begin
  12222. {$IFDEF VerbosePasResolver}
  12223. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12224. {$ENDIF}
  12225. RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12226. [GetElementTypeName(LeftResolved.LoTypeEl)],Bin.left);
  12227. end;
  12228. end;
  12229. eopAs:
  12230. begin
  12231. if (LeftTypeEl.ClassType=TPasClassType) then
  12232. begin
  12233. if (LeftResolved.IdentEl is TPasType)
  12234. or (not (rrfReadable in LeftResolved.Flags)) then
  12235. RaiseIncompatibleTypeRes(20180204124711,nOperatorIsNotOverloadedAOpB,
  12236. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12237. if RightResolved.IdentEl=nil then
  12238. RaiseXExpectedButYFound(20170216152630,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12239. if not (RightResolved.IdentEl is TPasType) then
  12240. RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
  12241. if not (RightResolved.BaseType=btContext) then
  12242. RaiseXExpectedButYFound(20180426195816,'class',RightResolved.IdentEl.Name,Bin.right);
  12243. RightTypeEl:=RightResolved.LoTypeEl;
  12244. if RightTypeEl is TPasClassType then
  12245. begin
  12246. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12247. begin
  12248. // e.g. classinst as classtype
  12249. if (CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible) then
  12250. begin
  12251. SetRightValueExpr([rrfReadable]);
  12252. exit;
  12253. end;
  12254. end
  12255. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12256. begin
  12257. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12258. and (not TPasClassType(RightTypeEl).IsExternal) then
  12259. begin
  12260. // e.g. intfvar as classtype
  12261. SetRightValueExpr([rrfReadable]);
  12262. exit;
  12263. end;
  12264. end
  12265. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12266. begin
  12267. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12268. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12269. begin
  12270. // e.g. classinst as intftype
  12271. SetRightValueExpr([rrfReadable]);
  12272. exit;
  12273. end;
  12274. end;
  12275. end;
  12276. RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12277. end
  12278. else if LeftTypeEl.ClassType=TPasGenericTemplateType then
  12279. begin
  12280. // genericvar as ...
  12281. if (LeftResolved.IdentEl is TPasType)
  12282. or (not (rrfReadable in LeftResolved.Flags)) then
  12283. RaiseIncompatibleTypeRes(20190908191127,nOperatorIsNotOverloadedAOpB,
  12284. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12285. if RightResolved.IdentEl=nil then
  12286. RaiseXExpectedButYFound(20190908191202,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12287. if not (RightResolved.IdentEl is TPasType) then
  12288. RaiseXExpectedButYFound(20190908191204,'class',RightResolved.IdentEl.Name,Bin.right);
  12289. if not (RightResolved.BaseType=btContext) then
  12290. RaiseXExpectedButYFound(20190908191206,'class',RightResolved.IdentEl.Name,Bin.right);
  12291. RightTypeEl:=RightResolved.LoTypeEl;
  12292. if RightTypeEl is TPasClassType then
  12293. begin
  12294. // e.g. genericvar as classtype
  12295. SetRightValueExpr([rrfReadable]);
  12296. exit;
  12297. end;
  12298. RaiseIncompatibleTypeRes(20190908192345,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12299. end;
  12300. end;
  12301. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  12302. if (rrfReadable in LeftResolved.Flags)
  12303. and (rrfReadable in RightResolved.Flags) then
  12304. begin
  12305. RightTypeEl:=RightResolved.LoTypeEl;
  12306. if (LeftTypeEl.ClassType=TPasEnumType) and (LeftTypeEl=RightTypeEl) then
  12307. begin
  12308. SetBaseType(btBoolean);
  12309. exit;
  12310. end
  12311. else if (LeftTypeEl.ClassType=TPasPointerType)
  12312. and (RightResolved.BaseType in btAllInteger) then
  12313. begin
  12314. SetBaseType(btBoolean);
  12315. exit;
  12316. end;
  12317. end;
  12318. eopSubIdent:
  12319. begin
  12320. ResolvedEl:=RightResolved;
  12321. exit;
  12322. end;
  12323. eopAdd,eopSubtract:
  12324. if (rrfReadable in LeftResolved.Flags)
  12325. and (rrfReadable in RightResolved.Flags) then
  12326. begin
  12327. if (LeftTypeEl.ClassType=TPasArrayType) then
  12328. begin
  12329. if IsDynArray(LeftTypeEl)
  12330. and (Bin.OpCode=eopAdd)
  12331. and ElHasModeSwitch(Bin,msArrayOperators)
  12332. and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
  12333. or IsDynArray(RightResolved.LoTypeEl)) then
  12334. begin
  12335. // dynarr+[...]
  12336. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,Bin,true);
  12337. SetLeftValueExpr([rrfReadable]);
  12338. exit;
  12339. end;
  12340. end
  12341. else if LeftTypeEl.ClassType=TPasPointerType then
  12342. begin
  12343. if (RightResolved.BaseType in btAllInteger)
  12344. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12345. begin
  12346. // TypedPointer+Integer
  12347. SetLeftValueExpr([rrfReadable]);
  12348. exit;
  12349. end;
  12350. end;
  12351. end;
  12352. end;
  12353. end
  12354. else if LeftResolved.BaseType in [btSet,btArrayOrSet] then
  12355. begin
  12356. if (rrfReadable in LeftResolved.Flags)
  12357. and (rrfReadable in RightResolved.Flags) then
  12358. begin
  12359. if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12360. case Bin.OpCode of
  12361. eopAdd,
  12362. eopSubtract,
  12363. eopMultiply,
  12364. eopSymmetricaldifference,
  12365. eopLessthanEqual,
  12366. eopGreaterThanEqual:
  12367. begin
  12368. if RightResolved.LoTypeEl=nil then
  12369. begin
  12370. // right is empty set/array
  12371. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12372. SetBaseType(btBoolean)
  12373. else
  12374. begin
  12375. ResolvedEl:=LeftResolved;
  12376. ResolvedEl.IdentEl:=nil;
  12377. ResolvedEl.ExprEl:=Bin;
  12378. end;
  12379. exit;
  12380. end
  12381. else if LeftResolved.LoTypeEl=nil then
  12382. begin
  12383. // left is empty set/array
  12384. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12385. SetBaseType(btBoolean)
  12386. else
  12387. begin
  12388. ResolvedEl:=RightResolved;
  12389. ResolvedEl.IdentEl:=nil;
  12390. ResolvedEl.ExprEl:=Bin;
  12391. end;
  12392. exit;
  12393. end
  12394. else if (LeftResolved.SubType=RightResolved.SubType)
  12395. or ((LeftResolved.SubType in btAllBooleans)
  12396. and (RightResolved.SubType in btAllBooleans))
  12397. or ((LeftResolved.SubType in btAllInteger)
  12398. and (RightResolved.SubType in btAllInteger)) then
  12399. begin
  12400. // compatible set
  12401. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12402. SetBaseType(btBoolean)
  12403. else
  12404. begin
  12405. ResolvedEl:=LeftResolved;
  12406. ResolvedEl.IdentEl:=nil;
  12407. ResolvedEl.ExprEl:=Bin;
  12408. end;
  12409. exit;
  12410. end;
  12411. {$IFDEF VerbosePasResolver}
  12412. writeln('TPasResolver.ComputeBinaryExprRes + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
  12413. +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
  12414. {$ENDIF}
  12415. end;
  12416. end
  12417. else if RightResolved.BaseType=btContext then
  12418. begin
  12419. RightTypeEl:=RightResolved.LoTypeEl;
  12420. if RightTypeEl.ClassType=TPasArrayType then
  12421. begin
  12422. if IsDynArray(RightTypeEl) then
  12423. begin
  12424. // [...]+dynarr
  12425. CheckAssignCompatibilityArrayType(RightResolved,LeftResolved,Bin,true);
  12426. SetRightValueExpr([rrfReadable]);
  12427. exit;
  12428. end;
  12429. end;
  12430. end;
  12431. end;
  12432. end
  12433. else if LeftResolved.BaseType=btArrayLit then
  12434. begin
  12435. if (rrfReadable in LeftResolved.Flags)
  12436. and (rrfReadable in RightResolved.Flags)
  12437. and (Bin.OpCode=eopAdd)
  12438. and ElHasModeSwitch(Bin,msArrayOperators) then
  12439. begin
  12440. if RightResolved.BaseType=btArrayLit then
  12441. begin
  12442. if LeftResolved.LoTypeEl<>nil then
  12443. ResolvedEl:=LeftResolved
  12444. else
  12445. ResolvedEl:=RightResolved;
  12446. ResolvedEl.IdentEl:=nil;
  12447. ResolvedEl.ExprEl:=Bin;
  12448. exit;
  12449. end
  12450. else if (RightResolved.BaseType=btContext)
  12451. and (RightResolved.LoTypeEl.ClassType=TPasArrayType) then
  12452. begin
  12453. ResolvedEl:=RightResolved;
  12454. ResolvedEl.IdentEl:=nil;
  12455. ResolvedEl.ExprEl:=Bin;
  12456. exit;
  12457. end;
  12458. end;
  12459. end
  12460. else if LeftResolved.BaseType=btModule then
  12461. begin
  12462. if Bin.OpCode=eopSubIdent then
  12463. begin
  12464. ResolvedEl:=RightResolved;
  12465. exit;
  12466. end;
  12467. end;
  12468. {$IFDEF VerbosePasResolver}
  12469. writeln('TPasResolver.ComputeBinaryExprRes OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  12470. {$ENDIF}
  12471. RaiseIncompatibleTypeRes(20180204114631,nOperatorIsNotOverloadedAOpB,
  12472. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12473. if Flags=[] then ;
  12474. end;
  12475. function TPasResolver.ComputeAddStringRes(const LeftResolved,
  12476. RightResolved: TPasResolverResult; ExprEl: TPasExpr; out
  12477. ResolvedEl: TPasResolverResult): boolean;
  12478. procedure SetBaseType(BaseType: TResolverBaseType);
  12479. begin
  12480. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  12481. ExprEl,[rrfReadable]);
  12482. end;
  12483. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  12484. begin
  12485. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  12486. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,ExprEl,Flags);
  12487. end;
  12488. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  12489. begin
  12490. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  12491. RightResolved.LoTypeEl,RightResolved.HiTypeEl,ExprEl,Flags);
  12492. end;
  12493. begin
  12494. Result:=true;
  12495. case LeftResolved.BaseType of
  12496. btChar:
  12497. begin
  12498. case RightResolved.BaseType of
  12499. btChar: SetBaseType(btString);
  12500. {$ifdef FPC_HAS_CPSTRING}
  12501. btAnsiChar:
  12502. if BaseTypeChar=btAnsiChar then
  12503. SetBaseType(btString)
  12504. else
  12505. SetBaseType(btUnicodeString);
  12506. {$endif}
  12507. btWideChar:
  12508. if BaseTypeChar=btWideChar then
  12509. SetBaseType(btString)
  12510. else
  12511. SetBaseType(btUnicodeString);
  12512. else
  12513. // use right type for result
  12514. SetRightValueExpr([rrfReadable]);
  12515. end;
  12516. exit;
  12517. end;
  12518. {$ifdef FPC_HAS_CPSTRING}
  12519. btAnsiChar:
  12520. begin
  12521. case RightResolved.BaseType of
  12522. btChar:
  12523. if BaseTypeChar=btAnsiChar then
  12524. SetBaseType(btString)
  12525. else
  12526. SetBaseType(btUnicodeString);
  12527. btAnsiChar:
  12528. if BaseTypeChar=btAnsiChar then
  12529. SetBaseType(btString)
  12530. else
  12531. SetBaseType(btAnsiString);
  12532. btWideChar:
  12533. if BaseTypeChar=btWideChar then
  12534. SetBaseType(btString)
  12535. else
  12536. SetBaseType(btUnicodeString);
  12537. else
  12538. // use right type for result
  12539. SetRightValueExpr([rrfReadable]);
  12540. end;
  12541. exit;
  12542. end;
  12543. {$endif}
  12544. btWideChar:
  12545. begin
  12546. case RightResolved.BaseType of
  12547. btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
  12548. if BaseTypeChar=btWideChar then
  12549. SetBaseType(btString)
  12550. else
  12551. SetBaseType(btUnicodeString);
  12552. else
  12553. // use right type for result
  12554. SetRightValueExpr([rrfReadable]);
  12555. end;
  12556. exit;
  12557. end;
  12558. {$ifdef FPC_HAS_CPSTRING}
  12559. btShortString:
  12560. begin
  12561. case RightResolved.BaseType of
  12562. btChar,btAnsiChar,btShortString,btWideChar:
  12563. // use left type for result
  12564. SetLeftValueExpr([rrfReadable]);
  12565. else
  12566. // shortstring + string => string
  12567. SetRightValueExpr([rrfReadable]);
  12568. end;
  12569. exit;
  12570. end;
  12571. {$endif}
  12572. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  12573. begin
  12574. // string + x => string
  12575. SetLeftValueExpr([rrfReadable]);
  12576. exit;
  12577. end;
  12578. end;
  12579. Result:=false;
  12580. end;
  12581. procedure TPasResolver.ComputeArgumentAndExpr(Arg: TPasArgument; out
  12582. ArgResolved: TPasResolverResult; Expr: TPasExpr; out
  12583. ExprResolved: TPasResolverResult; SetReferenceFlags: boolean);
  12584. var
  12585. NeedVar: Boolean;
  12586. RHSFlags: TPasResolverComputeFlags;
  12587. begin
  12588. NeedVar:=Arg.Access in [argVar, argOut];
  12589. ComputeElement(Arg,ArgResolved,[]);
  12590. {$IFDEF VerbosePasResolver}
  12591. writeln('TPasResolver.ComputeArgumentAndExpr Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  12592. {$ENDIF}
  12593. if (ArgResolved.LoTypeEl=nil) and (Arg.ArgType<>nil) then
  12594. RaiseInternalError(20160922163628,'TypeEl=nil for '+GetTreeDbg(Arg));
  12595. RHSFlags:=[];
  12596. if NeedVar then
  12597. Include(RHSFlags,rcNoImplicitProc)
  12598. else if IsProcedureType(ArgResolved,true)
  12599. or (ArgResolved.BaseType=btPointer)
  12600. or (Arg.ArgType=nil) then
  12601. Include(RHSFlags,rcNoImplicitProcType);
  12602. if SetReferenceFlags then
  12603. Include(RHSFlags,rcSetReferenceFlags);
  12604. ComputeElement(Expr,ExprResolved,RHSFlags);
  12605. {$IFDEF VerbosePasResolver}
  12606. writeln('TPasResolver.ComputeArgumentAndExpr Expr=',GetTreeDbg(Expr,2),' ExprResolved=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
  12607. {$ENDIF}
  12608. end;
  12609. procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
  12610. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12611. StartEl: TPasElement);
  12612. procedure ComputeIndexProperty(Prop: TPasProperty);
  12613. begin
  12614. if [rcConstant,rcType]*Flags<>[] then
  12615. RaiseConstantExprExp(20170216152635,Params);
  12616. ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
  12617. ResolvedEl.IdentEl:=Prop;
  12618. ResolvedEl.Flags:=[];
  12619. if GetPasPropertyGetter(Prop)<>nil then
  12620. Include(ResolvedEl.Flags,rrfReadable);
  12621. if GetPasPropertySetter(Prop)<>nil then
  12622. Include(ResolvedEl.Flags,rrfWritable);
  12623. end;
  12624. procedure ComputeArrayPointer(TypeEl: TPasType);
  12625. begin
  12626. if TypeEl=nil then
  12627. RaiseInternalError(20180423092254);
  12628. ComputeElement(TypeEl,ResolvedEl,[rcType],Params);
  12629. ResolvedEl.IdentEl:=nil;
  12630. ResolvedEl.ExprEl:=Params;
  12631. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  12632. end;
  12633. var
  12634. TypeEl, ElType: TPasType;
  12635. ArrayEl: TPasArrayType;
  12636. ArgNo: Integer;
  12637. OrigResolved: TPasResolverResult;
  12638. ClassOrRecordScope: TPasClassOrRecordScope;
  12639. Ref: TResolvedReference;
  12640. begin
  12641. ComputeElement(Params.Value,ResolvedEl,
  12642. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  12643. {$IFDEF VerbosePasResolver}
  12644. writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  12645. {$ENDIF}
  12646. if ResolvedEl.BaseType in btAllStrings then
  12647. begin
  12648. // stringvar[] => char
  12649. case GetActualBaseType(ResolvedEl.BaseType) of
  12650. {$ifdef FPC_HAS_CPSTRING}
  12651. btAnsiString,btRawByteString,btShortString:
  12652. if BaseTypeChar=btAnsiChar then
  12653. ResolvedEl.BaseType:=btChar
  12654. else
  12655. ResolvedEl.BaseType:=btAnsiChar;
  12656. {$endif}
  12657. btWideString,btUnicodeString:
  12658. if BaseTypeChar=btWideChar then
  12659. ResolvedEl.BaseType:=btChar
  12660. else
  12661. ResolvedEl.BaseType:=btWideChar;
  12662. else
  12663. RaiseNotYetImplemented(20170417202354,Params);
  12664. end;
  12665. // keep ResolvedEl.IdentEl the string var
  12666. ResolvedEl.LoTypeEl:=FBaseTypes[ResolvedEl.BaseType];
  12667. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  12668. ResolvedEl.ExprEl:=Params;
  12669. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
  12670. end
  12671. else if ResolvedEl.BaseType=btPointer then
  12672. // (@something)[]
  12673. ComputeArrayPointer(ResolvedEl.LoTypeEl)
  12674. else if (ResolvedEl.IdentEl is TPasProperty)
  12675. and (GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then
  12676. // property with args
  12677. ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
  12678. else if ResolvedEl.BaseType=btContext then
  12679. begin
  12680. TypeEl:=ResolvedEl.LoTypeEl;
  12681. if (TypeEl.ClassType=TPasClassType)
  12682. or (TypeEl.ClassType=TPasRecordType)
  12683. or (TypeEl.ClassType=TPasClassOfType) then
  12684. begin
  12685. if not (Params.CustomData is TResolvedReference) then
  12686. RaiseNotYetImplemented(20190125143203,Params,GetObjName(Params.CustomData));
  12687. Ref:=TResolvedReference(Params.CustomData);
  12688. if Ref.Declaration is TPasProperty then
  12689. ComputeIndexProperty(TPasProperty(Ref.Declaration))
  12690. else if TypeEl is TPasMembersType then
  12691. begin
  12692. ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
  12693. ComputeArrayParams_Class(Params,ResolvedEl,ClassOrRecordScope,Flags,StartEl);
  12694. end
  12695. else
  12696. RaiseNotYetImplemented(20161010174916,Params);
  12697. end
  12698. else if TypeEl.ClassType=TPasArrayType then
  12699. begin
  12700. if not (rrfReadable in ResolvedEl.Flags) then
  12701. RaiseMsg(20170517001140,nIllegalQualifierAfter,sIllegalQualifierAfter,
  12702. ['[',TypeEl.ElementTypeName],Params);
  12703. ArrayEl:=TPasArrayType(TypeEl);
  12704. ArgNo:=0;
  12705. repeat
  12706. if length(ArrayEl.Ranges)=0 then
  12707. begin
  12708. inc(ArgNo); // dynamic/open array has one dimension
  12709. if IsDynArray(ArrayEl) then
  12710. Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
  12711. end
  12712. else
  12713. inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
  12714. if ArgNo>length(Params.Params) then
  12715. RaiseInternalError(20161010185535);
  12716. if ArgNo=length(Params.Params) then
  12717. break;
  12718. // continue in sub array
  12719. ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
  12720. until false;
  12721. OrigResolved:=ResolvedEl;
  12722. ElType:=GetArrayElType(ArrayEl);
  12723. ComputeElement(ElType,ResolvedEl,Flags,StartEl);
  12724. // identifier and value is the array itself
  12725. ResolvedEl.IdentEl:=OrigResolved.IdentEl;
  12726. ResolvedEl.ExprEl:=OrigResolved.ExprEl;
  12727. ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
  12728. if IsDynArray(ArrayEl) then
  12729. // dyn array elements are writable independent of the array
  12730. Include(ResolvedEl.Flags,rrfWritable);
  12731. end
  12732. else if TypeEl.ClassType=TPasPointerType then
  12733. ComputeArrayPointer(TPasPointerType(TypeEl).DestType)
  12734. else
  12735. RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
  12736. end
  12737. else
  12738. RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
  12739. end;
  12740. procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
  12741. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  12742. Flags: TPasResolverComputeFlags; StartEl: TPasElement);
  12743. begin
  12744. RaiseNotYetImplemented(20190125142240,Params);
  12745. if Params=nil then ;
  12746. if ClassOrRecScope=nil then ;
  12747. if Flags=[] then ;
  12748. if StartEl=nil then ;
  12749. SetResolverIdentifier(ResolvedEl,btNone,nil,nil,nil,[]);
  12750. end;
  12751. procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
  12752. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12753. StartEl: TPasElement);
  12754. var
  12755. DeclEl: TPasElement;
  12756. BuiltInProc: TResElDataBuiltInProc;
  12757. Proc: TPasProcedure;
  12758. ParamResolved: TPasResolverResult;
  12759. Ref: TResolvedReference;
  12760. DeclType: TPasType;
  12761. Param0: TPasExpr;
  12762. begin
  12763. Ref:=GetParamsValueRef(Params);
  12764. if Ref=nil then
  12765. RaiseNotYetImplemented(20160928174124,Params);
  12766. DeclEl:=Ref.Declaration;
  12767. if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  12768. begin
  12769. if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
  12770. begin
  12771. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  12772. if Assigned(BuiltInProc.GetCallResult) then
  12773. // built-in function
  12774. BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
  12775. else
  12776. // built-in procedure
  12777. SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,
  12778. BuiltInProc.Proc,BuiltInProc.Proc,[]);
  12779. if bipfCanBeStatement in BuiltInProc.Flags then
  12780. Include(ResolvedEl.Flags,rrfCanBeStatement);
  12781. end
  12782. else if DeclEl.CustomData is TResElDataBaseType then
  12783. begin
  12784. // type cast to base type
  12785. DeclType:=TPasUnresolvedSymbolRef(DeclEl);
  12786. if length(Params.Params)<>1 then
  12787. begin
  12788. {$IFDEF VerbosePasResolver}
  12789. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl));
  12790. {$ENDIF}
  12791. RaiseMsg(20180503105409,nWrongNumberOfParametersForTypeCast,
  12792. sWrongNumberOfParametersForTypeCast,[DeclType.Name],Params);
  12793. end;
  12794. Param0:=Params.Params[0];
  12795. ComputeElement(Param0,ParamResolved,[]);
  12796. ComputeTypeCast(DeclType,DeclType,Param0,ParamResolved,ResolvedEl,Flags);
  12797. end
  12798. else
  12799. RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
  12800. end
  12801. else
  12802. begin
  12803. // normal identifier (not built-in)
  12804. ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  12805. if ResolvedEl.BaseType=btProc then
  12806. begin
  12807. if not (ResolvedEl.IdentEl is TPasProcedure) then
  12808. RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
  12809. Proc:=TPasProcedure(ResolvedEl.IdentEl);
  12810. if rcConstant in Flags then
  12811. RaiseConstantExprExp(20170216152637,Params);
  12812. if Proc.ProcType is TPasFunctionType then
  12813. // function call => return result
  12814. ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
  12815. Flags+[rcNoImplicitProc],StartEl)
  12816. else if (Proc.ClassType=TPasConstructor) then
  12817. begin
  12818. // constructor -> return value of type class
  12819. ResolvedEl:=GetReference_ConstructorType(Ref,Params.Value);
  12820. end
  12821. else
  12822. // procedure call, result is neither readable nor writable
  12823. SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,Proc.ProcType,[]);
  12824. Include(ResolvedEl.Flags,rrfCanBeStatement);
  12825. end
  12826. else if ResolvedEl.LoTypeEl is TPasProcedureType then
  12827. begin
  12828. if Params.Value is TParamsExpr then
  12829. begin
  12830. // e.g. Name()() or Name[]()
  12831. Include(ResolvedEl.Flags,rrfReadable);
  12832. end;
  12833. if rrfReadable in ResolvedEl.Flags then
  12834. begin
  12835. // call procvar
  12836. if rcConstant in Flags then
  12837. RaiseConstantExprExp(20170216152639,Params);
  12838. if ResolvedEl.LoTypeEl is TPasFunctionType then
  12839. // function call => return result
  12840. ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  12841. ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  12842. else
  12843. // procedure call, result is neither readable nor writable
  12844. SetResolverTypeExpr(ResolvedEl,btProc,
  12845. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,[]);
  12846. Include(ResolvedEl.Flags,rrfCanBeStatement);
  12847. end
  12848. else
  12849. begin
  12850. // typecast to proctype
  12851. if length(Params.Params)<>1 then
  12852. begin
  12853. {$IFDEF VerbosePasResolver}
  12854. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
  12855. {$ENDIF}
  12856. RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
  12857. sWrongNumberOfParametersForTypeCast,[ResolvedEl.LoTypeEl.Name],Params);
  12858. end;
  12859. Param0:=Params.Params[0];
  12860. ComputeElement(Param0,ParamResolved,[]);
  12861. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  12862. ParamResolved,ResolvedEl,Flags);
  12863. end;
  12864. end
  12865. else if (DeclEl is TPasType) then
  12866. begin
  12867. // type cast
  12868. Param0:=Params.Params[0];
  12869. ComputeElement(Param0,ParamResolved,[]);
  12870. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  12871. ParamResolved,ResolvedEl,Flags);
  12872. end
  12873. else
  12874. RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
  12875. end;
  12876. end;
  12877. procedure TPasResolver.ComputeTypeCast(ToLoType, ToHiType: TPasType;
  12878. Param: TPasExpr; const ParamResolved: TPasResolverResult; out
  12879. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  12880. function ParamIsVar: boolean;
  12881. var
  12882. IdentEl: TPasElement;
  12883. begin
  12884. IdentEl:=ParamResolved.IdentEl;
  12885. if IdentEl=nil then exit(false);
  12886. if [rcConstant,rcType]*Flags<>[] then
  12887. Result:=(IdentEl.ClassType=TPasConst) and (TPasConst(IdentEl).IsConst)
  12888. else
  12889. Result:=(IdentEl is TPasVariable)
  12890. or (IdentEl.ClassType=TPasArgument)
  12891. or (IdentEl.ClassType=TPasResultElement);
  12892. end;
  12893. var
  12894. WriteFlags: TPasResolverResultFlags;
  12895. KeepWriteFlags: Boolean;
  12896. bt: TResolverBaseType;
  12897. Expr: TPasExpr;
  12898. begin
  12899. {$IFDEF VerbosePasResolver}
  12900. writeln('TPasResolver.ComputeFuncParams START ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved));
  12901. {$ENDIF}
  12902. if ToLoType.CustomData is TResElDataBaseType then
  12903. begin
  12904. // type cast to base type (or alias of base type)
  12905. bt:=GetActualBaseType(TResElDataBaseType(ToLoType.CustomData).BaseType);
  12906. SetResolverValueExpr(ResolvedEl,
  12907. TResElDataBaseType(ToLoType.CustomData).BaseType,
  12908. ToLoType,ToHiType,
  12909. Param,[rrfReadable]);
  12910. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  12911. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  12912. if (WriteFlags<>[]) and ParamIsVar then
  12913. begin
  12914. KeepWriteFlags:=false;
  12915. // Param is writable -> check if typecast keeps this
  12916. if (bt=btPointer) then
  12917. begin
  12918. // typecast to pointer
  12919. if (ParamResolved.BaseType=btPointer)
  12920. or (ParamResolved.BaseType in [btString,btUnicodeString,btWideString])
  12921. or (ParamResolved.LoTypeEl=nil) // untyped
  12922. or (ParamResolved.LoTypeEl.ClassType=TPasClassType)
  12923. or IsDynArray(ParamResolved.LoTypeEl)
  12924. then
  12925. // e.g. pointer(ObjVar)
  12926. KeepWriteFlags:=true;
  12927. end
  12928. else if IsSameType(ToLoType,ParamResolved.LoTypeEl,prraNone) then
  12929. // e.g. Byte(TAliasByte)
  12930. KeepWriteFlags:=true;
  12931. if KeepWriteFlags then
  12932. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  12933. end;
  12934. end
  12935. else if ToLoType is TPasProcedureType then
  12936. begin
  12937. // typecast to proctype
  12938. if ParamIsVar then
  12939. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable]
  12940. else
  12941. WriteFlags:=[];
  12942. SetResolverValueExpr(ResolvedEl,btContext,
  12943. ToLoType,ToHiType,
  12944. Param,[rrfReadable]+WriteFlags);
  12945. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  12946. end
  12947. else
  12948. begin
  12949. // typecast to custom type, e.g. to classtype, recordtype, arraytype, range, set
  12950. if (Param.Parent is TParamsExpr) then
  12951. Expr:=TParamsExpr(Param.Parent)
  12952. else
  12953. Expr:=Param;
  12954. ComputeElement(ToHiType,ResolvedEl,Flags,Expr);
  12955. ResolvedEl.ExprEl:=Expr;
  12956. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  12957. ResolvedEl.Flags:=[rrfReadable];
  12958. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  12959. if (WriteFlags<>[]) and ParamIsVar then
  12960. begin
  12961. KeepWriteFlags:=false;
  12962. if (rrfReadable in ResolvedEl.Flags) then
  12963. begin
  12964. // typecast a value
  12965. if ParamResolved.BaseType=btPointer then
  12966. begin
  12967. if (ToLoType.ClassType=TPasClassType)
  12968. or IsDynArray(ParamResolved.LoTypeEl) then
  12969. // aClassType(aPointer)
  12970. KeepWriteFlags:=true;
  12971. end
  12972. else if ParamResolved.LoTypeEl=nil then
  12973. // e.g. TAliasType(untyped)
  12974. KeepWriteFlags:=true
  12975. else if ToLoType=ParamResolved.LoTypeEl then
  12976. // e.g. TAliasType(ActualType)
  12977. KeepWriteFlags:=true
  12978. else if (ToLoType.ClassType=TPasClassType)
  12979. and (ParamResolved.LoTypeEl.ClassType=TPasClassType) then
  12980. begin
  12981. // e.g. aClassType(ObjVar)
  12982. if (TPasClassType(ToLoType).ObjKind<>TPasClassType(ParamResolved.LoTypeEl).ObjKind) then
  12983. // e.g. IntfType(ObjVar)
  12984. else
  12985. KeepWriteFlags:=true;
  12986. end
  12987. else if (ToLoType.ClassType=TPasRecordType)
  12988. and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
  12989. // typecast record
  12990. KeepWriteFlags:=true
  12991. else if (ToLoType.ClassType=TPasArrayType)
  12992. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  12993. and IsDynArray(ToLoType)
  12994. and IsDynArray(ParamResolved.LoTypeEl) then
  12995. // typecast dyn array to dyn array
  12996. KeepWriteFlags:=true;
  12997. end
  12998. else
  12999. begin
  13000. // typecast a type to a value, e.g. Pointer(TObject)
  13001. end;
  13002. if KeepWriteFlags then
  13003. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  13004. end;
  13005. end;
  13006. {$IFDEF VerbosePasResolver}
  13007. writeln('TPasResolver.ComputeFuncParams END ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved),' Result=',GetResolverResultDbg(ResolvedEl));
  13008. {$ENDIF}
  13009. end;
  13010. procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
  13011. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13012. StartEl: TPasElement);
  13013. // [param,param,...]
  13014. var
  13015. ParamResolved, FirstResolved: TPasResolverResult;
  13016. i: Integer;
  13017. Param: TPasExpr;
  13018. IsRange, IsArray: Boolean;
  13019. ArrayType: TPasArrayType;
  13020. begin
  13021. ArrayType:=IsArrayExpr(Params);
  13022. IsArray:=ArrayType<>nil;
  13023. if length(Params.Params)=0 then
  13024. begin
  13025. SetResolverValueExpr(ResolvedEl,btArrayOrSet,nil,nil,Params,[rrfReadable]);
  13026. if IsArray then
  13027. ResolvedEl.BaseType:=btArrayLit;
  13028. exit;
  13029. end;
  13030. FirstResolved:=Default(TPasResolverResult);
  13031. Flags:=Flags-[rcNoImplicitProc]+[rcNoImplicitProcType];
  13032. for i:=0 to length(Params.Params)-1 do
  13033. begin
  13034. Param:=Params.Params[i];
  13035. ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
  13036. IsRange:=ParamResolved.BaseType=btRange;
  13037. if IsRange then
  13038. begin
  13039. if IsArray then
  13040. RaiseXExpectedButYFound(20180615111713,'array value','range expression',Param);
  13041. ConvertRangeToElement(ParamResolved);
  13042. end;
  13043. if FirstResolved.BaseType=btNone then
  13044. begin
  13045. // first value -> check if type usable in a set/array
  13046. FirstResolved:=ParamResolved;
  13047. if IsRange then
  13048. CheckIsOrdinal(FirstResolved,Param,true);
  13049. if rrfReadable in FirstResolved.Flags then
  13050. begin
  13051. // has a value
  13052. if (not IsArray) and (not IsRange)
  13053. and (not CheckIsOrdinal(FirstResolved,Param,false)) then
  13054. begin
  13055. // can't be a set
  13056. IsArray:=true;
  13057. end;
  13058. end
  13059. else
  13060. begin
  13061. IsArray:=true;
  13062. if (FirstResolved.BaseType=btContext) then
  13063. begin
  13064. if FirstResolved.IdentEl is TPasClassType then
  13065. // array of classtypes
  13066. else
  13067. begin
  13068. {$IFDEF VerbosePasResolver}
  13069. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13070. {$ENDIF}
  13071. RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
  13072. end;
  13073. end
  13074. else
  13075. begin
  13076. {$IFDEF VerbosePasResolver}
  13077. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13078. {$ENDIF}
  13079. RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
  13080. end;
  13081. end;
  13082. end
  13083. else
  13084. begin
  13085. // next value
  13086. CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
  13087. end;
  13088. end;
  13089. FirstResolved.IdentEl:=nil;
  13090. FirstResolved.ExprEl:=Params;
  13091. FirstResolved.SubType:=FirstResolved.BaseType;
  13092. if IsArray then
  13093. FirstResolved.BaseType:=btArrayLit
  13094. else
  13095. FirstResolved.BaseType:=btArrayOrSet;
  13096. FirstResolved.Flags:=[rrfReadable];
  13097. ResolvedEl:=FirstResolved;
  13098. end;
  13099. procedure TPasResolver.ComputeDereference(El: TUnaryExpr;
  13100. var ResolvedEl: TPasResolverResult);
  13101. procedure Deref(TypeEl: TPasType);
  13102. var
  13103. Expr: TPasExpr;
  13104. begin
  13105. Expr:=ResolvedEl.ExprEl;
  13106. if Expr=nil then
  13107. Expr:=El;
  13108. ComputeElement(TypeEl,ResolvedEl,[rcNoImplicitProc],El);
  13109. ResolvedEl.IdentEl:=nil;
  13110. ResolvedEl.ExprEl:=Expr;
  13111. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  13112. end;
  13113. var
  13114. TypeEl: TPasType;
  13115. begin
  13116. if ResolvedEl.BaseType=btPointer then
  13117. begin
  13118. Deref(ResolvedEl.LoTypeEl);
  13119. exit;
  13120. end
  13121. else if ResolvedEl.BaseType=btContext then
  13122. begin
  13123. TypeEl:=ResolvedEl.LoTypeEl;
  13124. if TypeEl.ClassType=TPasPointerType then
  13125. begin
  13126. Deref(TPasPointerType(TypeEl).DestType);
  13127. exit;
  13128. end;
  13129. end;
  13130. RaiseMsg(20180422191139,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  13131. [OpcodeStrings[eopDeref],GetResolverResultDescription(ResolvedEl)],El);
  13132. end;
  13133. procedure TPasResolver.ComputeArrayValuesExpectedType(El: TArrayValues; out
  13134. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13135. StartEl: TPasElement);
  13136. // (expr, expr, ...)
  13137. var
  13138. Parent: TPasElement;
  13139. HiTypeEl, LoTypeEl: TPasType;
  13140. Field: PRecordValuesItem;
  13141. Ref: TResolvedReference;
  13142. Member: TPasVariable;
  13143. i: Integer;
  13144. ArrType: TPasArrayType;
  13145. begin
  13146. Parent:=El.Parent;
  13147. if Parent is TPasVariable then
  13148. begin
  13149. HiTypeEl:=TPasVariable(Parent).VarType;
  13150. if HiTypeEl=nil then
  13151. RaiseMsg(20180429171628,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13152. ['const','array values'],El);
  13153. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13154. if LoTypeEl.ClassType=TPasArrayType then
  13155. // ok
  13156. else
  13157. RaiseIncompatibleTypeDesc(20180429171714,nIncompatibleTypesGotExpected,
  13158. [],'array value',GetTypeDescription(HiTypeEl),El);
  13159. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13160. El,[rrfReadable]);
  13161. end
  13162. else if Parent.ClassType=TRecordValues then
  13163. begin
  13164. // record field array
  13165. // get field
  13166. i:=length(TRecordValues(Parent).Fields)-1;
  13167. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13168. dec(i);
  13169. if i<0 then
  13170. RaiseInternalError(20180429181150);
  13171. Field:=@TRecordValues(Parent).Fields[i];
  13172. // get member
  13173. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13174. Member:=Ref.Declaration as TPasVariable;
  13175. if Member=nil then
  13176. RaiseInternalError(20180429181210);
  13177. ComputeElement(Member,ResolvedEl,[],StartEl);
  13178. ResolvedEl.Flags:=[rrfReadable];
  13179. end
  13180. else if Parent.ClassType=TArrayValues then
  13181. begin
  13182. // array of array
  13183. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13184. if (ResolvedEl.BaseType=btContext)
  13185. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13186. begin
  13187. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13188. if length(ArrType.Ranges)>1 then
  13189. RaiseNotYetImplemented(20180429180930,El);
  13190. HiTypeEl:=ArrType.ElType;
  13191. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13192. if LoTypeEl.ClassType<>TPasArrayType then
  13193. RaiseIncompatibleTypeDesc(20180429180938,nIncompatibleTypesGotExpected,
  13194. [],'array values',GetTypeDescription(HiTypeEl),El);
  13195. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13196. El,[rrfReadable]);
  13197. end
  13198. else
  13199. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13200. [],'array values',GetTypeDescription(ResolvedEl),El);
  13201. end
  13202. else
  13203. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable]);
  13204. end;
  13205. procedure TPasResolver.ComputeRecordValues(El: TRecordValues; out
  13206. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13207. StartEl: TPasElement);
  13208. // (name:expr; name:expr; ...)
  13209. var
  13210. Parent, Member: TPasElement;
  13211. LoTypeEl, HiTypeEl: TPasType;
  13212. i: Integer;
  13213. Field: PRecordValuesItem;
  13214. Ref: TResolvedReference;
  13215. ArrType: TPasArrayType;
  13216. begin
  13217. Parent:=El.Parent;
  13218. if Parent is TPasVariable then
  13219. begin
  13220. HiTypeEl:=TPasVariable(Parent).VarType;
  13221. if HiTypeEl=nil then
  13222. RaiseMsg(20180429105451,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13223. ['const','record values'],El);
  13224. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13225. if LoTypeEl.ClassType<>TPasRecordType then
  13226. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  13227. [],'record value',GetTypeDescription(HiTypeEl),El);
  13228. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13229. El,[rrfReadable]);
  13230. end
  13231. else if Parent.ClassType=TRecordValues then
  13232. begin
  13233. // nested record
  13234. // get field
  13235. i:=length(TRecordValues(Parent).Fields)-1;
  13236. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13237. dec(i);
  13238. if i<0 then
  13239. RaiseInternalError(20180429130244);
  13240. Field:=@TRecordValues(Parent).Fields[i];
  13241. // get member
  13242. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13243. Member:=Ref.Declaration as TPasVariable;
  13244. if Member=nil then
  13245. RaiseInternalError(20180429130548);
  13246. ComputeElement(Member,ResolvedEl,[],StartEl);
  13247. ResolvedEl.Flags:=[rrfReadable];
  13248. end
  13249. else if Parent.ClassType=TArrayValues then
  13250. begin
  13251. // array of record
  13252. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13253. if (ResolvedEl.BaseType=btContext)
  13254. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13255. begin
  13256. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13257. if length(ArrType.Ranges)>1 then
  13258. RaiseNotYetImplemented(20180429180450,El);
  13259. HiTypeEl:=ArrType.ElType;
  13260. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13261. if LoTypeEl.ClassType<>TPasRecordType then
  13262. RaiseIncompatibleTypeDesc(20180429180642,nIncompatibleTypesGotExpected,
  13263. [],'record values',GetTypeDescription(HiTypeEl),El);
  13264. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13265. El,[rrfReadable]);
  13266. end
  13267. else
  13268. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13269. [],'array values',GetTypeDescription(ResolvedEl),El);
  13270. end
  13271. else
  13272. RaiseMsg(20180429110227,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13273. ['const','(name:'],El);
  13274. end;
  13275. procedure TPasResolver.CheckIsClass(El: TPasElement;
  13276. const ResolvedEl: TPasResolverResult);
  13277. var
  13278. TypeEl: TPasType;
  13279. begin
  13280. if (ResolvedEl.BaseType<>btContext) then
  13281. RaiseXExpectedButYFound(20170216152245,'class',BaseTypeNames[ResolvedEl.BaseType],El);
  13282. TypeEl:=ResolvedEl.LoTypeEl;
  13283. if (TypeEl.ClassType<>TPasClassType)
  13284. or (TPasClassType(TypeEl).ObjKind<>okClass) then
  13285. RaiseXExpectedButYFound(20170216152246,'class',GetElementTypeName(ResolvedEl.LoTypeEl),El);
  13286. end;
  13287. function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  13288. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  13289. // called when type casting a class instance into an unrelated class
  13290. begin
  13291. if FromClassRes.BaseType=btNone then ;
  13292. if ToClassRes.BaseType=btNone then ;
  13293. if ErrorEl=nil then ;
  13294. Result:=cIncompatible;
  13295. end;
  13296. procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
  13297. const LHS, RHS: TPasResolverResult);
  13298. var
  13299. LBT, RBT: TResolverBaseType;
  13300. begin
  13301. // check both are values
  13302. if not (rrfReadable in LHS.Flags) then
  13303. begin
  13304. if LHS.LoTypeEl<>nil then
  13305. RaiseXExpectedButYFound(20170216152645,'ordinal',GetElementTypeName(LHS.LoTypeEl),Left)
  13306. else
  13307. RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13308. end;
  13309. if not (rrfReadable in RHS.Flags) then
  13310. begin
  13311. if RHS.LoTypeEl<>nil then
  13312. RaiseXExpectedButYFound(20170216152651,'ordinal',GetElementTypeName(RHS.LoTypeEl),Right)
  13313. else
  13314. RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
  13315. end;
  13316. // check both have the same ordinal type
  13317. LBT:=GetActualBaseType(LHS.BaseType);
  13318. RBT:=GetActualBaseType(RHS.BaseType);
  13319. if LBT in btAllBooleans then
  13320. begin
  13321. if RBT in btAllBooleans then
  13322. exit;
  13323. RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13324. end
  13325. else if LBT in btAllInteger then
  13326. begin
  13327. if RBT in btAllInteger then
  13328. exit;
  13329. RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
  13330. end
  13331. else if LBT in btAllChars then
  13332. begin
  13333. if RBT in btAllChars then
  13334. exit;
  13335. RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
  13336. end
  13337. else if LBT=btContext then
  13338. begin
  13339. if LHS.LoTypeEl.ClassType=TPasEnumType then
  13340. begin
  13341. if LHS.LoTypeEl=RHS.LoTypeEl then
  13342. exit;
  13343. if RHS.LoTypeEl.ClassType<>TPasEnumType then
  13344. RaiseXExpectedButYFound(20170216152707,LHS.LoTypeEl.Parent.Name,GetElementTypeName(RHS.LoTypeEl),Right);
  13345. if LHS.LoTypeEl.Parent<>RHS.LoTypeEl.Parent then
  13346. RaiseXExpectedButYFound(20170216152710,LHS.LoTypeEl.Parent.Name,RHS.LoTypeEl.Parent.Name,Right);
  13347. end
  13348. else
  13349. RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13350. end
  13351. else
  13352. RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13353. end;
  13354. function TPasResolver.CheckIsOrdinal(
  13355. const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
  13356. RaiseOnError: boolean): boolean;
  13357. begin
  13358. Result:=false;
  13359. if ResolvedEl.BaseType in btAllRanges then
  13360. else if (ResolvedEl.BaseType=btContext) then
  13361. begin
  13362. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  13363. else if RaiseOnError then
  13364. RaiseXExpectedButYFound(20170216152718,'ordinal value',GetElementTypeName(ResolvedEl.LoTypeEl),ErrorEl)
  13365. else
  13366. exit;
  13367. end
  13368. else if RaiseOnError then
  13369. RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
  13370. else
  13371. exit;
  13372. Result:=true;
  13373. end;
  13374. procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
  13375. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  13376. // LHS defines the array element type
  13377. // check if RHS
  13378. var
  13379. LBT, RBT: TResolverBaseType;
  13380. C: TClass;
  13381. begin
  13382. if (LHS.LoTypeEl=RHS.LoTypeEl) and (LHS.BaseType=RHS.BaseType) then
  13383. exit; // exact same type
  13384. LBT:=GetActualBaseType(LHS.BaseType);
  13385. RBT:=GetActualBaseType(RHS.BaseType);
  13386. if rrfReadable in LHS.Flags then
  13387. begin
  13388. if not (rrfReadable in RHS.Flags) then
  13389. RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
  13390. [],RHS,LHS,Right);
  13391. // array of values
  13392. if LBT in btAllBooleans then
  13393. begin
  13394. if RBT in btAllBooleans then
  13395. begin
  13396. LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
  13397. exit;
  13398. end;
  13399. RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13400. end
  13401. else if LBT in btAllInteger then
  13402. begin
  13403. if RBT in btAllInteger then
  13404. begin
  13405. LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
  13406. exit;
  13407. end;
  13408. RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
  13409. end
  13410. else if LBT in btAllChars then
  13411. begin
  13412. if RBT in btAllChars then
  13413. begin
  13414. LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
  13415. exit;
  13416. end;
  13417. RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
  13418. end
  13419. else if LBT in btAllStrings then
  13420. begin
  13421. if RBT in btAllStringAndChars then
  13422. begin
  13423. LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
  13424. exit;
  13425. end;
  13426. RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
  13427. end
  13428. else if LBT=btNil then
  13429. begin
  13430. if RBT=btNil then
  13431. exit
  13432. else if RBT=btPointer then
  13433. begin
  13434. LHS:=RHS;
  13435. exit;
  13436. end
  13437. else if RBT=btContext then
  13438. begin
  13439. C:=RHS.LoTypeEl.ClassType;
  13440. if (C=TPasClassType)
  13441. or (C=TPasClassOfType)
  13442. or (C=TPasPointerType)
  13443. or ((C=TPasArrayType) and IsDynArray(RHS.LoTypeEl))
  13444. or (C=TPasProcedureType)
  13445. or (C=TPasFunctionType) then
  13446. begin
  13447. LHS:=RHS;
  13448. exit;
  13449. end;
  13450. end;
  13451. end
  13452. else if LBT=btContext then
  13453. begin
  13454. C:=LHS.LoTypeEl.ClassType;
  13455. if C=TPasEnumType then
  13456. begin
  13457. if LHS.LoTypeEl=RHS.LoTypeEl then
  13458. exit;
  13459. end
  13460. else if C=TPasClassType then
  13461. begin
  13462. // array of class instances
  13463. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13464. RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
  13465. [],RHS,LHS,Right);
  13466. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13467. begin
  13468. // right class type is a left class type -> ok
  13469. exit;
  13470. end
  13471. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13472. begin
  13473. // left class type is a right class type -> right is the new base class type
  13474. LHS:=RHS;
  13475. exit;
  13476. end;
  13477. end;
  13478. end;
  13479. end
  13480. else
  13481. begin
  13482. // array of types
  13483. if rrfReadable in RHS.Flags then
  13484. RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
  13485. [],RHS,LHS,Right);
  13486. if LBT=btContext then
  13487. begin
  13488. if LHS.LoTypeEl.ClassType=TPasClassType then
  13489. begin
  13490. // array of class type
  13491. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13492. RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
  13493. [],RHS,LHS,Right);
  13494. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13495. begin
  13496. // right class type is a left class type -> ok
  13497. exit;
  13498. end
  13499. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13500. begin
  13501. // left class type is a right class type -> right is the new base class type
  13502. LHS:=RHS;
  13503. exit;
  13504. end;
  13505. end;
  13506. end;
  13507. end;
  13508. // can't combine
  13509. if LHS.LoTypeEl=nil then
  13510. RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
  13511. if RHS.LoTypeEl=nil then
  13512. RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
  13513. RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
  13514. [],RHS,LHS,Right);
  13515. end;
  13516. procedure TPasResolver.ConvertRangeToElement(
  13517. var ResolvedEl: TPasResolverResult);
  13518. var
  13519. TypeEl: TPasType;
  13520. begin
  13521. if ResolvedEl.BaseType<>btRange then
  13522. RaiseInternalError(20161001155732);
  13523. if ResolvedEl.LoTypeEl=nil then
  13524. if ResolvedEl.IdentEl<>nil then
  13525. RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
  13526. else
  13527. RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
  13528. TypeEl:=ResolvedEl.LoTypeEl;
  13529. if TypeEl is TPasRangeType then
  13530. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant])
  13531. else
  13532. begin
  13533. ResolvedEl.BaseType:=ResolvedEl.SubType;
  13534. ResolvedEl.SubType:=btNone;
  13535. end;
  13536. end;
  13537. function TPasResolver.IsCharLiteral(const Value: string; ErrorPos: TPasElement
  13538. ): TResolverBaseType;
  13539. // returns true if Value is a Pascal char literal
  13540. // btAnsiChar: #65, #$50, ^G, 'a'
  13541. // btWideChar: #10000, 'ä'
  13542. var
  13543. i: SizeInt;
  13544. p, base, l: Integer;
  13545. begin
  13546. Result:=btNone;
  13547. //writeln('TPasResolver.IsCharLiteral ',BaseTypeChar,' "',Value,'" l=',length(Value));
  13548. l:=length(Value);
  13549. if l=0 then exit;
  13550. p:=1;
  13551. case Value[1] of
  13552. '''':
  13553. begin
  13554. inc(p);
  13555. if p>l then exit;
  13556. {$ifdef FPC_HAS_CPSTRING}
  13557. case Value[2] of
  13558. '''':
  13559. if Value='''''''''' then
  13560. Result:=btAnsiChar; // ''''
  13561. #32..#38,#40..#191:
  13562. if (l=3) and (Value[3]='''') then
  13563. Result:=btAnsiChar; // e.g. 'a'
  13564. #192..#255:
  13565. if BaseTypeChar=btWideChar then
  13566. begin
  13567. // default char is widechar: UTF-8 'ä' is a widechar
  13568. i:=Utf8CodePointLen(@Value[2],4,false);
  13569. //writeln('TPasResolver.IsCharLiteral "',Value,'" ',length(Value),' i=',i);
  13570. if i<2 then
  13571. exit;
  13572. p:=2+i;
  13573. if (p=l) and (Value[p]='''') then
  13574. // single UTF-8 codepoint
  13575. Result:=btWideChar;
  13576. end;
  13577. end;
  13578. {$else}
  13579. case Value[p] of
  13580. '''':
  13581. if (p+2=l) and (Value[p+1]='''') and (Value[p+2]='''') then
  13582. Result:=btWideChar; // ''''
  13583. #$DC00..#$DFFF: ;
  13584. else
  13585. if (l=3) and (Value[3]='''') then
  13586. Result:=btWideChar; // e.g. 'a'
  13587. end;
  13588. {$endif}
  13589. end;
  13590. '#':
  13591. begin
  13592. inc(p);
  13593. if p>l then exit;
  13594. case Value[p] of
  13595. '$': begin base:=16; inc(p); end;
  13596. '&': begin base:=8; inc(p); end;
  13597. '%': begin base:=2; inc(p); end;
  13598. '0'..'9': base:=10;
  13599. else RaiseNotYetImplemented(20170728142709,ErrorPos);
  13600. end;
  13601. i:=0;
  13602. while p<=l do
  13603. begin
  13604. case Value[p] of
  13605. '0'..'9': i:=i*base+ord(Value[p])-ord('0');
  13606. 'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
  13607. 'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
  13608. end;
  13609. inc(p);
  13610. end;
  13611. if p>l then
  13612. begin
  13613. {$ifdef FPC_HAS_CPSTRING}
  13614. if i<256 then
  13615. Result:=btAnsiChar
  13616. else
  13617. {$endif}
  13618. Result:=btWideChar;
  13619. end;
  13620. end;
  13621. '^':
  13622. begin
  13623. if (l=2) and (Value[2] in ['a'..'z','A'..'Z']) then
  13624. Result:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  13625. end;
  13626. end;
  13627. if Result in [{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar] then
  13628. begin
  13629. if FBaseTypes[Result]=nil then
  13630. begin
  13631. {$ifdef FPC_HAS_CPSTRING}
  13632. if Result=btAnsiChar then
  13633. Result:=btWideChar
  13634. else
  13635. {$endif}
  13636. Result:=btChar;
  13637. end;
  13638. if Result=BaseTypeChar then
  13639. Result:=btChar;
  13640. end;
  13641. end;
  13642. function TPasResolver.CheckForIn(Loop: TPasImplForLoop; const VarResolved,
  13643. InResolved: TPasResolverResult): boolean;
  13644. begin
  13645. Result:=false;
  13646. if Loop=nil then ;
  13647. if VarResolved.BaseType=btCustom then ;
  13648. if InResolved.BaseType=btCustom then ;
  13649. end;
  13650. function TPasResolver.CheckForInClassOrRec(Loop: TPasImplForLoop; const VarResolved,
  13651. InResolved: TPasResolverResult): boolean;
  13652. var
  13653. LoTypeEl: TPasType;
  13654. EnumeratorClass: TPasClassType;
  13655. EnumeratorScope: TPasDotClassScope;
  13656. Getter, MoveNext, Current: TPasIdentifier;
  13657. GetterFunc, MoveNextFunc: TPasFunction;
  13658. ptm: TProcTypeModifier;
  13659. ResultResolved, MoveNextResolved, CurrentResolved: TPasResolverResult;
  13660. CurrentProp: TPasProperty;
  13661. ForScope: TPasForLoopScope;
  13662. DotScope: TPasDotBaseScope;
  13663. begin
  13664. Result:=false;
  13665. if InResolved.IdentEl is TPasType then
  13666. RaiseMsg(20190120180525,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  13667. [GetBaseDescription(InResolved)],Loop.StartExpr);
  13668. if not (rrfReadable in InResolved.Flags) then
  13669. RaiseMsg(20171221195421,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  13670. [GetBaseDescription(InResolved)],Loop.StartExpr);
  13671. LoTypeEl:=InResolved.LoTypeEl;
  13672. if LoTypeEl=nil then exit;
  13673. // check function InVar.GetEnumerator
  13674. DotScope:=PushDotScope(InResolved.HiTypeEl);
  13675. if DotScope=nil then
  13676. exit;
  13677. // find aRecord.GetEnumerator
  13678. Getter:=DotScope.FindIdentifier('GetEnumerator');
  13679. PopScope;
  13680. if Getter=nil then
  13681. begin
  13682. if LoTypeEl is TPasMembersType then
  13683. RaiseIdentifierNotFound(20171221191511,'GetEnumerator',Loop.StartExpr)
  13684. else
  13685. exit;
  13686. end;
  13687. // check is function
  13688. if Getter.Element.ClassType<>TPasFunction then
  13689. RaiseContextXExpectedButYFound(20171221191638,'GetEnumerator','function',GetElementTypeName(Getter.Element),Loop.StartExpr);
  13690. GetterFunc:=TPasFunction(Getter.Element);
  13691. // check visibility
  13692. if not (GetterFunc.Visibility in [visPublic,visPublished]) then
  13693. RaiseContextXExpectedButYFound(20171221191824,'function GetEnumerator','public',VisibilityNames[GetterFunc.Visibility],Loop.StartExpr);
  13694. // check arguments
  13695. if GetterFunc.FuncType.Args.Count>0 then
  13696. RaiseContextXExpectedButYFound(20171221191944,'function GetEnumerator','no arguments',IntToStr(GetterFunc.ProcType.Args.Count),Loop.StartExpr);
  13697. // check proc type modifiers
  13698. for ptm in GetterFunc.ProcType.Modifiers do
  13699. if not (ptm in [ptmOfObject]) then
  13700. RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  13701. // check result type
  13702. ComputeElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcType]);
  13703. if (ResultResolved.BaseType<>btContext) then
  13704. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
  13705. LoTypeEl:=ResultResolved.LoTypeEl;
  13706. if not (LoTypeEl is TPasClassType) then
  13707. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  13708. if not (rrfReadable in ResultResolved.Flags) then
  13709. RaiseContextXExpectedButYFound(20171221195506,'function GetEnumerator','result class instance',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  13710. // find function MoveNext: boolean in Enumerator class
  13711. EnumeratorClass:=TPasClassType(LoTypeEl);
  13712. EnumeratorScope:=PushClassDotScope(EnumeratorClass);
  13713. MoveNext:=EnumeratorScope.FindIdentifier('MoveNext');
  13714. if MoveNext=nil then
  13715. RaiseIdentifierNotFound(20171221195632,'MoveNext',Loop.StartExpr);
  13716. // check is function
  13717. if MoveNext.Element.ClassType<>TPasFunction then
  13718. RaiseContextXExpectedButYFound(20171221195651,'MoveNext','function',GetElementTypeName(MoveNext.Element),Loop.StartExpr);
  13719. MoveNextFunc:=TPasFunction(MoveNext.Element);
  13720. // check visibility
  13721. if not (MoveNextFunc.Visibility in [visPublic,visPublished]) then
  13722. RaiseContextXExpectedButYFound(20171221195712,'function MoveNext','public',VisibilityNames[MoveNextFunc.Visibility],Loop.StartExpr);
  13723. // check arguments
  13724. if MoveNextFunc.FuncType.Args.Count>0 then
  13725. RaiseContextXExpectedButYFound(20171221195723,'function MoveNext','no arguments',IntToStr(MoveNextFunc.ProcType.Args.Count),Loop.StartExpr);
  13726. // check proc type modifiers
  13727. for ptm in MoveNextFunc.ProcType.Modifiers do
  13728. if not (ptm in [ptmOfObject]) then
  13729. RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  13730. // check result type
  13731. ComputeElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcType]);
  13732. if not (MoveNextResolved.BaseType in btAllBooleans) then
  13733. RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
  13734. // check property Current
  13735. Current:=EnumeratorScope.FindIdentifier('Current');
  13736. if Current=nil then
  13737. RaiseIdentifierNotFound(20171221200433,'Current',Loop.StartExpr);
  13738. // check is property
  13739. if Current.Element.ClassType<>TPasProperty then
  13740. RaiseContextXExpectedButYFound(20171221200508,'Current','property',GetElementTypeName(Current.Element),Loop.StartExpr);
  13741. CurrentProp:=TPasProperty(Current.Element);
  13742. // check visibility
  13743. if not (CurrentProp.Visibility in [visPublic,visPublished]) then
  13744. RaiseContextXExpectedButYFound(20171221200546,'property Current','public',VisibilityNames[CurrentProp.Visibility],Loop.StartExpr);
  13745. // check arguments
  13746. if CurrentProp.Args.Count>0 then
  13747. RaiseContextXExpectedButYFound(20171221200638,'property Current','no arguments',IntToStr(CurrentProp.Args.Count),Loop.StartExpr);
  13748. // check readable
  13749. if GetPasPropertyGetter(CurrentProp)=nil then
  13750. RaiseContextXInvalidY(20171221200823,'property Current','read accessor',Loop.StartExpr);
  13751. // check result type fits for-loop variable
  13752. ComputeElement(CurrentProp,CurrentResolved,[rcType]);
  13753. if CheckAssignResCompatibility(VarResolved,CurrentResolved,Loop.VariableName,false)=cIncompatible then
  13754. RaiseIncompatibleTypeRes(20171221200018,nIncompatibleTypesGotExpected,[],VarResolved,CurrentResolved,Loop.VariableName);
  13755. PopScope; // pop EnumeratorScope
  13756. ForScope:=Loop.CustomData as TPasForLoopScope;
  13757. ForScope.GetEnumerator:=GetterFunc;
  13758. ForScope.MoveNext:=MoveNextFunc;
  13759. ForScope.Current:=CurrentProp;
  13760. Result:=true;
  13761. end;
  13762. function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
  13763. Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
  13764. begin
  13765. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
  13766. begin
  13767. if RaiseOnError then
  13768. RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
  13769. sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
  13770. exit(false);
  13771. end;
  13772. Result:=true;
  13773. end;
  13774. function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
  13775. Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean): integer;
  13776. begin
  13777. if length(Params.Params)>MaxCount then
  13778. begin
  13779. if RaiseOnError then
  13780. RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
  13781. sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[MaxCount]);
  13782. exit(cIncompatible);
  13783. end;
  13784. Result:=cExact;
  13785. end;
  13786. function TPasResolver.CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer;
  13787. Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
  13788. RaiseOnError: boolean): integer;
  13789. begin
  13790. if RaiseOnError then
  13791. RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  13792. [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
  13793. Result:=cIncompatible;
  13794. end;
  13795. function TPasResolver.FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  13796. var
  13797. Clause: TPasUsesClause;
  13798. i: Integer;
  13799. Use: TPasUsesUnit;
  13800. ModName: String;
  13801. begin
  13802. Result:=nil;
  13803. if (Section=nil) then exit;
  13804. Clause:=Section.UsesClause;
  13805. for i:=0 to length(Clause)-1 do
  13806. begin
  13807. Use:=Clause[i];
  13808. if (Use.Module=nil) or not (Use.Module is TPasModule) then continue;
  13809. ModName:=Use.Module.Name;
  13810. if CompareText(ModName,aName)=0 then
  13811. exit(TPasModule(Use.Module));
  13812. end;
  13813. end;
  13814. function TPasResolver.FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  13815. var
  13816. C: TClass;
  13817. begin
  13818. C:=aMod.ClassType;
  13819. if C.InheritsFrom(TPasProgram) then
  13820. Result:=FindUsedUnitInSection(aName,TPasProgram(aMod).ProgramSection)
  13821. else if C.InheritsFrom(TPasLibrary) then
  13822. Result:=FindUsedUnitInSection(aName,TPasLibrary(aMod).LibrarySection)
  13823. else
  13824. begin
  13825. Result:=FindUsedUnitInSection(aName,aMod.InterfaceSection);
  13826. if Result<>nil then exit;
  13827. Result:=FindUsedUnitInSection(aName,aMod.ImplementationSection);
  13828. end
  13829. end;
  13830. procedure TPasResolver.FinishAssertCall(Proc: TResElDataBuiltInProc;
  13831. Params: TParamsExpr);
  13832. var
  13833. aMod: TPasModule;
  13834. ModScope: TPasModuleScope;
  13835. aConstructor: TPasConstructor;
  13836. begin
  13837. if Proc=nil then ;
  13838. aMod:=RootElement;
  13839. ModScope:=aMod.CustomData as TPasModuleScope;
  13840. if not (pmsfAssertSearched in ModScope.Flags) then
  13841. FindAssertExceptionConstructors(Params);
  13842. if ModScope.AssertClass=nil then exit;
  13843. if length(Params.Params)>1 then
  13844. aConstructor:=ModScope.AssertMsgConstructor
  13845. else
  13846. aConstructor:=ModScope.AssertDefConstructor;
  13847. if aConstructor=nil then exit;
  13848. CreateReference(aConstructor,Params,rraRead);
  13849. end;
  13850. function TPasResolver.FindClassTypeAndConstructor(const aUnitName,
  13851. aClassName: string; out aClass: TPasClassType; out
  13852. aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
  13853. var
  13854. aMod, UtilsMod: TPasModule;
  13855. SectionScope: TPasSectionScope;
  13856. Identifier: TPasIdentifier;
  13857. El: TPasElement;
  13858. ClassScope: TPasClassScope;
  13859. begin
  13860. Result:=false;
  13861. aClass:=nil;
  13862. aConstructor:=nil;
  13863. // find unit in uses clauses
  13864. aMod:=RootElement;
  13865. UtilsMod:=FindUsedUnit(aUnitName,aMod);
  13866. if UtilsMod=nil then exit;
  13867. // find class in interface
  13868. if UtilsMod.InterfaceSection=nil then exit;
  13869. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  13870. Identifier:=SectionScope.FindLocalIdentifier(aClassName);
  13871. if Identifier=nil then exit;
  13872. El:=Identifier.Element;
  13873. if not (El is TPasClassType) then
  13874. RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl);
  13875. if TPasClassType(El).ObjKind<>okClass then
  13876. RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetElementTypeName(El),ErrorEl);
  13877. aClass:=TPasClassType(El);
  13878. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  13879. repeat
  13880. Identifier:=ClassScope.FindIdentifier('create');
  13881. while Identifier<>nil do
  13882. begin
  13883. if Identifier.Element.ClassType=TPasConstructor then
  13884. begin
  13885. aConstructor:=TPasConstructor(Identifier.Element);
  13886. if aConstructor.ProcType.Args.Count=0 then
  13887. exit(true);
  13888. end;
  13889. Identifier:=Identifier.NextSameIdentifier;
  13890. end;
  13891. ClassScope:=ClassScope.AncestorScope;
  13892. until ClassScope=nil;
  13893. aConstructor:=nil;
  13894. end;
  13895. procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
  13896. var
  13897. aMod: TPasModule;
  13898. ModScope: TPasModuleScope;
  13899. Identifier: TPasIdentifier;
  13900. aClass: TPasClassType;
  13901. ClassScope: TPasClassScope;
  13902. aConstructor: TPasConstructor;
  13903. Arg: TPasArgument;
  13904. ArgResolved: TPasResolverResult;
  13905. begin
  13906. aMod:=RootElement;
  13907. ModScope:=aMod.CustomData as TPasModuleScope;
  13908. if pmsfAssertSearched in ModScope.Flags then exit;
  13909. Include(ModScope.Flags,pmsfAssertSearched);
  13910. FindClassTypeAndConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
  13911. if aClass=nil then exit;
  13912. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  13913. ModScope.AssertClass:=aClass;
  13914. repeat
  13915. Identifier:=ClassScope.FindIdentifier('create');
  13916. while Identifier<>nil do
  13917. begin
  13918. if Identifier.Element.ClassType=TPasConstructor then
  13919. begin
  13920. aConstructor:=TPasConstructor(Identifier.Element);
  13921. //writeln('TPasResolver.FindAssertExceptionConstructors ',aConstructor.Name,' ',aConstructor.ProcType.Args.Count);
  13922. if aConstructor.ProcType.Args.Count=0 then
  13923. begin
  13924. if ModScope.AssertDefConstructor=nil then
  13925. ModScope.AssertDefConstructor:=aConstructor;
  13926. end
  13927. else if aConstructor.ProcType.Args.Count=1 then
  13928. begin
  13929. if ModScope.AssertMsgConstructor=nil then
  13930. begin
  13931. Arg:=TPasArgument(aConstructor.ProcType.Args[0]);
  13932. //writeln('TPasResolver.FindAssertExceptionConstructors ',GetObjName(Arg.ArgType),' ',GetObjName(BaseTypes[BaseTypeString]));
  13933. ComputeElement(Arg.ArgType,ArgResolved,[rcType]);
  13934. if ArgResolved.BaseType in btAllStrings then
  13935. ModScope.AssertMsgConstructor:=aConstructor;
  13936. end;
  13937. end;
  13938. end;
  13939. Identifier:=Identifier.NextSameIdentifier;
  13940. end;
  13941. ClassScope:=ClassScope.AncestorScope;
  13942. until ClassScope=nil;
  13943. end;
  13944. procedure TPasResolver.FindRangeErrorConstructors(ErrorEl: TPasElement);
  13945. var
  13946. aMod: TPasModule;
  13947. ModScope: TPasModuleScope;
  13948. aClass: TPasClassType;
  13949. aConstructor: TPasConstructor;
  13950. begin
  13951. aMod:=RootElement;
  13952. ModScope:=aMod.CustomData as TPasModuleScope;
  13953. if pmsfRangeErrorSearched in ModScope.Flags then exit;
  13954. Include(ModScope.Flags,pmsfRangeErrorSearched);
  13955. FindClassTypeAndConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
  13956. ModScope.RangeErrorClass:=aClass;
  13957. ModScope.RangeErrorConstructor:=aConstructor;
  13958. end;
  13959. function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
  13960. var
  13961. aMod, UtilsMod: TPasModule;
  13962. SectionScope: TPasSectionScope;
  13963. Identifier: TPasIdentifier;
  13964. El: TPasElement;
  13965. ModScope: TPasModuleScope;
  13966. begin
  13967. aMod:=RootElement;
  13968. ModScope:=aMod.CustomData as TPasModuleScope;
  13969. Result:=ModScope.SystemTVarRec;
  13970. if Result<>nil then exit;
  13971. // find unit in uses clauses
  13972. UtilsMod:=FindUsedUnit('system',aMod);
  13973. if UtilsMod=nil then
  13974. RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
  13975. // find class in interface
  13976. if UtilsMod.InterfaceSection=nil then
  13977. RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
  13978. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  13979. Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
  13980. if Identifier=nil then
  13981. RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
  13982. El:=Identifier.Element;
  13983. if not (El is TPasRecordType) then
  13984. RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
  13985. Result:=TPasRecordType(El);
  13986. ModScope.SystemTVarRec:=Result;
  13987. end;
  13988. function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
  13989. var
  13990. aModule: TPasModule;
  13991. ModScope: TPasModuleScope;
  13992. begin
  13993. aModule:=El.GetModule;
  13994. ModScope:=aModule.CustomData as TPasModuleScope;
  13995. Result:=ModScope.SystemTVarRec;
  13996. if Result=nil then
  13997. RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
  13998. end;
  13999. function TPasResolver.FindDefaultConstructor(aClass: TPasClassType
  14000. ): TPasConstructor;
  14001. var
  14002. ClassScope: TPasClassScope;
  14003. Identifier: TPasIdentifier;
  14004. El: TPasElement;
  14005. HasOverload: Boolean;
  14006. Proc: TPasProcedure;
  14007. begin
  14008. Result:=nil;
  14009. if (aClass=nil) or aClass.IsExternal or (aClass.ObjKind<>okClass) then exit;
  14010. ClassScope:=aClass.CustomData as TPasClassScope;
  14011. repeat
  14012. Identifier:=ClassScope.FindLocalIdentifier('create');
  14013. if Identifier<>nil then
  14014. begin
  14015. HasOverload:=false;
  14016. while Identifier<>nil do
  14017. begin
  14018. El:=Identifier.Element;
  14019. if not (El is TPasProcedure) then exit;
  14020. Proc:=TPasProcedure(El);
  14021. if Proc.ClassType=TPasConstructor then
  14022. begin
  14023. if Proc.ProcType.Args.Count=0 then
  14024. exit(TPasConstructor(El));
  14025. end;
  14026. if Proc.IsOverload then
  14027. HasOverload:=true;
  14028. Identifier:=Identifier.NextSameIdentifier;
  14029. end;
  14030. if not HasOverload then exit;
  14031. end;
  14032. ClassScope:=ClassScope.AncestorScope;
  14033. until false;
  14034. end;
  14035. procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
  14036. const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  14037. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  14038. PosEl: TPasElement);
  14039. begin
  14040. if MsgType<=mtError then
  14041. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
  14042. else
  14043. LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  14044. if Sender=nil then ;
  14045. end;
  14046. function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
  14047. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
  14048. var
  14049. Ref: TResolvedReference;
  14050. Decl: TPasElement;
  14051. C: TClass;
  14052. ResolvedType: TPasResolverResult;
  14053. EnumValue: TPasEnumValue;
  14054. EnumType: TPasEnumType;
  14055. EvalFlags: TResEvalFlags;
  14056. begin
  14057. Result:=nil;
  14058. if not (Expr.CustomData is TResolvedReference) then
  14059. RaiseNotYetImplemented(20170518203134,Expr);
  14060. Ref:=TResolvedReference(Expr.CustomData);
  14061. Decl:=Ref.Declaration;
  14062. {$IFDEF VerbosePasResEval}
  14063. writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
  14064. {$ENDIF}
  14065. C:=Decl.ClassType;
  14066. if C=TPasConst then
  14067. begin
  14068. if (TPasConst(Decl).Expr<>nil)
  14069. and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
  14070. begin
  14071. if TPasConst(Decl).VarType<>nil then
  14072. begin
  14073. // typed const
  14074. ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
  14075. end
  14076. else
  14077. ResolvedType.BaseType:=btNone;
  14078. EvalFlags:=Flags;
  14079. if not (refConstExt in EvalFlags) then
  14080. Include(EvalFlags,refConst);
  14081. Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,EvalFlags);
  14082. if Result<>nil then
  14083. begin
  14084. if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
  14085. Result:=Result.Clone;
  14086. Result.IdentEl:=Decl;
  14087. if TPasConst(Decl).VarType<>nil then
  14088. begin
  14089. // typed const
  14090. if Result.Kind=revkInt then
  14091. case ResolvedType.BaseType of
  14092. btByte: TResEvalInt(Result).Typed:=reitByte;
  14093. btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
  14094. btWord: TResEvalInt(Result).Typed:=reitWord;
  14095. btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
  14096. btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
  14097. btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
  14098. btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
  14099. btLongint: TResEvalInt(Result).Typed:=reitLongInt;
  14100. btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
  14101. {$ifdef HasInt64}
  14102. btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
  14103. btInt64: TResEvalInt(Result).Typed:=reitNone; // default
  14104. {$else}
  14105. btIntDouble: TResEvalInt(Result).Typed:=reitNone; // default
  14106. {$endif}
  14107. else
  14108. ReleaseEvalValue(Result);
  14109. RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
  14110. end;
  14111. end;
  14112. exit;
  14113. end;
  14114. end
  14115. else if vmExternal in TPasConst(Decl).VarModifiers then
  14116. begin
  14117. Result:=TResEvalExternal.Create;
  14118. Result.IdentEl:=Decl;
  14119. exit;
  14120. end;
  14121. if refConst in Flags then
  14122. begin
  14123. ReleaseEvalValue(Result);
  14124. RaiseConstantExprExp(20170518214928,Expr);
  14125. end;
  14126. end
  14127. else if C=TPasEnumValue then
  14128. begin
  14129. EnumValue:=TPasEnumValue(Decl);
  14130. EnumType:=EnumValue.Parent as TPasEnumType;
  14131. Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
  14132. exit;
  14133. end
  14134. else if C.InheritsFrom(TPasType) then
  14135. Result:=EvalTypeRange(TPasType(Decl),Flags);
  14136. {$IFDEF VerbosePasResEval}
  14137. writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags,' refConstExt=',refConstExt in Flags);
  14138. {$ENDIF}
  14139. if (Result=nil) and ([refConst,refConstExt]*Flags<>[]) then
  14140. RaiseConstantExprExp(20170518213616,Expr);
  14141. if Sender=nil then ;
  14142. end;
  14143. function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
  14144. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  14145. var
  14146. Ref: TResolvedReference;
  14147. Decl: TPasElement;
  14148. C: TClass;
  14149. BuiltInProc: TResElDataBuiltInProc;
  14150. bt: TResolverBaseType;
  14151. ResolvedEl: TPasResolverResult;
  14152. TypeEl: TPasType;
  14153. begin
  14154. Result:=nil;
  14155. case Params.Kind of
  14156. pekArrayParams: ;
  14157. pekFuncParams:
  14158. if Params.Value.CustomData is TResolvedReference then
  14159. begin
  14160. Ref:=TResolvedReference(Params.Value.CustomData);
  14161. Decl:=Ref.Declaration;
  14162. if Decl is TPasType then
  14163. Decl:=ResolveAliasType(TPasType(Decl));
  14164. C:=Decl.ClassType;
  14165. if C=TPasUnresolvedSymbolRef then
  14166. begin
  14167. if Decl.CustomData is TResElDataBuiltInProc then
  14168. begin
  14169. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  14170. {$IFDEF VerbosePasResEval}
  14171. writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14172. {$ENDIF}
  14173. if BuiltInProc.Eval<>nil then
  14174. BuiltInProc.Eval(BuiltInProc,Params,Flags,Result)
  14175. else
  14176. case BuiltInProc.BuiltIn of
  14177. bfAssigned: Result:=nil;
  14178. bfConcatArray: Result:=nil;
  14179. bfCopyArray: Result:=nil;
  14180. bfTypeInfo: Result:=nil;
  14181. else
  14182. {$IFDEF VerbosePasResEval}
  14183. writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14184. {$ENDIF}
  14185. RaiseNotYetImplemented(20170624192324,Params);
  14186. end;
  14187. {$IFDEF VerbosePasResEval}
  14188. {AllowWriteln}
  14189. if Result<>nil then
  14190. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
  14191. else
  14192. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
  14193. {AllowWriteln-}
  14194. {$ENDIF}
  14195. exit;
  14196. end
  14197. else if Decl.CustomData is TResElDataBaseType then
  14198. begin
  14199. // typecast to basetype
  14200. bt:=TResElDataBaseType(Decl.CustomData).BaseType;
  14201. Result:=EvalBaseTypeCast(Params,bt);
  14202. end;
  14203. {$IFDEF VerbosePasResEval}
  14204. writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
  14205. {$ENDIF}
  14206. end
  14207. else if C=TPasEnumType then
  14208. begin
  14209. // typecast to enumtype
  14210. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
  14211. end
  14212. else if C=TPasRangeType then
  14213. begin
  14214. // typecast to custom range
  14215. ComputeElement(TPasRangeType(Decl).RangeExpr.left,ResolvedEl,[rcConstant]);
  14216. if ResolvedEl.BaseType=btContext then
  14217. begin
  14218. TypeEl:=ResolvedEl.LoTypeEl;
  14219. if TypeEl.ClassType=TPasEnumType then
  14220. begin
  14221. // typecast to enumtype
  14222. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(TypeEl),Params.Params[0],Flags);
  14223. end
  14224. else
  14225. RaiseNotYetImplemented(20171009223403,Params);
  14226. end
  14227. else
  14228. RaiseNotYetImplemented(20171009223303,Params);
  14229. end;
  14230. end;
  14231. pekSet: ;
  14232. end;
  14233. if Flags=[] then ;
  14234. if Sender=nil then ;
  14235. end;
  14236. procedure TPasResolver.OnRangeCheckEl(Sender: TResExprEvaluator;
  14237. El: TPasElement; var MsgType: TMessageType);
  14238. begin
  14239. if El=nil then exit;
  14240. if (MsgType=mtWarning)
  14241. and (bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
  14242. MsgType:=mtError;
  14243. if Sender=nil then ;
  14244. end;
  14245. function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
  14246. bt: TResolverBaseType): TResEvalvalue;
  14247. procedure TCFloatToInt(Value: TResEvalValue; Flo: TMaxPrecFloat);
  14248. var
  14249. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14250. begin
  14251. if bt in btAllIntegerNoQWord then
  14252. begin
  14253. // float to int
  14254. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14255. if (Flo<MinIntVal) or (Flo>MaxIntVal) then
  14256. fExprEvaluator.EmitRangeCheckConst(20170711001228,
  14257. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14258. {$R-}
  14259. try
  14260. Int:=Round(Flo);
  14261. except
  14262. RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
  14263. end;
  14264. case bt of
  14265. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14266. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14267. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14268. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14269. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14270. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14271. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14272. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14273. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14274. {$ifdef HasInt64}
  14275. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14276. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14277. {$else}
  14278. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14279. {$endif}
  14280. else
  14281. RaiseNotYetImplemented(20170711001513,Params);
  14282. end;
  14283. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14284. exit;
  14285. end
  14286. else if bt=btSingle then
  14287. begin
  14288. // float to single
  14289. try
  14290. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Flo));
  14291. except
  14292. RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
  14293. end;
  14294. end
  14295. else if bt=btDouble then
  14296. begin
  14297. // float to double
  14298. try
  14299. Result:=TResEvalFloat.CreateValue(double(Flo));
  14300. except
  14301. RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
  14302. end;
  14303. end
  14304. else if bt=btCurrency then
  14305. begin
  14306. // float to currency
  14307. try
  14308. Result:=TResEvalCurrency.CreateValue(Currency(Flo));
  14309. except
  14310. RaiseMsg(20180421171840,nRangeCheckError,sRangeCheckError,[],Params);
  14311. end;
  14312. end
  14313. else
  14314. begin
  14315. {$IFDEF VerbosePasResEval}
  14316. writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
  14317. {$ENDIF}
  14318. RaiseNotYetImplemented(20170711002542,Params);
  14319. end;
  14320. end;
  14321. var
  14322. Value: TResEvalValue;
  14323. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14324. Flo: TMaxPrecFloat;
  14325. w: WideChar;
  14326. begin
  14327. Result:=nil;
  14328. {$IFDEF VerbosePasResEval}
  14329. writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
  14330. {$ENDIF}
  14331. Value:=Eval(Params.Params[0],[refAutoConstExt]);
  14332. if Value=nil then exit;
  14333. try
  14334. case Value.Kind of
  14335. revkInt:
  14336. begin
  14337. Int:=TResEvalInt(Value).Int;
  14338. {$ifdef HasInt64}
  14339. if bt=btQWord then
  14340. begin
  14341. // int to qword
  14342. {$R-}
  14343. Result:=TResEvalUInt.CreateValue(TMaxPrecUInt(Int));
  14344. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14345. end
  14346. else
  14347. {$endif}
  14348. if bt in btAllIntegerNoQWord then
  14349. begin
  14350. // int to int
  14351. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14352. if (Int<MinIntVal) or (Int>MaxIntVal) then
  14353. begin
  14354. {$R-}
  14355. case bt of
  14356. btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
  14357. btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
  14358. btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
  14359. btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
  14360. btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
  14361. btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
  14362. {$ifdef HasInt64}
  14363. btInt64: Result:=TResEvalInt.CreateValue(Int);
  14364. {$endif}
  14365. btUIntSingle,
  14366. btIntSingle,
  14367. btUIntDouble,
  14368. btIntDouble:
  14369. fExprEvaluator.EmitRangeCheckConst(20170624194534,
  14370. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14371. else
  14372. RaiseNotYetImplemented(20170624200109,Params);
  14373. end;
  14374. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14375. end
  14376. else
  14377. begin
  14378. {$R-}
  14379. case bt of
  14380. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14381. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14382. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14383. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14384. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14385. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14386. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14387. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14388. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14389. {$ifdef HasInt64}
  14390. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14391. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14392. {$else}
  14393. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14394. {$endif}
  14395. else
  14396. RaiseNotYetImplemented(20170624200109,Params);
  14397. end;
  14398. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14399. end;
  14400. exit;
  14401. end
  14402. else if bt in btAllBooleans then
  14403. case Int of
  14404. 0: Result:=TResEvalBool.CreateValue(false);
  14405. 1: Result:=TResEvalBool.CreateValue(true);
  14406. else
  14407. fExprEvaluator.EmitRangeCheckConst(20170710203254,
  14408. Value.AsString,0,1,Params,mtError);
  14409. end
  14410. {$ifdef FPC_HAS_CPSTRING}
  14411. else if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14412. try
  14413. Result:=TResEvalString.CreateValue(Char(Int));
  14414. except
  14415. RaiseMsg(20180125112510,nRangeCheckError,sRangeCheckError,[],Params);
  14416. end
  14417. {$endif}
  14418. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14419. try
  14420. w:=WideChar(Int);
  14421. Result:=TResEvalUTF16.CreateValue(w);
  14422. except
  14423. RaiseMsg(20180125112716,nRangeCheckError,sRangeCheckError,[],Params);
  14424. end
  14425. else if bt=btSingle then
  14426. try
  14427. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Int));
  14428. except
  14429. RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
  14430. end
  14431. else if bt=btDouble then
  14432. try
  14433. Result:=TResEvalFloat.CreateValue(Double(Int));
  14434. except
  14435. RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
  14436. end
  14437. else if bt=btCurrency then
  14438. try
  14439. Result:=TResEvalCurrency.CreateValue(Currency(Int));
  14440. except
  14441. RaiseMsg(20180422093631,nRangeCheckError,sRangeCheckError,[],Params);
  14442. end
  14443. else
  14444. begin
  14445. {$IFDEF VerbosePasResEval}
  14446. writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
  14447. {$ENDIF}
  14448. RaiseNotYetImplemented(20170624194308,Params);
  14449. end;
  14450. end;
  14451. revkFloat:
  14452. begin
  14453. Flo:=TResEvalFloat(Value).FloatValue;
  14454. TCFloatToInt(Value,Flo);
  14455. end;
  14456. revkCurrency:
  14457. begin
  14458. if bt=btCurrency then
  14459. begin
  14460. Result:=Value;
  14461. Value:=nil;
  14462. end
  14463. else
  14464. begin
  14465. Flo:=TResEvalCurrency(Value).Value;
  14466. TCFloatToInt(Value,Flo);
  14467. end;
  14468. end;
  14469. {$ifdef FPC_HAS_CPSTRING}
  14470. revkString:
  14471. begin
  14472. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14473. begin
  14474. // ansichar(ansistring)
  14475. if fExprEvaluator.StringToOrd(Value,nil)>$ffff then
  14476. RaiseXExpectedButYFound(20181005141025,'char','string',Params);
  14477. Result:=Value;
  14478. Value:=nil;
  14479. end
  14480. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14481. begin
  14482. // widechar(ansistring)
  14483. if fExprEvaluator.GetWideChar(TResEvalString(Value).S,w) then
  14484. begin
  14485. Result:=Value;
  14486. Value:=nil;
  14487. end
  14488. else
  14489. RaiseXExpectedButYFound(20181005141058,'char','string',Params);
  14490. end
  14491. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  14492. begin
  14493. // ansistring(ansistring)
  14494. Result:=Value;
  14495. Value:=nil;
  14496. end
  14497. else if (bt=btUnicodeString) or (bt=btWideString)
  14498. or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  14499. begin
  14500. // unicodestring(ansistring)
  14501. Result:=TResEvalUTF16.CreateValue(
  14502. fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Params));
  14503. end
  14504. else if bt=btRawByteString then
  14505. begin
  14506. // rawbytestring(ansistring)
  14507. SetCodePage(TResEvalString(Value).S,CP_NONE,false);
  14508. end;
  14509. end;
  14510. {$endif}
  14511. revkUnicodeString:
  14512. if length(TResEvalUTF16(Value).S)=1 then
  14513. begin
  14514. w:=TResEvalUTF16(Value).S[1];
  14515. {$ifdef FPC_HAS_CPSTRING}
  14516. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14517. begin
  14518. // ansichar(unicodestring)
  14519. if ord(w)<=255 then
  14520. begin
  14521. Result:=Value;
  14522. Value:=nil;
  14523. end
  14524. else
  14525. RaiseMsg(20181005141632,nRangeCheckError,sRangeCheckError,[],Params);
  14526. end
  14527. else
  14528. {$endif}
  14529. if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14530. begin
  14531. // widechar(unicodestring)
  14532. Result:=Value;
  14533. Value:=nil;
  14534. end;
  14535. end
  14536. {$ifdef FPC_HAS_CPSTRING}
  14537. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  14538. begin
  14539. // ansistring(unicodestring)
  14540. Result:=TResEvalString.CreateValue(
  14541. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
  14542. end
  14543. else if bt=btRawByteString then
  14544. begin
  14545. // rawbytestring(unicodestring)
  14546. Result:=TResEvalString.CreateValue(
  14547. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
  14548. end
  14549. {$endif}
  14550. else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  14551. begin
  14552. // unicodestring(unicodestring)
  14553. Result:=Value;
  14554. Value:=nil;
  14555. end;
  14556. revkExternal:
  14557. exit;
  14558. else
  14559. {$IFDEF VerbosePasResEval}
  14560. writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
  14561. {$ENDIF}
  14562. RaiseNotYetImplemented(20170624193436,Params);
  14563. end;
  14564. finally
  14565. ReleaseEvalValue(Value);
  14566. end;
  14567. end;
  14568. procedure TPasResolver.AddGenericTemplateIdentifiers(
  14569. GenericTemplateTypes: TFPList; Scope: TPasIdentifierScope);
  14570. var
  14571. TemplType: TPasGenericTemplateType;
  14572. i: Integer;
  14573. begin
  14574. if GenericTemplateTypes=nil then exit;
  14575. for i:=0 to GenericTemplateTypes.Count-1 do
  14576. begin
  14577. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  14578. Scope.AddIdentifier(TemplType.Name,TemplType,pikSimple);
  14579. end;
  14580. end;
  14581. procedure TPasResolver.AddSpecializedTemplateIdentifiers(
  14582. GenericTemplateTypes: TFPList; SpecializedItem: TPRSpecializedItem;
  14583. Scope: TPasIdentifierScope; CheckConstraints: boolean);
  14584. var
  14585. i: Integer;
  14586. TemplType: TPasGenericTemplateType;
  14587. ParamTypes: TPasTypeArray;
  14588. ParamType: TPasType;
  14589. ErrorPos: TPasElement;
  14590. begin
  14591. ParamTypes:=SpecializedItem.Params;
  14592. ErrorPos:=SpecializedItem.FirstSpecialize;
  14593. for i:=0 to length(ParamTypes)-1 do
  14594. begin
  14595. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  14596. ParamType:=ParamTypes[i];
  14597. if CheckConstraints then
  14598. begin
  14599. if ParamType is TPasGenericTemplateType then
  14600. CheckTemplateFitsTemplate(TPasGenericTemplateType(ParamType),
  14601. TemplType,ErrorPos)
  14602. else
  14603. CheckTemplateFitsParam(ParamType,TemplType,SpecializedItem,
  14604. prtcoAssignToTempl,ErrorPos);
  14605. end;
  14606. AddIdentifier(Scope,TemplType.Name,ParamTypes[i],pikSimple);
  14607. end;
  14608. end;
  14609. function TPasResolver.CreateInferenceTypesForCall(Params: TParamsExpr;
  14610. TargetProc: TPasProcedure): TFPList;
  14611. type
  14612. TInferredType = record
  14613. InferType: TPasType;
  14614. IsVarOut: boolean;
  14615. end;
  14616. TInferredTypes = array of TInferredType;
  14617. procedure RaiseInferTypeMismatch(const Id: TMaxPrecInt; ArgType: TPasType;
  14618. ErrorPos: TPasElement);
  14619. begin
  14620. RaiseMsg(Id,nInferredTypeXFromDiffArgsMismatchFromMethodY,
  14621. sInferredTypeXFromDiffArgsMismatchFromMethodY,
  14622. [ArgType.Name,TargetProc.Name],ErrorPos);
  14623. end;
  14624. procedure Infer(ArgParent: TPasElement; ArgType, ParamLoType, ParamHiType: TPasType;
  14625. NeedVar, IsSubType, IsDelphi: boolean;
  14626. InferenceParams: TInferredTypes; TemplTypes: TFPList;
  14627. ErrorPos: TPasElement);
  14628. var
  14629. C: TClass;
  14630. i: Integer;
  14631. OldInferType, ParamElType: TPasType;
  14632. ResolveAlias: TPRResolveAlias;
  14633. Arr: TPasArrayType;
  14634. begin
  14635. if (ArgType=nil) or (ParamLoType=nil) then exit;
  14636. C:=ArgType.ClassType;
  14637. if C=TPasGenericTemplateType then
  14638. begin
  14639. i:=TemplTypes.IndexOf(ArgType);
  14640. if i>=0 then
  14641. begin
  14642. // a generic type param corresponds to ParamType
  14643. OldInferType:=InferenceParams[i].InferType;
  14644. if OldInferType=nil then
  14645. begin
  14646. // template type inferred first time
  14647. InferenceParams[i].InferType:=ParamHiType;
  14648. InferenceParams[i].IsVarOut:=NeedVar;
  14649. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  14650. exit;
  14651. end;
  14652. // already inferred -> check compatibility
  14653. ResolveAlias:=prraAlias;
  14654. if IsDelphi and (NeedVar or InferenceParams[i].IsVarOut) then
  14655. // Delphi allows passing alias, but not type alias to a var arg
  14656. ResolveAlias:=prraSimple;
  14657. if IsSameType(OldInferType,ParamHiType,ResolveAlias) then
  14658. exit; // same types -> ok
  14659. if IsSubType then
  14660. begin
  14661. if CheckElTypeCompatibility(OldInferType,InferenceParams[i].InferType,
  14662. ResolveAlias)<=cGenericExact then
  14663. exit;
  14664. // e.g. "array of TA" and "array of TB"
  14665. RaiseInferTypeMismatch(20191006215539,ArgType,ErrorPos);
  14666. end;
  14667. // top level type does not fit exactly
  14668. if NeedVar then
  14669. begin
  14670. // second is var/out
  14671. if InferenceParams[i].IsVarOut then
  14672. // two var/out arguments mismatch
  14673. RaiseInferTypeMismatch(20191006220355,ArgType,ErrorPos);
  14674. if CheckAssignCompatibility(ParamHiType,OldInferType,
  14675. false,ErrorPos)=cIncompatible then
  14676. // second is var/out, and do not match
  14677. RaiseInferTypeMismatch(20191006220402,ArgType,ErrorPos);
  14678. // first can be widened to fit
  14679. InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  14680. InferenceParams[i].InferType:=ParamHiType;
  14681. InferenceParams[i].IsVarOut:=NeedVar;
  14682. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  14683. exit;
  14684. end
  14685. else if InferenceParams[i].IsVarOut then
  14686. begin
  14687. // first was var/out
  14688. if CheckAssignCompatibility(OldInferType,ParamHiType,
  14689. false,ErrorPos)=cIncompatible then
  14690. // first was var/out, and do not match
  14691. RaiseInferTypeMismatch(20191006220750,ArgType,ErrorPos);
  14692. // second can be widened to fit
  14693. exit;
  14694. end;
  14695. // find a type compatible to both
  14696. // ToDo
  14697. RaiseInferTypeMismatch(20191006220406,ArgType,ErrorPos);
  14698. end;
  14699. end
  14700. else if ArgParent<>ArgType.Parent then
  14701. // ArgType is a reference
  14702. else if C=TPasArrayType then
  14703. begin
  14704. // e.g. Proc(a: array...)
  14705. Arr:=TPasArrayType(ArgType);
  14706. if ParamLoType.ClassType<>TPasArrayType then
  14707. exit;
  14708. ParamElType:=TPasArrayType(ParamLoType).ElType;
  14709. Infer(Arr,Arr.ElType,ParamElType,ResolveAliasType(ParamElType),
  14710. NeedVar,true,IsDelphi,InferenceParams,TemplTypes,ErrorPos);
  14711. end
  14712. else
  14713. begin
  14714. {$IFDEF VerbosePasResolver}
  14715. //writeln('Infer ArgType=',GetObjName(ArgType),' ParamLoType=',GetObjName(ParamLoType));
  14716. {$ENDIF}
  14717. end;
  14718. end;
  14719. procedure InferParam(i: integer; NeedVar: boolean; ParamsExprs: TPasExprArray;
  14720. ProcArgs: TFPList;
  14721. InferenceParams: TInferredTypes; TemplTypes: TFPList; IsDelphi: boolean);
  14722. var
  14723. Arg: TPasArgument;
  14724. ArgType: TPasType;
  14725. ArgResolved, ExprResolved: TPasResolverResult;
  14726. Expr: TPasExpr;
  14727. begin
  14728. //writeln('InferParam i=',i,' NeedVar=',NeedVar,' IsDelphi=',IsDelphi,' ProcArgs.Count=',ProcArgs.Count);
  14729. Arg:=TPasArgument(ProcArgs[i]);
  14730. ArgType:=Arg.ArgType;
  14731. if ArgType=nil then
  14732. exit; // untyped arg
  14733. if (ArgType.Parent<>Arg) and (ArgType.ClassType<>TPasGenericTemplateType) then
  14734. exit; // a reference -> no need to search for a template reference
  14735. if NeedVar<>(Arg.Access in [argVar, argOut]) then
  14736. exit;
  14737. if i<length(ParamsExprs) then
  14738. Expr:=ParamsExprs[i]
  14739. else
  14740. begin
  14741. Expr:=Arg.ValueExpr;
  14742. if Expr=nil then exit;
  14743. end;
  14744. ComputeArgumentAndExpr(Arg,ArgResolved,Expr,ExprResolved,false);
  14745. {$IFDEF VerbosePasResolver}
  14746. writeln('TPasResolver.CreateInferenceTypesForCall Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  14747. {$ENDIF}
  14748. if ExprResolved.BaseType in btAllWithSubType then
  14749. begin
  14750. // passing a literal set or array or custom range
  14751. {$IFDEF VerbosePasResolver}
  14752. writeln('TPasResolver.CreateInferenceTypesForCall.InferParam ToDo: ',GetResolverResultDbg(ExprResolved));
  14753. {$ENDIF}
  14754. end
  14755. else if (ExprResolved.SubType<>btNone) then
  14756. RaiseNotYetImplemented(20191006203622,Expr)
  14757. else
  14758. Infer(Arg,ArgType,ExprResolved.LoTypeEl,ExprResolved.HiTypeEl,
  14759. NeedVar,false,IsDelphi,
  14760. InferenceParams,TemplTypes,Expr);
  14761. end;
  14762. var
  14763. TemplTypes, ProcArgs: TFPList;
  14764. InferenceTypes: TInferredTypes;
  14765. ParamsExprs: TPasExprArray;
  14766. IsDelphi: Boolean;
  14767. i: Integer;
  14768. begin
  14769. Result:=nil;
  14770. TemplTypes:=GetProcTemplateTypes(TargetProc);
  14771. if (TemplTypes=nil) or (TemplTypes.Count=0) then
  14772. RaiseNotYetImplemented(20191006174321,Params);
  14773. ProcArgs:=TargetProc.ProcType.Args;
  14774. ParamsExprs:=Params.Params;
  14775. if ProcArgs.Count<length(ParamsExprs) then
  14776. RaiseNotYetImplemented(20191006183021,Params);
  14777. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  14778. try
  14779. SetLength(InferenceTypes,TemplTypes.Count);
  14780. for i:=0 to TemplTypes.Count-1 do
  14781. InferenceTypes[i]:=Default(TInferredType);
  14782. // first infer from var/out args exact types
  14783. for i:=0 to ProcArgs.Count-1 do
  14784. InferParam(i,true,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  14785. // then infer from the other args
  14786. for i:=0 to ProcArgs.Count-1 do
  14787. InferParam(i,false,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  14788. // check that all types are inferred
  14789. for i:=0 to TemplTypes.Count-1 do
  14790. if InferenceTypes[i].InferType=nil then
  14791. RaiseMsg(20191006175104,nCouldNotInferTypeArgXForMethodY,
  14792. sCouldNotInferTypeArgXForMethodY,
  14793. [TPasGenericTemplateType(TemplTypes[i]).Name,TargetProc.Name],Params);
  14794. Result:=TFPList.Create;
  14795. for i:=0 to length(InferenceTypes)-1 do
  14796. begin
  14797. Result.Add(InferenceTypes[i].InferType);
  14798. InferenceTypes[i].InferType:=nil;
  14799. end;
  14800. finally
  14801. if Result=nil then
  14802. for i:=0 to length(InferenceTypes)-1 do
  14803. if InferenceTypes[i].InferType<>nil then
  14804. InferenceTypes[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  14805. end;
  14806. end;
  14807. function TPasResolver.GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  14808. Params: TFPList): TPasElement;
  14809. var
  14810. Data: TPasSpecializeTypeData;
  14811. GenScope: TPasGenericScope;
  14812. GenericTemplateList: TFPList;
  14813. i, j: Integer;
  14814. Param: TPasElement;
  14815. ParamsResolved: TPasTypeArray;
  14816. ResolvedEl: TPasResolverResult;
  14817. SpecializedElList: TObjectList;
  14818. Item: TPRSpecializedItem;
  14819. SrcModule: TPasModule;
  14820. SrcModuleScope: TPasModuleScope;
  14821. SrcResolver: TPasResolver;
  14822. IsSelf: Boolean;
  14823. GenericType: TPasGenericType;
  14824. GenericProc: TPasProcedure;
  14825. ProcScope: TPasProcedureScope;
  14826. begin
  14827. Result:=nil;
  14828. if El.CustomData<>nil then
  14829. RaiseNotYetImplemented(20190726142522,El);
  14830. // check if there is already such a specialization
  14831. GenScope:=nil;
  14832. GenericType:=nil;
  14833. GenericProc:=nil;
  14834. if GenericEl is TPasGenericType then
  14835. begin
  14836. GenericType:=TPasGenericType(GenericEl);
  14837. if not (GenericEl.CustomData is TPasGenericScope) then
  14838. RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  14839. [GetTypeDescription(GenericType)],El);
  14840. GenScope:=TPasGenericScope(GenericEl.CustomData);
  14841. if (not (GenericType is TPasClassType))
  14842. and (GenScope.GenericStep<psgsInterfaceParsed) then
  14843. RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  14844. [GetTypeDescription(GenericType)],El);
  14845. GenericTemplateList:=GenericType.GenericTemplateTypes;
  14846. end
  14847. else if GenericEl is TPasProcedure then
  14848. begin
  14849. GenericProc:=TPasProcedure(GenericEl);
  14850. if not (GenericProc.CustomData is TPasProcedureScope) then
  14851. RaiseMsg(20190919132733,nIdentifierNotFound,sIdentifierNotFound,
  14852. [GenericProc.Name],El);
  14853. ProcScope:=TPasProcedureScope(GenericProc.CustomData);
  14854. if ProcScope.DeclarationProc<>nil then
  14855. RaiseNotYetImplemented(20190920182602,El);
  14856. GenScope:=ProcScope;
  14857. if GenScope.GenericStep<psgsInterfaceParsed then
  14858. RaiseMsg(20190920120649,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  14859. [GetElementDbgPath(GenericProc)],El);
  14860. GenericTemplateList:=GetProcTemplateTypes(GenericProc);
  14861. end
  14862. else
  14863. RaiseNotYetImplemented(20190919132603,GenericEl);
  14864. SpecializedElList:=GenScope.SpecializedItems;
  14865. if GenericTemplateList=nil then
  14866. RaiseMsg(20190905111703,nXExpectedButYFound,sXExpectedButYFound,
  14867. ['generic templates',GenericEl.Name],El);
  14868. if GenericTemplateList.Count<>Params.Count then
  14869. RaiseMsg(20190905111704,nXExpectedButYFound,sXExpectedButYFound,
  14870. ['type with '+IntToStr(Params.Count)+' generic template(s)',
  14871. GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
  14872. SetLength(ParamsResolved,Params.Count);
  14873. IsSelf:=true;
  14874. for i:=0 to Params.Count-1 do
  14875. begin
  14876. Param:=TPasElement(Params[i]);
  14877. ComputeElement(Param,ResolvedEl,[rcType]);
  14878. ParamsResolved[i]:=ResolvedEl.LoTypeEl;
  14879. if ResolvedEl.LoTypeEl<>TPasType(GenericTemplateList[i]) then
  14880. IsSelf:=false;
  14881. end;
  14882. if IsSelf then
  14883. exit(GenericEl);
  14884. if SpecializedElList=nil then
  14885. begin
  14886. SpecializedElList:=TObjectList.Create(true);
  14887. if GenScope<>nil then
  14888. GenScope.SpecializedItems:=SpecializedElList
  14889. else
  14890. RaiseNotYetImplemented(20190919133159,El);
  14891. end;
  14892. i:=SpecializedElList.Count-1;
  14893. Item:=nil;
  14894. while i>=0 do
  14895. begin
  14896. Item:=TPRSpecializedItem(SpecializedElList[i]);
  14897. j:=length(Item.Params)-1;
  14898. while j>=0 do
  14899. begin
  14900. if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
  14901. and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
  14902. break;
  14903. dec(j);
  14904. end;
  14905. if j<0 then
  14906. break;
  14907. Item:=nil;
  14908. dec(i);
  14909. end;
  14910. if Item=nil then
  14911. begin
  14912. // new specialization
  14913. SrcModule:=GenericEl.GetModule;
  14914. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  14915. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  14916. Item:=SrcResolver.CreateSpecializedItem(El,GenericEl,ParamsResolved)
  14917. end;
  14918. Result:=Item.SpecializedEl;
  14919. if El.ClassType=TPasSpecializeType then
  14920. begin
  14921. Data:=TPasSpecializeTypeData.Create;
  14922. // add to free list
  14923. AddResolveData(El,Data,lkModule);
  14924. Data.SpecializedType:=Result as TPasGenericType;
  14925. end;
  14926. end;
  14927. function TPasResolver.CheckGenericConstraintFitsParam(ParamType: TPasType;
  14928. SpecializedItem: TPRSpecializedItem; TemplType: TPasGenericTemplateType;
  14929. ConEl: TPasElement; Operation: TPRTemplateCompOp; ErrorPos: TPasElement
  14930. ): integer;
  14931. function RaiseXExpButYFound(id: TMaxPrecInt; const X: string; Y: TPasType): integer;
  14932. begin
  14933. if ErrorPos<>nil then
  14934. RaiseXExpectedButTypeYFound(id,X,Y,ErrorPos);
  14935. Result:=cIncompatible;
  14936. end;
  14937. procedure RaiseNotValidConstraint(Id: TMaxPrecInt; ConEl: TPasElement);
  14938. begin
  14939. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  14940. [GetElementSourcePosStr(ConEl)],ErrorPos);
  14941. end;
  14942. function ElementReferencesTemplateTypes(El: TPasElement;
  14943. GenericTemplateTypes: TFPList): boolean;
  14944. var
  14945. C: TClass;
  14946. Prim: TPrimitiveExpr;
  14947. Decl: TPasElement;
  14948. Bin: TBinaryExpr;
  14949. Spec: TPasSpecializeType;
  14950. Arr: TPasArrayType;
  14951. i: Integer;
  14952. InlineSpec: TInlineSpecializeExpr;
  14953. begin
  14954. Result:=false;
  14955. if El=nil then exit;
  14956. C:=El.ClassType;
  14957. if C=TPrimitiveExpr then
  14958. begin
  14959. Prim:=TPrimitiveExpr(El);
  14960. if Prim.Kind=pekIdent then
  14961. begin
  14962. if Prim.CustomData is TResolvedReference then
  14963. begin
  14964. Decl:=TResolvedReference(Prim.CustomData).Declaration;
  14965. exit(ElementReferencesTemplateTypes(Decl,GenericTemplateTypes));
  14966. end;
  14967. end
  14968. else
  14969. exit;
  14970. end
  14971. else if C=TBinaryExpr then
  14972. begin
  14973. Bin:=TBinaryExpr(El);
  14974. Result:=ElementReferencesTemplateTypes(Bin.left,GenericTemplateTypes)
  14975. or ElementReferencesTemplateTypes(Bin.right,GenericTemplateTypes);
  14976. end
  14977. else if C=TInlineSpecializeExpr then
  14978. begin
  14979. InlineSpec:=TInlineSpecializeExpr(El);
  14980. if ElementReferencesTemplateTypes(InlineSpec.NameExpr,GenericTemplateTypes) then
  14981. exit(true);
  14982. for i:=0 to InlineSpec.Params.Count-1 do
  14983. begin
  14984. Decl:=TPasElement(InlineSpec.Params[i]);
  14985. if Decl.Parent<>InlineSpec then continue;
  14986. if ElementReferencesTemplateTypes(Decl,GenericTemplateTypes) then
  14987. exit(true);
  14988. end;
  14989. end
  14990. else if C=TPasGenericTemplateType then
  14991. Result:=GenericTemplateTypes.IndexOf(El)>=0
  14992. else if C.InheritsFrom(TPasType) then
  14993. begin
  14994. if TPasType(El).Name<>'' then exit;
  14995. if C=TPasSpecializeType then
  14996. begin
  14997. Spec:=TPasSpecializeType(El);
  14998. if ElementReferencesTemplateTypes(Spec.DestType,GenericTemplateTypes) then
  14999. exit(true);
  15000. for i:=0 to Spec.Params.Count-1 do
  15001. if ElementReferencesTemplateTypes(TPasElement(Spec.Params[i]),GenericTemplateTypes) then
  15002. exit(true);
  15003. end
  15004. else if C=TPasArrayType then
  15005. begin
  15006. Arr:=TPasArrayType(El);
  15007. for i:=0 to length(Arr.Ranges)-1 do
  15008. if ElementReferencesTemplateTypes(Arr.Ranges[i],GenericTemplateTypes) then exit(true);
  15009. Result:=ElementReferencesTemplateTypes(Arr.ElType,GenericTemplateTypes);
  15010. end
  15011. else if C=TPasPointerType then
  15012. Result:=ElementReferencesTemplateTypes(TPasPointerType(El).DestType,GenericTemplateTypes)
  15013. else if C=TPasSetType then
  15014. Result:=ElementReferencesTemplateTypes(TPasSetType(El).EnumType,GenericTemplateTypes)
  15015. else if C=TPasEnumType then
  15016. else
  15017. RaiseNotYetImplemented(20190905110152,El);
  15018. end
  15019. else
  15020. RaiseNotYetImplemented(20190905105648,El);
  15021. end;
  15022. var
  15023. ConToken: TToken;
  15024. aClass, ConstraintClass: TPasClassType;
  15025. GenTempl: TPasGenericTemplateType;
  15026. i: Integer;
  15027. ResolvedEl: TPasResolverResult;
  15028. ConType: TPasType;
  15029. GenericTemplateTypes: TFPList;
  15030. GenericEl: TPasElement;
  15031. begin
  15032. ConToken:=GetGenericConstraintKeyword(ConEl);
  15033. case ConToken of
  15034. tkrecord:
  15035. begin
  15036. if ParamType is TPasRecordType then exit(cExact);
  15037. exit(RaiseXExpButYFound(20190725200015,'record type',ParamType));
  15038. end;
  15039. tkclass,tkconstructor:
  15040. begin
  15041. if not (ParamType is TPasClassType) then
  15042. exit(RaiseXExpButYFound(20190726133231,'class type',ParamType));
  15043. aClass:=TPasClassType(ParamType);
  15044. if aClass.ObjKind<>okClass then
  15045. exit(RaiseXExpButYFound(20190726133232,'class type',ParamType));
  15046. if aClass.IsExternal then
  15047. exit(RaiseXExpButYFound(20190726133233,'non external class type',ParamType));
  15048. if ConToken=tkconstructor then
  15049. begin
  15050. if FindDefaultConstructor(aClass)=nil then
  15051. exit(RaiseXExpButYFound(20190831000225,'class type with constructor create()',ParamType));
  15052. end;
  15053. exit;
  15054. end;
  15055. end;
  15056. if not (ConEl is TPasType) then
  15057. RaiseNotYetImplemented(20190912214727,ConEl,GetObjPath(ErrorPos));
  15058. // constraint can be a class type, interface type or a template type
  15059. // Param must be a class
  15060. if SpecializedItem<>nil then
  15061. begin
  15062. GenericEl:=SpecializedItem.GenericEl;
  15063. if GenericEl is TPasGenericType then
  15064. GenericTemplateTypes:=TPasGenericType(GenericEl).GenericTemplateTypes
  15065. else if GenericEl is TPasProcedure then
  15066. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(GenericEl))
  15067. else
  15068. RaiseNotYetImplemented(20190920114755,ConEl);
  15069. if ElementReferencesTemplateTypes(ConEl,GenericTemplateTypes) then
  15070. begin
  15071. // constraint contains templates -> specialize constraint
  15072. if ConEl is TPasType then
  15073. begin
  15074. // type reference
  15075. ConType:=TPasType(ConEl);
  15076. i:=length(SpecializedItem.SpecializedConstraints);
  15077. Setlength(SpecializedItem.SpecializedConstraints,i+1);
  15078. SpecializedItem.SpecializedConstraints[i]:=nil;
  15079. SpecializeElType(TemplType,SpecializedItem.SpecializedEl,ConType,
  15080. TPasType(SpecializedItem.SpecializedConstraints[i]));
  15081. ConEl:=SpecializedItem.SpecializedConstraints[i];
  15082. end
  15083. else
  15084. // non type reference
  15085. RaiseNotValidConstraint(20190915181137,ConEl);
  15086. end;
  15087. end;
  15088. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15089. if ResolvedEl.BaseType<>btContext then
  15090. RaiseNotValidConstraint(20190914105836,ConEl);
  15091. if ResolvedEl.HiTypeEl.Name='' then
  15092. RaiseNotValidConstraint(20190726134037,GetGenericConstraintErrorEl(ConEl,TemplType));
  15093. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  15094. begin
  15095. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  15096. if GenTempl=ConEl.Parent then
  15097. RaiseNotYetImplemented(20190831213359,GenTempl);
  15098. Result:=CheckTemplateFitsParam(ParamType,GenTempl,nil,Operation,ErrorPos);
  15099. end
  15100. else if ResolvedEl.LoTypeEl is TPasClassType then
  15101. begin
  15102. // constraint is classtype or interfacetype
  15103. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15104. if not (ParamType is TPasClassType) then
  15105. begin
  15106. if ErrorPos<>nil then
  15107. RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],
  15108. ParamType,ConstraintClass,ErrorPos);
  15109. exit(cIncompatible);
  15110. end;
  15111. if TPasClassType(ParamType).ObjKind<>okClass then
  15112. begin
  15113. if ErrorPos<>nil then
  15114. RaiseMsg(20190904175144,nXExpectedButYFound,sXExpectedButYFound,
  15115. ['class',GetTypeDescription(ParamType)],ErrorPos);
  15116. exit(cIncompatible);
  15117. end;
  15118. case ConstraintClass.ObjKind of
  15119. okClass:
  15120. case Operation of
  15121. prtcoAssignToTempl:
  15122. // TemplateClass:=ParamClassType
  15123. if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
  15124. begin
  15125. // ParamType is not ConstraintClass
  15126. if ErrorPos<>nil then
  15127. RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],
  15128. ParamType,ConstraintClass,ErrorPos);
  15129. exit(cIncompatible);
  15130. end;
  15131. prtcoAssignFromTempl:
  15132. // ParamClassType:=TemplateClass
  15133. if CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible then
  15134. begin
  15135. // ConstraintClass is not ParamType
  15136. if ErrorPos<>nil then
  15137. RaiseIncompatibleType(20190915202812,nIncompatibleTypesGotExpected,[''],
  15138. ConstraintClass,ParamType,ErrorPos);
  15139. exit(cIncompatible);
  15140. end;
  15141. prtcoEqual:
  15142. // TemplateClass=ParamClassType
  15143. if (CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible)
  15144. and (CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible) then
  15145. begin
  15146. // ParamType is not related to ConstraintClass
  15147. if ErrorPos<>nil then
  15148. RaiseIncompatibleType(20190915203651,nIncompatibleTypesGotExpected,[''],
  15149. ParamType,ConstraintClass,ErrorPos);
  15150. exit(cIncompatible);
  15151. end;
  15152. else
  15153. RaiseNotYetImplemented(20190915203439,ConEl);
  15154. end;
  15155. okInterface:
  15156. case Operation of
  15157. prtcoAssignToTempl:
  15158. // TemplateClassWithIntf:=ParamClassType
  15159. if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
  15160. begin
  15161. // ParamType does not implement ConstraintClass
  15162. if ErrorPos<>nil then
  15163. RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],
  15164. ParamType,ConstraintClass,ErrorPos);
  15165. exit(cIncompatible);
  15166. end;
  15167. prtcoAssignFromTempl:
  15168. // ParamClassType:=TemplateClassWithIntf
  15169. begin
  15170. // check when specialize
  15171. end;
  15172. prtcoEqual:
  15173. // TemplateClassWithIntf=ParamClassType
  15174. begin
  15175. // check when specialize
  15176. end;
  15177. else
  15178. RaiseNotYetImplemented(20190915203218,ConEl);
  15179. end;
  15180. else
  15181. if ErrorPos<>nil then
  15182. RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],
  15183. ParamType,ConstraintClass,ErrorPos);
  15184. exit(cIncompatible);
  15185. end;
  15186. end
  15187. else
  15188. begin
  15189. {$IFDEF VerbosePasResolver}
  15190. writeln('TPasResolver.CheckSpecializedParamFitsConstraintExpr ',GetObjPath(ResolvedEl.LoTypeEl));
  15191. {$ENDIF}
  15192. RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15193. [GetElementSourcePosStr(GetGenericConstraintErrorEl(ConEl,ConEl.Parent))],
  15194. ErrorPos);
  15195. end;
  15196. Result:=cExact;
  15197. end;
  15198. function TPasResolver.CheckTemplateFitsParam(ParamType: TPasType;
  15199. GenTempl: TPasGenericTemplateType; SpecializedItem: TPRSpecializedItem;
  15200. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15201. var
  15202. i: Integer;
  15203. begin
  15204. // check if the ParamType fits the constraints
  15205. for i:=0 to length(GenTempl.Constraints)-1 do
  15206. begin
  15207. Result:=CheckGenericConstraintFitsParam(ParamType,SpecializedItem,
  15208. GenTempl,GenTempl.Constraints[i],Operation,ErrorPos);
  15209. if Result=cIncompatible then exit;
  15210. end;
  15211. Result:=cExact;
  15212. end;
  15213. function TPasResolver.CheckTemplateFitsParamRes(
  15214. GenTempl: TPasGenericTemplateType; const ResolvedEl: TPasResolverResult;
  15215. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15216. var
  15217. i: Integer;
  15218. ConEl: TPasElement;
  15219. ConToken: TToken;
  15220. LoTypeEl: TPasType;
  15221. begin
  15222. if length(GenTempl.Constraints)=0 then
  15223. exit(cGenericExact);
  15224. if ResolvedEl.BaseType=btContext then
  15225. begin
  15226. LoTypeEl:=ResolvedEl.LoTypeEl;
  15227. if LoTypeEl is TPasGenericTemplateType then
  15228. begin
  15229. if LoTypeEl=GenTempl then
  15230. exit(cGenericExact);
  15231. if (Operation=prtcoAssignToTempl) and (ErrorPos<>nil) then
  15232. CheckTemplateFitsTemplate(TPasGenericTemplateType(LoTypeEl),GenTempl,ErrorPos);
  15233. Result:=cGenericExact;
  15234. end
  15235. else
  15236. Result:=CheckTemplateFitsParam(LoTypeEl,GenTempl,nil,Operation,ErrorPos);
  15237. end
  15238. else if ResolvedEl.BaseType=btNil then
  15239. begin
  15240. for i:=0 to length(GenTempl.Constraints)-1 do
  15241. begin
  15242. ConEl:=GenTempl.Constraints[i];
  15243. ConToken:=GetGenericConstraintKeyword(ConEl);
  15244. if ConToken=tkrecord then
  15245. begin
  15246. if ErrorPos<>nil then
  15247. RaiseXExpectedButYFound(20190915211000,'record type','nil',ErrorPos);
  15248. exit(cIncompatible);
  15249. end;
  15250. end;
  15251. Result:=cGenericExact;
  15252. end
  15253. else
  15254. begin
  15255. if ErrorPos<>nil then
  15256. RaiseNotYetImplemented(20190915205441,ErrorPos);
  15257. Result:=cIncompatible;
  15258. end;
  15259. end;
  15260. procedure TPasResolver.CheckTemplateFitsTemplate(ParamTemplType,
  15261. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  15262. procedure RaiseNotValidConstraint(const Id: TMaxPrecInt; ConEl: TPasElement);
  15263. begin
  15264. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15265. [GetElementTypeName(ConEl)],GetGenericConstraintErrorEl(ConEl,GenTempl));
  15266. end;
  15267. var
  15268. ParamConstraints: TPasElementArray;
  15269. j, k: Integer;
  15270. ConToken: TToken;
  15271. ConstraintClass, ParamClassType: TPasClassType;
  15272. ConEl, ParamConstraintEl: TPasElement;
  15273. ParamLoType, ParamHiType: TPasType;
  15274. ResolvedEl: TPasResolverResult;
  15275. begin
  15276. ParamConstraints:=ParamTemplType.Constraints;
  15277. for j:=0 to length(GenTempl.Constraints)-1 do
  15278. begin
  15279. ConEl:=GenTempl.Constraints[j];
  15280. ConToken:=GetGenericConstraintKeyword(ConEl);
  15281. if ConToken<>tkEOF then
  15282. begin
  15283. // constraint is keyword
  15284. // -> check if keyword is in ParamConstraints
  15285. k:=length(ParamConstraints)-1;
  15286. while (k>=0) and (GetGenericConstraintKeyword(ParamConstraints[k])<>ConToken) do
  15287. dec(k);
  15288. if k<0 then
  15289. RaiseMsg(20190816230021,nTypeParamXIsMissingConstraintY,
  15290. sTypeParamXIsMissingConstraintY,
  15291. [ParamTemplType.Name,TokenInfos[ConToken]],ErrorPos);
  15292. end
  15293. else if ConEl is TPasType then
  15294. begin
  15295. // constraint is a type
  15296. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15297. if ResolvedEl.BaseType<>btContext then
  15298. RaiseNotValidConstraint(20190816231846,ConEl);
  15299. if not (ResolvedEl.LoTypeEl is TPasClassType) then
  15300. RaiseNotValidConstraint(20190816231849,ConEl);
  15301. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15302. // constraint is class/interface type
  15303. // -> check if one of ParamConstraints fits the constraint type
  15304. // i.e. ParamConstraints must be more strict than target constraints
  15305. k:=length(ParamConstraints)-1;
  15306. while k>=0 do
  15307. begin
  15308. ParamConstraintEl:=ParamConstraints[k];
  15309. if ParamConstraintEl is TPasType then
  15310. begin
  15311. ParamHiType:=TPasType(ParamConstraintEl);
  15312. ParamLoType:=ResolveAliasType(ParamHiType);
  15313. if not (ParamLoType is TPasClassType) then
  15314. RaiseMsg(20190816232459,nXExpectedButYFound,sXExpectedButYFound,
  15315. ['type',GetTypeDescription(ParamHiType)],
  15316. GetGenericConstraintErrorEl(ParamConstraintEl,ParamTemplType));
  15317. ParamClassType:=TPasClassType(ParamLoType);
  15318. if (ConstraintClass.ObjKind=okInterface)
  15319. and (ParamClassType.ObjKind=okClass) then
  15320. begin
  15321. if GetClassImplementsIntf(ParamClassType,ConstraintClass)<>nil then
  15322. break;
  15323. end
  15324. else
  15325. begin
  15326. if CheckClassIsClass(ParamClassType,ConstraintClass)<cIncompatible then
  15327. break;
  15328. end;
  15329. end;
  15330. dec(k);
  15331. end;
  15332. if k<0 then
  15333. begin
  15334. if ConstraintClass.ObjKind=okInterface then
  15335. RaiseMsg(20190816233102,nTypeParamXMustSupportIntfY,
  15336. sTypeParamXMustSupportIntfY,
  15337. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos)
  15338. else
  15339. RaiseMsg(20190816230021,nTypeParamXIsNotCompatibleWithY,
  15340. sTypeParamXIsNotCompatibleWithY,
  15341. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos);
  15342. end;
  15343. end
  15344. else
  15345. RaiseNotYetImplemented(20190912215702,GetGenericConstraintErrorEl(ConEl,GenTempl));
  15346. end;
  15347. end;
  15348. function TPasResolver.CreateSpecializedItem(El: TPasElement;
  15349. GenericEl: TPasElement; const ParamsResolved: TPasTypeArray
  15350. ): TPRSpecializedItem;
  15351. var
  15352. NewEl: TPasElement;
  15353. GenScope: TPasGenericScope;
  15354. SpecializedItems: TObjectList;
  15355. procedure InsertBehind(List: TFPList);
  15356. var
  15357. Last: TPasElement;
  15358. i: Integer;
  15359. begin
  15360. Last:=GenericEl;
  15361. if SpecializedItems<>nil then
  15362. begin
  15363. i:=SpecializedItems.Count-2;
  15364. if i>=0 then
  15365. Last:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
  15366. end;
  15367. i:=List.IndexOf(Last);
  15368. if i<0 then
  15369. begin
  15370. {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
  15371. writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
  15372. //for i:=0 to List.Count-1 do writeln(' ',GetObjName(TObject(List[i])));
  15373. {$ENDIF}
  15374. if GenericEl is TPasProcedure then
  15375. i:=List.Count-1
  15376. else
  15377. RaiseNotYetImplemented(20190826150507,El);
  15378. end;
  15379. List.Insert(i+1,NewEl);
  15380. end;
  15381. var
  15382. NewName: String;
  15383. NewClass: TPTreeElement;
  15384. SrcModule: TPasModule;
  15385. SrcModuleScope: TPasModuleScope;
  15386. SrcResolver: TPasResolver;
  15387. NewParent: TPasElement;
  15388. TypeItem: TPRSpecializedTypeItem;
  15389. ProcItem: TPRSpecializedProcItem;
  15390. begin
  15391. Result:=nil;
  15392. if Pos('$G',GenericEl.Name)>0 then
  15393. RaiseNotYetImplemented(20190813003729,El);
  15394. SrcModule:=GenericEl.GetModule;
  15395. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  15396. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  15397. if SrcResolver<>Self then
  15398. RaiseInternalError(20190728121705);
  15399. GenScope:=TPasGenericScope(GenericEl.CustomData);
  15400. SpecializedItems:=GenScope.SpecializedItems;
  15401. TypeItem:=nil;
  15402. ProcItem:=nil;
  15403. if GenericEl is TPasGenericType then
  15404. begin
  15405. TypeItem:=TPRSpecializedTypeItem.Create;
  15406. Result:=TypeItem;
  15407. end
  15408. else if GenericEl is TPasProcedure then
  15409. begin
  15410. ProcItem:=TPRSpecializedProcItem.Create;
  15411. Result:=ProcItem;
  15412. end
  15413. else
  15414. RaiseNotYetImplemented(20190920140756,GenericEl);
  15415. Result.GenericEl:=GenericEl;
  15416. Result.FirstSpecialize:=El;
  15417. Result.Params:=ParamsResolved;
  15418. SpecializedItems.Add(Result);
  15419. NewName:=GenericEl.Name+'$G'+IntToStr(SpecializedItems.Count);
  15420. NewClass:=TPTreeElement(GenericEl.ClassType);
  15421. NewParent:=GenericEl.Parent;
  15422. NewEl:=TPasElement(NewClass.Create(NewName,NewParent));
  15423. if TypeItem<>nil then
  15424. TypeItem.SpecializedType:=TPasGenericType(NewEl) // this calls AddRef
  15425. else
  15426. ProcItem.SpecializedProc:=TPasProcedure(NewEl); // this calls AddRef
  15427. if NewParent is TPasDeclarations then
  15428. begin
  15429. InsertBehind(TPasDeclarations(NewParent).Declarations);
  15430. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasDeclarations.Children');{$ENDIF}
  15431. end
  15432. else if NewParent is TPasMembersType then
  15433. begin
  15434. InsertBehind(TPasMembersType(NewParent).Members);
  15435. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasMembersType.Members');{$ENDIF}
  15436. end
  15437. else
  15438. NewEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; // fix refcount
  15439. if GenScope.GenericStep>=psgsInterfaceParsed then
  15440. SpecializeGenericIntf(Result);
  15441. if GenScope.GenericStep>=psgsImplementationParsed then
  15442. SpecializeGenericImpl(Result);
  15443. end;
  15444. procedure TPasResolver.InitSpecializeScopes(El: TPasElement; out
  15445. State: TScopeStashState);
  15446. function PushParentScopes(CurEl: TPasElement): integer;
  15447. var
  15448. Keep: Integer;
  15449. Scope: TPasScope;
  15450. IntfSection: TInterfaceSection;
  15451. begin
  15452. {$IFDEF VerboseInitSpecializeScopes}
  15453. writeln(' PushParentScopes START ',GetObjName(CurEl));
  15454. {$ENDIF}
  15455. if CurEl=nil then
  15456. RaiseInternalError(20190728125025);
  15457. if CurEl is TPasModule then
  15458. begin
  15459. if not (CurEl.CustomData is TPasModuleScope) then
  15460. RaiseNotYetImplemented(20190728142609,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15461. Keep:=0;
  15462. if FScopeCount<=Keep then
  15463. RaiseInternalError(20190728124857);
  15464. if not (FScopes[Keep] is TPasDefaultScope) then
  15465. RaiseInternalError(20190728124858);
  15466. end
  15467. else
  15468. begin
  15469. if CurEl.Parent=nil then
  15470. RaiseInternalError(20190728130238,GetObjName(CurEl));
  15471. if CurEl.CustomData=nil then
  15472. exit(PushParentScopes(CurEl.Parent));
  15473. if not (CurEl.CustomData is TPasIdentifierScope) then
  15474. RaiseNotYetImplemented(20190728131934,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15475. Keep:=PushParentScopes(CurEl.Parent);
  15476. end;
  15477. inc(Keep);
  15478. Scope:=TPasScope(CurEl.CustomData);
  15479. {$IFDEF VerboseInitSpecializeScopes}
  15480. writeln(' PushParentScopes ',GetObjName(CurEl),' Scope=',GetObjName(Scope),' Keep=',Keep);
  15481. {$ENDIF}
  15482. if Scope.FreeOnPop then
  15483. RaiseInternalError(20190728131153,GetObjName(CurEl));
  15484. if (Keep<FScopeCount) and (FScopes[Keep]=Scope) then
  15485. // Scope is already on the scopestack
  15486. else
  15487. begin
  15488. if Keep<FScopeCount then
  15489. begin
  15490. // cannot use current scope stack -> stash
  15491. {$IFDEF VerboseInitSpecializeScopes}
  15492. writeln(' PushParentScopes StashScopes Keep=',Keep);
  15493. {$ENDIF}
  15494. StashScopes(Keep);
  15495. if Keep<>FScopeCount then
  15496. RaiseNotYetImplemented(20190813005130,El);
  15497. State.ScopeCount:=ScopeCount;
  15498. end;
  15499. if (CurEl.ClassType=TImplementationSection) then
  15500. begin
  15501. // unit implementation -> push interface scope
  15502. IntfSection:=CurEl.GetModule.InterfaceSection;
  15503. if IntfSection=nil then
  15504. RaiseNotYetImplemented(20190825112907,CurEl);
  15505. if not (IntfSection.CustomData is TPasSectionScope) then
  15506. RaiseNotYetImplemented(20190825112907,CurEl);
  15507. PushScope(TPasSectionScope(IntfSection.CustomData));
  15508. inc(Keep);
  15509. end;
  15510. PushScope(Scope);
  15511. end;
  15512. exit(Keep);
  15513. end;
  15514. var
  15515. Keep: Integer;
  15516. begin
  15517. {$IFDEF VerboseInitSpecializeScopes}
  15518. writeln('TPasResolver.InitSpecializeScopes START ',GetObjName(El));
  15519. {$ENDIF}
  15520. State.ScopeCount:=ScopeCount;
  15521. State.StashCount:=FStashScopeCount;
  15522. Keep:=PushParentScopes(El.Parent)+1;
  15523. if Keep<FScopeCount then
  15524. begin
  15525. // cannot use current scope stack -> stash
  15526. {$IFDEF VerboseInitSpecializeScopes}
  15527. writeln('TPasResolver.InitSpecializeScopes StashScopes Keep=',Keep);
  15528. {$ENDIF}
  15529. StashScopes(Keep);
  15530. if Keep<>FScopeCount then
  15531. RaiseNotYetImplemented(20190813005859,El);
  15532. end;
  15533. {$IFDEF VerboseInitSpecializeScopes}
  15534. WriteScopesShort('TPasResolver.InitSpecializeScopes END');
  15535. {$ENDIF}
  15536. end;
  15537. procedure TPasResolver.RestoreSpecializeScopes(const State: TScopeStashState);
  15538. begin
  15539. while ScopeCount>State.ScopeCount do
  15540. PopScope;
  15541. RestoreStashedScopes(State.StashCount);
  15542. end;
  15543. procedure TPasResolver.SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem
  15544. );
  15545. var
  15546. SpecEl, GenericEl: TPasElement;
  15547. C: TClass;
  15548. NewRecordType, GenRecordType: TPasRecordType;
  15549. NewClassType, GenClassType: TPasClassType;
  15550. NewArrayType, GenArrayType: TPasArrayType;
  15551. GenProcType, NewProcType: TPasProcedureType;
  15552. GenProc, NewProc: TPasProcedure;
  15553. OldScopeState: TScopeStashState;
  15554. begin
  15555. if SpecializedItem.Step<>prssNone then
  15556. exit;
  15557. SpecializedItem.Step:=prssInterfaceBuilding;
  15558. SpecEl:=SpecializedItem.SpecializedEl;
  15559. GenericEl:=SpecializedItem.GenericEl;
  15560. // change scope
  15561. InitSpecializeScopes(GenericEl,OldScopeState);
  15562. {$IFDEF VerbosePasResolver}
  15563. WriteScopesShort('TPasResolver.SpecializeGenericIntf Init SpecEl='+SpecEl.FullName+' GenericEl='+GenericEl.FullName);
  15564. {$ENDIF}
  15565. SpecializePasElementProperties(GenericEl,SpecEl);
  15566. C:=SpecEl.ClassType;
  15567. if C=TPasRecordType then
  15568. begin
  15569. NewRecordType:=TPasRecordType(SpecEl);
  15570. GenRecordType:=TPasRecordType(GenericEl);
  15571. SpecializeRecordType(GenRecordType,NewRecordType,TPRSpecializedTypeItem(SpecializedItem));
  15572. end
  15573. else if C=TPasClassType then
  15574. begin
  15575. NewClassType:=TPasClassType(SpecEl);
  15576. GenClassType:=TPasClassType(GenericEl);
  15577. SpecializeClassType(GenClassType,NewClassType,TPRSpecializedTypeItem(SpecializedItem));
  15578. end
  15579. else if C=TPasArrayType then
  15580. begin
  15581. GenArrayType:=TPasArrayType(GenericEl);
  15582. NewArrayType:=TPasArrayType(SpecEl);
  15583. SpecializeArrayType(GenArrayType,NewArrayType,TPRSpecializedTypeItem(SpecializedItem));
  15584. end
  15585. else if (C=TPasProcedureType)
  15586. or (C=TPasFunctionType) then
  15587. begin
  15588. GenProcType:=TPasProcedureType(GenericEl);
  15589. NewProcType:=TPasProcedureType(SpecEl);
  15590. SpecializeProcedureType(GenProcType,NewProcType,TPRSpecializedTypeItem(SpecializedItem));
  15591. end
  15592. else if C.InheritsFrom(TPasProcedure) then
  15593. begin
  15594. GenProc:=TPasProcedure(GenericEl);
  15595. NewProc:=TPasProcedure(SpecEl);
  15596. SpecializeProcedure(GenProc,NewProc,SpecializedItem);
  15597. end
  15598. else
  15599. RaiseNotYetImplemented(20190728134933,GenericEl);
  15600. {$IFDEF VerbosePasResolver}
  15601. WriteScopesShort('TPasResolver.SpecializeGenericIntf Finish: '+SpecEl.FullName);
  15602. {$ENDIF}
  15603. RestoreSpecializeScopes(OldScopeState);
  15604. {$IFDEF VerbosePasResolver}
  15605. WriteScopesShort('TPasResolver.SpecializeGenericIntf RestoreStashedScopes: '+SpecEl.FullName);
  15606. {$ENDIF}
  15607. end;
  15608. procedure TPasResolver.SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem
  15609. );
  15610. var
  15611. GenericEl: TPasElement;
  15612. GenScope: TPasGenericScope;
  15613. SpecializedTypeItem: TPRSpecializedTypeItem;
  15614. SpecializedProcItem: TPRSpecializedProcItem;
  15615. GenImplProc, GenIntfProc, SpecDeclProc: TPasProcedure;
  15616. GenDeclProcScope: TPasProcedureScope;
  15617. OldScopeState: TScopeStashState;
  15618. begin
  15619. // check specialized type step
  15620. if SpecializedItem.Step>prssInterfaceFinished then
  15621. exit;
  15622. GenericEl:=SpecializedItem.GenericEl;
  15623. if SpecializedItem.Step<prssInterfaceFinished then
  15624. if GenericEl is TPasType then
  15625. RaiseMsg(20190804120128,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  15626. [GetTypeDescription(TPasType(GenericEl))],SpecializedItem.FirstSpecialize)
  15627. else
  15628. RaiseMsg(20190920190727,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  15629. [GenericEl.Name],SpecializedItem.FirstSpecialize);
  15630. SpecializedItem.Step:=prssImplementationBuilding;
  15631. // check generic type is resolved completely
  15632. GenScope:=TPasGenericScope(GenericEl.CustomData);
  15633. if GenScope.GenericStep<psgsImplementationParsed then
  15634. RaiseNotYetImplemented(20190804174019,GenericEl,GetObjName(SpecializedItem.SpecializedEl));
  15635. if GenericEl is TPasMembersType then
  15636. begin
  15637. // specialize all method bodies
  15638. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem);
  15639. if SpecializedTypeItem.ImplProcs=nil then
  15640. SpecializedTypeItem.ImplProcs:=TFPList.Create;
  15641. SpecializeMembersImpl(TPasMembersType(GenericEl),
  15642. TPasMembersType(SpecializedTypeItem.SpecializedType),
  15643. SpecializedTypeItem);
  15644. end
  15645. else if GenericEl is TPasProcedure then
  15646. begin
  15647. // specialize proc implementation
  15648. GenIntfProc:=TPasProcedure(GenericEl);
  15649. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then
  15650. //
  15651. else
  15652. begin
  15653. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem);
  15654. GenDeclProcScope:=TPasProcedureScope(GenScope);
  15655. GenImplProc:=GenDeclProcScope.ImplProc;
  15656. if GenImplProc=nil then
  15657. RaiseNotYetImplemented(20190920211609,SpecializedProcItem.SpecializedProc);
  15658. if GenImplProc.Body=nil then
  15659. RaiseNotYetImplemented(20190920192731,GenImplProc); // GenScope.GenericStep is wrong
  15660. SpecDeclProc:=SpecializedProcItem.SpecializedProc;
  15661. InitSpecializeScopes(GenImplProc,OldScopeState);
  15662. SpecializeGenImplProc(GenIntfProc,SpecDeclProc,SpecializedProcItem);
  15663. RestoreSpecializeScopes(OldScopeState);
  15664. end;
  15665. end;
  15666. SpecializedItem.Step:=prssImplementationFinished;
  15667. end;
  15668. procedure TPasResolver.SpecializeMembers(GenMembersType,
  15669. SpecMembersType: TPasMembersType);
  15670. var
  15671. i: Integer;
  15672. GenEl, NewEl: TPasElement;
  15673. NewClass: TPTreeElement;
  15674. begin
  15675. for i:=0 to GenMembersType.Members.Count-1 do
  15676. begin
  15677. GenEl:=TPasElement(GenMembersType.Members[i]);
  15678. if GenEl.Parent<>GenMembersType then
  15679. RaiseNotYetImplemented(20190728145634,GenEl,GetObjName(GenEl.Parent));
  15680. NewClass:=TPTreeElement(GenEl.ClassType);
  15681. NewEl:=TPasElement(NewClass.Create(GenEl.Name,SpecMembersType));
  15682. SpecMembersType.Members.Add(NewEl);
  15683. SpecializeElement(GenEl,NewEl);
  15684. end;
  15685. end;
  15686. procedure TPasResolver.SpecializeMembersImpl(GenericType,
  15687. SpecType: TPasMembersType; SpecializedItem: TPRSpecializedTypeItem);
  15688. var
  15689. GenClassOrRec, SpecClassOrRec: TPasMembersType;
  15690. i: Integer;
  15691. GenMember, SpecMember, ImplParent: TPasElement;
  15692. GenIntfProc, GenImplProc, SpecIntfProc: TPasProcedure;
  15693. GenIntfProcScope: TPasProcedureScope;
  15694. OldScopeState: TScopeStashState;
  15695. begin
  15696. GenClassOrRec:=TPasMembersType(GenericType);
  15697. SpecClassOrRec:=TPasMembersType(SpecType);
  15698. {$IFDEF VerbosePasResolver}
  15699. writeln('TPasResolver.SpecializeMembersImpl RestoreStashedScopes ',GetObjPath(SpecClassOrRec),' ',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  15700. {$ENDIF}
  15701. // specialize member bodies
  15702. ImplParent:=nil;
  15703. OldScopeState:=default(TScopeStashState);
  15704. for i:=0 to GenClassOrRec.Members.Count-1 do
  15705. begin
  15706. GenMember:=TPasElement(GenClassOrRec.Members[i]);
  15707. SpecMember:=TPasElement(SpecClassOrRec.Members[i]);
  15708. if SpecMember.ClassType<>GenMember.ClassType then
  15709. RaiseNotYetImplemented(20190816002658,GenMember,GetObjName(SpecMember));
  15710. if SpecMember.Name<>GenMember.Name then
  15711. RaiseNotYetImplemented(20190804124220,GenMember,GetObjName(SpecMember));
  15712. if GenMember is TPasProcedure then
  15713. begin
  15714. GenIntfProc:=TPasProcedure(GenMember);
  15715. SpecIntfProc:=TPasProcedure(SpecMember);
  15716. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then continue;
  15717. GenIntfProcScope:=TPasProcedureScope(GenIntfProc.CustomData);
  15718. GenImplProc:=GenIntfProcScope.ImplProc;
  15719. if GenImplProc=nil then
  15720. RaiseNotYetImplemented(20190921221246,GenIntfProc);
  15721. if ImplParent=nil then
  15722. begin
  15723. // switch scope (e.g. unit implementation section)
  15724. ImplParent:=GenImplProc.Parent;
  15725. InitSpecializeScopes(GenImplProc,OldScopeState);
  15726. {$IFDEF VerbosePasResolver}
  15727. writeln('TPasResolver.SpecializeGenImplProc Specialize implprocs: SpecType=',GetObjName(SpecType),' ImplParent=',GetObjName(ImplParent),' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount,' TopScope=',GetObjName(TopScope));
  15728. {$ENDIF}
  15729. end
  15730. else if ImplParent<>GenImplProc.Parent then
  15731. RaiseNotYetImplemented(20190804130322,GenImplProc,GetObjName(ImplParent));
  15732. SpecializeGenImplProc(GenIntfProc,SpecIntfProc,SpecializedItem);
  15733. end
  15734. else if GenMember is TPasMembersType then
  15735. begin
  15736. // nested record/class type
  15737. SpecializeMembersImpl(TPasMembersType(GenMember),TPasMembersType(SpecMember),
  15738. SpecializedItem);
  15739. end;
  15740. end;
  15741. if ImplParent<>nil then
  15742. begin
  15743. // restore scope
  15744. RestoreSpecializeScopes(OldScopeState);
  15745. end;
  15746. end;
  15747. procedure TPasResolver.SpecializeGenImplProc(GenDeclProc,
  15748. SpecDeclProc: TPasProcedure; SpecializedItem: TPRSpecializedItem);
  15749. var
  15750. GenDeclProcScope, GenImplProcScope, SpecDeclProcScope,
  15751. SpecImplProcScope: TPasProcedureScope;
  15752. GenImplProc, SpecImplProc: TPasProcedure;
  15753. NewClass: TPTreeElement;
  15754. SpecClassOrRec, GenClassOrRec: TPasMembersType;
  15755. SpecClassOrRecScope: TPasClassOrRecordScope;
  15756. NewImplProcName, OldClassname: String;
  15757. p, LastDotP: Integer;
  15758. SpecializedProcItem: TPRSpecializedProcItem;
  15759. SpecializedTypeItem: TPRSpecializedTypeItem;
  15760. Templates: TFPList;
  15761. begin
  15762. SpecializedProcItem:=nil;
  15763. SpecializedTypeItem:=nil;
  15764. if SpecializedItem is TPRSpecializedProcItem then
  15765. // impl proc of a specialized forward proc
  15766. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem)
  15767. else if SpecializedItem is TPRSpecializedTypeItem then
  15768. // method of a specialized class/record
  15769. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem)
  15770. else
  15771. RaiseNotYetImplemented(20190922145050,SpecDeclProc);
  15772. GenDeclProcScope:=TPasProcedureScope(GenDeclProc.CustomData);
  15773. GenImplProc:=GenDeclProcScope.ImplProc;
  15774. if GenImplProc=nil then
  15775. RaiseNotYetImplemented(20190804122134,GenDeclProc);
  15776. if GenImplProc.Body=nil then
  15777. RaiseNotYetImplemented(20190921220216,GenImplProc);
  15778. GenImplProcScope:=TPasProcedureScope(GenImplProc.CustomData);
  15779. SpecDeclProcScope:=TPasProcedureScope(SpecDeclProc.CustomData);
  15780. if SpecDeclProc.Parent is TPasMembersType then
  15781. begin
  15782. SpecClassOrRec:=SpecDeclProc.Parent as TPasMembersType;
  15783. SpecClassOrRecScope:=SpecClassOrRec.CustomData as TPasClassOrRecordScope;
  15784. end
  15785. else
  15786. begin
  15787. SpecClassOrRec:=nil;
  15788. SpecClassOrRecScope:=nil;
  15789. end;
  15790. {$IFDEF VerbosePasResolver}
  15791. writeln('TPasResolver.SpecializeGenImplProc Specialize GenImplProc: ',GetObjName(GenImplProc));
  15792. {$ENDIF}
  15793. // create impl proc name
  15794. if SpecializedTypeItem<>nil then
  15795. begin
  15796. // method of a specialized class/record
  15797. if SpecClassOrRecScope=nil then
  15798. RaiseNotYetImplemented(20190921221839,SpecDeclProc);
  15799. NewImplProcName:=GenImplProc.Name;
  15800. p:=length(NewImplProcName);
  15801. while (p>0) and (NewImplProcName[p]<>'.') do dec(p);
  15802. if p=0 then
  15803. RaiseNotYetImplemented(20190921221730,GenImplProc);
  15804. // has classname -> replace generic classname with specialized classname
  15805. LastDotP:=p;
  15806. while (p>1) and (NewImplProcName[p-1]<>'.') do dec(p);
  15807. OldClassname:=copy(NewImplProcName,p,LastDotP-p);
  15808. GenClassOrRec:=GenDeclProc.Parent as TPasMembersType;
  15809. if not SameText(OldClassname,GenClassOrRec.Name) then
  15810. RaiseNotYetImplemented(20190814141833,GenImplProc);
  15811. NewImplProcName:=LeftStr(NewImplProcName,p-1)+SpecClassOrRec.Name+copy(NewImplProcName,LastDotP,length(NewImplProcName));
  15812. end
  15813. else
  15814. begin
  15815. // use classname of GenImplProc and name of SpecDeclProc
  15816. OldClassname:=GenImplProc.Name;
  15817. p:=length(OldClassname);
  15818. while (p>0) and (OldClassname[p]<>'.') do dec(p);
  15819. if p>0 then
  15820. NewImplProcName:=LeftStr(OldClassname,p)+SpecDeclProc.Name
  15821. else
  15822. NewImplProcName:=SpecDeclProc.Name;
  15823. end;
  15824. // create impl proc
  15825. NewClass:=TPTreeElement(GenImplProc.ClassType);
  15826. SpecImplProc:=TPasProcedure(NewClass.Create(NewImplProcName,GenImplProc.Parent));
  15827. SpecDeclProcScope.ImplProc:=SpecImplProc;
  15828. if SpecializedProcItem<>nil then
  15829. SpecializedProcItem.ImplProc:=SpecImplProc
  15830. else
  15831. SpecializedTypeItem.ImplProcs.Add(SpecImplProc);
  15832. // create impl proc scope
  15833. SpecImplProcScope:=TPasProcedureScope(CreateScope(SpecImplProc,FScopeClass_Proc));
  15834. SpecImplProcScope.Flags:=[ppsfIsSpecialized];
  15835. SpecImplProcScope.DeclarationProc:=SpecDeclProc;
  15836. SpecImplProcScope.ModeSwitches:=GenImplProcScope.Modeswitches;
  15837. SpecImplProcScope.BoolSwitches:=GenImplProcScope.BoolSwitches;
  15838. SpecImplProcScope.VisibilityContext:=SpecClassOrRec;
  15839. SpecImplProcScope.ClassRecScope:=SpecClassOrRecScope;
  15840. if GenDeclProcScope.SelfArg<>nil then
  15841. RaiseNotYetImplemented(20190922154603,GenImplProc);
  15842. if SpecializedProcItem<>nil then
  15843. begin
  15844. Templates:=GetProcTemplateTypes(GenDeclProc);
  15845. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecImplProcScope,
  15846. false);
  15847. end;
  15848. // specialize props
  15849. SpecializePasElementProperties(GenImplProc,SpecImplProc);
  15850. AddProcedure(SpecImplProc,nil);
  15851. SpecializeProcedure(GenImplProc,SpecImplProc,SpecializedItem);
  15852. end;
  15853. procedure TPasResolver.SpecializeElement(GenEl, SpecEl: TPasElement);
  15854. var
  15855. C: TClass;
  15856. begin
  15857. // first copy sourcefilename and linenumber needed by error messages
  15858. SpecializePasElementProperties(GenEl,SpecEl);
  15859. C:=GenEl.ClassType;
  15860. // expressions
  15861. if C=TPrimitiveExpr then
  15862. SpecializePrimitiveExpr(TPrimitiveExpr(GenEl),TPrimitiveExpr(SpecEl))
  15863. else if C=TUnaryExpr then
  15864. SpecializeUnaryExpr(TUnaryExpr(GenEl),TUnaryExpr(SpecEl))
  15865. else if C=TBinaryExpr then
  15866. SpecializeBinaryExpr(TBinaryExpr(GenEl),TBinaryExpr(SpecEl))
  15867. else if C=TBoolConstExpr then
  15868. SpecializeBoolConstExpr(TBoolConstExpr(GenEl),TBoolConstExpr(SpecEl))
  15869. else if C=TNilExpr then
  15870. SpecializeExpr(TNilExpr(GenEl),TNilExpr(SpecEl))
  15871. else if C=TInheritedExpr then
  15872. SpecializeExpr(TInheritedExpr(GenEl),TInheritedExpr(SpecEl))
  15873. else if C=TParamsExpr then
  15874. SpecializeParamsExpr(TParamsExpr(GenEl),TParamsExpr(SpecEl))
  15875. else if C=TRecordValues then
  15876. SpecializeRecordValues(TRecordValues(GenEl),TRecordValues(SpecEl))
  15877. else if C=TArrayValues then
  15878. SpecializeArrayValues(TArrayValues(GenEl),TArrayValues(SpecEl))
  15879. else if C=TInlineSpecializeExpr then
  15880. SpecializeInlineSpecializeExpr(TInlineSpecializeExpr(GenEl),TInlineSpecializeExpr(SpecEl))
  15881. else if C=TProcedureExpr then
  15882. SpecializeProcedureExpr(TProcedureExpr(GenEl),TProcedureExpr(SpecEl))
  15883. // TPasType
  15884. else if (C=TPasAliasType)
  15885. or (C=TPasTypeAliasType)
  15886. or (C=TPasClassOfType) then
  15887. begin
  15888. AddType(TPasAliasType(SpecEl));
  15889. SpecializeAliasType(TPasAliasType(GenEl),TPasAliasType(SpecEl));
  15890. end
  15891. else if C=TPasPointerType then
  15892. begin
  15893. AddType(TPasPointerType(SpecEl));
  15894. SpecializePointerType(TPasPointerType(GenEl),TPasPointerType(SpecEl));
  15895. end
  15896. else if C=TPasRangeType then
  15897. begin
  15898. AddType(TPasRangeType(SpecEl));
  15899. SpecializeRangeType(TPasRangeType(GenEl),TPasRangeType(SpecEl));
  15900. end
  15901. else if C=TPasArrayType then
  15902. begin
  15903. if GetTypeParameterCount(TPasArrayType(GenEl))>0 then
  15904. RaiseNotYetImplemented(20190815201219,GenEl);
  15905. AddArrayType(TPasArrayType(SpecEl),nil);
  15906. SpecializeArrayType(TPasArrayType(GenEl),TPasArrayType(SpecEl),nil);
  15907. end
  15908. else if C=TPasEnumValue then
  15909. begin
  15910. AddEnumValue(TPasEnumValue(SpecEl));
  15911. SpecializeEnumValue(TPasEnumValue(GenEl),TPasEnumValue(SpecEl));
  15912. end
  15913. else if C=TPasEnumType then
  15914. begin
  15915. AddEnumType(TPasEnumType(SpecEl));
  15916. SpecializeEnumType(TPasEnumType(GenEl),TPasEnumType(SpecEl));
  15917. end
  15918. else if C=TPasSetType then
  15919. SpecializeSetType(TPasSetType(GenEl),TPasSetType(SpecEl))
  15920. else if C=TPasVariant then
  15921. SpecializeVariant(TPasVariant(GenEl),TPasVariant(SpecEl))
  15922. else if C=TPasRecordType then
  15923. begin
  15924. if GetTypeParameterCount(TPasRecordType(GenEl))>0 then
  15925. RaiseNotYetImplemented(20190815201201,GenEl);
  15926. AddRecordType(TPasRecordType(SpecEl),nil);
  15927. SpecializeRecordType(TPasRecordType(GenEl),TPasRecordType(SpecEl),nil);
  15928. end
  15929. else if C=TPasClassType then
  15930. begin
  15931. if GetTypeParameterCount(TPasClassType(GenEl))>0 then
  15932. RaiseNotYetImplemented(20190816214947,GenEl);
  15933. AddClassType(TPasClassType(SpecEl),nil);
  15934. SpecializeClassType(TPasClassType(GenEl),TPasClassType(SpecEl),nil);
  15935. end
  15936. else if C=TPasStringType then
  15937. begin
  15938. AddType(TPasStringType(SpecEl));
  15939. SpecializeStringType(TPasStringType(GenEl),TPasStringType(SpecEl));
  15940. end
  15941. else if C=TPasSpecializeType then
  15942. begin
  15943. AddType(TPasSpecializeType(SpecEl));
  15944. SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
  15945. end
  15946. else if C=TPasGenericTemplateType then
  15947. SpecializeGenericTemplateType(TPasGenericTemplateType(GenEl),TPasGenericTemplateType(SpecEl))
  15948. // empty statement
  15949. else if C=TPasImplCommand then
  15950. // TPasImplBlock
  15951. else if C=TPasImplBeginBlock then
  15952. SpecializeImplBlock(TPasImplBeginBlock(GenEl),TPasImplBeginBlock(SpecEl))
  15953. else if C=TPasImplAsmStatement then
  15954. SpecializeImplAsmStatement(TPasImplAsmStatement(GenEl),TPasImplAsmStatement(SpecEl))
  15955. else if C=TPasImplRepeatUntil then
  15956. SpecializeImplRepeatUntil(TPasImplRepeatUntil(GenEl),TPasImplRepeatUntil(SpecEl))
  15957. else if C=TPasImplIfElse then
  15958. SpecializeImplIfElse(TPasImplIfElse(GenEl),TPasImplIfElse(SpecEl))
  15959. else if C=TPasImplWhileDo then
  15960. SpecializeImplWhileDo(TPasImplWhileDo(GenEl),TPasImplWhileDo(SpecEl))
  15961. else if C=TPasImplWithDo then
  15962. SpecializeImplWithDo(TPasImplWithDo(GenEl),TPasImplWithDo(SpecEl))
  15963. else if C=TPasImplCaseOf then
  15964. SpecializeImplCaseOf(TPasImplCaseOf(GenEl),TPasImplCaseOf(SpecEl))
  15965. else if C=TPasImplCaseStatement then
  15966. SpecializeImplCaseStatement(TPasImplCaseStatement(GenEl),TPasImplCaseStatement(SpecEl))
  15967. else if C=TPasImplCaseElse then
  15968. SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
  15969. else if C=TPasImplAssign then
  15970. SpecializeImplAssign(TPasImplAssign(GenEl),TPasImplAssign(SpecEl))
  15971. else if C=TPasImplSimple then
  15972. SpecializeImplSimple(TPasImplSimple(GenEl),TPasImplSimple(SpecEl))
  15973. else if C=TPasImplForLoop then
  15974. SpecializeImplForLoop(TPasImplForLoop(GenEl),TPasImplForLoop(SpecEl))
  15975. else if C=TPasImplTry then
  15976. SpecializeImplTry(TPasImplTry(GenEl),TPasImplTry(SpecEl))
  15977. else if (C=TPasImplTryFinally)
  15978. or (C=TPasImplTryExcept)
  15979. or (C=TPasImplTryExceptElse) then
  15980. SpecializeImplBlock(TPasImplTryHandler(GenEl),TPasImplTryHandler(SpecEl))
  15981. else if C=TPasImplExceptOn then
  15982. begin
  15983. AddExceptOn(TPasImplExceptOn(SpecEl));
  15984. SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl));
  15985. end
  15986. else if C=TPasImplRaise then
  15987. SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
  15988. // declaration
  15989. else if C=TPasResString then
  15990. begin
  15991. AddResourceString(TPasResString(SpecEl));
  15992. SpecializeResString(TPasResString(GenEl),TPasResString(SpecEl));
  15993. end
  15994. else if C=TPasVariable then
  15995. begin
  15996. AddVariable(TPasVariable(SpecEl));
  15997. SpecializeVariable(TPasVariable(GenEl),TPasVariable(SpecEl),true);
  15998. end
  15999. else if C=TPasConst then
  16000. begin
  16001. AddVariable(TPasConst(SpecEl));
  16002. SpecializeConst(TPasConst(GenEl),TPasConst(SpecEl));
  16003. end
  16004. else if C=TPasProperty then
  16005. begin
  16006. AddProperty(TPasProperty(SpecEl));
  16007. SpecializeProperty(TPasProperty(GenEl),TPasProperty(SpecEl));
  16008. end
  16009. else if C=TPasAttributes then
  16010. SpecializeAttributes(TPasAttributes(GenEl),TPasAttributes(SpecEl))
  16011. else if C=TPasMethodResolution then
  16012. SpecializeMethodResolution(TPasMethodResolution(GenEl),TPasMethodResolution(SpecEl))
  16013. // procedure
  16014. else if C=TPasArgument then
  16015. begin
  16016. AddArgument(TPasArgument(SpecEl));
  16017. SpecializeArgument(TPasArgument(GenEl),TPasArgument(SpecEl));
  16018. end
  16019. else if C=TProcedureBody then
  16020. begin
  16021. AddProcedureBody(TProcedureBody(SpecEl));
  16022. SpecializeProcedureBody(TProcedureBody(GenEl),TProcedureBody(SpecEl));
  16023. end
  16024. else if C=TPasOperator then
  16025. begin
  16026. AddProcedure(TPasOperator(SpecEl),nil);
  16027. SpecializeOperator(TPasOperator(GenEl),TPasOperator(SpecEl));
  16028. end
  16029. else if C.InheritsFrom(TPasProcedure) then
  16030. begin
  16031. AddProcedure(TPasProcedure(SpecEl),nil);
  16032. SpecializeProcedure(TPasProcedure(GenEl),TPasProcedure(SpecEl),nil);
  16033. end
  16034. else if C.InheritsFrom(TPasProcedureType) then
  16035. begin
  16036. AddProcedureType(TPasProcedureType(SpecEl),nil);
  16037. SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
  16038. end
  16039. else
  16040. RaiseNotYetImplemented(20190728151215,GenEl);
  16041. end;
  16042. procedure TPasResolver.SpecializePasElementProperties(GenEl, SpecEl: TPasElement
  16043. );
  16044. begin
  16045. SpecEl.SourceFilename:=GenEl.SourceFilename;
  16046. SpecEl.SourceLinenumber:=GenEl.SourceLinenumber;;
  16047. SpecEl.SourceEndLinenumber:=GenEl.SourceEndLinenumber;
  16048. SpecEl.Visibility:=GenEl.Visibility;
  16049. SpecEl.Hints:=GenEl.Hints;
  16050. SpecEl.HintMessage:=GenEl.HintMessage;
  16051. SpecEl.DocComment:=GenEl.DocComment;
  16052. end;
  16053. procedure TPasResolver.SpecializeVariable(GenEl, SpecEl: TPasVariable;
  16054. Finish: boolean);
  16055. begin
  16056. SpecializeElType(GenEl,SpecEl,GenEl.VarType,SpecEl.VarType);
  16057. SpecEl.VarModifiers:=GenEl.VarModifiers;
  16058. if GenEl.LibraryName<>nil then
  16059. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryName,SpecEl.LibraryName);
  16060. if GenEl.ExportName<>nil then
  16061. SpecializeElExpr(GenEl,SpecEl,GenEl.ExportName,SpecEl.ExportName);
  16062. SpecEl.Modifiers:=GenEl.Modifiers;
  16063. if GenEl.AbsoluteExpr<>nil then
  16064. SpecializeElExpr(GenEl,SpecEl,GenEl.AbsoluteExpr,SpecEl.AbsoluteExpr);
  16065. if GenEl.Expr<>nil then
  16066. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16067. if Finish then
  16068. FinishVariable(SpecEl);
  16069. end;
  16070. procedure TPasResolver.SpecializeConst(GenEl, SpecEl: TPasConst);
  16071. begin
  16072. SpecEl.IsConst:=GenEl.IsConst;
  16073. SpecializeVariable(GenEl,SpecEl,true);
  16074. end;
  16075. procedure TPasResolver.SpecializeProperty(GenEl, SpecEl: TPasProperty);
  16076. begin
  16077. SpecializeVariable(GenEl,SpecEl,false);
  16078. SpecializeElExpr(GenEl,SpecEl,GenEl.IndexExpr,SpecEl.IndexExpr);
  16079. SpecializeElExpr(GenEl,SpecEl,GenEl.ReadAccessor,SpecEl.ReadAccessor);
  16080. SpecializeElExpr(GenEl,SpecEl,GenEl.WriteAccessor,SpecEl.WriteAccessor);
  16081. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16082. SpecializeExprArray(GenEl,SpecEl,GenEl.Implements,SpecEl.Implements);
  16083. SpecializeElExpr(GenEl,SpecEl,GenEl.StoredAccessor,SpecEl.StoredAccessor);
  16084. SpecializeElExpr(GenEl,SpecEl,GenEl.DefaultExpr,SpecEl.DefaultExpr);
  16085. SpecEl.DispIDReadOnly:=GenEl.DispIDReadOnly;
  16086. SpecEl.IsDefault:=GenEl.IsDefault;
  16087. SpecEl.IsNodefault:=GenEl.IsNodefault;
  16088. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16089. {$IFDEF CheckPasTreeRefCount},'TPasProperty.Args'{$ENDIF});
  16090. FinishProperty(SpecEl);
  16091. end;
  16092. procedure TPasResolver.SpecializeElType(GenEl, SpecEl: TPasElement;
  16093. GenElType: TPasType; var SpecElType: TPasType);
  16094. var
  16095. Ref: TPasElement;
  16096. NewClass: TPTreeElement;
  16097. begin
  16098. if GenElType=nil then exit;
  16099. if (GenElType.Parent<>GenEl)
  16100. or (GenElType.ClassType=TPasGenericTemplateType) then
  16101. begin
  16102. // reference
  16103. if GenElType.Name='' then
  16104. RaiseNotYetImplemented(20190813213555,GenEl,GetObjName(GenElType)+' Parent='+GetObjName(GenElType.Parent));
  16105. Ref:=FindElement(GenElType.Name);
  16106. if not (Ref is TPasType) then
  16107. RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
  16108. GenElType:=TPasType(Ref);
  16109. if SpecElType<>nil then
  16110. RaiseNotYetImplemented(20190812021617,GenEl);
  16111. SpecElType:=GenElType;
  16112. SpecElType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  16113. exit;
  16114. end;
  16115. // e.g. anonymous type
  16116. if SpecElType<>nil then
  16117. RaiseNotYetImplemented(20190808222744,SpecEl,GetObjName(SpecElType));
  16118. NewClass:=TPTreeElement(GenElType.ClassType);
  16119. SpecElType:=TPasType(NewClass.Create(GenElType.Name,SpecEl));
  16120. SpecializeElement(GenElType,SpecElType);
  16121. end;
  16122. procedure TPasResolver.SpecializeElExpr(GenEl, SpecEl: TPasElement;
  16123. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  16124. var
  16125. NewClass: TPTreeElement;
  16126. begin
  16127. if GenElExpr=nil then exit;
  16128. if SpecElExpr<>nil then
  16129. RaiseNotYetImplemented(20190803220248,SpecEl,GetObjName(SpecElExpr));
  16130. if GenElExpr.Parent<>GenEl then
  16131. RaiseNotYetImplemented(20190809160834,GenEl);
  16132. // normal expression
  16133. NewClass:=TPTreeElement(GenElExpr.ClassType);
  16134. SpecElExpr:=TPasExpr(NewClass.Create(GenElExpr.Name,SpecEl));
  16135. SpecializeElement(GenElExpr,SpecElExpr);
  16136. end;
  16137. procedure TPasResolver.SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  16138. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  16139. var
  16140. NewClass: TPTreeElement;
  16141. begin
  16142. if GenImplEl=nil then exit;
  16143. if GenImplEl.Parent<>GenEl then
  16144. RaiseNotYetImplemented(20190808222638,GenEl,GetObjName(GenImplEl.Parent));
  16145. NewClass:=TPTreeElement(GenImplEl.ClassType);
  16146. SpecImplEl:=TPasImplElement(NewClass.Create(GenImplEl.Name,SpecEl));
  16147. SpecializeElement(GenImplEl,SpecImplEl);
  16148. end;
  16149. procedure TPasResolver.SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  16150. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  16151. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16152. var
  16153. i: Integer;
  16154. begin
  16155. if GenImplAlias=nil then exit;
  16156. i:=GenEl.Elements.IndexOf(GenImplAlias);
  16157. if i<0 then
  16158. RaiseNotYetImplemented(20190808225239,GenEl);
  16159. SpecImplAlias:=TObject(SpecEl.Elements[i]) as TPasImplElement;
  16160. if SpecImplAlias.ClassType<>GenImplAlias.ClassType then
  16161. RaiseNotYetImplemented(20190808231616,GenImplAlias,GetObjName(SpecImplAlias));
  16162. SpecImplAlias.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16163. end;
  16164. procedure TPasResolver.SpecializeElList(GenEl, SpecEl: TPasElement;
  16165. GenList, SpecList: TFPList; AllowReferences: boolean
  16166. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16167. var
  16168. i: Integer;
  16169. GenListItem, SpecListItem, Ref: TPasElement;
  16170. NewClass: TPTreeElement;
  16171. begin
  16172. for i:=0 to GenList.Count-1 do
  16173. begin
  16174. GenListItem:=TPasElement(GenList[i]);
  16175. if GenListItem.Parent<>GenEl then
  16176. begin
  16177. if not AllowReferences then
  16178. RaiseNotYetImplemented(20190808212421,GenEl,IntToStr(i));
  16179. if not (GenListItem is TPasType) then
  16180. RaiseNotYetImplemented(20190812025715,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16181. // reference
  16182. Ref:=FindElement(GenListItem.Name);
  16183. if not (Ref is TPasType) then
  16184. RaiseNotYetImplemented(20190812025715,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem)+' Ref='+GetObjName(Ref));
  16185. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16186. SpecList.Add(Ref);
  16187. continue;
  16188. end;
  16189. if GenListItem.ClassType=TPasGenericTemplateType then
  16190. RaiseNotYetImplemented(20190812233309,GenEl);
  16191. NewClass:=TPTreeElement(GenListItem.ClassType);
  16192. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16193. SpecList.Add(SpecListItem);
  16194. SpecializeElement(GenListItem,SpecListItem);
  16195. end;
  16196. end;
  16197. procedure TPasResolver.SpecializeElArray(GenEl, SpecEl: TPasElement;
  16198. GenList: TPasElementArray; var SpecList: TPasElementArray;
  16199. AllowReferences: boolean{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16200. var
  16201. l, i: Integer;
  16202. GenListItem, Ref, SpecListItem: TPasElement;
  16203. NewClass: TPTreeElement;
  16204. begin
  16205. if length(SpecList)>0 then
  16206. RaiseNotYetImplemented(20190914102814,GenEl,GetObjName(SpecEl));
  16207. l:=length(GenList);
  16208. SetLength(SpecList,l);
  16209. for i:=0 to l-1 do
  16210. SpecList[i]:=nil;
  16211. for i:=0 to l-1 do
  16212. begin
  16213. GenListItem:=GenList[i];
  16214. if GenListItem.Parent<>GenEl then
  16215. begin
  16216. if not AllowReferences then
  16217. RaiseNotYetImplemented(20190914102952,GenEl,IntToStr(i));
  16218. if not (GenListItem is TPasType) then
  16219. RaiseNotYetImplemented(20190914102957,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16220. // reference
  16221. Ref:=FindElement(GenListItem.Name);
  16222. if not (Ref is TPasType) then
  16223. RaiseNotYetImplemented(20190914103009,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem)+' Ref='+GetObjName(Ref));
  16224. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16225. SpecList[i]:=Ref;
  16226. continue;
  16227. end;
  16228. if GenListItem.ClassType=TPasGenericTemplateType then
  16229. RaiseNotYetImplemented(20190914103040,GenEl);
  16230. NewClass:=TPTreeElement(GenListItem.ClassType);
  16231. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16232. SpecList[i]:=SpecListItem;
  16233. SpecializeElement(GenListItem,SpecListItem);
  16234. end;
  16235. end;
  16236. procedure TPasResolver.SpecializeProcedure(GenEl, SpecEl: TPasProcedure;
  16237. SpecializedItem: TPRSpecializedItem);
  16238. var
  16239. GenProcType: TPasProcedureType;
  16240. NewClass: TPTreeElement;
  16241. SpecProcScope, GenProcScope: TPasProcedureScope;
  16242. i, j: Integer;
  16243. GenPart, SpecPart: TProcedureNamePart;
  16244. GenTempl, SpecTempl: TPasGenericTemplateType;
  16245. Templates: TFPList;
  16246. GenBody: TProcedureBody;
  16247. begin
  16248. GenProcScope:=GenEl.CustomData as TPasProcedureScope;
  16249. SpecProcScope:=SpecEl.CustomData as TPasProcedureScope;
  16250. if SpecProcScope<>nil then
  16251. begin
  16252. if TopScope<>SpecProcScope then
  16253. RaiseNotYetImplemented(20190920194151,SpecEl);
  16254. end
  16255. else if SpecializedItem<>nil then
  16256. begin
  16257. // specialized generic/parametrized procedure
  16258. SpecProcScope:=TPasProcedureScope(PushScope(SpecEl,ScopeClass_Procedure));
  16259. SpecProcScope.SpecializedFromItem:=SpecializedItem;
  16260. if GenProcScope.DeclarationProc<>nil then
  16261. RaiseNotYetImplemented(20190920203700,SpecEl);
  16262. if GenProcScope.OverriddenProc<>nil then
  16263. RaiseNotYetImplemented(20190920203536,SpecEl);
  16264. SpecProcScope.ClassRecScope:=GenProcScope.ClassRecScope;
  16265. if GenProcScope.SelfArg<>nil then
  16266. RaiseNotYetImplemented(20190920203626,SpecEl);
  16267. // SpecProcScope.Flags
  16268. SpecProcScope.ModeSwitches:=GenProcScope.ModeSwitches;
  16269. SpecProcScope.BoolSwitches:=GenProcScope.BoolSwitches;
  16270. Templates:=GetProcTemplateTypes(GenEl);
  16271. if (Templates=nil) or (Templates.Count=0) then
  16272. RaiseNotYetImplemented(20190920183140,SpecEl);
  16273. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecProcScope,true);
  16274. end
  16275. else
  16276. RaiseNotYetImplemented(20190922153918,SpecEl);
  16277. Include(SpecProcScope.Flags,ppsfIsSpecialized);
  16278. if GenEl.PublicName<>nil then
  16279. SpecializeElExpr(GenEl,SpecEl,GenEl.PublicName,SpecEl.PublicName);
  16280. if GenEl.LibrarySymbolName<>nil then
  16281. SpecializeElExpr(GenEl,SpecEl,GenEl.LibrarySymbolName,SpecEl.LibrarySymbolName);
  16282. if GenEl.LibraryExpr<>nil then
  16283. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryExpr,SpecEl.LibraryExpr);
  16284. if GenEl.DispIDExpr<>nil then
  16285. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16286. if GenEl.MessageExpr<>nil then
  16287. SpecializeElExpr(GenEl,SpecEl,GenEl.MessageExpr,SpecEl.MessageExpr);
  16288. SpecEl.MessageName:=GenEl.MessageName;
  16289. SpecEl.MessageType:=GenEl.MessageType;
  16290. SpecEl.AliasName:=GenEl.AliasName;
  16291. SpecEl.Modifiers:=GenEl.Modifiers;
  16292. if GenEl.NameParts<>nil then
  16293. begin
  16294. if SpecEl.NameParts<>nil then
  16295. RaiseNotYetImplemented(20190818125620,SpecEl);
  16296. SpecEl.NameParts:=TFPList.Create;
  16297. for i:=0 to GenEl.NameParts.Count-1 do
  16298. begin
  16299. GenPart:=TProcedureNamePart(GenEl.NameParts[i]);
  16300. SpecPart:=TProcedureNamePart.Create;
  16301. SpecEl.NameParts.Add(SpecPart);
  16302. SpecPart.Name:=GenPart.Name;
  16303. if GenPart.Templates<>nil then
  16304. begin
  16305. if (SpecializedItem<>nil) and (i=GenEl.NameParts.Count-1) then
  16306. begin
  16307. // the templates have been specialized to parameters
  16308. continue;
  16309. end;
  16310. SpecPart.Templates:=TFPList.Create;
  16311. for j:=0 to GenPart.Templates.Count-1 do
  16312. begin
  16313. GenTempl:=TPasGenericTemplateType(GenPart.Templates[j]);
  16314. if GenTempl.Parent<>GenEl then
  16315. RaiseNotYetImplemented(20190818130001,GenEl,IntToStr(i)+','+IntToStr(j)+':'+GenTempl.Name+' GenParent='+GetObjName(GenTempl.Parent)+' GenEl='+GetObjName(GenEl));
  16316. NewClass:=TPTreeElement(GenTempl.ClassType);
  16317. SpecTempl:=TPasGenericTemplateType(NewClass.Create(GenTempl.Name,SpecEl));
  16318. SpecPart.Templates.Add(SpecTempl);
  16319. SpecializeElement(GenTempl,SpecTempl);
  16320. end;
  16321. end;
  16322. end;
  16323. end;
  16324. if GenEl.ProcType<>nil then
  16325. begin
  16326. GenProcType:=GenEl.ProcType;
  16327. if GenProcType.Parent<>GenEl then
  16328. RaiseNotYetImplemented(20190803212426,GenEl,GetObjName(GenProcType.Parent));
  16329. NewClass:=TPTreeElement(GenProcType.ClassType);
  16330. SpecEl.ProcType:=TPasProcedureType(NewClass.Create(GenProcType.Name,SpecEl));
  16331. SpecializeElement(GenProcType,SpecEl.ProcType);
  16332. end;
  16333. SpecProcScope.GenericStep:=psgsInterfaceParsed;
  16334. if GenEl.Body<>nil then
  16335. begin
  16336. // implementation proc
  16337. if SpecializedItem<>nil then
  16338. SpecializedItem.Step:=prssImplementationBuilding;
  16339. GenBody:=GenEl.Body;
  16340. if GenBody.Parent<>GenEl then
  16341. RaiseNotYetImplemented(20190804183308,GenEl,GetObjName(GenBody.Parent));
  16342. if SpecEl.Body<>nil then
  16343. RaiseNotYetImplemented(20190920211853,SpecEl);
  16344. NewClass:=TPTreeElement(GenBody.ClassType);
  16345. SpecEl.Body:=TProcedureBody(NewClass.Create(GenBody.Name,SpecEl));
  16346. SpecializeElement(GenBody,SpecEl.Body);
  16347. FinishProcedure(SpecEl);
  16348. end
  16349. else if SpecializedItem=nil then
  16350. // declaration proc, parent is specialized
  16351. FinishProcedure(SpecEl)
  16352. else
  16353. begin
  16354. // specialized generic procedure, body is not yet parsed
  16355. SpecializedItem.Step:=prssInterfaceFinished;
  16356. if TopScope<>SpecProcScope then
  16357. RaiseNotYetImplemented(20190920190400,SpecEl);
  16358. PopScope;
  16359. end;
  16360. end;
  16361. procedure TPasResolver.SpecializeOperator(GenEl, SpecEl: TPasOperator);
  16362. begin
  16363. SpecEl.OperatorType:=GenEl.OperatorType;
  16364. SpecEl.TokenBased:=GenEl.TokenBased;
  16365. SpecializeProcedure(GenEl,SpecEl,nil);
  16366. end;
  16367. procedure TPasResolver.SpecializeProcedureType(GenEl,
  16368. SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  16369. var
  16370. GenResultEl, NewResultEl: TPasResultElement;
  16371. NewClass: TPTreeElement;
  16372. i: Integer;
  16373. GenScope: TPasGenericScope;
  16374. begin
  16375. if GenEl.GenericTemplateTypes<>nil then
  16376. begin
  16377. GenScope:=TPasGenericScope(PushScope(SpecEl,TPasProcTypeScope));
  16378. if SpecializedItem<>nil then
  16379. begin
  16380. // specialized procedure type
  16381. GenScope.SpecializedFromItem:=SpecializedItem;
  16382. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  16383. SpecializedItem,GenScope,true);
  16384. end
  16385. else
  16386. begin
  16387. // generic procedure type inside a generic type
  16388. RaiseNotYetImplemented(20190813194550,GenEl);
  16389. end;
  16390. end;
  16391. // Args
  16392. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16393. {$IFDEF CheckPasTreeRefCount},'TPasProcedureType.Args'{$ENDIF});
  16394. for i:=0 to SpecEl.Args.Count-1 do
  16395. FinishArgument(TPasArgument(SpecEl.Args[i]));
  16396. // properties
  16397. SpecEl.CallingConvention:=GenEl.CallingConvention;
  16398. SpecEl.Modifiers:=GenEl.Modifiers;
  16399. // function result
  16400. if SpecEl is TPasFunctionType then
  16401. begin
  16402. GenResultEl:=TPasFunctionType(GenEl).ResultEl;
  16403. if GenResultEl.Parent<>GenEl then
  16404. RaiseNotYetImplemented(20190803212935,GenEl,GetObjName(GenResultEl.Parent));
  16405. NewClass:=TPTreeElement(GenResultEl.ClassType);
  16406. NewResultEl:=TPasResultElement(NewClass.Create(GenResultEl.Name,SpecEl));
  16407. TPasFunctionType(SpecEl).ResultEl:=NewResultEl;
  16408. AddFunctionResult(NewResultEl);
  16409. SpecializeElType(GenResultEl,NewResultEl,GenResultEl.ResultType,NewResultEl.ResultType);
  16410. end;
  16411. FinishProcedureType(SpecEl);
  16412. if SpecializedItem<>nil then
  16413. SpecializedItem.Step:=prssImplementationFinished;
  16414. end;
  16415. procedure TPasResolver.SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  16416. var
  16417. GenBody, NewBody: TPasImplBlock;
  16418. NewClass: TPTreeElement;
  16419. begin
  16420. SpecializeDeclarations(GenEl,SpecEl);
  16421. FinishTypeSection(SpecEl);
  16422. if GenEl.Body<>nil then
  16423. begin
  16424. GenBody:=GenEl.Body;
  16425. if GenBody.Parent<>GenEl then
  16426. RaiseNotYetImplemented(20190804184934,GenBody);
  16427. NewClass:=TPTreeElement(GenBody.ClassType);
  16428. NewBody:=TPasImplBlock(NewClass.Create(GenBody.Name,SpecEl));
  16429. SpecEl.Body:=NewBody;
  16430. SpecializeElement(GenBody,NewBody);
  16431. end;
  16432. end;
  16433. procedure TPasResolver.SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  16434. var
  16435. i: Integer;
  16436. GenDecl, NewDecl: TPasElement;
  16437. NewClass: TPTreeElement;
  16438. begin
  16439. for i:=0 to GenEl.Declarations.Count-1 do
  16440. begin
  16441. GenDecl:=TPasElement(GenEl.Declarations[i]);
  16442. if GenDecl.Parent<>GenEl then
  16443. RaiseNotYetImplemented(20190806091336,GenEl,GetObjName(GenDecl));
  16444. NewClass:=TPTreeElement(GenDecl.ClassType);
  16445. NewDecl:=TPasElement(NewClass.Create(GenDecl.Name,SpecEl));
  16446. SpecEl.Declarations.Add(NewDecl);
  16447. if NewClass=TPasAttributes then
  16448. SpecEl.Attributes.Add(NewDecl)
  16449. else if (NewClass=TPasClassType)
  16450. or (NewClass=TPasRecordType) then
  16451. SpecEl.Classes.Add(NewDecl)
  16452. else if NewClass=TPasConst then
  16453. SpecEl.Consts.Add(NewDecl)
  16454. else if NewClass=TPasExportSymbol then
  16455. SpecEl.ExportSymbols.Add(NewDecl)
  16456. else if NewClass.InheritsFrom(TPasProcedure) then
  16457. SpecEl.Functions.Add(NewDecl)
  16458. else if NewClass=TPasProperty then
  16459. SpecEl.Properties.Add(NewDecl)
  16460. else if NewClass=TPasResString then
  16461. SpecEl.ResStrings.Add(NewDecl)
  16462. else if NewClass.InheritsFrom(TPasType) then
  16463. SpecEl.Types.Add(NewDecl)
  16464. else if NewClass=TPasVariable then
  16465. SpecEl.Variables.Add(NewDecl)
  16466. else
  16467. RaiseNotYetImplemented(20190804184718,GenDecl);
  16468. SpecializeElement(GenDecl,NewDecl);
  16469. end;
  16470. end;
  16471. procedure TPasResolver.SpecializeSpecializeType(GenEl,
  16472. SpecEl: TPasSpecializeType);
  16473. var
  16474. GenDestType: TPasType;
  16475. Ref: TPasElement;
  16476. begin
  16477. // search DestType<ParamCount>
  16478. GenDestType:=GenEl.DestType;
  16479. if GenDestType=nil then
  16480. RaiseNotYetImplemented(20190812022211,GenEl);
  16481. if GenDestType.Parent=GenEl then
  16482. RaiseNotYetImplemented(20190812022251,GenEl);
  16483. Ref:=FindElementFor(GenDestType.Name,GenEl.Parent,GenEl.Params.Count);
  16484. if not (Ref is TPasGenericType) then
  16485. RaiseNotYetImplemented(20190812022359,GenEl,GetObjName(Ref));
  16486. SpecEl.DestType:=TPasGenericType(Ref);
  16487. SpecEl.DestType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  16488. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16489. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true
  16490. {$IFDEF CheckPasTreeRefCount},'TPasSpecializeType.Params'{$ENDIF});
  16491. FinishSpecializeType(SpecEl);
  16492. {$IFDEF VerbosePasResolver}
  16493. //writeln('TPasResolver.SpecializeSpecializeType ',GetObjName(SpecEl.DestType),' ',GetObjName(SpecEl.CustomData));
  16494. {$ENDIF}
  16495. end;
  16496. procedure TPasResolver.SpecializeGenericTemplateType(GenEl,
  16497. SpecEl: TPasGenericTemplateType);
  16498. var
  16499. GenConstraints, SpecConstraints: TPasElementArray;
  16500. i: Integer;
  16501. ConEl: TPasElement;
  16502. begin
  16503. GenConstraints:=GenEl.Constraints;
  16504. if length(SpecEl.Constraints)>0 then
  16505. RaiseNotYetImplemented(20190914070209,GenEl);
  16506. SetLength(SpecEl.Constraints,length(GenConstraints));
  16507. SpecConstraints:=SpecEl.Constraints;
  16508. for i:=0 to length(SpecConstraints)-1 do
  16509. SpecConstraints[i]:=nil;
  16510. for i:=0 to length(GenConstraints)-1 do
  16511. begin
  16512. ConEl:=GenConstraints[i];
  16513. if ConEl is TPasExpr then
  16514. SpecializeElExpr(GenEl,SpecEl,TPasExpr(ConEl),TPasExpr(SpecConstraints[i]))
  16515. else if ConEl is TPasType then
  16516. SpecializeElType(GenEl,SpecEl,TPasType(ConEl),TPasType(SpecConstraints[i]))
  16517. else
  16518. RaiseNotYetImplemented(20190914070522,GenEl,IntToStr(i)+' '+GetObjName(ConEl));
  16519. end;
  16520. end;
  16521. procedure TPasResolver.SpecializeArgument(GenEl, SpecEl: TPasArgument);
  16522. begin
  16523. SpecEl.Access:=GenEl.Access;
  16524. SpecializeElType(GenEl,SpecEl,GenEl.ArgType,SpecEl.ArgType);
  16525. if GenEl.ValueExpr<>nil then
  16526. SpecializeElExpr(GenEl,SpecEl,GenEl.ValueExpr,SpecEl.ValueExpr);
  16527. // FinishArgument is called when all arguments are ready
  16528. end;
  16529. procedure TPasResolver.SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  16530. var
  16531. i: Integer;
  16532. GenImpl, NewImpl: TPasImplElement;
  16533. NewClass: TPTreeElement;
  16534. begin
  16535. for i:=0 to GenEl.Elements.Count-1 do
  16536. begin
  16537. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  16538. if GenImpl.Parent<>GenEl then
  16539. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  16540. NewClass:=TPTreeElement(GenImpl.ClassType);
  16541. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  16542. SpecEl.Elements.Add(NewImpl);
  16543. SpecializeElement(GenImpl,NewImpl);
  16544. end;
  16545. end;
  16546. procedure TPasResolver.SpecializeImplAsmStatement(GenEl,
  16547. SpecEl: TPasImplAsmStatement);
  16548. begin
  16549. SpecializeImplBlock(GenEl,SpecEl);
  16550. SpecEl.Tokens.Assign(GenEl.Tokens);
  16551. end;
  16552. procedure TPasResolver.SpecializeImplRepeatUntil(GenEl,
  16553. SpecEl: TPasImplRepeatUntil);
  16554. begin
  16555. SpecializeImplBlock(GenEl,SpecEl);
  16556. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  16557. end;
  16558. procedure TPasResolver.SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  16559. begin
  16560. // do not call SpecializeImplBlock(GenEl,SpecEl);
  16561. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  16562. SpecializeElImplEl(GenEl,SpecEl,GenEl.IfBranch,SpecEl.IfBranch);
  16563. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,SpecEl.ElseBranch);
  16564. end;
  16565. procedure TPasResolver.SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  16566. begin
  16567. // do not call SpecializeImplBlock(GenEl,SpecEl);
  16568. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  16569. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  16570. end;
  16571. procedure TPasResolver.SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  16572. var
  16573. i: Integer;
  16574. GenExpr, SpecExpr: TPasExpr;
  16575. NewClass: TPTreeElement;
  16576. begin
  16577. for i:=0 to GenEl.Expressions.Count-1 do
  16578. begin
  16579. GenExpr:=TPasExpr(GenEl.Expressions[i]);
  16580. if GenExpr.Parent<>GenEl then
  16581. RaiseNotYetImplemented(20190808224343,GenEl,IntToStr(i));
  16582. NewClass:=TPTreeElement(GenExpr.ClassType);
  16583. SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
  16584. SpecEl.Expressions.Add(SpecExpr);
  16585. BeginScope(stWithExpr,SpecExpr);
  16586. SpecializeElement(GenExpr,SpecExpr);
  16587. end;
  16588. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  16589. FinishWithDo(SpecEl);
  16590. end;
  16591. procedure TPasResolver.SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  16592. begin
  16593. SpecializeElExpr(GenEl,SpecEl,GenEl.CaseExpr,SpecEl.CaseExpr);
  16594. SpecializeImplBlock(GenEl,SpecEl); // Elements
  16595. if GenEl.ElseBranch<>nil then
  16596. SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,TPasImplElement(SpecEl.ElseBranch)
  16597. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseOf.ElseBranch'{$ENDIF});
  16598. end;
  16599. procedure TPasResolver.SpecializeImplCaseStatement(GenEl,
  16600. SpecEl: TPasImplCaseStatement);
  16601. begin
  16602. SpecializeElList(GenEl,SpecEl,GenEl.Expressions,SpecEl.Expressions,false
  16603. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseStatement.CaseExpr'{$ENDIF});
  16604. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  16605. end;
  16606. procedure TPasResolver.SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  16607. begin
  16608. if GenEl.Elements.Count>0 then
  16609. RaiseNotYetImplemented(20190808142935,GenEl);
  16610. SpecEl.Kind:=GenEl.Kind;
  16611. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  16612. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  16613. end;
  16614. procedure TPasResolver.SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  16615. begin
  16616. if GenEl.Elements.Count>0 then
  16617. RaiseNotYetImplemented(20190808142935,GenEl);
  16618. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16619. end;
  16620. procedure TPasResolver.SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  16621. var
  16622. i: Integer;
  16623. GenImpl, NewImpl: TPasImplElement;
  16624. NewClass: TPTreeElement;
  16625. begin
  16626. if GenEl.Variable<>nil then
  16627. RaiseNotYetImplemented(20190808142627,GenEl);
  16628. SpecializeElExpr(GenEl,SpecEl,GenEl.VariableName,SpecEl.VariableName);
  16629. SpecEl.LoopType:=GenEl.LoopType;
  16630. SpecializeElExpr(GenEl,SpecEl,GenEl.StartExpr,SpecEl.StartExpr);
  16631. SpecializeElExpr(GenEl,SpecEl,GenEl.EndExpr,SpecEl.EndExpr);
  16632. FinishForLoopHeader(SpecEl);
  16633. // SpecEl.Body is set via AddElement
  16634. for i:=0 to GenEl.Elements.Count-1 do
  16635. begin
  16636. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  16637. if GenImpl.Parent<>GenEl then
  16638. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  16639. NewClass:=TPTreeElement(GenImpl.ClassType);
  16640. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  16641. SpecEl.AddElement(NewImpl);
  16642. SpecializeElement(GenImpl,NewImpl);
  16643. end;
  16644. end;
  16645. procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  16646. begin
  16647. SpecializeImplBlock(GenEl,SpecEl); // clone elements
  16648. if GenEl.FinallyExcept<>nil then
  16649. SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
  16650. TPasImplElement(SpecEl.FinallyExcept));
  16651. if GenEl.ElseBranch<>nil then
  16652. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
  16653. TPasImplElement(SpecEl.ElseBranch));
  16654. end;
  16655. procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  16656. var
  16657. GenVar: TPasVariable;
  16658. NewClass: TPTreeElement;
  16659. begin
  16660. GenVar:=GenEl.VarEl;
  16661. if GenVar<>nil then
  16662. begin
  16663. if GenVar.Parent<>GenEl then
  16664. RaiseNotYetImplemented(20190808232327,GenEl);
  16665. NewClass:=TPTreeElement(GenVar.ClassType);
  16666. SpecEl.VarEl:=TPasVariable(NewClass.Create(GenVar.Name,SpecEl));
  16667. SpecializeElement(GenVar,SpecEl.VarEl);
  16668. if GenVar.VarType<>GenEl.TypeEl then
  16669. RaiseNotYetImplemented(20190808232601,GenEl);
  16670. SpecEl.TypeEl:=SpecEl.VarEl.VarType;
  16671. SpecEl.TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
  16672. end
  16673. else
  16674. SpecializeElType(GenEl,SpecEl,GenEl.TypeEl,SpecEl.TypeEl);
  16675. FinishExceptOnExpr;
  16676. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  16677. FinishExceptOnStatement;
  16678. end;
  16679. procedure TPasResolver.SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  16680. begin
  16681. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptObject,SpecEl.ExceptObject);
  16682. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptAddr,SpecEl.ExceptAddr);
  16683. end;
  16684. procedure TPasResolver.SpecializeExpr(GenEl, SpecEl: TPasExpr);
  16685. begin
  16686. SpecEl.Kind:=GenEl.Kind;
  16687. SpecEl.OpCode:=GenEl.OpCode;
  16688. SpecializeElExpr(GenEl,SpecEl,GenEl.format1,SpecEl.format1);
  16689. SpecializeElExpr(GenEl,SpecEl,GenEl.format2,SpecEl.format2);
  16690. end;
  16691. procedure TPasResolver.SpecializeExprArray(GenEl, SpecEl: TPasElement;
  16692. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  16693. var
  16694. i: Integer;
  16695. begin
  16696. if length(SpecArray)>0 then
  16697. RaiseNotYetImplemented(20190808205855,GenEl);
  16698. SetLength(SpecArray,length(GenArray));
  16699. for i:=0 to length(SpecArray)-1 do
  16700. SpecArray[i]:=nil;
  16701. for i:=0 to length(GenArray)-1 do
  16702. SpecializeElExpr(GenEl,SpecEl,GenArray[i],SpecArray[i]);
  16703. end;
  16704. procedure TPasResolver.SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  16705. begin
  16706. SpecializeExpr(GenEl,SpecEl);
  16707. SpecEl.Value:=GenEl.Value;
  16708. end;
  16709. procedure TPasResolver.SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  16710. begin
  16711. SpecializeExpr(GenEl,SpecEl);
  16712. SpecializeElExpr(GenEl,SpecEl,GenEl.Operand,SpecEl.Operand);
  16713. end;
  16714. procedure TPasResolver.SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  16715. begin
  16716. SpecializeExpr(GenEl,SpecEl);
  16717. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  16718. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  16719. end;
  16720. procedure TPasResolver.SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  16721. begin
  16722. SpecializeExpr(GenEl,SpecEl);
  16723. SpecEl.Value:=GenEl.Value;
  16724. end;
  16725. procedure TPasResolver.SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  16726. begin
  16727. SpecializeExpr(GenEl,SpecEl);
  16728. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  16729. SpecializeExprArray(GenEl,SpecEl,GenEl.Params,SpecEl.Params);
  16730. end;
  16731. procedure TPasResolver.SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  16732. var
  16733. GenField: TRecordValuesItem;
  16734. i: Integer;
  16735. SpecFieldP: PRecordValuesItem;
  16736. begin
  16737. SpecializeExpr(GenEl,SpecEl);
  16738. // fields
  16739. SetLength(SpecEl.Fields,length(GenEl.Fields));
  16740. for i:=0 to length(SpecEl.Fields)-1 do
  16741. with SpecEl.Fields[i] do
  16742. begin
  16743. NameExp:=nil;
  16744. ValueExp:=nil;
  16745. end;
  16746. for i:=0 to length(GenEl.Fields)-1 do
  16747. begin
  16748. GenField:=GenEl.Fields[i];
  16749. if GenField.NameExp.Parent<>GenEl then
  16750. RaiseNotYetImplemented(20190808205128,GenEl);
  16751. if GenField.ValueExp.Parent<>GenEl then
  16752. RaiseNotYetImplemented(20190808205138,GenEl);
  16753. SpecFieldP:[email protected][i];
  16754. SpecializeElExpr(GenEl,SpecEl,GenField.NameExp,TPasExpr(SpecFieldP^.NameExp));
  16755. SpecializeElExpr(GenEl,SpecEl,GenField.ValueExp,SpecFieldP^.ValueExp);
  16756. end;
  16757. end;
  16758. procedure TPasResolver.SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  16759. begin
  16760. SpecializeExpr(GenEl,SpecEl);
  16761. SpecializeExprArray(GenEl,SpecEl,GenEl.Values,SpecEl.Values);
  16762. end;
  16763. procedure TPasResolver.SpecializeInlineSpecializeExpr(GenEl,
  16764. SpecEl: TInlineSpecializeExpr);
  16765. begin
  16766. SpecializeExpr(GenEl,SpecEl);
  16767. SpecializeElExpr(GenEl,SpecEl,GenEl.NameExpr,SpecEl.NameExpr);
  16768. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,
  16769. true{$IFDEF CheckPasTreeRefCount},'TInlineSpecializeExpr.Params'{$ENDIF});
  16770. end;
  16771. procedure TPasResolver.SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  16772. begin
  16773. SpecializeExpr(GenEl,SpecEl);
  16774. if GenEl.Proc=nil then
  16775. RaiseNotYetImplemented(20190808221018,GenEl);
  16776. RaiseNotYetImplemented(20190808221040,GenEl);
  16777. end;
  16778. procedure TPasResolver.SpecializeResString(GenEl, SpecEl: TPasResString);
  16779. begin
  16780. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16781. FinishResourcestring(SpecEl);
  16782. end;
  16783. procedure TPasResolver.SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  16784. begin
  16785. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  16786. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16787. // not needed by specialize: FinishTypeAlias();
  16788. FinishTypeDef(SpecEl);
  16789. end;
  16790. procedure TPasResolver.SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  16791. begin
  16792. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  16793. FinishPointerType(SpecEl);
  16794. end;
  16795. procedure TPasResolver.SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  16796. begin
  16797. SpecializeElExpr(GenEl,SpecEl,GenEl.RangeExpr,TPasExpr(SpecEl.RangeExpr));
  16798. FinishRangeType(SpecEl);
  16799. end;
  16800. procedure TPasResolver.SpecializeArrayType(GenEl, SpecEl: TPasArrayType;
  16801. SpecializedItem: TPRSpecializedTypeItem);
  16802. var
  16803. GenScope: TPasGenericScope;
  16804. begin
  16805. SpecEl.IndexRange:=GenEl.IndexRange;
  16806. SpecEl.PackMode:=GenEl.PackMode;
  16807. if GenEl.GenericTemplateTypes<>nil then
  16808. begin
  16809. GenScope:=TPasGenericScope(PushScope(SpecEl,TPasArrayScope));
  16810. if SpecializedItem<>nil then
  16811. begin
  16812. // specialized generic array
  16813. GenScope.SpecializedFromItem:=SpecializedItem;
  16814. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  16815. SpecializedItem,GenScope,true);
  16816. end
  16817. else
  16818. begin
  16819. // generic arraytype inside a generic type
  16820. RaiseNotYetImplemented(20190812225218,GenEl);
  16821. end;
  16822. end;
  16823. SpecializeExprArray(GenEl,SpecEl,GenEl.Ranges,SpecEl.Ranges);
  16824. SpecializeElType(GenEl,SpecEl,GenEl.ElType,SpecEl.ElType);
  16825. FinishArrayType(SpecEl);
  16826. if SpecializedItem<>nil then
  16827. SpecializedItem.Step:=prssImplementationFinished;
  16828. end;
  16829. procedure TPasResolver.SpecializeRecordType(GenEl, SpecEl: TPasRecordType;
  16830. SpecializedItem: TPRSpecializedTypeItem);
  16831. var
  16832. GenScope: TPasGenericScope;
  16833. begin
  16834. SpecEl.PackMode:=GenEl.PackMode;
  16835. if SpecializedItem<>nil then
  16836. begin
  16837. // specialized generic record
  16838. if SpecEl.CustomData<>nil then
  16839. RaiseNotYetImplemented(20190921204740,SpecEl);
  16840. GenScope:=TPasGenericScope(PushScope(SpecEl,TPasRecordScope));
  16841. GenScope.VisibilityContext:=SpecEl;
  16842. GenScope.SpecializedFromItem:=SpecializedItem;
  16843. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  16844. SpecializedItem,GenScope,true);
  16845. end
  16846. else if GenEl.GenericTemplateTypes.Count>0 then
  16847. begin
  16848. // generic recordtype inside a generic type
  16849. if SpecEl.CustomData=nil then
  16850. RaiseNotYetImplemented(20190815201634,SpecEl);
  16851. GenScope:=TPasGenericScope(SpecEl.CustomData);
  16852. RaiseNotYetImplemented(20190815194327,GenEl);
  16853. end;
  16854. // specialize sub elements
  16855. SpecializeMembers(GenEl,SpecEl);
  16856. FinishRecordType(SpecEl);
  16857. if SpecializedItem<>nil then
  16858. SpecializedItem.Step:=prssInterfaceFinished;
  16859. end;
  16860. procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType;
  16861. SpecializedItem: TPRSpecializedTypeItem);
  16862. var
  16863. HeaderScope: TPasGenericParamsScope;
  16864. TemplType: TPasGenericTemplateType;
  16865. GenericTemplateTypes: TFPList;
  16866. GenScope: TPasClassScope;
  16867. begin
  16868. GenericTemplateTypes:=GenEl.GenericTemplateTypes;
  16869. SpecEl.ObjKind:=GenEl.ObjKind;
  16870. SpecEl.PackMode:=GenEl.PackMode;
  16871. if GenEl.HelperForType<>nil then
  16872. RaiseNotYetImplemented(20190730182758,GenEl,'');
  16873. if GenEl.IsForward then
  16874. RaiseNotYetImplemented(20190730182858,GenEl);
  16875. SpecEl.IsExternal:=GenEl.IsExternal;
  16876. SpecEl.IsShortDefinition:=GenEl.IsShortDefinition;
  16877. if GenEl.GUIDExpr<>nil then
  16878. SpecializeElExpr(GenEl,SpecEl,GenEl.GUIDExpr,SpecEl.GUIDExpr);
  16879. SpecEl.Modifiers.Assign(GenEl.Modifiers);
  16880. SpecEl.ExternalNameSpace:=GenEl.ExternalNameSpace;
  16881. SpecEl.ExternalName:=GenEl.ExternalName;
  16882. SpecEl.InterfaceType:=GenEl.InterfaceType;
  16883. // ancestor+interfaces
  16884. if SpecializedItem<>nil then
  16885. begin
  16886. // ancestor can be specialized types. For example: = class(TAncestor<T>)
  16887. // -> create a scope with the specialized parameters
  16888. HeaderScope:=TPasGenericParamsScope.Create;
  16889. SpecializedItem.HeaderScope:=HeaderScope;
  16890. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
  16891. HeaderScope.Element:=TemplType;
  16892. PushScope(HeaderScope);
  16893. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  16894. SpecializedItem,HeaderScope,true);
  16895. end
  16896. else
  16897. HeaderScope:=nil;
  16898. SpecializeElType(GenEl,SpecEl,
  16899. GenEl.AncestorType,SpecEl.AncestorType);
  16900. SpecializeElList(GenEl,SpecEl,
  16901. GenEl.Interfaces,SpecEl.Interfaces,true
  16902. {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF});
  16903. if HeaderScope<>nil then
  16904. begin
  16905. if TopScope<>HeaderScope then
  16906. RaiseNotYetImplemented(20190813003056,GenEl);
  16907. PopScope;
  16908. SpecializedItem.HeaderScope:=nil;
  16909. HeaderScope.Free;
  16910. end;
  16911. FinishAncestors(SpecEl);
  16912. // Note: class scope is created by FinishAncestors
  16913. GenScope:=NoNil(SpecEl.CustomData) as TPasClassScope;
  16914. if GenScope.SpecializedFromItem<>nil then
  16915. RaiseNotYetImplemented(20190816215413,SpecEl);
  16916. if SpecializedItem<>nil then
  16917. begin
  16918. GenScope.SpecializedFromItem:=SpecializedItem;
  16919. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  16920. SpecializedItem,GenScope,false);
  16921. end;
  16922. // specialize sub elements
  16923. SpecializeMembers(GenEl,SpecEl);
  16924. if SpecializedItem<>nil then
  16925. SpecializedItem.Step:=prssInterfaceFinished;
  16926. FinishClassType(SpecEl);
  16927. end;
  16928. procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  16929. begin
  16930. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  16931. end;
  16932. procedure TPasResolver.SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  16933. begin
  16934. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  16935. {$IFDEF CheckPasTreeRefCount},'TPasEnumType.Values'{$ENDIF});
  16936. FinishEnumType(SpecEl);
  16937. end;
  16938. procedure TPasResolver.SpecializeSetType(GenEl, SpecEl: TPasSetType);
  16939. begin
  16940. SpecEl.IsPacked:=GenEl.IsPacked;
  16941. SpecializeElType(GenEl,SpecEl,GenEl.EnumType,SpecEl.EnumType);
  16942. FinishSetType(SpecEl);
  16943. end;
  16944. procedure TPasResolver.SpecializeVariant(GenEl, SpecEl: TPasVariant);
  16945. begin
  16946. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  16947. {$IFDEF CheckPasTreeRefCount},'TPasVariant.Values'{$ENDIF});
  16948. RaiseNotYetImplemented(20190808214218,GenEl)
  16949. //ToDo: Members: TPasRecordType;
  16950. end;
  16951. procedure TPasResolver.SpecializeStringType(GenEl, SpecEl: TPasStringType);
  16952. begin
  16953. SpecEl.LengthExpr:=GenEl.LengthExpr;
  16954. FinishTypeDef(SpecEl);
  16955. end;
  16956. procedure TPasResolver.SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  16957. begin
  16958. SpecializeExprArray(GenEl,SpecEl,GenEl.Calls,SpecEl.Calls);
  16959. FinishAttributes(SpecEl);
  16960. end;
  16961. procedure TPasResolver.SpecializeMethodResolution(GenEl,
  16962. SpecEl: TPasMethodResolution);
  16963. begin
  16964. SpecEl.ProcClass:=GenEl.ProcClass;
  16965. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceName,SpecEl.InterfaceName);
  16966. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceProc,SpecEl.InterfaceProc);
  16967. SpecializeElExpr(GenEl,SpecEl,GenEl.ImplementationProc,SpecEl.ImplementationProc);
  16968. FinishMethodResolution(SpecEl);
  16969. end;
  16970. function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
  16971. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  16972. var Handled: boolean): integer;
  16973. // called when LHS or RHS BaseType is btCustom
  16974. // if RaiseOnIncompatible=true you can raise an useful error.
  16975. begin
  16976. Result:=cIncompatible;
  16977. if LHS.BaseType=btNone then ;
  16978. if RHS.BaseType=btNone then ;
  16979. if ErrorEl=nil then ;
  16980. if RaiseOnIncompatible then ;
  16981. if Handled then ;
  16982. end;
  16983. function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
  16984. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  16985. ): integer;
  16986. begin
  16987. Result:=cIncompatible;
  16988. if LHS.BaseType=RHS.BaseType then;
  16989. if ErrorEl=nil then;
  16990. if RaiseOnIncompatible then ;
  16991. end;
  16992. function TPasResolver.BI_Length_OnGetCallCompatibility(
  16993. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  16994. // check params of built in proc 'length'
  16995. var
  16996. Params: TParamsExpr;
  16997. Param: TPasExpr;
  16998. ParamResolved: TPasResolverResult;
  16999. Ranges: TPasExprArray;
  17000. begin
  17001. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17002. exit(cIncompatible);
  17003. Params:=TParamsExpr(Expr);
  17004. // first param: string or dynamic array or type/const of static array
  17005. Param:=Params.Params[0];
  17006. ComputeElement(Param,ParamResolved,[]);
  17007. Result:=cIncompatible;
  17008. if ParamResolved.BaseType in btAllStringAndChars then
  17009. begin
  17010. if rrfReadable in ParamResolved.Flags then
  17011. Result:=cExact;
  17012. end
  17013. else if ParamResolved.BaseType=btContext then
  17014. begin
  17015. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17016. begin
  17017. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17018. if length(Ranges)=0 then
  17019. begin
  17020. if rrfReadable in ParamResolved.Flags then
  17021. Result:=cExact;
  17022. end
  17023. else
  17024. // static array
  17025. Result:=cExact;
  17026. end;
  17027. end;
  17028. if Result=cIncompatible then
  17029. exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
  17030. 'string or dynamic array',RaiseOnError));
  17031. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17032. end;
  17033. procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17034. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17035. begin
  17036. if Params=nil then ;
  17037. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  17038. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
  17039. end;
  17040. procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  17041. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17042. var
  17043. Param, Expr: TPasExpr;
  17044. ParamResolved: TPasResolverResult;
  17045. Value: TResEvalValue;
  17046. Ranges: TPasExprArray;
  17047. IdentEl: TPasElement;
  17048. begin
  17049. Evaluated:=nil;
  17050. // first param: string or dynamic array or type/const of static array
  17051. Param:=Params.Params[0];
  17052. ComputeElement(Param,ParamResolved,[]);
  17053. if ParamResolved.BaseType in btAllStringAndChars then
  17054. begin
  17055. if rrfReadable in ParamResolved.Flags then
  17056. begin
  17057. Value:=Eval(Param,Flags);
  17058. if Value=nil then exit;
  17059. case Value.Kind of
  17060. {$ifdef FPC_HAS_CPSTRING}
  17061. revkString:
  17062. Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
  17063. {$endif}
  17064. revkUnicodeString:
  17065. Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
  17066. end;
  17067. ReleaseEvalValue(Value);
  17068. end
  17069. end
  17070. else if ParamResolved.BaseType=btContext then
  17071. begin
  17072. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17073. begin
  17074. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17075. if length(Ranges)=0 then
  17076. begin
  17077. // open or dynamic array
  17078. IdentEl:=ParamResolved.IdentEl;
  17079. if (IdentEl is TPasVariable)
  17080. and (TPasVariable(IdentEl).Expr is TPasExpr) then
  17081. begin
  17082. Expr:=TPasVariable(IdentEl).Expr;
  17083. if Expr is TArrayValues then
  17084. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values))
  17085. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  17086. Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params));
  17087. end;
  17088. end
  17089. else
  17090. begin
  17091. // static array
  17092. Evaluated:=TResEvalInt.CreateValue(GetRangeLength(Ranges[0]));
  17093. end;
  17094. end;
  17095. end;
  17096. if Proc=nil then ;
  17097. end;
  17098. function TPasResolver.BI_SetLength_OnGetCallCompatibility(
  17099. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17100. // check params of built in proc 'setlength'
  17101. var
  17102. Params: TParamsExpr;
  17103. Param: TPasExpr;
  17104. ParamResolved, DimResolved: TPasResolverResult;
  17105. ArgNo: Integer;
  17106. DynArr: TPasArrayType;
  17107. ElType: TPasType;
  17108. begin
  17109. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17110. exit(cIncompatible);
  17111. Params:=TParamsExpr(Expr);
  17112. // first param: string or array variable
  17113. Param:=Params.Params[0];
  17114. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17115. Result:=cIncompatible;
  17116. DynArr:=nil;
  17117. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17118. begin
  17119. if ParamResolved.BaseType in btAllStrings then
  17120. Result:=cExact
  17121. else if ParamResolved.BaseType=btContext then
  17122. begin
  17123. if IsDynArray(ParamResolved.LoTypeEl) then
  17124. begin
  17125. Result:=cExact;
  17126. DynArr:=NoNil(ParamResolved.LoTypeEl) as TPasArrayType;
  17127. end;
  17128. end;
  17129. end;
  17130. if Result=cIncompatible then
  17131. exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
  17132. 'string or dynamic array variable',RaiseOnError));
  17133. // second param: new length
  17134. ArgNo:=2;
  17135. repeat
  17136. Param:=Params.Params[ArgNo-1];
  17137. ComputeElement(Param,DimResolved,[]);
  17138. Result:=cIncompatible;
  17139. if (rrfReadable in DimResolved.Flags)
  17140. and (DimResolved.BaseType in btAllInteger) then
  17141. Result:=cExact;
  17142. if Result=cIncompatible then
  17143. exit(CheckRaiseTypeArgNo(20170329160338,ArgNo,Param,DimResolved,
  17144. 'integer',RaiseOnError));
  17145. if (DynArr=nil) or (ArgNo=length(Params.Params)) then break;
  17146. ElType:=ResolveAliasType(DynArr.ElType);
  17147. if not IsDynArray(ElType) then break;
  17148. DynArr:=NoNil(ElType) as TPasArrayType;
  17149. inc(ArgNo);
  17150. until false;
  17151. Result:=CheckBuiltInMaxParamCount(Proc,Params,ArgNo,RaiseOnError);
  17152. end;
  17153. procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
  17154. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17155. var
  17156. P: TPasExprArray;
  17157. begin
  17158. if Proc=nil then ;
  17159. P:=Params.Params;
  17160. if P=nil then ;
  17161. FinishCallArgAccess(P[0],rraVarParam);
  17162. FinishCallArgAccess(P[1],rraRead);
  17163. end;
  17164. function TPasResolver.BI_InExclude_OnGetCallCompatibility(
  17165. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17166. // check params of built in proc 'include'
  17167. var
  17168. Params: TParamsExpr;
  17169. Param: TPasExpr;
  17170. ParamResolved: TPasResolverResult;
  17171. EnumType: TPasEnumType;
  17172. C: TClass;
  17173. begin
  17174. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17175. exit(cIncompatible);
  17176. Params:=TParamsExpr(Expr);
  17177. // first param: set variable
  17178. // todo set of int, set of char, set of bool
  17179. Param:=Params.Params[0];
  17180. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17181. EnumType:=nil;
  17182. if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
  17183. and (ParamResolved.IdentEl<>nil) then
  17184. begin
  17185. C:=ParamResolved.IdentEl.ClassType;
  17186. if (C.InheritsFrom(TPasVariable)
  17187. or (C=TPasArgument)
  17188. or (C=TPasResultElement)) then
  17189. begin
  17190. if (ParamResolved.BaseType=btSet)
  17191. and (ParamResolved.LoTypeEl is TPasEnumType) then
  17192. EnumType:=TPasEnumType(ParamResolved.LoTypeEl);
  17193. end;
  17194. end;
  17195. if EnumType=nil then
  17196. begin
  17197. {$IFDEF VerbosePasResolver}
  17198. writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
  17199. {$ENDIF}
  17200. exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
  17201. 'variable of set of enumtype',RaiseOnError));
  17202. end;
  17203. // second param: enum
  17204. Param:=Params.Params[1];
  17205. ComputeElement(Param,ParamResolved,[]);
  17206. if (not (rrfReadable in ParamResolved.Flags))
  17207. or (ParamResolved.LoTypeEl<>EnumType) then
  17208. begin
  17209. if RaiseOnError then
  17210. RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
  17211. ['2'],ParamResolved.LoTypeEl,EnumType,Param);
  17212. exit(cIncompatible);
  17213. end;
  17214. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17215. end;
  17216. procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
  17217. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17218. var
  17219. P: TPasExprArray;
  17220. begin
  17221. if Proc=nil then ;
  17222. P:=Params.Params;
  17223. if P=nil then ;
  17224. FinishCallArgAccess(P[0],rraVarParam);
  17225. FinishCallArgAccess(P[1],rraRead);
  17226. end;
  17227. function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17228. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17229. var
  17230. Params: TParamsExpr;
  17231. begin
  17232. if GetLoop(Expr)=nil then
  17233. RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
  17234. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17235. exit(cExact);
  17236. Params:=TParamsExpr(Expr);
  17237. {$IFDEF VerbosePasResolver}
  17238. writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
  17239. {$ENDIF}
  17240. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17241. end;
  17242. function TPasResolver.BI_Continue_OnGetCallCompatibility(
  17243. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17244. var
  17245. Params: TParamsExpr;
  17246. begin
  17247. if GetLoop(Expr)=nil then
  17248. RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
  17249. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17250. exit(cExact);
  17251. Params:=TParamsExpr(Expr);
  17252. {$IFDEF VerbosePasResolver}
  17253. writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
  17254. {$ENDIF}
  17255. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17256. end;
  17257. function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17258. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17259. var
  17260. Params: TParamsExpr;
  17261. Param: TPasExpr;
  17262. ParamResolved, ResultResolved: TPasResolverResult;
  17263. i: Integer;
  17264. ProcScope: TPasProcedureScope;
  17265. ResultEl: TPasResultElement;
  17266. Flags: TPasResolverComputeFlags;
  17267. CtxProc: TPasProcedure;
  17268. begin
  17269. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17270. exit(cExact);
  17271. Params:=TParamsExpr(Expr);
  17272. {$IFDEF VerbosePasResolver}
  17273. writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
  17274. {$ENDIF}
  17275. // first param: result
  17276. Param:=Params.Params[0];
  17277. Result:=cIncompatible;
  17278. i:=ScopeCount-1;
  17279. while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
  17280. if i>0 then
  17281. begin
  17282. // first param is function result
  17283. ProcScope:=TPasProcedureScope(Scopes[i]);
  17284. CtxProc:=TPasProcedure(ProcScope.Element);
  17285. if not (CtxProc.ProcType is TPasFunctionType) then
  17286. begin
  17287. if RaiseOnError then
  17288. RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
  17289. sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
  17290. exit(cIncompatible);
  17291. end;
  17292. ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
  17293. ComputeElement(ResultEl,ResultResolved,[rcType]);
  17294. end
  17295. else
  17296. begin
  17297. // default: main program, param is an integer
  17298. SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],FBaseTypes[btLongint],
  17299. [rrfReadable,rrfWritable]);
  17300. end;
  17301. {$IFDEF VerbosePasResolver}
  17302. writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
  17303. {$ENDIF}
  17304. Flags:=[];
  17305. if IsProcedureType(ResultResolved,true) then
  17306. Include(Flags,rcNoImplicitProc);
  17307. ComputeElement(Param,ParamResolved,Flags);
  17308. {$IFDEF VerbosePasResolver}
  17309. writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
  17310. {$ENDIF}
  17311. if rrfReadable in ParamResolved.Flags then
  17312. Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
  17313. if Result=cIncompatible then
  17314. begin
  17315. if RaiseOnError then
  17316. RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
  17317. ['1'],ParamResolved,ResultResolved,Param);
  17318. exit;
  17319. end;
  17320. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17321. end;
  17322. function TPasResolver.BI_IncDec_OnGetCallCompatibility(
  17323. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17324. var
  17325. Params: TParamsExpr;
  17326. Param: TPasExpr;
  17327. ParamResolved, IncrResolved: TPasResolverResult;
  17328. TypeEl: TPasType;
  17329. begin
  17330. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17331. exit(cIncompatible);
  17332. Params:=TParamsExpr(Expr);
  17333. // first param: var Integer
  17334. Param:=Params.Params[0];
  17335. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17336. {$IFDEF VerbosePasResolver}
  17337. writeln('TPasResolver.BI_IncDec_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  17338. {$ENDIF}
  17339. Result:=cIncompatible;
  17340. // Expr must be a variable
  17341. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17342. begin
  17343. if RaiseOnError then
  17344. RaiseVarExpected(20170216152319,Expr,ParamResolved.IdentEl);
  17345. exit;
  17346. end;
  17347. if ParamResolved.BaseType in btAllInteger then
  17348. Result:=cExact
  17349. else if ParamResolved.BaseType=btPointer then
  17350. begin
  17351. if ElHasBoolSwitch(Expr,bsPointerMath) then
  17352. Result:=cExact;
  17353. end
  17354. else if ParamResolved.BaseType=btContext then
  17355. begin
  17356. TypeEl:=ParamResolved.LoTypeEl;
  17357. if (TypeEl.ClassType=TPasPointerType)
  17358. and ElHasBoolSwitch(Expr,bsPointerMath) then
  17359. Result:=cExact;
  17360. end;
  17361. if Result=cIncompatible then
  17362. exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
  17363. if length(Params.Params)=1 then
  17364. exit;
  17365. // second param: increment/decrement
  17366. Param:=Params.Params[1];
  17367. ComputeElement(Param,IncrResolved,[]);
  17368. Result:=cIncompatible;
  17369. if rrfReadable in IncrResolved.Flags then
  17370. begin
  17371. if IncrResolved.BaseType in btAllInteger then
  17372. Result:=cExact;
  17373. end;
  17374. if Result=cIncompatible then
  17375. exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
  17376. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17377. end;
  17378. procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
  17379. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17380. var
  17381. P: TPasExprArray;
  17382. begin
  17383. if Proc=nil then ;
  17384. P:=Params.Params;
  17385. FinishCallArgAccess(P[0],rraVarParam);
  17386. if Length(P)>1 then
  17387. FinishCallArgAccess(P[1],rraRead);
  17388. end;
  17389. function TPasResolver.BI_Assigned_OnGetCallCompatibility(
  17390. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17391. // check params of built in proc 'Assigned'
  17392. var
  17393. Params: TParamsExpr;
  17394. Param: TPasExpr;
  17395. ParamResolved: TPasResolverResult;
  17396. C: TClass;
  17397. begin
  17398. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17399. exit(cIncompatible);
  17400. Params:=TParamsExpr(Expr);
  17401. // first param: pointer, class, class instance, proc type or array
  17402. Param:=Params.Params[0];
  17403. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  17404. Result:=cIncompatible;
  17405. if ParamResolved.BaseType in [btNil,btPointer] then
  17406. Result:=cExact
  17407. else if (ParamResolved.BaseType=btContext) then
  17408. begin
  17409. C:=ParamResolved.LoTypeEl.ClassType;
  17410. if (C=TPasClassType)
  17411. or (C=TPasClassOfType)
  17412. or C.InheritsFrom(TPasProcedureType)
  17413. or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.LoTypeEl).Ranges)=0)) then
  17414. Result:=cExact;
  17415. end;
  17416. if Result=cIncompatible then
  17417. exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
  17418. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17419. end;
  17420. procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17421. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17422. begin
  17423. SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,
  17424. FBaseTypes[btBoolean],FBaseTypes[btBoolean],[rrfReadable]);
  17425. if Params=nil then ;
  17426. end;
  17427. procedure TPasResolver.BI_Assigned_OnFinishParamsExpr(
  17428. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17429. var
  17430. P: TPasExpr;
  17431. ResolvedEl: TPasResolverResult;
  17432. begin
  17433. if Proc=nil then ;
  17434. P:=Params.Params[0];
  17435. AccessExpr(P,rraRead);
  17436. ComputeElement(P,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
  17437. end;
  17438. function TPasResolver.BI_Chr_OnGetCallCompatibility(
  17439. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17440. var
  17441. Params: TParamsExpr;
  17442. Param: TPasExpr;
  17443. ParamResolved: TPasResolverResult;
  17444. begin
  17445. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17446. exit(cIncompatible);
  17447. Params:=TParamsExpr(Expr);
  17448. // first param: integer
  17449. Param:=Params.Params[0];
  17450. ComputeElement(Param,ParamResolved,[]);
  17451. Result:=cIncompatible;
  17452. if rrfReadable in ParamResolved.Flags then
  17453. begin
  17454. if ParamResolved.BaseType in btAllInteger then
  17455. Result:=cExact;
  17456. end;
  17457. if Result=cIncompatible then
  17458. exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
  17459. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17460. end;
  17461. procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17462. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17463. begin
  17464. SetResolverIdentifier(ResolvedEl,BaseTypeChar,Proc.Proc,
  17465. FBaseTypes[BaseTypeChar],FBaseTypes[BaseTypeChar],[rrfReadable]);
  17466. if Params=nil then ;
  17467. end;
  17468. procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  17469. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17470. var
  17471. Param: TPasExpr;
  17472. Value: TResEvalValue;
  17473. begin
  17474. Evaluated:=nil;
  17475. Param:=Params.Params[0];
  17476. Value:=Eval(Param,Flags);
  17477. {$IFDEF VerbosePasResEval}
  17478. {AllowWriteln}
  17479. if Value=nil then
  17480. writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
  17481. else
  17482. writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
  17483. {AllowWriteln-}
  17484. {$ENDIF}
  17485. if Value=nil then exit;
  17486. try
  17487. Evaluated:=fExprEvaluator.ChrValue(Value,Params);
  17488. finally
  17489. ReleaseEvalValue(Value);
  17490. end;
  17491. if Proc=nil then ;
  17492. end;
  17493. function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17494. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17495. var
  17496. Params: TParamsExpr;
  17497. Param: TPasExpr;
  17498. ParamResolved, ResolvedEl: TPasResolverResult;
  17499. TypeEl: TPasType;
  17500. begin
  17501. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17502. exit(cIncompatible);
  17503. Params:=TParamsExpr(Expr);
  17504. // first param: bool, enum or char
  17505. Param:=Params.Params[0];
  17506. ComputeElement(Param,ParamResolved,[]);
  17507. Result:=cIncompatible;
  17508. if rrfReadable in ParamResolved.Flags then
  17509. begin
  17510. if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
  17511. Result:=cExact
  17512. else if (ParamResolved.BaseType=btContext) and (ParamResolved.LoTypeEl is TPasEnumType) then
  17513. Result:=cExact
  17514. else if ParamResolved.BaseType=btRange then
  17515. begin
  17516. if ParamResolved.SubType in btAllBooleans+btAllChars then
  17517. Result:=cExact
  17518. else if ParamResolved.SubType=btContext then
  17519. begin
  17520. TypeEl:=ParamResolved.LoTypeEl;
  17521. if TypeEl.ClassType=TPasRangeType then
  17522. begin
  17523. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  17524. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  17525. exit(cExact);
  17526. end;
  17527. end;
  17528. end;
  17529. end;
  17530. if Result=cIncompatible then
  17531. exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
  17532. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17533. end;
  17534. procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17535. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17536. begin
  17537. SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,
  17538. FBaseTypes[btLongint],FBaseTypes[btLongint],[rrfReadable]);
  17539. if Params=nil then ;
  17540. end;
  17541. procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  17542. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17543. var
  17544. Param: TPasExpr;
  17545. Value: TResEvalValue;
  17546. begin
  17547. Evaluated:=nil;
  17548. Param:=Params.Params[0];
  17549. Value:=Eval(Param,Flags);
  17550. {$IFDEF VerbosePasResEval}
  17551. {AllowWriteln}
  17552. if Value=nil then
  17553. writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
  17554. else
  17555. writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
  17556. {AllowWriteln-}
  17557. {$ENDIF}
  17558. if Value=nil then exit;
  17559. try
  17560. Evaluated:=fExprEvaluator.OrdValue(Value,Params);
  17561. finally
  17562. ReleaseEvalValue(Value);
  17563. end;
  17564. if Proc=nil then ;
  17565. end;
  17566. function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
  17567. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17568. // check params of built in proc 'Low' or 'High'
  17569. var
  17570. Params: TParamsExpr;
  17571. Param: TPasExpr;
  17572. ParamResolved: TPasResolverResult;
  17573. C: TClass;
  17574. begin
  17575. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17576. exit(cIncompatible);
  17577. Params:=TParamsExpr(Expr);
  17578. // first param: enumtype, range, built-in ordinal type (char, longint, ...)
  17579. Param:=Params.Params[0];
  17580. ComputeElement(Param,ParamResolved,[]);
  17581. Result:=cIncompatible;
  17582. if ParamResolved.BaseType in btAllRanges then
  17583. // e.g. high(char)
  17584. Result:=cExact
  17585. else if ParamResolved.BaseType=btSet then
  17586. Result:=cExact
  17587. else if (ParamResolved.BaseType=btContext) then
  17588. begin
  17589. C:=ParamResolved.LoTypeEl.ClassType;
  17590. if (C=TPasArrayType)
  17591. or (C=TPasSetType)
  17592. or (C=TPasEnumType) then
  17593. Result:=cExact;
  17594. end;
  17595. if Result=cIncompatible then
  17596. begin
  17597. {$IFDEF VerbosePasResolver}
  17598. writeln('TPasResolver.BI_LowHigh_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  17599. {$ENDIF}
  17600. exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
  17601. end;
  17602. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17603. end;
  17604. procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17605. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17606. var
  17607. ArrayEl: TPasArrayType;
  17608. Param: TPasExpr;
  17609. TypeEl: TPasType;
  17610. begin
  17611. Param:=Params.Params[0];
  17612. ComputeElement(Param,ResolvedEl,[]);
  17613. if ResolvedEl.BaseType=btContext then
  17614. begin
  17615. TypeEl:=ResolvedEl.LoTypeEl;
  17616. if TypeEl.ClassType=TPasArrayType then
  17617. begin
  17618. // array: result type is type of first dimension
  17619. ArrayEl:=TPasArrayType(TypeEl);
  17620. if length(ArrayEl.Ranges)=0 then
  17621. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  17622. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable])
  17623. else
  17624. begin
  17625. ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
  17626. if ResolvedEl.BaseType=btRange then
  17627. ConvertRangeToElement(ResolvedEl);
  17628. end;
  17629. end
  17630. else if TypeEl.ClassType=TPasSetType then
  17631. begin
  17632. ResolvedEl.LoTypeEl:=TPasSetType(TypeEl).EnumType;
  17633. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  17634. end;
  17635. end
  17636. else if ResolvedEl.BaseType=btSet then
  17637. begin
  17638. ResolvedEl.BaseType:=ResolvedEl.SubType;
  17639. ResolvedEl.SubType:=btNone;
  17640. end
  17641. else
  17642. ;// ordinal: result type is argument type
  17643. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
  17644. end;
  17645. procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  17646. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17647. function IsDynArrayConstExpr(IdentEl: TPasElement): boolean;
  17648. begin
  17649. Result:=false;
  17650. if not (IdentEl is TPasVariable) then exit;
  17651. if not (TPasVariable(IdentEl).Expr is TPasExpr) then exit;
  17652. if (IdentEl.ClassType=TPasConst) and TPasConst(IdentEl).IsConst then
  17653. exit(true);
  17654. if fExprEvaluator.IsConst(Params) then
  17655. exit(true); // a const refers an initial value
  17656. end;
  17657. var
  17658. Param: TPasExpr;
  17659. ParamResolved: TPasResolverResult;
  17660. var
  17661. TypeEl: TPasType;
  17662. ArrayEl: TPasArrayType;
  17663. Value: TResEvalValue;
  17664. EnumType: TPasEnumType;
  17665. aSet: TResEvalSet;
  17666. bt: TResolverBaseType;
  17667. Int, MinInt, MaxInt: TMaxPrecInt;
  17668. i: Integer;
  17669. Expr: TPasExpr;
  17670. begin
  17671. Evaluated:=nil;
  17672. Param:=Params.Params[0];
  17673. ComputeElement(Param,ParamResolved,[]);
  17674. TypeEl:=ParamResolved.LoTypeEl;
  17675. if ParamResolved.BaseType=btContext then
  17676. begin
  17677. if TypeEl.ClassType=TPasArrayType then
  17678. begin
  17679. // array: low/high of first dimension
  17680. ArrayEl:=TPasArrayType(TypeEl);
  17681. if length(ArrayEl.Ranges)=0 then
  17682. begin
  17683. // dyn or open array
  17684. if Proc.BuiltIn=bfLow then
  17685. Evaluated:=TResEvalInt.CreateValue(0)
  17686. else if IsDynArrayConstExpr(ParamResolved.IdentEl) then
  17687. begin
  17688. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  17689. if Expr is TArrayValues then
  17690. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
  17691. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  17692. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
  17693. if Evaluated=nil then
  17694. RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
  17695. end
  17696. else
  17697. exit;
  17698. end
  17699. else
  17700. begin
  17701. // static array
  17702. Evaluated:=EvalRangeLimit(ArrayEl.Ranges[0],Flags,Proc.BuiltIn=bfLow,Param);
  17703. end;
  17704. end
  17705. else if TypeEl.ClassType=TPasSetType then
  17706. begin
  17707. // set: first/last enum
  17708. TypeEl:=TPasSetType(TypeEl).EnumType;
  17709. if TypeEl.ClassType=TPasEnumType then
  17710. begin
  17711. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  17712. if Proc.BuiltIn=bfLow then
  17713. Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
  17714. else
  17715. Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
  17716. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  17717. end
  17718. else
  17719. begin
  17720. {$IFDEF VerbosePasResolver}
  17721. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  17722. {$ENDIF}
  17723. RaiseNotYetImplemented(20170601203026,Params);
  17724. end;
  17725. end
  17726. else if TypeEl.ClassType=TPasEnumType then
  17727. begin
  17728. EnumType:=TPasEnumType(TypeEl);
  17729. if Proc.BuiltIn=bfLow then
  17730. i:=0
  17731. else
  17732. i:=EnumType.Values.Count-1;
  17733. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  17734. end;
  17735. end
  17736. else if ParamResolved.BaseType=btSet then
  17737. begin
  17738. Value:=Eval(Param,Flags);
  17739. if Value=nil then exit;
  17740. case Value.Kind of
  17741. revkSetOfInt:
  17742. begin
  17743. aSet:=TResEvalSet(Value);
  17744. if length(aSet.Ranges)=0 then
  17745. RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
  17746. if Proc.BuiltIn=bfLow then
  17747. Int:=aSet.RangeStart
  17748. else
  17749. Int:=aSet.RangeEnd;
  17750. case aSet.ElKind of
  17751. revskEnum:
  17752. begin
  17753. EnumType:=aSet.IdentEl as TPasEnumType;
  17754. Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
  17755. end;
  17756. revskInt:
  17757. Evaluated:=TResEvalInt.CreateValue(Int);
  17758. revskChar:
  17759. {$ifdef FPC_HAS_CPSTRING}
  17760. if Int<256 then
  17761. Evaluated:=TResEvalString.CreateValue(chr(Int))
  17762. else
  17763. {$endif}
  17764. Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
  17765. revskBool:
  17766. if Int=0 then
  17767. Evaluated:=TResEvalBool.CreateValue(false)
  17768. else
  17769. Evaluated:=TResEvalBool.CreateValue(true)
  17770. end;
  17771. end;
  17772. else
  17773. RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
  17774. end;
  17775. end
  17776. else if (TypeEl is TPasUnresolvedSymbolRef)
  17777. and (TypeEl.CustomData is TResElDataBaseType) then
  17778. begin
  17779. // low,high(base type)
  17780. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  17781. bt:=GetActualBaseType(bt);
  17782. if bt in btAllBooleans then
  17783. Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
  17784. {$ifdef HasInt64}
  17785. else if bt=btQWord then
  17786. begin
  17787. if Proc.BuiltIn=bfLow then
  17788. Evaluated:=TResEvalInt.CreateValue(0)
  17789. else
  17790. Evaluated:=TResEvalUInt.CreateValue(High(QWord));
  17791. end
  17792. {$endif}
  17793. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  17794. begin
  17795. if Proc.BuiltIn=bfLow then
  17796. Evaluated:=TResEvalInt.CreateValue(MinInt)
  17797. else
  17798. Evaluated:=TResEvalInt.CreateValue(MaxInt);
  17799. end
  17800. {$ifdef FPC_HAS_CPSTRING}
  17801. else if bt=btAnsiChar then
  17802. begin
  17803. if Proc.BuiltIn=bfLow then
  17804. Evaluated:=TResEvalString.CreateValue(#0)
  17805. else
  17806. Evaluated:=TResEvalString.CreateValue(#255);
  17807. end
  17808. {$endif}
  17809. else if bt=btWideChar then
  17810. begin
  17811. if Proc.BuiltIn=bfLow then
  17812. Evaluated:=TResEvalUTF16.CreateValue(#0)
  17813. else
  17814. Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
  17815. end
  17816. else
  17817. begin
  17818. {$IFDEF VerbosePasResolver}
  17819. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  17820. {$ENDIF}
  17821. RaiseNotYetImplemented(20170602070738,Params);
  17822. end;
  17823. end
  17824. else if ParamResolved.LoTypeEl is TPasRangeType then
  17825. begin
  17826. // e.g. type t = 2..10;
  17827. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
  17828. end
  17829. else
  17830. begin
  17831. {$IFDEF VerbosePasResolver}
  17832. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  17833. {$ENDIF}
  17834. RaiseNotYetImplemented(20170601202353,Params);
  17835. end;
  17836. {$IFDEF VerbosePasResEval}
  17837. {AllowWriteln}
  17838. if Evaluated=nil then
  17839. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
  17840. else
  17841. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
  17842. {AllowWriteln-}
  17843. {$ENDIF}
  17844. end;
  17845. function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
  17846. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17847. // check params of built in proc 'Pred' or 'Succ'
  17848. var
  17849. Params: TParamsExpr;
  17850. Param: TPasExpr;
  17851. ParamResolved: TPasResolverResult;
  17852. begin
  17853. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17854. exit(cIncompatible);
  17855. Params:=TParamsExpr(Expr);
  17856. // first param: enum, range, set, char or integer
  17857. Param:=Params.Params[0];
  17858. ComputeElement(Param,ParamResolved,[]);
  17859. Result:=cIncompatible;
  17860. if CheckIsOrdinal(ParamResolved,Param,false) then
  17861. Result:=cExact;
  17862. if Result=cIncompatible then
  17863. exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
  17864. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17865. end;
  17866. procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17867. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17868. begin
  17869. ComputeElement(Params.Params[0],ResolvedEl,[]);
  17870. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  17871. if Proc=nil then ;
  17872. end;
  17873. procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  17874. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17875. var
  17876. Param: TPasExpr;
  17877. begin
  17878. //writeln('TPasResolver.BI_PredSucc_OnEval START');
  17879. Evaluated:=nil;
  17880. Param:=Params.Params[0];
  17881. Evaluated:=Eval(Param,Flags);
  17882. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
  17883. if Evaluated=nil then exit;
  17884. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
  17885. if Evaluated.Element<>nil then
  17886. Evaluated:=Evaluated.Clone;
  17887. if Proc.BuiltIn=bfPred then
  17888. fExprEvaluator.PredValue(Evaluated,Params)
  17889. else
  17890. fExprEvaluator.SuccValue(Evaluated,Params);
  17891. end;
  17892. function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  17893. const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
  17894. ): integer;
  17895. function CheckFormat(FormatExpr: TPasExpr; Index: integer;
  17896. const ParamResolved: TPasResolverResult): boolean;
  17897. var
  17898. ResolvedEl: TPasResolverResult;
  17899. Ok: Boolean;
  17900. begin
  17901. if FormatExpr=nil then exit(true);
  17902. Result:=false;
  17903. Ok:=false;
  17904. if ParamResolved.BaseType in btAllFloats then
  17905. // floats supports value:Width:Precision
  17906. Ok:=true
  17907. else
  17908. // all other only support value:Width
  17909. Ok:=Index<2;
  17910. if not Ok then
  17911. begin
  17912. if RaiseOnError then
  17913. RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
  17914. exit;
  17915. end;
  17916. ComputeElement(FormatExpr,ResolvedEl,[]);
  17917. if not (ResolvedEl.BaseType in btAllInteger) then
  17918. begin
  17919. if RaiseOnError then
  17920. RaiseXExpectedButYFound(20170319221515,
  17921. 'integer',GetResolverResultDescription(ResolvedEl,true),FormatExpr);
  17922. exit;
  17923. end;
  17924. if not (rrfReadable in ResolvedEl.Flags) then
  17925. begin
  17926. if RaiseOnError then
  17927. RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
  17928. exit;
  17929. end;
  17930. Result:=true;
  17931. end;
  17932. var
  17933. TypeEl: TPasType;
  17934. begin
  17935. Result:=cIncompatible;
  17936. if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
  17937. Result:=cExact
  17938. else if IsFunc and (ParamResolved.BaseType in btAllStringAndChars) then
  17939. Result:=cExact
  17940. else if ParamResolved.BaseType=btContext then
  17941. begin
  17942. TypeEl:=ParamResolved.LoTypeEl;
  17943. if TypeEl.ClassType=TPasEnumType then
  17944. Result:=cExact
  17945. end;
  17946. if Result=cIncompatible then
  17947. exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
  17948. if not CheckFormat(Param.format1,1,ParamResolved) then
  17949. exit(cIncompatible);
  17950. if not CheckFormat(Param.format2,2,ParamResolved) then
  17951. exit(cIncompatible);
  17952. end;
  17953. function TPasResolver.BI_StrProc_OnGetCallCompatibility(
  17954. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17955. // check params of built-in procedure 'Str'
  17956. var
  17957. Params: TParamsExpr;
  17958. Param: TPasExpr;
  17959. ParamResolved: TPasResolverResult;
  17960. begin
  17961. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17962. exit(cIncompatible);
  17963. Params:=TParamsExpr(Expr);
  17964. if ParentNeedsExprResult(Params) then
  17965. begin
  17966. if RaiseOnError then
  17967. RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
  17968. sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
  17969. exit(cIncompatible);
  17970. end;
  17971. // first param: boolean, integer, enum, class instance
  17972. Param:=Params.Params[0];
  17973. ComputeElement(Param,ParamResolved,[]);
  17974. Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
  17975. if Result=cIncompatible then
  17976. exit;
  17977. // second parameter: string variable
  17978. Param:=Params.Params[1];
  17979. ComputeElement(Param,ParamResolved,[]);
  17980. Result:=cIncompatible;
  17981. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17982. begin
  17983. if ParamResolved.BaseType in btAllStrings then
  17984. Result:=cExact;
  17985. end;
  17986. if Result=cIncompatible then
  17987. exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
  17988. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17989. end;
  17990. procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  17991. Params: TParamsExpr);
  17992. var
  17993. P: TPasExprArray;
  17994. begin
  17995. if Proc=nil then ;
  17996. P:=Params.Params;
  17997. if P=nil then ;
  17998. FinishCallArgAccess(P[0],rraRead);
  17999. FinishCallArgAccess(P[1],rraVarParam);
  18000. end;
  18001. function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
  18002. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18003. var
  18004. Params: TParamsExpr;
  18005. Param: TPasExpr;
  18006. ParamResolved: TPasResolverResult;
  18007. i: Integer;
  18008. begin
  18009. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18010. exit(cIncompatible);
  18011. Params:=TParamsExpr(Expr);
  18012. if not ParentNeedsExprResult(Params) then
  18013. begin
  18014. // not in an expression -> the 'procedure str' is needed, not the 'function str'
  18015. if RaiseOnError then
  18016. RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
  18017. sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
  18018. exit(cIncompatible);
  18019. end;
  18020. // param: string, boolean, integer, enum, class instance
  18021. for i:=0 to length(Params.Params)-1 do
  18022. begin
  18023. Param:=Params.Params[i];
  18024. ComputeElement(Param,ParamResolved,[]);
  18025. Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
  18026. if Result=cIncompatible then
  18027. exit;
  18028. end;
  18029. Result:=cExact;
  18030. end;
  18031. procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18032. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18033. begin
  18034. SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,
  18035. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable]);
  18036. if Params=nil then ;
  18037. if Proc=nil then ;
  18038. end;
  18039. procedure TPasResolver.BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  18040. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18041. begin
  18042. Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
  18043. if Proc=nil then ;
  18044. end;
  18045. function TPasResolver.BI_WriteStrProc_OnGetCallCompatibility(
  18046. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18047. // check params of built-in procedure 'Str'
  18048. var
  18049. Params: TParamsExpr;
  18050. Param: TPasExpr;
  18051. ParamResolved: TPasResolverResult;
  18052. i: Integer;
  18053. begin
  18054. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  18055. exit(cIncompatible);
  18056. Params:=TParamsExpr(Expr);
  18057. // first parameter: string variable
  18058. Param:=Params.Params[0];
  18059. ComputeElement(Param,ParamResolved,[]);
  18060. Result:=cIncompatible;
  18061. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18062. begin
  18063. if ParamResolved.BaseType in btAllStrings then
  18064. Result:=cExact;
  18065. end;
  18066. if Result=cIncompatible then
  18067. exit(CheckRaiseTypeArgNo(20180527190304,1,Param,ParamResolved,'string variable',RaiseOnError));
  18068. // other parameters: boolean, integer, enum, class instance
  18069. for i:=1 to length(Params.Params)-1 do
  18070. begin
  18071. Param:=Params.Params[i];
  18072. ComputeElement(Param,ParamResolved,[]);
  18073. Result:=BI_Str_CheckParam(false,Param,ParamResolved,i,RaiseOnError);
  18074. if Result=cIncompatible then
  18075. exit;
  18076. end;
  18077. end;
  18078. procedure TPasResolver.BI_WriteStrProc_OnFinishParamsExpr(
  18079. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18080. var
  18081. P: TPasExprArray;
  18082. i: Integer;
  18083. begin
  18084. if Proc=nil then ;
  18085. P:=Params.Params;
  18086. if P=nil then ;
  18087. FinishCallArgAccess(P[0],rraOutParam);
  18088. for i:=0 to length(Params.Params)-1 do
  18089. FinishCallArgAccess(P[i],rraRead);
  18090. end;
  18091. function TPasResolver.BI_Val_OnGetCallCompatibility(
  18092. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18093. // check params of built-in procedure 'Val(const s: string; out v: valtype; out code: integer)'
  18094. var
  18095. Params: TParamsExpr;
  18096. Param: TPasExpr;
  18097. ParamResolved: TPasResolverResult;
  18098. begin
  18099. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18100. exit(cIncompatible);
  18101. Params:=TParamsExpr(Expr);
  18102. // first parameter: string
  18103. Param:=Params.Params[0];
  18104. ComputeElement(Param,ParamResolved,[]);
  18105. Result:=cIncompatible;
  18106. if ParamResolved.BaseType in btAllStrings then
  18107. Result:=cExact;
  18108. if Result=cIncompatible then
  18109. exit(CheckRaiseTypeArgNo(20181214141250,1,Param,ParamResolved,'string',RaiseOnError));
  18110. // second parameter: var value
  18111. Param:=Params.Params[1];
  18112. ComputeElement(Param,ParamResolved,[]);
  18113. Result:=cIncompatible;
  18114. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18115. begin
  18116. if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
  18117. Result:=cExact
  18118. else if ParamResolved.BaseType=btContext then
  18119. begin
  18120. if ParamResolved.LoTypeEl is TPasEnumType then
  18121. Result:=cExact;
  18122. end;
  18123. end;
  18124. if Result=cIncompatible then
  18125. exit(CheckRaiseTypeArgNo(20181214141704,2,Param,ParamResolved,
  18126. 'boolean/integer/float/enum variable',RaiseOnError));
  18127. // third parameter: out Code: integer
  18128. Param:=Params.Params[2];
  18129. ComputeElement(Param,ParamResolved,[]);
  18130. Result:=cIncompatible;
  18131. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18132. begin
  18133. if ParamResolved.BaseType in btAllInteger then
  18134. Result:=cExact;
  18135. end;
  18136. if Result=cIncompatible then
  18137. exit(CheckRaiseTypeArgNo(20181214141511,3,Param,ParamResolved,'integer variable',RaiseOnError));
  18138. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18139. end;
  18140. procedure TPasResolver.BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  18141. Params: TParamsExpr);
  18142. var
  18143. P: TPasExprArray;
  18144. begin
  18145. if Proc=nil then ;
  18146. P:=Params.Params;
  18147. if P=nil then ;
  18148. FinishCallArgAccess(P[0],rraRead);
  18149. FinishCallArgAccess(P[1],rraOutParam);
  18150. FinishCallArgAccess(P[2],rraOutParam);
  18151. end;
  18152. function TPasResolver.BI_LoHi_OnGetCallCompatibility(
  18153. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18154. var
  18155. Params: TParamsExpr;
  18156. Param: TPasExpr;
  18157. ParamResolved: TPasResolverResult;
  18158. begin
  18159. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18160. Exit(cIncompatible);
  18161. Params:=TParamsExpr(Expr);
  18162. // first Param: any integer type
  18163. Param:=Params.params[0];
  18164. ComputeElement(Param,ParamResolved,[]);
  18165. Result:=cIncompatible;
  18166. if (rrfReadable in ParamResolved.Flags)
  18167. and (ParamResolved.BaseType in btAllInteger)
  18168. then
  18169. Result:=cExact;
  18170. if Result=cIncompatible then
  18171. Exit(CheckRaiseTypeArgNo(20190128232600,1,Param,ParamResolved,'integer type',RaiseOnError));
  18172. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18173. end;
  18174. procedure TPasResolver.BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18175. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18176. var
  18177. ResolvedParam: TPasResolverResult;
  18178. BaseType: TResolverBaseType;
  18179. Mask: LongWord;
  18180. begin
  18181. ComputeElement(Params.Params[0],ResolvedParam,[]);
  18182. GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18183. case Mask of
  18184. $F, $FF: BaseType := btByte;
  18185. $FFFF: BaseType := btWord;
  18186. else { $FFFFFFFF } BaseType := btLongWord;
  18187. end;
  18188. SetResolverIdentifier(ResolvedEl,BaseType,Proc.Proc,
  18189. FBaseTypes[BaseType],FBaseTypes[BaseType],[rrfReadable]);
  18190. end;
  18191. procedure TPasResolver.BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  18192. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18193. var
  18194. Param: TPasExpr;
  18195. ResolvedParam: TPasResolverResult;
  18196. Value: TResEvalValue;
  18197. Shift: Integer;
  18198. Mask: LongWord;
  18199. begin
  18200. Evaluated := nil;
  18201. Param := Params.Params[0];
  18202. Value := Eval(Param,Flags);
  18203. {$IFDEF VerbosePasResEval}
  18204. {AllowWriteln}
  18205. if value=nil then
  18206. writeln('TPasResolver.BI_LoHi_OnEval Value=NIL')
  18207. else
  18208. writeln('TPasResolver.BI_LoHi_OnEval Value=',value.AsDebugString);
  18209. {AllowWriteln-}
  18210. {$ENDIF}
  18211. if Value=nil then exit;
  18212. try
  18213. ComputeElement(Param,ResolvedParam,[]);
  18214. Shift := GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18215. Evaluated := fExprEvaluator.LoHiValue(Value,Shift,Mask,Params);
  18216. finally
  18217. ReleaseEvalValue(Value);
  18218. end;
  18219. end;
  18220. function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
  18221. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18222. var
  18223. Params: TParamsExpr;
  18224. Param: TPasExpr;
  18225. ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
  18226. i: Integer;
  18227. ArrType: TPasArrayType;
  18228. ElType: TPasType;
  18229. begin
  18230. Result:=cIncompatible;
  18231. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18232. exit;
  18233. Params:=TParamsExpr(Expr);
  18234. FirstElTypeResolved:=Default(TPasResolverResult);
  18235. for i:=0 to length(Params.Params)-1 do
  18236. begin
  18237. // all params: array
  18238. Param:=Params.Params[i];
  18239. ComputeElement(Param,ParamResolved,[]);
  18240. ElTypeResolved:=default(TPasResolverResult);
  18241. if rrfReadable in ParamResolved.Flags then
  18242. begin
  18243. if ParamResolved.BaseType=btContext then
  18244. begin
  18245. if IsDynArray(ParamResolved.LoTypeEl) then
  18246. begin
  18247. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  18248. ElType:=GetArrayElType(ArrType);
  18249. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18250. end;
  18251. end
  18252. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  18253. SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
  18254. ParamResolved.LoTypeEl,ParamResolved.HiTypeEl,Param,ParamResolved.Flags);
  18255. end;
  18256. if ElTypeResolved.BaseType=btNone then
  18257. exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18258. Include(ElTypeResolved.Flags,rrfReadable);
  18259. if i=0 then
  18260. begin
  18261. FirstElTypeResolved:=ElTypeResolved;
  18262. Include(FirstElTypeResolved.Flags,rrfWritable);
  18263. end
  18264. else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
  18265. exit(cIncompatible);
  18266. end;
  18267. Result:=cExact;
  18268. end;
  18269. procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
  18270. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18271. ResolvedEl: TPasResolverResult);
  18272. begin
  18273. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18274. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18275. ResolvedEl.ExprEl:=Params;
  18276. ResolvedEl.IdentEl:=nil;
  18277. if ResolvedEl.BaseType=btArrayOrSet then
  18278. ResolvedEl.BaseType:=btArrayLit;
  18279. if Proc=nil then ;
  18280. end;
  18281. function TPasResolver.BI_ConcatString_OnGetCallCompatibility(
  18282. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18283. var
  18284. Params: TParamsExpr;
  18285. i: Integer;
  18286. Param: TPasExpr;
  18287. ParamResolved: TPasResolverResult;
  18288. begin
  18289. Result:=cIncompatible;
  18290. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18291. exit;
  18292. Params:=TParamsExpr(Expr);
  18293. for i:=0 to length(Params.Params)-1 do
  18294. begin
  18295. // all params: char or string
  18296. Param:=Params.Params[i];
  18297. ComputeElement(Param,ParamResolved,[]);
  18298. if not (rrfReadable in ParamResolved.Flags)
  18299. or not (ParamResolved.BaseType in btAllStringAndChars) then
  18300. exit(CheckRaiseTypeArgNo(20181219230329,i+1,Param,ParamResolved,'string',RaiseOnError));
  18301. end;
  18302. Result:=cExact;
  18303. end;
  18304. procedure TPasResolver.BI_ConcatString_OnGetCallResult(
  18305. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18306. ResolvedEl: TPasResolverResult);
  18307. var
  18308. i: Integer;
  18309. Param: TPasExpr;
  18310. ParamResolved, CombinedResolved: TPasResolverResult;
  18311. ParamsArr: TPasExprArray;
  18312. begin
  18313. if Proc=nil then ;
  18314. ParamsArr:=Params.Params;
  18315. for i:=0 to length(ParamsArr)-1 do
  18316. begin
  18317. // all params: char or string
  18318. Param:=ParamsArr[i];
  18319. ComputeElement(Param,ParamResolved,[]);
  18320. if i=0 then
  18321. ResolvedEl:=ParamResolved
  18322. else
  18323. begin
  18324. ComputeAddStringRes(ResolvedEl,ParamResolved,Params,CombinedResolved);
  18325. ResolvedEl:=CombinedResolved;
  18326. end;
  18327. end;
  18328. end;
  18329. procedure TPasResolver.BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  18330. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18331. var
  18332. i: Integer;
  18333. Param: TPasExpr;
  18334. Value, NewValue: TResEvalValue;
  18335. ok: Boolean;
  18336. begin
  18337. if Proc=nil then ;
  18338. Value:=nil;
  18339. Evaluated:=nil;
  18340. ok:=false;
  18341. try
  18342. for i:=0 to length(Params.Params)-1 do
  18343. begin
  18344. // all params: char or string
  18345. Param:=Params.Params[i];
  18346. Value:=Eval(Param,Flags);
  18347. if Value=nil then
  18348. exit;
  18349. if i=0 then
  18350. begin
  18351. Evaluated:=Value;
  18352. Value:=nil;
  18353. end
  18354. else
  18355. begin
  18356. NewValue:=ExprEvaluator.EvalStringAddExpr(Param,Params.Params[i-1],Param,
  18357. Evaluated,Value);
  18358. ReleaseEvalValue(Evaluated);
  18359. Evaluated:=NewValue;
  18360. ReleaseEvalValue(Value);
  18361. end;
  18362. end;
  18363. ok:=true;
  18364. finally
  18365. ReleaseEvalValue(Value);
  18366. if not ok then
  18367. ReleaseEvalValue(Evaluated);
  18368. end;
  18369. end;
  18370. function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
  18371. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18372. var
  18373. Params: TParamsExpr;
  18374. Param: TPasExpr;
  18375. ParamResolved: TPasResolverResult;
  18376. begin
  18377. Result:=cIncompatible;
  18378. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18379. exit;
  18380. Params:=TParamsExpr(Expr);
  18381. // first param: array
  18382. Param:=Params.Params[0];
  18383. ComputeElement(Param,ParamResolved,[]);
  18384. if rrfReadable in ParamResolved.Flags then
  18385. begin
  18386. if ParamResolved.BaseType=btContext then
  18387. begin
  18388. if IsDynArray(ParamResolved.LoTypeEl) then
  18389. Result:=cExact;
  18390. end
  18391. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  18392. Result:=cExact;
  18393. end;
  18394. if Result=cIncompatible then
  18395. exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18396. if length(Params.Params)=1 then
  18397. exit(cExact);
  18398. // check optional Start index
  18399. Param:=Params.Params[1];
  18400. ComputeElement(Param,ParamResolved,[]);
  18401. if not (rrfReadable in ParamResolved.Flags)
  18402. or not (ParamResolved.BaseType in btAllInteger) then
  18403. exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
  18404. if length(Params.Params)=2 then
  18405. exit(cExact);
  18406. // check optional Count
  18407. Param:=Params.Params[2];
  18408. ComputeElement(Param,ParamResolved,[]);
  18409. if not (rrfReadable in ParamResolved.Flags)
  18410. or not (ParamResolved.BaseType in btAllInteger) then
  18411. exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
  18412. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18413. end;
  18414. procedure TPasResolver.BI_CopyArray_OnGetCallResult(
  18415. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18416. ResolvedEl: TPasResolverResult);
  18417. begin
  18418. if Proc=nil then ;
  18419. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18420. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18421. ResolvedEl.ExprEl:=Params;
  18422. ResolvedEl.IdentEl:=nil;
  18423. if ResolvedEl.BaseType=btArrayOrSet then
  18424. ResolvedEl.BaseType:=btArrayLit;
  18425. end;
  18426. function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
  18427. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18428. // Insert(Item,var Array,Index)
  18429. var
  18430. Params: TParamsExpr;
  18431. Param, ItemParam: TPasExpr;
  18432. ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
  18433. ArrType: TPasArrayType;
  18434. ElType: TPasType;
  18435. begin
  18436. Result:=cIncompatible;
  18437. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18438. exit;
  18439. Params:=TParamsExpr(Expr);
  18440. // check Item
  18441. ItemParam:=Params.Params[0];
  18442. ComputeElement(ItemParam,ItemResolved,[]);
  18443. if not (rrfReadable in ItemResolved.Flags) then
  18444. exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
  18445. // check Array
  18446. Param:=Params.Params[1];
  18447. ComputeElement(Param,ParamResolved,[]);
  18448. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18449. begin
  18450. if RaiseOnError then
  18451. RaiseVarExpected(20170329171514,Param,ParamResolved.IdentEl);
  18452. exit;
  18453. end;
  18454. if (ParamResolved.BaseType<>btContext)
  18455. or not IsDynArray(ParamResolved.LoTypeEl) then
  18456. exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
  18457. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  18458. ElType:=GetArrayElType(ArrType);
  18459. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18460. if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
  18461. exit(cIncompatible);
  18462. // check insert Index
  18463. Param:=Params.Params[2];
  18464. ComputeElement(Param,ParamResolved,[]);
  18465. if not (rrfReadable in ParamResolved.Flags)
  18466. or not (ParamResolved.BaseType in btAllInteger) then
  18467. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  18468. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18469. end;
  18470. procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
  18471. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18472. var
  18473. P: TPasExprArray;
  18474. Param0, Param1: TPasExpr;
  18475. ArrayResolved, ElTypeResolved: TPasResolverResult;
  18476. ElType: TPasType;
  18477. begin
  18478. if Proc=nil then ;
  18479. P:=Params.Params;
  18480. Param0:=P[0];
  18481. Param1:=P[1];
  18482. FinishCallArgAccess(Param0,rraRead);
  18483. FinishCallArgAccess(Param1,rraVarParam);
  18484. FinishCallArgAccess(P[2],rraRead);
  18485. if not (Param0 is TPrimitiveExpr) then
  18486. begin
  18487. // insert complex expression, e.g. insert([1],Arr,index)
  18488. // -> mark array and set literals
  18489. ComputeElement(Param1,ArrayResolved,[]);
  18490. if (ArrayResolved.BaseType<>btContext)
  18491. or not IsDynArray(ArrayResolved.LoTypeEl) then
  18492. RaiseNotYetImplemented(20180622144039,Param1);
  18493. ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
  18494. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18495. if (ElTypeResolved.BaseType=btContext)
  18496. and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
  18497. MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
  18498. end;
  18499. end;
  18500. function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
  18501. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18502. // Delete(var Array; Start, Count: integer)
  18503. var
  18504. Params: TParamsExpr;
  18505. Param: TPasExpr;
  18506. ParamResolved: TPasResolverResult;
  18507. begin
  18508. Result:=cIncompatible;
  18509. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18510. exit;
  18511. Params:=TParamsExpr(Expr);
  18512. // check Array
  18513. Param:=Params.Params[0];
  18514. ComputeElement(Param,ParamResolved,[]);
  18515. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18516. begin
  18517. if RaiseOnError then
  18518. RaiseVarExpected(20170329173421,Param,ParamResolved.IdentEl);
  18519. exit;
  18520. end;
  18521. if (ParamResolved.BaseType<>btContext)
  18522. or not IsDynArray(ParamResolved.LoTypeEl) then
  18523. exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18524. // check param Start
  18525. Param:=Params.Params[1];
  18526. ComputeElement(Param,ParamResolved,[]);
  18527. if not (rrfReadable in ParamResolved.Flags)
  18528. or not (ParamResolved.BaseType in btAllInteger) then
  18529. exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
  18530. // check param Count
  18531. Param:=Params.Params[2];
  18532. ComputeElement(Param,ParamResolved,[]);
  18533. if not (rrfReadable in ParamResolved.Flags)
  18534. or not (ParamResolved.BaseType in btAllInteger) then
  18535. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  18536. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18537. end;
  18538. procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
  18539. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18540. var
  18541. P: TPasExprArray;
  18542. begin
  18543. if Proc=nil then ;
  18544. P:=Params.Params;
  18545. if P=nil then ;
  18546. FinishCallArgAccess(P[0],rraVarParam);
  18547. FinishCallArgAccess(P[1],rraRead);
  18548. FinishCallArgAccess(P[2],rraRead);
  18549. end;
  18550. function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
  18551. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18552. var
  18553. Params: TParamsExpr;
  18554. Param: TPasExpr;
  18555. Decl: TPasElement;
  18556. ParamResolved: TPasResolverResult;
  18557. aType: TPasType;
  18558. begin
  18559. Result:=cIncompatible;
  18560. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18561. exit;
  18562. Params:=TParamsExpr(Expr);
  18563. // check type or var
  18564. Param:=Params.Params[0];
  18565. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  18566. Decl:=ParamResolved.IdentEl;
  18567. aType:=nil;
  18568. if (Decl<>nil) then
  18569. begin
  18570. if Decl is TPasType then
  18571. aType:=TPasType(Decl)
  18572. else if Decl is TPasVariable then
  18573. aType:=TPasVariable(Decl).VarType
  18574. else if Decl.ClassType=TPasArgument then
  18575. aType:=TPasArgument(Decl).ArgType
  18576. else if Decl.ClassType=TPasResultElement then
  18577. aType:=TPasResultElement(Decl).ResultType
  18578. else if (Decl is TPasProcedure)
  18579. and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
  18580. aType:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
  18581. {$IFDEF VerbosePasResolver}
  18582. {AllowWriteln}
  18583. if aType=nil then
  18584. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility Decl=',GetObjName(Decl));
  18585. {AllowWriteln-}
  18586. {$ENDIF}
  18587. end;
  18588. if aType=nil then
  18589. begin
  18590. {$IFDEF VerbosePasResolver}
  18591. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  18592. {$ENDIF}
  18593. RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  18594. end;
  18595. aType:=ResolveAliasType(aType);
  18596. if not HasTypeInfo(aType) then
  18597. RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
  18598. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18599. end;
  18600. procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18601. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18602. begin
  18603. if Proc=nil then;
  18604. if Params=nil then ;
  18605. SetResolverTypeExpr(ResolvedEl,btPointer,
  18606. FBaseTypes[btPointer],FBaseTypes[btPointer],[rrfReadable]);
  18607. end;
  18608. function TPasResolver.BI_Assert_OnGetCallCompatibility(
  18609. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18610. // check params of built-in procedure 'Assert'
  18611. // Assert(bool)
  18612. // Assert(bool,string)
  18613. var
  18614. Params: TParamsExpr;
  18615. Param: TPasExpr;
  18616. ParamResolved: TPasResolverResult;
  18617. begin
  18618. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18619. exit(cIncompatible);
  18620. Params:=TParamsExpr(Expr);
  18621. // first param: boolean
  18622. Param:=Params.Params[0];
  18623. ComputeElement(Param,ParamResolved,[]);
  18624. if not (rrfReadable in ParamResolved.Flags)
  18625. or not (ParamResolved.BaseType in btAllBooleans) then
  18626. exit(CheckRaiseTypeArgNo(20180117123819,1,Param,ParamResolved,'boolean',RaiseOnError));
  18627. // optional second parameter: string
  18628. if length(Params.Params)>1 then
  18629. begin
  18630. Param:=Params.Params[1];
  18631. ComputeElement(Param,ParamResolved,[]);
  18632. if not (rrfReadable in ParamResolved.Flags)
  18633. or not (ParamResolved.BaseType in btAllStringAndChars) then
  18634. exit(CheckRaiseTypeArgNo(20180117123932,2,Param,ParamResolved,'string',RaiseOnError));
  18635. end;
  18636. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  18637. end;
  18638. procedure TPasResolver.BI_Assert_OnFinishParamsExpr(
  18639. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18640. begin
  18641. FinishAssertCall(Proc,Params);
  18642. end;
  18643. function TPasResolver.BI_New_OnGetCallCompatibility(
  18644. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18645. var
  18646. Params: TParamsExpr;
  18647. Param: TPasExpr;
  18648. TypeEl, SubTypeEl: TPasType;
  18649. ParamResolved: TPasResolverResult;
  18650. begin
  18651. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18652. exit(cIncompatible);
  18653. Params:=TParamsExpr(Expr);
  18654. // first param: var PRecord
  18655. Param:=Params.Params[0];
  18656. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  18657. {$IFDEF VerbosePasResolver}
  18658. writeln('TPasResolver.BI_New_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  18659. {$ENDIF}
  18660. Result:=cIncompatible;
  18661. // Expr must be a variable
  18662. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18663. begin
  18664. if RaiseOnError then
  18665. RaiseVarExpected(20180425005303,Expr,ParamResolved.IdentEl);
  18666. exit;
  18667. end;
  18668. if ParamResolved.BaseType=btContext then
  18669. begin
  18670. TypeEl:=ParamResolved.LoTypeEl;
  18671. if TypeEl.ClassType=TPasPointerType then
  18672. begin
  18673. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  18674. if SubTypeEl.ClassType=TPasRecordType then
  18675. Result:=cExact;
  18676. end;
  18677. end;
  18678. if Result=cIncompatible then
  18679. exit(CheckRaiseTypeArgNo(20180425005421,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  18680. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18681. end;
  18682. procedure TPasResolver.BI_New_OnFinishParamsExpr(
  18683. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18684. begin
  18685. if Proc=nil then ;
  18686. FinishCallArgAccess(Params.Params[0],rraOutParam);
  18687. end;
  18688. function TPasResolver.BI_Dispose_OnGetCallCompatibility(
  18689. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18690. var
  18691. Params: TParamsExpr;
  18692. Param: TPasExpr;
  18693. TypeEl, SubTypeEl: TPasType;
  18694. ParamResolved: TPasResolverResult;
  18695. begin
  18696. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18697. exit(cIncompatible);
  18698. Params:=TParamsExpr(Expr);
  18699. // first param: var PRecord
  18700. Param:=Params.Params[0];
  18701. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  18702. {$IFDEF VerbosePasResolver}
  18703. writeln('TPasResolver.BI_Dispose_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  18704. {$ENDIF}
  18705. Result:=cIncompatible;
  18706. if (rrfReadable in ParamResolved.Flags) then
  18707. if ParamResolved.BaseType=btContext then
  18708. begin
  18709. TypeEl:=ParamResolved.LoTypeEl;
  18710. if TypeEl.ClassType=TPasPointerType then
  18711. begin
  18712. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  18713. if SubTypeEl.ClassType=TPasRecordType then
  18714. Result:=cExact;
  18715. end;
  18716. end;
  18717. if Result=cIncompatible then
  18718. exit(CheckRaiseTypeArgNo(20180425010620,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  18719. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18720. end;
  18721. procedure TPasResolver.BI_Dispose_OnFinishParamsExpr(
  18722. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18723. begin
  18724. if Proc=nil then ;
  18725. FinishCallArgAccess(Params.Params[0],rraRead);
  18726. end;
  18727. function TPasResolver.BI_Default_OnGetCallCompatibility(
  18728. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18729. var
  18730. Params: TParamsExpr;
  18731. Param: TPasExpr;
  18732. ParamResolved: TPasResolverResult;
  18733. Decl: TPasElement;
  18734. aType: TPasType;
  18735. begin
  18736. Result:=cIncompatible;
  18737. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18738. exit;
  18739. Params:=TParamsExpr(Expr);
  18740. // check type or var
  18741. Param:=Params.Params[0];
  18742. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  18743. Decl:=ParamResolved.IdentEl;
  18744. aType:=nil;
  18745. if (Decl<>nil) and (ParamResolved.LoTypeEl<>nil) then
  18746. begin
  18747. if Decl is TPasType then
  18748. aType:=TPasType(Decl)
  18749. else if Decl is TPasVariable then
  18750. aType:=TPasVariable(Decl).VarType
  18751. else if Decl.ClassType=TPasArgument then
  18752. aType:=TPasArgument(Decl).ArgType;
  18753. {$IFDEF VerbosePasResolver}
  18754. {AllowWriteln}
  18755. if aType=nil then
  18756. writeln('TPasResolver.BI_Default_OnGetCallCompatibility Decl=',GetObjName(Decl));
  18757. {AllowWriteln-}
  18758. {$ENDIF}
  18759. end;
  18760. if aType=nil then
  18761. begin
  18762. {$IFDEF VerbosePasResolver}
  18763. writeln('TPasResolver.BI_Default_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  18764. {$ENDIF}
  18765. RaiseMsg(20180501004009,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  18766. end;
  18767. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18768. end;
  18769. procedure TPasResolver.BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18770. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18771. var
  18772. Param: TPasExpr;
  18773. begin
  18774. if Proc=nil then ;
  18775. Param:=Params.Params[0];
  18776. ComputeElement(Param,ResolvedEl,[rcNoImplicitProc]);
  18777. ResolvedEl.Flags:=[rrfReadable];
  18778. ResolvedEl.IdentEl:=nil;
  18779. end;
  18780. procedure TPasResolver.BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  18781. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18782. var
  18783. Param: TPasExpr;
  18784. ParamResolved: TPasResolverResult;
  18785. TypeEl: TPasType;
  18786. EnumType: TPasEnumType;
  18787. i: Integer;
  18788. ArrayEl: TPasArrayType;
  18789. bt: TResolverBaseType;
  18790. MinInt, MaxInt: TMaxPrecInt;
  18791. begin
  18792. if Proc=nil then ;
  18793. Evaluated:=nil;
  18794. Param:=Params.Params[0];
  18795. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  18796. TypeEl:=ParamResolved.LoTypeEl;
  18797. if ParamResolved.BaseType=btContext then
  18798. begin
  18799. if TypeEl.ClassType=TPasArrayType then
  18800. begin
  18801. // array: []
  18802. RaiseNotYetImplemented(20180501005214,Param);
  18803. ArrayEl:=TPasArrayType(TypeEl);
  18804. if length(ArrayEl.Ranges)=0 then
  18805. begin
  18806. // dyn or open array
  18807. end
  18808. else
  18809. begin
  18810. // static array
  18811. end;
  18812. end
  18813. else if TypeEl.ClassType=TPasSetType then
  18814. begin
  18815. // set: first/last enum
  18816. TypeEl:=TPasSetType(TypeEl).EnumType;
  18817. if TypeEl.ClassType=TPasEnumType then
  18818. begin
  18819. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  18820. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,EnumType);
  18821. end
  18822. else
  18823. begin
  18824. {$IFDEF VerbosePasResolver}
  18825. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  18826. {$ENDIF}
  18827. RaiseNotYetImplemented(20180501005348,Params);
  18828. end;
  18829. end
  18830. else if TypeEl.ClassType=TPasEnumType then
  18831. begin
  18832. EnumType:=TPasEnumType(TypeEl);
  18833. i:=0;
  18834. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  18835. end;
  18836. end
  18837. else if (TypeEl is TPasUnresolvedSymbolRef)
  18838. and (TypeEl.CustomData is TResElDataBaseType) then
  18839. begin
  18840. // default(base type)
  18841. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  18842. bt:=GetActualBaseType(bt);
  18843. if bt in btAllBooleans then
  18844. Evaluated:=TResEvalBool.CreateValue(false)
  18845. {$ifdef HasInt64}
  18846. else if bt=btQWord then
  18847. Evaluated:=TResEvalInt.CreateValue(0)
  18848. {$endif}
  18849. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  18850. Evaluated:=TResEvalInt.CreateValue(MinInt)
  18851. {$ifdef FPC_HAS_CPSTRING}
  18852. else if bt in [btAnsiString,btShortString] then
  18853. Evaluated:=TResEvalString.CreateValue('')
  18854. {$endif}
  18855. else if bt in [btUnicodeString,btWideString] then
  18856. Evaluated:=TResEvalUTF16.CreateValue('')
  18857. {$ifdef FPC_HAS_CPSTRING}
  18858. else if bt=btAnsiChar then
  18859. Evaluated:=TResEvalString.CreateValue(#0)
  18860. {$endif}
  18861. else if bt=btWideChar then
  18862. Evaluated:=TResEvalUTF16.CreateValue(#0)
  18863. else if bt in btAllFloats then
  18864. Evaluated:=TResEvalFloat.CreateValue(0.0)
  18865. else
  18866. begin
  18867. {$IFDEF VerbosePasResolver}
  18868. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  18869. {$ENDIF}
  18870. RaiseNotYetImplemented(20180501005645,Params);
  18871. end;
  18872. end
  18873. else if ParamResolved.LoTypeEl is TPasRangeType then
  18874. begin
  18875. // e.g. type t = 2..10;
  18876. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,true,Param);
  18877. end
  18878. else if ParamResolved.BaseType=btSet then
  18879. begin
  18880. if ParamResolved.SubType=btContext then
  18881. begin
  18882. if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
  18883. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,TPasEnumType(ParamResolved.LoTypeEl))
  18884. else
  18885. begin
  18886. {$IFDEF VerbosePasResolver}
  18887. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  18888. {$ENDIF}
  18889. RaiseNotYetImplemented(20180501125138,Param);
  18890. end;
  18891. end
  18892. else
  18893. begin
  18894. {$IFDEF VerbosePasResolver}
  18895. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  18896. {$ENDIF}
  18897. RaiseNotYetImplemented(20180501125014,Param);
  18898. end;
  18899. end
  18900. else
  18901. begin
  18902. {$IFDEF VerbosePasResolver}
  18903. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  18904. {$ENDIF}
  18905. RaiseNotYetImplemented(20180501004839,Param);
  18906. end;
  18907. end;
  18908. constructor TPasResolver.Create;
  18909. begin
  18910. inherited Create;
  18911. FDefaultScope:=TPasDefaultScope.Create;
  18912. FPendingForwardProcs:=TFPList.Create;
  18913. FBaseTypeChar:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  18914. FBaseTypeString:={$ifdef FPC_HAS_CPSTRING}btAnsiString{$else}btUnicodeString{$endif};
  18915. FBaseTypeExtended:=btDouble;
  18916. FBaseTypeLength:={$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  18917. FDynArrayMinIndex:=0;
  18918. FDynArrayMaxIndex:=High(TMaxPrecInt);
  18919. cTGUIDToString:=cTypeConversion+1;
  18920. cStringToTGUID:=cTypeConversion+1;
  18921. cInterfaceToTGUID:=cTypeConversion+1;
  18922. cInterfaceToString:=cTypeConversion+2;
  18923. FScopeClass_Class:=TPasClassScope;
  18924. FScopeClass_InitialFinalization:=TPasInitialFinalizationScope;
  18925. FScopeClass_Module:=TPasModuleScope;
  18926. FScopeClass_Proc:=TPasProcedureScope;
  18927. FScopeClass_Section:=TPasSectionScope;
  18928. FScopeClass_WithExpr:=TPasWithExprScope;
  18929. fExprEvaluator:=TResExprEvaluator.Create;
  18930. fExprEvaluator.OnLog:=@OnExprEvalLog;
  18931. fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
  18932. fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
  18933. fExprEvaluator.OnRangeCheckEl:=@OnRangeCheckEl;
  18934. PushScope(FDefaultScope);
  18935. end;
  18936. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  18937. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  18938. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  18939. var
  18940. aScanner: TPascalScanner;
  18941. SrcPos: TPasSourcePos;
  18942. begin
  18943. // get source position for good error messages
  18944. aScanner:=CurrentParser.Scanner;
  18945. if (ASourceFilename='') or StoreSrcColumns then
  18946. begin
  18947. SrcPos.FileName:=aScanner.CurFilename;
  18948. SrcPos.Row:=aScanner.CurRow;
  18949. SrcPos.Column:=aScanner.CurColumn;
  18950. end
  18951. else
  18952. begin
  18953. SrcPos.FileName:=ASourceFilename;
  18954. SrcPos.Row:=ASourceLinenumber;
  18955. SrcPos.Column:=0;
  18956. end;
  18957. Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
  18958. end;
  18959. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  18960. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  18961. const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
  18962. var
  18963. El: TPasElement;
  18964. SrcY: integer;
  18965. SectionScope: TPasSectionScope;
  18966. begin
  18967. Result:=nil;
  18968. {$IFDEF VerbosePasResolver}
  18969. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  18970. {$ENDIF}
  18971. if (AParent=nil) and (FRootElement<>nil) then
  18972. RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
  18973. if ASrcPos.FileName='' then
  18974. begin
  18975. {$IFDEF VerbosePasResolver}
  18976. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  18977. {$ENDIF}
  18978. RaiseInternalError(20160922163541,'missing filename');
  18979. end;
  18980. SrcY:=ASrcPos.Row;
  18981. if StoreSrcColumns then
  18982. SrcY:=MangleSourceLineNumber(SrcY,ASrcPos.Column);
  18983. if AClass=TSelfExpr then
  18984. RaiseInternalError(20190131154235);
  18985. // create element
  18986. El:=AClass.Create(AName,AParent);
  18987. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('CreateElement');{$ENDIF}
  18988. FLastElement:=El;
  18989. try
  18990. El.Visibility:=AVisibility;
  18991. El.SourceFilename:=ASrcPos.FileName;
  18992. El.SourceLinenumber:=SrcY;
  18993. if FRootElement=nil then
  18994. begin
  18995. RootElement:=El as TPasModule;
  18996. if FStep=prsInit then
  18997. FStep:=prsParsing;
  18998. end
  18999. else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
  19000. begin
  19001. // first element of section
  19002. SectionScope:=TPasSectionScope(AParent.CustomData);
  19003. SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  19004. SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  19005. end;
  19006. if IsElementSkipped(El) then exit;
  19007. // create scope
  19008. if AClass.InheritsFrom(TPasExpr) then
  19009. // resolved when finished
  19010. else if (AClass=TPasVariable)
  19011. or (AClass=TPasConst) then
  19012. AddVariable(TPasVariable(El))
  19013. else if AClass=TPasResString then
  19014. AddResourceString(TPasResString(El))
  19015. else if (AClass=TPasProperty) then
  19016. AddProperty(TPasProperty(El))
  19017. else if AClass=TPasArgument then
  19018. AddArgument(TPasArgument(El))
  19019. else if AClass=TPasEnumType then
  19020. AddEnumType(TPasEnumType(El))
  19021. else if AClass=TPasEnumValue then
  19022. AddEnumValue(TPasEnumValue(El))
  19023. else if (AClass=TUnresolvedPendingRef) then
  19024. else if (AClass=TPasAliasType)
  19025. or (AClass=TPasTypeAliasType)
  19026. or (AClass=TPasClassOfType)
  19027. or (AClass=TPasPointerType)
  19028. or (AClass=TPasSetType)
  19029. or (AClass=TPasRangeType)
  19030. or (AClass=TPasSpecializeType) then
  19031. AddType(TPasType(El))
  19032. else if AClass=TPasArrayType then
  19033. AddArrayType(TPasArrayType(El),TypeParams)
  19034. else if (AClass=TPasProcedureType)
  19035. or (AClass=TPasFunctionType) then
  19036. AddProcedureType(TPasProcedureType(El),TypeParams)
  19037. else if AClass=TPasGenericTemplateType then
  19038. AddGenericTemplateType(TPasGenericTemplateType(El))
  19039. else if AClass=TPasStringType then
  19040. begin
  19041. AddType(TPasType(El));
  19042. {$ifdef FPC_HAS_CPSTRING}
  19043. if BaseTypes[btShortString]=nil then
  19044. {$endif}
  19045. RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
  19046. end
  19047. else if AClass=TPasRecordType then
  19048. AddRecordType(TPasRecordType(El),TypeParams)
  19049. else if AClass=TPasClassType then
  19050. AddClassType(TPasClassType(El),TypeParams)
  19051. else if AClass=TPasVariant then
  19052. else if AClass.InheritsFrom(TPasProcedure) then
  19053. AddProcedure(TPasProcedure(El),TypeParams)
  19054. else if AClass=TPasResultElement then
  19055. AddFunctionResult(TPasResultElement(El))
  19056. else if AClass=TProcedureBody then
  19057. AddProcedureBody(TProcedureBody(El))
  19058. else if AClass=TPasMethodResolution then
  19059. else if AClass=TPasImplExceptOn then
  19060. AddExceptOn(TPasImplExceptOn(El))
  19061. else if AClass=TPasImplWithDo then
  19062. AddWithDo(TPasImplWithDo(El))
  19063. else if AClass=TPasImplLabelMark then
  19064. else if AClass=TPasOverloadedProc then
  19065. else if (AClass=TInterfaceSection)
  19066. or (AClass=TImplementationSection)
  19067. or (AClass=TProgramSection)
  19068. or (AClass=TLibrarySection) then
  19069. AddSection(TPasSection(El))
  19070. else if (AClass=TPasModule)
  19071. or (AClass=TPasProgram)
  19072. or (AClass=TPasLibrary) then
  19073. AddModule(TPasModule(El))
  19074. else if AClass=TPasUsesUnit then
  19075. else if AClass=TInitializationSection then
  19076. AddInitialFinalizationSection(TInitializationSection(El))
  19077. else if AClass=TFinalizationSection then
  19078. AddInitialFinalizationSection(TFinalizationSection(El))
  19079. else if AClass=TPasImplCommand then
  19080. else if AClass.InheritsFrom(TPasImplBlock) then
  19081. // resolved when finished
  19082. else if AClass=TPasAttributes then
  19083. else if AClass=TPasUnresolvedUnitRef then
  19084. RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
  19085. else
  19086. RaiseNotYetImplemented(20160922163544,El);
  19087. Result:=El;
  19088. finally
  19089. if Result=nil then
  19090. El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  19091. end;
  19092. end;
  19093. function TPasResolver.FindModule(const AName: String; NameExpr,
  19094. InFileExpr: TPasExpr): TPasModule;
  19095. var
  19096. InFilename, FileUnitName: String;
  19097. begin
  19098. if InFileExpr<>nil then
  19099. begin
  19100. InFilename:=GetUsesUnitInFilename(InFileExpr);
  19101. if InFilename='' then
  19102. RaiseXExpectedButYFound(20180222001220,
  19103. 'file path','empty string',InFileExpr);
  19104. if msDelphi in CurrentParser.CurrentModeswitches then
  19105. begin
  19106. // in delphi the last unit name must match the filename
  19107. FileUnitName:=ChangeFileExt(ExtractFileName(InFilename),'');
  19108. if CompareText(AName,FileUnitName)<>0 then
  19109. RaiseXExpectedButYFound(20180222230400,AName,FileUnitName,InFileExpr);
  19110. end;
  19111. end;
  19112. Result:=FindUnit(AName,InFilename,NameExpr,InFileExpr);
  19113. if Result=nil then
  19114. begin
  19115. if InFileExpr<>nil then
  19116. RaiseMsg(20180223140434,nCantFindUnitX,sCantFindUnitX,[InFilename],InFileExpr)
  19117. else
  19118. RaiseMsg(20180223140409,nCantFindUnitX,sCantFindUnitX,[AName],NameExpr);
  19119. end;
  19120. end;
  19121. function TPasResolver.FindElement(const aName: String): TPasElement;
  19122. begin
  19123. Result:=FindElementFor(aName,nil,0);
  19124. end;
  19125. function TPasResolver.FindElementFor(const aName: String; AParent: TPasElement;
  19126. TypeParamCount: integer): TPasElement;
  19127. // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
  19128. var
  19129. p: SizeInt;
  19130. RightPath, CurName, LeftPath: String;
  19131. NeedPop: Boolean;
  19132. CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
  19133. CurSection: TPasSection;
  19134. i: Integer;
  19135. UsesUnit: TPasUsesUnit;
  19136. CurScope: TPasDotBaseScope;
  19137. FindData: TPRFindData;
  19138. begin
  19139. Result:=nil;
  19140. ErrorEl:=nil; // use nil to use scanner position as error position
  19141. RightPath:=aName;
  19142. LeftPath:='';
  19143. p:=1;
  19144. CurScopeEl:=nil;
  19145. repeat
  19146. p:=Pos('.',RightPath);
  19147. if p<1 then
  19148. begin
  19149. CurName:=RightPath;
  19150. RightPath:='';
  19151. end
  19152. else
  19153. begin
  19154. CurName:=LeftStr(RightPath,p-1);
  19155. Delete(RightPath,1,p);
  19156. if RightPath='' then
  19157. RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  19158. end;
  19159. if LeftPath='' then
  19160. LeftPath:=CurName
  19161. else
  19162. LeftPath:=LeftPath+'.'+CurName;
  19163. {$IFDEF VerbosePasResolver}
  19164. {AllowWriteln}
  19165. if RightPath<>'' then
  19166. writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
  19167. {AllowWriteln-}
  19168. {$ENDIF}
  19169. if not IsValidIdent(CurName) then
  19170. RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
  19171. if CurScopeEl<>nil then
  19172. begin
  19173. NeedPop:=true;
  19174. if CurScopeEl is TPasType then
  19175. begin
  19176. CurScope:=PushDotScope(TPasType(CurScopeEl));
  19177. if CurScope=nil then
  19178. RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19179. ['.',LeftPath],ErrorEl);
  19180. end
  19181. else if CurScopeEl is TPasModule then
  19182. PushModuleDotScope(TPasModule(CurScopeEl))
  19183. else
  19184. RaiseMsg(20170504174021,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19185. ['.',LeftPath],ErrorEl);
  19186. end
  19187. else
  19188. NeedPop:=false;
  19189. if (TypeParamCount>0) and (RightPath='') then
  19190. begin
  19191. NextEl:=FindGenericEl(CurName,TypeParamCount,FindData,ErrorEl);
  19192. if (FindData.StartScope<>nil) and (FindData.StartScope.ClassType=ScopeClass_WithExpr)
  19193. and (wesfNeedTmpVar in TPasWithExprScope(FindData.StartScope).Flags) then
  19194. RaiseInternalError(20190801104033); // caller forgot to handle "With"
  19195. end
  19196. else
  19197. NextEl:=FindElementWithoutParams(CurName,ErrorEl,true);
  19198. {$IFDEF VerbosePasResolver}
  19199. //if RightPath<>'' then
  19200. // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
  19201. {$ENDIF}
  19202. if NextEl is TPasModule then
  19203. begin
  19204. if CurScopeEl is TPasModule then
  19205. RaiseXExpectedButYFound(20170328001619,'class',GetElementTypeName(NextEl)+' '+NextEl.Name,ErrorEl);
  19206. if Pos('.',NextEl.Name)>0 then
  19207. begin
  19208. // dotted module name -> check if the full module name is in aName
  19209. if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
  19210. begin
  19211. if CompareText(NextEl.Name,aName)=0 then
  19212. RaiseXExpectedButYFound(20170504165825,'type',GetElementTypeName(NextEl),ErrorEl)
  19213. else
  19214. RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
  19215. end;
  19216. RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
  19217. end;
  19218. CurScopeEl:=NextEl;
  19219. end
  19220. else if NextEl.ClassType=TPasUsesUnit then
  19221. begin
  19222. // the first name of a used unit matches -> find longest match
  19223. CurSection:=NextEl.Parent as TPasSection;
  19224. i:=length(CurSection.UsesClause)-1;
  19225. BestEl:=nil;
  19226. while i>=0 do
  19227. begin
  19228. UsesUnit:=CurSection.UsesClause[i];
  19229. CurName:=UsesUnit.Name;
  19230. if IsDottedIdentifierPrefix(CurName,aName)
  19231. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19232. BestEl:=UsesUnit;
  19233. dec(i);
  19234. if (i<0) and (CurSection.ClassType=TImplementationSection) then
  19235. begin
  19236. CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
  19237. if CurSection=nil then break;
  19238. i:=length(CurSection.UsesClause)-1;
  19239. end;
  19240. end;
  19241. // check module name too
  19242. CurName:=RootElement.Name;
  19243. if IsDottedIdentifierPrefix(CurName,aName)
  19244. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19245. BestEl:=RootElement;
  19246. if BestEl=nil then
  19247. RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
  19248. RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
  19249. if BestEl.ClassType=TPasUsesUnit then
  19250. CurScopeEl:=TPasUsesUnit(BestEl).Module
  19251. else
  19252. CurScopeEl:=BestEl;
  19253. end
  19254. else if NextEl<>nil then
  19255. CurScopeEl:=NextEl
  19256. else
  19257. RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
  19258. // restore scope
  19259. if NeedPop then
  19260. PopScope;
  19261. if RightPath='' then
  19262. exit(NextEl);
  19263. until false;
  19264. if AParent=nil then ;;
  19265. end;
  19266. function TPasResolver.FindElementWithoutParams(const AName: String;
  19267. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  19268. var
  19269. Data: TPRFindData;
  19270. begin
  19271. Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs);
  19272. if Data.Found=nil then exit; // forward type: class-of or ^
  19273. CheckFoundElement(Data,nil);
  19274. if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
  19275. and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
  19276. RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
  19277. end;
  19278. function TPasResolver.FindElementWithoutParams(const AName: String; out
  19279. Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean
  19280. ): TPasElement;
  19281. var
  19282. Abort: boolean;
  19283. begin
  19284. //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
  19285. Result:=Nil;
  19286. Abort:=false;
  19287. Data:=Default(TPRFindData);
  19288. Data.ErrorPosEl:=ErrorPosEl;
  19289. IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort);
  19290. Result:=Data.Found;
  19291. if Result=nil then
  19292. begin
  19293. if (ErrorPosEl=nil) and (LastElement<>nil) then
  19294. begin
  19295. if (LastElement.ClassType=TPasClassOfType)
  19296. and (TPasClassOfType(LastElement).DestType=nil) then
  19297. begin
  19298. // 'class of' of a not yet defined class
  19299. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  19300. CurrentParser.CurSourcePos);
  19301. exit;
  19302. end
  19303. else if (LastElement.ClassType=TPasPointerType)
  19304. and (TPasPointerType(LastElement).DestType=nil) then
  19305. begin
  19306. // pointer of a not yet defined type
  19307. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  19308. CurrentParser.CurSourcePos);
  19309. exit;
  19310. end
  19311. end;
  19312. RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
  19313. end;
  19314. if NoProcsWithArgs and (Result is TPasProcedure)
  19315. and ProcNeedsParams(TPasProcedure(Result).ProcType)
  19316. then
  19317. // proc needs parameters
  19318. RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
  19319. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
  19320. end;
  19321. function TPasResolver.FindFirstEl(const AName: String; out Data: TPRFindData;
  19322. ErrorPosEl: TPasElement): TPasElement;
  19323. var
  19324. Abort: boolean;
  19325. begin
  19326. Abort:=false;
  19327. Data:=Default(TPRFindData);
  19328. Data.ErrorPosEl:=ErrorPosEl;
  19329. IterateElements(AName,@OnFindFirst,@Data,Abort);
  19330. Result:=Data.Found;
  19331. end;
  19332. procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  19333. // Input: El is TPasUsesUnit
  19334. // Output: El is either a TPasUsesUnit or the root module
  19335. var
  19336. CurUsesUnit: TPasUsesUnit;
  19337. BestEl: TPasElement;
  19338. aName, CurName: String;
  19339. Clause: TPasUsesClause;
  19340. i: Integer;
  19341. Section: TPasSection;
  19342. begin
  19343. {$IFDEF VerbosePasResolver}
  19344. //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
  19345. {$ENDIF}
  19346. if not (El is TPasUsesUnit) then
  19347. RaiseInternalError(20170503000945);
  19348. aName:=GetNameExprValue(Expr);
  19349. if aName='' then
  19350. RaiseNotYetImplemented(20170503110217,Expr);
  19351. repeat
  19352. Expr:=GetNextDottedExpr(Expr);
  19353. if Expr=nil then break;
  19354. CurName:=GetNameExprValue(Expr);
  19355. if CurName='' then
  19356. RaiseNotYetImplemented(20170502164242,Expr);
  19357. aName:=aName+'.'+CurName;
  19358. until false;
  19359. {$IFDEF VerbosePasResolver}
  19360. //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
  19361. {$ENDIF}
  19362. // search in uses clause
  19363. BestEl:=nil;
  19364. Section:=TPasUsesUnit(El).Parent as TPasSection;
  19365. repeat
  19366. Clause:=Section.UsesClause;
  19367. for i:=0 to length(Clause)-1 do
  19368. begin
  19369. CurUsesUnit:=Clause[i];
  19370. CurName:=CurUsesUnit.Name;
  19371. if IsDottedIdentifierPrefix(CurName,aName)
  19372. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19373. BestEl:=CurUsesUnit; // a better match
  19374. end;
  19375. if Section is TImplementationSection then
  19376. begin
  19377. // search in interface uses clause too
  19378. Section:=(Section.Parent as TPasModule).InterfaceSection;
  19379. end
  19380. else
  19381. break;
  19382. until Section=nil;
  19383. {$IFDEF VerbosePasResolver}
  19384. //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
  19385. {$ENDIF}
  19386. // check module name
  19387. CurName:=El.GetModule.Name;
  19388. if IsDottedIdentifierPrefix(CurName,aName)
  19389. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19390. BestEl:=El.GetModule; // a better match
  19391. if BestEl=nil then
  19392. begin
  19393. // no dotted module name fits the expression
  19394. RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
  19395. end;
  19396. El:=BestEl;
  19397. {$IFDEF VerbosePasResolver}
  19398. //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
  19399. {$ENDIF}
  19400. end;
  19401. function TPasResolver.FindGenericEl(const AName: string;
  19402. TemplateCount: integer; out Find: TPRFindData; ErrorPosEl: TPasElement
  19403. ): TPasElement;
  19404. var
  19405. Data: TPRFindGenericData;
  19406. Abort: boolean;
  19407. begin
  19408. Data:=Default(TPRFindGenericData);
  19409. Data.TemplateCount:=TemplateCount;
  19410. Data.Find.ErrorPosEl:=ErrorPosEl;
  19411. Abort:=false;
  19412. IterateElements(AName,@OnFindFirst_GenericEl,@Data,Abort);
  19413. Find:=Data.Find;
  19414. Result:=Find.Found;
  19415. if Result=nil then
  19416. begin
  19417. {$IFDEF VerbosePasResolver}
  19418. WriteScopesShort('TPasResolver.FindGenericType');
  19419. {$ENDIF}
  19420. RaiseMsg(20190801104759,nIdentifierNotFound,sIdentifierNotFound,[AName+GetGenericParamCommas(TemplateCount)],ErrorPosEl);
  19421. end;
  19422. CheckFoundElement(Find,nil);
  19423. end;
  19424. procedure TPasResolver.IterateElements(const aName: string;
  19425. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  19426. var Abort: boolean);
  19427. var
  19428. i: Integer;
  19429. Scope: TPasScope;
  19430. begin
  19431. for i:=FScopeCount-1 downto 0 do
  19432. begin
  19433. Scope:=Scopes[i];
  19434. Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
  19435. if Abort then
  19436. exit;
  19437. if Scope is TPasSubExprScope then break;
  19438. end;
  19439. end;
  19440. procedure TPasResolver.CheckFoundElement(
  19441. const FindData: TPRFindData; Ref: TResolvedReference);
  19442. // check visibility rules
  19443. // Call this method after finding an element by searching the scopes.
  19444. function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
  19445. // returns true of aRef is a TPasVariable that inherits its const from parent.
  19446. // For example
  19447. // type TRecord = record
  19448. // a: word; // inherits const
  19449. // const b: word = 3; // does not inherit const
  19450. // class var c: word; // does not inherit const
  19451. // end;
  19452. // procedure DoIt(const r:TRecord)
  19453. var
  19454. El: TPasElement;
  19455. begin
  19456. El:=aRef.Declaration;
  19457. Result:=(El.ClassType=TPasVariable)
  19458. and (TPasVariable(El).VarModifiers*[vmClass, vmStatic]=[]);
  19459. //writeln('IsFieldInheritingConst ',GetObjName(El),' ',Result,' vmClass=',vmClass in TPasVariable(El).VarModifiers);
  19460. end;
  19461. var
  19462. Proc: TPasProcedure;
  19463. StartScope: TPasScope;
  19464. OnlyTypeMembers, IsClassOf: Boolean;
  19465. C: TClass;
  19466. ClassRecScope: TPasClassOrRecordScope;
  19467. i: Integer;
  19468. AbstractProcs: TArrayOfPasProcedure;
  19469. TypeEl: TPasType;
  19470. begin
  19471. StartScope:=FindData.StartScope;
  19472. OnlyTypeMembers:=false;
  19473. IsClassOf:=false;
  19474. if StartScope is TPasDotBaseScope then
  19475. begin
  19476. OnlyTypeMembers:=TPasDotBaseScope(StartScope).OnlyTypeMembers;
  19477. if StartScope.ClassType=TPasDotClassScope then
  19478. IsClassOf:=TPasDotClassScope(StartScope).IsClassOf;
  19479. if Ref<>nil then
  19480. begin
  19481. Include(Ref.Flags,rrfDotScope);
  19482. if TPasDotBaseScope(StartScope).ConstParent
  19483. and IsFieldInheritingConst(Ref) then
  19484. Include(Ref.Flags,rrfConstInherited);
  19485. end;
  19486. end
  19487. else if StartScope.ClassType=ScopeClass_WithExpr then
  19488. begin
  19489. OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
  19490. IsClassOf:=wesfIsClassOf in TPasWithExprScope(StartScope).Flags;
  19491. if Ref<>nil then
  19492. begin
  19493. Include(Ref.Flags,rrfDotScope);
  19494. if (wesfConstParent in TPasWithExprScope(StartScope).Flags)
  19495. and IsFieldInheritingConst(Ref) then
  19496. Include(Ref.Flags,rrfConstInherited);
  19497. end;
  19498. end
  19499. else if StartScope.ClassType=FScopeClass_Proc then
  19500. begin
  19501. Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
  19502. //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
  19503. if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
  19504. OnlyTypeMembers:=true;
  19505. end;
  19506. //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
  19507. // ' StartIsDot=',StartScope is TPasDotBaseScope,
  19508. // ' OnlyTypeMembers=',(StartScope is TPasDotBaseScope)
  19509. // and TPasDotBaseScope(StartScope).OnlyTypeMembers,
  19510. // ' FindData.Found=',GetObjName(FindData.Found));
  19511. if OnlyTypeMembers then
  19512. begin
  19513. //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
  19514. // and (vmClass in TPasVariable(FindData.Found).VarModifiers));
  19515. // only class vars/procs allowed
  19516. if FindData.Found.ClassType=TPasConstructor then
  19517. // constructor: ok
  19518. else if IsClassMethod(FindData.Found)
  19519. then
  19520. // class proc: ok
  19521. else if (FindData.Found is TPasVariable)
  19522. and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
  19523. // class var/const/property: ok
  19524. else if FindData.Found is TPasType then
  19525. // nested type: ok
  19526. else if FindData.Found is TPasEnumValue then
  19527. // e.g. enumtype.enumvalue: ok
  19528. else
  19529. begin
  19530. RaiseMsg(20170216152348,nCannotAccessThisMemberFromAX,
  19531. sCannotAccessThisMemberFromAX,[GetElementTypeName(FindData.Found.Parent)],FindData.ErrorPosEl);
  19532. end;
  19533. end
  19534. else if (proExtClassInstanceNoTypeMembers in Options)
  19535. and (StartScope is TPasDotClassScope)
  19536. and TPasClassType(TPasDotClassScope(StartScope).ClassRecScope.Element).IsExternal then
  19537. begin
  19538. // e.g. ExtClassInstance.Member
  19539. C:=FindData.Found.ClassType;
  19540. if (C=TPasProcedure) or (C=TPasFunction) then
  19541. // ok
  19542. else if (C=TPasConst) then
  19543. // ok
  19544. else if ((C=TPasVariable) or (C=TPasProperty))
  19545. and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
  19546. // ok
  19547. else if IsHelper(FindData.Found.Parent) then
  19548. // ok
  19549. else
  19550. begin
  19551. RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
  19552. sExternalClassInstanceCannotAccessStaticX,
  19553. [GetElementTypeName(FindData.Found)+' '+FindData.Found.Name],
  19554. FindData.ErrorPosEl);
  19555. end;
  19556. end;
  19557. if (FindData.Found is TPasProcedure) then
  19558. begin
  19559. Proc:=TPasProcedure(FindData.Found);
  19560. if Proc.IsVirtual or Proc.IsOverride then
  19561. begin
  19562. if StartScope.ClassType=TPasInheritedScope then
  19563. begin
  19564. // inherited expr -> call directly
  19565. if Proc.IsAbstract then
  19566. RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
  19567. sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
  19568. end
  19569. else
  19570. begin
  19571. // call via virtual method table
  19572. if Ref<>nil then
  19573. Ref.Flags:=Ref.Flags+[rrfVMT];
  19574. end;
  19575. end;
  19576. // constructor: NewInstance or normal call
  19577. // it is a NewInstance iff the scope is a class/record, e.g. TObject.Create
  19578. if (Proc.ClassType=TPasConstructor)
  19579. and (Ref<>nil) then
  19580. begin
  19581. if OnlyTypeMembers then
  19582. Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
  19583. // store the class in Ref.Context
  19584. if Ref.Context<>nil then
  19585. RaiseInternalError(20170131141936);
  19586. Ref.Context:=TResolvedRefCtxConstructor.Create;
  19587. TypeEl:=nil;
  19588. ClassRecScope:=nil;
  19589. C:=StartScope.ClassType;
  19590. if C.InheritsFrom(TPasDotClassOrRecordScope) then
  19591. ClassRecScope:=TPasDotClassOrRecordScope(StartScope).ClassRecScope
  19592. else if C=ScopeClass_WithExpr then
  19593. begin
  19594. ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope;
  19595. if ClassRecScope=nil then
  19596. TypeEl:=TPasWithExprScope(StartScope).Scope.Element as TPasType;
  19597. end
  19598. else if C=ScopeClass_Procedure then
  19599. ClassRecScope:=TPasProcedureScope(StartScope).ClassRecScope
  19600. else if C=TPasDotHelperScope then
  19601. TypeEl:=NoNil(TPasDotHelperScope(StartScope).Element) as TPasType
  19602. else
  19603. RaiseInternalError(20170131150855,GetObjName(StartScope));
  19604. if TypeEl<>nil then
  19605. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl
  19606. else
  19607. begin
  19608. if ClassRecScope=nil then
  19609. RaiseInternalError(20190123120156,GetObjName(StartScope));
  19610. TypeEl:=ClassRecScope.Element as TPasMembersType;
  19611. if (TypeEl.ClassType=TPasClassType)
  19612. and (TPasClassType(TypeEl).HelperForType<>nil) then
  19613. TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
  19614. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
  19615. if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
  19616. begin
  19617. if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
  19618. LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
  19619. sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
  19620. else
  19621. begin
  19622. AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
  19623. if (length(AbstractProcs)>0) then
  19624. begin
  19625. if IsClassOf then
  19626. // aClass.Create: do not warn
  19627. else
  19628. for i:=0 to length(AbstractProcs)-1 do
  19629. LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
  19630. sConstructingClassXWithAbstractMethodY,
  19631. [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
  19632. end;
  19633. end;
  19634. end;
  19635. end;
  19636. end;
  19637. {$IFDEF VerbosePasResolver}
  19638. {AllowWriteln}
  19639. if (Proc.ClassType=TPasConstructor) then
  19640. begin
  19641. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  19642. if Ref=nil then
  19643. write(' no ref!')
  19644. else
  19645. begin
  19646. write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
  19647. ' StartScope=',GetObjName(StartScope),
  19648. ' OnlyTypeMembers=',OnlyTypeMembers);
  19649. end;
  19650. writeln;
  19651. end;
  19652. {AllowWriteln-}
  19653. {$ENDIF}
  19654. // destructor: FreeInstance or normal call
  19655. // it is a normal call if 'inherited'
  19656. if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
  19657. if not (StartScope is TPasInheritedScope) then
  19658. Ref.Flags:=Ref.Flags+[rrfFreeInstance];
  19659. {$IFDEF VerbosePasResolver}
  19660. {AllowWriteln}
  19661. if (Proc.ClassType=TPasDestructor) then
  19662. begin
  19663. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  19664. if Ref=nil then
  19665. write(' no ref!')
  19666. else
  19667. begin
  19668. write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
  19669. ' StartScope=',GetObjName(StartScope));
  19670. if StartScope is TPasDotClassOrRecordScope then
  19671. write(' InheritedExpr=',StartScope is TPasInheritedScope);
  19672. end;
  19673. writeln;
  19674. end;
  19675. {AllowWriteln-}
  19676. {$ENDIF}
  19677. end;
  19678. CheckFoundElementVisibility(FindData,Ref);
  19679. end;
  19680. procedure TPasResolver.CheckFoundElementVisibility(const FindData: TPRFindData;
  19681. Ref: TResolvedReference);
  19682. var
  19683. Context: TPasElement;
  19684. FoundContext: TPasMembersType;
  19685. CurScope: TPasScope;
  19686. {$IFDEF VerbosePasResolver}
  19687. i: Integer;
  19688. {$ENDIF}
  19689. begin
  19690. // check class visibility
  19691. if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
  19692. begin
  19693. Context:=GetVisibilityContext;
  19694. FoundContext:=FindData.Found.Parent as TPasMembersType;
  19695. case FindData.Found.Visibility of
  19696. visPrivate:
  19697. // private members can only be accessed in same module
  19698. if FoundContext.GetModule<>Context.GetModule then
  19699. RaiseMsg(20170216152354,nCantAccessXMember,sCantAccessXMember,
  19700. ['private',FindData.Found.Name],FindData.ErrorPosEl);
  19701. visProtected:
  19702. begin
  19703. // protected members can only be accessed in same module
  19704. // or descendant classes
  19705. CurScope:=TopScope;
  19706. if FoundContext.GetModule=Context.GetModule then
  19707. // same module -> ok
  19708. else if (Context is TPasType)
  19709. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  19710. // context in class or descendant
  19711. else if (CurScope is TPasDotClassOrRecordScope)
  19712. and (TPasDotClassOrRecordScope(CurScope).ClassRecScope.Element.GetModule=Context.GetModule) then
  19713. // e.g. aClassInThisModule.identifier
  19714. else if (CurScope is TPasWithExprScope)
  19715. and (TPasWithExprScope(CurScope).Scope.Element<>nil)
  19716. and (TPasWithExprScope(CurScope).Scope.Element.GetModule=Context.GetModule) then
  19717. // e.g. with aClassInThisModule do identifier
  19718. else
  19719. RaiseMsg(20170216152356,nCantAccessXMember,sCantAccessXMember,
  19720. ['protected',FindData.Found.Name],FindData.ErrorPosEl);
  19721. end;
  19722. visStrictPrivate:
  19723. // strict private members can only be accessed in their class
  19724. if Context<>FoundContext then
  19725. begin
  19726. {$IFDEF VerbosePasResolver}
  19727. {AllowWriteln}
  19728. writeln('TPasResolver.CheckFoundElement Context=',GetElementDbgPath(Context),' FoundContext=',GetElementDbgPath(FoundContext));
  19729. for i:=ScopeCount-1 downto 0 do
  19730. writeln(' ',i,' ',Scopes[i].ClassName,' Element=',GetObjName(Scopes[i].Element),' VisibilityContext=',GetObjName(Scopes[i].VisibilityContext));
  19731. {AllowWriteln-}
  19732. {$ENDIF}
  19733. RaiseMsg(20170216152357,nCantAccessXMember,sCantAccessXMember,
  19734. ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
  19735. end;
  19736. visStrictProtected:
  19737. // strict protected members can only be accessed in their and descendant classes
  19738. if (Context is TPasType)
  19739. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  19740. // context in class or descendant
  19741. else
  19742. RaiseMsg(20170216152400,nCantAccessXMember,sCantAccessXMember,
  19743. ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
  19744. end;
  19745. end;
  19746. if Ref=nil then ;
  19747. end;
  19748. function TPasResolver.GetVisibilityContext: TPasElement;
  19749. var
  19750. i: Integer;
  19751. begin
  19752. for i:=ScopeCount-1 downto 0 do
  19753. begin
  19754. Result:=Scopes[i].VisibilityContext;
  19755. if Result<>nil then exit;
  19756. end;
  19757. Result:=nil;
  19758. end;
  19759. procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
  19760. begin
  19761. case ScopeType of
  19762. stWithExpr: PushWithExprScope(El as TPasExpr);
  19763. else
  19764. RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
  19765. end;
  19766. end;
  19767. procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
  19768. begin
  19769. if IsElementSkipped(El) then exit;
  19770. case ScopeType of
  19771. stModule: FinishModule(El as TPasModule);
  19772. stUsesClause: FinishUsesClause;
  19773. stTypeSection: FinishTypeSection(El);
  19774. stTypeDef: FinishTypeDef(El as TPasType);
  19775. stResourceString: FinishResourcestring(El as TPasResString);
  19776. stProcedure: FinishProcedure(El as TPasProcedure);
  19777. stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
  19778. stExceptOnExpr: FinishExceptOnExpr;
  19779. stExceptOnStatement: FinishExceptOnStatement;
  19780. stWithExpr: FinishWithDo(El as TPasImplWithDo);
  19781. stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop);
  19782. stDeclaration: FinishDeclaration(El);
  19783. stAncestors: FinishAncestors(El as TPasClassType);
  19784. stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
  19785. else
  19786. RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
  19787. end;
  19788. end;
  19789. procedure TPasResolver.FinishTypeAlias(var NewType: TPasType);
  19790. var
  19791. TypeEl, DestType: TPasType;
  19792. AncestorClass, aClass: TPasClassType;
  19793. Scope: TPasIdentifierScope;
  19794. OldType: TPasTypeAliasType;
  19795. LocalScope: TPasScope;
  19796. begin
  19797. DestType:=TPasTypeAliasType(NewType).DestType;
  19798. TypeEl:=ResolveSimpleAliasType(DestType);
  19799. if TypeEl is TPasClassType then
  19800. begin
  19801. // change "=type aClassType" to "=class(aClassType)"
  19802. // or change "=type aInterfaceType" to "=interface(aInterfaceType)"
  19803. AncestorClass := TPasClassType(TypeEl);
  19804. // remove aliastype from scope
  19805. LocalScope:=GetLocalScope;
  19806. Scope:=LocalScope as TPasIdentifierScope;
  19807. Scope.RemoveLocalIdentifier(NewType);
  19808. // create class or interface
  19809. aClass := TPasClassType(CreateElement(TPasClassType,
  19810. NewType.Name,NewType.Parent,NewType.Visibility,
  19811. NewType.SourceFilename,NewType.SourceLinenumber));
  19812. aClass.ObjKind := AncestorClass.ObjKind;
  19813. // release old alias type
  19814. OldType := TPasTypeAliasType(NewType);
  19815. NewType := aClass;
  19816. TPasTypeAliasType(OldType).DestType:=nil; // clear reference
  19817. OldType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  19818. // set ancestor
  19819. aClass.AncestorType := DestType;
  19820. {$IFDEF CheckPasTreeRefCount}DestType.ChangeRefId('ResolveTypeReference','TPasClassType.AncestorType');{$ENDIF}
  19821. FinishScope(stAncestors,aClass);
  19822. end;
  19823. end;
  19824. function TPasResolver.IsUnitIntfFinished(AModule: TPasModule): boolean;
  19825. var
  19826. CurIntf: TInterfaceSection;
  19827. begin
  19828. CurIntf:=AModule.InterfaceSection;
  19829. Result:=(CurIntf<>nil)
  19830. and (CurIntf.CustomData is TPasSectionScope)
  19831. and TPasSectionScope(CurIntf.CustomData).Finished;
  19832. end;
  19833. procedure TPasResolver.NotifyPendingUsedInterfaces;
  19834. // called after unit interface is ready to be used by other modules
  19835. var
  19836. ModuleScope: TPasModuleScope;
  19837. i: Integer;
  19838. PendingResolver: TPasResolver;
  19839. PendingSection: TPasSection;
  19840. begin
  19841. // call all PendingResolvers
  19842. // Note that a waiting resolver might continue parsing
  19843. ModuleScope:=RootElement.CustomData as TPasModuleScope;
  19844. i:=ModuleScope.PendingResolvers.Count-1;
  19845. while i>=0 do
  19846. begin
  19847. PendingResolver:=TObject(ModuleScope.PendingResolvers[i]) as TPasResolver;
  19848. PendingSection:=PendingResolver.GetLastSection;
  19849. {$IFDEF VerbosePasResolver}
  19850. writeln('TPasResolver.NotifyPendingUsedInterfaces "',ModuleScope.Element.Name,'" Pending="',PendingResolver.RootElement.Name,'"');
  19851. {$ENDIF}
  19852. if PendingSection=nil then
  19853. RaiseInternalError(20180305141421);
  19854. PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
  19855. dec(i);
  19856. if i>=ModuleScope.PendingResolvers.Count then
  19857. i:=ModuleScope.PendingResolvers.Count-1;
  19858. end;
  19859. end;
  19860. function TPasResolver.GetPendingUsedInterface(Section: TPasSection
  19861. ): TPasUsesUnit;
  19862. var
  19863. i: Integer;
  19864. UseUnit: TPasUsesUnit;
  19865. begin
  19866. Result:=nil;
  19867. for i:=0 to length(Section.UsesClause)-1 do
  19868. begin
  19869. UseUnit:=Section.UsesClause[i];
  19870. if not (UseUnit.Module is TPasModule) then continue;
  19871. if not IsUnitIntfFinished(TPasModule(UseUnit.Module)) then
  19872. exit(UseUnit);
  19873. end;
  19874. end;
  19875. function TPasResolver.CheckPendingUsedInterface(Section: TPasSection): boolean;
  19876. var
  19877. PendingModule: TPasModule;
  19878. PendingModuleScope: TPasModuleScope;
  19879. List: TFPList;
  19880. WasPending: Boolean;
  19881. begin
  19882. {$IFDEF VerbosePasResolver}
  19883. //writeln('TPasResolver.CheckPendingUsedInterface START "',RootElement.Name,'" Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
  19884. {$ENDIF}
  19885. WasPending:=Section.PendingUsedIntf<>nil;
  19886. if WasPending then
  19887. begin
  19888. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  19889. if not IsUnitIntfFinished(PendingModule) then
  19890. exit; // still pending
  19891. // other unit interface is finished
  19892. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  19893. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" UnitIntf finished of "',PendingModule.Name,'"');
  19894. {$ENDIF}
  19895. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  19896. PendingModuleScope.PendingResolvers.Remove(Self);
  19897. Section.PendingUsedIntf:=nil;
  19898. end;
  19899. Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
  19900. //writeln('TPasResolver.CheckPendingUsedInterface ',GetObjName(RootElement),' Section=',GetObjName(Section),' PendingUsedIntf=',GetObjName(Section.PendingUsedIntf));
  19901. if Section.PendingUsedIntf<>nil then
  19902. begin
  19903. // module not yet finished due to pending used interfaces
  19904. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  19905. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  19906. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  19907. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" waiting for unit intf of "',PendingModule.Name,'"');
  19908. {$ENDIF}
  19909. List:=PendingModuleScope.PendingResolvers;
  19910. if List.IndexOf(Self)<0 then
  19911. List.Add(Self);
  19912. Result:=not WasPending;
  19913. end
  19914. else
  19915. begin
  19916. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  19917. {AllowWriteln}
  19918. if WasPending then
  19919. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" uses section complete: ',Section.ClassName);
  19920. {AllowWriteln-}
  19921. {$ENDIF}
  19922. Result:=WasPending;
  19923. if Result then
  19924. UsedInterfacesFinished(Section);
  19925. end;
  19926. end;
  19927. procedure TPasResolver.UsedInterfacesFinished(Section: TPasSection);
  19928. // if there is a unit cycle that stopped parsing this unit
  19929. // this method is called after the needed used unit interfaces have finished
  19930. begin
  19931. {$IFDEF VerbosePasResolver}
  19932. writeln('TPasResolver.UsesSectionFinished ',Section.ElementTypeName,' "',RootElement.Name,'"...');
  19933. {$ENDIF}
  19934. CurrentParser.ParseContinue;
  19935. if Section=nil then ;
  19936. end;
  19937. function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
  19938. // called by the parser when reading DoParseConstValueExpression
  19939. var
  19940. C: TClass;
  19941. V: TPasVariable;
  19942. TypeEl: TPasType;
  19943. begin
  19944. Result:=false;
  19945. if El=nil then exit;
  19946. C:=El.ClassType;
  19947. if (C=TPasConst) or (C=TPasVariable) then
  19948. begin
  19949. V:=TPasVariable(El);
  19950. if V.VarType=nil then exit;
  19951. TypeEl:=ResolveAliasType(V.VarType);
  19952. Result:=TypeEl.ClassType=TPasArrayType;
  19953. end;
  19954. //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
  19955. end;
  19956. function TPasResolver.GetDefaultClassVisibility(AClass: TPasClassType
  19957. ): TPasMemberVisibility;
  19958. var
  19959. ClassScope: TPasClassScope;
  19960. begin
  19961. if AClass.CustomData=nil then
  19962. exit(visDefault);
  19963. ClassScope:=(AClass.CustomData as TPasClassScope);
  19964. if pcsfPublished in ClassScope.Flags then
  19965. Result:=visPublished
  19966. else
  19967. Result:=visPublic;
  19968. end;
  19969. procedure TPasResolver.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  19970. Before: boolean; var Handled: boolean);
  19971. begin
  19972. inherited ModeChanged(Sender, NewMode, Before, Handled);
  19973. if not Before then
  19974. begin
  19975. if LastElement is TPasSection then
  19976. TPasSectionScope(LastElement.CustomData).ModeSwitches:=CurrentParser.CurrentModeswitches;
  19977. end;
  19978. end;
  19979. class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
  19980. Line, Column: integer);
  19981. begin
  19982. Line:=Linenumber;
  19983. Column:=0;
  19984. if Line<0 then begin
  19985. Line:=-Line;
  19986. Column:=Line mod ParserMaxEmbeddedColumn;
  19987. Line:=Line div ParserMaxEmbeddedColumn;
  19988. end;
  19989. end;
  19990. class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
  19991. var
  19992. Line, Column: integer;
  19993. begin
  19994. if El=nil then exit('nil');
  19995. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  19996. Result:=El.SourceFilename+'('+IntToStr(Line);
  19997. if Column>0 then
  19998. Result:=Result+','+IntToStr(Column);
  19999. Result:=Result+')';
  20000. end;
  20001. function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
  20002. var
  20003. Line, Column: integer;
  20004. begin
  20005. if El=nil then exit('nil');
  20006. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  20007. if (Line=0) then
  20008. begin
  20009. if El is TPasUnresolvedSymbolRef then
  20010. exit('intrinsic');
  20011. end;
  20012. Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
  20013. if Column>0 then
  20014. Result:=Result+','+IntToStr(Column);
  20015. Result:=Result+')';
  20016. end;
  20017. destructor TPasResolver.Destroy;
  20018. begin
  20019. {$IFDEF VerbosePasResolverMem}
  20020. writeln('TPasResolver.Destroy START ',ClassName);
  20021. {$ENDIF}
  20022. Clear;
  20023. {$IFDEF VerbosePasResolverMem}
  20024. writeln('TPasResolver.Destroy PopScope...');
  20025. {$ENDIF}
  20026. PopScope; // free default scope
  20027. {$IFDEF VerbosePasResolverMem}
  20028. writeln('TPasResolver.Destroy FPendingForwards...');
  20029. {$ENDIF}
  20030. FreeAndNil(FPendingForwardProcs);
  20031. FreeAndNil(fExprEvaluator);
  20032. ClearBuiltInIdentifiers;
  20033. inherited Destroy;
  20034. {$IFDEF VerbosePasResolverMem}
  20035. writeln('TPasResolver.Destroy END ',ClassName);
  20036. {$ENDIF}
  20037. end;
  20038. procedure TPasResolver.Clear;
  20039. begin
  20040. ClearHelperList(FActiveHelpers);
  20041. RestoreStashedScopes(0);
  20042. // clear stack, keep DefaultScope
  20043. while (FScopeCount>0) and (FTopScope<>DefaultScope) do
  20044. PopScope;
  20045. ClearResolveDataList(lkModule);
  20046. end;
  20047. procedure TPasResolver.ClearBuiltInIdentifiers;
  20048. var
  20049. bt: TResolverBaseType;
  20050. bp: TResolverBuiltInProc;
  20051. begin
  20052. ClearResolveDataList(lkBuiltIn);
  20053. for bt in TResolverBaseType do
  20054. ReleaseAndNil(TPasElement(FBaseTypes[bt]){$IFDEF CheckPasTreeRefCount},'TPasResolver.AddBaseType'{$ENDIF});
  20055. for bp in TResolverBuiltInProc do
  20056. FBuiltInProcs[bp]:=nil;
  20057. end;
  20058. procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
  20059. const TheBaseTypes: TResolveBaseTypes;
  20060. const TheBaseProcs: TResolverBuiltInProcs);
  20061. var
  20062. bt: TResolverBaseType;
  20063. begin
  20064. for bt in TheBaseTypes do
  20065. AddBaseType(BaseTypeNames[bt],bt);
  20066. if bfLength in TheBaseProcs then
  20067. AddBuiltInProc('Length','function Length(const String or Array): sizeint',
  20068. @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
  20069. @BI_Length_OnEval,nil,bfLength);
  20070. if bfSetLength in TheBaseProcs then
  20071. AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
  20072. @BI_SetLength_OnGetCallCompatibility,nil,nil,
  20073. @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
  20074. if bfInclude in TheBaseProcs then
  20075. AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
  20076. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20077. @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
  20078. if bfExclude in TheBaseProcs then
  20079. AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
  20080. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20081. @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
  20082. if bfBreak in TheBaseProcs then
  20083. AddBuiltInProc('Break','procedure Break',
  20084. @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
  20085. if bfContinue in TheBaseProcs then
  20086. AddBuiltInProc('Continue','procedure Continue',
  20087. @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
  20088. if bfExit in TheBaseProcs then
  20089. AddBuiltInProc('Exit','procedure Exit(result)',
  20090. @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
  20091. if bfInc in TheBaseProcs then
  20092. AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
  20093. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20094. @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
  20095. if bfDec in TheBaseProcs then
  20096. AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
  20097. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20098. @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
  20099. if bfAssigned in TheBaseProcs then
  20100. AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
  20101. @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
  20102. nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
  20103. if bfChr in TheBaseProcs then
  20104. AddBuiltInProc('Chr','function Chr(const Integer): char',
  20105. @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,
  20106. @BI_Chr_OnEval,nil,bfChr);
  20107. if bfOrd in TheBaseProcs then
  20108. AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
  20109. @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
  20110. @BI_Ord_OnEval,nil,bfOrd);
  20111. if bfLow in TheBaseProcs then
  20112. AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
  20113. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20114. @BI_LowHigh_OnEval,nil,bfLow);
  20115. if bfHigh in TheBaseProcs then
  20116. AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
  20117. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20118. @BI_LowHigh_OnEval,nil,bfHigh);
  20119. if bfPred in TheBaseProcs then
  20120. AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
  20121. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20122. @BI_PredSucc_OnEval,nil,bfPred);
  20123. if bfSucc in TheBaseProcs then
  20124. AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
  20125. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20126. @BI_PredSucc_OnEval,nil,bfSucc);
  20127. if bfStrProc in TheBaseProcs then
  20128. AddBuiltInProc('Str','procedure Str(const var; var String)',
  20129. @BI_StrProc_OnGetCallCompatibility,nil,nil,
  20130. @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
  20131. if bfStrFunc in TheBaseProcs then
  20132. AddBuiltInProc('Str','function Str(const var): String',
  20133. @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
  20134. @BI_StrFunc_OnEval,nil,bfStrFunc);
  20135. if bfWriteStr in TheBaseProcs then
  20136. AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
  20137. @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
  20138. @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
  20139. if bfVal in TheBaseProcs then
  20140. AddBuiltInProc('Val','procedure Val(const String; var Value: bool|int|float|enum; out Int)',
  20141. @BI_Val_OnGetCallCompatibility,nil,nil,
  20142. @BI_Val_OnFinishParamsExpr,bfVal,[bipfCanBeStatement]);
  20143. if bfLo in TheBaseProcs then
  20144. AddBuiltInProc('Lo','function Lo(X: any integer type): Byte|Word)',
  20145. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20146. @BI_LoHi_OnEval,nil,bfLo);
  20147. if bfHi in TheBaseProcs then
  20148. AddBuiltInProc('Hi','function Hi(X: any integer type): Byte|Word)',
  20149. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20150. @BI_LoHi_OnEval,nil,bfHi);
  20151. if bfConcatArray in TheBaseProcs then
  20152. AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
  20153. @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
  20154. nil,nil,bfConcatArray);
  20155. if bfConcatString in TheBaseProcs then
  20156. AddBuiltInProc('Concat','function Concat(const String1, String2, ...): String',
  20157. @BI_ConcatString_OnGetCallCompatibility,@BI_ConcatString_OnGetCallResult,
  20158. @BI_ConcatString_OnEval,nil,bfConcatString);
  20159. if bfCopyArray in TheBaseProcs then
  20160. AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
  20161. @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
  20162. nil,nil,bfCopyArray);
  20163. if bfInsertArray in TheBaseProcs then
  20164. AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
  20165. @BI_InsertArray_OnGetCallCompatibility,nil,nil,
  20166. @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
  20167. if bfDeleteArray in TheBaseProcs then
  20168. AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
  20169. @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
  20170. @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
  20171. if bfTypeInfo in TheBaseProcs then
  20172. AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
  20173. @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
  20174. nil,nil,bfTypeInfo);
  20175. if bfAssert in TheBaseProcs then
  20176. AddBuiltInProc('Assert','procedure Assert(bool[,string])',
  20177. @BI_Assert_OnGetCallCompatibility,nil,nil,
  20178. @BI_Assert_OnFinishParamsExpr,bfAssert,[bipfCanBeStatement]);
  20179. if bfNew in TheBaseProcs then
  20180. AddBuiltInProc('New','procedure New(out ^record)',
  20181. @BI_New_OnGetCallCompatibility,nil,nil,
  20182. @BI_New_OnFinishParamsExpr,bfNew,[bipfCanBeStatement]);
  20183. if bfDispose in TheBaseProcs then
  20184. AddBuiltInProc('Dispose','procedure Dispose(var ^record)',
  20185. @BI_Dispose_OnGetCallCompatibility,nil,nil,
  20186. @BI_Dispose_OnFinishParamsExpr,bfDispose,[bipfCanBeStatement]);
  20187. if bfDefault in TheBaseProcs then
  20188. AddBuiltInProc('Default','function Default(T): T',
  20189. @BI_Default_OnGetCallCompatibility,@BI_Default_OnGetCallResult,
  20190. @BI_Default_OnEval,nil,bfDefault,[]);
  20191. end;
  20192. function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
  20193. ): TResElDataBaseType;
  20194. var
  20195. El: TPasUnresolvedSymbolRef;
  20196. begin
  20197. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20198. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TPasResolver.AddBaseType');{$ENDIF}
  20199. if not (Typ in [btNone,btCustom]) then
  20200. FBaseTypes[Typ]:=El;
  20201. Result:=TResElDataBaseType.Create;
  20202. Result.BaseType:=Typ;
  20203. AddResolveData(El,Result,lkBuiltIn);
  20204. FDefaultScope.AddIdentifier(aName,El,pikBaseType);
  20205. end;
  20206. function TPasResolver.AddCustomBaseType(const aName: string;
  20207. aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  20208. var
  20209. CustomData: TResElDataBaseType;
  20210. begin
  20211. Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20212. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('TPasResolver.AddCustomBaseType');{$ENDIF}
  20213. CustomData:=aClass.Create;
  20214. CustomData.BaseType:=btCustom;
  20215. AddResolveData(Result,CustomData,lkBuiltIn);
  20216. FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
  20217. end;
  20218. function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
  20219. ResolveAlias: boolean): boolean;
  20220. begin
  20221. Result:=false;
  20222. if aType=nil then exit;
  20223. if ResolveAlias then
  20224. aType:=ResolveAliasType(aType);
  20225. if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
  20226. Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
  20227. end;
  20228. function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
  20229. const GetCallCompatibility: TOnGetCallCompatibility;
  20230. const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
  20231. const FinishParamsExpr: TOnFinishParamsExpr;
  20232. const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
  20233. ): TResElDataBuiltInProc;
  20234. var
  20235. El: TPasUnresolvedSymbolRef;
  20236. begin
  20237. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20238. Result:=TResElDataBuiltInProc.Create;
  20239. Result.Proc:=El;
  20240. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TResElDataBuiltInProc.Proc');{$ENDIF}
  20241. Result.Signature:=Signature;
  20242. Result.BuiltIn:=BuiltIn;
  20243. Result.GetCallCompatibility:=GetCallCompatibility;
  20244. Result.GetCallResult:=GetCallResult;
  20245. Result.Eval:=EvalConst;
  20246. Result.FinishParamsExpression:=FinishParamsExpr;
  20247. Result.Flags:=Flags;
  20248. AddResolveData(El,Result,lkBuiltIn);
  20249. FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
  20250. if BuiltIn<>bfCustom then
  20251. FBuiltInProcs[BuiltIn]:=Result;
  20252. end;
  20253. procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
  20254. Kind: TResolveDataListKind);
  20255. begin
  20256. if Data.Element<>nil then
  20257. RaiseInternalError(20171111162227);
  20258. if El.CustomData<>nil then
  20259. RaiseInternalError(20171111162236);
  20260. Data.Element:=El;
  20261. Data.Owner:=Self;
  20262. Data.Next:=FLastCreatedData[Kind];
  20263. FLastCreatedData[Kind]:=Data;
  20264. El.CustomData:=Data;
  20265. end;
  20266. function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
  20267. Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
  20268. procedure RaiseAlreadySet;
  20269. var
  20270. FormerDeclEl: TPasElement;
  20271. begin
  20272. {AllowWriteln}
  20273. writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  20274. writeln(' RefEl at ',GetElementSourcePosStr(RefEl));
  20275. writeln(' RefEl.CustomData=',GetObjName(RefEl.CustomData));
  20276. if RefEl.CustomData is TResolvedReference then
  20277. begin
  20278. FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
  20279. writeln(' TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
  20280. ' IsSame=',FormerDeclEl=DeclEl);
  20281. end;
  20282. {AllowWriteln-}
  20283. RaiseInternalError(20160922163554,'customdata<>nil');
  20284. end;
  20285. begin
  20286. if RefEl.CustomData<>nil then
  20287. RaiseAlreadySet;
  20288. {$IFDEF VerbosePasResolver}
  20289. writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  20290. {$ENDIF}
  20291. Result:=TResolvedReference.Create;
  20292. if FindData<>nil then
  20293. begin
  20294. if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
  20295. Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
  20296. end;
  20297. AddResolveData(RefEl,Result,lkModule);
  20298. Result.Declaration:=DeclEl;
  20299. if RefEl is TPasExpr then
  20300. SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
  20301. EmitElementHints(RefEl,DeclEl);
  20302. end;
  20303. procedure TPasResolver.WriteScopesShort(Title: string);
  20304. var
  20305. i: Integer;
  20306. begin
  20307. {AllowWriteln}
  20308. writeln(Title,' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  20309. for i:=0 to FScopeCount-1 do
  20310. writeln(' ',i,'/',FScopeCount,' ',GetObjName(FScopes[i]));
  20311. {AllowWriteln-}
  20312. end;
  20313. function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
  20314. ): TPasScope;
  20315. begin
  20316. if not ScopeClass.IsStoredInElement then
  20317. RaiseInternalError(20160923121858);
  20318. if El.CustomData<>nil then
  20319. RaiseInternalError(20160923121849);
  20320. {$IFDEF VerbosePasResolver}
  20321. writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
  20322. {$ENDIF}
  20323. Result:=ScopeClass.Create;
  20324. if Result.FreeOnPop then
  20325. begin
  20326. Result.Element:=El;
  20327. El.CustomData:=Result;
  20328. Result.Owner:=Self;
  20329. end
  20330. else
  20331. // add to free list
  20332. AddResolveData(El,Result,lkModule);
  20333. end;
  20334. function TPasResolver.CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean
  20335. ): TPasGroupScope;
  20336. begin
  20337. Result:=TPasGroupScope.Create;
  20338. Result.Element:=HiType;
  20339. GroupScope_AddTypeAndAncestors(Result,HiType,WithTopHelpers);
  20340. end;
  20341. procedure TPasResolver.GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope;
  20342. HiType: TPasType; WithTopHelpers: boolean);
  20343. var
  20344. IsClass: Boolean;
  20345. i: Integer;
  20346. Entry: TPRHelperEntry;
  20347. HelperForType, LoType: TPasType;
  20348. AncestorScope, HelperScope: TPasClassScope;
  20349. C: TClass;
  20350. begin
  20351. HiType:=ResolveAliasType(HiType,false);
  20352. LoType:=ResolveAliasType(HiType);
  20353. IsClass:=LoType.ClassType=TPasClassType;
  20354. if IsClass and (TPasClassType(LoType).HelperForType<>nil) then
  20355. begin
  20356. // start in a helper
  20357. WithTopHelpers:=false;
  20358. // first add helper and its ancestors
  20359. HelperScope:=TPasClassScope(LoType.CustomData);
  20360. while HelperScope<>nil do
  20361. begin
  20362. Scope.Add(HelperScope);
  20363. HelperScope:=HelperScope.AncestorScope;
  20364. end;
  20365. // then add the HelperForType and its ancestors
  20366. HiType:=ResolveAliasType(TPasClassType(HiType).HelperForType,false);
  20367. LoType:=ResolveAliasType(HiType);
  20368. IsClass:=LoType.ClassType=TPasClassType;
  20369. end;
  20370. repeat
  20371. // first add helper(s)
  20372. if WithTopHelpers then
  20373. begin
  20374. for i:=length(FActiveHelpers)-1 downto 0 do
  20375. begin
  20376. Entry:=FActiveHelpers[i];
  20377. HelperForType:=Entry.HelperForType;
  20378. if IsSameType(HelperForType,HiType,prraNone) then
  20379. begin
  20380. // add Helper and its ancestors
  20381. HelperScope:=TPasClassScope(Entry.Helper.CustomData);
  20382. while HelperScope<>nil do
  20383. begin
  20384. Scope.Add(HelperScope);
  20385. HelperScope:=HelperScope.AncestorScope;
  20386. end;
  20387. if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
  20388. break;
  20389. end;
  20390. end;
  20391. end
  20392. else
  20393. WithTopHelpers:=true;
  20394. // then add scope of LoType
  20395. C:=LoType.ClassType;
  20396. if (C=TPasClassType) or (C=TPasRecordType) then
  20397. Scope.Add(LoType.CustomData as TPasIdentifierScope);
  20398. // continue with ancestor
  20399. if not IsClass then break;
  20400. AncestorScope:=(LoType.CustomData as TPasClassScope).AncestorScope;
  20401. if AncestorScope=nil then break;
  20402. HiType:=TPasClassType(AncestorScope.Element);
  20403. LoType:=HiType;
  20404. until LoType=nil;
  20405. end;
  20406. procedure TPasResolver.PopScope;
  20407. var
  20408. Scope: TPasScope;
  20409. begin
  20410. if FScopeCount=0 then
  20411. RaiseInternalError(20160922163557);
  20412. {$IFDEF VerbosePasResolver}
  20413. {AllowWriteln}
  20414. //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
  20415. writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
  20416. {AllowWriteln-}
  20417. {$ENDIF}
  20418. dec(FScopeCount);
  20419. if FTopScope.FreeOnPop then
  20420. begin
  20421. Scope:=FScopes[FScopeCount];
  20422. if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
  20423. Scope.Element.CustomData:=nil;
  20424. if Scope=FDefaultScope then
  20425. FDefaultScope:=nil;
  20426. FScopes[FScopeCount]:=nil;
  20427. Scope.Free;
  20428. end;
  20429. if FScopeCount>0 then
  20430. FTopScope:=FScopes[FScopeCount-1]
  20431. else
  20432. FTopScope:=nil;
  20433. end;
  20434. procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
  20435. var
  20436. WithScope: TPasWithScope;
  20437. i: Integer;
  20438. begin
  20439. WithScope:=El.CustomData as TPasWithScope;
  20440. for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
  20441. begin
  20442. CheckTopScope(ScopeClass_WithExpr);
  20443. if TopScope<>WithScope.ExpressionScopes[i] then
  20444. RaiseInternalError(20160923102846);
  20445. PopScope;
  20446. end;
  20447. CheckTopScope(TPasWithScope);
  20448. PopScope;
  20449. end;
  20450. procedure TPasResolver.PopGenericParamScope(El: TPasGenericType);
  20451. var
  20452. TemplType: TPasGenericTemplateType;
  20453. begin
  20454. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  20455. begin
  20456. TemplType:=TPasGenericTemplateType(El.GenericTemplateTypes[0]);
  20457. if not (TopScope is TPasGenericParamsScope) then
  20458. RaiseNotYetImplemented(20190831204109,El,GetObjName(TopScope));
  20459. if TopScope.Element<>TemplType then
  20460. RaiseNotYetImplemented(20190831204134,El,GetObjName(TopScope.Element));
  20461. PopScope;
  20462. end
  20463. else
  20464. begin
  20465. if TopScope is TPasGenericParamsScope then
  20466. RaiseNotYetImplemented(20190831204213,El,GetObjName(TopScope.Element));
  20467. end;
  20468. end;
  20469. procedure TPasResolver.PushScope(Scope: TPasScope);
  20470. begin
  20471. if Scope=nil then
  20472. RaiseInternalError(20160922163601);
  20473. if length(FScopes)=FScopeCount then
  20474. SetLength(FScopes,FScopeCount*2+10);
  20475. FScopes[FScopeCount]:=Scope;
  20476. inc(FScopeCount);
  20477. FTopScope:=Scope;
  20478. {$IFDEF VerbosePasResolver}
  20479. writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
  20480. {$ENDIF}
  20481. end;
  20482. function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
  20483. ): TPasScope;
  20484. begin
  20485. Result:=CreateScope(El,ScopeClass);
  20486. PushScope(Result);
  20487. end;
  20488. function TPasResolver.PushGroupScope(HiType: TPasType): TPasGroupScope;
  20489. begin
  20490. Result:=CreateGroupScope(HiType);
  20491. PushScope(Result);
  20492. end;
  20493. function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  20494. begin
  20495. Result:=TPasModuleDotScope.Create;
  20496. Result.Owner:=Self;
  20497. Result.Module:=aModule;
  20498. if aModule is TPasProgram then
  20499. begin // program
  20500. if TPasProgram(aModule).ProgramSection<>nil then
  20501. Result.InterfaceScope:=
  20502. NoNil(TPasProgram(aModule).ProgramSection.CustomData) as TPasSectionScope;
  20503. end
  20504. else if aModule is TPasLibrary then
  20505. begin // library
  20506. if TPasLibrary(aModule).LibrarySection<>nil then
  20507. Result.InterfaceScope:=
  20508. NoNil(TPasLibrary(aModule).LibrarySection.CustomData) as TPasSectionScope;
  20509. end
  20510. else
  20511. begin // unit
  20512. if aModule.InterfaceSection<>nil then
  20513. Result.InterfaceScope:=
  20514. NoNil(aModule.InterfaceSection.CustomData) as TPasSectionScope;
  20515. if (aModule=RootElement)
  20516. and (aModule.ImplementationSection<>nil)
  20517. and (aModule.ImplementationSection.CustomData<>nil)
  20518. then
  20519. Result.ImplementationScope:=NoNil(aModule.ImplementationSection.CustomData) as TPasSectionScope;
  20520. if CompareText(aModule.Name,'system')=0 then
  20521. Result.SystemScope:=DefaultScope;
  20522. end;
  20523. PushScope(Result);
  20524. end;
  20525. function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType;
  20526. WithTopHelpers: boolean): TPasDotClassScope;
  20527. var
  20528. ClassScope: TPasClassScope;
  20529. Ref: TResolvedReference;
  20530. begin
  20531. if CurClassType.IsForward then
  20532. begin
  20533. Ref:=CurClassType.CustomData as TResolvedReference;
  20534. CurClassType:=Ref.Declaration as TPasClassType;
  20535. end;
  20536. if CurClassType.CustomData=nil then
  20537. RaiseInternalError(20160922163611);
  20538. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  20539. Result:=TPasDotClassScope.Create;
  20540. Result.Owner:=Self;
  20541. Result.ClassRecScope:=ClassScope;
  20542. Result.GroupScope:=CreateGroupScope(CurClassType,WithTopHelpers);
  20543. PushScope(Result);
  20544. end;
  20545. function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  20546. var
  20547. RecScope: TPasRecordScope;
  20548. begin
  20549. RecScope:=NoNil(CurRecordType.CustomData) as TPasRecordScope;
  20550. Result:=TPasDotClassOrRecordScope.Create;
  20551. Result.Owner:=Self;
  20552. Result.ClassRecScope:=RecScope;
  20553. Result.GroupScope:=CreateGroupScope(CurRecordType);
  20554. PushScope(Result);
  20555. end;
  20556. function TPasResolver.PushInheritedScope(ClassOrRec: TPasMembersType;
  20557. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  20558. begin
  20559. Result:=TPasInheritedScope.Create;
  20560. Result.Owner:=Self;
  20561. Result.ClassRecScope:=NoNil(ClassOrRec.CustomData) as TPasClassOrRecordScope;
  20562. Result.AncestorScope:=AncestorScope;
  20563. Result.GroupScope:=CreateGroupScope(ClassOrRec,WithTopHelpers);
  20564. PushScope(Result);
  20565. end;
  20566. function TPasResolver.PushEnumDotScope(HiType: TPasType;
  20567. EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  20568. begin
  20569. Result:=TPasDotEnumTypeScope.Create;
  20570. Result.Owner:=Self;
  20571. Result.EnumScope:=NoNil(EnumLoType.CustomData) as TPasEnumTypeScope;
  20572. Result.GroupScope:=CreateGroupScope(HiType);
  20573. PushScope(Result);
  20574. end;
  20575. function TPasResolver.PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  20576. var
  20577. Group: TPasGroupScope;
  20578. begin
  20579. Group:=CreateGroupScope(HiType);
  20580. if Group.Count=0 then
  20581. begin
  20582. Group.Free;
  20583. exit(nil);
  20584. end;
  20585. Result:=TPasDotHelperScope.Create;
  20586. Result.Element:=HiType;
  20587. Result.Owner:=Self;
  20588. Result.GroupScope:=Group;
  20589. PushScope(Result);
  20590. end;
  20591. function TPasResolver.PushTemplateDotScope(TemplType: TPasGenericTemplateType;
  20592. ErrorEl: TPasElement): TPasDotBaseScope;
  20593. procedure PushConstraintScope(ConEl: TPasElement);
  20594. var
  20595. ConToken: TToken;
  20596. DotClassScope: TPasDotClassScope;
  20597. MemberType: TPasMembersType;
  20598. GenTempl: TPasGenericTemplateType;
  20599. aClass: TPasClassType;
  20600. aConstructor: TPasConstructor;
  20601. i: Integer;
  20602. ResolvedEl: TPasResolverResult;
  20603. begin
  20604. ConToken:=GetGenericConstraintKeyword(ConEl);
  20605. case ConToken of
  20606. tkrecord: ;
  20607. tkclass, tkconstructor:
  20608. begin
  20609. if Result<>nil then
  20610. RaiseNotYetImplemented(20190831005217,TemplType);
  20611. if not FindClassTypeAndConstructor('system','tobject',aClass,aConstructor,ErrorEl) then
  20612. RaiseIdentifierNotFound(20190831002421,'system.TObject.Create()',ErrorEl);
  20613. DotClassScope:=TPasDotClassScope.Create;
  20614. Result:=DotClassScope;
  20615. PushScope(Result);
  20616. DotClassScope.Owner:=Self;
  20617. DotClassScope.ClassRecScope:=aClass.CustomData as TPasClassScope;
  20618. Result.GroupScope:=CreateGroupScope(aClass,false);
  20619. end;
  20620. else
  20621. if not (ConEl is TPasType) then
  20622. RaiseNotYetImplemented(20190914070842,TemplType,GetObjName(ConEl));
  20623. ComputeElement(ConEl,ResolvedEl,[rcType]);
  20624. if ResolvedEl.BaseType<>btContext then
  20625. RaiseNotYetImplemented(20190915183241,ConEl);
  20626. if ResolvedEl.IdentEl=nil then
  20627. RaiseNotYetImplemented(20190831214135,ConEl);
  20628. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  20629. begin
  20630. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  20631. if ConEl.HasParent(GenTempl) then
  20632. RaiseNotYetImplemented(20190831214258,ConEl);
  20633. for i:=0 to length(GenTempl.Constraints)-1 do
  20634. PushConstraintScope(GenTempl.Constraints[i]);
  20635. end
  20636. else if ResolvedEl.LoTypeEl is TPasMembersType then
  20637. begin
  20638. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  20639. if Result=nil then
  20640. begin
  20641. DotClassScope:=TPasDotClassScope.Create;
  20642. Result:=DotClassScope;
  20643. PushScope(Result);
  20644. DotClassScope.Owner:=Self;
  20645. DotClassScope.ClassRecScope:=MemberType.CustomData as TPasClassScope;
  20646. Result.GroupScope:=CreateGroupScope(ResolvedEl.HiTypeEl,false);
  20647. end
  20648. else
  20649. GroupScope_AddTypeAndAncestors(Result.GroupScope,MemberType,false);
  20650. end
  20651. else
  20652. RaiseNotYetImplemented(20190831001450, ConEl);
  20653. end;
  20654. end;
  20655. var
  20656. i: Integer;
  20657. begin
  20658. Result:=nil;
  20659. for i:=0 to length(TemplType.Constraints)-1 do
  20660. PushConstraintScope(TemplType.Constraints[i]);
  20661. end;
  20662. function TPasResolver.PushDotScope(HiType: TPasType): TPasDotBaseScope;
  20663. var
  20664. C: TClass;
  20665. LoType: TPasType;
  20666. begin
  20667. LoType:=ResolveAliasType(HiType);
  20668. C:=LoType.ClassType;
  20669. if C=TPasClassType then
  20670. Result:=PushClassDotScope(TPasClassType(LoType))
  20671. else if C=TPasRecordType then
  20672. Result:=PushRecordDotScope(TPasRecordType(LoType))
  20673. else if C=TPasEnumType then
  20674. Result:=PushEnumDotScope(HiType,TPasEnumType(LoType))
  20675. else if C=TPasGenericTemplateType then
  20676. Result:=PushTemplateDotScope(TPasGenericTemplateType(LoType),HiType)
  20677. else
  20678. Result:=PushHelperDotScope(HiType);
  20679. end;
  20680. function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  20681. var
  20682. WithEl: TPasImplWithDo;
  20683. WithScope: TPasWithScope;
  20684. ExprResolved: TPasResolverResult;
  20685. ErrorEl: TPasExpr;
  20686. LoType, HiType, DestType: TPasType;
  20687. ExprScope: TPasGroupScope;
  20688. ClassEl: TPasClassType;
  20689. WithExprScope: TPasWithExprScope;
  20690. Flags: TPasWithExprScopeFlags;
  20691. ClassRecScope: TPasClassOrRecordScope;
  20692. begin
  20693. if not (Expr.Parent is TPasImplWithDo) then
  20694. RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
  20695. WithEl:=TPasImplWithDo(Expr.Parent);
  20696. if not (WithEl.CustomData is TPasWithScope) then
  20697. RaiseInternalError(20181210175526);
  20698. WithScope:=TPasWithScope(WithEl.CustomData);
  20699. ResolveExpr(Expr,rraRead);
  20700. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  20701. {$IFDEF VerbosePasResolver}
  20702. writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
  20703. {$ENDIF}
  20704. ErrorEl:=Expr;
  20705. HiType:=ExprResolved.HiTypeEl;
  20706. LoType:=ExprResolved.LoTypeEl;
  20707. // ToDo: use last element in Expr for error position
  20708. if LoType=nil then
  20709. RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  20710. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  20711. if (ExprResolved.BaseType in btAllStandardTypes) then
  20712. // ok
  20713. else if (ExprResolved.BaseType=btContext) then
  20714. // ok
  20715. else
  20716. RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  20717. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  20718. Flags:=[];
  20719. CheckUseAsType(LoType,20190123113957,Expr);
  20720. ClassRecScope:=nil;
  20721. ExprScope:=nil;
  20722. if LoType.ClassType=TPasClassOfType then
  20723. begin
  20724. // e.g. with ImageClass do FindHandlerFromExtension()
  20725. DestType:=TPasClassOfType(LoType).DestType;
  20726. ClassEl:=ResolveAliasType(DestType) as TPasClassType;
  20727. ExprScope:=CreateGroupScope(DestType);
  20728. ClassRecScope:=TPasClassOrRecordScope(ClassEl.CustomData);
  20729. Include(Flags,wesfOnlyTypeMembers);
  20730. Include(Flags,wesfIsClassOf);
  20731. end
  20732. else if LoType is TPasMembersType then
  20733. ClassRecScope:=TPasClassOrRecordScope(LoType.CustomData);
  20734. if ExprScope=nil then
  20735. begin
  20736. ExprScope:=CreateGroupScope(HiType);
  20737. if ExprScope.Count=0 then
  20738. begin
  20739. ExprScope.Free;
  20740. RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  20741. [GetElementTypeName(LoType)],ErrorEl);
  20742. end;
  20743. if ExprResolved.IdentEl is TPasType then
  20744. // e.g. with TPoint do PointInCircle
  20745. Include(Flags,wesfOnlyTypeMembers);
  20746. end;
  20747. WithExprScope:=ScopeClass_WithExpr.Create;
  20748. WithExprScope.WithScope:=WithScope;
  20749. WithExprScope.Index:=WithEl.Expressions.Count;
  20750. WithExprScope.Expr:=Expr;
  20751. WithExprScope.Scope:=ExprScope;
  20752. WithExprScope.ClassRecScope:=ClassRecScope;
  20753. if not (ExprResolved.IdentEl is TPasType) then
  20754. Include(Flags,wesfNeedTmpVar);
  20755. if (not (rrfWritable in ExprResolved.Flags))
  20756. and (ExprResolved.BaseType=btContext)
  20757. and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
  20758. Include(Flags,wesfConstParent);
  20759. WithExprScope.Flags:=Flags;
  20760. WithScope.ExpressionScopes.Add(WithExprScope);
  20761. PushScope(WithExprScope);
  20762. Result:=WithExprScope;
  20763. end;
  20764. function TPasResolver.StashScopes(NewScopeCnt: integer): integer;
  20765. begin
  20766. Result:=FStashScopeCount;
  20767. if NewScopeCnt>ScopeCount then
  20768. RaiseInternalError(20190728125505);
  20769. while ScopeCount>NewScopeCnt do
  20770. begin
  20771. {$IFDEF VerbosePasResolver}
  20772. writeln('TPasResolver.StashScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  20773. {$ENDIF}
  20774. if FStashScopeCount=length(FStashScopes) then
  20775. SetLength(FStashScopes,FStashScopeCount+4);
  20776. FStashScopes[FStashScopeCount]:=TopScope;
  20777. inc(FStashScopeCount);
  20778. dec(FScopeCount);
  20779. FScopes[FScopeCount]:=nil;
  20780. if FScopeCount>0 then
  20781. FTopScope:=FScopes[FScopeCount-1]
  20782. else
  20783. FTopScope:=nil;
  20784. end;
  20785. end;
  20786. function TPasResolver.StashSubExprScopes: integer;
  20787. // move all subexpr scopes from Scopes to StashScopes
  20788. var
  20789. NewScopeCnt: Integer;
  20790. begin
  20791. NewScopeCnt:=FScopeCount;
  20792. while (NewScopeCnt>0) and (FScopes[NewScopeCnt-1] is TPasSubExprScope) do
  20793. dec(NewScopeCnt);
  20794. Result:=StashScopes(NewScopeCnt);
  20795. end;
  20796. procedure TPasResolver.RestoreStashedScopes(StashDepth: integer);
  20797. // restore sub scopes
  20798. begin
  20799. while FStashScopeCount>StashDepth do
  20800. begin
  20801. {$IFDEF VerbosePasResolver}
  20802. writeln('TPasResolver.RestoreStashScopes moving ',FStashScopes[FStashScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  20803. {$ENDIF}
  20804. if FScopeCount=length(FScopes) then
  20805. SetLength(FScopes,FScopeCount+4);
  20806. dec(FStashScopeCount);
  20807. FScopes[FScopeCount]:=FStashScopes[FStashScopeCount];
  20808. FTopScope:=FScopes[FScopeCount];
  20809. FStashScopes[FStashScopeCount]:=nil;
  20810. inc(FScopeCount);
  20811. end;
  20812. end;
  20813. function TPasResolver.GetCurrentProcScope(ErrorEl: TPasElement
  20814. ): TPasProcedureScope;
  20815. var
  20816. Scope: TPasScope;
  20817. i: Integer;
  20818. begin
  20819. i:=ScopeCount;
  20820. repeat
  20821. dec(i);
  20822. if i<0 then
  20823. RaiseMsg(20171006001229,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  20824. Scope:=Scopes[i];
  20825. if Scope is TPasProcedureScope then
  20826. exit(TPasProcedureScope(Scope));
  20827. until false;
  20828. Result:=nil;
  20829. end;
  20830. function TPasResolver.GetProcScope(El: TPasElement): TPasProcedureScope;
  20831. var
  20832. CurEl: TPasElement;
  20833. begin
  20834. CurEl:=El;
  20835. while CurEl<>nil do
  20836. begin
  20837. if CurEl is TPasProcedure then
  20838. exit(TPasProcedureScope(CurEl.CustomData));
  20839. CurEl:=CurEl.Parent;
  20840. end;
  20841. Result:=nil;
  20842. end;
  20843. function TPasResolver.GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  20844. begin
  20845. Result:=GetCurrentProcScope(ErrorEl);
  20846. Result:=Result.GetSelfScope;
  20847. end;
  20848. function TPasResolver.GetSelfScope(El: TPasElement): TPasProcedureScope;
  20849. begin
  20850. Result:=GetProcScope(El);
  20851. if Result<>nil then
  20852. Result:=Result.GetSelfScope;
  20853. end;
  20854. procedure TPasResolver.AddHelper(Helper: TPasClassType;
  20855. var List: TPRHelperEntryArray);
  20856. var
  20857. NewEntry: TPRHelperEntry;
  20858. Added: Integer;
  20859. HelperForType: TPasType;
  20860. begin
  20861. HelperForType:=ResolveAliasType(Helper.HelperForType,false);
  20862. NewEntry:=TPRHelperEntry.Create;
  20863. NewEntry.Helper:=Helper;
  20864. NewEntry.HelperForType:=HelperForType;
  20865. Added:=length(List);
  20866. NewEntry.Added:=Added;
  20867. SetLength(List,Added+1);
  20868. List[Added]:=NewEntry;
  20869. end;
  20870. procedure TPasResolver.AddActiveHelper(Helper: TPasClassType);
  20871. begin
  20872. AddHelper(Helper,FActiveHelpers);
  20873. end;
  20874. class function TPasResolver.MangleSourceLineNumber(Line, Column: integer
  20875. ): integer;
  20876. begin
  20877. if (Column<ParserMaxEmbeddedColumn)
  20878. and (Line<ParserMaxEmbeddedRow) then
  20879. Result:=-(Line*ParserMaxEmbeddedColumn+integer(Column))
  20880. else
  20881. Result:=Line;
  20882. end;
  20883. procedure TPasResolver.SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  20884. MsgNumber: integer; const Fmt: String;
  20885. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  20886. PosEl: TPasElement);
  20887. var
  20888. {$IFDEF VerbosePasResolver}
  20889. s: string;
  20890. {$ENDIF}
  20891. Column, Row: integer;
  20892. begin
  20893. FLastMsgId := id;
  20894. FLastMsgType := MsgType;
  20895. FLastMsgNumber := MsgNumber;
  20896. FLastMsgPattern := Fmt;
  20897. FLastMsg := SafeFormat(Fmt,Args);
  20898. FLastElement := PosEl;
  20899. if PosEl=nil then
  20900. FLastSourcePos:=CurrentParser.CurSourcePos
  20901. else
  20902. begin
  20903. FLastSourcePos.FileName:=PosEl.SourceFilename;
  20904. UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
  20905. if Row>=0 then
  20906. FLastSourcePos.Row:=Row
  20907. else
  20908. FLastSourcePos.Row:=0;
  20909. if Column>=0 then
  20910. FLastSourcePos.Column:=Column
  20911. else
  20912. FLastSourcePos.Column:=0;
  20913. end;
  20914. CreateMsgArgs(FLastMsgArgs,Args);
  20915. {$IFDEF VerbosePasResolver}
  20916. {AllowWriteln}
  20917. write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
  20918. s:='';
  20919. str(MsgType,s);
  20920. write(s);
  20921. writeln(': [',MsgNumber,'] ',FLastMsg);
  20922. {AllowWriteln-}
  20923. {$ENDIF}
  20924. end;
  20925. procedure TPasResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
  20926. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  20927. ErrorPosEl: TPasElement);
  20928. var
  20929. E: EPasResolve;
  20930. begin
  20931. SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  20932. E:=EPasResolve.Create(FLastMsg);
  20933. E.Id:=Id;
  20934. E.MsgType:=mtError;
  20935. E.MsgNumber:=MsgNumber;
  20936. E.MsgPattern:=Fmt;
  20937. E.PasElement:=ErrorPosEl;
  20938. E.Args:=FLastMsgArgs;
  20939. E.SourcePos:=FLastSourcePos;
  20940. raise E;
  20941. end;
  20942. procedure TPasResolver.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
  20943. Msg: string);
  20944. var
  20945. s: String;
  20946. begin
  20947. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  20948. if Msg<>'' then
  20949. s:=s+' "'+Msg+'"';
  20950. {$IFDEF VerbosePasResolver}
  20951. writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  20952. {$ENDIF}
  20953. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  20954. end;
  20955. procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
  20956. begin
  20957. {$IFDEF VerbosePasResolver}
  20958. writeln('TPasResolver.RaiseInternalError [',id,'] ',Msg);
  20959. {$ENDIF}
  20960. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  20961. end;
  20962. procedure TPasResolver.RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement;
  20963. const Msg: string);
  20964. var
  20965. i: Integer;
  20966. s: String;
  20967. begin
  20968. s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
  20969. for i:=0 to ScopeCount-1 do
  20970. begin
  20971. if i>0 then s:=s+',';
  20972. s:=s+Scopes[i].ClassName;
  20973. end;
  20974. if Msg<>'' then
  20975. s:=s+': '+Msg;
  20976. RaiseInternalError(id,s);
  20977. end;
  20978. procedure TPasResolver.RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string;
  20979. El: TPasElement);
  20980. begin
  20981. {$IFDEF VerbosePasResolver}
  20982. writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
  20983. WriteScopes;
  20984. {$ENDIF}
  20985. RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
  20986. end;
  20987. procedure TPasResolver.RaiseXExpectedButYFound(id: TMaxPrecInt; const X, Y: string;
  20988. El: TPasElement);
  20989. begin
  20990. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
  20991. end;
  20992. procedure TPasResolver.RaiseXExpectedButTypeYFound(id: TMaxPrecInt;
  20993. const X: string; Y: TPasType; El: TPasElement);
  20994. begin
  20995. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,
  20996. [x,GetTypeDescription(Y)],El);
  20997. end;
  20998. procedure TPasResolver.RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C, X,
  20999. Y: string; El: TPasElement);
  21000. begin
  21001. RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
  21002. end;
  21003. procedure TPasResolver.RaiseContextXInvalidY(id: TMaxPrecInt; const X, Y: string;
  21004. El: TPasElement);
  21005. begin
  21006. RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
  21007. end;
  21008. procedure TPasResolver.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  21009. begin
  21010. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  21011. end;
  21012. procedure TPasResolver.RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement;
  21013. IdentEl: TPasElement);
  21014. begin
  21015. if IdentEl is TPasProperty then
  21016. RaiseMsg(id,nNoMemberIsProvidedToAccessProperty,
  21017. sNoMemberIsProvidedToAccessProperty,[],ErrorEl)
  21018. else
  21019. RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  21020. end;
  21021. procedure TPasResolver.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  21022. begin
  21023. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  21024. end;
  21025. procedure TPasResolver.RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  21026. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21027. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  21028. function GetString(ArgNo: integer): string;
  21029. begin
  21030. if ArgNo>High(Args) then
  21031. exit('invalid param '+IntToStr(ArgNo));
  21032. {$ifdef pas2js}
  21033. if isString(Args[ArgNo]) then
  21034. Result:=String(Args[ArgNo])
  21035. else
  21036. Result:='invalid param '+jsTypeOf(Args[ArgNo]);
  21037. {$else}
  21038. case Args[ArgNo].VType of
  21039. vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
  21040. else
  21041. Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
  21042. end;
  21043. {$endif}
  21044. end;
  21045. begin
  21046. case MsgNumber of
  21047. nIllegalTypeConversionTo:
  21048. RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
  21049. nIncompatibleTypesGotExpected:
  21050. RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
  21051. nIncompatibleTypeArgNo:
  21052. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
  21053. nIncompatibleTypeArgNoVarParamMustMatchExactly:
  21054. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
  21055. [GetString(0),GotDesc,ExpDesc],ErrorEl);
  21056. nResultTypeMismatchExpectedButFound:
  21057. RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
  21058. nXExpectedButYFound:
  21059. RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
  21060. nOperatorIsNotOverloadedAOpB:
  21061. RaiseMsg(id,MsgNumber,sOperatorIsNotOverloadedAOpB,[GotDesc,GetString(0),ExpDesc],ErrorEl);
  21062. nTypesAreNotRelatedXY:
  21063. RaiseMsg(id,MsgNumber,sTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  21064. else
  21065. RaiseInternalError(20170329112911);
  21066. end;
  21067. end;
  21068. procedure TPasResolver.RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  21069. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21070. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  21071. var
  21072. DescA, DescB: String;
  21073. begin
  21074. DescA:=GetTypeDescription(GotType);
  21075. DescB:=GetTypeDescription(ExpType);
  21076. if DescA=DescB then
  21077. begin
  21078. DescA:=GetTypeDescription(GotType,true);
  21079. DescB:=GetTypeDescription(ExpType,true);
  21080. end;
  21081. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
  21082. end;
  21083. procedure TPasResolver.RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  21084. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21085. const GotType, ExpType: TPasResolverResult;
  21086. ErrorEl: TPasElement);
  21087. var
  21088. GotDesc, ExpDesc: String;
  21089. begin
  21090. {$IFDEF VerbosePasResolver}
  21091. writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  21092. {$ENDIF}
  21093. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  21094. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  21095. end;
  21096. procedure TPasResolver.RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt;
  21097. ErrorEl: TPasElement);
  21098. begin
  21099. RaiseMsg(id,nHelpersCannotBeUsedAsTypes,sHelpersCannotBeUsedAsTypes,[],ErrorEl);
  21100. end;
  21101. procedure TPasResolver.RaiseInvalidProcTypeModifier(id: TMaxPrecInt;
  21102. ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
  21103. begin
  21104. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
  21105. ProcTypeModifiers[ptm]],ErrorEl);
  21106. end;
  21107. procedure TPasResolver.RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  21108. pm: TProcedureModifier; ErrorEl: TPasElement);
  21109. begin
  21110. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
  21111. ModifierNames[pm]],ErrorEl);
  21112. end;
  21113. procedure TPasResolver.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  21114. MsgNumber: integer; const Fmt: String;
  21115. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21116. PosEl: TPasElement);
  21117. var
  21118. Scanner: TPascalScanner;
  21119. State: TWarnMsgState;
  21120. {$IFDEF VerbosePasResolver}
  21121. s: String;
  21122. {$ENDIF}
  21123. begin
  21124. Scanner:=CurrentParser.Scanner;
  21125. if (Scanner<>nil) then
  21126. begin
  21127. if (FStep<prsFinishingModule)
  21128. and (Scanner.IgnoreMsgType(MsgType)) then
  21129. exit; // during parsing consider directives like $Hints on|off
  21130. if MsgType>=mtWarning then
  21131. begin
  21132. State:=Scanner.WarnMsgState[MsgNumber];
  21133. case State of
  21134. wmsOff:
  21135. begin
  21136. {$IFDEF VerbosePasResolver}
  21137. {AllowWriteln}
  21138. write('TPasResolver.LogMsg ignoring ',id,' ',GetElementSourcePosStr(PosEl),' ');
  21139. s:='';
  21140. str(MsgType,s);
  21141. write(s);
  21142. writeln(': [',MsgNumber,'] ',SafeFormat(Fmt,Args));
  21143. {AllowWriteln-}
  21144. {$ENDIF}
  21145. exit; // ignore
  21146. end;
  21147. wmsError:
  21148. begin
  21149. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl);
  21150. exit;
  21151. end;
  21152. end;
  21153. end;
  21154. end;
  21155. SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  21156. if Assigned(OnLog) then
  21157. OnLog(Self,FLastMsg)
  21158. else if Assigned(CurrentParser.OnLog) then
  21159. CurrentParser.OnLog(Self,FLastMsg);
  21160. end;
  21161. class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
  21162. MsgNumbers: TIntegerDynArray): boolean;
  21163. procedure SetNumber(Number: integer);
  21164. begin
  21165. {$IF FPC_FULLVERSION>=30101}
  21166. MsgNumbers:=[Number];
  21167. {$ELSE}
  21168. Setlength(MsgNumbers,1);
  21169. MsgNumbers[0]:=Number;
  21170. {$ENDIF}
  21171. end;
  21172. procedure SetNumbers(Numbers: array of integer);
  21173. var
  21174. i: Integer;
  21175. begin
  21176. Setlength(MsgNumbers,length(Numbers));
  21177. for i:=0 to high(Numbers) do
  21178. MsgNumbers[i]:=Numbers[i];
  21179. end;
  21180. begin
  21181. if Identifier='' then exit(false);
  21182. if Identifier[1] in ['0'..'9'] then exit(false);
  21183. Result:=true;
  21184. case UpperCase(Identifier) of
  21185. // FPC:
  21186. 'CONSTRUCTING_ABSTRACT': SetNumber(nConstructingClassXWithAbstractMethodY); // Constructing an instance of a class with abstract methods.
  21187. //'IMPLICIT_VARIANTS': ; // Implicit use of the variants unit.
  21188. // useanalyzer: 'NO_RETVAL': ; // Function result is not set.
  21189. 'SYMBOL_DEPRECATED': SetNumber(nSymbolXIsDeprecated); // Deprecated symbol.
  21190. 'SYMBOL_EXPERIMENTAL': SetNumber(nSymbolXIsExperimental); // Experimental symbol
  21191. 'SYMBOL_LIBRARY': SetNumber(nSymbolXBelongsToALibrary); // Not used.
  21192. 'SYMBOL_PLATFORM': SetNumber(nSymbolXIsNotPortable); // Platform-dependent symbol.
  21193. 'SYMBOL_UNIMPLEMENTED': SetNumber(nSymbolXIsNotImplemented); // Unimplemented symbol.
  21194. //'UNIT_DEPRECATED': ; // Deprecated unit.
  21195. //'UNIT_EXPERIMENTAL': ; // Experimental unit.
  21196. //'UNIT_LIBRARY': ; //
  21197. //'UNIT_PLATFORM': ; // Platform dependent unit.
  21198. //'UNIT_UNIMPLEMENTED': ; // Unimplemented unit.
  21199. //'ZERO_NIL_COMPAT': ; // Converting 0 to NIL
  21200. //'IMPLICIT_STRING_CAST': ; // Implicit string type conversion
  21201. //'IMPLICIT_STRING_CAST_LOSS': ; // Implicit string typecast with potential data loss from ”$1” to ”$2”
  21202. //'EXPLICIT_STRING_CAST': ; // Explicit string type conversion
  21203. //'EXPLICIT_STRING_CAST_LOSS': ; // Explicit string typecast with potential data loss from ”$1” to ”$2”
  21204. //'CVT_NARROWING_STRING_LOST': ; // Unicode constant cast with potential data loss
  21205. // Delphi:
  21206. 'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
  21207. 'GARBAGE': SetNumber(nTextAfterFinalIgnored); // text after final end.
  21208. 'BOUNDS_ERROR': SetNumbers([nRangeCheckError,
  21209. nHighRangeLimitLTLowRangeLimit,
  21210. nRangeCheckEvaluatingConstantsVMinMax,
  21211. nRangeCheckInSetConstructor]);
  21212. 'MESSAGE_DIRECTIVE': SetNumber(nUserDefined); // $message directive
  21213. else
  21214. Result:=false;
  21215. end;
  21216. end;
  21217. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  21218. ExpType: TPasResolverResult; out GotDesc, ExpDesc: String);
  21219. begin
  21220. {$IFDEF VerbosePasResolver}
  21221. writeln('TPasResolver.GetIncompatibleTypeDesc Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  21222. {$ENDIF}
  21223. if GotType.BaseType<>ExpType.BaseType then
  21224. begin
  21225. GotDesc:=GetBaseDescription(GotType);
  21226. if ExpType.BaseType=btNil then
  21227. ExpDesc:=BaseTypeNames[btPointer]
  21228. else
  21229. ExpDesc:=GetBaseDescription(ExpType);
  21230. if GotDesc=ExpDesc then
  21231. begin
  21232. GotDesc:=GetBaseDescription(GotType,true);
  21233. ExpDesc:=GetBaseDescription(ExpType,true);
  21234. end;
  21235. end
  21236. else if (GotType.LoTypeEl<>nil) and (ExpType.LoTypeEl<>nil) then
  21237. begin
  21238. GotDesc:=GetTypeDescription(GotType);
  21239. ExpDesc:=GetTypeDescription(ExpType);
  21240. if GotDesc<>ExpDesc then exit;
  21241. if GotType.HiTypeEl<>ExpType.HiTypeEl then
  21242. begin
  21243. GotDesc:=GetTypeDescription(GotType.HiTypeEl);
  21244. ExpDesc:=GetTypeDescription(ExpType.HiTypeEl);
  21245. if GotDesc<>ExpDesc then exit;
  21246. end;
  21247. GotDesc:=GetTypeDescription(GotType,true);
  21248. ExpDesc:=GetTypeDescription(ExpType,true);
  21249. end
  21250. else
  21251. begin
  21252. GotDesc:=GetResolverResultDescription(GotType,true);
  21253. ExpDesc:=GetResolverResultDescription(ExpType,true);
  21254. if GotDesc=ExpDesc then
  21255. begin
  21256. GotDesc:=GetResolverResultDescription(GotType,false);
  21257. ExpDesc:=GetResolverResultDescription(ExpType,false);
  21258. end;
  21259. end;
  21260. end;
  21261. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  21262. ExpType: TPasType; out GotDesc, ExpDesc: String);
  21263. begin
  21264. GotDesc:=GetTypeDescription(GotType);
  21265. ExpDesc:=GetTypeDescription(ExpType);
  21266. if GotDesc<>ExpDesc then exit;
  21267. GotDesc:=GetTypeDescription(GotType,true);
  21268. ExpDesc:=GetTypeDescription(ExpType,true);
  21269. end;
  21270. function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
  21271. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
  21272. ): integer;
  21273. var
  21274. ProcArgs: TFPList;
  21275. i, ParamCnt, ParamCompatibility: Integer;
  21276. Param, Value: TPasExpr;
  21277. ParamResolved: TPasResolverResult;
  21278. Flags: TPasResolverComputeFlags;
  21279. begin
  21280. Result:=cExact;
  21281. ProcArgs:=ProcType.Args;
  21282. Value:=Params.Value;
  21283. if Value is TBinaryExpr then
  21284. Value:=TBinaryExpr(Value).right;
  21285. // check args
  21286. ParamCnt:=length(Params.Params);
  21287. i:=0;
  21288. while i<ParamCnt do
  21289. begin
  21290. Param:=Params.Params[i];
  21291. {$IFDEF VerbosePasResolver}
  21292. writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
  21293. {$ENDIF}
  21294. if i<ProcArgs.Count then
  21295. begin
  21296. ParamCompatibility:=CheckParamCompatibility(Param,
  21297. TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
  21298. if ParamCompatibility=cIncompatible then
  21299. exit(cIncompatible);
  21300. end
  21301. else
  21302. begin
  21303. if ptmVarargs in ProcType.Modifiers then
  21304. begin
  21305. if SetReferenceFlags then
  21306. Flags:=[rcNoImplicitProcType,rcSetReferenceFlags]
  21307. else
  21308. Flags:=[rcNoImplicitProcType];
  21309. ComputeElement(Param,ParamResolved,Flags,Param);
  21310. if not (rrfReadable in ParamResolved.Flags) then
  21311. begin
  21312. if RaiseOnError then
  21313. RaiseVarExpected(20180712001415,Param,ParamResolved.IdentEl);
  21314. exit(cIncompatible);
  21315. end;
  21316. ParamCompatibility:=cExact;
  21317. end
  21318. else
  21319. begin
  21320. // too many arguments
  21321. if RaiseOnError then
  21322. RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
  21323. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
  21324. exit(cIncompatible);
  21325. end;
  21326. end;
  21327. if Result<cTypeConversion then
  21328. inc(Result,ParamCompatibility)
  21329. else
  21330. Result:=Max(Result,ParamCompatibility);
  21331. inc(i);
  21332. end;
  21333. if (i<ProcArgs.Count) then
  21334. if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
  21335. begin
  21336. // not enough arguments
  21337. if RaiseOnError then
  21338. // ToDo: position cursor on identifier
  21339. RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
  21340. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
  21341. exit(cIncompatible);
  21342. end
  21343. else
  21344. begin
  21345. // the rest are default params
  21346. end;
  21347. end;
  21348. function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
  21349. Params: TParamsExpr; RaiseOnError: boolean): integer;
  21350. var
  21351. PropArg: TPasArgument;
  21352. ArgNo, ParamComp: Integer;
  21353. Param: TPasExpr;
  21354. PropArgs: TFPList;
  21355. begin
  21356. Result:=cExact;
  21357. PropArgs:=GetPasPropertyArgs(PropEl);
  21358. if PropArgs.Count<length(Params.Params) then
  21359. begin
  21360. if not RaiseOnError then exit(cIncompatible);
  21361. RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  21362. [PropEl.Name],Params)
  21363. end
  21364. else if PropArgs.Count>length(Params.Params) then
  21365. begin
  21366. if not RaiseOnError then exit(cIncompatible);
  21367. RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
  21368. [TPasArgument(PropArgs[length(Params.Params)]).Name],Params);
  21369. end;
  21370. for ArgNo:=0 to PropArgs.Count-1 do
  21371. begin
  21372. PropArg:=TPasArgument(PropArgs[ArgNo]);
  21373. Param:=Params.Params[ArgNo];
  21374. ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
  21375. if ParamComp=cIncompatible then
  21376. exit(cIncompatible);
  21377. inc(Result,ParamComp);
  21378. end;
  21379. end;
  21380. function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  21381. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
  21382. var
  21383. ArgNo: Integer;
  21384. Param: TPasExpr;
  21385. ParamResolved: TPasResolverResult;
  21386. procedure GetNextParam;
  21387. begin
  21388. if ArgNo>=length(Params.Params) then
  21389. RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  21390. [],Params);
  21391. Param:=Params.Params[ArgNo];
  21392. ComputeElement(Param,ParamResolved,[]);
  21393. inc(ArgNo);
  21394. end;
  21395. var
  21396. DimNo: integer;
  21397. RangeResolved, OrigRangeResolved, OrigParamResolved: TPasResolverResult;
  21398. bt: TResolverBaseType;
  21399. NextType, TypeEl: TPasType;
  21400. RangeExpr: TPasExpr;
  21401. TypeFits: Boolean;
  21402. ParamValue: TResEvalValue;
  21403. begin
  21404. ArgNo:=0;
  21405. repeat
  21406. if length(ArrayEl.Ranges)=0 then
  21407. begin
  21408. // dynamic/open array -> needs exactly one integer
  21409. GetNextParam;
  21410. if (not (rrfReadable in ParamResolved.Flags))
  21411. or not (ParamResolved.BaseType in btAllInteger) then
  21412. exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
  21413. if EmitHints then
  21414. begin
  21415. ParamValue:=Eval(Param,[refAutoConstExt]);
  21416. if ParamValue<>nil then
  21417. try // has const value -> check range
  21418. if ParamValue.Kind=revkExternal then
  21419. // ignore
  21420. else if (ParamValue.Kind<>revkInt)
  21421. or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
  21422. or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
  21423. fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
  21424. DynArrayMinIndex,DynArrayMaxIndex,Param);
  21425. finally
  21426. ReleaseEvalValue(ParamValue);
  21427. end;
  21428. end;
  21429. end
  21430. else
  21431. begin
  21432. // static array
  21433. for DimNo:=0 to length(ArrayEl.Ranges)-1 do
  21434. begin
  21435. GetNextParam;
  21436. RangeExpr:=ArrayEl.Ranges[DimNo];
  21437. ComputeElement(RangeExpr,RangeResolved,[]);
  21438. bt:=RangeResolved.BaseType;
  21439. if not (rrfReadable in ParamResolved.Flags) then
  21440. begin
  21441. if not RaiseOnError then exit(cIncompatible);
  21442. RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
  21443. [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
  21444. end;
  21445. TypeFits:=false;
  21446. OrigRangeResolved:=RangeResolved;
  21447. OrigParamResolved:=ParamResolved;
  21448. if bt=btRange then
  21449. begin
  21450. ConvertRangeToElement(RangeResolved);
  21451. bt:=RangeResolved.BaseType;
  21452. end;
  21453. if ParamResolved.BaseType=btRange then
  21454. begin
  21455. ConvertRangeToElement(ParamResolved);
  21456. end;
  21457. if (bt in btAllBooleans) then
  21458. begin
  21459. if (ParamResolved.BaseType in btAllBooleans) then
  21460. TypeFits:=true;
  21461. end
  21462. else if (bt in btAllInteger) then
  21463. begin
  21464. if (ParamResolved.BaseType in btAllInteger) then
  21465. TypeFits:=true;
  21466. end
  21467. else if (bt in btAllChars) then
  21468. begin
  21469. if (ParamResolved.BaseType in btAllChars) then
  21470. TypeFits:=true;
  21471. end
  21472. else if (bt=btContext) then
  21473. begin
  21474. TypeEl:=RangeResolved.LoTypeEl;
  21475. if ParamResolved.BaseType=btContext then
  21476. begin
  21477. if (TypeEl.ClassType=TPasEnumType)
  21478. and IsSameType(TypeEl,ParamResolved.LoTypeEl,prraNone) then
  21479. TypeFits:=true;
  21480. end;
  21481. end;
  21482. if not TypeFits then
  21483. begin
  21484. // incompatible
  21485. if not RaiseOnError then exit(cIncompatible);
  21486. RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
  21487. [IntToStr(ArgNo)],OrigParamResolved,OrigRangeResolved,Param);
  21488. end;
  21489. if EmitHints then
  21490. fExprEvaluator.IsInRange(Param,RangeExpr,true);
  21491. end;
  21492. end;
  21493. if ArgNo=length(Params.Params) then exit(cExact);
  21494. // there are more parameters -> continue in sub array
  21495. NextType:=ResolveAliasType(ArrayEl.ElType);
  21496. if NextType.ClassType<>TPasArrayType then
  21497. RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  21498. [],Params);
  21499. ArrayEl:=TPasArrayType(NextType);
  21500. until false;
  21501. Result:=cIncompatible;
  21502. end;
  21503. function TPasResolver.CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  21504. // returns if number and type of arguments fit
  21505. // does not check calling convention
  21506. var
  21507. ProcArgs1, ProcArgs2, TemplTypes1, TemplTypes2: TFPList;
  21508. i, Comp: Integer;
  21509. begin
  21510. Result:=false;
  21511. if (Proc1.NameParts<>nil) or (Proc2.NameParts<>nil) then
  21512. begin
  21513. TemplTypes1:=GetProcTemplateTypes(Proc1);
  21514. TemplTypes2:=GetProcTemplateTypes(Proc2);
  21515. if TemplTypes1=nil then
  21516. begin
  21517. if TemplTypes2<>nil then
  21518. exit;
  21519. end
  21520. else if TemplTypes2=nil then
  21521. exit
  21522. else if TemplTypes1.Count<>TemplTypes2.Count then
  21523. exit;
  21524. end;
  21525. ProcArgs1:=Proc1.ProcType.Args;
  21526. ProcArgs2:=Proc2.ProcType.Args;
  21527. {$IFDEF VerbosePasResolver}
  21528. writeln('TPasResolver.CheckProcOverloadCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
  21529. {$ENDIF}
  21530. // check args
  21531. if ProcArgs1.Count<>ProcArgs2.Count then
  21532. exit;
  21533. for i:=0 to ProcArgs1.Count-1 do
  21534. begin
  21535. {$IFDEF VerbosePasResolver}
  21536. writeln('TPasResolver.CheckProcOverloadCompatibility ',i,'/',ProcArgs1.Count);
  21537. {$ENDIF}
  21538. Comp:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
  21539. if Comp>cExact then
  21540. exit;
  21541. end;
  21542. Result:=true;
  21543. end;
  21544. function TPasResolver.CheckProcTypeCompatibility(Proc1,
  21545. Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
  21546. RaiseOnIncompatible: boolean): boolean;
  21547. // if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
  21548. function ModifierError(Modifier: TProcTypeModifier): boolean;
  21549. begin
  21550. Result:=false;
  21551. if not RaiseOnIncompatible then exit;
  21552. RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
  21553. [GetElementTypeName(Proc1),ProcTypeModifiers[Modifier]],ErrorEl);
  21554. end;
  21555. var
  21556. ProcArgs1, ProcArgs2: TFPList;
  21557. i: Integer;
  21558. Result1Resolved, Result2Resolved: TPasResolverResult;
  21559. ExpectedArg, ActualArg: TPasArgument;
  21560. begin
  21561. Result:=false;
  21562. if Proc1.ClassType<>Proc2.ClassType then
  21563. begin
  21564. if RaiseOnIncompatible then
  21565. RaiseXExpectedButYFound(20170402112353,GetElementTypeName(Proc1),GetElementTypeName(Proc2),ErrorEl);
  21566. exit;
  21567. end;
  21568. if Proc1.IsReferenceTo then
  21569. begin
  21570. if IsAssign then
  21571. // aRefTo:=aproc -> any IsNested/OfObject is allowed
  21572. else
  21573. ; // aRefTo = AnyProc -> ok
  21574. end
  21575. else if Proc2.IsReferenceTo then
  21576. begin
  21577. if IsAssign then
  21578. // NonRefTo := aRefTo -> not possible
  21579. exit(ModifierError(ptmReferenceTo))
  21580. else
  21581. ; // AnyProc = aRefTo -> ok
  21582. end
  21583. else if Proc2.Parent is TPasAnonymousProcedure then
  21584. begin
  21585. if IsAssign then
  21586. // NonRefTo := AnonymousProc -> not possible
  21587. exit(ModifierError(ptmReferenceTo))
  21588. else
  21589. ; // AnyProc = AnonymousProc -> ok
  21590. end
  21591. else
  21592. begin
  21593. // neither Proc1 nor Proc2 is a reference-to -> check isNested and OfObject
  21594. if Proc1.IsNested<>Proc2.IsNested then
  21595. exit(ModifierError(ptmIsNested));
  21596. if Proc1.IsOfObject<>Proc2.IsOfObject then
  21597. begin
  21598. if (proProcTypeWithoutIsNested in Options) then
  21599. exit(ModifierError(ptmOfObject))
  21600. else if Proc1.IsNested then
  21601. // "is nested" can handle both, proc and method.
  21602. else
  21603. exit(ModifierError(ptmOfObject))
  21604. end;
  21605. end;
  21606. if Proc1.CallingConvention<>Proc2.CallingConvention then
  21607. begin
  21608. if RaiseOnIncompatible then
  21609. RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
  21610. [],ErrorEl);
  21611. exit;
  21612. end;
  21613. ProcArgs1:=Proc1.Args;
  21614. ProcArgs2:=Proc2.Args;
  21615. if ProcArgs1.Count<>ProcArgs2.Count then
  21616. begin
  21617. if RaiseOnIncompatible then
  21618. RaiseMsg(20170902142829,nIncompatibleTypesGotParametersExpected,
  21619. sIncompatibleTypesGotParametersExpected,
  21620. [IntToStr(ProcArgs1.Count),IntToStr(ProcArgs2.Count)],ErrorEl);
  21621. exit;
  21622. end;
  21623. for i:=0 to ProcArgs1.Count-1 do
  21624. begin
  21625. {$IFDEF VerbosePasResolver}
  21626. writeln('TPasResolver.CheckProcTypeCompatibility ',i,'/',ProcArgs1.Count);
  21627. {$ENDIF}
  21628. ExpectedArg:=TPasArgument(ProcArgs1[i]);
  21629. ActualArg:=TPasArgument(ProcArgs2[i]);
  21630. if CheckProcArgCompatibility(ExpectedArg,ActualArg)>cGenericExact then
  21631. begin
  21632. if RaiseOnIncompatible then
  21633. begin
  21634. if ExpectedArg.Access<>ActualArg.Access then
  21635. RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  21636. [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
  21637. AccessDescriptions[ExpectedArg.Access]],
  21638. ErrorEl);
  21639. RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
  21640. [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
  21641. end;
  21642. exit;
  21643. end;
  21644. end;
  21645. if Proc1 is TPasFunctionType then
  21646. begin
  21647. ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
  21648. ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
  21649. if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
  21650. or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
  21651. begin
  21652. if RaiseOnIncompatible then
  21653. RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
  21654. [],Result1Resolved,Result2Resolved,ErrorEl);
  21655. exit;
  21656. end;
  21657. end;
  21658. Result:=true;
  21659. end;
  21660. function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument
  21661. ): integer;
  21662. begin
  21663. // check access: var, const, ...
  21664. if Arg1.Access<>Arg2.Access then exit(cIncompatible);
  21665. Result:=CheckElTypeCompatibility(Arg1.ArgType,Arg2.ArgType,prraSimple);
  21666. end;
  21667. function TPasResolver.CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  21668. ResolveAlias: TPRResolveAlias): integer;
  21669. var
  21670. Arg1Resolved, Arg2Resolved: TPasResolverResult;
  21671. C: TClass;
  21672. Arr1, Arr2: TPasArrayType;
  21673. TemplType1, TemplType2: TPasGenericTemplateType;
  21674. Templates1, Templates2: TFPList;
  21675. i: Integer;
  21676. begin
  21677. if Arg1=Arg2 then exit(cExact);
  21678. ComputeElement(Arg1,Arg1Resolved,[rcType]);
  21679. ComputeElement(Arg2,Arg2Resolved,[rcType]);
  21680. {$IFDEF VerbosePasResolver}
  21681. writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
  21682. {$ENDIF}
  21683. if IsGenericTemplType(Arg1Resolved) then
  21684. begin
  21685. Result:=cGenericExact;
  21686. if Arg1Resolved.LoTypeEl=Arg2Resolved.LoTypeEl then
  21687. exit(cExact)
  21688. else if IsGenericTemplType(Arg2Resolved) then
  21689. begin
  21690. TemplType1:=TPasGenericTemplateType(Arg1Resolved.LoTypeEl);
  21691. TemplType2:=TPasGenericTemplateType(Arg2Resolved.LoTypeEl);
  21692. if (TemplType1.Parent is TPasProcedure)
  21693. and (TemplType2.Parent is TPasProcedure) then
  21694. begin
  21695. Templates1:=GetProcTemplateTypes(TPasProcedure(TemplType1.Parent));
  21696. Templates2:=GetProcTemplateTypes(TPasProcedure(TemplType2.Parent));
  21697. i:=Templates1.IndexOf(TemplType1);
  21698. if (i>=0) and (i=Templates2.IndexOf(TemplType2)) then
  21699. exit(cExact);
  21700. end;
  21701. end;
  21702. exit;
  21703. end
  21704. else if IsGenericTemplType(Arg2Resolved) then
  21705. exit(cGenericExact);
  21706. if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
  21707. or (Arg1Resolved.LoTypeEl=nil)
  21708. or (Arg2Resolved.LoTypeEl=nil) then
  21709. exit(cIncompatible);
  21710. if ResolveAlias=prraSimple then
  21711. begin
  21712. if IsSameType(Arg1Resolved.HiTypeEl,Arg2Resolved.HiTypeEl,prraSimple) then
  21713. exit(cExact);
  21714. end
  21715. else
  21716. begin
  21717. if IsSameType(Arg1Resolved.LoTypeEl,Arg2Resolved.LoTypeEl,prraNone) then
  21718. exit(cExact);
  21719. end;
  21720. if Arg1Resolved.BaseType=btContext then
  21721. begin
  21722. C:=Arg1Resolved.LoTypeEl.ClassType;
  21723. if C<>Arg2Resolved.LoTypeEl.ClassType then
  21724. exit(cIncompatible);
  21725. if C=TPasArrayType then
  21726. begin
  21727. Arr1:=TPasArrayType(Arg1Resolved.LoTypeEl);
  21728. Arr2:=TPasArrayType(Arg2Resolved.LoTypeEl);
  21729. if length(Arr1.Ranges)<>length(Arr2.Ranges) then
  21730. exit(cIncompatible);
  21731. if length(Arr1.Ranges)>0 then
  21732. RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
  21733. Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
  21734. exit;
  21735. end;
  21736. end;
  21737. Result:=cIncompatible;
  21738. end;
  21739. function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  21740. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  21741. var
  21742. El: TPasElement;
  21743. begin
  21744. Result:=false;
  21745. El:=ResolvedEl.IdentEl;
  21746. if El=nil then
  21747. begin
  21748. if (ResolvedEl.ExprEl is TUnaryExpr)
  21749. and (TUnaryExpr(ResolvedEl.ExprEl).OpCode=eopDeref) then
  21750. begin
  21751. // e.g. p^:=
  21752. end
  21753. else
  21754. begin
  21755. if ErrorOnFalse then
  21756. begin
  21757. {$IFDEF VerbosePasResolver}
  21758. writeln('TPasResolver.CheckCanBeLHS no identifier: ',GetResolverResultDbg(ResolvedEl));
  21759. {$ENDIF}
  21760. if (ResolvedEl.LoTypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
  21761. RaiseXExpectedButYFound(20170216152727,'identifier',GetElementTypeName(ResolvedEl.LoTypeEl),ResolvedEl.ExprEl)
  21762. else
  21763. RaiseVarExpected(20170216152426,ErrorEl,ResolvedEl.IdentEl);
  21764. end;
  21765. exit;
  21766. end;
  21767. end;
  21768. if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
  21769. exit(not IsVariableConst(El,ErrorEl,ErrorOnFalse));
  21770. // not writable
  21771. if not ErrorOnFalse then exit;
  21772. {$IFDEF VerbosePasResolver}
  21773. writeln('TPasResolver.CheckCanBeLHS not writable: ',GetResolverResultDbg(ResolvedEl));
  21774. {$ENDIF}
  21775. if ResolvedEl.IdentEl is TPasProperty then
  21776. RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
  21777. else if ResolvedEl.IdentEl is TPasConst then
  21778. RaiseMsg(20180430012042,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],ErrorEl)
  21779. else
  21780. RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  21781. end;
  21782. function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
  21783. RaiseOnIncompatible: boolean; ErrorEl: TPasElement): integer;
  21784. var
  21785. LeftResolved, RightResolved: TPasResolverResult;
  21786. Flags: TPasResolverComputeFlags;
  21787. IsProcType: Boolean;
  21788. begin
  21789. if ErrorEl=nil then
  21790. ErrorEl:=RHS;
  21791. ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
  21792. Flags:=[];
  21793. IsProcType:=IsProcedureType(LeftResolved,true);
  21794. if IsProcType then
  21795. if msDelphi in CurrentParser.CurrentModeswitches then
  21796. Include(Flags,rcNoImplicitProc)
  21797. else
  21798. Include(Flags,rcNoImplicitProcType);
  21799. ComputeElement(RHS,RightResolved,Flags);
  21800. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  21801. if RHS is TPasExpr then
  21802. CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
  21803. end;
  21804. procedure TPasResolver.CheckAssignExprRange(
  21805. const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  21806. // if RHS is a constant check if it fits into range LeftResolved
  21807. var
  21808. LRangeValue, RValue: TResEvalValue;
  21809. Int, MinVal, MaxVal: TMaxPrecInt;
  21810. RangeExpr: TBinaryExpr;
  21811. C: TClass;
  21812. EnumType: TPasEnumType;
  21813. bt: TResolverBaseType;
  21814. LTypeEl: TPasType;
  21815. begin
  21816. LTypeEl:=LeftResolved.LoTypeEl;
  21817. if (LTypeEl<>nil)
  21818. and ((LTypeEl.ClassType=TPasArrayType)
  21819. or (LTypeEl.ClassType=TPasRecordType)) then
  21820. exit; // arrays and records are checked by element, not by the whole value
  21821. if LTypeEl is TPasClassOfType then
  21822. exit; // class-of are checked only by type, not by value
  21823. RValue:=Eval(RHS,[refAutoConstExt]);
  21824. if RValue=nil then
  21825. exit; // not a const expression
  21826. {$IFDEF VerbosePasResEval}
  21827. writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
  21828. {$ENDIF}
  21829. LRangeValue:=nil;
  21830. try
  21831. if RValue.Kind=revkExternal then
  21832. // skip
  21833. else if LeftResolved.BaseType=btCustom then
  21834. CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
  21835. else if LeftResolved.BaseType=btSet then
  21836. begin
  21837. // assign to a set
  21838. C:=LTypeEl.ClassType;
  21839. if C=TPasRangeType then
  21840. begin
  21841. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  21842. LRangeValue:=Eval(RangeExpr,[refConst],false);
  21843. end
  21844. else if C=TPasEnumType then
  21845. begin
  21846. EnumType:=TPasEnumType(LTypeEl);
  21847. LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
  21848. 0,TMaxPrecInt(EnumType.Values.Count)-1);
  21849. end
  21850. else if C=TPasUnresolvedSymbolRef then
  21851. begin
  21852. // set of basetype
  21853. if LTypeEl.CustomData is TResElDataBaseType then
  21854. begin
  21855. bt:=GetActualBaseType(TResElDataBaseType(LTypeEl.CustomData).BaseType);
  21856. if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinVal,MaxVal) then
  21857. LRangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
  21858. else if bt=btBoolean then
  21859. LRangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
  21860. {$ifdef FPC_HAS_CPSTRING}
  21861. else if bt=btAnsiChar then
  21862. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  21863. {$endif}
  21864. else if bt=btWideChar then
  21865. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
  21866. else
  21867. RaiseNotYetImplemented(20170714205110,RHS);
  21868. end
  21869. else
  21870. RaiseNotYetImplemented(20170714204803,RHS);
  21871. end
  21872. else
  21873. RaiseNotYetImplemented(20170714193100,RHS);
  21874. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true);
  21875. end
  21876. else if LTypeEl is TPasRangeType then
  21877. begin
  21878. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  21879. LRangeValue:=Eval(RangeExpr,[refConst]);
  21880. if LeftResolved.BaseType=btSet then
  21881. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true)
  21882. else
  21883. fExprEvaluator.IsInRange(RValue,RHS,LRangeValue,RangeExpr,true);
  21884. end
  21885. else if (LeftResolved.BaseType in btAllIntegerNoQWord)
  21886. and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
  21887. case RValue.Kind of
  21888. revkInt:
  21889. if (MinVal>TResEvalInt(RValue).Int)
  21890. or (MaxVal<TResEvalInt(RValue).Int) then
  21891. fExprEvaluator.EmitRangeCheckConst(20170530093126,
  21892. IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
  21893. revkUInt:
  21894. if (TResEvalUInt(RValue).UInt>High(TMaxPrecInt))
  21895. or (MinVal>TMaxPrecInt(TResEvalUInt(RValue).UInt))
  21896. or (MaxVal<TMaxPrecInt(TResEvalUInt(RValue).UInt)) then
  21897. fExprEvaluator.EmitRangeCheckConst(20170530093616,
  21898. IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
  21899. revkFloat:
  21900. if TResEvalFloat(RValue).IsInt(Int) then
  21901. begin
  21902. if (MinVal>Int) or (MaxVal<Int) then
  21903. fExprEvaluator.EmitRangeCheckConst(20170802133307,
  21904. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  21905. end
  21906. else
  21907. begin
  21908. {$IFDEF VerbosePasResEval}
  21909. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<TMaxPrecFloat(low(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>TMaxPrecFloat(high(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(TMaxPrecInt));
  21910. {$ENDIF}
  21911. RaiseRangeCheck(20170802133750,RHS);
  21912. end;
  21913. revkCurrency:
  21914. if TResEvalCurrency(RValue).IsInt(Int) then
  21915. begin
  21916. if (MinVal>Int) or (MaxVal<Int) then
  21917. fExprEvaluator.EmitRangeCheckConst(20180421171325,
  21918. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  21919. end
  21920. else
  21921. begin
  21922. {$IFDEF VerbosePasResEval}
  21923. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalCurrency(RValue).Value),' ',TResEvalCurrency(RValue).Value,' ',high(TMaxPrecInt));
  21924. {$ENDIF}
  21925. RaiseRangeCheck(20180421171438,RHS);
  21926. end;
  21927. else
  21928. {$IFDEF VerbosePasResEval}
  21929. writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
  21930. {$ENDIF}
  21931. RaiseNotYetImplemented(20170530092731,RHS);
  21932. end
  21933. {$ifdef HasInt64}
  21934. else if LeftResolved.BaseType=btQWord then
  21935. case RValue.Kind of
  21936. revkInt:
  21937. if (TResEvalInt(RValue).Int<0) then
  21938. fExprEvaluator.EmitRangeCheckConst(20170530094316,
  21939. IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
  21940. revkUInt: ;
  21941. else
  21942. RaiseNotYetImplemented(20170530094311,RHS);
  21943. end
  21944. {$endif}
  21945. else if RValue.Kind in [revkNil,revkBool] then
  21946. // simple type check is enough
  21947. else if LeftResolved.BaseType in [btSingle,btDouble,btCurrency] then
  21948. // simple type check is enough
  21949. // ToDo: warn if precision loss
  21950. else if LeftResolved.BaseType in btAllChars then
  21951. begin
  21952. case RValue.Kind of
  21953. {$ifdef FPC_HAS_CPSTRING}
  21954. revkString,
  21955. {$endif}
  21956. revkUnicodeString:
  21957. Int:=fExprEvaluator.StringToOrd(RValue,RHS);
  21958. else
  21959. RaiseNotYetImplemented(20170714171218,RHS);
  21960. end;
  21961. case GetActualBaseType(LeftResolved.BaseType) of
  21962. {$ifdef FPC_HAS_CPSTRING}
  21963. btAnsiChar: MaxVal:=$ff;
  21964. {$endif}
  21965. btWideChar: MaxVal:=$ffff;
  21966. end;
  21967. if (Int>MaxVal) then
  21968. fExprEvaluator.EmitRangeCheckConst(20170714171911,
  21969. '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
  21970. end
  21971. else if LeftResolved.BaseType in btAllStrings then
  21972. // simple type check is enough
  21973. // ToDo: warn if unicode to non-utf8
  21974. else if LeftResolved.BaseType=btContext then
  21975. // simple type check is enough
  21976. else if LeftResolved.BaseType=btRange then
  21977. begin
  21978. if (LeftResolved.ExprEl is TBinaryExpr)
  21979. and (TBinaryExpr(LeftResolved.ExprEl).Kind=pekRange) then
  21980. begin
  21981. LRangeValue:=Eval(LeftResolved.ExprEl,[refConst]);
  21982. try
  21983. case LRangeValue.Kind of
  21984. revkRangeInt:
  21985. case TResEvalRangeInt(LRangeValue).ElKind of
  21986. revskEnum:
  21987. if (RValue.Kind<>revkEnum) then
  21988. RaiseNotYetImplemented(20171009171251,RHS)
  21989. else if (TResEvalEnum(RValue).Index<TResEvalRangeInt(LRangeValue).RangeStart)
  21990. or (TResEvalEnum(RValue).Index>TResEvalRangeInt(LRangeValue).RangeEnd) then
  21991. fExprEvaluator.EmitRangeCheckConst(20171009171442,
  21992. TResEvalEnum(RValue).AsString,
  21993. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeStart),
  21994. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeEnd),
  21995. RHS);
  21996. else
  21997. RaiseNotYetImplemented(20171009165348,LeftResolved.ExprEl);
  21998. end;
  21999. else
  22000. RaiseNotYetImplemented(20171009165326,LeftResolved.ExprEl);
  22001. end;
  22002. finally
  22003. ReleaseEvalValue(LRangeValue);
  22004. end;
  22005. end
  22006. else
  22007. RaiseNotYetImplemented(20171009171005,RHS);
  22008. end
  22009. else
  22010. begin
  22011. {$IFDEF VerbosePasResolver}
  22012. writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
  22013. {$ENDIF}
  22014. RaiseNotYetImplemented(20170530095243,RHS);
  22015. end;
  22016. finally
  22017. ReleaseEvalValue(RValue);
  22018. ReleaseEvalValue(LRangeValue);
  22019. end;
  22020. end;
  22021. procedure TPasResolver.CheckAssignExprRangeToCustom(
  22022. const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
  22023. begin
  22024. if LeftResolved.BaseType<>btCustom then exit;
  22025. if RValue=nil then exit;
  22026. if RHS=nil then ;
  22027. end;
  22028. function TPasResolver.CheckAssignResCompatibility(const LHS,
  22029. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  22030. ): integer;
  22031. var
  22032. LTypeEl, RTypeEl: TPasType;
  22033. Handled: Boolean;
  22034. C: TClass;
  22035. LBT, RBT: TResolverBaseType;
  22036. LRange, RValue, Value: TResEvalValue;
  22037. RightSubResolved: TPasResolverResult;
  22038. wc: WideChar;
  22039. begin
  22040. // check if the RHS can be converted to LHS
  22041. {$IFDEF VerbosePasResolver}
  22042. writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  22043. {$ENDIF}
  22044. Result:=-1;
  22045. Handled:=false;
  22046. Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
  22047. if Handled and (Result>=cExact) and (Result<cIncompatible) then
  22048. exit;
  22049. if not Handled then
  22050. begin
  22051. LBT:=GetActualBaseType(LHS.BaseType);
  22052. RBT:=GetActualBaseType(RHS.BaseType);
  22053. if IsGenericTemplType(LHS) then
  22054. begin
  22055. // Template := RHS
  22056. if not RaiseOnIncompatible then
  22057. ErrorEl:=nil;
  22058. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),
  22059. RHS,prtcoAssignToTempl,ErrorEl);
  22060. exit;
  22061. end
  22062. else if IsGenericTemplType(RHS) then
  22063. begin
  22064. // LHS := Template
  22065. if not RaiseOnIncompatible then
  22066. ErrorEl:=nil;
  22067. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),
  22068. LHS,prtcoAssignFromTempl,ErrorEl);
  22069. exit;
  22070. end;
  22071. if LHS.LoTypeEl=nil then
  22072. begin
  22073. if LBT=btUntyped then
  22074. begin
  22075. // untyped parameter
  22076. Result:=cTypeConversion;
  22077. end
  22078. else
  22079. RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
  22080. end
  22081. else if LBT=RBT then
  22082. begin
  22083. if LBT=btContext then
  22084. exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
  22085. else
  22086. begin
  22087. // same base type, maybe not same type (e.g. longint and integer)
  22088. if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  22089. and HasExactType(RHS) then
  22090. Result:=cExact
  22091. else
  22092. Result:=cAliasExact;
  22093. end;
  22094. end
  22095. else if (LBT in btAllBooleans)
  22096. and (RBT in btAllBooleans) then
  22097. Result:=cCompatible
  22098. else if (LBT in btAllChars) then
  22099. begin
  22100. if (RBT in btAllChars) then
  22101. case LBT of
  22102. {$ifdef FPC_HAS_CPSTRING}
  22103. btAnsiChar:
  22104. Result:=cLossyConversion;
  22105. {$endif}
  22106. btWideChar:
  22107. {$ifdef FPC_HAS_CPSTRING}
  22108. if RBT=btAnsiChar then
  22109. Result:=cCompatible
  22110. else
  22111. {$endif}
  22112. Result:=cLossyConversion;
  22113. else
  22114. RaiseNotYetImplemented(20170728132440,ErrorEl,BaseTypeNames[LBT]);
  22115. end
  22116. else if (RBT=btRange) and (RHS.SubType in btAllChars) then
  22117. begin
  22118. if LBT=btWideChar then
  22119. exit(cCompatible);
  22120. {$ifdef FPC_HAS_CPSTRING}
  22121. // LHS is ansichar
  22122. if GetActualBaseType(RHS.SubType)=btAnsiChar then
  22123. exit(cExact);
  22124. RValue:=Eval(RHS,[refAutoConstExt]);
  22125. if RValue<>nil then
  22126. try
  22127. // ansichar:=constvalue
  22128. case RValue.Kind of
  22129. revkString:
  22130. if not ExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  22131. exit(cIncompatible);
  22132. revkUnicodeString:
  22133. begin
  22134. if length(TResEvalUTF16(RValue).S)<>1 then
  22135. exit(cIncompatible);
  22136. wc:=TResEvalUTF16(RValue).S[1];
  22137. end;
  22138. revkExternal:
  22139. exit(cCompatible);
  22140. else
  22141. RaiseNotYetImplemented(20171108194650,ErrorEl);
  22142. end;
  22143. if ord(wc)>255 then
  22144. exit(cIncompatible);
  22145. exit(cCompatible);
  22146. finally
  22147. ReleaseEvalValue(RValue);
  22148. end;
  22149. // LHS is ansichar, RHS is not a const
  22150. if (RHS.ExprEl is TBinaryExpr) and (TBinaryExpr(RHS.ExprEl).Kind=pekRange) then
  22151. begin
  22152. RValue:=Eval(RHS.ExprEl,[refConst]);
  22153. try
  22154. if RValue.Kind<>revkRangeInt then
  22155. RaiseNotYetImplemented(20171108195035,ErrorEl);
  22156. if TResEvalRangeInt(RValue).RangeStart>255 then
  22157. exit(cIncompatible);
  22158. if TResEvalRangeInt(RValue).RangeEnd>255 then
  22159. exit(cLossyConversion);
  22160. exit(cCompatible);
  22161. finally
  22162. ReleaseEvalValue(RValue);
  22163. end;
  22164. end;
  22165. {$endif}
  22166. RaiseNotYetImplemented(20171108195216,ErrorEl);
  22167. end;
  22168. end
  22169. else if (LBT in btAllStrings) then
  22170. begin
  22171. if (RBT in btAllStringAndChars) then
  22172. case LBT of
  22173. {$ifdef FPC_HAS_CPSTRING}
  22174. btAnsiString:
  22175. if RBT in [btAnsiChar,btShortString,btRawByteString] then
  22176. Result:=cCompatible
  22177. else
  22178. Result:=cLossyConversion;
  22179. btShortString:
  22180. if RBT=btAnsiChar then
  22181. Result:=cCompatible
  22182. else
  22183. Result:=cLossyConversion;
  22184. btRawByteString:
  22185. if RBT in [btAnsiChar,btAnsiString,btShortString] then
  22186. Result:=cCompatible
  22187. else
  22188. Result:=cLossyConversion;
  22189. {$endif}
  22190. btWideString,btUnicodeString:
  22191. Result:=cCompatible;
  22192. else
  22193. {$IFDEF VerbosePasResolver}
  22194. writeln('TPasResolver.CheckAssignResCompatibility ',{$ifdef pas2js}str(LBT){$else}LBT{$ENDIF});
  22195. {$ENDIF}
  22196. RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
  22197. end
  22198. else if RBT=btContext then
  22199. begin
  22200. RTypeEl:=RHS.LoTypeEl;
  22201. if RTypeEl.ClassType=TPasClassType then
  22202. begin
  22203. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  22204. and IsTGUIDString(LHS) then
  22205. // aGUIDString:=IntfTypeOrVar
  22206. exit(cInterfaceToString); // no check for rrfReadable
  22207. end
  22208. else if RTypeEl.ClassType=TPasRecordType then
  22209. begin
  22210. if IsTGUID(TPasRecordType(RTypeEl)) then
  22211. // aString:=GUID
  22212. Result:=cTGUIDToString;
  22213. end;
  22214. end;
  22215. end
  22216. else if (LBT in btAllInteger)
  22217. and (RBT in btAllInteger) then
  22218. begin
  22219. Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
  22220. case LBT of
  22221. btByte,
  22222. btShortInt: inc(Result,cLossyConversion);
  22223. btWord,
  22224. btSmallInt:
  22225. if not (RBT in [btByte,btShortInt]) then
  22226. inc(Result,cLossyConversion);
  22227. btUIntSingle:
  22228. if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
  22229. inc(Result,cLossyConversion);
  22230. btIntSingle:
  22231. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
  22232. inc(Result,cLossyConversion);
  22233. btLongWord,
  22234. btLongint:
  22235. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
  22236. inc(Result,cLossyConversion);
  22237. btUIntDouble:
  22238. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
  22239. inc(Result,cLossyConversion);
  22240. btIntDouble:
  22241. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
  22242. inc(Result,cLossyConversion);
  22243. {$ifdef HasInt64}
  22244. btQWord,
  22245. btInt64,btComp:
  22246. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
  22247. btLongWord,btLongint,btUIntDouble,btIntDouble]) then
  22248. inc(Result,cLossyConversion);
  22249. {$endif}
  22250. else
  22251. RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
  22252. end;
  22253. end
  22254. else if (LBT in btAllFloats)
  22255. and (RBT in btAllFloats) then
  22256. begin
  22257. Result:=cFloatToFloatConversion+ord(LBT)-ord(RBT);
  22258. case LBT of
  22259. btSingle:
  22260. if RBT>btSingle then
  22261. inc(Result,cLossyConversion);
  22262. btDouble:
  22263. if RBT>btDouble then
  22264. inc(Result,cLossyConversion);
  22265. btExtended,btCExtended:
  22266. if RBT>btCExtended then
  22267. inc(Result,cLossyConversion);
  22268. btCurrency:
  22269. inc(Result,cLossyConversion);
  22270. else
  22271. RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
  22272. end;
  22273. end
  22274. else if (LBT in btAllFloats)
  22275. and (RBT in btAllInteger) then
  22276. begin
  22277. Result:=cIntToFloatConversion+ord(LBT)-ord(RBT);
  22278. case LBT of
  22279. btSingle:
  22280. if RBT>btUIntSingle then
  22281. inc(Result,cLossyConversion);
  22282. btDouble:
  22283. if RBT>btUIntDouble then
  22284. inc(Result,cLossyConversion);
  22285. btExtended,btCExtended:
  22286. if RBT>btCExtended then
  22287. inc(Result,cLossyConversion);
  22288. btCurrency:
  22289. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  22290. btIntSingle,btUIntSingle,
  22291. btLongWord,btLongint]) then
  22292. inc(Result,cLossyConversion);
  22293. else
  22294. RaiseNotYetImplemented(20170417205911,ErrorEl,BaseTypeNames[LBT]);
  22295. end;
  22296. end
  22297. else if LBT=btNil then
  22298. begin
  22299. if RaiseOnIncompatible then
  22300. RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
  22301. [],ErrorEl);
  22302. exit(cIncompatible);
  22303. end
  22304. else if LBT=btRange then
  22305. begin
  22306. if (LHS.ExprEl is TBinaryExpr) and (TBinaryExpr(LHS.ExprEl).Kind=pekRange) then
  22307. begin
  22308. LRange:=Eval(LHS.ExprEl,[refConst]);
  22309. RValue:=nil;
  22310. try
  22311. {$IFDEF VerbosePasResolver}
  22312. //writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString);
  22313. {$ENDIF}
  22314. case LRange.Kind of
  22315. revkRangeInt:
  22316. case TResEvalRangeInt(LRange).ElKind of
  22317. revskEnum:
  22318. if RHS.BaseType=btContext then
  22319. begin
  22320. if IsSameType(TResEvalRangeInt(LRange).ElType,RHS.LoTypeEl,prraAlias) then
  22321. begin
  22322. // same enum type
  22323. {$IFDEF VerbosePasResolver}
  22324. writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString,' Left.ElType=',GetObjName(TResEvalRangeInt(LRange).ElType),' RHS.TypeEl=',GetObjName(RHS.LoTypeEl));
  22325. {$ENDIF}
  22326. // ToDo: check if LRange is smaller than Range of RHS (cLossyConversion)
  22327. exit(cExact);
  22328. end;
  22329. end;
  22330. revskInt:
  22331. if RHS.BaseType in btAllInteger then
  22332. begin
  22333. RValue:=Eval(RHS,[refAutoConstExt]);
  22334. if RValue<>nil then
  22335. begin
  22336. // ToDo: check range
  22337. end;
  22338. exit(cCompatible);
  22339. end;
  22340. revskChar:
  22341. if RHS.BaseType in btAllStringAndChars then
  22342. begin
  22343. RValue:=Eval(RHS,[refAutoConstExt]);
  22344. if RValue<>nil then
  22345. begin
  22346. case RValue.Kind of
  22347. {$ifdef FPC_HAS_CPSTRING}
  22348. revkString:
  22349. if not fExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  22350. exit(cIncompatible);
  22351. {$endif}
  22352. revkUnicodeString:
  22353. begin
  22354. if length(TResEvalUTF16(RValue).S)<>1 then
  22355. exit(cIncompatible);
  22356. wc:=TResEvalUTF16(RValue).S[1];
  22357. end;
  22358. revkExternal:
  22359. exit(cCompatible);
  22360. else
  22361. RaiseNotYetImplemented(20171108192232,ErrorEl);
  22362. end;
  22363. if (ord(wc)<TResEvalRangeInt(LRange).RangeStart)
  22364. or (ord(wc)>TResEvalRangeInt(LRange).RangeEnd) then
  22365. exit(cIncompatible);
  22366. end;
  22367. exit(cCompatible);
  22368. end;
  22369. revskBool:
  22370. if RHS.BaseType=btBoolean then
  22371. begin
  22372. RValue:=Eval(RHS,[refAutoConstExt]);
  22373. if RValue<>nil then
  22374. begin
  22375. // ToDo: check range
  22376. end;
  22377. exit(cCompatible);
  22378. end;
  22379. end;
  22380. end;
  22381. finally
  22382. ReleaseEvalValue(LRange);
  22383. ReleaseEvalValue(RValue);
  22384. end;
  22385. end;
  22386. end
  22387. else if LBT=btSet then
  22388. begin
  22389. if RBT=btArrayOrSet then
  22390. begin
  22391. if RHS.SubType=btNone then
  22392. // a:=[]
  22393. Result:=cExact
  22394. else if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  22395. and HasExactType(RHS) then
  22396. Result:=cExact
  22397. else if LHS.SubType=RHS.SubType then
  22398. Result:=cAliasExact
  22399. else if (LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans) then
  22400. Result:=cCompatible
  22401. else if (LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger) then
  22402. begin
  22403. // ToDo: range check
  22404. Result:=cCompatible;
  22405. end
  22406. else if (LHS.SubType in btAllChars) and (RHS.SubType in btAllChars) then
  22407. begin
  22408. // ToDo: range check
  22409. Result:=cCompatible;
  22410. end;
  22411. end;
  22412. end
  22413. else if LBT in [btArrayLit,btArrayOrSet,btModule,btProc] then
  22414. begin
  22415. if RaiseOnIncompatible then
  22416. RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  22417. exit(cIncompatible);
  22418. end
  22419. else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
  22420. begin
  22421. if RaiseOnIncompatible then
  22422. RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  22423. exit(cIncompatible);
  22424. end
  22425. else if RBT=btNil then
  22426. begin
  22427. if LBT=btPointer then
  22428. Result:=cExact
  22429. else if LBT=btContext then
  22430. begin
  22431. LTypeEl:=LHS.LoTypeEl;
  22432. C:=LTypeEl.ClassType;
  22433. if (C=TPasClassType)
  22434. or (C=TPasClassOfType)
  22435. or (C=TPasPointerType)
  22436. or C.InheritsFrom(TPasProcedureType)
  22437. or IsDynArray(LTypeEl) then
  22438. Result:=cExact;
  22439. end;
  22440. end
  22441. else if RBT=btProc then
  22442. begin
  22443. if (msDelphi in CurrentParser.CurrentModeswitches)
  22444. and (LHS.LoTypeEl is TPasProcedureType)
  22445. and (RHS.IdentEl is TPasProcedure) then
  22446. begin
  22447. // for example ProcVar:=Proc
  22448. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  22449. TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
  22450. exit(cExact);
  22451. end
  22452. else if (LHS.LoTypeEl is TPasProcedureType)
  22453. and (RHS.ExprEl is TProcedureExpr) then
  22454. begin
  22455. // for example ProcVar:=anonymous-procedure...
  22456. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  22457. TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
  22458. exit(cExact);
  22459. end
  22460. end
  22461. else if LBT=btPointer then
  22462. begin
  22463. if RBT=btPointer then
  22464. begin
  22465. LTypeEl:=LHS.LoTypeEl;
  22466. RTypeEl:=RHS.LoTypeEl;
  22467. if IsBaseType(LTypeEl,btPointer) then
  22468. Result:=cExact // btPointer can take any pointer
  22469. else if IsBaseType(RTypeEl,btPointer) then
  22470. Result:=cTypeConversion // any pointer can take a btPointer
  22471. else if IsSameType(LTypeEl,RTypeEl,prraAlias) then
  22472. Result:=cExact // pointer of same type
  22473. else if (LTypeEl.ClassType=TPasPointerType)
  22474. and (RTypeEl.ClassType=TPasPointerType) then
  22475. Result:=CheckAssignCompatibility(TPasPointerType(LTypeEl).DestType,
  22476. TPasPointerType(RTypeEl).DestType,RaiseOnIncompatible);
  22477. end
  22478. else if IsBaseType(LHS.LoTypeEl,btPointer) then
  22479. begin
  22480. // UntypedPointer:=...
  22481. if RBT=btContext then
  22482. begin
  22483. RTypeEl:=RHS.LoTypeEl;
  22484. C:=RTypeEl.ClassType;
  22485. if C=TPasClassType then
  22486. // UntypedPointer:=ClassTypeOrInstance
  22487. exit(cTypeConversion)
  22488. else if C=TPasClassOfType then
  22489. // UntypedPointer:=ClassOfVar
  22490. Result:=cTypeConversion
  22491. else if C=TPasArrayType then
  22492. begin
  22493. if IsDynArray(RTypeEl) then
  22494. // UntypedPointer:=DynArray
  22495. Result:=cTypeConversion;
  22496. end
  22497. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  22498. // UntypedPointer:=procvar
  22499. Result:=cLossyConversion
  22500. else if C=TPasPointerType then
  22501. // UntypedPointer:=TypedPointer
  22502. Result:=cExact;
  22503. end;
  22504. end;
  22505. end
  22506. else if (LBT=btContext) then
  22507. begin
  22508. LTypeEl:=LHS.LoTypeEl;
  22509. if (LTypeEl.ClassType=TPasArrayType) then
  22510. Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
  22511. else if LTypeEl.ClassType=TPasEnumType then
  22512. begin
  22513. if (RHS.BaseType=btRange) and (RHS.SubType=btContext) then
  22514. begin
  22515. RTypeEl:=RHS.LoTypeEl;
  22516. if RTypeEl.ClassType=TPasRangeType then
  22517. begin
  22518. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,RightSubResolved,[rcConstant]);
  22519. if (RightSubResolved.BaseType=btContext)
  22520. and IsSameType(LTypeEl,RightSubResolved.LoTypeEl,prraAlias) then
  22521. begin
  22522. // enumtype := enumrange
  22523. Result:=cExact;
  22524. end;
  22525. end;
  22526. end;
  22527. end
  22528. else if LTypeEl.ClassType=TPasRecordType then
  22529. begin
  22530. if (RBT in btAllStrings) and IsTGUID(TPasRecordType(LTypeEl))
  22531. and (rrfReadable in RHS.Flags) then
  22532. begin
  22533. // GUIDVar := string, e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
  22534. Value:=Eval(RHS,[refConstExt]);
  22535. try
  22536. if Value=nil then
  22537. if RaiseOnIncompatible then
  22538. RaiseXExpectedButYFound(20180414105916,'string literal','string', ErrorEl)
  22539. else
  22540. exit(cIncompatible);
  22541. finally
  22542. ReleaseEvalValue(Value);
  22543. end;
  22544. Result:=cStringToTGUID;
  22545. end;
  22546. end
  22547. else if LTypeEl.ClassType=TPasPointerType then
  22548. begin
  22549. // TypedPointer:=
  22550. if RHS.BaseType=btPointer then
  22551. begin
  22552. RTypeEl:=RHS.LoTypeEl;
  22553. if IsBaseType(RTypeEl,btPointer) then
  22554. // TypedPointer:=UntypedPointer
  22555. Result:=cTypeConversion
  22556. else
  22557. begin
  22558. // TypedPointer:=@Var
  22559. Result:=CheckAssignCompatibilityPointerType(
  22560. TPasPointerType(LTypeEl).DestType,RTypeEl,ErrorEl,false);
  22561. end;
  22562. end;
  22563. end;
  22564. end;
  22565. end;
  22566. if (Result>=0) and (Result<cIncompatible) then
  22567. begin
  22568. // type fits -> check readable
  22569. if not (rrfReadable in RHS.Flags) then
  22570. begin
  22571. if RaiseOnIncompatible then
  22572. begin
  22573. {$IFDEF VerbosePasResolver}
  22574. writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  22575. {$ENDIF}
  22576. RaiseVarExpected(20170318235637,ErrorEl,RHS.IdentEl);
  22577. end;
  22578. exit(cIncompatible);
  22579. end;
  22580. exit;
  22581. end;
  22582. // incompatible
  22583. {$IFDEF VerbosePasResolver}
  22584. writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  22585. {$ENDIF}
  22586. if not RaiseOnIncompatible then
  22587. exit(cIncompatible);
  22588. // create error messages
  22589. RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
  22590. [],RHS,LHS,ErrorEl);
  22591. end;
  22592. function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
  22593. ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
  22594. ): integer;
  22595. // check if the RightResolved is type compatible to LeftResolved
  22596. var
  22597. LFlags, RFlags: TPasResolverComputeFlags;
  22598. LeftResolved, RightResolved: TPasResolverResult;
  22599. LeftErrorEl, RightErrorEl: TPasElement;
  22600. begin
  22601. Result:=cIncompatible;
  22602. // Delphi resolves both sides, so it forbids "if procvar=procvar then"
  22603. // FPC is more clever. It supports "if procvar=@proc then", "function=value"
  22604. if msDelphi in CurrentParser.CurrentModeswitches then
  22605. LFlags:=[]
  22606. else
  22607. LFlags:=[rcNoImplicitProcType];
  22608. if SetReferenceFlags then
  22609. Include(LFlags,rcSetReferenceFlags);
  22610. ComputeElement(Left,LeftResolved,LFlags);
  22611. if (msDelphi in CurrentParser.CurrentModeswitches) then
  22612. RFlags:=LFlags
  22613. else
  22614. begin
  22615. if LeftResolved.BaseType=btNil then
  22616. RFlags:=[rcNoImplicitProcType]
  22617. else if IsProcedureType(LeftResolved,true) then
  22618. RFlags:=[rcNoImplicitProcType]
  22619. else
  22620. RFlags:=[];
  22621. end;
  22622. if SetReferenceFlags then
  22623. Include(RFlags,rcSetReferenceFlags);
  22624. {$IFDEF VerbosePasResolver}
  22625. writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
  22626. {$ENDIF}
  22627. ComputeElement(Right,RightResolved,RFlags);
  22628. if ErrorEl=nil then
  22629. begin
  22630. LeftErrorEl:=Left;
  22631. RightErrorEl:=Right;
  22632. end
  22633. else
  22634. begin
  22635. LeftErrorEl:=ErrorEl;
  22636. RightErrorEl:=ErrorEl;
  22637. end;
  22638. Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
  22639. RaiseOnIncompatible,RightErrorEl);
  22640. end;
  22641. function TPasResolver.CheckEqualResCompatibility(const LHS,
  22642. RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  22643. RErrorEl: TPasElement): integer;
  22644. var
  22645. LTypeEl, RTypeEl: TPasType;
  22646. ResolvedEl: TPasResolverResult;
  22647. begin
  22648. Result:=cIncompatible;
  22649. if RErrorEl=nil then RErrorEl:=LErrorEl;
  22650. // check if the RHS is type compatible to LHS
  22651. {$IFDEF VerbosePasResolver}
  22652. writeln('TPasResolver.CheckEqualResCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  22653. {$ENDIF}
  22654. if not (rrfReadable in LHS.Flags) then
  22655. begin
  22656. if (LHS.BaseType=btContext) then
  22657. begin
  22658. LTypeEl:=LHS.LoTypeEl;
  22659. if (LTypeEl.ClassType=TPasClassType)
  22660. and (ResolveAliasTypeEl(LHS.IdentEl)=LTypeEl) then
  22661. begin
  22662. // LHS is class type, e.g. TObject or IInterface
  22663. if RHS.BaseType=btNil then
  22664. exit(cExact)
  22665. else if RHS.BaseType in btAllStrings then
  22666. begin
  22667. if (rrfReadable in RHS.Flags)
  22668. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  22669. and IsTGUIDString(RHS) then
  22670. // e.g. IUnknown=aGUIDString
  22671. exit(cInterfaceToString);
  22672. end
  22673. else if (RHS.BaseType=btContext) then
  22674. begin
  22675. RTypeEl:=RHS.LoTypeEl;
  22676. if (RTypeEl.ClassType=TPasClassOfType)
  22677. and (rrfReadable in RHS.Flags)
  22678. and (TPasClassType(LTypeEl).ObjKind=okClass) then
  22679. // for example if TImage=ImageClass then
  22680. exit(cExact)
  22681. else if (RTypeEl.ClassType=TPasRecordType)
  22682. and (rrfReadable in RHS.Flags)
  22683. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  22684. and IsTGUID(TPasRecordType(RTypeEl)) then
  22685. // e.g. if IUnknown=TGuidVar then
  22686. exit(cInterfaceToTGUID);
  22687. end;
  22688. end;
  22689. end;
  22690. RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
  22691. end;
  22692. if not (rrfReadable in RHS.Flags) then
  22693. begin
  22694. if (RHS.BaseType=btContext) then
  22695. begin
  22696. RTypeEl:=RHS.LoTypeEl;
  22697. if (RTypeEl.ClassType=TPasClassType)
  22698. and (ResolveAliasTypeEl(RHS.IdentEl)=RTypeEl) then
  22699. begin
  22700. // RHS is class type, e.g. TObject or IInterface
  22701. if LHS.BaseType=btNil then
  22702. exit(cExact)
  22703. else if LHS.BaseType in btAllStrings then
  22704. begin
  22705. if (rrfReadable in LHS.Flags)
  22706. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  22707. and IsTGUIDString(LHS) then
  22708. // e.g. aGUIDString=IUnknown
  22709. exit(cInterfaceToString);
  22710. end
  22711. else if (LHS.BaseType=btContext) then
  22712. begin
  22713. LTypeEl:=LHS.LoTypeEl;
  22714. if (LTypeEl.ClassType=TPasClassOfType)
  22715. and (rrfReadable in LHS.Flags)
  22716. and (TPasClassType(RTypeEl).ObjKind=okClass) then
  22717. // for example if ImageClass=TImage then
  22718. exit(cExact)
  22719. else if (LTypeEl.ClassType=TPasRecordType)
  22720. and (rrfReadable in LHS.Flags)
  22721. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  22722. and IsTGUID(TPasRecordType(LTypeEl)) then
  22723. // e.g. if TGuidVar=IUnknown then
  22724. exit(cInterfaceToTGUID);
  22725. end;
  22726. end;
  22727. end;
  22728. RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
  22729. end;
  22730. if IsGenericTemplType(LHS) then
  22731. begin
  22732. // TemplateVar = x
  22733. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),RHS,prtcoEqual,nil);
  22734. if Result<>cIncompatible then exit;
  22735. end
  22736. else if IsGenericTemplType(RHS) then
  22737. begin
  22738. // x = TemplateVar
  22739. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),LHS,prtcoEqual,nil);
  22740. if Result<>cIncompatible then exit;
  22741. end;
  22742. if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
  22743. begin
  22744. Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
  22745. if (Result=cIncompatible) and RaiseOnIncompatible then
  22746. RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
  22747. [],RHS,LHS,LErrorEl);
  22748. exit;
  22749. end
  22750. else if LHS.BaseType=RHS.BaseType then
  22751. begin
  22752. if LHS.BaseType=btContext then
  22753. exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
  22754. else
  22755. exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
  22756. end
  22757. else if LHS.BaseType in btAllInteger then
  22758. begin
  22759. if RHS.BaseType in btAllInteger+btAllFloats then
  22760. exit(cCompatible)
  22761. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  22762. exit(cCompatible);
  22763. end
  22764. else if LHS.BaseType in btAllFloats then
  22765. begin
  22766. if RHS.BaseType in btAllInteger+btAllFloats then
  22767. exit(cCompatible);
  22768. end
  22769. else if LHS.BaseType in btAllBooleans then
  22770. begin
  22771. if RHS.BaseType in btAllBooleans then
  22772. exit(cCompatible)
  22773. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  22774. exit(cCompatible);
  22775. end
  22776. else if LHS.BaseType in btAllStringAndChars then
  22777. begin
  22778. if RHS.BaseType in btAllStringAndChars then
  22779. exit(cCompatible)
  22780. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  22781. exit(cCompatible)
  22782. else if RHS.BaseType=btContext then
  22783. begin
  22784. RTypeEl:=RHS.LoTypeEl;
  22785. if (RTypeEl.ClassType=TPasClassType) then
  22786. begin
  22787. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  22788. and IsTGUIDString(LHS) then
  22789. // e.g. aGUIDString=IntfVar
  22790. exit(cInterfaceToString);
  22791. end
  22792. else if (RTypeEl.ClassType=TPasRecordType)
  22793. and IsTGUID(TPasRecordType(RTypeEl)) then
  22794. // e.g. aString=GuidVar
  22795. exit(cTGUIDToString);
  22796. end;
  22797. end
  22798. else if LHS.BaseType=btNil then
  22799. begin
  22800. if RHS.BaseType in [btPointer,btNil] then
  22801. exit(cExact)
  22802. else if RHS.BaseType=btContext then
  22803. begin
  22804. LTypeEl:=RHS.LoTypeEl;
  22805. if (LTypeEl.ClassType=TPasClassType)
  22806. or (LTypeEl.ClassType=TPasClassOfType)
  22807. or (LTypeEl.ClassType=TPasPointerType)
  22808. or (LTypeEl is TPasProcedureType)
  22809. or IsDynArray(LTypeEl) then
  22810. exit(cExact);
  22811. end;
  22812. if RaiseOnIncompatible then
  22813. RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
  22814. [],RHS,LHS,RErrorEl)
  22815. else
  22816. exit(cIncompatible);
  22817. end
  22818. else if RHS.BaseType=btNil then
  22819. begin
  22820. if LHS.BaseType=btPointer then
  22821. exit(cExact)
  22822. else if LHS.BaseType=btContext then
  22823. begin
  22824. LTypeEl:=LHS.LoTypeEl;
  22825. if (LTypeEl.ClassType=TPasClassType)
  22826. or (LTypeEl.ClassType=TPasClassOfType)
  22827. or (LTypeEl.ClassType=TPasPointerType)
  22828. or (LTypeEl is TPasProcedureType)
  22829. or IsDynArray(LTypeEl) then
  22830. exit(cExact);
  22831. end;
  22832. if RaiseOnIncompatible then
  22833. RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
  22834. [],LHS,RHS,LErrorEl)
  22835. else
  22836. exit(cIncompatible);
  22837. end
  22838. else if LHS.BaseType=btPointer then
  22839. begin
  22840. if RHS.BaseType=btContext then
  22841. begin
  22842. RTypeEl:=RHS.LoTypeEl;
  22843. if RTypeEl.ClassType=TPasPointerType then
  22844. // @Something=TypedPointer
  22845. exit(cExact)
  22846. else if RTypeEl.ClassType=TPasClassType then
  22847. // @Something=ClassOrInterface
  22848. exit(cCompatible)
  22849. else if RTypeEl.ClassType=TPasClassOfType then
  22850. // @Something=ClassOf
  22851. exit(cCompatible);
  22852. end;
  22853. end
  22854. else if LHS.BaseType in [btSet,btArrayOrSet] then
  22855. begin
  22856. if RHS.BaseType in [btSet,btArrayOrSet] then
  22857. begin
  22858. if LHS.LoTypeEl=nil then
  22859. exit(cExact); // empty set
  22860. if RHS.LoTypeEl=nil then
  22861. exit(cExact); // empty set
  22862. if IsSameType(LHS.LoTypeEl,RHS.LoTypeEl,prraAlias) then
  22863. exit(cExact);
  22864. if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+btAllChars)) then
  22865. exit(cExact);
  22866. if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
  22867. or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
  22868. exit(cCompatible);
  22869. if RaiseOnIncompatible then
  22870. RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  22871. ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
  22872. else
  22873. exit(cIncompatible);
  22874. end;
  22875. end
  22876. else if LHS.BaseType=btRange then
  22877. begin
  22878. if LHS.SubType in btAllInteger then
  22879. begin
  22880. // e.g. 2..4
  22881. if RHS.BaseType in btAllInteger then
  22882. exit(cCompatible)
  22883. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  22884. exit(cCompatible);
  22885. end
  22886. else if LHS.SubType in btAllBooleans then
  22887. begin
  22888. if RHS.BaseType in btAllBooleans then
  22889. exit(cCompatible)
  22890. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  22891. exit(cCompatible);
  22892. end
  22893. else if LHS.SubType in btAllChars then
  22894. begin
  22895. if RHS.BaseType in btAllStringAndChars then
  22896. exit(cCompatible)
  22897. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  22898. exit(cCompatible);
  22899. end
  22900. else if LHS.SubType=btContext then
  22901. begin
  22902. LTypeEl:=LHS.LoTypeEl;
  22903. if LTypeEl.ClassType=TPasRangeType then
  22904. begin
  22905. ComputeElement(TPasRangeType(LTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  22906. if ResolvedEl.BaseType=btContext then
  22907. begin
  22908. LTypeEl:=ResolvedEl.LoTypeEl;
  22909. if LTypeEl.ClassType=TPasEnumType then
  22910. begin
  22911. if RHS.BaseType=btContext then
  22912. begin
  22913. RTypeEl:=RHS.LoTypeEl;
  22914. if (LTypeEl=RTypeEl) then
  22915. exit(cCompatible);
  22916. end;
  22917. end;
  22918. end;
  22919. end;
  22920. end;
  22921. end
  22922. else if LHS.BaseType=btContext then
  22923. begin
  22924. LTypeEl:=LHS.LoTypeEl;
  22925. if LTypeEl.ClassType=TPasEnumType then
  22926. begin
  22927. if RHS.BaseType=btRange then
  22928. begin
  22929. RTypeEl:=RHS.LoTypeEl;
  22930. if RTypeEl.ClassType=TPasRangeType then
  22931. begin
  22932. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  22933. if ResolvedEl.BaseType=btContext then
  22934. begin
  22935. RTypeEl:=ResolvedEl.LoTypeEl;
  22936. if LTypeEl=RTypeEl then
  22937. exit(cCompatible);
  22938. end;
  22939. end;
  22940. end;
  22941. end
  22942. else if LTypeEl.ClassType=TPasClassType then
  22943. begin
  22944. if RHS.BaseType=btPointer then
  22945. exit(cCompatible)
  22946. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  22947. begin
  22948. if RHS.BaseType in btAllStrings then
  22949. begin
  22950. if IsTGUIDString(RHS) then
  22951. // e.g. IntfVar=aGUIDString
  22952. exit(cInterfaceToString);
  22953. end
  22954. else if RHS.BaseType=btContext then
  22955. begin
  22956. RTypeEl:=RHS.LoTypeEl;
  22957. if (RTypeEl.ClassType=TPasRecordType)
  22958. and IsTGUID(TPasRecordType(RTypeEl)) then
  22959. // e.g. IntfVar=GuidVar
  22960. exit(cInterfaceToTGUID);
  22961. end;
  22962. end;
  22963. end
  22964. else if LTypeEl.ClassType=TPasClassOfType then
  22965. begin
  22966. if RHS.BaseType=btPointer then
  22967. exit(cCompatible);
  22968. end
  22969. else if LTypeEl.ClassType=TPasRecordType then
  22970. begin
  22971. if IsTGUID(TPasRecordType(LTypeEl)) then
  22972. begin
  22973. // LHS is TGUID
  22974. if (RHS.BaseType in btAllStrings) then
  22975. // GuidVar=aString
  22976. exit(cTGUIDToString)
  22977. else if RHS.BaseType=btContext then
  22978. begin
  22979. RTypeEl:=RHS.LoTypeEl;
  22980. if (RTypeEl.ClassType=TPasClassType)
  22981. and (TPasClassType(RTypeEl).ObjKind=okInterface) then
  22982. // GUIDVar=IntfVar
  22983. exit(cInterfaceToTGUID);
  22984. end;
  22985. end;
  22986. end
  22987. else if LTypeEl.ClassType=TPasPointerType then
  22988. begin
  22989. if RHS.BaseType=btPointer then
  22990. // TypedPointer=@Something
  22991. exit(cExact);
  22992. end;
  22993. end;
  22994. if RaiseOnIncompatible then
  22995. RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
  22996. [],RHS,LHS,RErrorEl)
  22997. else
  22998. exit(cIncompatible);
  22999. end;
  23000. function TPasResolver.IsVariableConst(El, PosEl: TPasElement;
  23001. RaiseIfConst: boolean): boolean;
  23002. var
  23003. CurEl: TPasElement;
  23004. VarResolved: TPasResolverResult;
  23005. Loop: TPasImplForLoop;
  23006. begin
  23007. Result:=false;
  23008. CurEl:=PosEl;
  23009. while CurEl<>nil do
  23010. begin
  23011. if (CurEl.ClassType=TPasImplForLoop) then
  23012. begin
  23013. Loop:=TPasImplForLoop(CurEl);
  23014. if (Loop.VariableName<>PosEl) then
  23015. begin
  23016. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
  23017. if VarResolved.IdentEl=El then
  23018. begin
  23019. if RaiseIfConst then
  23020. RaiseMsg(20180430100719,nIllegalAssignmentToForLoopVar,
  23021. sIllegalAssignmentToForLoopVar,[El.Name],PosEl);
  23022. exit(true);
  23023. end;
  23024. end;
  23025. end;
  23026. CurEl:=CurEl.Parent;
  23027. end;
  23028. end;
  23029. function TPasResolver.ResolvedElCanBeVarParam(
  23030. const ResolvedEl: TPasResolverResult; PosEl: TPasElement;
  23031. RaiseIfConst: boolean): boolean;
  23032. function NotLocked(El: TPasElement): boolean;
  23033. begin
  23034. Result:=not IsVariableConst(El,PosEl,RaiseIfConst);
  23035. end;
  23036. var
  23037. IdentEl: TPasElement;
  23038. begin
  23039. Result:=false;
  23040. if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
  23041. exit;
  23042. if ResolvedEl.IdentEl=nil then
  23043. exit(true);
  23044. IdentEl:=ResolvedEl.IdentEl;
  23045. if IdentEl.ClassType=TPasVariable then
  23046. exit(NotLocked(IdentEl));
  23047. if (IdentEl.ClassType=TPasConst) then
  23048. begin
  23049. if TPasConst(IdentEl).IsConst then
  23050. begin
  23051. if RaiseIfConst then
  23052. RaiseMsg(20180430100719,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  23053. exit(false);
  23054. end;
  23055. exit(NotLocked(IdentEl));
  23056. end;
  23057. if (IdentEl.ClassType=TPasArgument) then
  23058. begin
  23059. if TPasArgument(IdentEl).Access in [argConst,argConstRef] then
  23060. begin
  23061. if RaiseIfConst then
  23062. RaiseMsg(20180430100843,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  23063. exit(false);
  23064. end;
  23065. Result:=(TPasArgument(IdentEl).Access in [argDefault, argVar, argOut]);
  23066. exit(Result and NotLocked(IdentEl));
  23067. end;
  23068. if IdentEl.ClassType=TPasResultElement then
  23069. exit(NotLocked(IdentEl));
  23070. if (proPropertyAsVarParam in Options)
  23071. and (IdentEl.ClassType=TPasProperty) then
  23072. exit(NotLocked(IdentEl));
  23073. end;
  23074. function TPasResolver.ResolvedElIsClassOrRecordInstance(
  23075. const ResolvedEl: TPasResolverResult): boolean;
  23076. var
  23077. TypeEl: TPasType;
  23078. begin
  23079. Result:=false;
  23080. if ResolvedEl.BaseType<>btContext then exit;
  23081. TypeEl:=ResolvedEl.LoTypeEl;
  23082. if TypeEl=nil then exit;
  23083. if TypeEl.ClassType=TPasClassType then
  23084. begin
  23085. if TPasClassType(TypeEl).ObjKind<>okClass then exit;
  23086. end
  23087. else if TypeEl.ClassType=TPasRecordType then
  23088. else
  23089. exit;
  23090. if (ResolvedEl.IdentEl is TPasVariable)
  23091. or (ResolvedEl.IdentEl.ClassType=TPasArgument)
  23092. or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
  23093. exit(true);
  23094. end;
  23095. function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
  23096. ): boolean;
  23097. begin
  23098. Result:=ms in GetElModeSwitches(El);
  23099. end;
  23100. function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
  23101. var
  23102. C: TClass;
  23103. begin
  23104. while El<>nil do
  23105. begin
  23106. if El.CustomData<>nil then
  23107. begin
  23108. C:=El.CustomData.ClassType;
  23109. if C.InheritsFrom(TPasProcedureScope) then
  23110. exit(TPasProcedureScope(El.CustomData).ModeSwitches)
  23111. else if C.InheritsFrom(TPasSectionScope) then
  23112. exit(TPasSectionScope(El.CustomData).ModeSwitches);
  23113. end;
  23114. El:=El.Parent;
  23115. end;
  23116. Result:=CurrentParser.CurrentModeswitches;
  23117. end;
  23118. function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
  23119. ): boolean;
  23120. begin
  23121. Result:=bs in GetElBoolSwitches(El);
  23122. end;
  23123. function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  23124. var
  23125. C: TClass;
  23126. begin
  23127. Result:=CurrentParser.Scanner.CurrentBoolSwitches;
  23128. while El<>nil do
  23129. begin
  23130. if El.CustomData<>nil then
  23131. begin
  23132. C:=El.CustomData.ClassType;
  23133. if C.InheritsFrom(TPasProcedureScope) then
  23134. exit(TPasProcedureScope(El.CustomData).BoolSwitches)
  23135. else if C.InheritsFrom(TPasSectionScope) then
  23136. exit(TPasSectionScope(El.CustomData).BoolSwitches)
  23137. else if C.InheritsFrom(TPasModuleScope) then
  23138. exit(TPasModuleScope(El.CustomData).BoolSwitches);
  23139. end;
  23140. El:=El.Parent;
  23141. end;
  23142. end;
  23143. function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
  23144. Flags: TPRProcTypeDescFlags): string;
  23145. var
  23146. Args, Templates: TFPList;
  23147. i: Integer;
  23148. Arg: TPasArgument;
  23149. ArgType: TPasType;
  23150. Proc: TPasProcedure;
  23151. begin
  23152. if ProcType=nil then exit('nil');
  23153. Result:=ProcType.TypeName;
  23154. if ProcType.IsReferenceTo then
  23155. Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
  23156. if ProcType.Parent is TPasProcedure then
  23157. begin
  23158. Proc:=TPasProcedure(ProcType.Parent);
  23159. if (prptdUseName in Flags) then
  23160. begin
  23161. if prptdAddPaths in Flags then
  23162. Result:=Result+' '+Proc.FullName
  23163. else
  23164. Result:=Result+' '+Proc.Name;
  23165. end;
  23166. Templates:=GetProcTemplateTypes(Proc);
  23167. if Templates<>nil then
  23168. Result:=Result+GetGenericParamCommas(Templates.Count);
  23169. end;
  23170. Args:=ProcType.Args;
  23171. if Args.Count>0 then
  23172. begin
  23173. Result:=Result+'(';
  23174. for i:=0 to Args.Count-1 do
  23175. begin
  23176. if i>0 then Result:=Result+';';
  23177. Arg:=TPasArgument(Args[i]);
  23178. if AccessNames[Arg.Access]<>'' then
  23179. Result:=Result+AccessNames[Arg.Access];
  23180. if Arg.ArgType=nil then
  23181. Result:=Result+'untyped'
  23182. else
  23183. begin
  23184. ArgType:=Arg.ArgType;
  23185. if prptdResolveSimpleAlias in Flags then
  23186. ArgType:=ResolveSimpleAliasType(ArgType);
  23187. Result:=Result+GetTypeDescription(ArgType,prptdAddPaths in Flags);
  23188. end;
  23189. end;
  23190. Result:=Result+')';
  23191. end;
  23192. if ProcType.IsOfObject then
  23193. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  23194. if ProcType.IsNested then
  23195. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  23196. if cCallingConventions[ProcType.CallingConvention]<>'' then
  23197. Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
  23198. end;
  23199. function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
  23200. OnlyType: boolean): string;
  23201. function GetSubTypeName: string;
  23202. begin
  23203. if (T.LoTypeEl<>nil) and (T.LoTypeEl.Name<>'') then
  23204. Result:=T.LoTypeEl.Name
  23205. else
  23206. Result:=BaseTypeNames[T.SubType];
  23207. end;
  23208. var
  23209. ArrayEl: TPasArrayType;
  23210. begin
  23211. case T.BaseType of
  23212. btModule: exit(GetElementTypeName(T.IdentEl)+' '+T.IdentEl.Name);
  23213. btNil: exit('nil');
  23214. btRange:
  23215. Result:='range of '+GetSubTypeName;
  23216. btSet:
  23217. Result:='set of '+GetSubTypeName;
  23218. btArrayLit:
  23219. Result:='array of '+GetSubTypeName;
  23220. btArrayOrSet:
  23221. Result:='set/array literal of '+GetSubTypeName;
  23222. btContext:
  23223. begin
  23224. if T.LoTypeEl.ClassType=TPasClassOfType then
  23225. Result:='class of '+TPasClassOfType(T.LoTypeEl).DestType.Name
  23226. else if T.LoTypeEl.ClassType=TPasAliasType then
  23227. Result:=TPasAliasType(T.LoTypeEl).DestType.Name
  23228. else if T.LoTypeEl.ClassType=TPasTypeAliasType then
  23229. Result:='type '+TPasAliasType(T.LoTypeEl).DestType.Name
  23230. else if T.LoTypeEl.ClassType=TPasArrayType then
  23231. begin
  23232. ArrayEl:=TPasArrayType(T.LoTypeEl);
  23233. if length(ArrayEl.Ranges)=0 then
  23234. begin
  23235. if ArrayEl.ElType=nil then
  23236. Result:='array of const'
  23237. else
  23238. begin
  23239. Result:='array of '+ArrayEl.ElType.Name;
  23240. if IsOpenArray(ArrayEl) then
  23241. Result:='open '+Result;
  23242. end;
  23243. end
  23244. else
  23245. Result:='static array[] of '+ArrayEl.ElType.Name;
  23246. end
  23247. else if T.LoTypeEl is TPasProcedureType then
  23248. Result:=GetProcTypeDescription(TPasProcedureType(T.LoTypeEl),[])
  23249. else if T.LoTypeEl.Name<>'' then
  23250. Result:=T.LoTypeEl.Name
  23251. else
  23252. Result:=T.LoTypeEl.ElementTypeName;
  23253. end;
  23254. btCustom:
  23255. Result:=T.LoTypeEl.Name;
  23256. else
  23257. Result:=BaseTypeNames[T.BaseType];
  23258. end;
  23259. if (not OnlyType) and (T.LoTypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
  23260. Result:=T.IdentEl.Name+':'+Result;
  23261. end;
  23262. function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
  23263. function GetName: string;
  23264. var
  23265. s: String;
  23266. Spec: TPasSpecializeType;
  23267. P: TPasElement;
  23268. i: Integer;
  23269. GenScope: TPasGenericScope;
  23270. Params: TPasTypeArray;
  23271. begin
  23272. Result:=aType.Name;
  23273. if Result='' then
  23274. begin
  23275. if aType is TPasArrayType then
  23276. begin
  23277. if length(TPasArrayType(aType).Ranges)>0 then
  23278. Result:='static array'
  23279. else if TPasArrayType(aType).ElType=nil then
  23280. Result:='array of const'
  23281. else if IsOpenArray(aType) then
  23282. Result:='open array'
  23283. else
  23284. Result:='dynamic array';
  23285. end
  23286. else if aType is TPasSpecializeType then
  23287. begin
  23288. Spec:=TPasSpecializeType(aType);
  23289. if Spec.CustomData is TPasSpecializeTypeData then
  23290. exit(GetTypeDescription(TPasSpecializeTypeData(Spec.CustomData).SpecializedType));
  23291. Result:=GetTypeDescription(Spec.DestType,true)+'<';
  23292. for i:=0 to Spec.Params.Count-1 do
  23293. begin
  23294. P:=TPasElement(Spec.Params[i]);
  23295. if P is TPasType then
  23296. Result:=Result+GetTypeDescription(TPasType(P));
  23297. if i>0 then
  23298. Result:=Result+',';
  23299. end;
  23300. Result:=Result+'>';
  23301. end
  23302. else
  23303. Result:=GetElementTypeName(aType);
  23304. end
  23305. else if aType is TPasGenericType then
  23306. begin
  23307. i:=GetTypeParameterCount(TPasGenericType(aType));
  23308. if i>0 then
  23309. Result:=Result+GetGenericParamCommas(GetTypeParameterCount(TPasGenericType(aType)))
  23310. else if aType.CustomData is TPasGenericScope then
  23311. begin
  23312. GenScope:=TPasGenericScope(aType.CustomData);
  23313. if GenScope.SpecializedFromItem<>nil then
  23314. begin
  23315. Params:=GenScope.SpecializedFromItem.Params;
  23316. Result:=Result+'<';
  23317. for i:=0 to length(Params)-1 do
  23318. begin
  23319. Result:=Result+GetTypeDescription(Params[i]);
  23320. if i>0 then
  23321. Result:=Result+',';
  23322. end;
  23323. Result:=Result+'>';
  23324. end
  23325. end;
  23326. end;
  23327. if AddPath then
  23328. begin
  23329. s:=aType.ParentPath;
  23330. if (s<>'') and (s<>'.') then
  23331. Result:=s+'.'+Result;
  23332. end;
  23333. end;
  23334. begin
  23335. if aType=nil then exit('untyped');
  23336. Result:=GetName;
  23337. if (aType.ClassType=TPasUnresolvedSymbolRef) then
  23338. begin
  23339. if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
  23340. Result:=Result+'()';
  23341. exit;
  23342. end;
  23343. end;
  23344. function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
  23345. AddPath: boolean): string;
  23346. var
  23347. s: String;
  23348. begin
  23349. Result:=GetTypeDescription(R.LoTypeEl,AddPath);
  23350. if R.BaseType in [btSet,btArrayLit,btArrayOrSet] then
  23351. Result:=BaseTypeNames[R.BaseType]+' of '+Result;
  23352. if (R.LoTypeEl<>nil) and (R.IdentEl=R.LoTypeEl) then
  23353. begin
  23354. s:=GetElementTypeName(R.LoTypeEl);
  23355. if s<>'' then
  23356. Result:=s+' '+Result
  23357. else
  23358. Result:='type '+Result;
  23359. end;
  23360. end;
  23361. function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
  23362. AddPath: boolean): string;
  23363. begin
  23364. if R.BaseType=btContext then
  23365. Result:=GetTypeDescription(R,AddPath)
  23366. else if (R.BaseType=btPointer) and not IsBaseType(R.LoTypeEl,btPointer) then
  23367. Result:='^'+GetTypeDescription(R,AddPath)
  23368. else
  23369. Result:=BaseTypeNames[R.BaseType];
  23370. end;
  23371. function TPasResolver.GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  23372. var
  23373. Scope: TPasProcedureScope;
  23374. Body: TPasImplBlock;
  23375. begin
  23376. Result:=nil;
  23377. if Proc=nil then exit;
  23378. if Proc.Body<>nil then
  23379. Body:=Proc.Body.Body
  23380. else
  23381. Body:=nil;
  23382. if Body=nil then
  23383. begin
  23384. if Proc.CustomData=nil then exit;
  23385. Scope:=Proc.CustomData as TPasProcedureScope;
  23386. Proc:=Scope.ImplProc;
  23387. if Proc=nil then exit;
  23388. if Proc.Body=nil then exit;
  23389. Body:=Proc.Body.Body;
  23390. if Body=nil then exit;
  23391. end;
  23392. if Body.Elements=nil then exit;
  23393. if Body.Elements.Count=0 then exit;
  23394. Result:=TPasImplElement(Body.Elements[0]);
  23395. end;
  23396. function TPasResolver.GetProcTemplateTypes(Proc: TPasProcedure): TFPList;
  23397. var
  23398. NameParts: TProcedureNamePart;
  23399. begin
  23400. if Proc.NameParts=nil then
  23401. exit(nil);
  23402. NameParts:=TProcedureNamePart(Proc.NameParts[Proc.NameParts.Count-1]);
  23403. Result:=NameParts.Templates;
  23404. if (Result<>nil) and (Result.Count=0) then
  23405. exit(nil);
  23406. end;
  23407. function TPasResolver.GetProcName(Proc: TPasProcedure; WithTemplates: boolean
  23408. ): string;
  23409. var
  23410. NameParts: TProcedureNameParts;
  23411. i, j: Integer;
  23412. NamePart: TProcedureNamePart;
  23413. TemplType: TPasGenericTemplateType;
  23414. Templates: TFPList;
  23415. begin
  23416. if Proc=nil then exit('(nil)');
  23417. Result:=Proc.Name;
  23418. if WithTemplates then
  23419. begin
  23420. NameParts:=Proc.NameParts;
  23421. if NameParts=nil then exit;
  23422. Result:='';
  23423. for i:=0 to NameParts.Count-1 do
  23424. begin
  23425. NamePart:=TProcedureNamePart(NameParts[i]);
  23426. if i>0 then
  23427. Result:=Result+'.';
  23428. Result:=Result+NamePart.Name;
  23429. Templates:=NamePart.Templates;
  23430. if (Templates<>nil) and (Templates.Count>0) then
  23431. begin
  23432. for j:=0 to Templates.Count-1 do
  23433. begin
  23434. TemplType:=TPasGenericTemplateType(NamePart.Templates[j]);
  23435. if j=0 then
  23436. Result:=Result+'<'
  23437. else
  23438. Result:=Result+',';
  23439. Result:=Result+TemplType.Name;
  23440. end;
  23441. Result:=Result+'>';
  23442. end;
  23443. end;
  23444. end;
  23445. end;
  23446. function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
  23447. WithRedeclarations: boolean): TPasProperty;
  23448. begin
  23449. Result:=nil;
  23450. if El=nil then exit;
  23451. if (not WithRedeclarations) and (El.VarType<>nil) then exit;
  23452. if El.CustomData=nil then exit;
  23453. Result:=TPasPropertyScope(El.CustomData).AncestorProp;
  23454. end;
  23455. function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
  23456. begin
  23457. Result:=nil;
  23458. while El<>nil do
  23459. begin
  23460. if El.VarType<>nil then
  23461. exit(El.VarType);
  23462. El:=GetPasPropertyAncestor(El);
  23463. end;
  23464. end;
  23465. function TPasResolver.GetPasPropertyArgs(El: TPasProperty): TFPList;
  23466. begin
  23467. while El<>nil do
  23468. begin
  23469. if El.VarType<>nil then
  23470. exit(El.Args);
  23471. El:=GetPasPropertyAncestor(El);
  23472. end;
  23473. Result:=nil;
  23474. end;
  23475. function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
  23476. // search the member variable or getter function of a property
  23477. var
  23478. DeclEl: TPasElement;
  23479. begin
  23480. Result:=nil;
  23481. while El<>nil do
  23482. begin
  23483. if El.ReadAccessor<>nil then
  23484. begin
  23485. DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
  23486. Result:=DeclEl;
  23487. exit;
  23488. end;
  23489. El:=GetPasPropertyAncestor(El);
  23490. end;
  23491. end;
  23492. function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
  23493. // search the member variable or setter procedure of a property
  23494. var
  23495. DeclEl: TPasElement;
  23496. begin
  23497. Result:=nil;
  23498. while El<>nil do
  23499. begin
  23500. if El.WriteAccessor<>nil then
  23501. begin
  23502. DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
  23503. Result:=DeclEl;
  23504. exit;
  23505. end;
  23506. El:=GetPasPropertyAncestor(El);
  23507. end;
  23508. end;
  23509. function TPasResolver.GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  23510. // search the index expression of a property
  23511. begin
  23512. Result:=nil;
  23513. while El<>nil do
  23514. begin
  23515. if El.IndexExpr<>nil then
  23516. begin
  23517. Result:=El.IndexExpr;
  23518. exit;
  23519. end;
  23520. El:=GetPasPropertyAncestor(El);
  23521. end;
  23522. end;
  23523. function TPasResolver.GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  23524. // search the stored expression of a property
  23525. begin
  23526. Result:=nil;
  23527. while El<>nil do
  23528. begin
  23529. if El.StoredAccessor<>nil then
  23530. begin
  23531. Result:=El.StoredAccessor;
  23532. exit;
  23533. end;
  23534. El:=GetPasPropertyAncestor(El);
  23535. end;
  23536. end;
  23537. function TPasResolver.GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  23538. // search the stored expression of a property
  23539. begin
  23540. Result:=nil;
  23541. while El<>nil do
  23542. begin
  23543. if El.DefaultExpr<>nil then
  23544. begin
  23545. Result:=El.DefaultExpr;
  23546. exit;
  23547. end
  23548. else if El.IsNodefault then
  23549. exit(nil);
  23550. El:=GetPasPropertyAncestor(El);
  23551. end;
  23552. end;
  23553. function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
  23554. Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
  23555. SetReferenceFlags: boolean): integer;
  23556. var
  23557. ExprResolved, ParamResolved: TPasResolverResult;
  23558. NeedVar, UseAssignError: Boolean;
  23559. begin
  23560. Result:=cIncompatible;
  23561. ComputeArgumentAndExpr(Param,ParamResolved,Expr,ExprResolved,SetReferenceFlags);
  23562. NeedVar:=Param.Access in [argVar, argOut];
  23563. if NeedVar then
  23564. begin
  23565. // Expr must be a variable
  23566. if not ResolvedElCanBeVarParam(ExprResolved,Expr) then
  23567. begin
  23568. {$IFDEF VerbosePasResolver}
  23569. writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
  23570. {$ENDIF}
  23571. if RaiseOnError then
  23572. begin
  23573. if ExprResolved.IdentEl is TPasConst then
  23574. RaiseMsg(20180430012609,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],Expr)
  23575. else
  23576. RaiseVarExpected(20180430012457,Expr,ExprResolved.IdentEl);
  23577. end;
  23578. exit;
  23579. end;
  23580. if (Param.ArgType=nil) then
  23581. exit(cExact); // untyped argument
  23582. if (ParamResolved.BaseType=ExprResolved.BaseType) then
  23583. begin
  23584. if msDelphi in CurrentParser.CurrentModeswitches then
  23585. begin
  23586. // Delphi allows passing alias, but not type alias to a var arg
  23587. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  23588. exit(cExact);
  23589. end
  23590. else if IsSameType(ParamResolved.LoTypeEl,ExprResolved.LoTypeEl,prraNone) then
  23591. begin
  23592. // ObjFPC allows passing type alias to a var arg, but simple alias wins
  23593. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  23594. exit(cExact)
  23595. else
  23596. exit(cAliasExact);
  23597. end;
  23598. if (ParamResolved.BaseType=btContext)
  23599. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  23600. and (ExprResolved.LoTypeEl.ClassType=TPasArrayType) then
  23601. begin
  23602. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
  23603. if Result<>cIncompatible then exit;
  23604. end;
  23605. end;
  23606. if IsGenericTemplType(ParamResolved) then
  23607. exit(cGenericExact);
  23608. //writeln('TPasResolver.CheckParamCompatibility NeedVar ParamResolved=',GetResolverResultDbg(ParamResolved),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  23609. if RaiseOnError then
  23610. RaiseIncompatibleTypeRes(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
  23611. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,
  23612. Expr);
  23613. exit(cIncompatible);
  23614. end;
  23615. UseAssignError:=false;
  23616. if RaiseOnError and (ExprResolved.BaseType in [btArrayLit,btArrayOrSet]) then
  23617. // e.g. Call([1,2]) -> on mismatch jump to the wrong param expression
  23618. UseAssignError:=true;
  23619. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,UseAssignError);
  23620. if (Result=cIncompatible) and RaiseOnError then
  23621. RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
  23622. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
  23623. if SetReferenceFlags and (ParamResolved.BaseType=btContext)
  23624. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  23625. MarkArrayExprRecursive(Expr,TPasArrayType(ParamResolved.LoTypeEl));
  23626. end;
  23627. function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
  23628. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  23629. ): integer;
  23630. var
  23631. RTypeEl, LTypeEl: TPasType;
  23632. SrcResolved, DstResolved: TPasResolverResult;
  23633. LArray, RArray: TPasArrayType;
  23634. GotDesc, ExpDesc: String;
  23635. CurTVarRec: TPasRecordType;
  23636. function RaiseIncompatType(Id: TMaxPrecInt): integer;
  23637. begin
  23638. Result:=cIncompatible;
  23639. if not RaiseOnIncompatible then exit;
  23640. RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
  23641. [],RHS,LHS,ErrorEl);
  23642. end;
  23643. begin
  23644. if (RHS.LoTypeEl=nil) then
  23645. RaiseInternalError(20160922163645);
  23646. if (LHS.LoTypeEl=nil) then
  23647. RaiseInternalError(20160922163648);
  23648. LTypeEl:=LHS.LoTypeEl;
  23649. RTypeEl:=RHS.LoTypeEl;
  23650. // Note: do not check if LHS is writable, because this method is used for 'const' too.
  23651. if (LTypeEl=RTypeEl) and (rrfReadable in RHS.Flags) then
  23652. exit(cExact);
  23653. {$IFDEF VerbosePasResolver}
  23654. writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
  23655. {$ENDIF}
  23656. Result:=-1;
  23657. if LTypeEl.ClassType=TPasClassType then
  23658. begin
  23659. if RHS.BaseType=btNil then
  23660. Result:=cExact
  23661. else if RTypeEl.ClassType=TPasClassType then
  23662. begin
  23663. Result:=cIncompatible;
  23664. if not (rrfReadable in RHS.Flags) then
  23665. exit(RaiseIncompatType(20190215112914));
  23666. if TPasClassType(LTypeEl).ObjKind=TPasClassType(RTypeEl).ObjKind then
  23667. Result:=CheckSrcIsADstType(RHS,LHS)
  23668. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  23669. begin
  23670. if (TPasClassType(RTypeEl).ObjKind=okClass)
  23671. and (not TPasClassType(RTypeEl).IsExternal) then
  23672. begin
  23673. // IntfVar:=ClassInstVar
  23674. if GetClassImplementsIntf(TPasClassType(RTypeEl),TPasClassType(LTypeEl))<>nil then
  23675. exit(cTypeConversion);
  23676. end;
  23677. end;
  23678. if (Result=cIncompatible) and RaiseOnIncompatible then
  23679. RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
  23680. [],RTypeEl,LTypeEl,ErrorEl);
  23681. end
  23682. else
  23683. exit(RaiseIncompatType(20190215112919));
  23684. end
  23685. else if LTypeEl.ClassType=TPasClassOfType then
  23686. begin
  23687. if RHS.BaseType=btNil then
  23688. Result:=cExact
  23689. else if (RTypeEl.ClassType=TPasClassOfType) then
  23690. begin
  23691. if RHS.IdentEl is TPasType then
  23692. begin
  23693. Result:=cIncompatible;
  23694. if RaiseOnIncompatible then
  23695. begin
  23696. if ResolveAliasType(TPasType(RHS.IdentEl)) is TPasClassOfType then
  23697. RaiseMsg(20180317103206,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23698. ['type class-of','class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  23699. else
  23700. RaiseMsg(20180511123859,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23701. [GetResolverResultDescription(RHS),'class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  23702. end;
  23703. end
  23704. else
  23705. begin
  23706. // e.g. ImageClass:=AnotherImageClass;
  23707. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  23708. TPasClassOfType(LTypeEl).DestType);
  23709. if (Result=cIncompatible) and RaiseOnIncompatible then
  23710. RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23711. ['class of '+TPasClassOfType(RTypeEl).DestType.PathName,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  23712. end;
  23713. end
  23714. else if (RHS.IdentEl is TPasType)
  23715. and (ResolveAliasType(TPasType(RHS.IdentEl)).ClassType=TPasClassType) then
  23716. begin
  23717. // e.g. ImageClass:=TFPMemoryImage;
  23718. Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType);
  23719. if (Result=cIncompatible) and RaiseOnIncompatible then
  23720. RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23721. [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  23722. // do not check rrfReadable -> exit
  23723. exit;
  23724. end;
  23725. end
  23726. else if LTypeEl is TPasProcedureType then
  23727. begin
  23728. if RHS.BaseType=btNil then
  23729. exit(cExact);
  23730. //writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RHS.BaseType=',BaseTypeNames[RHS.BaseType],' RTypeEl=',GetObjName(RTypeEl),' RHS.IdentEl=',GetObjName(RHS.IdentEl),' RHS.ExprEl=',GetObjName(RHS.ExprEl),' rrfReadable=',rrfReadable in RHS.Flags);
  23731. if (LTypeEl.ClassType=RTypeEl.ClassType)
  23732. and (rrfReadable in RHS.Flags) then
  23733. begin
  23734. // e.g. ProcVar1:=ProcVar2
  23735. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  23736. true,ErrorEl,RaiseOnIncompatible) then
  23737. exit(cExact);
  23738. end;
  23739. if RaiseOnIncompatible then
  23740. begin
  23741. if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
  23742. RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23743. [GetElementTypeName(RTypeEl),GetElementTypeName(LTypeEl)],ErrorEl);
  23744. end;
  23745. end
  23746. else if LTypeEl.ClassType=TPasArrayType then
  23747. begin
  23748. LArray:=TPasArrayType(LTypeEl);
  23749. if (length(LArray.Ranges)=0) and (RTypeEl.ClassType=TPasArrayType) then
  23750. begin
  23751. // DynOrOpenArr:=array
  23752. RArray:=TPasArrayType(RTypeEl);
  23753. if length(RArray.Ranges)=1 then
  23754. begin
  23755. // DynOrOpenArr:=SingleDimStaticArr
  23756. if (msDelphi in CurrentParser.CurrentModeswitches)
  23757. and not IsOpenArray(LArray) then
  23758. begin
  23759. // DynArr:=SingleDimStaticArr forbidden in Delphi
  23760. // Note: OpenArr:=StaticArr is allowed in Delphi
  23761. if RaiseOnIncompatible then
  23762. RaiseIncompatibleTypeDesc(20180620115341,nIncompatibleTypesGotExpected,
  23763. [],'static array','dynamic array',ErrorEl);
  23764. exit(cIncompatible);
  23765. end;
  23766. end
  23767. else if length(RArray.Ranges)>1 then
  23768. begin
  23769. // DynOrOpenArr:=MultiDimStaticArr -> no
  23770. if RaiseOnIncompatible then
  23771. RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
  23772. [],'multi dimensional static array','dynamic array',ErrorEl);
  23773. exit(cIncompatible);
  23774. end
  23775. else if not (proOpenAsDynArrays in Options) then
  23776. begin
  23777. if IsOpenArray(LArray) then
  23778. // OpenArray:=OpenOrDynArr -> ok
  23779. else if IsOpenArray(RArray) then
  23780. begin
  23781. // DynArray:=OpenArray
  23782. if RaiseOnIncompatible then
  23783. RaiseIncompatibleTypeDesc(20180620115515,nIncompatibleTypesGotExpected,
  23784. [],'open array','dynamic array',ErrorEl);
  23785. exit(cIncompatible)
  23786. end
  23787. else
  23788. begin
  23789. // DynArray:=DynArr
  23790. if (msDelphi in CurrentParser.CurrentModeswitches)
  23791. and (LArray<>RArray) then
  23792. begin
  23793. // Delphi does not allow assigning arrays with same element types
  23794. exit(RaiseIncompatType(20190215112626));
  23795. end;
  23796. end;
  23797. end;
  23798. // check element type
  23799. if LArray.ElType=nil then
  23800. begin
  23801. // ArrayOfConst:=SingleDimArr
  23802. if RArray.ElType=nil then
  23803. // ArrayOfConst:=ArrayOfConst
  23804. Result:=cExact
  23805. else
  23806. begin
  23807. CurTVarRec:=GetTVarRec(LArray);
  23808. if ResolveAliasType(RArray.ElType)=CurTVarRec then
  23809. // ArrayOfConst:=ArrayOfTVarRec
  23810. Result:=cExact
  23811. else
  23812. // ArrayOfConst:=SingleDimArr
  23813. exit(RaiseIncompatType(20190215112715));
  23814. end;
  23815. end
  23816. else if RArray.ElType=nil then
  23817. // ArrayOfNonConst:=ArrayOfConst
  23818. exit(RaiseIncompatType(20190215112907))
  23819. else
  23820. begin
  23821. Result:=CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias);
  23822. if Result=cIncompatible then
  23823. if RaiseOnIncompatible then
  23824. begin
  23825. GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
  23826. RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23827. ['array of '+GotDesc,
  23828. 'array of '+ExpDesc],ErrorEl)
  23829. end
  23830. else
  23831. exit(cIncompatible);
  23832. end;
  23833. end;
  23834. end
  23835. else if LTypeEl.ClassType=TPasRecordType then
  23836. begin
  23837. if (RTypeEl is TPasClassType) and (TPasClassType(RTypeEl).ObjKind=okInterface)
  23838. and IsTGUID(TPasRecordType(LTypeEl)) then
  23839. begin
  23840. // GUIDVar := IntfTypeOrVar
  23841. exit(cInterfaceToTGUID);
  23842. end;
  23843. // records of different type
  23844. end
  23845. else if LTypeEl.ClassType=TPasEnumType then
  23846. begin
  23847. // enums of different type
  23848. end
  23849. else if RTypeEl.ClassType=TPasSetType then
  23850. begin
  23851. // sets of different type are compatible if enum types are compatible
  23852. if LTypeEl.ClassType=TPasSetType then
  23853. begin
  23854. ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
  23855. ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
  23856. if (SrcResolved.LoTypeEl<>nil)
  23857. and (SrcResolved.LoTypeEl=DstResolved.LoTypeEl) then
  23858. Result:=cExact
  23859. else if (SrcResolved.LoTypeEl.CustomData is TResElDataBaseType)
  23860. and (DstResolved.LoTypeEl.CustomData is TResElDataBaseType)
  23861. and (CompareText(SrcResolved.LoTypeEl.Name,DstResolved.LoTypeEl.Name)=0) then
  23862. Result:=cExact
  23863. else if RaiseOnIncompatible then
  23864. RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
  23865. [],SrcResolved,DstResolved,ErrorEl)
  23866. else
  23867. exit(cIncompatible);
  23868. end
  23869. else
  23870. exit(RaiseIncompatType(20190215112924));
  23871. end
  23872. else if LTypeEl.ClassType=TPasPointerType then
  23873. begin
  23874. if RTypeEl.ClassType=TPasPointerType then
  23875. begin
  23876. // TypedPointer:=TypedPointer
  23877. Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
  23878. TPasPointerType(RTypeEl).DestType,ErrorEl,false);
  23879. if Result=cIncompatible then
  23880. exit(RaiseIncompatType(20190215112927));
  23881. end;
  23882. end
  23883. else
  23884. {$IFDEF VerbosePasResolver}
  23885. RaiseNotYetImplemented(20160922163654,ErrorEl);
  23886. {$ELSE}
  23887. ;
  23888. {$ENDIF}
  23889. if Result=-1 then
  23890. exit(RaiseIncompatType(20190215112931));
  23891. if not (rrfReadable in RHS.Flags) then
  23892. exit(RaiseIncompatType(20190215112934));
  23893. end;
  23894. function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
  23895. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  23896. ): integer;
  23897. procedure Check_ArrayOfChar_String(ArrType: TPasArrayType;
  23898. ArrLength: integer; const ElTypeResolved: TPasResolverResult;
  23899. Expr: TPasExpr; ErrorEl: TPasElement);
  23900. // check if assigning a string to an array of char fits
  23901. var
  23902. Value: TResEvalValue;
  23903. ElBT: TResolverBaseType;
  23904. l: Integer;
  23905. S: String;
  23906. {$ifdef FPC_HAS_CPSTRING}
  23907. US: UnicodeString;
  23908. {$endif}
  23909. begin
  23910. if Expr=nil then exit;
  23911. ElBT:=GetActualBaseType(ElTypeResolved.BaseType);
  23912. if length(ArrType.Ranges)=0 then
  23913. begin
  23914. // dynamic array of char can hold any string
  23915. // ToDo: check if value can be converted without loss
  23916. Result:=cExact;
  23917. exit;
  23918. end;
  23919. // static array -> check length of string
  23920. Value:=Eval(Expr,[refAutoConst]); // no external const allowed
  23921. try
  23922. case Value.Kind of
  23923. {$ifdef FPC_HAS_CPSTRING}
  23924. revkString:
  23925. if ElBT=btAnsiChar then
  23926. l:=length(TResEvalString(Value).S)
  23927. else
  23928. begin
  23929. US:=fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,ErrorEl);
  23930. l:=length(US);
  23931. end;
  23932. {$endif}
  23933. revkUnicodeString:
  23934. begin
  23935. if ElBT=btWideChar then
  23936. l:=length(TResEvalUTF16(Value).S)
  23937. else
  23938. begin
  23939. S:=String(TResEvalUTF16(Value).S);
  23940. l:=length(S);
  23941. end;
  23942. end;
  23943. else
  23944. {$IFDEF VerbosePasResolver}
  23945. writeln('Check_ArrayOfChar_String Value=',Value.AsDebugString);
  23946. {$ENDIF}
  23947. exit; // incompatible
  23948. end;
  23949. if ArrLength<>l then
  23950. begin
  23951. {$IFDEF VerbosePasResolver}
  23952. writeln('Check_ArrayOfChar_String ElType=',ElBT,'=',GetResolverResultDbg(ElTypeResolved),' Value=',Value.AsDebugString);
  23953. {$ENDIF}
  23954. RaiseMsg(20170913113216,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  23955. [IntToStr(ArrLength),IntToStr(l)],ErrorEl);
  23956. end;
  23957. Result:=cExact;
  23958. finally
  23959. ReleaseEvalValue(Value);
  23960. end;
  23961. end;
  23962. procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
  23963. Values: TPasResolverResult; ErrorEl: TPasElement);
  23964. var
  23965. Range, Value, Expr: TPasExpr;
  23966. RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
  23967. i, ExpectedCount, ValCnt: Integer;
  23968. IsLastRange, IsConstExpr: Boolean;
  23969. ArrayValues: TPasExprArray;
  23970. LeftResult: integer;
  23971. ExprCompFlags: TPasResolverComputeFlags;
  23972. BuiltInProc: TResElDataBuiltInProc;
  23973. Ref: TResolvedReference;
  23974. RArrayType: TPasArrayType;
  23975. begin
  23976. {$IFDEF VerbosePasResolver}
  23977. writeln('TPasResolver.CheckAssignCompatibilityArrayType.CheckRange ArrType=',GetObjName(ArrType),' RgIndex=',RangeIndex,' Values=',GetResolverResultDbg(Values));
  23978. {$ENDIF}
  23979. if not (rrfReadable in RHS.Flags) then
  23980. exit;
  23981. if (Values.BaseType=btContext) and (RangeIndex=0) and (Values.LoTypeEl=ArrType) then
  23982. begin
  23983. Result:=cExact;
  23984. exit;
  23985. end;
  23986. Expr:=Values.ExprEl;
  23987. if (Expr=nil) and (Values.IdentEl is TPasConst)
  23988. and (TPasConst(Values.IdentEl).VarType=nil) then
  23989. Expr:=TPasVariable(Values.IdentEl).Expr;
  23990. IsConstExpr:=(Expr<>nil) and ExprEvaluator.IsConst(Expr);
  23991. if IsConstExpr then
  23992. ExprCompFlags:=[rcConstant]
  23993. else
  23994. ExprCompFlags:=[];
  23995. if Expr<>nil then
  23996. begin
  23997. if IsEmptyArrayExpr(Values) then
  23998. begin
  23999. if length(ArrType.Ranges)=0 then
  24000. begin
  24001. if RaiseOnIncompatible then
  24002. MarkArrayExprRecursive(Values.ExprEl,ArrType);
  24003. Result:=cExact; // empty set fits open and dyn array
  24004. exit;
  24005. end;
  24006. end
  24007. else if IsArrayOperatorAdd(Expr) and not (Values.BaseType in btAllStrings) then
  24008. begin
  24009. // a:=left+right
  24010. if length(ArrType.Ranges)>0 then
  24011. exit; // ToDo: StaticArray:=A+B
  24012. // check a:=left
  24013. ComputeElement(TBinaryExpr(Expr).left,ValueResolved,ExprCompFlags);
  24014. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24015. if Result=cIncompatible then exit;
  24016. LeftResult:=Result;
  24017. // check a:=right
  24018. Result:=cIncompatible;
  24019. ComputeElement(TBinaryExpr(Expr).right,ValueResolved,ExprCompFlags);
  24020. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24021. if Result=cIncompatible then exit;
  24022. if Result<LeftResult then
  24023. Result:=LeftResult;
  24024. exit;
  24025. end
  24026. else if (Expr<>nil) and (Expr.ClassType=TParamsExpr)
  24027. and (TParamsExpr(Expr).Kind=pekFuncParams) then
  24028. begin
  24029. if TParamsExpr(Expr).Value.CustomData is TResolvedReference then
  24030. begin
  24031. Ref:=TResolvedReference(TParamsExpr(Expr).Value.CustomData);
  24032. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  24033. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  24034. begin
  24035. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  24036. ArrayValues:=TParamsExpr(Expr).Params;
  24037. if BuiltInProc.BuiltIn=bfConcatArray then
  24038. begin
  24039. // check Concat(array1,array2,...)
  24040. Result:=cExact;
  24041. for i:=0 to length(ArrayValues)-1 do
  24042. begin
  24043. LeftResult:=Result;
  24044. Result:=cIncompatible;
  24045. ComputeElement(ArrayValues[i],ValueResolved,ExprCompFlags);
  24046. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24047. if Result=cIncompatible then exit;
  24048. if Result<LeftResult then
  24049. Result:=LeftResult;
  24050. end;
  24051. exit;
  24052. end
  24053. else if BuiltInProc.BuiltIn=bfCopyArray then
  24054. begin
  24055. // check Copy(A...)
  24056. ComputeElement(ArrayValues[0],ValueResolved,ExprCompFlags);
  24057. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24058. exit;
  24059. end;
  24060. end;
  24061. end;
  24062. end;
  24063. end;
  24064. ExpectedCount:=-1;
  24065. if length(ArrType.Ranges)=0 then
  24066. begin
  24067. // dynamic array
  24068. if (Expr<>nil) then
  24069. begin
  24070. if Expr.ClassType=TArrayValues then
  24071. ExpectedCount:=length(TArrayValues(Expr).Values)
  24072. else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  24073. ExpectedCount:=length(TParamsExpr(Expr).Params)
  24074. else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
  24075. begin
  24076. // const a: dynarray = string
  24077. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  24078. if ElTypeResolved.BaseType in btAllChars then
  24079. Result:=cExact;
  24080. exit;
  24081. end
  24082. else
  24083. begin
  24084. // invalid
  24085. exit;
  24086. end;
  24087. end
  24088. else
  24089. begin
  24090. // type check
  24091. if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
  24092. exit;
  24093. RArrayType:=TPasArrayType(Values.LoTypeEl);
  24094. if length(RArrayType.Ranges)>0 then
  24095. begin
  24096. if RaiseOnIncompatible then
  24097. RaiseXExpectedButYFound(20180622104834,'dynamic array','static array',ErrorEl);
  24098. exit;
  24099. end;
  24100. // dynarr:=dynarr -> check element type
  24101. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  24102. Include(ElTypeResolved.Flags,rrfWritable);
  24103. ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
  24104. Include(ValueResolved.Flags,rrfReadable);
  24105. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
  24106. exit;
  24107. end;
  24108. Range:=nil;
  24109. IsLastRange:=true;
  24110. end
  24111. else
  24112. begin
  24113. // static array
  24114. Range:=ArrType.Ranges[RangeIndex];
  24115. ExpectedCount:=GetRangeLength(Range);
  24116. if ExpectedCount=0 then
  24117. begin
  24118. ComputeElement(Range,RangeResolved,[rcConstant]);
  24119. RaiseNotYetImplemented(20170222232409,Expr,'range '+GetResolverResultDbg(RangeResolved));
  24120. end;
  24121. IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
  24122. if Expr=nil then
  24123. begin
  24124. if (ValueResolved.BaseType=btContext) and (ValueResolved.LoTypeEl.ClassType=TPasArrayType) then
  24125. begin
  24126. {$IFDEF VerbosePasResolver}
  24127. writeln('CheckRange TODO StaticArr:=Arr');
  24128. {$ENDIF}
  24129. end;
  24130. exit;
  24131. end;
  24132. end;
  24133. if IsLastRange then
  24134. begin
  24135. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  24136. ElTypeResolved.ExprEl:=Range;
  24137. Include(ElTypeResolved.Flags,rrfWritable);
  24138. end
  24139. else
  24140. ElTypeResolved.BaseType:=btNone;
  24141. if (Expr<>nil)
  24142. and ((Expr.ClassType=TArrayValues)
  24143. or ((Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet))) then
  24144. begin
  24145. // array literal
  24146. if (ErrorEl.Parent is TPasVariable) then
  24147. begin
  24148. // array initialization e.g. var a: tarray = []
  24149. if msDelphi in CurrentParser.CurrentModeswitches then
  24150. begin
  24151. // Delphi expects square brackets for dynamic arrays
  24152. // and round brackets for static arrays
  24153. if length(ArrType.Ranges)>0 then
  24154. begin
  24155. // static array
  24156. if Expr.ClassType<>TArrayValues then
  24157. begin
  24158. if RaiseOnIncompatible then
  24159. RaiseXExpectedButYFound(20180615121203,'(','[',ErrorEl);
  24160. exit;
  24161. end;
  24162. end
  24163. else
  24164. begin
  24165. // dyn array
  24166. if Expr.ClassType=TArrayValues then
  24167. begin
  24168. if RaiseOnIncompatible then
  24169. RaiseXExpectedButYFound(20180615122953,'[','(',ErrorEl);
  24170. exit;
  24171. end;
  24172. end;
  24173. end
  24174. else
  24175. begin
  24176. // ObjFPC always expects round brackets in initialization
  24177. if Expr.ClassType<>TArrayValues then
  24178. begin
  24179. if RaiseOnIncompatible then
  24180. RaiseXExpectedButYFound(20170913181208,'(','[',ErrorEl);
  24181. exit;
  24182. end;
  24183. end;
  24184. end;
  24185. // check each value
  24186. if Expr.ClassType=TArrayValues then
  24187. ArrayValues:=TArrayValues(Expr).Values
  24188. else
  24189. ArrayValues:=TParamsExpr(Expr).Params;
  24190. ValCnt:=length(ArrayValues);
  24191. Include(ExprCompFlags,rcNoImplicitProcType);
  24192. for i:=0 to ExpectedCount-1 do
  24193. begin
  24194. if i=ValCnt then
  24195. begin
  24196. // not enough values
  24197. if ValCnt>0 then
  24198. ErrorEl:=ArrayValues[ValCnt-1];
  24199. RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24200. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  24201. end;
  24202. Value:=ArrayValues[i];
  24203. ComputeElement(Value,ValueResolved,ExprCompFlags);
  24204. if IsLastRange then
  24205. begin
  24206. // last dimension -> check element type
  24207. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
  24208. if Result=cIncompatible then
  24209. exit;
  24210. CheckAssignExprRange(ElTypeResolved,Value);
  24211. end
  24212. else
  24213. begin
  24214. // multi dimensional array -> check next range
  24215. CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
  24216. end;
  24217. end;
  24218. if ExpectedCount<ValCnt then
  24219. begin
  24220. // too many values
  24221. ErrorEl:=ArrayValues[ExpectedCount];
  24222. if RaiseOnIncompatible then
  24223. RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24224. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  24225. exit;
  24226. end;
  24227. if RaiseOnIncompatible and (Expr.ClassType=TParamsExpr) then
  24228. // mark [] expression as an array
  24229. MarkArrayExpr(TParamsExpr(Expr),ArrType);
  24230. end
  24231. else
  24232. begin
  24233. // single value
  24234. // Note: the parser does not store the difference between (1) and 1
  24235. if not IsLastRange then
  24236. begin
  24237. if RaiseOnIncompatible then
  24238. RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24239. [IntToStr(ExpectedCount),'1'],ErrorEl);
  24240. exit;
  24241. end;
  24242. if (Values.BaseType in btAllStrings) and (ElTypeResolved.BaseType in btAllChars) then
  24243. begin
  24244. // e.g. array of char = ''
  24245. Check_ArrayOfChar_String(ArrType,ExpectedCount,ElTypeResolved,Expr,ErrorEl);
  24246. exit;
  24247. end;
  24248. if (ExpectedCount>1) then
  24249. begin
  24250. if RaiseOnIncompatible then
  24251. begin
  24252. {$IFDEF VerbosePasResolver}
  24253. writeln('CheckRange Values=',GetResolverResultDbg(Values),' ElTypeResolved=',GetResolverResultDbg(ElTypeResolved));
  24254. {$ENDIF}
  24255. RaiseMsg(20170913103143,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24256. [IntToStr(ExpectedCount),'1'],ErrorEl);
  24257. end;
  24258. exit;
  24259. end;
  24260. // check element type
  24261. Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
  24262. if Result=cIncompatible then
  24263. exit;
  24264. if Expr<>nil then
  24265. CheckAssignExprRange(ElTypeResolved,Expr);
  24266. end;
  24267. end;
  24268. var
  24269. LArrType: TPasArrayType;
  24270. begin
  24271. Result:=cIncompatible;
  24272. {$IFDEF VerbosePasResolver}
  24273. writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  24274. {$ENDIF}
  24275. if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
  24276. RaiseInternalError(20170222230012);
  24277. LArrType:=TPasArrayType(LHS.LoTypeEl);
  24278. if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
  24279. and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
  24280. begin
  24281. // ArrayOfConst:=[]
  24282. exit(cExact);
  24283. end;
  24284. CheckRange(LArrType,0,RHS,ErrorEl);
  24285. if (Result=cIncompatible) and RaiseOnIncompatible then
  24286. RaiseIncompatibleTypeRes(20180622104721,nIncompatibleTypesGotExpected,[],RHS,LHS,ErrorEl);
  24287. end;
  24288. function TPasResolver.CheckAssignCompatibilityPointerType(LTypeEl,
  24289. RTypeEl: TPasType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24290. ): integer;
  24291. var
  24292. LeftResolved, RightResolved: TPasResolverResult;
  24293. begin
  24294. ComputeElement(LTypeEl,LeftResolved,[rcNoImplicitProc]);
  24295. ComputeElement(RTypeEl,RightResolved,[rcNoImplicitProc]);
  24296. Include(LeftResolved.Flags,rrfWritable);
  24297. Include(RightResolved.Flags,rrfReadable);
  24298. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  24299. end;
  24300. function TPasResolver.CheckEqualCompatibilityUserType(const LHS,
  24301. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24302. ): integer;
  24303. // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  24304. var
  24305. LTypeEl, RTypeEl: TPasType;
  24306. AResolved, BResolved: TPasResolverResult;
  24307. function IncompatibleElements: integer;
  24308. begin
  24309. Result:=cIncompatible;
  24310. if not RaiseOnIncompatible then exit;
  24311. RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
  24312. [],LTypeEl,RTypeEl,ErrorEl);
  24313. end;
  24314. begin
  24315. if (LHS.LoTypeEl=nil) then
  24316. RaiseInternalError(20161007223118);
  24317. if (RHS.LoTypeEl=nil) then
  24318. RaiseInternalError(20161007223119);
  24319. LTypeEl:=LHS.LoTypeEl;
  24320. RTypeEl:=RHS.LoTypeEl;
  24321. if LTypeEl=RTypeEl then
  24322. exit(cExact);
  24323. if LTypeEl.ClassType=TPasClassType then
  24324. begin
  24325. if RTypeEl.ClassType=TPasClassType then
  24326. begin
  24327. // e.g. if Sender=Button1 then
  24328. Result:=CheckSrcIsADstType(LHS,RHS);
  24329. if Result=cIncompatible then
  24330. Result:=CheckSrcIsADstType(RHS,LHS);
  24331. if (Result=cIncompatible) and RaiseOnIncompatible then
  24332. RaiseIncompatibleTypeRes(20180324190757,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  24333. exit;
  24334. end
  24335. else if RTypeEl.ClassType=TPasRecordType then
  24336. begin
  24337. if (TPasClassType(LTypeEl).ObjKind=okInterface)
  24338. and IsTGUID(TPasRecordType(RTypeEl)) then
  24339. // IntfVar=GuidVar
  24340. exit(cInterfaceToTGUID);
  24341. end;
  24342. exit(IncompatibleElements);
  24343. end
  24344. else if LTypeEl.ClassType=TPasClassOfType then
  24345. begin
  24346. if RTypeEl.ClassType=TPasClassOfType then
  24347. begin
  24348. // for example: if ImageClass=ImageClass then
  24349. Result:=CheckClassIsClass(TPasClassOfType(LTypeEl).DestType,
  24350. TPasClassOfType(RTypeEl).DestType);
  24351. if Result=cIncompatible then
  24352. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  24353. TPasClassOfType(LTypeEl).DestType);
  24354. if (Result=cIncompatible) and RaiseOnIncompatible then
  24355. RaiseIncompatibleTypeRes(20180324190804,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  24356. exit;
  24357. end;
  24358. exit(IncompatibleElements);
  24359. end
  24360. else if LTypeEl.ClassType=TPasEnumType then
  24361. begin
  24362. // enums of different type
  24363. if not RaiseOnIncompatible then
  24364. exit(cIncompatible);
  24365. if RTypeEl.ClassType=TPasEnumValue then
  24366. RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
  24367. [],TPasEnumType(LTypeEl),TPasEnumType(RTypeEl),ErrorEl)
  24368. else
  24369. exit(IncompatibleElements);
  24370. end
  24371. else if LTypeEl.ClassType=TPasRecordType then
  24372. begin
  24373. if RTypeEl.ClassType=TPasClassType then
  24374. begin
  24375. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  24376. and IsTGUID(TPasRecordType(LTypeEl)) then
  24377. // GuidVar=IntfVar
  24378. exit(cInterfaceToTGUID);
  24379. end;
  24380. end
  24381. else if LTypeEl.ClassType=TPasSetType then
  24382. begin
  24383. if RTypeEl.ClassType=TPasSetType then
  24384. begin
  24385. ComputeElement(TPasSetType(LTypeEl).EnumType,AResolved,[]);
  24386. ComputeElement(TPasSetType(RTypeEl).EnumType,BResolved,[]);
  24387. if (AResolved.LoTypeEl<>nil)
  24388. and (AResolved.LoTypeEl=BResolved.LoTypeEl) then
  24389. exit(cExact);
  24390. if (AResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24391. and (BResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24392. and (CompareText(AResolved.LoTypeEl.Name,BResolved.LoTypeEl.Name)=0) then
  24393. exit(cExact);
  24394. if RaiseOnIncompatible then
  24395. RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
  24396. [],AResolved,BResolved,ErrorEl)
  24397. else
  24398. exit(cIncompatible);
  24399. end
  24400. else
  24401. exit(IncompatibleElements);
  24402. end
  24403. else if LTypeEl is TPasProcedureType then
  24404. begin
  24405. if RTypeEl is TPasProcedureType then
  24406. begin
  24407. // e.g. ProcVar1 = ProcVar2
  24408. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  24409. false,nil,false) then
  24410. exit(cExact);
  24411. end
  24412. else
  24413. exit(IncompatibleElements);
  24414. end
  24415. else if LTypeEl.ClassType=TPasPointerType then
  24416. begin
  24417. if RTypeEl.ClassType=TPasPointerType then
  24418. // TypedPointer=TypedPointer
  24419. exit(cExact);
  24420. end;
  24421. exit(IncompatibleElements);
  24422. end;
  24423. function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
  24424. RaiseOnError: boolean): integer;
  24425. // for example if TClassA(AnObject)=nil then ;
  24426. var
  24427. Param: TPasExpr;
  24428. ParamResolved, ResolvedEl: TPasResolverResult;
  24429. begin
  24430. if length(Params.Params)<>1 then
  24431. begin
  24432. if RaiseOnError then
  24433. RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
  24434. sWrongNumberOfParametersForTypeCast,[El.Name],Params);
  24435. exit(cIncompatible);
  24436. end;
  24437. Param:=Params.Params[0];
  24438. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  24439. ComputeElement(El,ResolvedEl,[rcType]);
  24440. Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
  24441. end;
  24442. function TPasResolver.CheckTypeCastRes(const FromResolved,
  24443. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  24444. ): integer;
  24445. var
  24446. ToTypeEl, ToClassType, FromClassType, FromTypeEl: TPasType;
  24447. ToTypeBaseType: TResolverBaseType;
  24448. C: TClass;
  24449. ToProcType, FromProcType: TPasProcedureType;
  24450. TemplType: TPasGenericTemplateType;
  24451. i: Integer;
  24452. ConToken: TToken;
  24453. ConEl: TPasElement;
  24454. begin
  24455. Result:=cIncompatible;
  24456. ToTypeEl:=ToResolved.LoTypeEl;
  24457. if (ToTypeEl<>nil)
  24458. and (rrfReadable in FromResolved.Flags) then
  24459. begin
  24460. C:=ToTypeEl.ClassType;
  24461. if FromResolved.BaseType=btUntyped then
  24462. begin
  24463. // typecast an untyped parameter
  24464. Result:=cCompatible;
  24465. end
  24466. else if C=TPasUnresolvedSymbolRef then
  24467. begin
  24468. if ToTypeEl.CustomData is TResElDataBaseType then
  24469. begin
  24470. // base type cast, e.g. double(aninteger)
  24471. if ToTypeEl=FromResolved.LoTypeEl then
  24472. exit(cExact);
  24473. ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
  24474. if ToTypeBaseType=FromResolved.BaseType then
  24475. Result:=cExact
  24476. else if ToTypeBaseType in btAllInteger then
  24477. begin
  24478. if FromResolved.BaseType in (btArrayRangeTypes+[btRange,btCurrency]) then
  24479. Result:=cCompatible
  24480. else if FromResolved.BaseType=btContext then
  24481. begin
  24482. FromTypeEl:=FromResolved.LoTypeEl;
  24483. if FromTypeEl.ClassType=TPasEnumType then
  24484. // e.g. longint(TEnum)
  24485. Result:=cCompatible;
  24486. end;
  24487. end
  24488. else if ToTypeBaseType in btAllFloats then
  24489. begin
  24490. if FromResolved.BaseType in btAllFloats then
  24491. Result:=cCompatible
  24492. else if FromResolved.BaseType in btAllInteger then
  24493. Result:=cCompatible;
  24494. end
  24495. else if ToTypeBaseType in btAllBooleans then
  24496. begin
  24497. if FromResolved.BaseType in btAllBooleans then
  24498. Result:=cCompatible
  24499. else if FromResolved.BaseType in btAllInteger then
  24500. Result:=cCompatible;
  24501. end
  24502. else if ToTypeBaseType in btAllChars then
  24503. begin
  24504. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  24505. Result:=cCompatible
  24506. else if FromResolved.BaseType=btContext then
  24507. begin
  24508. FromTypeEl:=FromResolved.LoTypeEl;
  24509. if FromTypeEl.ClassType=TPasEnumType then
  24510. // e.g. char(TEnum)
  24511. Result:=cCompatible;
  24512. end;
  24513. end
  24514. else if ToTypeBaseType in btAllStrings then
  24515. begin
  24516. if FromResolved.BaseType in btAllStringAndChars then
  24517. Result:=cCompatible
  24518. else if (FromResolved.BaseType=btPointer)
  24519. and (ToTypeBaseType in btAllStringPointer) then
  24520. Result:=cExact;
  24521. end
  24522. else if ToTypeBaseType=btPointer then
  24523. begin
  24524. if FromResolved.BaseType in ([btPointer]+btAllStringPointer) then
  24525. Result:=cExact
  24526. else if FromResolved.BaseType=btContext then
  24527. begin
  24528. FromTypeEl:=FromResolved.LoTypeEl;
  24529. C:=FromTypeEl.ClassType;
  24530. if (C=TPasClassType)
  24531. or (C=TPasClassOfType)
  24532. or (C=TPasPointerType)
  24533. or ((C=TPasArrayType) and IsDynArray(FromTypeEl)) then
  24534. Result:=cExact
  24535. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  24536. begin
  24537. // from procvar to pointer
  24538. FromProcType:=TPasProcedureType(FromTypeEl);
  24539. if FromProcType.IsOfObject then
  24540. begin
  24541. if proMethodAddrAsPointer in Options then
  24542. Result:=cCompatible
  24543. else if RaiseOnError then
  24544. RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24545. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmOfObject],
  24546. BaseTypeNames[btPointer]],ErrorEl);
  24547. end
  24548. else if FromProcType.IsNested then
  24549. begin
  24550. if RaiseOnError then
  24551. RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24552. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmIsNested],
  24553. BaseTypeNames[btPointer]],ErrorEl);
  24554. end
  24555. else if FromProcType.IsReferenceTo then
  24556. begin
  24557. if proProcTypeWithoutIsNested in Options then
  24558. Result:=cCompatible
  24559. else if RaiseOnError then
  24560. RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24561. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmReferenceTo],
  24562. BaseTypeNames[btPointer]],ErrorEl);
  24563. end
  24564. else
  24565. Result:=cCompatible;
  24566. end;
  24567. end;
  24568. end;
  24569. end;
  24570. end
  24571. else if C=TPasClassType then
  24572. begin
  24573. // to class
  24574. if FromResolved.BaseType=btContext then
  24575. begin
  24576. FromTypeEl:=FromResolved.LoTypeEl;
  24577. if FromTypeEl.ClassType=TPasClassType then
  24578. begin
  24579. if FromResolved.IdentEl is TPasType then
  24580. RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  24581. if TPasClassType(FromTypeEl).ObjKind=TPasClassType(ToTypeEl).ObjKind then
  24582. begin
  24583. // type cast upwards or downwards
  24584. Result:=CheckSrcIsADstType(FromResolved,ToResolved);
  24585. if Result=cIncompatible then
  24586. Result:=CheckSrcIsADstType(ToResolved,FromResolved);
  24587. end
  24588. else if TPasClassType(ToTypeEl).ObjKind=okInterface then
  24589. begin
  24590. if (TPasClassType(FromTypeEl).ObjKind=okClass)
  24591. and (not TPasClassType(FromTypeEl).IsExternal) then
  24592. begin
  24593. // e.g. intftype(classinstvar)
  24594. Result:=cCompatible;
  24595. end;
  24596. end
  24597. else if TPasClassType(FromTypeEl).ObjKind=okInterface then
  24598. begin
  24599. if (TPasClassType(ToTypeEl).ObjKind=okClass)
  24600. and (not TPasClassType(ToTypeEl).IsExternal) then
  24601. begin
  24602. // e.g. classtype(intfvar)
  24603. Result:=cCompatible;
  24604. end;
  24605. end;
  24606. if Result=cIncompatible then
  24607. Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
  24608. end
  24609. else if FromTypeEl.ClassType=TPasGenericTemplateType then
  24610. begin
  24611. // e.g. aClassType(T)
  24612. TemplType:=TPasGenericTemplateType(FromTypeEl);
  24613. if length(TemplType.Constraints)=0 then
  24614. begin
  24615. // typecast unconstrained template to a classtype
  24616. // -> check when specialize
  24617. Result:=cExact;
  24618. end
  24619. else
  24620. for i:=0 to length(TemplType.Constraints)-1 do
  24621. begin
  24622. ConEl:=TemplType.Constraints[i];
  24623. ConToken:=GetGenericConstraintKeyword(ConEl);
  24624. case ConToken of
  24625. tkrecord: ; // invalid type cast
  24626. tkClass, tkconstructor:
  24627. Result:=cExact;
  24628. else
  24629. // identifier constraint: class or interface -> allow
  24630. Result:=cExact;
  24631. break;
  24632. end;
  24633. end;
  24634. end;
  24635. end
  24636. else if FromResolved.BaseType=btPointer then
  24637. begin
  24638. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  24639. Result:=cExact; // untyped pointer to class instance
  24640. end
  24641. else if FromResolved.BaseType=btNil then
  24642. Result:=cExact; // nil to class or interface
  24643. end
  24644. else if C=TPasGenericTemplateType then
  24645. begin
  24646. // e.g. T(var)
  24647. TemplType:=TPasGenericTemplateType(ToTypeEl);
  24648. FromTypeEl:=FromResolved.LoTypeEl;
  24649. for i:=0 to length(TemplType.Constraints)-1 do
  24650. begin
  24651. ConEl:=TemplType.Constraints[i];
  24652. ConToken:=GetGenericConstraintKeyword(ConEl);
  24653. case ConToken of
  24654. tkrecord:
  24655. if FromResolved.BaseType=btContext then
  24656. begin
  24657. if FromTypeEl.ClassType=TPasRecordType then
  24658. // typecast record to template record
  24659. Result:=cExact
  24660. else if FromTypeEl.ClassType=TPasGenericType then
  24661. // typecast template to template record
  24662. Result:=cExact;
  24663. end;
  24664. tkClass, tkconstructor:
  24665. Result:=cExact;
  24666. else
  24667. // identifier constraint: class or interface -> allow
  24668. Result:=cExact;
  24669. break;
  24670. end;
  24671. end;
  24672. end
  24673. else if C=TPasClassOfType then
  24674. begin
  24675. //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.LoTypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
  24676. if FromResolved.BaseType=btContext then
  24677. begin
  24678. if FromResolved.LoTypeEl.ClassType=TPasClassOfType then
  24679. begin
  24680. if (FromResolved.IdentEl is TPasType) then
  24681. RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  24682. // type cast classof(classof-var) upwards or downwards
  24683. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  24684. FromClassType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
  24685. Result:=CheckClassesAreRelated(ToClassType,FromClassType);
  24686. end;
  24687. end
  24688. else if FromResolved.BaseType=btPointer then
  24689. begin
  24690. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  24691. Result:=cExact; // untyped pointer to class-of
  24692. end
  24693. else if FromResolved.BaseType=btNil then
  24694. Result:=cExact; // nil to class-of
  24695. end
  24696. else if C=TPasRecordType then
  24697. begin
  24698. if FromResolved.BaseType=btContext then
  24699. begin
  24700. if FromResolved.LoTypeEl.ClassType=TPasRecordType then
  24701. begin
  24702. // typecast record to record
  24703. Result:=cExact;
  24704. end;
  24705. end;
  24706. end
  24707. else if (C=TPasEnumType)
  24708. or (C=TPasRangeType) then
  24709. begin
  24710. if CheckIsOrdinal(FromResolved,ErrorEl,true) then
  24711. Result:=cExact;
  24712. end
  24713. else if C=TPasArrayType then
  24714. begin
  24715. if FromResolved.BaseType=btContext then
  24716. begin
  24717. if FromResolved.LoTypeEl.ClassType=TPasArrayType then
  24718. Result:=CheckTypeCastArray(TPasArrayType(FromResolved.LoTypeEl),
  24719. TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
  24720. end
  24721. else if FromResolved.BaseType=btPointer then
  24722. begin
  24723. if IsDynArray(ToResolved.LoTypeEl)
  24724. and IsBaseType(FromResolved.LoTypeEl,btPointer) then
  24725. Result:=cExact; // untyped pointer to dynamic array
  24726. end
  24727. else if FromResolved.BaseType=btNil then
  24728. begin
  24729. if IsDynArray(ToResolved.LoTypeEl) then
  24730. Result:=cExact; // nil to dynamic array
  24731. end;
  24732. end
  24733. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  24734. begin
  24735. ToProcType:=TPasProcedureType(ToTypeEl);
  24736. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  24737. begin
  24738. // type cast untyped pointer value to proctype
  24739. if ToProcType.IsOfObject then
  24740. begin
  24741. if proMethodAddrAsPointer in Options then
  24742. Result:=cCompatible
  24743. else if RaiseOnError then
  24744. RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24745. [BaseTypeNames[btPointer],
  24746. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
  24747. end
  24748. else if ToProcType.IsNested then
  24749. begin
  24750. if RaiseOnError then
  24751. RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24752. [BaseTypeNames[btPointer],
  24753. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
  24754. end
  24755. else if ToProcType.IsReferenceTo then
  24756. begin
  24757. if proMethodAddrAsPointer in Options then
  24758. Result:=cCompatible
  24759. else if RaiseOnError then
  24760. RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24761. [BaseTypeNames[btPointer],
  24762. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
  24763. end
  24764. else
  24765. Result:=cCompatible;
  24766. end
  24767. else if FromResolved.BaseType=btContext then
  24768. begin
  24769. FromTypeEl:=FromResolved.LoTypeEl;
  24770. if FromTypeEl is TPasProcedureType then
  24771. begin
  24772. // type cast procvar to proctype
  24773. FromProcType:=TPasProcedureType(FromTypeEl);
  24774. if ToProcType.IsReferenceTo then
  24775. Result:=cCompatible
  24776. else if FromProcType.IsReferenceTo then
  24777. Result:=cCompatible
  24778. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  24779. and not (proMethodAddrAsPointer in Options) then
  24780. begin
  24781. if RaiseOnError then
  24782. RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24783. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  24784. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  24785. end
  24786. else if FromProcType.IsNested<>ToProcType.IsNested then
  24787. begin
  24788. if RaiseOnError then
  24789. RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24790. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  24791. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  24792. end
  24793. else
  24794. Result:=cCompatible;
  24795. end
  24796. end
  24797. else if FromResolved.BaseType=btProc then
  24798. begin
  24799. FromTypeEl:=FromResolved.LoTypeEl;
  24800. if FromTypeEl is TPasProcedureType then
  24801. begin
  24802. // typecast procedure (or anonymous procedure) to proctype
  24803. FromProcType:=TPasProcedureType(FromTypeEl);
  24804. if (msDelphi in CurrentParser.CurrentModeswitches)
  24805. and (FromResolved.IdentEl=nil)
  24806. and (FromResolved.LoTypeEl.Name<>'') then
  24807. // Delphi forbids typecast (non anonymous) procedure to proctype
  24808. else if ToProcType.IsReferenceTo then
  24809. Result:=cCompatible
  24810. else if FromResolved.IdentEl=nil then
  24811. // anonymous proc to proctype
  24812. Result:=cCompatible
  24813. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  24814. and not (proMethodAddrAsPointer in Options) then
  24815. begin
  24816. // e.g. TProcedure(Obj.DoIt)
  24817. if RaiseOnError then
  24818. RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24819. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  24820. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  24821. end
  24822. else if FromProcType.IsNested<>ToProcType.IsNested then
  24823. begin
  24824. if RaiseOnError then
  24825. RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  24826. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  24827. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  24828. end
  24829. else
  24830. Result:=cCompatible;
  24831. end;
  24832. end
  24833. else if FromResolved.BaseType=btNil then
  24834. // typecast nil to procedure type
  24835. Result:=cExact;
  24836. end
  24837. else if C=TPasPointerType then
  24838. begin
  24839. // typecast to typedpointer
  24840. if FromResolved.BaseType in [btPointer,btNil] then
  24841. Result:=cExact
  24842. else if FromResolved.BaseType=btContext then
  24843. begin
  24844. FromTypeEl:=FromResolved.LoTypeEl;
  24845. C:=FromTypeEl.ClassType;
  24846. if (C=TPasPointerType)
  24847. or (C=TPasClassOfType)
  24848. or (C=TPasClassType)
  24849. or (C.InheritsFrom(TPasProcedureType))
  24850. or IsDynArray(FromTypeEl) then
  24851. Result:=cCompatible;
  24852. end;
  24853. end
  24854. end
  24855. else if ToTypeEl<>nil then
  24856. begin
  24857. // FromResolved is not readable
  24858. if FromResolved.BaseType=btContext then
  24859. begin
  24860. FromTypeEl:=FromResolved.LoTypeEl;
  24861. if (FromTypeEl.ClassType=TPasClassType)
  24862. and (FromTypeEl=FromResolved.IdentEl)
  24863. and (ToResolved.BaseType=btContext) then
  24864. begin
  24865. ToTypeEl:=ToResolved.LoTypeEl;
  24866. if (ToTypeEl.ClassType=TPasClassOfType)
  24867. and (ToTypeEl=ToResolved.IdentEl) then
  24868. begin
  24869. // for example class-of(Self) in a class function
  24870. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  24871. FromClassType:=TPasClassType(FromTypeEl);
  24872. Result:=CheckClassesAreRelated(ToClassType,FromClassType);
  24873. end;
  24874. end;
  24875. end;
  24876. if (Result=cIncompatible) and RaiseOnError then
  24877. begin
  24878. if FromResolved.IdentEl is TPasType then
  24879. RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  24880. end;
  24881. end;
  24882. if Result=cIncompatible then
  24883. begin
  24884. {$IFDEF VerbosePasResolver}
  24885. writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
  24886. {$ENDIF}
  24887. if RaiseOnError then
  24888. RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
  24889. [],FromResolved,ToResolved,ErrorEl);
  24890. exit;
  24891. end;
  24892. end;
  24893. function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
  24894. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  24895. function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
  24896. out ElTypeResolved: TPasResolverResult): boolean;
  24897. begin
  24898. inc(NextIndex);
  24899. if NextIndex<length(ArrType.Ranges) then
  24900. begin
  24901. ElTypeResolved.BaseType:=btNone;
  24902. exit(true);
  24903. end;
  24904. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  24905. if (ElTypeResolved.BaseType<>btContext)
  24906. or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
  24907. exit(false);
  24908. ArrType:=TPasArrayType(ElTypeResolved.LoTypeEl);
  24909. NextIndex:=0;
  24910. Result:=true;
  24911. end;
  24912. var
  24913. FromIndex, ToIndex: Integer;
  24914. FromElTypeRes, ToElTypeRes: TPasResolverResult;
  24915. StartFromType, StartToType: TPasArrayType;
  24916. begin
  24917. {$IFDEF VerbosePasResolver}
  24918. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
  24919. {$ENDIF}
  24920. StartFromType:=FromType;
  24921. StartToType:=ToType;
  24922. Result:=cIncompatible;
  24923. // check dimensions
  24924. FromIndex:=0;
  24925. ToIndex:=0;
  24926. repeat
  24927. {$IFDEF VerbosePasResolver}
  24928. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  24929. {$ENDIF}
  24930. if length(ToType.Ranges)=0 then
  24931. // ToType is dynamic/open array -> fits any size
  24932. else
  24933. begin
  24934. // ToType is ranged
  24935. // ToDo: check size of dimension
  24936. end;
  24937. // check next dimension
  24938. if not NextDim(FromType,FromIndex,FromElTypeRes) then
  24939. begin
  24940. // at end of FromType
  24941. if NextDim(ToType,ToIndex,ToElTypeRes) then
  24942. begin
  24943. {$IFDEF VerbosePasResolver}
  24944. writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  24945. {$ENDIF}
  24946. break; // ToType has more dimensions
  24947. end;
  24948. // have same dimension -> check ElType
  24949. {$IFDEF VerbosePasResolver}
  24950. writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
  24951. {$ENDIF}
  24952. Include(FromElTypeRes.Flags,rrfReadable);
  24953. Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
  24954. break;
  24955. end
  24956. else
  24957. begin
  24958. // FromType has more dimensions
  24959. if not NextDim(ToType,ToIndex,ToElTypeRes) then
  24960. begin
  24961. {$IFDEF VerbosePasResolver}
  24962. writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  24963. {$ENDIF}
  24964. break; // ToType has less dimensions
  24965. end;
  24966. end;
  24967. until false;
  24968. if (Result=cIncompatible) and RaiseOnError then
  24969. RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
  24970. [],StartFromType,StartToType,ErrorEl);
  24971. end;
  24972. procedure TPasResolver.ComputeElement(El: TPasElement; out
  24973. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  24974. StartEl: TPasElement);
  24975. procedure ComputeIdentifier(Expr: TPasExpr);
  24976. var
  24977. Ref: TResolvedReference;
  24978. Proc: TPasProcedure;
  24979. ProcType: TPasProcedureType;
  24980. begin
  24981. Ref:=TResolvedReference(Expr.CustomData);
  24982. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  24983. if rrfConstInherited in Ref.Flags then
  24984. Exclude(ResolvedEl.Flags,rrfWritable);
  24985. {$IFDEF VerbosePasResolver}
  24986. {AllowWriteln}
  24987. if Expr is TPrimitiveExpr then
  24988. writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
  24989. else
  24990. writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
  24991. {AllowWriteln-}
  24992. {$ENDIF}
  24993. //if (Expr is TPrimitiveExpr) and (Expr.Parent is TParamsExpr) and (TPrimitiveExpr(Expr).Value='FA') then
  24994. // RaiseNotYetImplemented(20180621235200,Expr);
  24995. if not (rcSetReferenceFlags in Flags)
  24996. and (rrfNoImplicitCallWithoutParams in Ref.Flags) then
  24997. exit;
  24998. if (ResolvedEl.BaseType=btProc) then
  24999. begin
  25000. // proc
  25001. if rcNoImplicitProc in Flags then
  25002. begin
  25003. if rcSetReferenceFlags in Flags then
  25004. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25005. end
  25006. else if [rcConstant,rcType]*Flags=[] then
  25007. begin
  25008. // implicit call without params is allowed -> check if possible
  25009. Proc:=ResolvedEl.IdentEl as TPasProcedure;
  25010. if not ProcNeedsParams(Proc.ProcType) then
  25011. begin
  25012. // parameter less proc -> implicit call possible
  25013. if ResolvedEl.IdentEl is TPasFunction then
  25014. begin
  25015. // function => return result
  25016. ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
  25017. ResolvedEl,Flags+[rcType],StartEl);
  25018. end
  25019. else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
  25020. begin
  25021. // constructor -> return value of type class
  25022. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  25023. end
  25024. else if ParentNeedsExprResult(Expr) then
  25025. begin
  25026. // a procedure
  25027. exit;
  25028. end;
  25029. if rcSetReferenceFlags in Flags then
  25030. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25031. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25032. end;
  25033. end;
  25034. end
  25035. else if IsProcedureType(ResolvedEl,true) then
  25036. begin
  25037. // proc type
  25038. if [rcNoImplicitProc,rcNoImplicitProcType]*Flags<>[] then
  25039. begin
  25040. if rcSetReferenceFlags in Flags then
  25041. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25042. end
  25043. else if [rcConstant,rcType]*Flags=[] then
  25044. begin
  25045. // implicit call without params is allowed -> check if possible
  25046. ProcType:=TPasProcedureType(ResolvedEl.LoTypeEl);
  25047. if not ProcNeedsParams(ProcType) then
  25048. begin
  25049. // parameter less proc type -> implicit call possible
  25050. if ResolvedEl.LoTypeEl is TPasFunctionType then
  25051. // function => return result
  25052. ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  25053. ResolvedEl,Flags+[rcType],StartEl)
  25054. else if ParentNeedsExprResult(Expr) then
  25055. begin
  25056. // a procedure has no result
  25057. exit;
  25058. end;
  25059. if rcSetReferenceFlags in Flags then
  25060. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25061. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25062. end;
  25063. end;
  25064. end;
  25065. end;
  25066. procedure ComputeInherited(Expr: TInheritedExpr);
  25067. var
  25068. Ref: TResolvedReference;
  25069. Proc: TPasProcedure;
  25070. TypeEl: TPasProcedureType;
  25071. HasName: Boolean;
  25072. begin
  25073. // "inherited;"
  25074. Ref:=TResolvedReference(El.CustomData);
  25075. Proc:=NoNil(Ref.Declaration) as TPasProcedure;
  25076. TypeEl:=TPasProcedure(Proc).ProcType;
  25077. SetResolverIdentifier(ResolvedEl,btProc,Proc,
  25078. TypeEl,TypeEl,[rrfCanBeStatement]);
  25079. HasName:=(El.Parent.ClassType=TBinaryExpr)
  25080. and (TBinaryExpr(El.Parent).OpCode=eopNone); // true if 'inherited Proc;'
  25081. if HasName or (rcNoImplicitProc in Flags) then
  25082. exit;
  25083. // inherited; -> implicit call possible
  25084. if Proc is TPasFunction then
  25085. begin
  25086. // function => return result
  25087. ComputeElement(TPasFunction(Proc).FuncType.ResultEl,
  25088. ResolvedEl,Flags+[rcType],StartEl);
  25089. Exclude(ResolvedEl.Flags,rrfWritable);
  25090. end
  25091. else if (Proc.ClassType=TPasConstructor)
  25092. and (rrfNewInstance in Ref.Flags) then
  25093. begin
  25094. // new instance constructor -> return value of type class
  25095. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  25096. end
  25097. else if ParentNeedsExprResult(Expr) then
  25098. begin
  25099. // a procedure
  25100. exit;
  25101. end;
  25102. if rcSetReferenceFlags in Flags then
  25103. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25104. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25105. end;
  25106. procedure ComputeSpecializeType(SpecType: TPasSpecializeType);
  25107. var
  25108. TypeEl: TPasType;
  25109. begin
  25110. if SpecType.CustomData is TPasSpecializeTypeData then
  25111. begin
  25112. TypeEl:=TPasSpecializeTypeData(SpecType.CustomData).SpecializedType;
  25113. if TypeEl=nil then
  25114. RaiseNotYetImplemented(20190908153503,El);
  25115. SetResolverIdentifier(ResolvedEl,btContext,TypeEl,TypeEl,TypeEl,[]);
  25116. end
  25117. else
  25118. begin
  25119. TypeEl:=SpecType.DestType;
  25120. if TypeEl=nil then
  25121. RaiseNotYetImplemented(20190908153434,El);
  25122. SetResolverIdentifier(ResolvedEl,btContext,SpecType,TypeEl,SpecType,[]);
  25123. end;
  25124. end;
  25125. var
  25126. DeclEl: TPasElement;
  25127. ElClass: TClass;
  25128. bt: TResolverBaseType;
  25129. TypeEl: TPasType;
  25130. Value: TResEvalValue;
  25131. Int: TMaxPrecInt;
  25132. begin
  25133. if StartEl=nil then StartEl:=El;
  25134. ResolvedEl:=Default(TPasResolverResult);
  25135. {$IFDEF VerbosePasResolver}
  25136. writeln('TPasResolver.ComputeElement El=',GetObjName(El));
  25137. {$ENDIF}
  25138. if El=nil then
  25139. exit;
  25140. ElClass:=El.ClassType;
  25141. if ElClass=TPrimitiveExpr then
  25142. begin
  25143. case TPrimitiveExpr(El).Kind of
  25144. pekIdent,pekSelf:
  25145. begin
  25146. if not (El.CustomData is TResolvedReference) then
  25147. RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  25148. ComputeIdentifier(TPrimitiveExpr(El));
  25149. end;
  25150. pekNumber:
  25151. begin
  25152. if NumberIsFloat(TPrimitiveExpr(El).Value) then
  25153. bt:=BaseTypeExtended
  25154. else if length(TPrimitiveExpr(El).Value)<9 then
  25155. bt:=btLongint
  25156. else
  25157. begin
  25158. // with 9+ it could be longword: e.g. $87654321
  25159. Value:=Eval(TPrimitiveExpr(El),[]);
  25160. if Value=nil then
  25161. RaiseNotYetImplemented(20190130162601,El);
  25162. try
  25163. case Value.Kind of
  25164. revkInt:
  25165. begin
  25166. Int:=TResEvalInt(Value).Int;
  25167. bt:=GetSmallestIntegerBaseType(Int,Int);
  25168. end;
  25169. {$IFDEF HasInt64}
  25170. revkUInt:
  25171. bt:=btQWord;
  25172. {$ENDIF}
  25173. else
  25174. bt:=BaseTypeExtended;
  25175. end;
  25176. finally
  25177. ReleaseEvalValue(Value);
  25178. end;
  25179. end;
  25180. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  25181. TPrimitiveExpr(El),[rrfReadable])
  25182. end;
  25183. pekString:
  25184. begin
  25185. {$IFDEF VerbosePasResolver}
  25186. writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
  25187. {$ENDIF}
  25188. bt:=IsCharLiteral(TPrimitiveExpr(El).Value,El);
  25189. if bt in btAllChars then
  25190. begin
  25191. if bt=BaseTypeChar then
  25192. bt:=btChar;
  25193. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  25194. TPrimitiveExpr(El),[rrfReadable]);
  25195. end
  25196. else
  25197. SetResolverValueExpr(ResolvedEl,btString,
  25198. FBaseTypes[btString],FBaseTypes[btString],
  25199. TPrimitiveExpr(El),[rrfReadable]);
  25200. end;
  25201. pekNil:
  25202. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  25203. TPrimitiveExpr(El),[rrfReadable]);
  25204. pekBoolConst:
  25205. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  25206. TPrimitiveExpr(El),[rrfReadable]);
  25207. else
  25208. RaiseNotYetImplemented(20160922163701,El);
  25209. end;
  25210. end
  25211. else if ElClass=TPasUnresolvedSymbolRef then
  25212. begin
  25213. // built-in type
  25214. if El.CustomData is TResElDataBaseType then
  25215. SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
  25216. El,TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[])
  25217. else if El.CustomData is TResElDataBuiltInProc then
  25218. begin
  25219. SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,
  25220. TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[]);
  25221. if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
  25222. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25223. end
  25224. else
  25225. RaiseNotYetImplemented(20160926194756,El);
  25226. end
  25227. else if ElClass=TBoolConstExpr then
  25228. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  25229. TBoolConstExpr(El),[rrfReadable])
  25230. else if ElClass=TBinaryExpr then
  25231. ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
  25232. else if ElClass=TUnaryExpr then
  25233. begin
  25234. if TUnaryExpr(El).OpCode in [eopAddress,eopMemAddress] then
  25235. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  25236. else
  25237. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
  25238. {$IFDEF VerbosePasResolver}
  25239. writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
  25240. {$ENDIF}
  25241. case TUnaryExpr(El).OpCode of
  25242. eopAdd, eopSubtract:
  25243. if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
  25244. exit
  25245. else if IsGenericTemplType(ResolvedEl) then
  25246. exit
  25247. else
  25248. RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  25249. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  25250. eopNot:
  25251. begin
  25252. if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
  25253. else
  25254. ComputeUnaryNot(TUnaryExpr(El),ResolvedEl,Flags);
  25255. exit;
  25256. end;
  25257. eopAddress:
  25258. if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
  25259. begin
  25260. SetResolverValueExpr(ResolvedEl,btContext,
  25261. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  25262. exit;
  25263. end
  25264. else if (rrfReadable in ResolvedEl.Flags) and (ResolvedEl.BaseType<>btPointer) then
  25265. begin
  25266. SetResolverValueExpr(ResolvedEl,btPointer,
  25267. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  25268. exit;
  25269. end
  25270. else
  25271. RaiseMsg(20180208121541,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  25272. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  25273. eopDeref:
  25274. begin
  25275. ComputeDereference(TUnaryExpr(El),ResolvedEl);
  25276. exit;
  25277. end;
  25278. eopMemAddress:
  25279. if (ResolvedEl.BaseType=btContext)
  25280. and ((ResolvedEl.LoTypeEl is TPasProcedureType)
  25281. or IsGenericTemplType(ResolvedEl)) then
  25282. // @@ProcVar
  25283. exit
  25284. else
  25285. RaiseMsg(20180208121549,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  25286. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  25287. end;
  25288. {$IFDEF VerbosePasResolver}
  25289. writeln('TPasResolver.ComputeElement OpCode=',TUnaryExpr(El).OpCode);
  25290. {$ENDIF}
  25291. RaiseNotYetImplemented(20160926142426,El);
  25292. end
  25293. else if ElClass=TParamsExpr then
  25294. case TParamsExpr(El).Kind of
  25295. pekArrayParams: // a[]
  25296. ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  25297. pekFuncParams: // a()
  25298. ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  25299. pekSet: // []
  25300. ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  25301. else
  25302. RaiseNotYetImplemented(20161010184559,El);
  25303. end
  25304. else if ElClass=TInheritedExpr then
  25305. begin
  25306. // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
  25307. if El.CustomData is TResolvedReference then
  25308. ComputeInherited(TInheritedExpr(El))
  25309. else
  25310. // no ancestor proc
  25311. SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,nil,[rrfCanBeStatement]);
  25312. end
  25313. else if (ElClass=TPasAliasType) or (ElClass=TPasTypeAliasType) then
  25314. begin
  25315. // e.g. 'type a = b' -> compute b
  25316. ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  25317. ResolvedEl.IdentEl:=El;
  25318. ResolvedEl.HiTypeEl:=TPasAliasType(El);
  25319. end
  25320. else if (ElClass=TPasVariable) then
  25321. begin
  25322. // e.g. 'var a:b' -> compute b, use a as IdentEl
  25323. if rcConstant in Flags then
  25324. RaiseConstantExprExp(20170216152737,StartEl);
  25325. ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  25326. ResolvedEl.IdentEl:=El;
  25327. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  25328. end
  25329. else if (ElClass=TPasConst) then
  25330. begin
  25331. // e.g. 'var a:b' -> compute b, use a as IdentEl
  25332. if TPasConst(El).VarType<>nil then
  25333. begin
  25334. // typed const
  25335. if (not TPasConst(El).IsConst) and ([rcConstant,rcType]*Flags<>[]) then
  25336. RaiseConstantExprExp(20170216152739,StartEl);
  25337. ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  25338. ResolvedEl.IdentEl:=El;
  25339. if TPasConst(El).IsConst then
  25340. ResolvedEl.Flags:=[rrfReadable]
  25341. else
  25342. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  25343. end
  25344. else
  25345. begin
  25346. // untyped const
  25347. ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
  25348. ResolvedEl.IdentEl:=El;
  25349. ResolvedEl.Flags:=[rrfReadable];
  25350. end;
  25351. end
  25352. else if (ElClass=TPasEnumValue) then
  25353. begin
  25354. TypeEl:=NoNil(El.Parent) as TPasEnumType;
  25355. SetResolverIdentifier(ResolvedEl,btContext,El,TypeEl,TypeEl,[rrfReadable])
  25356. end
  25357. else if (ElClass=TPasEnumType) then
  25358. SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),TPasEnumType(El),[])
  25359. else if (ElClass=TPasProperty) then
  25360. begin
  25361. if rcConstant in Flags then
  25362. RaiseConstantExprExp(20170216152741,StartEl);
  25363. if GetPasPropertyArgs(TPasProperty(El)).Count=0 then
  25364. begin
  25365. ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
  25366. Flags+[rcType],StartEl);
  25367. ResolvedEl.IdentEl:=El;
  25368. ResolvedEl.Flags:=[];
  25369. if GetPasPropertyGetter(TPasProperty(El))<>nil then
  25370. Include(ResolvedEl.Flags,rrfReadable);
  25371. if GetPasPropertySetter(TPasProperty(El))<>nil then
  25372. Include(ResolvedEl.Flags,rrfWritable);
  25373. if IsProcedureType(ResolvedEl,true) then
  25374. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25375. end
  25376. else
  25377. begin
  25378. // index property without name
  25379. // Note: computing the pekArrayParams TParamsExpr will convert this to the type
  25380. SetResolverIdentifier(ResolvedEl,btArrayProperty,El,nil,nil,[]);
  25381. end;
  25382. end
  25383. else if ElClass=TPasArgument then
  25384. begin
  25385. if rcConstant in Flags then
  25386. RaiseConstantExprExp(20170216152744,StartEl);
  25387. if TPasArgument(El).ArgType=nil then
  25388. // untyped parameter
  25389. SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,nil,[])
  25390. else
  25391. begin
  25392. // typed parameter -> use param as IdentEl, compute type
  25393. ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
  25394. ResolvedEl.IdentEl:=El;
  25395. end;
  25396. ResolvedEl.Flags:=[rrfReadable];
  25397. if TPasArgument(El).Access in [argDefault, argVar, argOut] then
  25398. Include(ResolvedEl.Flags,rrfWritable);
  25399. if IsProcedureType(ResolvedEl,true) then
  25400. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25401. end
  25402. else if ElClass=TPasClassType then
  25403. begin
  25404. if TPasClassType(El).IsForward and (El.CustomData<>nil) then
  25405. begin
  25406. DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
  25407. TypeEl:=NoNil(DeclEl) as TPasClassType;
  25408. end
  25409. else
  25410. TypeEl:=TPasClassType(El);
  25411. SetResolverIdentifier(ResolvedEl,btContext,
  25412. TypeEl,TypeEl,TypeEl,[]);
  25413. end
  25414. else if ElClass=TPasClassOfType then
  25415. SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),TPasClassOfType(El),[])
  25416. else if ElClass=TPasPointerType then
  25417. SetResolverIdentifier(ResolvedEl,btContext,El,TPasPointerType(El),TPasPointerType(El),[])
  25418. else if ElClass=TPasRecordType then
  25419. SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),TPasRecordType(El),[])
  25420. else if ElClass=TPasRangeType then
  25421. begin
  25422. ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
  25423. ResolvedEl.IdentEl:=El;
  25424. ResolvedEl.LoTypeEl:=TPasRangeType(El);
  25425. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  25426. if ResolvedEl.ExprEl=nil then
  25427. ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
  25428. ResolvedEl.Flags:=[];
  25429. end
  25430. else if ElClass=TPasSetType then
  25431. begin
  25432. ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
  25433. if ResolvedEl.BaseType=btRange then
  25434. begin
  25435. ConvertRangeToElement(ResolvedEl);
  25436. ResolvedEl.LoTypeEl:=TPasSetType(El).EnumType;
  25437. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  25438. end;
  25439. ResolvedEl.SubType:=ResolvedEl.BaseType;
  25440. ResolvedEl.BaseType:=btSet;
  25441. ResolvedEl.IdentEl:=El;
  25442. ResolvedEl.Flags:=[];
  25443. end
  25444. else if ElClass=TPasResultElement then
  25445. begin
  25446. if rcConstant in Flags then
  25447. RaiseConstantExprExp(20170216152746,StartEl);
  25448. ComputeElement(TPasResultElement(El).ResultType,ResolvedEl,Flags+[rcType],StartEl);
  25449. ResolvedEl.IdentEl:=El;
  25450. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  25451. end
  25452. else if ElClass=TPasUsesUnit then
  25453. begin
  25454. if TPasUsesUnit(El).Module is TPasModule then
  25455. SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,nil,[])
  25456. else
  25457. RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
  25458. end
  25459. else if El.InheritsFrom(TPasModule) then
  25460. SetResolverIdentifier(ResolvedEl,btModule,El,nil,nil,[])
  25461. else if ElClass=TNilExpr then
  25462. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  25463. TNilExpr(El),[rrfReadable])
  25464. else if El.InheritsFrom(TPasProcedure) then
  25465. begin
  25466. TypeEl:=TPasProcedure(El).ProcType;
  25467. SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
  25468. if (TPasProcedure(El).ProcType is TPasFunctionType)
  25469. or (ElClass=TPasConstructor) then
  25470. Include(ResolvedEl.Flags,rrfReadable);
  25471. // Note: implicit calls are handled in TPrimitiveExpr
  25472. end
  25473. else if El.InheritsFrom(TPasProcedureType) then
  25474. begin
  25475. SetResolverIdentifier(ResolvedEl,btContext,El,
  25476. TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
  25477. // Note: implicit calls are handled in TPrimitiveExpr
  25478. end
  25479. else if ElClass=TProcedureExpr then
  25480. begin
  25481. TypeEl:=TProcedureExpr(El).Proc.ProcType;
  25482. SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
  25483. end
  25484. else if ElClass=TPasArrayType then
  25485. SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
  25486. else if ElClass=TArrayValues then
  25487. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable])
  25488. else if ElClass=TRecordValues then
  25489. ComputeRecordValues(TRecordValues(El),ResolvedEl,Flags,StartEl)
  25490. else if ElClass=TPasStringType then
  25491. begin
  25492. {$ifdef FPC_HAS_CPSTRING}
  25493. SetResolverTypeExpr(ResolvedEl,btShortString,
  25494. BaseTypes[btShortString],BaseTypes[btShortString],[rrfReadable]);
  25495. if BaseTypes[btShortString]=nil then
  25496. {$endif}
  25497. RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
  25498. end
  25499. else if ElClass=TPasResString then
  25500. SetResolverIdentifier(ResolvedEl,btString,El,
  25501. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
  25502. else if ElClass=TPasGenericTemplateType then
  25503. SetResolverIdentifier(ResolvedEl,btContext,El,TPasGenericTemplateType(El),
  25504. TPasGenericTemplateType(El),[])
  25505. else if ElClass=TPasSpecializeType then
  25506. ComputeSpecializeType(TPasSpecializeType(El))
  25507. else if ElClass=TInlineSpecializeExpr then
  25508. ComputeElement(TInlineSpecializeExpr(El).NameExpr,ResolvedEl,Flags,StartEl)
  25509. else
  25510. RaiseNotYetImplemented(20160922163705,El);
  25511. {$IF defined(nodejs) and defined(VerbosePasResolver)}
  25512. if not isNumber(ResolvedEl.BaseType) then
  25513. begin
  25514. {AllowWriteln}
  25515. writeln('TPasResolver.ComputeElement ',GetObjName(El),' typeof ResolvedEl.BaseType=',jsTypeOf(ResolvedEl.BaseType),' ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  25516. RaiseInternalError(20181101123527,jsTypeOf(ResolvedEl.LoTypeEl));
  25517. {AllowWriteln-}
  25518. end;
  25519. {$ENDIF}
  25520. end;
  25521. function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
  25522. Store: boolean): TResEvalValue;
  25523. // Important: Caller must free result with ReleaseEvalValue(Result)
  25524. begin
  25525. Result:=fExprEvaluator.Eval(Expr,Flags);
  25526. if Result=nil then exit;
  25527. {$IFDEF VerbosePasResEval}
  25528. writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  25529. {$ENDIF}
  25530. if Store
  25531. and (Expr.CustomData=nil)
  25532. and (Result.Element=nil)
  25533. and (not fExprEvaluator.IsSimpleExpr(Expr))
  25534. and (Expr.GetModule=RootElement) then
  25535. begin
  25536. //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  25537. AddResolveData(Expr,Result,lkModule);
  25538. end;
  25539. end;
  25540. function TPasResolver.Eval(const Value: TPasResolverResult;
  25541. Flags: TResEvalFlags; Store: boolean): TResEvalValue;
  25542. var
  25543. Expr: TPasExpr;
  25544. begin
  25545. Result:=nil;
  25546. if Value.ExprEl<>nil then
  25547. Result:=Eval(Value.ExprEl,Flags,Store)
  25548. else if Value.IdentEl is TPasConst then
  25549. begin
  25550. Expr:=TPasVariable(Value.IdentEl).Expr;
  25551. if Expr=nil then exit;
  25552. Result:=Eval(Expr,Flags,Store)
  25553. end;
  25554. end;
  25555. function TPasResolver.IsSameType(TypeA, TypeB: TPasType;
  25556. ResolveAlias: TPRResolveAlias): boolean;
  25557. begin
  25558. if (TypeA=nil) or (TypeB=nil) then exit(false);
  25559. case ResolveAlias of
  25560. prraSimple:
  25561. begin
  25562. TypeA:=ResolveSimpleAliasType(TypeA);
  25563. TypeB:=ResolveSimpleAliasType(TypeB);
  25564. end;
  25565. prraAlias:
  25566. begin
  25567. TypeA:=ResolveAliasType(TypeA);
  25568. TypeB:=ResolveAliasType(TypeB);
  25569. end;
  25570. end;
  25571. if TypeA=TypeB then exit(true);
  25572. if (TypeA.ClassType=TPasUnresolvedSymbolRef)
  25573. and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
  25574. begin
  25575. Result:=CompareText(TypeA.Name,TypeB.Name)=0;
  25576. exit;
  25577. end;
  25578. Result:=false;
  25579. end;
  25580. function TPasResolver.HasExactType(const ResolvedEl: TPasResolverResult
  25581. ): boolean;
  25582. var
  25583. IdentEl: TPasElement;
  25584. Expr: TPasExpr;
  25585. begin
  25586. IdentEl:=ResolvedEl.IdentEl;
  25587. if IdentEl<>nil then
  25588. begin
  25589. if IdentEl is TPasVariable then
  25590. exit(TPasVariable(IdentEl).VarType<>nil)
  25591. else if IdentEl.ClassType=TPasArgument then
  25592. exit(TPasArgument(IdentEl).ArgType<>nil)
  25593. else if IdentEl.ClassType=TPasResultElement then
  25594. exit(TPasResultElement(IdentEl).ResultType<>nil)
  25595. else if IdentEl is TPasType then
  25596. exit(true)
  25597. else
  25598. exit(false);
  25599. end;
  25600. Expr:=ResolvedEl.ExprEl;
  25601. if Expr<>nil then
  25602. begin
  25603. if Expr.Kind in [pekNumber,pekString,pekNil,pekBoolConst] then
  25604. exit(true)
  25605. else
  25606. exit(false);
  25607. end;
  25608. Result:=false;
  25609. end;
  25610. function TPasResolver.IndexOfGenericParam(Params: TPasExprArray): integer;
  25611. var
  25612. i: Integer;
  25613. ParamResolved: TPasResolverResult;
  25614. begin
  25615. for i:=0 to length(Params)-1 do
  25616. begin
  25617. ComputeElement(Params[i],ParamResolved,[]);
  25618. if ParamResolved.LoTypeEl is TPasGenericTemplateType then
  25619. exit(i);
  25620. end;
  25621. Result:=-1;
  25622. end;
  25623. procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  25624. ErrorEl: TPasElement);
  25625. begin
  25626. if aType=nil then exit;
  25627. if aType is TPasGenericType then
  25628. begin
  25629. if aType.ClassType=TPasClassType then
  25630. begin
  25631. if TPasClassType(aType).HelperForType<>nil then
  25632. RaiseHelpersCannotBeUsedAsType(id,ErrorEl);
  25633. end;
  25634. if (TPasGenericType(aType).GenericTemplateTypes<>nil)
  25635. and (TPasGenericType(aType).GenericTemplateTypes.Count>0) then
  25636. RaiseMsg(id,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,
  25637. [ErrorEl.ElementTypeName],ErrorEl);
  25638. end;
  25639. end;
  25640. function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
  25641. SkipAlias: boolean): TPasType;
  25642. var
  25643. DeclEl: TPasElement;
  25644. ClassScope: TPasClassScope;
  25645. begin
  25646. Result:=nil;
  25647. if ClassEl=nil then
  25648. exit;
  25649. if ClassEl.CustomData=nil then
  25650. exit;
  25651. if ClassEl.IsForward then
  25652. begin
  25653. DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
  25654. ClassEl:=NoNil(DeclEl) as TPasClassType;
  25655. Result:=ClassEl;
  25656. end
  25657. else
  25658. begin
  25659. ClassScope:=ClassEl.CustomData as TPasClassScope;
  25660. if not (pcsfAncestorResolved in ClassScope.Flags) then
  25661. exit;
  25662. if SkipAlias then
  25663. begin
  25664. if ClassScope.AncestorScope=nil then
  25665. exit;
  25666. Result:=TPasClassType(ClassScope.AncestorScope.Element);
  25667. end
  25668. else
  25669. Result:=ClassScope.DirectAncestor;
  25670. end;
  25671. end;
  25672. function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
  25673. begin
  25674. while El<>nil do
  25675. begin
  25676. if El is TProcedureBody then
  25677. exit(TProcedureBody(El));
  25678. El:=El.Parent;
  25679. end;
  25680. Result:=nil;
  25681. end;
  25682. function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
  25683. begin
  25684. Result:=GetProcFirstImplEl(Proc)<>nil;
  25685. end;
  25686. function TPasResolver.IndexOfImplementedInterface(ClassEl: TPasClassType;
  25687. aType: TPasType): integer;
  25688. var
  25689. List: TFPList;
  25690. i: Integer;
  25691. begin
  25692. if aType=nil then exit(-1);
  25693. aType:=ResolveAliasType(aType);
  25694. List:=ClassEl.Interfaces;
  25695. for i:=0 to List.Count-1 do
  25696. if ResolveAliasType(TPasType(List[i]))=aType then
  25697. exit(i);
  25698. Result:=-1;
  25699. end;
  25700. function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
  25701. begin
  25702. while El<>nil do
  25703. begin
  25704. if (El.ClassType=TPasImplRepeatUntil)
  25705. or (El.ClassType=TPasImplWhileDo)
  25706. or (El.ClassType=TPasImplForLoop) then
  25707. exit(TPasImplElement(El));
  25708. El:=El.Parent;
  25709. end;
  25710. Result:=nil;
  25711. end;
  25712. function TPasResolver.ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean
  25713. ): TPasType;
  25714. var
  25715. C: TClass;
  25716. begin
  25717. while aType<>nil do
  25718. begin
  25719. C:=aType.ClassType;
  25720. if C=TPasAliasType then
  25721. aType:=TPasAliasType(aType).DestType
  25722. else if (C=TPasTypeAliasType) and SkipTypeAlias then
  25723. aType:=TPasAliasType(aType).DestType
  25724. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  25725. and (aType.CustomData is TResolvedReference) then
  25726. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  25727. else if C=TPasSpecializeType then
  25728. begin
  25729. if aType.CustomData is TPasSpecializeTypeData then
  25730. exit(TPasSpecializeTypeData(aType.CustomData).SpecializedType);
  25731. aType:=TPasSpecializeType(aType).DestType;
  25732. end
  25733. else
  25734. exit(aType);
  25735. end;
  25736. Result:=nil;
  25737. end;
  25738. function TPasResolver.ResolveAliasTypeEl(El: TPasElement): TPasType;
  25739. begin
  25740. if (El is TPasType) then
  25741. Result:=ResolveAliasType(TPasType(El))
  25742. else
  25743. Result:=nil;
  25744. end;
  25745. function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
  25746. { returns true if El is
  25747. a) the last element of an @ operator expression
  25748. e.g. '@p().o[].El' or '@El[]'
  25749. b) mode delphi: the last element of a right side of an assignment
  25750. c) an accessor function, e.g. property P read El;
  25751. }
  25752. var
  25753. Parent: TPasElement;
  25754. Prop: TPasProperty;
  25755. begin
  25756. Result:=false;
  25757. if El=nil then exit;
  25758. if not IsNameExpr(El) then
  25759. exit;
  25760. repeat
  25761. Parent:=El.Parent;
  25762. //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
  25763. if Parent.ClassType=TUnaryExpr then
  25764. begin
  25765. if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
  25766. end
  25767. else if Parent.ClassType=TBinaryExpr then
  25768. begin
  25769. if TBinaryExpr(Parent).right<>El then exit;
  25770. if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
  25771. end
  25772. else if Parent.ClassType=TParamsExpr then
  25773. begin
  25774. if TParamsExpr(Parent).Value<>El then exit;
  25775. end
  25776. else if Parent.ClassType=TPasProperty then
  25777. begin
  25778. Prop:=TPasProperty(Parent);
  25779. Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
  25780. exit;
  25781. end
  25782. else if Parent.ClassType=TPasImplAssign then
  25783. begin
  25784. if TPasImplAssign(Parent).right<>El then exit;
  25785. if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
  25786. exit;
  25787. end
  25788. else
  25789. exit;
  25790. El:=TPasExpr(Parent);
  25791. until false;
  25792. end;
  25793. function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
  25794. var
  25795. C: TClass;
  25796. P: TPasElement;
  25797. begin
  25798. if (El=nil) or (El.Parent=nil) then exit(false);
  25799. Result:=false;
  25800. P:=El.Parent;
  25801. C:=P.ClassType;
  25802. if C=TBinaryExpr then
  25803. begin
  25804. if TBinaryExpr(P).right=El then
  25805. begin
  25806. if (TBinaryExpr(P).OpCode=eopSubIdent)
  25807. or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
  25808. Result:=ParentNeedsExprResult(TBinaryExpr(P))
  25809. else
  25810. Result:=true;
  25811. end
  25812. else
  25813. Result:=true;
  25814. end
  25815. else if C.InheritsFrom(TPasExpr) then
  25816. Result:=true
  25817. else if (C=TPasEnumValue)
  25818. or (C=TPasArgument)
  25819. or (C=TPasVariable)
  25820. or (C=TPasExportSymbol) then
  25821. Result:=true
  25822. else if C=TPasClassType then
  25823. Result:=TPasClassType(P).GUIDExpr=El
  25824. else if C=TPasProperty then
  25825. Result:=(TPasProperty(P).IndexExpr=El)
  25826. or (TPasProperty(P).DispIDExpr=El)
  25827. or (TPasProperty(P).DefaultExpr=El)
  25828. else if C=TPasProcedure then
  25829. Result:=(TPasProcedure(P).LibraryExpr=El)
  25830. or (TPasProcedure(P).DispIDExpr=El)
  25831. else if C=TPasImplRepeatUntil then
  25832. Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
  25833. else if C=TPasImplIfElse then
  25834. Result:=(TPasImplIfElse(P).ConditionExpr=El)
  25835. else if C=TPasImplWhileDo then
  25836. Result:=(TPasImplWhileDo(P).ConditionExpr=El)
  25837. else if C=TPasImplWithDo then
  25838. Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
  25839. else if C=TPasImplCaseOf then
  25840. Result:=(TPasImplCaseOf(P).CaseExpr=El)
  25841. else if C=TPasImplCaseStatement then
  25842. Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
  25843. else if C=TPasImplForLoop then
  25844. Result:=(TPasImplForLoop(P).StartExpr=El)
  25845. or (TPasImplForLoop(P).EndExpr=El)
  25846. else if C=TPasImplAssign then
  25847. Result:=(TPasImplAssign(P).right=El)
  25848. else if C=TPasImplRaise then
  25849. Result:=(TPasImplRaise(P).ExceptAddr=El);
  25850. end;
  25851. function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference;
  25852. Expr: TPasExpr): TPasResolverResult;
  25853. var
  25854. TypeEl: TPasType;
  25855. begin
  25856. TypeEl:=(Ref.Context as TResolvedRefCtxConstructor).Typ;
  25857. if TypeEl=nil then
  25858. RaiseNotYetImplemented(20190125205339,Expr)
  25859. else if TypeEl is TPasMembersType then
  25860. SetResolverValueExpr(Result,btContext,TypeEl,TypeEl,Expr,[rrfReadable])
  25861. else
  25862. begin
  25863. ComputeElement(TypeEl,Result,[rcType]);
  25864. Result.ExprEl:=Expr;
  25865. Result.Flags:=[rrfReadable];
  25866. end;
  25867. end;
  25868. function TPasResolver.GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  25869. var
  25870. El: TPasExpr;
  25871. begin
  25872. Result:=nil;
  25873. if Params=nil then exit;
  25874. El:=Params.Value;
  25875. while El<>nil do
  25876. begin
  25877. if El.CustomData is TResolvedReference then
  25878. exit(TResolvedReference(El.CustomData));
  25879. if El.ClassType=TInlineSpecializeExpr then
  25880. El:=TInlineSpecializeExpr(El).NameExpr
  25881. else if (El.ClassType=TBinaryExpr)
  25882. and (TBinaryExpr(El).OpCode=eopSubIdent) then
  25883. El:=TBinaryExpr(El).right
  25884. else
  25885. exit;
  25886. end;
  25887. end;
  25888. function TPasResolver.GetSetType(const ResolvedSet: TPasResolverResult
  25889. ): TPasSetType;
  25890. var
  25891. IdentEl: TPasElement;
  25892. aType: TPasType;
  25893. C: TClass;
  25894. begin
  25895. Result:=nil;
  25896. if ResolvedSet.BaseType=btSet then
  25897. begin
  25898. IdentEl:=ResolvedSet.IdentEl;
  25899. if IdentEl=nil then exit;
  25900. C:=IdentEl.ClassType;
  25901. if (C=TPasVariable)
  25902. or (C=TPasConst) then
  25903. aType:=TPasVariable(IdentEl).VarType
  25904. else if C=TPasProperty then
  25905. aType:=GetPasPropertyType(TPasProperty(IdentEl))
  25906. else if C=TPasArgument then
  25907. aType:=TPasArgument(IdentEl).ArgType
  25908. else if C.InheritsFrom(TPasProcedure)
  25909. and (TPasProcedure(IdentEl).ProcType is TPasFunctionType) then
  25910. aType:=TPasFunctionType(TPasProcedure(IdentEl).ProcType).ResultEl.ResultType
  25911. else if C=TPasSetType then
  25912. exit(TPasSetType(IdentEl))
  25913. else
  25914. exit;
  25915. if aType.ClassType=TPasSetType then
  25916. Result:=TPasSetType(aType);
  25917. end
  25918. else if ResolvedSet.BaseType=btContext then
  25919. begin
  25920. if ResolvedSet.LoTypeEl.ClassType=TPasSetType then
  25921. if ResolvedSet.HiTypeEl.ClassType=TPasSetType then
  25922. Result:=TPasSetType(ResolvedSet.HiTypeEl)
  25923. else
  25924. Result:=TPasSetType(ResolvedSet.LoTypeEl);
  25925. end;
  25926. end;
  25927. function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
  25928. ): boolean;
  25929. begin
  25930. TypeEl:=ResolveAliasType(TypeEl);
  25931. if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType) then
  25932. exit(false);
  25933. if length(TPasArrayType(TypeEl).Ranges)<>0 then
  25934. exit(false);
  25935. // Note: Array of Const is an open array of TVarRec
  25936. if OptionalOpenArray and (proOpenAsDynArrays in Options) then
  25937. Result:=true
  25938. else
  25939. Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
  25940. end;
  25941. function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
  25942. begin
  25943. Result:=(TypeEl<>nil)
  25944. and (TypeEl.ClassType=TPasArrayType)
  25945. and (length(TPasArrayType(TypeEl).Ranges)=0)
  25946. and (TypeEl.Parent<>nil)
  25947. and (TypeEl.Parent.ClassType=TPasArgument);
  25948. end;
  25949. function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
  25950. begin
  25951. TypeEl:=ResolveAliasType(TypeEl);
  25952. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  25953. and (length(TPasArrayType(TypeEl).Ranges)=0);
  25954. end;
  25955. function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
  25956. begin
  25957. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  25958. and (TPasArrayType(TypeEl).ElType=nil);
  25959. end;
  25960. function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
  25961. begin
  25962. Result:=ArrType.ElType;
  25963. if Result=nil then
  25964. Result:=GetTVarRec(ArrType);
  25965. end;
  25966. function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
  25967. var
  25968. C: TClass;
  25969. begin
  25970. Result:=false;
  25971. if Expr=nil then exit;
  25972. if Expr.Parent=nil then exit;
  25973. C:=Expr.Parent.ClassType;
  25974. if C.InheritsFrom(TPasVariable) then
  25975. Result:=(TPasVariable(Expr.Parent).Expr=Expr)
  25976. else if C=TPasArgument then
  25977. Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
  25978. end;
  25979. function TPasResolver.IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  25980. begin
  25981. Result:=(ResolvedEl.BaseType in [btSet,btArrayOrSet,btArrayLit])
  25982. and (ResolvedEl.SubType=btNone);
  25983. end;
  25984. function TPasResolver.IsClassMethod(El: TPasElement): boolean;
  25985. var
  25986. C: TClass;
  25987. begin
  25988. if El=nil then exit(false);
  25989. C:=El.ClassType;;
  25990. Result:=(C=TPasClassConstructor)
  25991. or (C=TPasClassDestructor)
  25992. or (C=TPasClassProcedure)
  25993. or (C=TPasClassFunction)
  25994. or (C=TPasClassOperator);
  25995. end;
  25996. function TPasResolver.IsClassField(El: TPasElement): boolean;
  25997. var
  25998. C: TClass;
  25999. begin
  26000. if ((El.ClassType=TPasVariable) or (El.ClassType=TPasConst))
  26001. and ([vmClass,vmStatic]*TPasVariable(El).VarModifiers<>[]) then
  26002. begin
  26003. C:=El.Parent.ClassType;
  26004. Result:=(C=TPasClassType) or (C=TPasRecordType);
  26005. end
  26006. else
  26007. Result:=false;
  26008. end;
  26009. function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
  26010. var
  26011. ProcType: TPasProcedureType;
  26012. begin
  26013. if not (El is TPasProcedure) then exit(nil);
  26014. ProcType:=TPasProcedure(El).ProcType;
  26015. if ProcType is TPasFunctionType then
  26016. Result:=TPasFunctionType(ProcType)
  26017. else
  26018. Result:=nil;
  26019. end;
  26020. function TPasResolver.MethodIsStatic(El: TPasProcedure): boolean;
  26021. begin
  26022. Result:=(ptmStatic in El.ProcType.Modifiers)
  26023. or (El.ClassType=TPasClassConstructor)
  26024. or (El.ClassType=TPasClassDestructor);
  26025. end;
  26026. function TPasResolver.IsMethod(El: TPasProcedure): boolean;
  26027. var
  26028. ProcScope: TPasProcedureScope;
  26029. begin
  26030. Result:=false;
  26031. if El=nil then exit;
  26032. if El.Parent is TPasMembersType then exit(true);
  26033. if not (El.CustomData is TPasProcedureScope) then exit;
  26034. ProcScope:=TPasProcedureScope(El.CustomData);
  26035. Result:=IsMethod(ProcScope.DeclarationProc);
  26036. end;
  26037. function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
  26038. begin
  26039. Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
  26040. and (TPasClassType(El.Parent).HelperForType<>nil);
  26041. end;
  26042. function TPasResolver.IsHelper(El: TPasElement): boolean;
  26043. begin
  26044. Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil);
  26045. end;
  26046. function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
  26047. const ExtName: string): boolean;
  26048. var
  26049. AncestorScope: TPasClassScope;
  26050. begin
  26051. Result:=false;
  26052. if aClass=nil then exit;
  26053. while (aClass<>nil) and aClass.IsExternal do
  26054. begin
  26055. if aClass.ExternalName=ExtName then exit(true);
  26056. AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
  26057. if AncestorScope=nil then exit;
  26058. aClass:=NoNil(AncestorScope.Element) as TPasClassType;
  26059. end;
  26060. end;
  26061. function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
  26062. HasValue: boolean): boolean;
  26063. var
  26064. TypeEl: TPasType;
  26065. begin
  26066. if (ResolvedEl.BaseType<>btContext) then
  26067. exit(false);
  26068. TypeEl:=ResolvedEl.LoTypeEl;
  26069. if not (TypeEl is TPasProcedureType) then
  26070. exit(false);
  26071. if HasValue and not (rrfReadable in ResolvedEl.Flags) then
  26072. exit(false);
  26073. Result:=true;
  26074. end;
  26075. function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
  26076. ): boolean;
  26077. begin
  26078. Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasArrayType);
  26079. end;
  26080. function TPasResolver.IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  26081. var
  26082. Ref: TResolvedReference;
  26083. begin
  26084. Result:=nil;
  26085. if Expr=nil then exit;
  26086. if Expr.Kind<>pekSet then exit;
  26087. if not (Expr.CustomData is TResolvedReference) then exit;
  26088. Ref:=TResolvedReference(Expr.CustomData);
  26089. if Ref.Declaration is TPasArrayType then
  26090. Result:=TPasArrayType(Ref.Declaration);
  26091. end;
  26092. function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  26093. begin
  26094. Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
  26095. and ElHasModeSwitch(Expr,msArrayOperators);
  26096. end;
  26097. function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
  26098. var
  26099. Value: TPasExpr;
  26100. Ref: TResolvedReference;
  26101. Decl: TPasElement;
  26102. C: TClass;
  26103. begin
  26104. Result:=false;
  26105. if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
  26106. Value:=Params.Value;
  26107. if not IsNameExpr(Value) then
  26108. exit;
  26109. if not (Value.CustomData is TResolvedReference) then exit;
  26110. Ref:=TResolvedReference(Value.CustomData);
  26111. Decl:=Ref.Declaration;
  26112. C:=Decl.ClassType;
  26113. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  26114. begin
  26115. Decl:=ResolveAliasType(TPasAliasType(Decl));
  26116. C:=Decl.ClassType;
  26117. end;
  26118. if (C=TPasProcedureType)
  26119. or (C=TPasFunctionType) then
  26120. exit(true)
  26121. else if (C=TPasClassType)
  26122. or (C=TPasClassOfType)
  26123. or (C=TPasEnumType)
  26124. or (C=TPasRecordType)
  26125. or (C=TPasArrayType)
  26126. or (C=TPasSpecializeType)
  26127. or (C=TPasGenericTemplateType) then
  26128. exit(true)
  26129. else if (C=TPasUnresolvedSymbolRef)
  26130. and (Decl.CustomData is TResElDataBaseType) then
  26131. exit(true);
  26132. end;
  26133. function TPasResolver.GetTypeParameterCount(aType: TPasGenericType): integer;
  26134. begin
  26135. if aType=nil then exit(0);
  26136. if aType.GenericTemplateTypes=nil then exit(0);
  26137. Result:=aType.GenericTemplateTypes.Count;
  26138. end;
  26139. function TPasResolver.GetGenericConstraintKeyword(El: TPasElement): TToken;
  26140. var
  26141. Prim: TPrimitiveExpr;
  26142. begin
  26143. if (El=nil) or (El.ClassType<>TPrimitiveExpr) then
  26144. exit(tkEOF);
  26145. Prim:=TPrimitiveExpr(El);
  26146. if Prim.Kind<>pekIdent then
  26147. exit(tkEOF);
  26148. case lowercase(Prim.Value) of
  26149. 'record': Result:=tkrecord;
  26150. 'class': Result:=tkclass;
  26151. 'constructor': Result:=tkconstructor;
  26152. else Result:=tkEOF;
  26153. end;
  26154. end;
  26155. function TPasResolver.GetGenericConstraintErrorEl(ConstraintEl,
  26156. TemplType: TPasElement): TPasElement;
  26157. begin
  26158. if (ConstraintEl is TPasExpr) or (ConstraintEl.Parent=TemplType) then
  26159. Result:=ConstraintEl
  26160. else
  26161. Result:=TemplType;
  26162. end;
  26163. function TPasResolver.IsFullySpecialized(El: TPasGenericType): boolean;
  26164. var
  26165. GenScope: TPasGenericScope;
  26166. Params: TPasTypeArray;
  26167. i: Integer;
  26168. begin
  26169. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  26170. exit(false);
  26171. if not (El.CustomData is TPasGenericScope) then exit(true);
  26172. GenScope:=TPasGenericScope(El.CustomData);
  26173. if GenScope.SpecializedFromItem=nil then exit(true);
  26174. Params:=GenScope.SpecializedFromItem.Params;
  26175. for i:=0 to length(Params)-1 do
  26176. if Params[i] is TPasGenericTemplateType then exit(false);
  26177. Result:=true;
  26178. end;
  26179. function TPasResolver.IsInterfaceType(const ResolvedEl: TPasResolverResult;
  26180. IntfType: TPasClassInterfaceType): boolean;
  26181. begin
  26182. if ResolvedEl.BaseType<>btContext then exit(false);
  26183. Result:=IsInterfaceType(ResolvedEl.LoTypeEl,IntfType);
  26184. end;
  26185. function TPasResolver.IsInterfaceType(TypeEl: TPasType;
  26186. IntfType: TPasClassInterfaceType): boolean;
  26187. begin
  26188. if TypeEl=nil then exit(false);
  26189. TypeEl:=ResolveAliasType(TypeEl);
  26190. Result:=(TypeEl.ClassType=TPasClassType)
  26191. and (TPasClassType(TypeEl).ObjKind=okInterface)
  26192. and (TPasClassType(TypeEl).InterfaceType=IntfType);
  26193. end;
  26194. function TPasResolver.IsTGUID(RecTypeEl: TPasRecordType): boolean;
  26195. var
  26196. Members: TFPList;
  26197. El: TPasElement;
  26198. begin
  26199. Result:=false;
  26200. if not SameText(RecTypeEl.Name,'TGUID') then exit;
  26201. if SameText(RecTypeEl.GetModule.Name,'system') then exit(true);
  26202. Members:=RecTypeEl.Members;
  26203. if Members.Count<4 then exit;
  26204. El:=TPasElement(Members[0]);
  26205. if not SameText(El.Name,'D1') then exit;
  26206. El:=TPasElement(Members[1]);
  26207. if not SameText(El.Name,'D2') then exit;
  26208. El:=TPasElement(Members[2]);
  26209. if not SameText(El.Name,'D3') then exit;
  26210. El:=TPasElement(Members[3]);
  26211. if not SameText(El.Name,'D4') then exit;
  26212. Result:=true;
  26213. end;
  26214. function TPasResolver.IsTGUIDString(const ResolvedEl: TPasResolverResult
  26215. ): boolean;
  26216. var
  26217. TypeEl: TPasType;
  26218. C: TClass;
  26219. IdentEl: TPasElement;
  26220. begin
  26221. if not (ResolvedEl.BaseType in btAllStrings) then
  26222. exit(false);
  26223. if (ResolvedEl.ExprEl<>nil) and (ResolvedEl.LoTypeEl<>nil) then
  26224. exit(true); // untyped string literal
  26225. IdentEl:=ResolvedEl.IdentEl;
  26226. if IdentEl<>nil then
  26227. begin
  26228. C:=IdentEl.ClassType;
  26229. if C.InheritsFrom(TPasVariable) then
  26230. TypeEl:=TPasVariable(IdentEl).VarType
  26231. else if C=TPasArgument then
  26232. TypeEl:=TPasArgument(IdentEl).ArgType
  26233. else if C=TPasResultElement then
  26234. TypeEl:=TPasResultElement(IdentEl).ResultType
  26235. else
  26236. TypeEl:=nil;
  26237. while TypeEl<>nil do
  26238. begin
  26239. if (TypeEl.ClassType=TPasAliasType)
  26240. or (TypeEl.ClassType=TPasTypeAliasType) then
  26241. begin
  26242. if SameText(TypeEl.Name,'TGUIDString') then
  26243. exit(true);
  26244. TypeEl:=TPasAliasType(TypeEl).DestType;
  26245. end
  26246. else
  26247. break;
  26248. end;
  26249. end;
  26250. Result:=false;
  26251. end;
  26252. function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
  26253. var
  26254. ClassEl: TPasClassType;
  26255. ClassScope: TPasClassScope;
  26256. aModule: TPasModule;
  26257. begin
  26258. Result:=false;
  26259. if (El=nil)
  26260. or (El.ClassType<>TPasClassType) then exit;
  26261. ClassEl:=TPasClassType(El);
  26262. if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
  26263. while not SameText(ClassEl.Name,'TCustomAttribute') do
  26264. begin
  26265. ClassScope:=ClassEl.CustomData as TPasClassScope;
  26266. if ClassScope.AncestorScope=nil then exit;
  26267. ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
  26268. end;
  26269. if not (ClassEl.Parent is TPasSection) then
  26270. exit; // this TCustomAttribute is not top level
  26271. aModule:=ClassEl.GetModule;
  26272. Result:=IsSystemUnit(aModule);
  26273. end;
  26274. function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
  26275. var
  26276. Section: TPasSection;
  26277. begin
  26278. Result:=false;
  26279. if El=nil then exit;
  26280. if SameText(El.Name,'system') then exit(true);
  26281. // tests and scripts are their own system unit: check if this is the root module
  26282. if El.ClassType=TPasProgram then
  26283. Section:=TPasProgram(El).ProgramSection
  26284. else if El.ClassType=TPasLibrary then
  26285. Section:=TPasLibrary(El).LibrarySection
  26286. else
  26287. Section:=El.InterfaceSection;
  26288. Result:=length(Section.UsesClause)=0;
  26289. end;
  26290. function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
  26291. var
  26292. Parent: TPasElement;
  26293. C: TClass;
  26294. Members: TFPList;
  26295. i: Integer;
  26296. begin
  26297. Result:=nil;
  26298. if El=nil then exit;
  26299. // find El in El.Parent members
  26300. Parent:=El.Parent;
  26301. if Parent=nil then exit;
  26302. C:=Parent.ClassType;
  26303. if C.InheritsFrom(TPasDeclarations) then
  26304. Members:=TPasDeclarations(Parent).Declarations
  26305. else if C.InheritsFrom(TPasMembersType) then
  26306. Members:=TPasMembersType(Parent).Members
  26307. else
  26308. exit;
  26309. i:=Members.IndexOf(El);
  26310. if i<0 then exit;
  26311. Result:=GetAttributeCalls(Members,i);
  26312. end;
  26313. function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
  26314. ): TPasExprArray;
  26315. procedure AddAttributesInFront(Members: TFPList; i: integer);
  26316. var
  26317. j, l, k: Integer;
  26318. Calls: TPasExprArray;
  26319. begin
  26320. // find attributes in front
  26321. j:=i;
  26322. while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
  26323. dec(j);
  26324. // collect all attribute calls
  26325. l:=0;
  26326. while j<i do
  26327. begin
  26328. Calls:=TPasAttributes(Members[j]).Calls;
  26329. SetLength(Result,l+length(Calls));
  26330. for k:=0 to length(Calls)-1 do
  26331. begin
  26332. Result[l]:=Calls[k];
  26333. inc(l);
  26334. end;
  26335. inc(j);
  26336. end;
  26337. end;
  26338. var
  26339. El, CurEl: TPasElement;
  26340. begin
  26341. Result:=nil;
  26342. El:=TPasElement(Members[Index]);
  26343. AddAttributesInFront(Members,Index);
  26344. if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
  26345. repeat
  26346. dec(Index);
  26347. if Index<1 then break;
  26348. CurEl:=TPasElement(Members[Index]);
  26349. if (CurEl.ClassType=TPasClassType)
  26350. and TPasClassType(CurEl).IsForward
  26351. and (TPasClassType(CurEl).CustomData is TResolvedReference)
  26352. and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
  26353. then
  26354. begin
  26355. // class has a forward declaration -> add attributes
  26356. AddAttributesInFront(Members,Index);
  26357. break;
  26358. end;
  26359. until false;
  26360. end;
  26361. function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
  26362. begin
  26363. Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
  26364. end;
  26365. function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
  26366. ): boolean;
  26367. var
  26368. Proc, OverriddenProc: TPasProcedure;
  26369. begin
  26370. Result:=false;
  26371. Proc:=DescendantProc;
  26372. if not Proc.IsOverride then exit;
  26373. if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
  26374. repeat
  26375. OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
  26376. if AncestorProc=OverriddenProc then exit(true);
  26377. Proc:=OverriddenProc;
  26378. until Proc=nil;
  26379. end;
  26380. function TPasResolver.GetTopLvlProc(El: TPasElement): TPasProcedure;
  26381. begin
  26382. Result:=nil;
  26383. while El<>nil do
  26384. begin
  26385. if El is TPasProcedure then
  26386. Result:=TPasProcedure(El);
  26387. El:=El.Parent;
  26388. end;
  26389. end;
  26390. function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  26391. var
  26392. Range: TResEvalValue;
  26393. begin
  26394. Result:=0;
  26395. Range:=Eval(RangeExpr,[refConst]);
  26396. if Range=nil then
  26397. RaiseNotYetImplemented(20170910210416,RangeExpr);
  26398. try
  26399. case Range.Kind of
  26400. revkRangeInt:
  26401. Result:=TResEvalRangeInt(Range).RangeEnd-TResEvalRangeInt(Range).RangeStart+1;
  26402. revkRangeUInt:
  26403. Result:=TResEvalRangeUInt(Range).RangeEnd-TResEvalRangeUInt(Range).RangeStart+1;
  26404. else
  26405. RaiseNotYetImplemented(20170910210554,RangeExpr);
  26406. end;
  26407. finally
  26408. ReleaseEvalValue(Range);
  26409. end;
  26410. {$IFDEF VerbosePasResolver}
  26411. {AllowWriteln}
  26412. //if Result=0 then
  26413. writeln('TPasResolver.GetRangeLength Result=',Result);
  26414. {AllowWriteln-}
  26415. {$ENDIF}
  26416. end;
  26417. function TPasResolver.EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  26418. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue;
  26419. var
  26420. Range: TResEvalValue;
  26421. EnumType: TPasEnumType;
  26422. begin
  26423. Result:=nil;
  26424. Range:=Eval(RangeExpr,Flags+[refConst]);
  26425. if Range=nil then
  26426. RaiseNotYetImplemented(20170601191258,RangeExpr);
  26427. case Range.Kind of
  26428. revkRangeInt:
  26429. case TResEvalRangeInt(Range).ElKind of
  26430. revskEnum:
  26431. begin
  26432. EnumType:=NoNil(TResEvalRangeInt(Range).ElType) as TPasEnumType;
  26433. if EvalLow then
  26434. Result:=TResEvalEnum.CreateValue(
  26435. TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
  26436. else
  26437. Result:=TResEvalEnum.CreateValue(
  26438. TResEvalRangeInt(Range).RangeEnd,
  26439. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  26440. end;
  26441. revskInt:
  26442. if EvalLow then
  26443. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
  26444. else
  26445. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
  26446. revskChar:
  26447. {$ifdef FPC_HAS_CPSTRING}
  26448. if TResEvalRangeInt(Range).RangeEnd<256 then
  26449. begin
  26450. if EvalLow then
  26451. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
  26452. else
  26453. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd));
  26454. end
  26455. else
  26456. {$endif}
  26457. begin
  26458. if EvalLow then
  26459. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeStart))
  26460. else
  26461. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
  26462. end;
  26463. revskBool:
  26464. if EvalLow then
  26465. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
  26466. else
  26467. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
  26468. else
  26469. ReleaseEvalValue(Range);
  26470. RaiseNotYetImplemented(20170601195240,ErrorEl);
  26471. end;
  26472. revkRangeUInt:
  26473. if EvalLow then
  26474. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
  26475. else
  26476. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
  26477. else
  26478. ReleaseEvalValue(Range);
  26479. RaiseNotYetImplemented(20170601195336,ErrorEl);
  26480. end;
  26481. ReleaseEvalValue(Range);
  26482. end;
  26483. function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags
  26484. ): TResEvalValue;
  26485. var
  26486. C: TClass;
  26487. BaseTypeData: TResElDataBaseType;
  26488. begin
  26489. Result:=nil;
  26490. Decl:=ResolveAliasType(Decl);
  26491. C:=Decl.ClassType;
  26492. if C=TPasRangeType then
  26493. begin
  26494. Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
  26495. if (Result<>nil) and (Result.IdentEl=nil) then
  26496. begin
  26497. Result.IdentEl:=Decl;
  26498. exit;
  26499. end;
  26500. end
  26501. else if C=TPasEnumType then
  26502. begin
  26503. Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
  26504. 0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
  26505. Result.IdentEl:=Decl;
  26506. exit;
  26507. end
  26508. else if C=TPasUnresolvedSymbolRef then
  26509. begin
  26510. if (Decl.CustomData is TResElDataBaseType) then
  26511. begin
  26512. BaseTypeData:=TResElDataBaseType(Decl.CustomData);
  26513. case BaseTypeData.BaseType of
  26514. btChar:
  26515. begin
  26516. Result:=TResEvalRangeInt.Create;
  26517. TResEvalRangeInt(Result).ElKind:=revskChar;
  26518. TResEvalRangeInt(Result).RangeStart:=0;
  26519. {$ifdef FPC_HAS_CPSTRING}
  26520. if BaseTypeChar in [btChar,btAnsiChar] then
  26521. TResEvalRangeInt(Result).RangeEnd:=$ff
  26522. else
  26523. {$endif}
  26524. TResEvalRangeInt(Result).RangeEnd:=$ffff;
  26525. end;
  26526. {$ifdef FPC_HAS_CPSTRING}
  26527. btAnsiChar:
  26528. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  26529. {$endif}
  26530. btWideChar:
  26531. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  26532. btBoolean,btByteBool,btWordBool{$ifdef HasInt64},btQWordBool{$endif}:
  26533. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
  26534. btByte,
  26535. btShortInt,
  26536. btWord,
  26537. btSmallInt,
  26538. btLongWord,
  26539. btLongint,
  26540. {$ifdef HasInt64}
  26541. btInt64,
  26542. btComp,
  26543. {$endif}
  26544. btIntSingle,
  26545. btUIntSingle,
  26546. btIntDouble,
  26547. btUIntDouble:
  26548. begin
  26549. Result:=TResEvalRangeInt.Create;
  26550. TResEvalRangeInt(Result).ElKind:=revskInt;
  26551. GetIntegerRange(BaseTypeData.BaseType,
  26552. TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
  26553. end;
  26554. end;
  26555. end;
  26556. end;
  26557. end;
  26558. function TPasResolver.HasTypeInfo(El: TPasType): boolean;
  26559. begin
  26560. Result:=false;
  26561. if El=nil then exit;
  26562. if El.CustomData is TResElDataBaseType then
  26563. exit(true); // base type
  26564. if El.Parent=nil then exit;
  26565. if El.Parent is TPasType then
  26566. begin
  26567. if not HasTypeInfo(TPasType(El.Parent)) then
  26568. exit;
  26569. end
  26570. else if ElHasModeSwitch(El,msOmitRTTI) then
  26571. exit
  26572. else if El.Parent is TPasAnonymousProcedure then
  26573. exit;
  26574. Result:=true;
  26575. end;
  26576. function TPasResolver.GetActualBaseType(bt: TResolverBaseType
  26577. ): TResolverBaseType;
  26578. begin
  26579. case bt of
  26580. btChar: Result:=BaseTypeChar;
  26581. btString: Result:=BaseTypeString;
  26582. btExtended: Result:=BaseTypeExtended;
  26583. else Result:=bt;
  26584. end;
  26585. end;
  26586. function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
  26587. ErrorEl: TPasElement): TResolverBaseType;
  26588. begin
  26589. if Bool1=Bool2 then exit(Bool1);
  26590. case Bool1 of
  26591. btBoolean: Result:=Bool2;
  26592. btByteBool: if Bool2<>btBoolean then Result:=Bool2;
  26593. btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
  26594. btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
  26595. {$ifdef HasInt64}
  26596. btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
  26597. {$endif}
  26598. else
  26599. RaiseNotYetImplemented(20170420093805,ErrorEl);
  26600. end;
  26601. end;
  26602. function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
  26603. ErrorEl: TPasElement): TResolverBaseType;
  26604. var
  26605. Precision1, Precision2: word;
  26606. Signed1, Signed2: boolean;
  26607. begin
  26608. if Int1.BaseType=Int2.BaseType then exit;
  26609. GetIntegerProps(Int1.BaseType,Precision1,Signed1);
  26610. GetIntegerProps(Int2.BaseType,Precision2,Signed2);
  26611. if Precision1=Precision2 then
  26612. begin
  26613. if Signed1<>Signed2 then
  26614. Precision1:=Max(Precision1,Precision2)+1;
  26615. end;
  26616. Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
  26617. end;
  26618. procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
  26619. Precision: word; out Signed: boolean);
  26620. begin
  26621. case bt of
  26622. btByte: begin Precision:=8; Signed:=false; end;
  26623. btShortInt: begin Precision:=8; Signed:=true; end;
  26624. btWord: begin Precision:=16; Signed:=false; end;
  26625. btSmallInt: begin Precision:=16; Signed:=true; end;
  26626. btIntSingle: begin Precision:=23; Signed:=true; end;
  26627. btUIntSingle: begin Precision:=22; Signed:=false; end;
  26628. btLongWord: begin Precision:=32; Signed:=false; end;
  26629. btLongint: begin Precision:=32; Signed:=true; end;
  26630. btIntDouble: begin Precision:=53; Signed:=true; end;
  26631. btUIntDouble: begin Precision:=52; Signed:=false; end;
  26632. {$ifdef HasInt64}
  26633. btQWord: begin Precision:=64; Signed:=false; end;
  26634. btInt64,btComp: begin Precision:=64; Signed:=true; end;
  26635. {$endif}
  26636. else
  26637. RaiseInternalError(20170420095727);
  26638. end;
  26639. end;
  26640. function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
  26641. MaxVal: TMaxPrecInt): boolean;
  26642. begin
  26643. Result:=true;
  26644. if bt=btExtended then bt:=BaseTypeExtended;
  26645. case bt of
  26646. btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
  26647. btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
  26648. btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
  26649. btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
  26650. btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
  26651. btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
  26652. {$ifdef HasInt64}
  26653. btInt64,
  26654. btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
  26655. {$endif}
  26656. btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
  26657. btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
  26658. btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
  26659. btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
  26660. btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
  26661. else
  26662. Result:=false;
  26663. end;
  26664. end;
  26665. function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
  26666. ErrorEl: TPasElement): TResolverBaseType;
  26667. begin
  26668. if Precision<=8 then
  26669. begin
  26670. if Signed then
  26671. Result:=btShortInt
  26672. else
  26673. Result:=btByte;
  26674. if BaseTypes[Result]<>nil then exit;
  26675. end;
  26676. if Precision<=16 then
  26677. begin
  26678. if Signed then
  26679. Result:=btSmallInt
  26680. else
  26681. Result:=btWord;
  26682. if BaseTypes[Result]<>nil then exit;
  26683. end;
  26684. if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
  26685. exit(btUIntSingle);
  26686. if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
  26687. exit(btIntSingle);
  26688. if Precision<=32 then
  26689. begin
  26690. if Signed then
  26691. Result:=btLongint
  26692. else
  26693. Result:=btLongWord;
  26694. if BaseTypes[Result]<>nil then exit;
  26695. end;
  26696. if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
  26697. exit(btUIntDouble);
  26698. if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
  26699. exit(btIntDouble);
  26700. {$ifdef HasInt64}
  26701. if Precision<=64 then
  26702. begin
  26703. if Signed then
  26704. Result:=btInt64
  26705. else
  26706. Result:=btQWord;
  26707. if BaseTypes[Result]<>nil then exit;
  26708. end;
  26709. {$endif}
  26710. RaiseRangeCheck(20170420100336,ErrorEl);
  26711. end;
  26712. function TPasResolver.GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt
  26713. ): TResolverBaseType;
  26714. // returns BaseTypeExtended if too big
  26715. var
  26716. V: TMaxPrecInt;
  26717. begin
  26718. if MinVal>MaxVal then
  26719. MinVal:=MaxVal;
  26720. if MinVal<0 then
  26721. begin
  26722. if MaxVal>-(MinVal+1) then
  26723. V:=MaxVal
  26724. else
  26725. V:=-(MinVal+1);
  26726. if V<=high(ShortInt) then
  26727. Result:=btShortInt
  26728. else if V<=high(SmallInt) then
  26729. Result:=btSmallInt
  26730. else if (BaseTypes[btIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  26731. Result:=btIntSingle
  26732. else if V<=High(Longint) then
  26733. Result:=btLongint
  26734. else if (BaseTypes[btIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  26735. Result:=btIntDouble
  26736. else
  26737. begin
  26738. Result:=btIntMax;
  26739. if BaseTypes[Result]=nil then
  26740. Result:=BaseTypeExtended;
  26741. end;
  26742. end
  26743. else
  26744. begin
  26745. V:=MaxVal;
  26746. if V<=high(Byte) then
  26747. Result:=btByte
  26748. else if V<=high(Word) then
  26749. Result:=btWord
  26750. else if (BaseTypes[btUIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  26751. Result:=btUIntSingle
  26752. else if V<=High(LongWord) then
  26753. Result:=btLongWord
  26754. else if (BaseTypes[btUIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  26755. Result:=btUIntDouble
  26756. else
  26757. begin
  26758. Result:=btIntMax;
  26759. if BaseTypes[Result]=nil then
  26760. Result:=BaseTypeExtended;
  26761. end;
  26762. end;
  26763. end;
  26764. function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
  26765. ErrorEl: TPasElement): TResolverBaseType;
  26766. var
  26767. bt1, bt2: TResolverBaseType;
  26768. begin
  26769. bt1:=GetActualBaseType(Char1.BaseType);
  26770. bt2:=GetActualBaseType(Char2.BaseType);
  26771. if bt1=bt2 then exit(bt1);
  26772. if not (bt1 in btAllChars) then
  26773. RaiseInternalError(20170420103128);
  26774. Result:=btWideChar;
  26775. if Result=BaseTypeChar then
  26776. Result:=btChar;
  26777. if ErrorEl=nil then ;
  26778. end;
  26779. function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
  26780. ErrorEl: TPasElement): TResolverBaseType;
  26781. var
  26782. bt1, bt2: TResolverBaseType;
  26783. begin
  26784. bt1:=GetActualBaseType(Str1.BaseType);
  26785. bt2:=GetActualBaseType(Str2.BaseType);
  26786. if bt1=bt2 then exit(bt1);
  26787. case bt1 of
  26788. {$ifdef FPC_HAS_CPSTRING}
  26789. btAnsiChar:
  26790. case bt2 of
  26791. btChar: Result:=btChar;
  26792. btWideChar: Result:=btWideChar;
  26793. else Result:=bt2;
  26794. end;
  26795. {$endif}
  26796. btWideChar:
  26797. case bt2 of
  26798. {$ifdef FPC_HAS_CPSTRING}
  26799. btAnsiChar: Result:=btWideChar;
  26800. {$endif}
  26801. btWideString: Result:=btWideString;
  26802. btString,btUnicodeString
  26803. {$ifdef FPC_HAS_CPSTRING},btShortString,btAnsiString,btRawByteString{$endif}:
  26804. Result:=btUnicodeString;
  26805. else RaiseNotYetImplemented(20170420103808,ErrorEl);
  26806. end;
  26807. {$ifdef FPC_HAS_CPSTRING}
  26808. btShortString:
  26809. case bt2 of
  26810. btChar,btAnsiChar: Result:=btShortString;
  26811. btString,btAnsiString: Result:=btAnsiString;
  26812. btRawByteString: Result:=btRawByteString;
  26813. btWideChar,btUnicodeString: Result:=btUnicodeString;
  26814. btWideString: Result:=btWideString;
  26815. else RaiseNotYetImplemented(20170420120937,ErrorEl);
  26816. end;
  26817. {$endif}
  26818. btString{$ifdef FPC_HAS_CPSTRING},btAnsiString{$endif}:
  26819. case bt2 of
  26820. {$ifdef FPC_HAS_CPSTRING}
  26821. btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
  26822. {$endif}
  26823. btWideChar,btUnicodeString: Result:=btUnicodeString;
  26824. btWideString: Result:=btWideString;
  26825. else RaiseNotYetImplemented(20170420121201,ErrorEl);
  26826. end;
  26827. {$ifdef FPC_HAS_CPSTRING}
  26828. btRawByteString:
  26829. case bt2 of
  26830. btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
  26831. btString,btAnsiString: Result:=btAnsiString;
  26832. btWideChar,btUnicodeString: Result:=btUnicodeString;
  26833. btWideString: Result:=btWideString;
  26834. else RaiseNotYetImplemented(20170420121352,ErrorEl);
  26835. end;
  26836. {$endif}
  26837. btWideString:
  26838. case bt2 of
  26839. btChar,btWideChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,btShortString,{$endif}btWideString:
  26840. Result:=btWideString;
  26841. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  26842. Result:=btUnicodeString;
  26843. else RaiseNotYetImplemented(20170420121532,ErrorEl);
  26844. end;
  26845. btUnicodeString:
  26846. Result:=btUnicodeString;
  26847. else
  26848. RaiseNotYetImplemented(20170420103153,ErrorEl);
  26849. end;
  26850. if Result=BaseTypeChar then
  26851. Result:=btChar
  26852. else if Result=BaseTypeString then
  26853. Result:=btString;
  26854. end;
  26855. function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
  26856. begin
  26857. Result:=El=nil;
  26858. end;
  26859. function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
  26860. var
  26861. Data: TObject;
  26862. begin
  26863. Data:=El.CustomData;
  26864. if Data=nil then
  26865. RaiseInternalError(20180215185302,GetObjName(El));
  26866. if Data.ClassType=TResElDataBaseType then
  26867. Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
  26868. else if Data.ClassType=TResElDataBuiltInProc then
  26869. Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
  26870. else
  26871. Result:=nil;
  26872. end;
  26873. function TPasResolver.GetLastSection: TPasSection;
  26874. var
  26875. Module: TPasModule;
  26876. begin
  26877. Result:=nil;
  26878. Module:=RootElement;
  26879. if Module=nil then exit;
  26880. if Module is TPasProgram then
  26881. Result:=TPasProgram(Module).ProgramSection
  26882. else if Module is TPasLibrary then
  26883. Result:=TPasLibrary(Module).LibrarySection
  26884. else if Module.ImplementationSection<>nil then
  26885. Result:=Module.ImplementationSection
  26886. else
  26887. Result:=Module.InterfaceSection;
  26888. end;
  26889. function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  26890. isLoFunc: Boolean; out Mask: LongWord): Integer;
  26891. const
  26892. SHIFT_SIZE: array[btByte..{$IFDEF HasInt64}btComp{$ELSE}btIntDouble{$ENDIF}] of Integer = (
  26893. 4, // btByte
  26894. 8, // btShortInt FPC lo/hi(shortint) works like SmallInt
  26895. 8, 8, // btWord, btSmallInt
  26896. 16, 16, 16, 16, // btUIntSingle, btIntSingle, btLongWord, btLongint
  26897. 32, 32 // btUIntDouble, btIntDouble
  26898. {$IFDEF HasInt64}
  26899. , 32, 32, 32 // btQWord, btInt64, btComp
  26900. {$endif}
  26901. );
  26902. begin
  26903. if (BaseType >= Low(SHIFT_SIZE)) and (BaseType <= High(SHIFT_SIZE)) then
  26904. begin
  26905. if msDelphi in CurrentParser.CurrentModeswitches then
  26906. Result := 8
  26907. else
  26908. Result := SHIFT_SIZE[BaseType];
  26909. case Result of
  26910. 8: Mask := $FF;
  26911. 16: Mask := $FFFF;
  26912. 32: Mask := $FFFFFFFF;
  26913. else
  26914. {4} Mask := $F;
  26915. end;
  26916. if isLoFunc then
  26917. Result := 0;
  26918. end
  26919. else
  26920. begin
  26921. RaiseInternalError(20190130122300);
  26922. Result := -1;
  26923. end;
  26924. end;
  26925. function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
  26926. ResolvedDestType: TPasResolverResult): integer;
  26927. // finds distance between classes SrcType and DestType
  26928. begin
  26929. Result:=CheckClassIsClass(ResolvedSrcType.LoTypeEl,ResolvedDestType.LoTypeEl);
  26930. end;
  26931. function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
  26932. // check if Src is equal or descends from Dest
  26933. var
  26934. ClassEl: TPasClassType;
  26935. DestScope: TPasClassScope;
  26936. GenericType: TPasGenericType;
  26937. begin
  26938. {$IFDEF VerbosePasResolver}
  26939. writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  26940. {$ENDIF}
  26941. if DestType=nil then exit(cIncompatible);
  26942. DestType:=ResolveAliasType(DestType);
  26943. if DestType.ClassType<>TPasClassType then
  26944. exit(cIncompatible);
  26945. Result:=cExact;
  26946. while SrcType<>nil do
  26947. begin
  26948. {$IFDEF VerbosePasResolver}
  26949. writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  26950. {$ENDIF}
  26951. if SrcType=DestType then
  26952. exit
  26953. else if SrcType.ClassType=TPasAliasType then
  26954. // alias -> skip
  26955. SrcType:=TPasAliasType(SrcType).DestType
  26956. else if SrcType.ClassType=TPasTypeAliasType then
  26957. begin
  26958. // type alias -> increase distance
  26959. SrcType:=TPasAliasType(SrcType).DestType;
  26960. inc(Result);
  26961. end
  26962. else if SrcType.ClassType=TPasSpecializeType then
  26963. begin
  26964. // specialize -> skip
  26965. if SrcType.CustomData is TPasSpecializeTypeData then
  26966. SrcType:=TPasSpecializeTypeData(SrcType.CustomData).SpecializedType
  26967. else
  26968. SrcType:=TPasSpecializeType(SrcType).DestType;
  26969. end
  26970. else if SrcType.ClassType=TPasClassType then
  26971. begin
  26972. ClassEl:=TPasClassType(SrcType);
  26973. if ClassEl.IsForward then
  26974. // class forward -> skip
  26975. SrcType:=(ClassEl.CustomData as TResolvedReference).Declaration as TPasType
  26976. else
  26977. begin
  26978. if (ClassEl.GenericTemplateTypes<>nil) and (ClassEl.GenericTemplateTypes.Count>0) then
  26979. begin
  26980. // SrcType is a generic
  26981. DestScope:=DestType.CustomData as TPasClassScope;
  26982. if DestScope.SpecializedFromItem<>nil then
  26983. begin
  26984. // DestType is specialized
  26985. GenericType:=TPasGenericType(DestScope.SpecializedFromItem.GenericEl);
  26986. {$IFDEF VerbosePasResolver}
  26987. writeln(' DestType is specialized from ',GetObjName(GenericType));
  26988. {$ENDIF}
  26989. if SrcType=GenericType then
  26990. exit; // DestType is a specialized SrcType
  26991. end;
  26992. end;
  26993. // class ancestor -> increase distance
  26994. SrcType:=(ClassEl.CustomData as TPasClassScope).DirectAncestor;
  26995. inc(Result);
  26996. end;
  26997. end
  26998. else
  26999. exit(cIncompatible);
  27000. end;
  27001. Result:=cIncompatible;
  27002. end;
  27003. function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  27004. begin
  27005. Result:=CheckClassIsClass(TypeA,TypeB);
  27006. if Result<>cIncompatible then exit;
  27007. Result:=CheckClassIsClass(TypeB,TypeA);
  27008. end;
  27009. function TPasResolver.GetClassImplementsIntf(ClassEl, Intf: TPasClassType
  27010. ): TPasClassType;
  27011. begin
  27012. Result:=nil;
  27013. while ClassEl<>nil do
  27014. begin
  27015. if IndexOfImplementedInterface(ClassEl,Intf)>=0 then
  27016. exit(ClassEl);
  27017. ClassEl:=GetPasClassAncestor(ClassEl,true) as TPasClassType;
  27018. end;
  27019. end;
  27020. end.