pasresolver.pp 1.0 MB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104101051010610107101081010910110101111011210113101141011510116101171011810119101201012110122101231012410125101261012710128101291013010131101321013310134101351013610137101381013910140101411014210143101441014510146101471014810149101501015110152101531015410155101561015710158101591016010161101621016310164101651016610167101681016910170101711017210173101741017510176101771017810179101801018110182101831018410185101861018710188101891019010191101921019310194101951019610197101981019910200102011020210203102041020510206102071020810209102101021110212102131021410215102161021710218102191022010221102221022310224102251022610227102281022910230102311023210233102341023510236102371023810239102401024110242102431024410245102461024710248102491025010251102521025310254102551025610257102581025910260102611026210263102641026510266102671026810269102701027110272102731027410275102761027710278102791028010281102821028310284102851028610287102881028910290102911029210293102941029510296102971029810299103001030110302103031030410305103061030710308103091031010311103121031310314103151031610317103181031910320103211032210323103241032510326103271032810329103301033110332103331033410335103361033710338103391034010341103421034310344103451034610347103481034910350103511035210353103541035510356103571035810359103601036110362103631036410365103661036710368103691037010371103721037310374103751037610377103781037910380103811038210383103841038510386103871038810389103901039110392103931039410395103961039710398103991040010401104021040310404104051040610407104081040910410104111041210413104141041510416104171041810419104201042110422104231042410425104261042710428104291043010431104321043310434104351043610437104381043910440104411044210443104441044510446104471044810449104501045110452104531045410455104561045710458104591046010461104621046310464104651046610467104681046910470104711047210473104741047510476104771047810479104801048110482104831048410485104861048710488104891049010491104921049310494104951049610497104981049910500105011050210503105041050510506105071050810509105101051110512105131051410515105161051710518105191052010521105221052310524105251052610527105281052910530105311053210533105341053510536105371053810539105401054110542105431054410545105461054710548105491055010551105521055310554105551055610557105581055910560105611056210563105641056510566105671056810569105701057110572105731057410575105761057710578105791058010581105821058310584105851058610587105881058910590105911059210593105941059510596105971059810599106001060110602106031060410605106061060710608106091061010611106121061310614106151061610617106181061910620106211062210623106241062510626106271062810629106301063110632106331063410635106361063710638106391064010641106421064310644106451064610647106481064910650106511065210653106541065510656106571065810659106601066110662106631066410665106661066710668106691067010671106721067310674106751067610677106781067910680106811068210683106841068510686106871068810689106901069110692106931069410695106961069710698106991070010701107021070310704107051070610707107081070910710107111071210713107141071510716107171071810719107201072110722107231072410725107261072710728107291073010731107321073310734107351073610737107381073910740107411074210743107441074510746107471074810749107501075110752107531075410755107561075710758107591076010761107621076310764107651076610767107681076910770107711077210773107741077510776107771077810779107801078110782107831078410785107861078710788107891079010791107921079310794107951079610797107981079910800108011080210803108041080510806108071080810809108101081110812108131081410815108161081710818108191082010821108221082310824108251082610827108281082910830108311083210833108341083510836108371083810839108401084110842108431084410845108461084710848108491085010851108521085310854108551085610857108581085910860108611086210863108641086510866108671086810869108701087110872108731087410875108761087710878108791088010881108821088310884108851088610887108881088910890108911089210893108941089510896108971089810899109001090110902109031090410905109061090710908109091091010911109121091310914109151091610917109181091910920109211092210923109241092510926109271092810929109301093110932109331093410935109361093710938109391094010941109421094310944109451094610947109481094910950109511095210953109541095510956109571095810959109601096110962109631096410965109661096710968109691097010971109721097310974109751097610977109781097910980109811098210983109841098510986109871098810989109901099110992109931099410995109961099710998109991100011001110021100311004110051100611007110081100911010110111101211013110141101511016110171101811019110201102111022110231102411025110261102711028110291103011031110321103311034110351103611037110381103911040110411104211043110441104511046110471104811049110501105111052110531105411055110561105711058110591106011061110621106311064110651106611067110681106911070110711107211073110741107511076110771107811079110801108111082110831108411085110861108711088110891109011091110921109311094110951109611097110981109911100111011110211103111041110511106111071110811109111101111111112111131111411115111161111711118111191112011121111221112311124111251112611127111281112911130111311113211133111341113511136111371113811139111401114111142111431114411145111461114711148111491115011151111521115311154111551115611157111581115911160111611116211163111641116511166111671116811169111701117111172111731117411175111761117711178111791118011181111821118311184111851118611187111881118911190111911119211193111941119511196111971119811199112001120111202112031120411205112061120711208112091121011211112121121311214112151121611217112181121911220112211122211223112241122511226112271122811229112301123111232112331123411235112361123711238112391124011241112421124311244112451124611247112481124911250112511125211253112541125511256112571125811259112601126111262112631126411265112661126711268112691127011271112721127311274112751127611277112781127911280112811128211283112841128511286112871128811289112901129111292112931129411295112961129711298112991130011301113021130311304113051130611307113081130911310113111131211313113141131511316113171131811319113201132111322113231132411325113261132711328113291133011331113321133311334113351133611337113381133911340113411134211343113441134511346113471134811349113501135111352113531135411355113561135711358113591136011361113621136311364113651136611367113681136911370113711137211373113741137511376113771137811379113801138111382113831138411385113861138711388113891139011391113921139311394113951139611397113981139911400114011140211403114041140511406114071140811409114101141111412114131141411415114161141711418114191142011421114221142311424114251142611427114281142911430114311143211433114341143511436114371143811439114401144111442114431144411445114461144711448114491145011451114521145311454114551145611457114581145911460114611146211463114641146511466114671146811469114701147111472114731147411475114761147711478114791148011481114821148311484114851148611487114881148911490114911149211493114941149511496114971149811499115001150111502115031150411505115061150711508115091151011511115121151311514115151151611517115181151911520115211152211523115241152511526115271152811529115301153111532115331153411535115361153711538115391154011541115421154311544115451154611547115481154911550115511155211553115541155511556115571155811559115601156111562115631156411565115661156711568115691157011571115721157311574115751157611577115781157911580115811158211583115841158511586115871158811589115901159111592115931159411595115961159711598115991160011601116021160311604116051160611607116081160911610116111161211613116141161511616116171161811619116201162111622116231162411625116261162711628116291163011631116321163311634116351163611637116381163911640116411164211643116441164511646116471164811649116501165111652116531165411655116561165711658116591166011661116621166311664116651166611667116681166911670116711167211673116741167511676116771167811679116801168111682116831168411685116861168711688116891169011691116921169311694116951169611697116981169911700117011170211703117041170511706117071170811709117101171111712117131171411715117161171711718117191172011721117221172311724117251172611727117281172911730117311173211733117341173511736117371173811739117401174111742117431174411745117461174711748117491175011751117521175311754117551175611757117581175911760117611176211763117641176511766117671176811769117701177111772117731177411775117761177711778117791178011781117821178311784117851178611787117881178911790117911179211793117941179511796117971179811799118001180111802118031180411805118061180711808118091181011811118121181311814118151181611817118181181911820118211182211823118241182511826118271182811829118301183111832118331183411835118361183711838118391184011841118421184311844118451184611847118481184911850118511185211853118541185511856118571185811859118601186111862118631186411865118661186711868118691187011871118721187311874118751187611877118781187911880118811188211883118841188511886118871188811889118901189111892118931189411895118961189711898118991190011901119021190311904119051190611907119081190911910119111191211913119141191511916119171191811919119201192111922119231192411925119261192711928119291193011931119321193311934119351193611937119381193911940119411194211943119441194511946119471194811949119501195111952119531195411955119561195711958119591196011961119621196311964119651196611967119681196911970119711197211973119741197511976119771197811979119801198111982119831198411985119861198711988119891199011991119921199311994119951199611997119981199912000120011200212003120041200512006120071200812009120101201112012120131201412015120161201712018120191202012021120221202312024120251202612027120281202912030120311203212033120341203512036120371203812039120401204112042120431204412045120461204712048120491205012051120521205312054120551205612057120581205912060120611206212063120641206512066120671206812069120701207112072120731207412075120761207712078120791208012081120821208312084120851208612087120881208912090120911209212093120941209512096120971209812099121001210112102121031210412105121061210712108121091211012111121121211312114121151211612117121181211912120121211212212123121241212512126121271212812129121301213112132121331213412135121361213712138121391214012141121421214312144121451214612147121481214912150121511215212153121541215512156121571215812159121601216112162121631216412165121661216712168121691217012171121721217312174121751217612177121781217912180121811218212183121841218512186121871218812189121901219112192121931219412195121961219712198121991220012201122021220312204122051220612207122081220912210122111221212213122141221512216122171221812219122201222112222122231222412225122261222712228122291223012231122321223312234122351223612237122381223912240122411224212243122441224512246122471224812249122501225112252122531225412255122561225712258122591226012261122621226312264122651226612267122681226912270122711227212273122741227512276122771227812279122801228112282122831228412285122861228712288122891229012291122921229312294122951229612297122981229912300123011230212303123041230512306123071230812309123101231112312123131231412315123161231712318123191232012321123221232312324123251232612327123281232912330123311233212333123341233512336123371233812339123401234112342123431234412345123461234712348123491235012351123521235312354123551235612357123581235912360123611236212363123641236512366123671236812369123701237112372123731237412375123761237712378123791238012381123821238312384123851238612387123881238912390123911239212393123941239512396123971239812399124001240112402124031240412405124061240712408124091241012411124121241312414124151241612417124181241912420124211242212423124241242512426124271242812429124301243112432124331243412435124361243712438124391244012441124421244312444124451244612447124481244912450124511245212453124541245512456124571245812459124601246112462124631246412465124661246712468124691247012471124721247312474124751247612477124781247912480124811248212483124841248512486124871248812489124901249112492124931249412495124961249712498124991250012501125021250312504125051250612507125081250912510125111251212513125141251512516125171251812519125201252112522125231252412525125261252712528125291253012531125321253312534125351253612537125381253912540125411254212543125441254512546125471254812549125501255112552125531255412555125561255712558125591256012561125621256312564125651256612567125681256912570125711257212573125741257512576125771257812579125801258112582125831258412585125861258712588125891259012591125921259312594125951259612597125981259912600126011260212603126041260512606126071260812609126101261112612126131261412615126161261712618126191262012621126221262312624126251262612627126281262912630126311263212633126341263512636126371263812639126401264112642126431264412645126461264712648126491265012651126521265312654126551265612657126581265912660126611266212663126641266512666126671266812669126701267112672126731267412675126761267712678126791268012681126821268312684126851268612687126881268912690126911269212693126941269512696126971269812699127001270112702127031270412705127061270712708127091271012711127121271312714127151271612717127181271912720127211272212723127241272512726127271272812729127301273112732127331273412735127361273712738127391274012741127421274312744127451274612747127481274912750127511275212753127541275512756127571275812759127601276112762127631276412765127661276712768127691277012771127721277312774127751277612777127781277912780127811278212783127841278512786127871278812789127901279112792127931279412795127961279712798127991280012801128021280312804128051280612807128081280912810128111281212813128141281512816128171281812819128201282112822128231282412825128261282712828128291283012831128321283312834128351283612837128381283912840128411284212843128441284512846128471284812849128501285112852128531285412855128561285712858128591286012861128621286312864128651286612867128681286912870128711287212873128741287512876128771287812879128801288112882128831288412885128861288712888128891289012891128921289312894128951289612897128981289912900129011290212903129041290512906129071290812909129101291112912129131291412915129161291712918129191292012921129221292312924129251292612927129281292912930129311293212933129341293512936129371293812939129401294112942129431294412945129461294712948129491295012951129521295312954129551295612957129581295912960129611296212963129641296512966129671296812969129701297112972129731297412975129761297712978129791298012981129821298312984129851298612987129881298912990129911299212993129941299512996129971299812999130001300113002130031300413005130061300713008130091301013011130121301313014130151301613017130181301913020130211302213023130241302513026130271302813029130301303113032130331303413035130361303713038130391304013041130421304313044130451304613047130481304913050130511305213053130541305513056130571305813059130601306113062130631306413065130661306713068130691307013071130721307313074130751307613077130781307913080130811308213083130841308513086130871308813089130901309113092130931309413095130961309713098130991310013101131021310313104131051310613107131081310913110131111311213113131141311513116131171311813119131201312113122131231312413125131261312713128131291313013131131321313313134131351313613137131381313913140131411314213143131441314513146131471314813149131501315113152131531315413155131561315713158131591316013161131621316313164131651316613167131681316913170131711317213173131741317513176131771317813179131801318113182131831318413185131861318713188131891319013191131921319313194131951319613197131981319913200132011320213203132041320513206132071320813209132101321113212132131321413215132161321713218132191322013221132221322313224132251322613227132281322913230132311323213233132341323513236132371323813239132401324113242132431324413245132461324713248132491325013251132521325313254132551325613257132581325913260132611326213263132641326513266132671326813269132701327113272132731327413275132761327713278132791328013281132821328313284132851328613287132881328913290132911329213293132941329513296132971329813299133001330113302133031330413305133061330713308133091331013311133121331313314133151331613317133181331913320133211332213323133241332513326133271332813329133301333113332133331333413335133361333713338133391334013341133421334313344133451334613347133481334913350133511335213353133541335513356133571335813359133601336113362133631336413365133661336713368133691337013371133721337313374133751337613377133781337913380133811338213383133841338513386133871338813389133901339113392133931339413395133961339713398133991340013401134021340313404134051340613407134081340913410134111341213413134141341513416134171341813419134201342113422134231342413425134261342713428134291343013431134321343313434134351343613437134381343913440134411344213443134441344513446134471344813449134501345113452134531345413455134561345713458134591346013461134621346313464134651346613467134681346913470134711347213473134741347513476134771347813479134801348113482134831348413485134861348713488134891349013491134921349313494134951349613497134981349913500135011350213503135041350513506135071350813509135101351113512135131351413515135161351713518135191352013521135221352313524135251352613527135281352913530135311353213533135341353513536135371353813539135401354113542135431354413545135461354713548135491355013551135521355313554135551355613557135581355913560135611356213563135641356513566135671356813569135701357113572135731357413575135761357713578135791358013581135821358313584135851358613587135881358913590135911359213593135941359513596135971359813599136001360113602136031360413605136061360713608136091361013611136121361313614136151361613617136181361913620136211362213623136241362513626136271362813629136301363113632136331363413635136361363713638136391364013641136421364313644136451364613647136481364913650136511365213653136541365513656136571365813659136601366113662136631366413665136661366713668136691367013671136721367313674136751367613677136781367913680136811368213683136841368513686136871368813689136901369113692136931369413695136961369713698136991370013701137021370313704137051370613707137081370913710137111371213713137141371513716137171371813719137201372113722137231372413725137261372713728137291373013731137321373313734137351373613737137381373913740137411374213743137441374513746137471374813749137501375113752137531375413755137561375713758137591376013761137621376313764137651376613767137681376913770137711377213773137741377513776137771377813779137801378113782137831378413785137861378713788137891379013791137921379313794137951379613797137981379913800138011380213803138041380513806138071380813809138101381113812138131381413815138161381713818138191382013821138221382313824138251382613827138281382913830138311383213833138341383513836138371383813839138401384113842138431384413845138461384713848138491385013851138521385313854138551385613857138581385913860138611386213863138641386513866138671386813869138701387113872138731387413875138761387713878138791388013881138821388313884138851388613887138881388913890138911389213893138941389513896138971389813899139001390113902139031390413905139061390713908139091391013911139121391313914139151391613917139181391913920139211392213923139241392513926139271392813929139301393113932139331393413935139361393713938139391394013941139421394313944139451394613947139481394913950139511395213953139541395513956139571395813959139601396113962139631396413965139661396713968139691397013971139721397313974139751397613977139781397913980139811398213983139841398513986139871398813989139901399113992139931399413995139961399713998139991400014001140021400314004140051400614007140081400914010140111401214013140141401514016140171401814019140201402114022140231402414025140261402714028140291403014031140321403314034140351403614037140381403914040140411404214043140441404514046140471404814049140501405114052140531405414055140561405714058140591406014061140621406314064140651406614067140681406914070140711407214073140741407514076140771407814079140801408114082140831408414085140861408714088140891409014091140921409314094140951409614097140981409914100141011410214103141041410514106141071410814109141101411114112141131411414115141161411714118141191412014121141221412314124141251412614127141281412914130141311413214133141341413514136141371413814139141401414114142141431414414145141461414714148141491415014151141521415314154141551415614157141581415914160141611416214163141641416514166141671416814169141701417114172141731417414175141761417714178141791418014181141821418314184141851418614187141881418914190141911419214193141941419514196141971419814199142001420114202142031420414205142061420714208142091421014211142121421314214142151421614217142181421914220142211422214223142241422514226142271422814229142301423114232142331423414235142361423714238142391424014241142421424314244142451424614247142481424914250142511425214253142541425514256142571425814259142601426114262142631426414265142661426714268142691427014271142721427314274142751427614277142781427914280142811428214283142841428514286142871428814289142901429114292142931429414295142961429714298142991430014301143021430314304143051430614307143081430914310143111431214313143141431514316143171431814319143201432114322143231432414325143261432714328143291433014331143321433314334143351433614337143381433914340143411434214343143441434514346143471434814349143501435114352143531435414355143561435714358143591436014361143621436314364143651436614367143681436914370143711437214373143741437514376143771437814379143801438114382143831438414385143861438714388143891439014391143921439314394143951439614397143981439914400144011440214403144041440514406144071440814409144101441114412144131441414415144161441714418144191442014421144221442314424144251442614427144281442914430144311443214433144341443514436144371443814439144401444114442144431444414445144461444714448144491445014451144521445314454144551445614457144581445914460144611446214463144641446514466144671446814469144701447114472144731447414475144761447714478144791448014481144821448314484144851448614487144881448914490144911449214493144941449514496144971449814499145001450114502145031450414505145061450714508145091451014511145121451314514145151451614517145181451914520145211452214523145241452514526145271452814529145301453114532145331453414535145361453714538145391454014541145421454314544145451454614547145481454914550145511455214553145541455514556145571455814559145601456114562145631456414565145661456714568145691457014571145721457314574145751457614577145781457914580145811458214583145841458514586145871458814589145901459114592145931459414595145961459714598145991460014601146021460314604146051460614607146081460914610146111461214613146141461514616146171461814619146201462114622146231462414625146261462714628146291463014631146321463314634146351463614637146381463914640146411464214643146441464514646146471464814649146501465114652146531465414655146561465714658146591466014661146621466314664146651466614667146681466914670146711467214673146741467514676146771467814679146801468114682146831468414685146861468714688146891469014691146921469314694146951469614697146981469914700147011470214703147041470514706147071470814709147101471114712147131471414715147161471714718147191472014721147221472314724147251472614727147281472914730147311473214733147341473514736147371473814739147401474114742147431474414745147461474714748147491475014751147521475314754147551475614757147581475914760147611476214763147641476514766147671476814769147701477114772147731477414775147761477714778147791478014781147821478314784147851478614787147881478914790147911479214793147941479514796147971479814799148001480114802148031480414805148061480714808148091481014811148121481314814148151481614817148181481914820148211482214823148241482514826148271482814829148301483114832148331483414835148361483714838148391484014841148421484314844148451484614847148481484914850148511485214853148541485514856148571485814859148601486114862148631486414865148661486714868148691487014871148721487314874148751487614877148781487914880148811488214883148841488514886148871488814889148901489114892148931489414895148961489714898148991490014901149021490314904149051490614907149081490914910149111491214913149141491514916149171491814919149201492114922149231492414925149261492714928149291493014931149321493314934149351493614937149381493914940149411494214943149441494514946149471494814949149501495114952149531495414955149561495714958149591496014961149621496314964149651496614967149681496914970149711497214973149741497514976149771497814979149801498114982149831498414985149861498714988149891499014991149921499314994149951499614997149981499915000150011500215003150041500515006150071500815009150101501115012150131501415015150161501715018150191502015021150221502315024150251502615027150281502915030150311503215033150341503515036150371503815039150401504115042150431504415045150461504715048150491505015051150521505315054150551505615057150581505915060150611506215063150641506515066150671506815069150701507115072150731507415075150761507715078150791508015081150821508315084150851508615087150881508915090150911509215093150941509515096150971509815099151001510115102151031510415105151061510715108151091511015111151121511315114151151511615117151181511915120151211512215123151241512515126151271512815129151301513115132151331513415135151361513715138151391514015141151421514315144151451514615147151481514915150151511515215153151541515515156151571515815159151601516115162151631516415165151661516715168151691517015171151721517315174151751517615177151781517915180151811518215183151841518515186151871518815189151901519115192151931519415195151961519715198151991520015201152021520315204152051520615207152081520915210152111521215213152141521515216152171521815219152201522115222152231522415225152261522715228152291523015231152321523315234152351523615237152381523915240152411524215243152441524515246152471524815249152501525115252152531525415255152561525715258152591526015261152621526315264152651526615267152681526915270152711527215273152741527515276152771527815279152801528115282152831528415285152861528715288152891529015291152921529315294152951529615297152981529915300153011530215303153041530515306153071530815309153101531115312153131531415315153161531715318153191532015321153221532315324153251532615327153281532915330153311533215333153341533515336153371533815339153401534115342153431534415345153461534715348153491535015351153521535315354153551535615357153581535915360153611536215363153641536515366153671536815369153701537115372153731537415375153761537715378153791538015381153821538315384153851538615387153881538915390153911539215393153941539515396153971539815399154001540115402154031540415405154061540715408154091541015411154121541315414154151541615417154181541915420154211542215423154241542515426154271542815429154301543115432154331543415435154361543715438154391544015441154421544315444154451544615447154481544915450154511545215453154541545515456154571545815459154601546115462154631546415465154661546715468154691547015471154721547315474154751547615477154781547915480154811548215483154841548515486154871548815489154901549115492154931549415495154961549715498154991550015501155021550315504155051550615507155081550915510155111551215513155141551515516155171551815519155201552115522155231552415525155261552715528155291553015531155321553315534155351553615537155381553915540155411554215543155441554515546155471554815549155501555115552155531555415555155561555715558155591556015561155621556315564155651556615567155681556915570155711557215573155741557515576155771557815579155801558115582155831558415585155861558715588155891559015591155921559315594155951559615597155981559915600156011560215603156041560515606156071560815609156101561115612156131561415615156161561715618156191562015621156221562315624156251562615627156281562915630156311563215633156341563515636156371563815639156401564115642156431564415645156461564715648156491565015651156521565315654156551565615657156581565915660156611566215663156641566515666156671566815669156701567115672156731567415675156761567715678156791568015681156821568315684156851568615687156881568915690156911569215693156941569515696156971569815699157001570115702157031570415705157061570715708157091571015711157121571315714157151571615717157181571915720157211572215723157241572515726157271572815729157301573115732157331573415735157361573715738157391574015741157421574315744157451574615747157481574915750157511575215753157541575515756157571575815759157601576115762157631576415765157661576715768157691577015771157721577315774157751577615777157781577915780157811578215783157841578515786157871578815789157901579115792157931579415795157961579715798157991580015801158021580315804158051580615807158081580915810158111581215813158141581515816158171581815819158201582115822158231582415825158261582715828158291583015831158321583315834158351583615837158381583915840158411584215843158441584515846158471584815849158501585115852158531585415855158561585715858158591586015861158621586315864158651586615867158681586915870158711587215873158741587515876158771587815879158801588115882158831588415885158861588715888158891589015891158921589315894158951589615897158981589915900159011590215903159041590515906159071590815909159101591115912159131591415915159161591715918159191592015921159221592315924159251592615927159281592915930159311593215933159341593515936159371593815939159401594115942159431594415945159461594715948159491595015951159521595315954159551595615957159581595915960159611596215963159641596515966159671596815969159701597115972159731597415975159761597715978159791598015981159821598315984159851598615987159881598915990159911599215993159941599515996159971599815999160001600116002160031600416005160061600716008160091601016011160121601316014160151601616017160181601916020160211602216023160241602516026160271602816029160301603116032160331603416035160361603716038160391604016041160421604316044160451604616047160481604916050160511605216053160541605516056160571605816059160601606116062160631606416065160661606716068160691607016071160721607316074160751607616077160781607916080160811608216083160841608516086160871608816089160901609116092160931609416095160961609716098160991610016101161021610316104161051610616107161081610916110161111611216113161141611516116161171611816119161201612116122161231612416125161261612716128161291613016131161321613316134161351613616137161381613916140161411614216143161441614516146161471614816149161501615116152161531615416155161561615716158161591616016161161621616316164161651616616167161681616916170161711617216173161741617516176161771617816179161801618116182161831618416185161861618716188161891619016191161921619316194161951619616197161981619916200162011620216203162041620516206162071620816209162101621116212162131621416215162161621716218162191622016221162221622316224162251622616227162281622916230162311623216233162341623516236162371623816239162401624116242162431624416245162461624716248162491625016251162521625316254162551625616257162581625916260162611626216263162641626516266162671626816269162701627116272162731627416275162761627716278162791628016281162821628316284162851628616287162881628916290162911629216293162941629516296162971629816299163001630116302163031630416305163061630716308163091631016311163121631316314163151631616317163181631916320163211632216323163241632516326163271632816329163301633116332163331633416335163361633716338163391634016341163421634316344163451634616347163481634916350163511635216353163541635516356163571635816359163601636116362163631636416365163661636716368163691637016371163721637316374163751637616377163781637916380163811638216383163841638516386163871638816389163901639116392163931639416395163961639716398163991640016401164021640316404164051640616407164081640916410164111641216413164141641516416164171641816419164201642116422164231642416425164261642716428164291643016431164321643316434164351643616437164381643916440164411644216443164441644516446164471644816449164501645116452164531645416455164561645716458164591646016461164621646316464164651646616467164681646916470164711647216473164741647516476164771647816479164801648116482164831648416485164861648716488164891649016491164921649316494164951649616497164981649916500165011650216503165041650516506165071650816509165101651116512165131651416515165161651716518165191652016521165221652316524165251652616527165281652916530165311653216533165341653516536165371653816539165401654116542165431654416545165461654716548165491655016551165521655316554165551655616557165581655916560165611656216563165641656516566165671656816569165701657116572165731657416575165761657716578165791658016581165821658316584165851658616587165881658916590165911659216593165941659516596165971659816599166001660116602166031660416605166061660716608166091661016611166121661316614166151661616617166181661916620166211662216623166241662516626166271662816629166301663116632166331663416635166361663716638166391664016641166421664316644166451664616647166481664916650166511665216653166541665516656166571665816659166601666116662166631666416665166661666716668166691667016671166721667316674166751667616677166781667916680166811668216683166841668516686166871668816689166901669116692166931669416695166961669716698166991670016701167021670316704167051670616707167081670916710167111671216713167141671516716167171671816719167201672116722167231672416725167261672716728167291673016731167321673316734167351673616737167381673916740167411674216743167441674516746167471674816749167501675116752167531675416755167561675716758167591676016761167621676316764167651676616767167681676916770167711677216773167741677516776167771677816779167801678116782167831678416785167861678716788167891679016791167921679316794167951679616797167981679916800168011680216803168041680516806168071680816809168101681116812168131681416815168161681716818168191682016821168221682316824168251682616827168281682916830168311683216833168341683516836168371683816839168401684116842168431684416845168461684716848168491685016851168521685316854168551685616857168581685916860168611686216863168641686516866168671686816869168701687116872168731687416875168761687716878168791688016881168821688316884168851688616887168881688916890168911689216893168941689516896168971689816899169001690116902169031690416905169061690716908169091691016911169121691316914169151691616917169181691916920169211692216923169241692516926169271692816929169301693116932169331693416935169361693716938169391694016941169421694316944169451694616947169481694916950169511695216953169541695516956169571695816959169601696116962169631696416965169661696716968169691697016971169721697316974169751697616977169781697916980169811698216983169841698516986169871698816989169901699116992169931699416995169961699716998169991700017001170021700317004170051700617007170081700917010170111701217013170141701517016170171701817019170201702117022170231702417025170261702717028170291703017031170321703317034170351703617037170381703917040170411704217043170441704517046170471704817049170501705117052170531705417055170561705717058170591706017061170621706317064170651706617067170681706917070170711707217073170741707517076170771707817079170801708117082170831708417085170861708717088170891709017091170921709317094170951709617097170981709917100171011710217103171041710517106171071710817109171101711117112171131711417115171161711717118171191712017121171221712317124171251712617127171281712917130171311713217133171341713517136171371713817139171401714117142171431714417145171461714717148171491715017151171521715317154171551715617157171581715917160171611716217163171641716517166171671716817169171701717117172171731717417175171761717717178171791718017181171821718317184171851718617187171881718917190171911719217193171941719517196171971719817199172001720117202172031720417205172061720717208172091721017211172121721317214172151721617217172181721917220172211722217223172241722517226172271722817229172301723117232172331723417235172361723717238172391724017241172421724317244172451724617247172481724917250172511725217253172541725517256172571725817259172601726117262172631726417265172661726717268172691727017271172721727317274172751727617277172781727917280172811728217283172841728517286172871728817289172901729117292172931729417295172961729717298172991730017301173021730317304173051730617307173081730917310173111731217313173141731517316173171731817319173201732117322173231732417325173261732717328173291733017331173321733317334173351733617337173381733917340173411734217343173441734517346173471734817349173501735117352173531735417355173561735717358173591736017361173621736317364173651736617367173681736917370173711737217373173741737517376173771737817379173801738117382173831738417385173861738717388173891739017391173921739317394173951739617397173981739917400174011740217403174041740517406174071740817409174101741117412174131741417415174161741717418174191742017421174221742317424174251742617427174281742917430174311743217433174341743517436174371743817439174401744117442174431744417445174461744717448174491745017451174521745317454174551745617457174581745917460174611746217463174641746517466174671746817469174701747117472174731747417475174761747717478174791748017481174821748317484174851748617487174881748917490174911749217493174941749517496174971749817499175001750117502175031750417505175061750717508175091751017511175121751317514175151751617517175181751917520175211752217523175241752517526175271752817529175301753117532175331753417535175361753717538175391754017541175421754317544175451754617547175481754917550175511755217553175541755517556175571755817559175601756117562175631756417565175661756717568175691757017571175721757317574175751757617577175781757917580175811758217583175841758517586175871758817589175901759117592175931759417595175961759717598175991760017601176021760317604176051760617607176081760917610176111761217613176141761517616176171761817619176201762117622176231762417625176261762717628176291763017631176321763317634176351763617637176381763917640176411764217643176441764517646176471764817649176501765117652176531765417655176561765717658176591766017661176621766317664176651766617667176681766917670176711767217673176741767517676176771767817679176801768117682176831768417685176861768717688176891769017691176921769317694176951769617697176981769917700177011770217703177041770517706177071770817709177101771117712177131771417715177161771717718177191772017721177221772317724177251772617727177281772917730177311773217733177341773517736177371773817739177401774117742177431774417745177461774717748177491775017751177521775317754177551775617757177581775917760177611776217763177641776517766177671776817769177701777117772177731777417775177761777717778177791778017781177821778317784177851778617787177881778917790177911779217793177941779517796177971779817799178001780117802178031780417805178061780717808178091781017811178121781317814178151781617817178181781917820178211782217823178241782517826178271782817829178301783117832178331783417835178361783717838178391784017841178421784317844178451784617847178481784917850178511785217853178541785517856178571785817859178601786117862178631786417865178661786717868178691787017871178721787317874178751787617877178781787917880178811788217883178841788517886178871788817889178901789117892178931789417895178961789717898178991790017901179021790317904179051790617907179081790917910179111791217913179141791517916179171791817919179201792117922179231792417925179261792717928179291793017931179321793317934179351793617937179381793917940179411794217943179441794517946179471794817949179501795117952179531795417955179561795717958179591796017961179621796317964179651796617967179681796917970179711797217973179741797517976179771797817979179801798117982179831798417985179861798717988179891799017991179921799317994179951799617997179981799918000180011800218003180041800518006180071800818009180101801118012180131801418015180161801718018180191802018021180221802318024180251802618027180281802918030180311803218033180341803518036180371803818039180401804118042180431804418045180461804718048180491805018051180521805318054180551805618057180581805918060180611806218063180641806518066180671806818069180701807118072180731807418075180761807718078180791808018081180821808318084180851808618087180881808918090180911809218093180941809518096180971809818099181001810118102181031810418105181061810718108181091811018111181121811318114181151811618117181181811918120181211812218123181241812518126181271812818129181301813118132181331813418135181361813718138181391814018141181421814318144181451814618147181481814918150181511815218153181541815518156181571815818159181601816118162181631816418165181661816718168181691817018171181721817318174181751817618177181781817918180181811818218183181841818518186181871818818189181901819118192181931819418195181961819718198181991820018201182021820318204182051820618207182081820918210182111821218213182141821518216182171821818219182201822118222182231822418225182261822718228182291823018231182321823318234182351823618237182381823918240182411824218243182441824518246182471824818249182501825118252182531825418255182561825718258182591826018261182621826318264182651826618267182681826918270182711827218273182741827518276182771827818279182801828118282182831828418285182861828718288182891829018291182921829318294182951829618297182981829918300183011830218303183041830518306183071830818309183101831118312183131831418315183161831718318183191832018321183221832318324183251832618327183281832918330183311833218333183341833518336183371833818339183401834118342183431834418345183461834718348183491835018351183521835318354183551835618357183581835918360183611836218363183641836518366183671836818369183701837118372183731837418375183761837718378183791838018381183821838318384183851838618387183881838918390183911839218393183941839518396183971839818399184001840118402184031840418405184061840718408184091841018411184121841318414184151841618417184181841918420184211842218423184241842518426184271842818429184301843118432184331843418435184361843718438184391844018441184421844318444184451844618447184481844918450184511845218453184541845518456184571845818459184601846118462184631846418465184661846718468184691847018471184721847318474184751847618477184781847918480184811848218483184841848518486184871848818489184901849118492184931849418495184961849718498184991850018501185021850318504185051850618507185081850918510185111851218513185141851518516185171851818519185201852118522185231852418525185261852718528185291853018531185321853318534185351853618537185381853918540185411854218543185441854518546185471854818549185501855118552185531855418555185561855718558185591856018561185621856318564185651856618567185681856918570185711857218573185741857518576185771857818579185801858118582185831858418585185861858718588185891859018591185921859318594185951859618597185981859918600186011860218603186041860518606186071860818609186101861118612186131861418615186161861718618186191862018621186221862318624186251862618627186281862918630186311863218633186341863518636186371863818639186401864118642186431864418645186461864718648186491865018651186521865318654186551865618657186581865918660186611866218663186641866518666186671866818669186701867118672186731867418675186761867718678186791868018681186821868318684186851868618687186881868918690186911869218693186941869518696186971869818699187001870118702187031870418705187061870718708187091871018711187121871318714187151871618717187181871918720187211872218723187241872518726187271872818729187301873118732187331873418735187361873718738187391874018741187421874318744187451874618747187481874918750187511875218753187541875518756187571875818759187601876118762187631876418765187661876718768187691877018771187721877318774187751877618777187781877918780187811878218783187841878518786187871878818789187901879118792187931879418795187961879718798187991880018801188021880318804188051880618807188081880918810188111881218813188141881518816188171881818819188201882118822188231882418825188261882718828188291883018831188321883318834188351883618837188381883918840188411884218843188441884518846188471884818849188501885118852188531885418855188561885718858188591886018861188621886318864188651886618867188681886918870188711887218873188741887518876188771887818879188801888118882188831888418885188861888718888188891889018891188921889318894188951889618897188981889918900189011890218903189041890518906189071890818909189101891118912189131891418915189161891718918189191892018921189221892318924189251892618927189281892918930189311893218933189341893518936189371893818939189401894118942189431894418945189461894718948189491895018951189521895318954189551895618957189581895918960189611896218963189641896518966189671896818969189701897118972189731897418975189761897718978189791898018981189821898318984189851898618987189881898918990189911899218993189941899518996189971899818999190001900119002190031900419005190061900719008190091901019011190121901319014190151901619017190181901919020190211902219023190241902519026190271902819029190301903119032190331903419035190361903719038190391904019041190421904319044190451904619047190481904919050190511905219053190541905519056190571905819059190601906119062190631906419065190661906719068190691907019071190721907319074190751907619077190781907919080190811908219083190841908519086190871908819089190901909119092190931909419095190961909719098190991910019101191021910319104191051910619107191081910919110191111911219113191141911519116191171911819119191201912119122191231912419125191261912719128191291913019131191321913319134191351913619137191381913919140191411914219143191441914519146191471914819149191501915119152191531915419155191561915719158191591916019161191621916319164191651916619167191681916919170191711917219173191741917519176191771917819179191801918119182191831918419185191861918719188191891919019191191921919319194191951919619197191981919919200192011920219203192041920519206192071920819209192101921119212192131921419215192161921719218192191922019221192221922319224192251922619227192281922919230192311923219233192341923519236192371923819239192401924119242192431924419245192461924719248192491925019251192521925319254192551925619257192581925919260192611926219263192641926519266192671926819269192701927119272192731927419275192761927719278192791928019281192821928319284192851928619287192881928919290192911929219293192941929519296192971929819299193001930119302193031930419305193061930719308193091931019311193121931319314193151931619317193181931919320193211932219323193241932519326193271932819329193301933119332193331933419335193361933719338193391934019341193421934319344193451934619347193481934919350193511935219353193541935519356193571935819359193601936119362193631936419365193661936719368193691937019371193721937319374193751937619377193781937919380193811938219383193841938519386193871938819389193901939119392193931939419395193961939719398193991940019401194021940319404194051940619407194081940919410194111941219413194141941519416194171941819419194201942119422194231942419425194261942719428194291943019431194321943319434194351943619437194381943919440194411944219443194441944519446194471944819449194501945119452194531945419455194561945719458194591946019461194621946319464194651946619467194681946919470194711947219473194741947519476194771947819479194801948119482194831948419485194861948719488194891949019491194921949319494194951949619497194981949919500195011950219503195041950519506195071950819509195101951119512195131951419515195161951719518195191952019521195221952319524195251952619527195281952919530195311953219533195341953519536195371953819539195401954119542195431954419545195461954719548195491955019551195521955319554195551955619557195581955919560195611956219563195641956519566195671956819569195701957119572195731957419575195761957719578195791958019581195821958319584195851958619587195881958919590195911959219593195941959519596195971959819599196001960119602196031960419605196061960719608196091961019611196121961319614196151961619617196181961919620196211962219623196241962519626196271962819629196301963119632196331963419635196361963719638196391964019641196421964319644196451964619647196481964919650196511965219653196541965519656196571965819659196601966119662196631966419665196661966719668196691967019671196721967319674196751967619677196781967919680196811968219683196841968519686196871968819689196901969119692196931969419695196961969719698196991970019701197021970319704197051970619707197081970919710197111971219713197141971519716197171971819719197201972119722197231972419725197261972719728197291973019731197321973319734197351973619737197381973919740197411974219743197441974519746197471974819749197501975119752197531975419755197561975719758197591976019761197621976319764197651976619767197681976919770197711977219773197741977519776197771977819779197801978119782197831978419785197861978719788197891979019791197921979319794197951979619797197981979919800198011980219803198041980519806198071980819809198101981119812198131981419815198161981719818198191982019821198221982319824198251982619827198281982919830198311983219833198341983519836198371983819839198401984119842198431984419845198461984719848198491985019851198521985319854198551985619857198581985919860198611986219863198641986519866198671986819869198701987119872198731987419875198761987719878198791988019881198821988319884198851988619887198881988919890198911989219893198941989519896198971989819899199001990119902199031990419905199061990719908199091991019911199121991319914199151991619917199181991919920199211992219923199241992519926199271992819929199301993119932199331993419935199361993719938199391994019941199421994319944199451994619947199481994919950199511995219953199541995519956199571995819959199601996119962199631996419965199661996719968199691997019971199721997319974199751997619977199781997919980199811998219983199841998519986199871998819989199901999119992199931999419995199961999719998199992000020001200022000320004200052000620007200082000920010200112001220013200142001520016200172001820019200202002120022200232002420025200262002720028200292003020031200322003320034200352003620037200382003920040200412004220043200442004520046200472004820049200502005120052200532005420055200562005720058200592006020061200622006320064200652006620067200682006920070200712007220073200742007520076200772007820079200802008120082200832008420085200862008720088200892009020091200922009320094200952009620097200982009920100201012010220103201042010520106201072010820109201102011120112201132011420115201162011720118201192012020121201222012320124201252012620127201282012920130201312013220133201342013520136201372013820139201402014120142201432014420145201462014720148201492015020151201522015320154201552015620157201582015920160201612016220163201642016520166201672016820169201702017120172201732017420175201762017720178201792018020181201822018320184201852018620187201882018920190201912019220193201942019520196201972019820199202002020120202202032020420205202062020720208202092021020211202122021320214202152021620217202182021920220202212022220223202242022520226202272022820229202302023120232202332023420235202362023720238202392024020241202422024320244202452024620247202482024920250202512025220253202542025520256202572025820259202602026120262202632026420265202662026720268202692027020271202722027320274202752027620277202782027920280202812028220283202842028520286202872028820289202902029120292202932029420295202962029720298202992030020301203022030320304203052030620307203082030920310203112031220313203142031520316203172031820319203202032120322203232032420325203262032720328203292033020331203322033320334203352033620337203382033920340203412034220343203442034520346203472034820349203502035120352203532035420355203562035720358203592036020361203622036320364203652036620367203682036920370203712037220373203742037520376203772037820379203802038120382203832038420385203862038720388203892039020391203922039320394203952039620397203982039920400204012040220403204042040520406204072040820409204102041120412204132041420415204162041720418204192042020421204222042320424204252042620427204282042920430204312043220433204342043520436204372043820439204402044120442204432044420445204462044720448204492045020451204522045320454204552045620457204582045920460204612046220463204642046520466204672046820469204702047120472204732047420475204762047720478204792048020481204822048320484204852048620487204882048920490204912049220493204942049520496204972049820499205002050120502205032050420505205062050720508205092051020511205122051320514205152051620517205182051920520205212052220523205242052520526205272052820529205302053120532205332053420535205362053720538205392054020541205422054320544205452054620547205482054920550205512055220553205542055520556205572055820559205602056120562205632056420565205662056720568205692057020571205722057320574205752057620577205782057920580205812058220583205842058520586205872058820589205902059120592205932059420595205962059720598205992060020601206022060320604206052060620607206082060920610206112061220613206142061520616206172061820619206202062120622206232062420625206262062720628206292063020631206322063320634206352063620637206382063920640206412064220643206442064520646206472064820649206502065120652206532065420655206562065720658206592066020661206622066320664206652066620667206682066920670206712067220673206742067520676206772067820679206802068120682206832068420685206862068720688206892069020691206922069320694206952069620697206982069920700207012070220703207042070520706207072070820709207102071120712207132071420715207162071720718207192072020721207222072320724207252072620727207282072920730207312073220733207342073520736207372073820739207402074120742207432074420745207462074720748207492075020751207522075320754207552075620757207582075920760207612076220763207642076520766207672076820769207702077120772207732077420775207762077720778207792078020781207822078320784207852078620787207882078920790207912079220793207942079520796207972079820799208002080120802208032080420805208062080720808208092081020811208122081320814208152081620817208182081920820208212082220823208242082520826208272082820829208302083120832208332083420835208362083720838208392084020841208422084320844208452084620847208482084920850208512085220853208542085520856208572085820859208602086120862208632086420865208662086720868208692087020871208722087320874208752087620877208782087920880208812088220883208842088520886208872088820889208902089120892208932089420895208962089720898208992090020901209022090320904209052090620907209082090920910209112091220913209142091520916209172091820919209202092120922209232092420925209262092720928209292093020931209322093320934209352093620937209382093920940209412094220943209442094520946209472094820949209502095120952209532095420955209562095720958209592096020961209622096320964209652096620967209682096920970209712097220973209742097520976209772097820979209802098120982209832098420985209862098720988209892099020991209922099320994209952099620997209982099921000210012100221003210042100521006210072100821009210102101121012210132101421015210162101721018210192102021021210222102321024210252102621027210282102921030210312103221033210342103521036210372103821039210402104121042210432104421045210462104721048210492105021051210522105321054210552105621057210582105921060210612106221063210642106521066210672106821069210702107121072210732107421075210762107721078210792108021081210822108321084210852108621087210882108921090210912109221093210942109521096210972109821099211002110121102211032110421105211062110721108211092111021111211122111321114211152111621117211182111921120211212112221123211242112521126211272112821129211302113121132211332113421135211362113721138211392114021141211422114321144211452114621147211482114921150211512115221153211542115521156211572115821159211602116121162211632116421165211662116721168211692117021171211722117321174211752117621177211782117921180211812118221183211842118521186211872118821189211902119121192211932119421195211962119721198211992120021201212022120321204212052120621207212082120921210212112121221213212142121521216212172121821219212202122121222212232122421225212262122721228212292123021231212322123321234212352123621237212382123921240212412124221243212442124521246212472124821249212502125121252212532125421255212562125721258212592126021261212622126321264212652126621267212682126921270212712127221273212742127521276212772127821279212802128121282212832128421285212862128721288212892129021291212922129321294212952129621297212982129921300213012130221303213042130521306213072130821309213102131121312213132131421315213162131721318213192132021321213222132321324213252132621327213282132921330213312133221333213342133521336213372133821339213402134121342213432134421345213462134721348213492135021351213522135321354213552135621357213582135921360213612136221363213642136521366213672136821369213702137121372213732137421375213762137721378213792138021381213822138321384213852138621387213882138921390213912139221393213942139521396213972139821399214002140121402214032140421405214062140721408214092141021411214122141321414214152141621417214182141921420214212142221423214242142521426214272142821429214302143121432214332143421435214362143721438214392144021441214422144321444214452144621447214482144921450214512145221453214542145521456214572145821459214602146121462214632146421465214662146721468214692147021471214722147321474214752147621477214782147921480214812148221483214842148521486214872148821489214902149121492214932149421495214962149721498214992150021501215022150321504215052150621507215082150921510215112151221513215142151521516215172151821519215202152121522215232152421525215262152721528215292153021531215322153321534215352153621537215382153921540215412154221543215442154521546215472154821549215502155121552215532155421555215562155721558215592156021561215622156321564215652156621567215682156921570215712157221573215742157521576215772157821579215802158121582215832158421585215862158721588215892159021591215922159321594215952159621597215982159921600216012160221603216042160521606216072160821609216102161121612216132161421615216162161721618216192162021621216222162321624216252162621627216282162921630216312163221633216342163521636216372163821639216402164121642216432164421645216462164721648216492165021651216522165321654216552165621657216582165921660216612166221663216642166521666216672166821669216702167121672216732167421675216762167721678216792168021681216822168321684216852168621687216882168921690216912169221693216942169521696216972169821699217002170121702217032170421705217062170721708217092171021711217122171321714217152171621717217182171921720217212172221723217242172521726217272172821729217302173121732217332173421735217362173721738217392174021741217422174321744217452174621747217482174921750217512175221753217542175521756217572175821759217602176121762217632176421765217662176721768217692177021771217722177321774217752177621777217782177921780217812178221783217842178521786217872178821789217902179121792217932179421795217962179721798217992180021801218022180321804218052180621807218082180921810218112181221813218142181521816218172181821819218202182121822218232182421825218262182721828218292183021831218322183321834218352183621837218382183921840218412184221843218442184521846218472184821849218502185121852218532185421855218562185721858218592186021861218622186321864218652186621867218682186921870218712187221873218742187521876218772187821879218802188121882218832188421885218862188721888218892189021891218922189321894218952189621897218982189921900219012190221903219042190521906219072190821909219102191121912219132191421915219162191721918219192192021921219222192321924219252192621927219282192921930219312193221933219342193521936219372193821939219402194121942219432194421945219462194721948219492195021951219522195321954219552195621957219582195921960219612196221963219642196521966219672196821969219702197121972219732197421975219762197721978219792198021981219822198321984219852198621987219882198921990219912199221993219942199521996219972199821999220002200122002220032200422005220062200722008220092201022011220122201322014220152201622017220182201922020220212202222023220242202522026220272202822029220302203122032220332203422035220362203722038220392204022041220422204322044220452204622047220482204922050220512205222053220542205522056220572205822059220602206122062220632206422065220662206722068220692207022071220722207322074220752207622077220782207922080220812208222083220842208522086220872208822089220902209122092220932209422095220962209722098220992210022101221022210322104221052210622107221082210922110221112211222113221142211522116221172211822119221202212122122221232212422125221262212722128221292213022131221322213322134221352213622137221382213922140221412214222143221442214522146221472214822149221502215122152221532215422155221562215722158221592216022161221622216322164221652216622167221682216922170221712217222173221742217522176221772217822179221802218122182221832218422185221862218722188221892219022191221922219322194221952219622197221982219922200222012220222203222042220522206222072220822209222102221122212222132221422215222162221722218222192222022221222222222322224222252222622227222282222922230222312223222233222342223522236222372223822239222402224122242222432224422245222462224722248222492225022251222522225322254222552225622257222582225922260222612226222263222642226522266222672226822269222702227122272222732227422275222762227722278222792228022281222822228322284222852228622287222882228922290222912229222293222942229522296222972229822299223002230122302223032230422305223062230722308223092231022311223122231322314223152231622317223182231922320223212232222323223242232522326223272232822329223302233122332223332233422335223362233722338223392234022341223422234322344223452234622347223482234922350223512235222353223542235522356223572235822359223602236122362223632236422365223662236722368223692237022371223722237322374223752237622377223782237922380223812238222383223842238522386223872238822389223902239122392223932239422395223962239722398223992240022401224022240322404224052240622407224082240922410224112241222413224142241522416224172241822419224202242122422224232242422425224262242722428224292243022431224322243322434224352243622437224382243922440224412244222443224442244522446224472244822449224502245122452224532245422455224562245722458224592246022461224622246322464224652246622467224682246922470224712247222473224742247522476224772247822479224802248122482224832248422485224862248722488224892249022491224922249322494224952249622497224982249922500225012250222503225042250522506225072250822509225102251122512225132251422515225162251722518225192252022521225222252322524225252252622527225282252922530225312253222533225342253522536225372253822539225402254122542225432254422545225462254722548225492255022551225522255322554225552255622557225582255922560225612256222563225642256522566225672256822569225702257122572225732257422575225762257722578225792258022581225822258322584225852258622587225882258922590225912259222593225942259522596225972259822599226002260122602226032260422605226062260722608226092261022611226122261322614226152261622617226182261922620226212262222623226242262522626226272262822629226302263122632226332263422635226362263722638226392264022641226422264322644226452264622647226482264922650226512265222653226542265522656226572265822659226602266122662226632266422665226662266722668226692267022671226722267322674226752267622677226782267922680226812268222683226842268522686226872268822689226902269122692226932269422695226962269722698226992270022701227022270322704227052270622707227082270922710227112271222713227142271522716227172271822719227202272122722227232272422725227262272722728227292273022731227322273322734227352273622737227382273922740227412274222743227442274522746227472274822749227502275122752227532275422755227562275722758227592276022761227622276322764227652276622767227682276922770227712277222773227742277522776227772277822779227802278122782227832278422785227862278722788227892279022791227922279322794227952279622797227982279922800228012280222803228042280522806228072280822809228102281122812228132281422815228162281722818228192282022821228222282322824228252282622827228282282922830228312283222833228342283522836228372283822839228402284122842228432284422845228462284722848228492285022851228522285322854228552285622857228582285922860228612286222863228642286522866228672286822869228702287122872228732287422875228762287722878228792288022881228822288322884228852288622887228882288922890228912289222893228942289522896228972289822899229002290122902229032290422905229062290722908229092291022911229122291322914229152291622917229182291922920229212292222923229242292522926229272292822929229302293122932229332293422935229362293722938229392294022941229422294322944229452294622947229482294922950229512295222953229542295522956229572295822959229602296122962229632296422965229662296722968229692297022971229722297322974229752297622977229782297922980229812298222983229842298522986229872298822989229902299122992229932299422995229962299722998229992300023001230022300323004230052300623007230082300923010230112301223013230142301523016230172301823019230202302123022230232302423025230262302723028230292303023031230322303323034230352303623037230382303923040230412304223043230442304523046230472304823049230502305123052230532305423055230562305723058230592306023061230622306323064230652306623067230682306923070230712307223073230742307523076230772307823079230802308123082230832308423085230862308723088230892309023091230922309323094230952309623097230982309923100231012310223103231042310523106231072310823109231102311123112231132311423115231162311723118231192312023121231222312323124231252312623127231282312923130231312313223133231342313523136231372313823139231402314123142231432314423145231462314723148231492315023151231522315323154231552315623157231582315923160231612316223163231642316523166231672316823169231702317123172231732317423175231762317723178231792318023181231822318323184231852318623187231882318923190231912319223193231942319523196231972319823199232002320123202232032320423205232062320723208232092321023211232122321323214232152321623217232182321923220232212322223223232242322523226232272322823229232302323123232232332323423235232362323723238232392324023241232422324323244232452324623247232482324923250232512325223253232542325523256232572325823259232602326123262232632326423265232662326723268232692327023271232722327323274232752327623277232782327923280232812328223283232842328523286232872328823289232902329123292232932329423295232962329723298232992330023301233022330323304233052330623307233082330923310233112331223313233142331523316233172331823319233202332123322233232332423325233262332723328233292333023331233322333323334233352333623337233382333923340233412334223343233442334523346233472334823349233502335123352233532335423355233562335723358233592336023361233622336323364233652336623367233682336923370233712337223373233742337523376233772337823379233802338123382233832338423385233862338723388233892339023391233922339323394233952339623397233982339923400234012340223403234042340523406234072340823409234102341123412234132341423415234162341723418234192342023421234222342323424234252342623427234282342923430234312343223433234342343523436234372343823439234402344123442234432344423445234462344723448234492345023451234522345323454234552345623457234582345923460234612346223463234642346523466234672346823469234702347123472234732347423475234762347723478234792348023481234822348323484234852348623487234882348923490234912349223493234942349523496234972349823499235002350123502235032350423505235062350723508235092351023511235122351323514235152351623517235182351923520235212352223523235242352523526235272352823529235302353123532235332353423535235362353723538235392354023541235422354323544235452354623547235482354923550235512355223553235542355523556235572355823559235602356123562235632356423565235662356723568235692357023571235722357323574235752357623577235782357923580235812358223583235842358523586235872358823589235902359123592235932359423595235962359723598235992360023601236022360323604236052360623607236082360923610236112361223613236142361523616236172361823619236202362123622236232362423625236262362723628236292363023631236322363323634236352363623637236382363923640236412364223643236442364523646236472364823649236502365123652236532365423655236562365723658236592366023661236622366323664236652366623667236682366923670236712367223673236742367523676236772367823679236802368123682236832368423685236862368723688236892369023691236922369323694236952369623697236982369923700237012370223703237042370523706237072370823709237102371123712237132371423715237162371723718237192372023721237222372323724237252372623727237282372923730237312373223733237342373523736237372373823739237402374123742237432374423745237462374723748237492375023751237522375323754237552375623757237582375923760237612376223763237642376523766237672376823769237702377123772237732377423775237762377723778237792378023781237822378323784237852378623787237882378923790237912379223793237942379523796237972379823799238002380123802238032380423805238062380723808238092381023811238122381323814238152381623817238182381923820238212382223823238242382523826238272382823829238302383123832238332383423835238362383723838238392384023841238422384323844238452384623847238482384923850238512385223853238542385523856238572385823859238602386123862238632386423865238662386723868238692387023871238722387323874238752387623877238782387923880238812388223883238842388523886238872388823889238902389123892238932389423895238962389723898238992390023901239022390323904239052390623907239082390923910239112391223913239142391523916239172391823919239202392123922239232392423925239262392723928239292393023931239322393323934239352393623937239382393923940239412394223943239442394523946239472394823949239502395123952239532395423955239562395723958239592396023961239622396323964239652396623967239682396923970239712397223973239742397523976239772397823979239802398123982239832398423985239862398723988239892399023991239922399323994239952399623997239982399924000240012400224003240042400524006240072400824009240102401124012240132401424015240162401724018240192402024021240222402324024240252402624027240282402924030240312403224033240342403524036240372403824039240402404124042240432404424045240462404724048240492405024051240522405324054240552405624057240582405924060240612406224063240642406524066240672406824069240702407124072240732407424075240762407724078240792408024081240822408324084240852408624087240882408924090240912409224093240942409524096240972409824099241002410124102241032410424105241062410724108241092411024111241122411324114241152411624117241182411924120241212412224123241242412524126241272412824129241302413124132241332413424135241362413724138241392414024141241422414324144241452414624147241482414924150241512415224153241542415524156241572415824159241602416124162241632416424165241662416724168241692417024171241722417324174241752417624177241782417924180241812418224183241842418524186241872418824189241902419124192241932419424195241962419724198241992420024201242022420324204242052420624207242082420924210242112421224213242142421524216242172421824219242202422124222242232422424225242262422724228242292423024231242322423324234242352423624237242382423924240242412424224243242442424524246242472424824249242502425124252242532425424255242562425724258242592426024261242622426324264242652426624267242682426924270242712427224273242742427524276242772427824279242802428124282242832428424285242862428724288242892429024291242922429324294242952429624297242982429924300243012430224303243042430524306243072430824309243102431124312243132431424315243162431724318243192432024321243222432324324243252432624327243282432924330243312433224333243342433524336243372433824339243402434124342243432434424345243462434724348243492435024351243522435324354243552435624357243582435924360243612436224363243642436524366243672436824369243702437124372243732437424375243762437724378243792438024381243822438324384243852438624387243882438924390243912439224393243942439524396243972439824399244002440124402244032440424405244062440724408244092441024411244122441324414244152441624417244182441924420244212442224423244242442524426244272442824429244302443124432244332443424435244362443724438244392444024441244422444324444244452444624447244482444924450244512445224453244542445524456244572445824459244602446124462244632446424465244662446724468244692447024471244722447324474244752447624477244782447924480244812448224483244842448524486244872448824489244902449124492244932449424495244962449724498244992450024501245022450324504245052450624507245082450924510245112451224513245142451524516245172451824519245202452124522245232452424525245262452724528245292453024531245322453324534245352453624537245382453924540245412454224543245442454524546245472454824549245502455124552245532455424555245562455724558245592456024561245622456324564245652456624567245682456924570245712457224573245742457524576245772457824579245802458124582245832458424585245862458724588245892459024591245922459324594245952459624597245982459924600246012460224603246042460524606246072460824609246102461124612246132461424615246162461724618246192462024621246222462324624246252462624627246282462924630246312463224633246342463524636246372463824639246402464124642246432464424645246462464724648246492465024651246522465324654246552465624657246582465924660246612466224663246642466524666246672466824669246702467124672246732467424675246762467724678246792468024681246822468324684246852468624687246882468924690246912469224693246942469524696246972469824699247002470124702247032470424705247062470724708247092471024711247122471324714247152471624717247182471924720247212472224723247242472524726247272472824729247302473124732247332473424735247362473724738247392474024741247422474324744247452474624747247482474924750247512475224753247542475524756247572475824759247602476124762247632476424765247662476724768247692477024771247722477324774247752477624777247782477924780247812478224783247842478524786247872478824789247902479124792247932479424795247962479724798247992480024801248022480324804248052480624807248082480924810248112481224813248142481524816248172481824819248202482124822248232482424825248262482724828248292483024831248322483324834248352483624837248382483924840248412484224843248442484524846248472484824849248502485124852248532485424855248562485724858248592486024861248622486324864248652486624867248682486924870248712487224873248742487524876248772487824879248802488124882248832488424885248862488724888248892489024891248922489324894248952489624897248982489924900249012490224903249042490524906249072490824909249102491124912249132491424915249162491724918249192492024921249222492324924249252492624927249282492924930249312493224933249342493524936249372493824939249402494124942249432494424945249462494724948249492495024951249522495324954249552495624957249582495924960249612496224963249642496524966249672496824969249702497124972249732497424975249762497724978249792498024981249822498324984249852498624987249882498924990249912499224993249942499524996249972499824999250002500125002250032500425005250062500725008250092501025011250122501325014250152501625017250182501925020250212502225023250242502525026250272502825029250302503125032250332503425035250362503725038250392504025041250422504325044250452504625047250482504925050250512505225053250542505525056250572505825059250602506125062250632506425065250662506725068250692507025071250722507325074250752507625077250782507925080250812508225083250842508525086250872508825089250902509125092250932509425095250962509725098250992510025101251022510325104251052510625107251082510925110251112511225113251142511525116251172511825119251202512125122251232512425125251262512725128251292513025131251322513325134251352513625137251382513925140251412514225143251442514525146251472514825149251502515125152251532515425155251562515725158251592516025161251622516325164251652516625167251682516925170251712517225173251742517525176251772517825179251802518125182251832518425185251862518725188251892519025191251922519325194251952519625197251982519925200252012520225203252042520525206252072520825209252102521125212252132521425215252162521725218252192522025221252222522325224252252522625227252282522925230252312523225233252342523525236252372523825239252402524125242252432524425245252462524725248252492525025251252522525325254252552525625257252582525925260252612526225263252642526525266252672526825269252702527125272252732527425275252762527725278252792528025281252822528325284252852528625287252882528925290252912529225293252942529525296252972529825299253002530125302253032530425305253062530725308253092531025311253122531325314253152531625317253182531925320253212532225323253242532525326253272532825329253302533125332253332533425335253362533725338253392534025341253422534325344253452534625347253482534925350253512535225353253542535525356253572535825359253602536125362253632536425365253662536725368253692537025371253722537325374253752537625377253782537925380253812538225383253842538525386253872538825389253902539125392253932539425395253962539725398253992540025401254022540325404254052540625407254082540925410254112541225413254142541525416254172541825419254202542125422254232542425425254262542725428254292543025431254322543325434254352543625437254382543925440254412544225443254442544525446254472544825449254502545125452254532545425455254562545725458254592546025461254622546325464254652546625467254682546925470254712547225473254742547525476254772547825479254802548125482254832548425485254862548725488254892549025491254922549325494254952549625497254982549925500255012550225503255042550525506255072550825509255102551125512255132551425515255162551725518255192552025521255222552325524255252552625527255282552925530255312553225533255342553525536255372553825539255402554125542255432554425545255462554725548255492555025551255522555325554255552555625557255582555925560255612556225563255642556525566255672556825569255702557125572255732557425575255762557725578255792558025581255822558325584255852558625587255882558925590255912559225593255942559525596255972559825599256002560125602256032560425605256062560725608256092561025611256122561325614256152561625617256182561925620256212562225623256242562525626256272562825629256302563125632256332563425635256362563725638256392564025641256422564325644256452564625647256482564925650256512565225653256542565525656256572565825659256602566125662256632566425665256662566725668256692567025671256722567325674256752567625677256782567925680256812568225683256842568525686256872568825689256902569125692256932569425695256962569725698256992570025701257022570325704257052570625707257082570925710257112571225713257142571525716257172571825719257202572125722257232572425725257262572725728257292573025731257322573325734257352573625737257382573925740257412574225743257442574525746257472574825749257502575125752257532575425755257562575725758257592576025761257622576325764257652576625767257682576925770257712577225773257742577525776257772577825779257802578125782257832578425785257862578725788257892579025791257922579325794257952579625797257982579925800258012580225803258042580525806258072580825809258102581125812258132581425815258162581725818258192582025821258222582325824258252582625827258282582925830258312583225833258342583525836258372583825839258402584125842258432584425845258462584725848258492585025851258522585325854258552585625857258582585925860258612586225863258642586525866258672586825869258702587125872258732587425875258762587725878258792588025881258822588325884258852588625887258882588925890258912589225893258942589525896258972589825899259002590125902259032590425905259062590725908259092591025911259122591325914259152591625917259182591925920259212592225923259242592525926259272592825929259302593125932259332593425935259362593725938259392594025941259422594325944259452594625947259482594925950259512595225953259542595525956259572595825959259602596125962259632596425965259662596725968259692597025971259722597325974259752597625977259782597925980259812598225983259842598525986259872598825989259902599125992259932599425995259962599725998259992600026001260022600326004260052600626007260082600926010260112601226013260142601526016260172601826019260202602126022260232602426025260262602726028260292603026031260322603326034260352603626037260382603926040260412604226043260442604526046260472604826049260502605126052260532605426055260562605726058260592606026061260622606326064260652606626067260682606926070260712607226073260742607526076260772607826079260802608126082260832608426085260862608726088260892609026091260922609326094260952609626097260982609926100261012610226103261042610526106261072610826109261102611126112261132611426115261162611726118261192612026121261222612326124261252612626127261282612926130261312613226133261342613526136261372613826139261402614126142261432614426145261462614726148261492615026151261522615326154261552615626157261582615926160261612616226163261642616526166261672616826169261702617126172261732617426175261762617726178261792618026181261822618326184261852618626187261882618926190261912619226193261942619526196261972619826199262002620126202262032620426205262062620726208262092621026211262122621326214262152621626217262182621926220262212622226223262242622526226262272622826229262302623126232262332623426235262362623726238262392624026241262422624326244262452624626247262482624926250262512625226253262542625526256262572625826259262602626126262262632626426265262662626726268262692627026271262722627326274262752627626277262782627926280262812628226283262842628526286262872628826289262902629126292262932629426295262962629726298262992630026301263022630326304263052630626307263082630926310263112631226313263142631526316263172631826319263202632126322263232632426325263262632726328263292633026331263322633326334263352633626337263382633926340263412634226343263442634526346263472634826349263502635126352263532635426355263562635726358263592636026361263622636326364263652636626367263682636926370263712637226373263742637526376263772637826379263802638126382263832638426385263862638726388263892639026391263922639326394263952639626397263982639926400264012640226403264042640526406264072640826409264102641126412264132641426415264162641726418264192642026421264222642326424264252642626427264282642926430264312643226433264342643526436264372643826439264402644126442264432644426445264462644726448264492645026451264522645326454264552645626457264582645926460264612646226463264642646526466264672646826469264702647126472264732647426475264762647726478264792648026481264822648326484264852648626487264882648926490264912649226493264942649526496264972649826499265002650126502265032650426505265062650726508265092651026511265122651326514265152651626517265182651926520265212652226523265242652526526265272652826529265302653126532265332653426535265362653726538265392654026541265422654326544265452654626547265482654926550265512655226553265542655526556265572655826559265602656126562265632656426565265662656726568265692657026571265722657326574265752657626577265782657926580265812658226583265842658526586265872658826589265902659126592265932659426595265962659726598265992660026601266022660326604266052660626607266082660926610266112661226613266142661526616266172661826619266202662126622266232662426625266262662726628266292663026631266322663326634266352663626637266382663926640266412664226643266442664526646266472664826649266502665126652266532665426655266562665726658266592666026661266622666326664266652666626667266682666926670266712667226673266742667526676266772667826679266802668126682266832668426685266862668726688266892669026691266922669326694266952669626697266982669926700267012670226703267042670526706267072670826709267102671126712267132671426715267162671726718267192672026721267222672326724267252672626727267282672926730267312673226733267342673526736267372673826739267402674126742267432674426745267462674726748267492675026751267522675326754267552675626757267582675926760267612676226763267642676526766267672676826769267702677126772267732677426775267762677726778267792678026781267822678326784267852678626787267882678926790267912679226793267942679526796267972679826799268002680126802268032680426805268062680726808268092681026811268122681326814268152681626817268182681926820268212682226823268242682526826268272682826829268302683126832268332683426835268362683726838268392684026841268422684326844268452684626847268482684926850268512685226853268542685526856268572685826859268602686126862268632686426865268662686726868268692687026871268722687326874268752687626877268782687926880268812688226883268842688526886268872688826889268902689126892268932689426895268962689726898268992690026901269022690326904269052690626907269082690926910269112691226913269142691526916269172691826919269202692126922269232692426925269262692726928269292693026931269322693326934269352693626937269382693926940269412694226943269442694526946269472694826949269502695126952269532695426955269562695726958269592696026961269622696326964269652696626967269682696926970269712697226973269742697526976269772697826979269802698126982269832698426985269862698726988269892699026991269922699326994269952699626997269982699927000270012700227003270042700527006270072700827009270102701127012270132701427015270162701727018270192702027021270222702327024270252702627027270282702927030270312703227033270342703527036270372703827039270402704127042270432704427045270462704727048270492705027051270522705327054270552705627057270582705927060270612706227063270642706527066270672706827069270702707127072270732707427075270762707727078270792708027081270822708327084270852708627087270882708927090270912709227093270942709527096270972709827099271002710127102271032710427105271062710727108271092711027111271122711327114271152711627117271182711927120271212712227123271242712527126271272712827129271302713127132271332713427135271362713727138271392714027141271422714327144271452714627147271482714927150271512715227153271542715527156271572715827159271602716127162271632716427165271662716727168271692717027171271722717327174271752717627177271782717927180271812718227183271842718527186271872718827189271902719127192271932719427195271962719727198271992720027201272022720327204272052720627207272082720927210272112721227213272142721527216272172721827219272202722127222272232722427225272262722727228272292723027231272322723327234272352723627237272382723927240272412724227243272442724527246272472724827249272502725127252272532725427255272562725727258272592726027261272622726327264272652726627267272682726927270272712727227273272742727527276272772727827279272802728127282272832728427285272862728727288272892729027291272922729327294272952729627297272982729927300273012730227303273042730527306273072730827309273102731127312273132731427315273162731727318273192732027321273222732327324273252732627327273282732927330273312733227333273342733527336273372733827339273402734127342273432734427345273462734727348273492735027351273522735327354273552735627357273582735927360273612736227363273642736527366273672736827369273702737127372273732737427375273762737727378273792738027381273822738327384273852738627387273882738927390273912739227393273942739527396273972739827399274002740127402274032740427405274062740727408274092741027411274122741327414274152741627417274182741927420274212742227423274242742527426274272742827429274302743127432274332743427435274362743727438274392744027441274422744327444274452744627447274482744927450274512745227453274542745527456274572745827459274602746127462274632746427465274662746727468274692747027471274722747327474274752747627477274782747927480274812748227483274842748527486274872748827489274902749127492274932749427495274962749727498274992750027501275022750327504275052750627507275082750927510275112751227513275142751527516275172751827519275202752127522275232752427525275262752727528275292753027531275322753327534275352753627537275382753927540275412754227543275442754527546275472754827549275502755127552275532755427555275562755727558275592756027561275622756327564275652756627567275682756927570275712757227573275742757527576275772757827579275802758127582275832758427585275862758727588275892759027591275922759327594275952759627597275982759927600276012760227603276042760527606276072760827609276102761127612276132761427615276162761727618276192762027621276222762327624276252762627627276282762927630276312763227633276342763527636276372763827639276402764127642276432764427645276462764727648276492765027651276522765327654276552765627657276582765927660276612766227663276642766527666276672766827669276702767127672276732767427675276762767727678276792768027681276822768327684276852768627687276882768927690276912769227693276942769527696276972769827699277002770127702277032770427705277062770727708277092771027711277122771327714277152771627717277182771927720277212772227723277242772527726277272772827729277302773127732277332773427735277362773727738277392774027741277422774327744277452774627747277482774927750277512775227753277542775527756277572775827759277602776127762277632776427765277662776727768277692777027771277722777327774277752777627777277782777927780277812778227783277842778527786277872778827789277902779127792277932779427795277962779727798277992780027801278022780327804278052780627807278082780927810278112781227813278142781527816278172781827819278202782127822278232782427825278262782727828278292783027831278322783327834278352783627837278382783927840278412784227843278442784527846278472784827849278502785127852278532785427855278562785727858278592786027861278622786327864278652786627867278682786927870278712787227873278742787527876278772787827879278802788127882278832788427885278862788727888278892789027891278922789327894278952789627897278982789927900279012790227903279042790527906279072790827909279102791127912279132791427915279162791727918279192792027921279222792327924279252792627927279282792927930279312793227933279342793527936279372793827939279402794127942279432794427945279462794727948279492795027951279522795327954279552795627957279582795927960279612796227963279642796527966279672796827969279702797127972279732797427975279762797727978279792798027981279822798327984279852798627987279882798927990279912799227993279942799527996279972799827999280002800128002280032800428005280062800728008280092801028011280122801328014280152801628017280182801928020280212802228023280242802528026280272802828029280302803128032280332803428035280362803728038280392804028041280422804328044280452804628047280482804928050280512805228053280542805528056280572805828059280602806128062280632806428065280662806728068280692807028071280722807328074280752807628077280782807928080280812808228083280842808528086280872808828089280902809128092280932809428095280962809728098280992810028101281022810328104281052810628107281082810928110281112811228113281142811528116281172811828119281202812128122281232812428125281262812728128281292813028131281322813328134281352813628137281382813928140281412814228143281442814528146281472814828149281502815128152281532815428155281562815728158281592816028161281622816328164281652816628167281682816928170281712817228173281742817528176281772817828179281802818128182281832818428185281862818728188281892819028191281922819328194281952819628197281982819928200282012820228203282042820528206282072820828209282102821128212282132821428215282162821728218282192822028221282222822328224282252822628227282282822928230282312823228233282342823528236282372823828239282402824128242282432824428245282462824728248282492825028251282522825328254282552825628257282582825928260282612826228263282642826528266282672826828269282702827128272282732827428275282762827728278282792828028281282822828328284282852828628287282882828928290282912829228293282942829528296282972829828299283002830128302283032830428305283062830728308283092831028311283122831328314283152831628317283182831928320283212832228323283242832528326283272832828329283302833128332283332833428335283362833728338283392834028341283422834328344283452834628347283482834928350283512835228353283542835528356283572835828359283602836128362283632836428365283662836728368283692837028371283722837328374283752837628377283782837928380283812838228383283842838528386283872838828389283902839128392283932839428395283962839728398283992840028401284022840328404284052840628407284082840928410284112841228413284142841528416284172841828419284202842128422284232842428425284262842728428284292843028431284322843328434284352843628437284382843928440284412844228443284442844528446284472844828449284502845128452284532845428455284562845728458284592846028461284622846328464284652846628467284682846928470284712847228473284742847528476284772847828479284802848128482284832848428485284862848728488284892849028491284922849328494284952849628497284982849928500285012850228503285042850528506285072850828509285102851128512285132851428515285162851728518285192852028521285222852328524285252852628527285282852928530285312853228533285342853528536285372853828539285402854128542285432854428545285462854728548285492855028551285522855328554285552855628557285582855928560285612856228563285642856528566285672856828569285702857128572285732857428575285762857728578285792858028581285822858328584285852858628587285882858928590285912859228593285942859528596285972859828599286002860128602286032860428605286062860728608286092861028611286122861328614286152861628617286182861928620286212862228623286242862528626286272862828629286302863128632286332863428635286362863728638286392864028641286422864328644286452864628647286482864928650286512865228653286542865528656286572865828659286602866128662286632866428665286662866728668286692867028671286722867328674286752867628677286782867928680286812868228683286842868528686286872868828689286902869128692286932869428695286962869728698286992870028701287022870328704287052870628707287082870928710287112871228713287142871528716287172871828719287202872128722287232872428725287262872728728287292873028731287322873328734287352873628737287382873928740287412874228743287442874528746287472874828749287502875128752287532875428755287562875728758287592876028761287622876328764287652876628767287682876928770287712877228773287742877528776287772877828779287802878128782287832878428785287862878728788287892879028791287922879328794287952879628797287982879928800288012880228803288042880528806288072880828809288102881128812288132881428815288162881728818288192882028821288222882328824288252882628827288282882928830288312883228833288342883528836288372883828839288402884128842288432884428845288462884728848288492885028851288522885328854288552885628857288582885928860288612886228863288642886528866288672886828869288702887128872288732887428875288762887728878288792888028881288822888328884288852888628887288882888928890288912889228893288942889528896288972889828899289002890128902289032890428905289062890728908289092891028911289122891328914289152891628917289182891928920289212892228923289242892528926289272892828929289302893128932289332893428935289362893728938289392894028941289422894328944289452894628947289482894928950289512895228953289542895528956289572895828959289602896128962289632896428965289662896728968289692897028971289722897328974289752897628977289782897928980289812898228983289842898528986289872898828989289902899128992289932899428995289962899728998289992900029001290022900329004290052900629007290082900929010290112901229013290142901529016290172901829019290202902129022290232902429025290262902729028290292903029031290322903329034290352903629037290382903929040290412904229043290442904529046290472904829049290502905129052290532905429055290562905729058290592906029061290622906329064290652906629067290682906929070290712907229073290742907529076290772907829079290802908129082290832908429085290862908729088290892909029091290922909329094290952909629097290982909929100291012910229103291042910529106291072910829109291102911129112291132911429115291162911729118291192912029121291222912329124291252912629127291282912929130291312913229133291342913529136291372913829139291402914129142291432914429145291462914729148291492915029151291522915329154291552915629157291582915929160291612916229163291642916529166291672916829169291702917129172291732917429175291762917729178291792918029181291822918329184291852918629187291882918929190291912919229193291942919529196291972919829199292002920129202292032920429205292062920729208292092921029211292122921329214292152921629217292182921929220292212922229223292242922529226292272922829229292302923129232292332923429235292362923729238292392924029241292422924329244292452924629247292482924929250292512925229253292542925529256292572925829259292602926129262292632926429265292662926729268292692927029271292722927329274292752927629277292782927929280292812928229283292842928529286292872928829289292902929129292292932929429295292962929729298292992930029301293022930329304293052930629307293082930929310293112931229313293142931529316293172931829319293202932129322293232932429325293262932729328293292933029331293322933329334293352933629337293382933929340293412934229343293442934529346293472934829349293502935129352293532935429355293562935729358293592936029361293622936329364293652936629367293682936929370293712937229373293742937529376293772937829379293802938129382293832938429385293862938729388293892939029391293922939329394293952939629397293982939929400294012940229403294042940529406294072940829409294102941129412294132941429415294162941729418294192942029421294222942329424294252942629427294282942929430294312943229433294342943529436294372943829439294402944129442294432944429445294462944729448294492945029451294522945329454294552945629457294582945929460294612946229463294642946529466294672946829469294702947129472294732947429475294762947729478294792948029481294822948329484294852948629487294882948929490294912949229493294942949529496294972949829499295002950129502295032950429505295062950729508295092951029511295122951329514295152951629517295182951929520295212952229523295242952529526295272952829529295302953129532295332953429535295362953729538295392954029541295422954329544295452954629547295482954929550295512955229553295542955529556295572955829559295602956129562295632956429565295662956729568295692957029571295722957329574295752957629577295782957929580295812958229583295842958529586295872958829589295902959129592295932959429595295962959729598295992960029601296022960329604296052960629607296082960929610296112961229613296142961529616296172961829619296202962129622296232962429625296262962729628296292963029631296322963329634296352963629637296382963929640296412964229643296442964529646296472964829649296502965129652296532965429655296562965729658296592966029661296622966329664296652966629667296682966929670296712967229673296742967529676296772967829679296802968129682296832968429685296862968729688296892969029691296922969329694296952969629697296982969929700297012970229703297042970529706297072970829709297102971129712297132971429715297162971729718297192972029721297222972329724297252972629727297282972929730297312973229733297342973529736297372973829739297402974129742297432974429745297462974729748297492975029751297522975329754297552975629757297582975929760297612976229763297642976529766297672976829769297702977129772297732977429775297762977729778297792978029781297822978329784297852978629787297882978929790297912979229793297942979529796297972979829799298002980129802298032980429805298062980729808298092981029811298122981329814298152981629817298182981929820298212982229823298242982529826298272982829829298302983129832298332983429835298362983729838298392984029841298422984329844298452984629847298482984929850298512985229853298542985529856298572985829859298602986129862298632986429865298662986729868298692987029871298722987329874298752987629877298782987929880298812988229883298842988529886298872988829889298902989129892298932989429895298962989729898298992990029901299022990329904299052990629907299082990929910299112991229913299142991529916299172991829919299202992129922299232992429925299262992729928299292993029931299322993329934299352993629937299382993929940299412994229943299442994529946299472994829949299502995129952299532995429955299562995729958299592996029961299622996329964299652996629967299682996929970299712997229973299742997529976299772997829979299802998129982299832998429985299862998729988299892999029991299922999329994299952999629997299982999930000300013000230003300043000530006300073000830009300103001130012300133001430015300163001730018300193002030021300223002330024300253002630027300283002930030300313003230033300343003530036300373003830039300403004130042300433004430045300463004730048300493005030051300523005330054300553005630057300583005930060300613006230063300643006530066300673006830069300703007130072300733007430075300763007730078300793008030081300823008330084300853008630087300883008930090300913009230093300943009530096300973009830099301003010130102301033010430105301063010730108301093011030111301123011330114301153011630117301183011930120301213012230123301243012530126301273012830129301303013130132301333013430135301363013730138301393014030141301423014330144301453014630147301483014930150301513015230153301543015530156301573015830159301603016130162301633016430165301663016730168301693017030171301723017330174301753017630177301783017930180301813018230183301843018530186301873018830189301903019130192301933019430195301963019730198301993020030201302023020330204302053020630207302083020930210302113021230213302143021530216302173021830219302203022130222302233022430225302263022730228302293023030231302323023330234302353023630237302383023930240302413024230243302443024530246
  1. {
  2. This file is part of the Free Component Library
  3. Pascal resolver
  4. Copyright (c) 2020 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. - generics
  244. - array of const
  245. - attributes
  246. ToDo:
  247. - operator overload
  248. - operator enumerator
  249. - binaryexpr
  250. - advanced records
  251. - Include/Exclude for set of int/char/bool
  252. - error if property method resolution is not used
  253. - $H-hintpos$H+
  254. - $pop, $push
  255. - $RTTI inherited|explicit
  256. - range checking:
  257. - property defaultvalue
  258. - IntSet:=[-1]
  259. - CharSet:=[#13]
  260. - proc: check if forward and impl default values match
  261. - call array of proc without ()
  262. - generics, nested param lists
  263. - object
  264. - futures
  265. - TPasFileType
  266. - labels
  267. - $zerobasedstrings on|off
  268. - FOR_LOOP_VAR_VARPAR passing a loop var to a var parameter gives a warning
  269. - FOR_VARIABLE warning if using a global var as loop var
  270. - COMPARISON_FALSE COMPARISON_TRUE Comparison always evaluates to False
  271. - USE_BEFORE_DEF Variable '%s' might not have been initialized
  272. - FOR_LOOP_VAR_UNDEF FOR-Loop variable '%s' may be undefined after loop
  273. - TYPEINFO_IMPLICITLY_ADDED Published caused RTTI ($M+) to be added to type '%s'
  274. - IMPLICIT_STRING_CAST Implicit string cast from '%s' to '%s'
  275. - IMPLICIT_STRING_CAST_LOSS Implicit string cast with potential data loss from '%s' to '%s'
  276. - off by default: EXPLICIT_STRING_CAST Explicit string cast from '%s' to '%s'
  277. - off by default: EXPLICIT_STRING_CAST_LOSS Explicit string cast with potential data loss from '%s' to '%s'
  278. - IMPLICIT_INTEGER_CAST_LOSS Implicit integer cast with potential data loss from '%s' to '%s'
  279. - IMPLICIT_CONVERSION_LOSS Implicit conversion may lose significant digits from '%s' to '%s'
  280. - COMBINING_SIGNED_UNSIGNED64 Combining signed type and unsigned 64-bit type - treated as an unsigned type
  281. -
  282. Debug flags: -d<x>
  283. VerbosePasResolver
  284. Notes:
  285. Functions and function types without parameters:
  286. property P read f; // use function f, not its result
  287. f. // implicit resolve f once if param less function or function type
  288. f[] // implicit resolve f once if a param less function or function type
  289. @f; use function f, not its result
  290. @p.f; @ operator applies to f, not p
  291. @f(); @ operator applies to result of f
  292. f(); use f's result
  293. FuncVar:=Func; if mode=objfpc: incompatible
  294. if mode=delphi: implicit addr of function f
  295. if f=g then : can implicit resolve each side once
  296. p(f), f as var parameter: can implicit
  297. }
  298. unit PasResolver;
  299. {$i fcl-passrc.inc}
  300. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  301. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  302. interface
  303. uses
  304. {$ifdef pas2js}
  305. js,
  306. {$IFDEF NODEJS}
  307. Node.FS,
  308. {$ENDIF}
  309. {$endif}
  310. Classes, SysUtils, Math, Types, contnrs,
  311. PasTree, PScanner, PParser, PasResolveEval;
  312. const
  313. ParserMaxEmbeddedColumn = 2048;
  314. ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
  315. po_Resolver = [
  316. po_ResolveStandardTypes,
  317. po_NoOverloadedProcs,
  318. po_KeepClassForward,
  319. po_ArrayRangeExpr,
  320. po_CheckCondFunction];
  321. type
  322. TResolverBaseType = (
  323. btNone, // undefined
  324. btCustom, // provided by descendant resolver
  325. btContext, // any source declared type with LoTypeEl/HiTypeEl
  326. btModule,
  327. btUntyped, // TPasArgument without ArgType
  328. btChar, // char
  329. {$ifdef FPC_HAS_CPSTRING}
  330. btAnsiChar, // ansichar
  331. {$endif}
  332. btWideChar, // widechar
  333. btString, // string
  334. {$ifdef FPC_HAS_CPSTRING}
  335. btAnsiString, // ansistring
  336. btShortString, // shortstring
  337. btRawByteString, // rawbytestring
  338. {$endif}
  339. btWideString, // widestring
  340. btUnicodeString,// unicodestring
  341. btSingle, // single 1.5E-45..3.4E38, digits 7-8, bytes 4
  342. btDouble, // double 5.0E-324..1.7E308, digits 15-16, bytes 8
  343. btExtended, // extended platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
  344. btCExtended, // cextended
  345. btCurrency, // as int64 div 10000, float, not ordinal
  346. btBoolean, // boolean
  347. btByteBool, // bytebool true=not zero
  348. btWordBool, // wordbool true=not zero
  349. btLongBool, // longbool true=not zero
  350. {$ifdef HasInt64}
  351. btQWordBool, // qwordbool true=not zero
  352. {$endif}
  353. btByte, // byte 0..255
  354. btShortInt, // shortint -128..127
  355. btWord, // word unsigned 2 bytes
  356. btSmallInt, // smallint signed 2 bytes
  357. btUIntSingle, // unsigned integer range of single 22bit
  358. btIntSingle, // integer range of single 23bit
  359. btLongWord, // longword unsigned 4 bytes
  360. btLongint, // longint signed 4 bytes
  361. btUIntDouble, // unsigned integer range of double 52bit
  362. btIntDouble, // integer range of double 53bit
  363. {$ifdef HasInt64}
  364. btQWord, // qword 0..18446744073709551615, bytes 8
  365. btInt64, // int64 -9223372036854775808..9223372036854775807, bytes 8
  366. btComp, // as Int64, not ordinal
  367. {$endif}
  368. btPointer, // pointer or canonical pointer (e.g. @something)
  369. {$ifdef fpc}
  370. btFile, // file
  371. btText, // text
  372. btVariant, // variant
  373. {$endif}
  374. btNil, // nil = pointer, class, procedure, method, ...
  375. btProc, // TPasProcedure
  376. btBuiltInProc, // TPasUnresolvedSymbolRef with CustomData is TResElDataBuiltInProc
  377. btArrayProperty,// IdentEl is TPasProperty with Args.Count>0, LoTypeEl=nil
  378. btSet, // set of '', see SubType
  379. btArrayLit, // [] array literal (TParamsExpr, TArrayValues, TBinaryExpr), see SubType
  380. btArrayOrSet, // [] can be set or array literal, see SubType
  381. btRange // a..b see SubType
  382. );
  383. TResolveBaseTypes = set of TResolverBaseType;
  384. const
  385. btIntMax = {$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  386. btUIntMax = {$ifdef HasInt64}btQWord{$else}btUIntDouble{$endif};
  387. btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
  388. btLongWord,btLongint,btIntDouble,btUIntDouble
  389. {$ifdef HasInt64}
  390. ,btQWord,btInt64,btComp
  391. {$endif}];
  392. btAllIntegerNoQWord = btAllInteger{$ifdef HasInt64}-[btQWord]{$endif};
  393. btAllSignedInteger = [btShortInt,btSmallInt,btIntSingle,btLongint,btIntDouble
  394. {$ifdef HasInt64}
  395. ,btInt64,btComp
  396. {$endif}];
  397. btAllChars = [btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar];
  398. btAllStrings = [btString,
  399. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btShortString,btRawByteString,{$endif}
  400. btWideString,btUnicodeString];
  401. btAllStringAndChars = btAllStrings+btAllChars;
  402. btAllStringPointer = [btString,
  403. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btRawByteString,{$endif}
  404. btWideString,btUnicodeString];
  405. btAllFloats = [btSingle,btDouble,
  406. btExtended,btCExtended,btCurrency];
  407. btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool
  408. {$ifdef HasInt64},btQWordBool{$endif}];
  409. btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
  410. btAllRanges = btArrayRangeTypes+[btRange];
  411. btAllWithSubType = [btSet, btArrayLit, btArrayOrSet, btRange];
  412. btAllIntrinsicTypes = btAllInteger+btAllStringAndChars+btAllFloats+btAllBooleans;
  413. btAllFPCTypes = [
  414. btChar,
  415. {$ifdef FPC_HAS_CPSTRING}
  416. btAnsiChar,
  417. {$endif}
  418. btWideChar,
  419. btString,
  420. {$ifdef FPC_HAS_CPSTRING}
  421. btAnsiString,
  422. btShortString,
  423. btRawByteString,
  424. {$endif}
  425. btWideString,
  426. btUnicodeString,
  427. btSingle,
  428. btDouble,
  429. btExtended,
  430. btCExtended,
  431. btCurrency,
  432. btBoolean,
  433. btByteBool,
  434. btWordBool,
  435. btLongBool,
  436. {$ifdef HasInt64}
  437. btQWordBool,
  438. {$endif}
  439. btByte,
  440. btShortInt,
  441. btWord,
  442. btSmallInt,
  443. btLongWord,
  444. btLongint,
  445. {$ifdef HasInt64}
  446. btQWord,
  447. btInt64,
  448. btComp,
  449. {$endif}
  450. btPointer
  451. {$ifdef fpc}
  452. ,btFile,
  453. btText,
  454. btVariant
  455. {$endif}
  456. ];
  457. ResBaseTypeNames: array[TResolverBaseType] of string =(
  458. 'None',
  459. 'Custom',
  460. 'Context',
  461. 'Module',
  462. 'Untyped',
  463. 'Char',
  464. {$ifdef FPC_HAS_CPSTRING}
  465. 'AnsiChar',
  466. {$endif}
  467. 'WideChar',
  468. 'String',
  469. {$ifdef FPC_HAS_CPSTRING}
  470. 'AnsiString',
  471. 'ShortString',
  472. 'RawByteString',
  473. {$endif}
  474. 'WideString',
  475. 'UnicodeString',
  476. 'Single',
  477. 'Double',
  478. 'Extended',
  479. 'CExtended',
  480. 'Currency',
  481. 'Boolean',
  482. 'ByteBool',
  483. 'WordBool',
  484. 'LongBool',
  485. {$ifdef HasInt64}
  486. 'QWordBool',
  487. {$endif}
  488. 'Byte',
  489. 'ShortInt',
  490. 'Word',
  491. 'SmallInt',
  492. 'UIntSingle',
  493. 'IntSingle',
  494. 'LongWord',
  495. 'Longint',
  496. 'UIntDouble',
  497. 'IntDouble',
  498. {$ifdef HasInt64}
  499. 'QWord',
  500. 'Int64',
  501. 'Comp',
  502. {$endif}
  503. 'Pointer',
  504. {$ifdef fpc}
  505. 'File',
  506. 'Text',
  507. 'Variant',
  508. {$endif}
  509. 'Nil',
  510. 'Procedure/Function',
  511. 'BuiltInProc',
  512. 'array property',
  513. 'set',
  514. 'array',
  515. 'set or array literal',
  516. 'range..'
  517. );
  518. type
  519. TResolverBuiltInProc = (
  520. bfCustom,
  521. bfLength,
  522. bfSetLength,
  523. bfInclude,
  524. bfExclude,
  525. bfBreak,
  526. bfContinue,
  527. bfExit,
  528. bfInc,
  529. bfDec,
  530. bfAssigned,
  531. bfChr,
  532. bfOrd,
  533. bfLow,
  534. bfHigh,
  535. bfPred,
  536. bfSucc,
  537. bfStrProc,
  538. bfStrFunc,
  539. bfWriteStr,
  540. bfVal,
  541. bfLo,
  542. bfHi,
  543. bfConcatArray,
  544. bfConcatString,
  545. bfCopyArray,
  546. bfInsertArray,
  547. bfDeleteArray,
  548. bfTypeInfo,
  549. bfGetTypeKind,
  550. bfAssert,
  551. bfNew,
  552. bfDispose,
  553. bfDefault
  554. );
  555. TResolverBuiltInProcs = set of TResolverBuiltInProc;
  556. const
  557. ResolverBuiltInProcNames: array[TResolverBuiltInProc] of string = (
  558. 'Custom',
  559. 'Length',
  560. 'SetLength',
  561. 'Include',
  562. 'Exclude',
  563. 'Break',
  564. 'Continue',
  565. 'Exit',
  566. 'Inc',
  567. 'Dec',
  568. 'Assigned',
  569. 'Chr',
  570. 'Ord',
  571. 'Low',
  572. 'High',
  573. 'Pred',
  574. 'Succ',
  575. 'Str',
  576. 'Str',
  577. 'WriteStr',
  578. 'Val',
  579. 'Lo',
  580. 'Hi',
  581. 'Concat',
  582. 'Concat',
  583. 'Copy',
  584. 'Insert',
  585. 'Delete',
  586. 'TypeInfo',
  587. 'GetTypeKind',
  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. Index: integer;
  659. Step: TPRSpecializeStep; // how much of the specialized element has been created
  660. FirstSpecialize: TPasElement;
  661. Params: TPasTypeArray;
  662. SpecializedConstraints: TPasElementArray;
  663. destructor Destroy; override;
  664. property SpecializedEl: TPasElement read FSpecializedEl;
  665. end;
  666. { TPRSpecializedTypeItem }
  667. TPRSpecializedTypeItem = class(TPRSpecializedItem)
  668. private
  669. FSpecializedType: TPasGenericType;
  670. procedure SetSpecializedType(AValue: TPasGenericType);
  671. public
  672. HeaderScope: TObject; // TPasScope
  673. ImplProcs: TFPList; // list of TPasProcedure
  674. destructor Destroy; override;
  675. property SpecializedType: TPasGenericType read FSpecializedType write SetSpecializedType;
  676. end;
  677. { TPRSpecializedProcItem }
  678. TPRSpecializedProcItem = class(TPRSpecializedItem)
  679. private
  680. FSpecializedProc: TPasProcedure;
  681. procedure SetSpecializedProc(const AValue: TPasProcedure);
  682. public
  683. ImplProc: TPasProcedure; // <>SpecializedProc, can be nil
  684. destructor Destroy; override;
  685. property SpecializedProc: TPasProcedure read FSpecializedProc write SetSpecializedProc;
  686. end;
  687. TPSRefAccess = (
  688. psraNone,
  689. psraRead,
  690. psraWrite,
  691. psraReadWrite,
  692. psraWriteRead,
  693. psraTypeInfo
  694. );
  695. { TPasScopeReference }
  696. TPasScopeReference = class
  697. private
  698. FElement: TPasElement;
  699. procedure SetElement(const AValue: TPasElement);
  700. public
  701. {$IFDEF VerbosePasResolver}
  702. Owner: TObject;
  703. {$ENDIF}
  704. Access: TPSRefAccess;
  705. NextSameName: TPasScopeReference;
  706. destructor Destroy; override;
  707. property Element: TPasElement read FElement write SetElement;
  708. end;
  709. TPasScope = class;
  710. { TPasScopeReferences - used by TPasAnalyzer to store references of a proc or initialization section }
  711. TPasScopeReferences = class
  712. private
  713. FScope: TPasScope;
  714. procedure OnClearItem(Item, Dummy: pointer);
  715. procedure OnCollectItem(Item, aList: pointer);
  716. public
  717. References: TPasResHashList; // hash list of TPasScopeReference
  718. constructor Create(aScope: TPasScope);
  719. destructor Destroy; override;
  720. procedure Clear;
  721. function Add(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  722. function Find(const aName: string): TPasScopeReference;
  723. function GetList: TFPList;
  724. property Scope: TPasScope read FScope;
  725. end;
  726. TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
  727. Data: Pointer; var Abort: boolean) of object;
  728. { TPasScope -
  729. Elements like TPasClassType use TPasScope descendants as CustomData for
  730. their sub identifiers.
  731. TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
  732. }
  733. TPasScope = Class(TResolveData)
  734. public
  735. VisibilityContext: TPasElement; // used to check if the current context
  736. // is allowed to access a private/protected element
  737. class function IsStoredInElement: boolean; virtual;
  738. class function FreeOnPop: boolean; virtual;
  739. procedure IterateElements(const aName: string; StartScope: TPasScope;
  740. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  741. var Abort: boolean); virtual;
  742. procedure WriteIdentifiers(Prefix: string); virtual;
  743. end;
  744. TPasScopeClass = class of TPasScope;
  745. TPasScopeArray = array of TPasScope;
  746. TPasModuleScopeFlag = (
  747. pmsfAssertSearched, // assert constructors searched
  748. pmsfRangeErrorNeeded, // somewhere is range checking on
  749. pmsfRangeErrorSearched // ERangeError constructor searched
  750. );
  751. TPasModuleScopeFlags = set of TPasModuleScopeFlag;
  752. { TPasModuleScope }
  753. TPasModuleScope = class(TPasScope)
  754. private
  755. FAssertClass: TPasClassType;
  756. FAssertDefConstructor: TPasConstructor;
  757. FAssertMsgConstructor: TPasConstructor;
  758. FRangeErrorClass: TPasClassType;
  759. FRangeErrorConstructor: TPasConstructor;
  760. FSystemTVarRec: TPasRecordType;
  761. procedure SetAssertClass(const AValue: TPasClassType);
  762. procedure SetAssertDefConstructor(const AValue: TPasConstructor);
  763. procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
  764. procedure SetRangeErrorClass(const AValue: TPasClassType);
  765. procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
  766. procedure SetSystemTVarRec(const AValue: TPasRecordType);
  767. public
  768. FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
  769. PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
  770. Flags: TPasModuleScopeFlags;
  771. BoolSwitches: TBoolSwitches;
  772. constructor Create; override;
  773. destructor Destroy; override;
  774. procedure IterateElements(const aName: string; StartScope: TPasScope;
  775. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  776. var Abort: boolean); override;
  777. property AssertClass: TPasClassType read FAssertClass write SetAssertClass;
  778. property AssertDefConstructor: TPasConstructor read FAssertDefConstructor write SetAssertDefConstructor;
  779. property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
  780. property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
  781. property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
  782. property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
  783. end;
  784. TPasModuleScopeClass = class of TPasModuleScope;
  785. TPasIdentifierKind = (
  786. pikNone, // not yet initialized
  787. pikBaseType, // e.g. longint
  788. pikBuiltInProc, // e.g. High(), SetLength()
  789. pikSimple, // simple vars, consts, types, enums
  790. pikProc, // may need parameter list with round brackets
  791. pikNamespace
  792. );
  793. TPasIdentifierKinds = set of TPasIdentifierKind;
  794. { TPasIdentifier }
  795. TPasIdentifier = Class(TObject)
  796. private
  797. FElement: TPasElement;
  798. procedure SetElement(AValue: TPasElement);
  799. public
  800. {$IFDEF VerbosePasResolver}
  801. Owner: TObject;
  802. {$ENDIF}
  803. Identifier: String;
  804. NextSameIdentifier: TPasIdentifier; // next identifier with same name
  805. Kind: TPasIdentifierKind;
  806. destructor Destroy; override;
  807. property Element: TPasElement read FElement write SetElement;
  808. end;
  809. TPasIdentifierArray = array of TPasIdentifier;
  810. { TPasIdentifierScope - elements with a list of sub identifiers }
  811. TPasIdentifierScope = Class(TPasScope)
  812. private
  813. FItems: TPasResHashList; // hashlist of TPasIdentifier
  814. procedure InternalAdd(Item: TPasIdentifier);
  815. procedure OnClearItem(Item, Dummy: pointer);
  816. procedure OnCollectItem(Item, List: pointer);
  817. protected
  818. procedure OnWriteItem(Item, Dummy: pointer);
  819. public
  820. constructor Create; override;
  821. destructor Destroy; override;
  822. procedure ClearIdentifiers(FreeItems: boolean);
  823. function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
  824. function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
  825. function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
  826. function AddIdentifier(const Identifier: String; El: TPasElement;
  827. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  828. function FindElement(const aName: string): TPasElement;
  829. procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
  830. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  831. var Abort: boolean);
  832. procedure IterateElements(const aName: string; StartScope: TPasScope;
  833. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  834. var Abort: boolean); override;
  835. procedure WriteIdentifiers(Prefix: string); override;
  836. procedure WriteLocalIdentifiers(Prefix: string); virtual;
  837. function GetLocalIdentifiers: TFPList; virtual;
  838. end;
  839. TPasIdentifierScopeArray = array of TPasIdentifierScope;
  840. { TPasDefaultScope - root scope }
  841. TPasDefaultScope = class(TPasIdentifierScope)
  842. public
  843. class function IsStoredInElement: boolean; override;
  844. end;
  845. { TPasIterateFilterData }
  846. TPasIterateFilterData = record
  847. OnIterate: TIterateScopeElement;
  848. Data: Pointer;
  849. end;
  850. PPasIterateFilterData = ^TPasIterateFilterData;
  851. { TPRHelperEntry }
  852. TPRHelperEntry = class
  853. public
  854. Added: integer; // Added is bigger when it was added later to the list
  855. HelperForType: TPasType; // alias resolved
  856. Helper: TPasClassType;
  857. end;
  858. TPRHelperEntryArray = array of TPRHelperEntry;
  859. { TPasSectionScope - e.g. interface, implementation, program, library }
  860. TPasSectionScope = Class(TPasIdentifierScope)
  861. private
  862. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  863. Data: Pointer; var Abort: boolean);
  864. public
  865. UsesScopes: TFPList; // list of TPasSectionScope
  866. UsesFinished: boolean;
  867. Finished: boolean;
  868. BoolSwitches: TBoolSwitches;
  869. ModeSwitches: TModeSwitches;
  870. Helpers: TPRHelperEntryArray; // only created for interface. Sorted ascending ComparePRHelperEntries
  871. constructor Create; override;
  872. destructor Destroy; override;
  873. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  874. procedure IterateElements(const aName: string; StartScope: TPasScope;
  875. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  876. var Abort: boolean); override;
  877. procedure WriteIdentifiers(Prefix: string); override;
  878. end;
  879. TPasSectionScopeClass = class of TPasSectionScope;
  880. { TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
  881. TPasInitialFinalizationScope = Class(TPasScope)
  882. public
  883. References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
  884. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  885. destructor Destroy; override;
  886. end;
  887. TPasInitialFinalizationScopeClass = class of TPasInitialFinalizationScope;
  888. { TPasEnumTypeScope }
  889. TPasEnumTypeScope = Class(TPasIdentifierScope)
  890. public
  891. CanonicalSet: TPasSetType;
  892. destructor Destroy; override;
  893. end;
  894. { TPasGenericParamsScope - used during parsing TPasGenericTemplateType(s) }
  895. TPasGenericParamsScope = Class(TPasIdentifierScope)
  896. public
  897. GenericType: TPasGenericType;
  898. end;
  899. TPSGenericStep = (
  900. psgsNone,
  901. psgsInterfaceParsed,
  902. psgsImplementationParsed
  903. );
  904. { TPasGenericScope }
  905. TPasGenericScope = Class(TPasIdentifierScope)
  906. public
  907. // for generic type:
  908. SpecializedItems: TObjectList; // list of TPRSpecializedItem
  909. GenericStep: TPSGenericStep; // how much of the generic was parsed
  910. // for specialized type:
  911. SpecializedFromItem: TPRSpecializedItem;
  912. destructor Destroy; override;
  913. end;
  914. { TPasArrayScope }
  915. TPasArrayScope = Class(TPasGenericScope)
  916. public
  917. end;
  918. TPasArrayScopeClass = class of TPasArrayScope;
  919. { TPasProcTypeScope }
  920. TPasProcTypeScope = Class(TPasGenericScope)
  921. public
  922. end;
  923. TPasProcTypeScopeClass = class of TPasProcTypeScope;
  924. { TPasClassOrRecordScope }
  925. TPasClassOrRecordScope = Class(TPasGenericScope)
  926. public
  927. DefaultProperty: TPasProperty;
  928. ClassConstructor: TPasClassConstructor;
  929. ClassDestructor: TPasClassDestructor;
  930. end;
  931. { TPasRecordScope }
  932. TPasRecordScope = Class(TPasClassOrRecordScope)
  933. end;
  934. TPasRecordScopeClass = class of TPasRecordScope;
  935. TPasClassScopeFlag = (
  936. pcsfAncestorResolved,
  937. pcsfSealed,
  938. pcsfPublished // default visibility is published due to $M directive
  939. );
  940. TPasClassScopeFlags = set of TPasClassScopeFlag;
  941. { TPasClassIntfMap }
  942. TPasClassIntfMap = class
  943. public
  944. Element: TPasElement;
  945. Intf: TPasClassType;
  946. Procs: TFPList;// maps Interface-member-index to TPasProcedure
  947. AncestorMap: TPasClassIntfMap;// AncestorMap.Element=Element, AncestorMap.Intf=DirectAncestor
  948. destructor Destroy; override;
  949. end;
  950. { TPasClassScope }
  951. TPasClassScope = Class(TPasClassOrRecordScope)
  952. public
  953. AncestorScope: TPasClassScope;
  954. CanonicalClassOf: TPasClassOfType;
  955. DirectAncestor: TPasType; // TPasClassType or TPasAliasType, see GetPasClassAncestor
  956. // Note: TPasClassType.AncestorType might be nil and DirectAncestor is "TObject"
  957. Flags: TPasClassScopeFlags;
  958. AbstractProcs: TArrayOfPasProcedure;
  959. Interfaces: TFPList; // list corresponds to TPasClassType(Element).Interfaces,
  960. // elements: TPasProperty for 'implements', or TPasClassIntfMap
  961. destructor Destroy; override;
  962. end;
  963. TPasClassScopeClass = class of TPasClassScope;
  964. { TPasGroupScope }
  965. TPasGroupScope = Class(TPasIdentifierScope)
  966. public
  967. Scopes: TPasIdentifierScopeArray;
  968. Count: integer;
  969. OnlyTypeMembers: boolean;
  970. procedure Add(Scope: TPasIdentifierScope);
  971. destructor Destroy; override;
  972. function GetFirstNonHelperScope: TPasIdentifierScope;
  973. class function IsStoredInElement: boolean; override;
  974. function FindAncestorIdentifier(const Identifier: String): TPasIdentifier;
  975. function FindAncestorElement(const Identifier: String): TPasElement;
  976. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  977. procedure IterateElements(const aName: string; StartScope: TPasScope;
  978. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  979. var Abort: boolean); override;
  980. procedure WriteIdentifiers(Prefix: string); override;
  981. end;
  982. TPasProcedureScopeFlag = (
  983. ppsfIsGroupOverload, // mode objfpc: one overload is enough for all procs in same scope
  984. ppsfIsSpecialized
  985. );
  986. TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
  987. { TPasProcedureScope }
  988. TPasProcedureScope = Class(TPasGenericScope)
  989. public
  990. DeclarationProc: TPasProcedure; // the corresponding forward declaration
  991. ImplProc: TPasProcedure; // the corresponding proc with Body
  992. OverriddenProc: TPasProcedure; // the ancestor proc with same signature
  993. ClassRecScope: TPasClassOrRecordScope;
  994. GroupScope: TPasGroupScope; // set during parsing a method body
  995. NestedMembersScope: TPasGroupScope; // set during parsing a method body of a nested class
  996. SelfArg: TPasArgument;
  997. Flags: TPasProcedureScopeFlags;
  998. BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
  999. ModeSwitches: TModeSwitches; // at proc start
  1000. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1001. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1002. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1003. var Abort: boolean); override;
  1004. function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
  1005. procedure WriteIdentifiers(Prefix: string); override;
  1006. destructor Destroy; override;
  1007. public
  1008. References: TPasScopeReferences; // created by TPasAnalyzer in DeclarationProc
  1009. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  1010. function GetReferences: TFPList;
  1011. end;
  1012. TPasProcedureScopeClass = class of TPasProcedureScope;
  1013. { TPasPropertyScope }
  1014. TPasPropertyScope = Class(TPasIdentifierScope)
  1015. public
  1016. AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
  1017. otherwise it is a redeclaration }
  1018. destructor Destroy; override;
  1019. end;
  1020. { TPasExceptOnScope }
  1021. TPasExceptOnScope = Class(TPasIdentifierScope)
  1022. end;
  1023. TPasWithScope = class;
  1024. TPasWithExprScopeFlag = (
  1025. wesfNeedTmpVar,
  1026. wesfOnlyTypeMembers,
  1027. wesfIsClassOf,
  1028. wesfConstParent // not writable
  1029. );
  1030. TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
  1031. { TPasWithExprScope }
  1032. TPasWithExprScope = Class(TPasScope)
  1033. public
  1034. WithScope: TPasWithScope; // owner
  1035. Index: integer;
  1036. Expr: TPasExpr;
  1037. Scope: TPasGroupScope;
  1038. ClassRecScope: TPasClassOrRecordScope;
  1039. Flags: TPasWithExprScopeFlags;
  1040. class function IsStoredInElement: boolean; override;
  1041. class function FreeOnPop: boolean; override;
  1042. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1043. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1044. var Abort: boolean); override;
  1045. procedure WriteIdentifiers(Prefix: string); override;
  1046. destructor Destroy; override;
  1047. end;
  1048. TPasWithExprScopeClass = class of TPasWithExprScope;
  1049. { TPasWithScope }
  1050. TPasWithScope = Class(TPasScope)
  1051. public
  1052. // Element is the TPasImplWithDo
  1053. ExpressionScopes: TObjectList; // list of TPasWithExprScope
  1054. constructor Create; override;
  1055. destructor Destroy; override;
  1056. end;
  1057. { TPasForLoopScope }
  1058. TPasForLoopScope = Class(TPasScope)
  1059. public
  1060. GetEnumerator: TPasFunction;
  1061. MoveNext: TPasFunction;
  1062. Current: TPasProperty;
  1063. end;
  1064. { TPasSubExprScope - base class for sub scopes aka dotted scopes }
  1065. TPasSubExprScope = Class(TPasIdentifierScope)
  1066. public
  1067. class function IsStoredInElement: boolean; override;
  1068. end;
  1069. { TPasDotBaseScope }
  1070. TPasDotBaseScope = Class(TPasSubExprScope)
  1071. public
  1072. GroupScope: TPasGroupScope;
  1073. OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
  1074. ConstParent: boolean;
  1075. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1076. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1077. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1078. var Abort: boolean); override;
  1079. procedure WriteIdentifiers(Prefix: string); override;
  1080. destructor Destroy; override;
  1081. end;
  1082. { TPasModuleDotScope - scope for searching unitname.<identifier> }
  1083. TPasModuleDotScope = Class(TPasDotBaseScope)
  1084. private
  1085. FModule: TPasModule;
  1086. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  1087. Data: Pointer; var Abort: boolean);
  1088. procedure SetModule(AValue: TPasModule);
  1089. public
  1090. ImplementationScope: TPasSectionScope;
  1091. InterfaceScope: TPasSectionScope;
  1092. SystemScope: TPasDefaultScope;
  1093. destructor Destroy; override;
  1094. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1095. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1096. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1097. var Abort: boolean); override;
  1098. procedure WriteIdentifiers(Prefix: string); override;
  1099. property Module: TPasModule read FModule write SetModule;
  1100. end;
  1101. { TPasDotEnumTypeScope - used for EnumType.EnumValue }
  1102. TPasDotEnumTypeScope = Class(TPasDotBaseScope)
  1103. public
  1104. EnumScope: TPasEnumTypeScope;
  1105. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1106. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1107. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1108. var Abort: boolean); override;
  1109. procedure WriteIdentifiers(Prefix: string); override;
  1110. end;
  1111. { TPasDotClassOrRecordScope }
  1112. TPasDotClassOrRecordScope = Class(TPasDotBaseScope)
  1113. public
  1114. ClassRecScope: TPasClassOrRecordScope;
  1115. end;
  1116. { TPasDotClassScope - used for aClass.subidentifier }
  1117. TPasDotClassScope = Class(TPasDotClassOrRecordScope)
  1118. public
  1119. IsClassOf: boolean; // true if aClassOf.
  1120. end;
  1121. { TPasInheritedScope - used for inherited; and inherited Name() }
  1122. TPasInheritedScope = Class(TPasDotClassOrRecordScope)
  1123. public
  1124. AncestorScope: TPasClassScope;
  1125. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1126. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1127. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1128. var Abort: boolean); override;
  1129. procedure WriteIdentifiers(Prefix: string); override;
  1130. end;
  1131. { TPasDotHelperScope }
  1132. TPasDotHelperScope = class(TPasDotBaseScope)
  1133. end;
  1134. TResolvedReferenceFlag = (
  1135. rrfDotScope, // found reference via a dot scope (TPasDotBaseScope)
  1136. rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
  1137. rrfNoImplicitCallWithoutParams, // a TPrimitiveExpr is not an implicit call
  1138. rrfNewInstance, // constructor call (without it call constructor as normal method)
  1139. rrfFreeInstance, // destructor call (without it call destructor as normal method)
  1140. rrfVMT, // use VMT for call
  1141. rrfConstInherited // parent is const and this child is too
  1142. );
  1143. TResolvedReferenceFlags = set of TResolvedReferenceFlag;
  1144. type
  1145. { TResolvedRefContext }
  1146. TResolvedRefContext = Class
  1147. end;
  1148. TResolvedRefAccess = (
  1149. rraNone,
  1150. rraRead, // expression is read
  1151. rraAssign, // expression is LHS assign
  1152. rraReadAndAssign, // expression is LHS +=, -=, *=, /=
  1153. rraVarParam, // expression is passed to a var parameter
  1154. rraOutParam, // expression is passed to an out parameter
  1155. rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
  1156. // will later be changed to rraRead, rraVarParam, rraOutParam
  1157. );
  1158. TPRResolveVarAccesses = set of TResolvedRefAccess;
  1159. const
  1160. rraAllRead = [rraRead,rraReadAndAssign,rraVarParam];
  1161. rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
  1162. ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
  1163. psraNone, // rraNone
  1164. psraRead, // rraRead
  1165. psraWrite, // rraAssign
  1166. psraReadWrite, // rraReadAndAssign
  1167. psraReadWrite, // rraVarParam
  1168. psraWrite, // rraOutParam
  1169. psraNone // rraParamToUnknownProc
  1170. );
  1171. type
  1172. { TResolvedReference - CustomData for normal references }
  1173. TResolvedReference = Class(TResolveData)
  1174. private
  1175. FDeclaration: TPasElement;
  1176. procedure SetDeclaration(AValue: TPasElement);
  1177. public
  1178. Flags: TResolvedReferenceFlags;
  1179. Access: TResolvedRefAccess;
  1180. Context: TResolvedRefContext;
  1181. WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
  1182. destructor Destroy; override;
  1183. property Declaration: TPasElement read FDeclaration write SetDeclaration;
  1184. end;
  1185. { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
  1186. TResolvedRefCtxConstructor = Class(TResolvedRefContext)
  1187. public
  1188. Typ: TPasType;
  1189. end;
  1190. { TResolvedRefCtxAttrProc - constructor of an attribute }
  1191. TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
  1192. public
  1193. Proc: TPasConstructor;
  1194. end;
  1195. TPasResolverResultFlag = (
  1196. rrfReadable,
  1197. rrfWritable,
  1198. rrfAssignable, // not writable in general, e.g. aString[1]:=
  1199. rrfCanBeStatement
  1200. );
  1201. TPasResolverResultFlags = set of TPasResolverResultFlag;
  1202. type
  1203. { TPasResolverResult }
  1204. TPasResolverResult = record
  1205. BaseType: TResolverBaseType;
  1206. SubType: TResolverBaseType; // for btSet, btArrayLit, btArrayOrSet, btRange
  1207. IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
  1208. LoTypeEl: TPasType; // can be nil for const expression, all alias resolved
  1209. HiTypeEl: TPasType; // same as LoTypeEl, except alias types are not resolved
  1210. ExprEl: TPasExpr;
  1211. Flags: TPasResolverResultFlags;
  1212. end;
  1213. PPasResolverResult = ^TPasResolverResult;
  1214. TPasResolverResultArray = array of TPasResolverResult;
  1215. type
  1216. TPasResolverComputeFlag = (
  1217. rcSetReferenceFlags, // set flags of references while computing type, used by Resolve* methods
  1218. rcNoImplicitProc, // do not call a function without params, includes rcNoImplicitProcType
  1219. rcNoImplicitProcType, // do not call a proc type without params
  1220. rcConstant, // resolve a constant expression, error if not computable
  1221. rcType, // resolve a type expression
  1222. rcCall // resolve result type of a function call
  1223. );
  1224. TPasResolverComputeFlags = set of TPasResolverComputeFlag;
  1225. TResElDataBuiltInSymbol = Class(TResolveData)
  1226. public
  1227. end;
  1228. { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
  1229. TResElDataBaseType = Class(TResElDataBuiltInSymbol)
  1230. public
  1231. BaseType: TResolverBaseType;
  1232. end;
  1233. TResElDataBaseTypeClass = class of TResElDataBaseType;
  1234. TResElDataBuiltInProc = Class;
  1235. TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
  1236. Exp: TPasExpr; RaiseOnError: boolean): integer of object;
  1237. TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1238. out ResolvedEl: TPasResolverResult) of object;
  1239. TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1240. Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
  1241. TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
  1242. Params: TParamsExpr) of object;
  1243. TBuiltInProcFlag = (
  1244. bipfCanBeStatement // a call is enough for a simple statement
  1245. );
  1246. TBuiltInProcFlags = set of TBuiltInProcFlag;
  1247. { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
  1248. TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
  1249. public
  1250. Proc: TPasUnresolvedSymbolRef;
  1251. Signature: string;
  1252. BuiltIn: TResolverBuiltInProc;
  1253. GetCallCompatibility: TOnGetCallCompatibility;
  1254. GetCallResult: TOnGetCallResult;
  1255. Eval: TOnEvalBIFunction;
  1256. FinishParamsExpression: TOnFinishParamsExpr;
  1257. Flags: TBuiltInProcFlags;
  1258. destructor Destroy; override;
  1259. end;
  1260. { TPRFindData }
  1261. TPRFindData = record
  1262. ErrorPosEl: TPasElement;
  1263. Found: TPasElement;
  1264. ElScope: TPasScope; // Where Found was found
  1265. StartScope: TPasScope; // where the search started
  1266. SkipGenerics: boolean;
  1267. end;
  1268. PPRFindData = ^TPRFindData;
  1269. TPRFindGenericData = record
  1270. Find: TPRFindData;
  1271. TemplateCount: integer;
  1272. end;
  1273. PPRFindGenericData = ^TPRFindGenericData;
  1274. TPasResolverOption = (
  1275. proFixCaseOfOverrides, // fix Name of overriding proc/property to the overriden proc/property
  1276. proClassPropertyNonStatic, // class property accessors can be non static
  1277. proPropertyAsVarParam, // allows to pass a property as a var/out argument
  1278. proClassOfIs, // class-of supports is and as operator
  1279. proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
  1280. proOpenAsDynArrays, // open arrays work like dynamic arrays
  1281. //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
  1282. //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
  1283. proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
  1284. proMethodAddrAsPointer, // can assign @method to a pointer
  1285. proSafecallAllowsDefault // allow assigning a default calling convention to a SafeCall proc
  1286. );
  1287. TPasResolverOptions = set of TPasResolverOption;
  1288. { TPasResolverHub }
  1289. TPasResolverHub = class
  1290. private
  1291. FOwner: TObject;
  1292. public
  1293. FinishedInterfaceCount: integer;
  1294. constructor Create(TheOwner: TObject); virtual;
  1295. procedure Reset; virtual;
  1296. property Owner: TObject read FOwner;
  1297. end;
  1298. TPasResolverHubClass = class of TPasResolverHub;
  1299. TPasResolverStep = (
  1300. prsInit,
  1301. prsParsing,
  1302. prsFinishingModule,
  1303. prsFinishedModule
  1304. );
  1305. TPasResolverSteps = set of TPasResolverStep;
  1306. TPRResolveAlias = (
  1307. prraNone, // do not resolve alias
  1308. prraSimple, // resolve alias, but not type alias
  1309. prraAlias // resolve alias and type alias
  1310. );
  1311. TPRProcTypeDescFlag = (
  1312. prptdUseName, // add name if available
  1313. prptdAddPaths, // add full paths to types
  1314. prptdResolveSimpleAlias
  1315. );
  1316. TPRProcTypeDescFlags = set of TPRProcTypeDescFlag;
  1317. TPRParentParams = record
  1318. InlineSpec: TInlineSpecializeExpr;
  1319. Params: TParamsExpr;
  1320. end;
  1321. TPRTemplateCompOp = (
  1322. prtcoAssignToTempl,
  1323. prtcoAssignFromTempl,
  1324. prtcoEqual
  1325. );
  1326. { TPasResolver }
  1327. TPasResolver = Class(TPasTreeContainer)
  1328. private
  1329. type
  1330. TResolveDataListKind = (lkBuiltIn,lkModule);
  1331. function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
  1332. function GetScopes(Index: integer): TPasScope; inline;
  1333. private
  1334. FActiveHelpers: TPRHelperEntryArray; // sorted ascending ComparePRHelperEntries
  1335. FAnonymousElTypePostfix: String;
  1336. FBaseTypeChar: TResolverBaseType;
  1337. FBaseTypeExtended: TResolverBaseType;
  1338. FBaseTypeLength: TResolverBaseType;
  1339. FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
  1340. FBaseTypeString: TResolverBaseType;
  1341. FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
  1342. FDefaultNameSpace: String;
  1343. FDefaultScope: TPasDefaultScope;
  1344. FDynArrayMaxIndex: TMaxPrecInt;
  1345. FDynArrayMinIndex: TMaxPrecInt;
  1346. FFinishedInterfaceIndex: integer;
  1347. FHub: TPasResolverHub;
  1348. FLastCreatedData: array[TResolveDataListKind] of TResolveData;
  1349. FLastElement: TPasElement;
  1350. FLastMsg: string;
  1351. FLastMsgArgs: TMessageArgs;
  1352. FLastMsgElement: TPasElement;
  1353. FLastMsgId: TMaxPrecInt;
  1354. FLastMsgNumber: integer;
  1355. FLastMsgPattern: string;
  1356. FLastMsgType: TMessageType;
  1357. FLastSourcePos: TPasSourcePos;
  1358. FOptions: TPasResolverOptions;
  1359. FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
  1360. FRootElement: TPasModule;
  1361. FScopeClass_Array: TPasArrayScopeClass;
  1362. FScopeClass_Class: TPasClassScopeClass;
  1363. FScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass;
  1364. FScopeClass_Module: TPasModuleScopeClass;
  1365. FScopeClass_Proc: TPasProcedureScopeClass;
  1366. FScopeClass_ProcType: TPasProcTypeScopeClass;
  1367. FScopeClass_Record: TPasRecordScopeClass;
  1368. FScopeClass_Section: TPasSectionScopeClass;
  1369. FScopeClass_WithExpr: TPasWithExprScopeClass;
  1370. FScopeCount: integer;
  1371. FScopes: TPasScopeArray; // stack of scopes
  1372. FStep: TPasResolverStep;
  1373. FStoreSrcColumns: boolean;
  1374. FStashScopeCount: integer;
  1375. FStashScopes: TPasScopeArray; // stack of scopes
  1376. FTopScope: TPasScope;
  1377. procedure ClearResolveDataList(Kind: TResolveDataListKind);
  1378. function GetBaseTypeNames(bt: TResolverBaseType): string;
  1379. function GetBuiltInProcs(bp: TResolverBuiltInProc): TResElDataBuiltInProc;
  1380. protected
  1381. const
  1382. cExact = 0;
  1383. cGenericExact = cExact+1;
  1384. cAliasExact = cGenericExact+1;
  1385. cCompatible = cAliasExact+1;
  1386. cIntToIntConversion = ord(High(TResolverBaseType));
  1387. cFloatToFloatConversion = 2*cIntToIntConversion;
  1388. cTypeConversion = cExact+10000; // e.g. TObject to Pointer
  1389. cLossyConversion = cExact+100000;
  1390. cIntToFloatConversion = cExact+400000; // int to float is worse than bigint to smallint
  1391. cIncompatible = High(integer);
  1392. var
  1393. cTGUIDToString: integer;
  1394. cStringToTGUID: integer;
  1395. cInterfaceToTGUID: integer;
  1396. cInterfaceToString: integer;
  1397. type
  1398. TFindCallElData = record
  1399. Params: TParamsExpr;
  1400. TemplCnt: integer;
  1401. Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
  1402. LastProc: TPasProcedure;
  1403. ElScope, StartScope: TPasScope;
  1404. Distance: integer; // compatibility distance
  1405. Count: integer;
  1406. List: TFPList; // if not nil then collect all found elements here
  1407. end;
  1408. PFindCallElData = ^TFindCallElData;
  1409. TFindProcKind = (
  1410. fpkProcDeclaration, // search declaration for a body
  1411. fpkProc, // check overloads for a proc
  1412. fpkMethod // check overloads for a method
  1413. );
  1414. TFindProcData = record
  1415. Proc: TPasProcedure;
  1416. Args: TFPList; // List of TPasArgument objects
  1417. Kind: TFindProcKind;
  1418. FoundOverloadModifier: boolean;
  1419. FoundInSameScope: integer;
  1420. Found: TPasProcedure;
  1421. ElScope, StartScope: TPasScope;
  1422. FoundNonProc: TPasElement;
  1423. end;
  1424. PFindProcData = ^TFindProcData;
  1425. procedure OnFindFirst_PreferNoParams(El: TPasElement; ElScope, StartScope: TPasScope;
  1426. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1427. procedure OnFindFirst(El: TPasElement; ElScope, StartScope: TPasScope;
  1428. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1429. procedure OnFindFirst_GenericEl(El: TPasElement; ElScope, StartScope: TPasScope;
  1430. FindFirstGenericData: Pointer; var Abort: boolean); virtual;
  1431. procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
  1432. FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
  1433. procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
  1434. FindProcData: Pointer; var Abort: boolean); virtual;
  1435. procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
  1436. FindProcData: Pointer; var Abort: boolean); virtual;
  1437. function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
  1438. function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
  1439. Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
  1440. protected
  1441. procedure SetCurrentParser(AValue: TPasParser); override;
  1442. procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
  1443. State: TWarnMsgState; var Handled: boolean); virtual;
  1444. procedure SetRootElement(const AValue: TPasModule); virtual;
  1445. procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
  1446. function AddIdentifier(Scope: TPasIdentifierScope;
  1447. const aName: String; El: TPasElement;
  1448. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  1449. procedure AddModule(El: TPasModule); virtual;
  1450. procedure AddSection(El: TPasSection); virtual;
  1451. procedure AddInitialFinalizationSection(El: TPasImplBlock); virtual;
  1452. procedure AddType(El: TPasType); virtual;
  1453. procedure AddArrayType(El: TPasArrayType; TypeParams: TFPList); virtual;
  1454. procedure AddRecordType(El: TPasRecordType; TypeParams: TFPList); virtual;
  1455. procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual;
  1456. procedure AddVariable(El: TPasVariable); virtual;
  1457. procedure AddResourceString(El: TPasResString); virtual;
  1458. procedure AddExportSymbol(El: TPasExportSymbol); virtual;
  1459. procedure AddEnumType(El: TPasEnumType); virtual;
  1460. procedure AddEnumValue(El: TPasEnumValue); virtual;
  1461. procedure AddProperty(El: TPasProperty); virtual;
  1462. procedure AddProcedureType(El: TPasProcedureType; TypeParams: TFPList); virtual;
  1463. procedure AddProcedure(El: TPasProcedure; TypeParams: TFPList); virtual;
  1464. procedure AddProcedureBody(El: TProcedureBody); virtual;
  1465. procedure AddArgument(El: TPasArgument); virtual;
  1466. procedure AddFunctionResult(El: TPasResultElement); virtual;
  1467. procedure AddGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1468. procedure AddExceptOn(El: TPasImplExceptOn); virtual;
  1469. procedure AddWithDo(El: TPasImplWithDo); virtual;
  1470. procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
  1471. procedure ResolveImplElement(El: TPasImplElement); virtual;
  1472. procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
  1473. procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
  1474. procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
  1475. procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
  1476. procedure ResolveImplAssign(El: TPasImplAssign); virtual;
  1477. procedure ResolveImplSimple(El: TPasImplSimple); virtual;
  1478. procedure ResolveImplRaise(El: TPasImplRaise); virtual;
  1479. procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
  1480. procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
  1481. procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
  1482. procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
  1483. procedure ResolveInheritedName(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1484. procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1485. procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1486. procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1487. procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
  1488. procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1489. procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; TemplParams: TFPList;
  1490. Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string = ''); virtual;
  1491. procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1492. procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1493. procedure ResolveArrayParamsArgs(Params: TParamsExpr;
  1494. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
  1495. function ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  1496. const ResolvedValue: TPasResolverResult;
  1497. Access: TResolvedRefAccess): boolean; virtual;
  1498. procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
  1499. procedure ResolveArrayValues(El: TArrayValues); virtual;
  1500. procedure ResolveRecordValues(El: TRecordValues); virtual;
  1501. procedure ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr; Access: TResolvedRefAccess); virtual;
  1502. function ResolveAccessor(Expr: TPasExpr): TPasElement;
  1503. procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
  1504. Access: TResolvedRefAccess); virtual;
  1505. procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
  1506. function MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType): boolean; virtual;
  1507. procedure MarkArrayExprRecursive(Expr: TPasExpr; ArrType: TPasArrayType); virtual;
  1508. procedure FinishModule(CurModule: TPasModule); virtual;
  1509. procedure FinishUsesClause; virtual;
  1510. procedure FinishSection(Section: TPasSection); virtual;
  1511. procedure FinishInterfaceSection(Section: TPasSection); virtual;
  1512. procedure FinishTypeSection(El: TPasElement); virtual;
  1513. procedure FinishTypeSectionEl(El: TPasType); virtual;
  1514. procedure FinishTypeDef(El: TPasType); virtual;
  1515. procedure FinishEnumType(El: TPasEnumType); virtual;
  1516. procedure FinishSetType(El: TPasSetType); virtual;
  1517. procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
  1518. procedure FinishRangeType(El: TPasRangeType); virtual;
  1519. procedure FinishConstRangeExpr(RangeExpr: TBinaryExpr;
  1520. out LeftResolved, RightResolved: TPasResolverResult);
  1521. procedure FinishRecordType(El: TPasRecordType); virtual;
  1522. procedure FinishClassType(El: TPasClassType); virtual;
  1523. procedure FinishClassOfType(El: TPasClassOfType); virtual;
  1524. procedure FinishPointerType(El: TPasPointerType); virtual;
  1525. procedure FinishArrayType(El: TPasArrayType); virtual;
  1526. procedure FinishAliasType(El: TPasAliasType); virtual;
  1527. procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1528. procedure FinishSpecializeType(El: TPasSpecializeType); virtual;
  1529. procedure FinishResourcestring(El: TPasResString); virtual;
  1530. procedure FinishProcedure(Proc: TPasProcedure); virtual;
  1531. procedure FinishProcedureType(El: TPasProcedureType); virtual;
  1532. procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
  1533. procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
  1534. procedure FinishExceptOnExpr; virtual;
  1535. procedure FinishExceptOnStatement; virtual;
  1536. procedure FinishWithDo(El: TPasImplWithDo); virtual;
  1537. procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual;
  1538. procedure FinishDeclaration(El: TPasElement); virtual;
  1539. procedure FinishVariable(El: TPasVariable); virtual;
  1540. procedure FinishProperty(PropEl: TPasProperty); virtual;
  1541. procedure FinishArgument(El: TPasArgument); virtual;
  1542. procedure FinishAncestors(aClass: TPasClassType); virtual;
  1543. procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
  1544. procedure FinishAttributes(El: TPasAttributes); virtual;
  1545. procedure FinishExportSymbol(El: TPasExportSymbol); virtual;
  1546. procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
  1547. procedure FinishPropertyParamAccess(Params: TParamsExpr;
  1548. Prop: TPasProperty); virtual;
  1549. procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
  1550. procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
  1551. procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
  1552. function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
  1553. procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  1554. procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
  1555. function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
  1556. procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
  1557. procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
  1558. IsOverride: boolean // override or class intf implementation
  1559. );
  1560. procedure CheckPointerCycle(El: TPasPointerType);
  1561. procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
  1562. procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
  1563. Flags: TPasResolverComputeFlags); virtual;
  1564. procedure ComputeBinaryExpr(Bin: TBinaryExpr;
  1565. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1566. StartEl: TPasElement);
  1567. procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
  1568. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1569. var LeftResolved, RightResolved: TPasResolverResult); virtual;
  1570. function ComputeAddStringRes(
  1571. const LeftResolved, RightResolved: TPasResolverResult; ExprEl: TPasExpr;
  1572. out ResolvedEl: TPasResolverResult): boolean; virtual;
  1573. procedure ComputeArgumentAndExpr(
  1574. Arg: TPasArgument; out ArgResolved: TPasResolverResult;
  1575. Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  1576. SetReferenceFlags: boolean);
  1577. procedure ComputeArgumentExpr(const ArgResolved: TPasResolverResult;
  1578. Access: TArgumentAccess; Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  1579. SetReferenceFlags: boolean);
  1580. procedure ComputeArrayParams(Params: TParamsExpr;
  1581. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1582. StartEl: TPasElement);
  1583. procedure ComputeArrayParams_Class(Params: TParamsExpr;
  1584. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  1585. Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
  1586. procedure ComputeFuncParams(Params: TParamsExpr;
  1587. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1588. StartEl: TPasElement);
  1589. procedure ComputeTypeCast(ToLoType, ToHiType: TPasType;
  1590. Param: TPasExpr; const ParamResolved: TPasResolverResult;
  1591. out ResolvedEl: TPasResolverResult;
  1592. Flags: TPasResolverComputeFlags); virtual;
  1593. procedure ComputeSetParams(Params: TParamsExpr;
  1594. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1595. StartEl: TPasElement);
  1596. procedure ComputeDereference(El: TUnaryExpr; var ResolvedEl: TPasResolverResult);
  1597. procedure ComputeArrayValuesExpectedType(El: TArrayValues; out ResolvedEl: TPasResolverResult;
  1598. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1599. procedure ComputeRecordValues(El: TRecordValues; out ResolvedEl: TPasResolverResult;
  1600. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1601. procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
  1602. function CheckTypeCastClassInstanceToClass(
  1603. const FromClassRes, ToClassRes: TPasResolverResult;
  1604. ErrorEl: TPasElement): integer; virtual; // type cast not related classes
  1605. procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
  1606. const LHS, RHS: TPasResolverResult);
  1607. function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
  1608. ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
  1609. procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
  1610. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  1611. procedure ConvertRangeToElement(var ResolvedEl: TPasResolverResult);
  1612. function IsCharLiteral(const Value: string; ErrorPos: TPasElement): TResolverBaseType; virtual;
  1613. function CheckForIn(Loop: TPasImplForLoop;
  1614. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1615. function CheckForInClassOrRec(Loop: TPasImplForLoop;
  1616. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1617. function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
  1618. MinCount: integer; RaiseOnError: boolean): boolean;
  1619. function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1620. MaxCount: integer; RaiseOnError: boolean; Signature: string = ''): integer;
  1621. function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
  1622. const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
  1623. function FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
  1624. function FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
  1625. procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
  1626. Params: TParamsExpr); virtual;
  1627. function FindSystemIdentifier(const aUnitName, aName: string;
  1628. ErrorEl: TPasElement): TPasElement; virtual;
  1629. function FindSystemClassType(const aUnitName, aClassName: string;
  1630. ErrorEl: TPasElement): TPasClassType; virtual;
  1631. function FindSystemClassTypeAndConstructor(const aUnitName, aClassName: string;
  1632. out aClass: TPasClassType; out aConstructor: TPasConstructor;
  1633. ErrorEl: TPasElement): boolean; virtual;
  1634. procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
  1635. procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
  1636. function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
  1637. function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
  1638. function FindDefaultConstructor(aClass: TPasClassType): TPasConstructor; virtual;
  1639. function GetTypeInfoParamType(Param: TPasExpr;
  1640. out ParamResolved: TPasResolverResult; LoType: boolean): TPasType; virtual; // returns type of param in typeinfo(param)
  1641. protected
  1642. // constant evaluation
  1643. fExprEvaluator: TResExprEvaluator;
  1644. procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
  1645. MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
  1646. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); virtual;
  1647. function OnExprEvalIdentifier(Sender: TResExprEvaluator;
  1648. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1649. function OnExprEvalParams(Sender: TResExprEvaluator;
  1650. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1651. procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
  1652. var MsgType: TMessageType); virtual;
  1653. function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
  1654. protected
  1655. // generic/specialize
  1656. type
  1657. TScopeStashState = record
  1658. ScopeCount: integer;
  1659. StashCount: integer;
  1660. end;
  1661. procedure AddGenericTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1662. Scope: TPasIdentifierScope);
  1663. procedure AddSpecializedTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1664. SpecializedItem: TPRSpecializedItem; Scope: TPasIdentifierScope;
  1665. CheckConstraints: boolean);
  1666. function CreateInferenceTypesForCall(Params: TParamsExpr;
  1667. TargetProc: TPasProcedure): TFPList;
  1668. function CheckGenericConstraintFitsParam(ParamType: TPasType;
  1669. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1670. TemplType: TPasGenericTemplateType; ConEl: TPasElement;
  1671. Operation: TPRTemplateCompOp;
  1672. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1673. ): integer;
  1674. function CheckTemplateFitsParam(ParamType: TPasType;
  1675. GenTempl: TPasGenericTemplateType;
  1676. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1677. Operation: TPRTemplateCompOp;
  1678. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1679. ): integer;
  1680. function CheckTemplateFitsParamRes(GenTempl: TPasGenericTemplateType;
  1681. const ResolvedEl: TPasResolverResult;
  1682. Operation: TPRTemplateCompOp;
  1683. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1684. ): integer;
  1685. procedure CheckTemplateFitsTemplate(ParamTemplType,
  1686. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  1687. function CreateSpecializedItem(El: TPasElement; GenericEl: TPasElement;
  1688. const ParamsResolved: TPasTypeArray): TPRSpecializedItem; virtual;
  1689. function CreateSpecializedTypeName(Item: TPRSpecializedItem): string; virtual;
  1690. procedure InitSpecializeScopes(El: TPasElement; out State: TScopeStashState); virtual;
  1691. procedure RestoreSpecializeScopes(const State: TScopeStashState); virtual;
  1692. procedure SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem); virtual;
  1693. procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem); virtual;
  1694. procedure SpecializeMembers(GenMembersType, SpecMembersType: TPasMembersType); virtual;
  1695. procedure SpecializeMembersImpl(GenericType, SpecType: TPasMembersType;
  1696. SpecializedItem: TPRSpecializedTypeItem); virtual;
  1697. procedure SpecializeGenImplProc(GenDeclProc, SpecDeclProc: TPasProcedure;
  1698. SpecializedItem: TPRSpecializedItem); virtual;
  1699. procedure SpecializeElement(GenEl, SpecEl: TPasElement);
  1700. procedure SpecializePasElementProperties(GenEl, SpecEl: TPasElement);
  1701. procedure SpecializeVariable(GenEl, SpecEl: TPasVariable; Finish: boolean);
  1702. procedure SpecializeConst(GenEl, SpecEl: TPasConst);
  1703. procedure SpecializeProperty(GenEl, SpecEl: TPasProperty);
  1704. function SpecializeTypeRef(GenEl, SpecEl: TPasElement; GenTypeRef: TPasType): TPasType;
  1705. procedure SpecializeElType(GenEl, SpecEl: TPasElement;
  1706. GenElType: TPasType; var SpecElType: TPasType);
  1707. procedure SpecializeElExpr(GenEl, SpecEl: TPasElement;
  1708. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  1709. procedure SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  1710. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  1711. procedure SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  1712. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  1713. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1714. procedure SpecializeElList(GenEl, SpecEl: TPasElement;
  1715. GenList, SpecList: TFPList; AllowReferences: boolean
  1716. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1717. procedure SpecializeElArray(GenEl, SpecEl: TPasElement;
  1718. GenList: TPasElementArray; var SpecList: TPasElementArray; AllowReferences: boolean
  1719. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1720. procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure; SpecializedItem: TPRSpecializedItem); virtual;
  1721. procedure SpecializeOperator(GenEl, SpecEl: TPasOperator);
  1722. procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  1723. procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  1724. procedure SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  1725. procedure SpecializeSpecializeType(GenEl, SpecEl: TPasSpecializeType);
  1726. procedure SpecializeGenericTemplateType(GenEl, SpecEl: TPasGenericTemplateType);
  1727. procedure SpecializeArgument(GenEl, SpecEl: TPasArgument);
  1728. procedure SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  1729. procedure SpecializeImplAsmStatement(GenEl, SpecEl: TPasImplAsmStatement);
  1730. procedure SpecializeImplRepeatUntil(GenEl, SpecEl: TPasImplRepeatUntil);
  1731. procedure SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  1732. procedure SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  1733. procedure SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  1734. procedure SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  1735. procedure SpecializeImplCaseStatement(GenEl, SpecEl: TPasImplCaseStatement);
  1736. procedure SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  1737. procedure SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  1738. procedure SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  1739. procedure SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  1740. procedure SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  1741. procedure SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  1742. procedure SpecializeExpr(GenEl, SpecEl: TPasExpr);
  1743. procedure SpecializeExprArray(GenEl, SpecEl: TPasElement;
  1744. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  1745. procedure SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  1746. procedure SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  1747. procedure SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  1748. procedure SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  1749. procedure SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  1750. procedure SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  1751. procedure SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  1752. procedure SpecializeInlineSpecializeExpr(GenEl, SpecEl: TInlineSpecializeExpr);
  1753. procedure SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  1754. procedure SpecializeResString(GenEl, SpecEl: TPasResString);
  1755. procedure SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  1756. procedure SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  1757. procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  1758. procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType; SpecializedItem: TPRSpecializedTypeItem);
  1759. procedure SpecializeRecordType(GenEl, SpecEl: TPasRecordType; SpecializedItem: TPRSpecializedTypeItem);
  1760. procedure SpecializeClassType(GenEl, SpecEl: TPasClassType; SpecializedItem: TPRSpecializedTypeItem);
  1761. procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  1762. procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  1763. procedure SpecializeSetType(GenEl, SpecEl: TPasSetType);
  1764. procedure SpecializeVariant(GenEl, SpecEl: TPasVariant);
  1765. procedure SpecializeStringType(GenEl, SpecEl: TPasStringType);
  1766. procedure SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  1767. procedure SpecializeMethodResolution(GenEl, SpecEl: TPasMethodResolution);
  1768. protected
  1769. // custom types (added by descendant resolvers)
  1770. function CheckAssignCompatibilityCustom(
  1771. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1772. RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
  1773. function CheckEqualCompatibilityCustomType(
  1774. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1775. RaiseOnIncompatible: boolean): integer; virtual;
  1776. protected
  1777. // built-in functions
  1778. function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1779. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1780. procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1781. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1782. procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  1783. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1784. function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1785. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1786. procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1787. Params: TParamsExpr); virtual;
  1788. function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1789. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1790. procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1791. Params: TParamsExpr); virtual;
  1792. function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1793. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1794. function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1795. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1796. function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1797. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1798. function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1799. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1800. procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1801. Params: TParamsExpr); virtual;
  1802. function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1803. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1804. procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1805. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1806. procedure BI_Assigned_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1807. Params: TParamsExpr); virtual;
  1808. function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1809. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1810. procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1811. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1812. procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  1813. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1814. function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1815. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1816. procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1817. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1818. procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  1819. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1820. function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1821. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1822. procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1823. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1824. procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  1825. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1826. function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1827. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1828. procedure BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1829. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1830. procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  1831. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1832. function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  1833. const ParamResolved: TPasResolverResult; ArgNo: integer;
  1834. RaiseOnError: boolean): integer;
  1835. function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1836. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1837. procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1838. Params: TParamsExpr); virtual;
  1839. function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1840. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1841. procedure BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1842. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1843. procedure BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  1844. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1845. function BI_WriteStrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1846. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1847. procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1848. Params: TParamsExpr); virtual;
  1849. function BI_Val_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1850. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1851. procedure BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1852. Params: TParamsExpr); virtual;
  1853. function BI_LoHi_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1854. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1855. procedure BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1856. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1857. procedure BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  1858. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1859. function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1860. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1861. procedure BI_ConcatArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1862. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1863. function BI_ConcatString_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1864. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1865. procedure BI_ConcatString_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1866. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1867. procedure BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  1868. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1869. function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1870. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1871. procedure BI_CopyArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1872. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1873. function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1874. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1875. procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1876. Params: TParamsExpr); virtual;
  1877. function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1878. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1879. procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1880. Params: TParamsExpr); virtual;
  1881. function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1882. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1883. procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1884. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1885. function BI_GetTypeKind_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1886. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1887. procedure BI_GetTypeKind_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1888. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1889. procedure BI_GetTypeKind_OnEval(Proc: TResElDataBuiltInProc;
  1890. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1891. function BI_Assert_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1892. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1893. procedure BI_Assert_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1894. Params: TParamsExpr); virtual;
  1895. function BI_New_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1896. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1897. procedure BI_New_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1898. Params: TParamsExpr); virtual;
  1899. function BI_Dispose_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1900. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1901. procedure BI_Dispose_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1902. Params: TParamsExpr); virtual;
  1903. function BI_Default_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1904. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1905. procedure BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1906. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1907. procedure BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  1908. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1909. public
  1910. constructor Create;
  1911. destructor Destroy; override;
  1912. procedure Clear; virtual; // does not free built-in identifiers
  1913. // overrides of TPasTreeContainer
  1914. function CreateElement(AClass: TPTreeElement; const AName: String;
  1915. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1916. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1917. overload; override;
  1918. function CreateElement(AClass: TPTreeElement; const AName: String;
  1919. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1920. const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
  1921. overload; override;
  1922. function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; override;
  1923. function FindUnit(const AName, InFilename: String;
  1924. NameExpr, InFileExpr: TPasExpr): TPasModule; virtual; abstract;
  1925. function FindElement(const aName: String): TPasElement; override; // used by TPasParser
  1926. function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser
  1927. function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
  1928. NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  1929. function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
  1930. ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  1931. function FindFirstEl(const AName: String; out Data: TPRFindData;
  1932. ErrorPosEl: TPasElement): TPasElement;
  1933. procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  1934. function FindGenericEl(const AName: string; TemplateCount: integer;
  1935. out Find: TPRFindData; ErrorPosEl: TPasElement): TPasElement; virtual;
  1936. procedure IterateElements(const aName: string;
  1937. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1938. var Abort: boolean); virtual;
  1939. procedure CheckFoundElement(const FindData: TPRFindData;
  1940. Ref: TResolvedReference); virtual;
  1941. procedure CheckFoundElementVisibility(const FindData: TPRFindData;
  1942. Ref: TResolvedReference); virtual;
  1943. function GetVisibilityContext: TPasElement;
  1944. procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1945. procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1946. procedure FinishTypeAlias(var NewType: TPasType); override;
  1947. function IsUnitIntfFinished(AModule: TPasModule): boolean;
  1948. procedure NotifyPendingUsedInterfaces; virtual;
  1949. function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
  1950. function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
  1951. procedure UsedInterfacesFinished(Section: TPasSection); virtual;
  1952. function NeedArrayValues(El: TPasElement): boolean; override;
  1953. function GetDefaultClassVisibility(AClass: TPasClassType
  1954. ): TPasMemberVisibility; override;
  1955. procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  1956. Before: boolean; var Handled: boolean); override;
  1957. // built in types and functions
  1958. procedure ClearBuiltInIdentifiers; virtual;
  1959. procedure AddObjFPCBuiltInIdentifiers(
  1960. const TheBaseTypes: TResolveBaseTypes = btAllFPCTypes;
  1961. const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
  1962. function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
  1963. function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  1964. function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
  1965. function AddBuiltInProc(const aName: string; Signature: string;
  1966. const GetCallCompatibility: TOnGetCallCompatibility;
  1967. const GetCallResult: TOnGetCallResult;
  1968. const EvalConst: TOnEvalBIFunction = nil;
  1969. const FinishParamsExpr: TOnFinishParamsExpr = nil;
  1970. const BuiltIn: TResolverBuiltInProc = bfCustom;
  1971. const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
  1972. // add extra TResolveData (E.CustomData) to free list
  1973. procedure AddResolveData(El: TPasElement; Data: TResolveData;
  1974. Kind: TResolveDataListKind);
  1975. function CreateReference(DeclEl, RefEl: TPasElement;
  1976. Access: TResolvedRefAccess;
  1977. FindData: PPRFindData = nil): TResolvedReference; virtual;
  1978. // scopes
  1979. function GetLocalScope: TPasScope; inline;
  1980. function GetParentLocalScope: TPasScope; inline;
  1981. function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
  1982. function CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean = true): TPasGroupScope; virtual;
  1983. procedure GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope; HiType: TPasType; WithTopHelpers: boolean = true);
  1984. procedure PopScope;
  1985. procedure PopWithScope(El: TPasImplWithDo);
  1986. procedure PopGenericParamScope(El: TPasGenericType); virtual;
  1987. procedure PushScope(Scope: TPasScope); overload;
  1988. function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
  1989. function PushGroupScope(HiType: TPasType): TPasGroupScope;
  1990. function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  1991. function PushClassDotScope(var CurClassType: TPasClassType; WithTopHelpers: boolean = true): TPasDotClassScope;
  1992. function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  1993. function PushInheritedScope(ClassOrRec: TPasMembersType;
  1994. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  1995. function PushEnumDotScope(HiType: TPasType; EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  1996. function PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  1997. function PushTemplateDotScope(TemplType: TPasGenericTemplateType; ErrorEl: TPasElement): TPasDotBaseScope;
  1998. function PushDotScope(HiType: TPasType): TPasDotBaseScope;
  1999. function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  2000. function StashScopes(NewScopeCnt: integer): integer; // returns old StashDepth
  2001. function StashSubExprScopes: integer; // returns old StashDepth
  2002. procedure RestoreStashedScopes(StashDepth: integer);
  2003. procedure DeleteScope(Index: integer); virtual;
  2004. procedure InsertScope(Scope: TPasScope; Index: integer); virtual;
  2005. function GetCurrentProcScope(ErrorEl: TPasElement): TPasProcedureScope;
  2006. function GetProcScope(El: TPasElement): TPasProcedureScope;
  2007. function GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  2008. function GetSelfScope(El: TPasElement): TPasProcedureScope;
  2009. procedure AddHelper(Helper: TPasClassType; var List: TPRHelperEntryArray);
  2010. procedure AddActiveHelper(Helper: TPasClassType); virtual;
  2011. // log and messages
  2012. class function MangleSourceLineNumber(Line, Column: integer): integer;
  2013. class procedure UnmangleSourceLineNumber(LineNumber: integer;
  2014. out Line, Column: integer);
  2015. class function GetDbgSourcePosStr(El: TPasElement): string;
  2016. function GetElementSourcePosStr(El: TPasElement): string;
  2017. procedure SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  2018. Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2019. PosEl: TPasElement);
  2020. procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  2021. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2022. PosEl: TPasElement); overload;
  2023. class function GetWarnIdentifierNumbers(Identifier: string;
  2024. out MsgNumbers: TIntegerDynArray): boolean; virtual;
  2025. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasResolverResult;
  2026. out GotDesc, ExpDesc: String); overload;
  2027. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
  2028. out GotDesc, ExpDesc: String); overload;
  2029. procedure GetIncompatibleProcParamsDesc(GotType, ExpType: TPasProcedureType;
  2030. out GotDesc, ExpDesc: string);
  2031. procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
  2032. Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2033. ErrorPosEl: TPasElement); virtual;
  2034. procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
  2035. procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
  2036. procedure RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
  2037. procedure RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string; El: TPasElement);
  2038. procedure RaiseXExpectedButYFound(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  2039. procedure RaiseXExpectedButTypeYFound(id: TMaxPrecInt; const X: string; Y: TPasType; El: TPasElement);
  2040. procedure RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C,X,Y: string; El: TPasElement);
  2041. procedure RaiseContextXInvalidY(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  2042. procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  2043. procedure RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement; IdentEl: TPasElement);
  2044. procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  2045. procedure RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  2046. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2047. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  2048. procedure RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  2049. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2050. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  2051. procedure RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  2052. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2053. const GotType, ExpType: TPasResolverResult;
  2054. ErrorEl: TPasElement);
  2055. procedure RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt; ErrorEl: TPasElement);
  2056. procedure RaiseInvalidProcTypeModifier(id: TMaxPrecInt; ProcType: TPasProcedureType;
  2057. ptm: TProcTypeModifier; ErrorEl: TPasElement);
  2058. procedure RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  2059. pm: TProcedureModifier; ErrorEl: TPasElement);
  2060. procedure WriteScopes;
  2061. procedure WriteScopesShort(Title: string);
  2062. // find value and type of an element
  2063. procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
  2064. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  2065. procedure ComputeResultElement(El: TPasResultElement; out ResolvedEl: TPasResolverResult;
  2066. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
  2067. function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2068. function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2069. // checking compatibilility
  2070. function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same
  2071. function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
  2072. function IndexOfGenericParam(Params: TPasExprArray): integer;
  2073. procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  2074. ErrorEl: TPasElement);
  2075. function CheckCallProcCompatibility(ProcType: TPasProcedureType;
  2076. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  2077. function CheckCallPropertyCompatibility(PropEl: TPasProperty;
  2078. Params: TParamsExpr; RaiseOnError: boolean): integer;
  2079. function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  2080. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
  2081. function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
  2082. ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  2083. function CheckParamResCompatibility(Expr: TPasExpr; const ExprResolved,
  2084. ParamResolved: TPasResolverResult; ParamNo: integer; RaiseOnError: boolean;
  2085. SetReferenceFlags: boolean): integer;
  2086. function CheckAssignCompatibilityUserType(
  2087. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2088. RaiseOnIncompatible: boolean): integer;
  2089. function CheckAssignCompatibilityArrayType(
  2090. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2091. RaiseOnIncompatible: boolean): integer;
  2092. function CheckAssignCompatibilityPointerType(LTypeEl, RTypeEl: TPasType;
  2093. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2094. function CheckEqualCompatibilityUserType(
  2095. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2096. RaiseOnIncompatible: boolean): integer; virtual; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  2097. function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
  2098. function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
  2099. ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
  2100. function CheckTypeCastArray(FromType, ToType: TPasArrayType;
  2101. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  2102. function CheckSrcIsADstType(
  2103. const ResolvedSrcType, ResolvedDestType: TPasResolverResult): integer;
  2104. function CheckClassIsClass(SrcType, DestType: TPasType): integer; virtual;
  2105. function CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  2106. function CheckAssignCompatibilityClasses(LType, RType: TPasClassType): integer; virtual; // not related classes
  2107. function GetClassImplementsIntf(ClassEl, Intf: TPasClassType): TPasClassType;
  2108. function CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  2109. function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
  2110. IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
  2111. function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): integer;
  2112. function CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  2113. ResolveAlias: TPRResolveAlias): integer;
  2114. function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  2115. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  2116. function CheckAssignCompatibility(const LHS, RHS: TPasElement;
  2117. RaiseOnIncompatible: boolean = true; ErrorEl: TPasElement = nil): integer;
  2118. procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  2119. procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
  2120. RValue: TResEvalValue; RHS: TPasExpr); virtual;
  2121. function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
  2122. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2123. function CheckEqualElCompatibility(Left, Right: TPasElement;
  2124. ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2125. SetReferenceFlags: boolean = false): integer;
  2126. function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
  2127. LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2128. RErrorEl: TPasElement = nil): integer;
  2129. function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
  2130. function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
  2131. PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
  2132. function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
  2133. // utility functions
  2134. function GetResolver(El: TPasElement): TPasResolver;
  2135. function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
  2136. function GetElModeSwitches(El: TPasElement): TModeSwitches;
  2137. function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
  2138. function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  2139. function GetProcTypeDescription(ProcType: TPasProcedureType;
  2140. Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
  2141. function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
  2142. function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
  2143. function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2144. function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2145. function GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  2146. function GetProcTemplateTypes(Proc: TPasProcedure): TFPList; // list of TPasGenericTemplateType
  2147. function GetProcName(Proc: TPasProcedure; WithTemplates: boolean = true): string;
  2148. function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
  2149. function GetPasPropertyType(El: TPasProperty): TPasType;
  2150. function GetPasPropertyArgs(El: TPasProperty): TFPList;
  2151. function GetPasPropertyGetter(El: TPasProperty): TPasElement;
  2152. function GetPasPropertySetter(El: TPasProperty): TPasElement;
  2153. function GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  2154. function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  2155. function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  2156. function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
  2157. function GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
  2158. function GetParentProcBody(El: TPasElement): TProcedureBody;
  2159. function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
  2160. function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
  2161. function GetLoop(El: TPasElement): TPasImplElement;
  2162. function ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean = true): TPasType;
  2163. function ResolveAliasTypeEl(El: TPasElement): TPasType; inline;
  2164. function ExprIsAddrTarget(El: TPasExpr): boolean;
  2165. function IsNameExpr(El: TPasExpr): boolean; inline; // TPrimitiveExpr with Kind=pekIdent
  2166. function GetNameExprValue(El: TPasExpr): string; // TPrimitiveExpr with Kind=pekIdent
  2167. function GetNextDottedExpr(El: TPasExpr): TPasExpr;
  2168. function GetLeftMostExpr(El: TPasExpr): TPasExpr;
  2169. function GetRightMostExpr(El: TPasExpr): TPasExpr;
  2170. procedure GetParamsOfNameExpr(El: TPasExpr; out ParentParams: TPRParentParams);
  2171. function GetInlineSpecOfNameExpr(El: TPasExpr): TInlineSpecializeExpr;
  2172. function GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  2173. function GetPathStart(El: TPasExpr): TPasExpr;
  2174. function GetPathEndIdent(El: TPasExpr; AllowCall: boolean): TPasExpr;
  2175. function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  2176. function ParentNeedsExprResult(El: TPasExpr): boolean;
  2177. function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
  2178. function GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  2179. function GetSetType(const ResolvedSet: TPasResolverResult): TPasSetType;
  2180. function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
  2181. function IsOpenArray(TypeEl: TPasType): boolean;
  2182. function IsDynOrOpenArray(TypeEl: TPasType): boolean;
  2183. function IsArrayOfConst(TypeEl: TPasType): boolean;
  2184. function GetArrayElType(ArrType: TPasArrayType): TPasType;
  2185. function IsVarInit(Expr: TPasExpr): boolean;
  2186. function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  2187. function IsClassMethod(El: TPasElement): boolean;
  2188. function IsClassField(El: TPasElement): boolean;
  2189. function GetFunctionType(El: TPasElement): TPasFunctionType;
  2190. function MethodIsStatic(El: TPasProcedure): boolean; // does not check if El is a method
  2191. function IsMethod(El: TPasProcedure): boolean;
  2192. function IsMethod_SelfIsClass(El: TPasElement): boolean;
  2193. function IsHelperMethod(El: TPasElement): boolean; virtual;
  2194. function IsHelper(El: TPasElement): boolean;
  2195. function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
  2196. function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
  2197. function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
  2198. function IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  2199. function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  2200. function IsTypeCast(Params: TParamsExpr): boolean;
  2201. function IsGenericTemplType(const ResolvedEl: TPasResolverResult): boolean;
  2202. function GetTypeParameterCount(aType: TPasGenericType): integer;
  2203. function GetGenericConstraintKeyword(El: TPasElement): TToken;
  2204. function GetGenericConstraintErrorEl(ConstraintEl, TemplType: TPasElement): TPasElement;
  2205. function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  2206. Params: TFPList): TPasElement; virtual;
  2207. procedure FinishGenericClassOrRecIntf(Scope: TPasGenericScope); virtual;
  2208. procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
  2209. procedure CheckPendingForwardProcs(El: TPasElement); virtual;
  2210. function IsSpecialized(El: TPasGenericType): boolean; overload;
  2211. function IsFullySpecialized(El: TPasGenericType): boolean; overload;
  2212. function IsFullySpecialized(Proc: TPasProcedure): boolean; overload;
  2213. function IsInterfaceType(const ResolvedEl: TPasResolverResult;
  2214. IntfType: TPasClassInterfaceType): boolean; overload;
  2215. function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
  2216. function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
  2217. function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
  2218. function IsCustomAttribute(El: TPasElement): boolean; virtual;
  2219. function IsSystemUnit(El: TPasModule): boolean; virtual;
  2220. function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
  2221. function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
  2222. function ProcNeedsParams(El: TPasProcedureType): boolean;
  2223. function ProcHasSelf(El: TPasProcedure): boolean; // returns false for local procs
  2224. procedure CreateProcSelfArg(Proc: TPasProcedure); virtual;
  2225. function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
  2226. function GetTopLvlProc(El: TPasElement): TPasProcedure;
  2227. function GetParentProc(El: TPasElement; GetDeclProc: boolean): TPasProcedure;
  2228. function GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  2229. function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  2230. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
  2231. function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
  2232. function HasTypeInfo(El: TPasType): boolean; virtual;
  2233. function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
  2234. function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2235. function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2236. procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
  2237. function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: TMaxPrecInt): boolean;
  2238. function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
  2239. function GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt): TResolverBaseType; // returns BaseTypeExtended if too big
  2240. function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2241. function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2242. function GetCombinedBaseType(const A, B: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2243. function IsElementSkipped(El: TPasElement): boolean; virtual;
  2244. function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
  2245. function GetFirstSection(WithUnitImpl: boolean): TPasSection;
  2246. function GetLastSection: TPasSection;
  2247. function GetParentSection(El: TPasElement): TPasSection;
  2248. function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
  2249. function FirstSectionUsesUnit(aModule: TPasModule): boolean;
  2250. function ImplementationUsesUnit(aModule: TPasModule; NotInIntf: boolean = true): boolean;
  2251. function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  2252. isLoFunc: Boolean; out Mask: LongWord): Integer;
  2253. public
  2254. property Hub: TPasResolverHub read FHub write FHub;
  2255. // options
  2256. property Options: TPasResolverOptions read FOptions write FOptions;
  2257. property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
  2258. write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
  2259. property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
  2260. property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
  2261. property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
  2262. property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
  2263. property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
  2264. property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
  2265. property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
  2266. property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
  2267. property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
  2268. property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
  2269. property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
  2270. If true Line and Column is mangled together in TPasElement.SourceLineNumber.
  2271. Use method UnmangleSourceLineNumber to extract. }
  2272. // parsed values
  2273. property DefaultNameSpace: String read FDefaultNameSpace;
  2274. property RootElement: TPasModule read FRootElement write SetRootElement;
  2275. property Step: TPasResolverStep read FStep;
  2276. property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers;
  2277. property FinishedInterfaceIndex: integer read FFinishedInterfaceIndex;
  2278. // scopes
  2279. property Scopes[Index: integer]: TPasScope read GetScopes;
  2280. property ScopeCount: integer read FScopeCount;
  2281. property TopScope: TPasScope read FTopScope;
  2282. property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
  2283. property ScopeClass_Array: TPasArrayScopeClass read FScopeClass_Array write FScopeClass_Array;
  2284. property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
  2285. property ScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass read FScopeClass_InitialFinalization write FScopeClass_InitialFinalization;
  2286. property ScopeClass_Module: TPasModuleScopeClass read FScopeClass_Module write FScopeClass_Module;
  2287. property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
  2288. property ScopeClass_ProcType: TPasProcTypeScopeClass read FScopeClass_ProcType write FScopeClass_ProcType;
  2289. property ScopeClass_Record: TPasRecordScopeClass read FScopeClass_Record write FScopeClass_Record;
  2290. property ScopeClass_Section: TPasSectionScopeClass read FScopeClass_Section write FScopeClass_Section;
  2291. property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
  2292. // last element
  2293. property LastElement: TPasElement read FLastElement;
  2294. property LastMsg: string read FLastMsg write FLastMsg;
  2295. property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
  2296. property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
  2297. property LastMsgId: TMaxPrecInt read FLastMsgId write FLastMsgId;
  2298. property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
  2299. property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
  2300. property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
  2301. property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
  2302. end;
  2303. function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
  2304. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2305. function GetClassAncestorsDbg(El: TPasClassType): string;
  2306. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2307. function GetElementTypeName(El: TPasElement): string; overload;
  2308. function GetElementTypeName(C: TPasElementBaseClass): string; overload;
  2309. function GetElementDbgPath(El: TPasElement): string; overload;
  2310. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2311. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2312. BaseType: TResolverBaseType; IdentEl: TPasElement;
  2313. LoTypeEl, HiTypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
  2314. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2315. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2316. Flags: TPasResolverResultFlags); overload;
  2317. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2318. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2319. Flags: TPasResolverResultFlags); overload;
  2320. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2321. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2322. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2323. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2324. function ChompDottedIdentifier(const Identifier: string): string;
  2325. function FirstDottedIdentifier(const Identifier: string): string; // without <>
  2326. function LastDottedIdentifier(const Identifier: string): string; // without <>
  2327. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2328. function GetFirstDotPos(const Identifier: string): integer;
  2329. function GetLastDotPos(const Identifier: string): integer;
  2330. {$IF FPC_FULLVERSION<30101}
  2331. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2332. {$ENDIF}
  2333. function DotExprToName(Expr: TPasExpr): string;
  2334. function NoNil(o: TObject): TObject;
  2335. function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
  2336. function dbgs(const a: TResolvedRefAccess): string; overload;
  2337. function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
  2338. function dbgs(const a: TPSRefAccess): string; overload;
  2339. implementation
  2340. function GetTreeDbg(El: TPasElement; Indent: integer): string;
  2341. procedure LineBreak(SubIndent: integer);
  2342. begin
  2343. Inc(Indent,SubIndent);
  2344. Result:=Result+LineEnding+StringOfChar(' ',Indent);
  2345. end;
  2346. var
  2347. i, l: Integer;
  2348. begin
  2349. if El=nil then exit('nil');
  2350. Result:=El.Name+':'+El.ClassName+'=';
  2351. if El is TPasExpr then
  2352. begin
  2353. if El.ClassType<>TBinaryExpr then
  2354. Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
  2355. if El.ClassType=TUnaryExpr then
  2356. Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
  2357. else if El.ClassType=TBinaryExpr then
  2358. Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
  2359. +OpcodeStrings[TPasExpr(El).OpCode]
  2360. +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
  2361. else if El.ClassType=TPrimitiveExpr then
  2362. Result:=Result+TPrimitiveExpr(El).Value
  2363. else if El.ClassType=TBoolConstExpr then
  2364. Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
  2365. else if El.ClassType=TNilExpr then
  2366. Result:=Result+'nil'
  2367. else if El.ClassType=TInheritedExpr then
  2368. Result:=Result+'inherited'
  2369. else if El.ClassType=TSelfExpr then
  2370. Result:=Result+'Self'
  2371. else if El.ClassType=TParamsExpr then
  2372. begin
  2373. LineBreak(2);
  2374. Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
  2375. l:=length(TParamsExpr(El).Params);
  2376. if l>0 then
  2377. begin
  2378. inc(Indent,2);
  2379. for i:=0 to l-1 do
  2380. begin
  2381. LineBreak(0);
  2382. Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
  2383. if i<l-1 then
  2384. Result:=Result+','
  2385. end;
  2386. dec(Indent,2);
  2387. end;
  2388. Result:=Result+')';
  2389. end
  2390. else if El.ClassType=TRecordValues then
  2391. begin
  2392. Result:=Result+'(';
  2393. l:=length(TRecordValues(El).Fields);
  2394. if l>0 then
  2395. begin
  2396. inc(Indent,2);
  2397. for i:=0 to l-1 do
  2398. begin
  2399. LineBreak(0);
  2400. Result:=Result+TRecordValues(El).Fields[i].Name+':'
  2401. +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
  2402. if i<l-1 then
  2403. Result:=Result+','
  2404. end;
  2405. dec(Indent,2);
  2406. end;
  2407. Result:=Result+')';
  2408. end
  2409. else if El.ClassType=TArrayValues then
  2410. begin
  2411. Result:=Result+'[';
  2412. l:=length(TArrayValues(El).Values);
  2413. if l>0 then
  2414. begin
  2415. inc(Indent,2);
  2416. for i:=0 to l-1 do
  2417. begin
  2418. LineBreak(0);
  2419. Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
  2420. if i<l-1 then
  2421. Result:=Result+','
  2422. end;
  2423. dec(Indent,2);
  2424. end;
  2425. Result:=Result+']';
  2426. end;
  2427. end
  2428. else if El is TPasProcedure then
  2429. begin
  2430. Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
  2431. end
  2432. else if El is TPasProcedureType then
  2433. begin
  2434. if TPasProcedureType(El).IsReferenceTo then
  2435. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2436. Result:=Result+'(';
  2437. l:=TPasProcedureType(El).Args.Count;
  2438. if l>0 then
  2439. begin
  2440. inc(Indent,2);
  2441. for i:=0 to l-1 do
  2442. begin
  2443. LineBreak(0);
  2444. Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
  2445. if i<l-1 then
  2446. Result:=Result+';'
  2447. end;
  2448. dec(Indent,2);
  2449. end;
  2450. Result:=Result+')';
  2451. if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
  2452. Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
  2453. if TPasProcedureType(El).IsOfObject then
  2454. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  2455. if TPasProcedureType(El).IsNested then
  2456. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2457. if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
  2458. Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
  2459. end
  2460. else if El.ClassType=TPasResultElement then
  2461. Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
  2462. else if El.ClassType=TPasArgument then
  2463. begin
  2464. if AccessNames[TPasArgument(El).Access]<>'' then
  2465. Result:=Result+AccessNames[TPasArgument(El).Access];
  2466. if TPasArgument(El).ArgType=nil then
  2467. Result:=Result+'untyped'
  2468. else
  2469. Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
  2470. end
  2471. else if El.ClassType=TPasUnresolvedSymbolRef then
  2472. begin
  2473. if El.CustomData is TResElDataBuiltInProc then
  2474. Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
  2475. end;
  2476. end;
  2477. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2478. var
  2479. HiTypeEl: TPasType;
  2480. begin
  2481. Result:='[bt='+ResBaseTypeNames[T.BaseType];
  2482. if T.SubType<>btNone then
  2483. Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
  2484. Result:=Result
  2485. +' Ident='+GetObjName(T.IdentEl);
  2486. HiTypeEl:=ResolveSimpleAliasType(T.HiTypeEl);
  2487. if HiTypeEl<>T.LoTypeEl then
  2488. Result:=Result+' LoType='+GetObjName(T.LoTypeEl)+' HiTypeEl='+GetObjName(HiTypeEl)
  2489. else
  2490. Result:=Result+' Type='+GetObjName(T.LoTypeEl);
  2491. Result:=Result
  2492. +' Expr='+GetObjName(T.ExprEl)
  2493. +' Flags='+ResolverResultFlagsToStr(T.Flags)
  2494. +']';
  2495. end;
  2496. function GetClassAncestorsDbg(El: TPasClassType): string;
  2497. function GetClassDesc(C: TPasClassType): string;
  2498. var
  2499. Module: TPasModule;
  2500. begin
  2501. if C.IsExternal then
  2502. Result:='class external '
  2503. else
  2504. Result:='class ';
  2505. Module:=C.GetModule;
  2506. if Module<>nil then
  2507. Result:=Result+Module.Name+'.';
  2508. Result:=Result+GetElementDbgPath(C);
  2509. end;
  2510. var
  2511. Scope, AncestorScope: TPasClassScope;
  2512. AncestorEl: TPasClassType;
  2513. begin
  2514. if El=nil then exit('nil');
  2515. Result:=GetClassDesc(El);
  2516. if El.CustomData is TPasClassScope then
  2517. begin
  2518. Scope:=TPasClassScope(El.CustomData);
  2519. AncestorScope:=Scope.AncestorScope;
  2520. while AncestorScope<>nil do
  2521. begin
  2522. Result:=Result+LineEnding+' ';
  2523. AncestorEl:=NoNil(AncestorScope.Element) as TPasClassType;
  2524. Result:=Result+GetClassDesc(AncestorEl);
  2525. AncestorScope:=AncestorScope.AncestorScope;
  2526. end;
  2527. end;
  2528. end;
  2529. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2530. var
  2531. f: TPasResolverResultFlag;
  2532. s: string;
  2533. begin
  2534. Result:='';
  2535. for f in Flags do
  2536. begin
  2537. if Result<>'' then Result:=Result+',';
  2538. str(f,s);
  2539. Result:=Result+s;
  2540. end;
  2541. Result:='['+Result+']';
  2542. end;
  2543. function GetElementTypeName(El: TPasElement): string;
  2544. var
  2545. C: TClass;
  2546. begin
  2547. if El=nil then
  2548. exit('?');
  2549. C:=El.ClassType;
  2550. if C=TPrimitiveExpr then
  2551. Result:=ExprKindNames[TPrimitiveExpr(El).Kind]
  2552. else if C=TUnaryExpr then
  2553. Result:='unary '+OpcodeStrings[TUnaryExpr(El).OpCode]
  2554. else if C=TBinaryExpr then
  2555. Result:=ExprKindNames[TBinaryExpr(El).Kind]
  2556. else if C=TPasClassType then
  2557. Result:=ObjKindNames[TPasClassType(El).ObjKind]
  2558. else if C=TPasUnresolvedSymbolRef then
  2559. Result:=El.Name
  2560. else
  2561. begin
  2562. Result:=GetElementTypeName(TPasElementBaseClass(C));
  2563. if Result='' then
  2564. Result:=El.ElementTypeName;
  2565. end;
  2566. end;
  2567. function GetElementTypeName(C: TPasElementBaseClass): string;
  2568. begin
  2569. if C=nil then
  2570. exit('nil');
  2571. if C=TPrimitiveExpr then
  2572. Result:='primitive expression'
  2573. else if C=TUnaryExpr then
  2574. Result:='unary expression'
  2575. else if C=TBinaryExpr then
  2576. Result:='binary expression'
  2577. else if C=TBoolConstExpr then
  2578. Result:='boolean const'
  2579. else if C=TNilExpr then
  2580. Result:='nil'
  2581. else if C=TPasAliasType then
  2582. Result:='alias'
  2583. else if C=TPasPointerType then
  2584. Result:='pointer'
  2585. else if C=TPasTypeAliasType then
  2586. Result:='type alias'
  2587. else if C=TPasClassOfType then
  2588. Result:='class of'
  2589. else if C=TPasSpecializeType then
  2590. Result:='specialize'
  2591. else if C=TInlineSpecializeExpr then
  2592. Result:='inline-specialize'
  2593. else if C=TPasRangeType then
  2594. Result:='range'
  2595. else if C=TPasArrayType then
  2596. Result:='array'
  2597. else if C=TPasFileType then
  2598. Result:='file'
  2599. else if C=TPasEnumValue then
  2600. Result:='enum value'
  2601. else if C=TPasEnumType then
  2602. Result:='enum type'
  2603. else if C=TPasSetType then
  2604. Result:='set'
  2605. else if C=TPasRecordType then
  2606. Result:='record'
  2607. else if C=TPasClassType then
  2608. Result:='class'
  2609. else if C=TPasArgument then
  2610. Result:='parameter'
  2611. else if C=TPasProcedureType then
  2612. Result:='procedural type'
  2613. else if C=TPasResultElement then
  2614. Result:='function result'
  2615. else if C=TPasFunctionType then
  2616. Result:='functional type'
  2617. else if C=TPasStringType then
  2618. Result:='string[]'
  2619. else if C=TPasVariable then
  2620. Result:='var'
  2621. else if C=TPasExportSymbol then
  2622. Result:='export'
  2623. else if C=TPasConst then
  2624. Result:='const'
  2625. else if C=TPasProperty then
  2626. Result:='property'
  2627. else if C=TPasProcedure then
  2628. Result:='procedure'
  2629. else if C=TPasFunction then
  2630. Result:='function'
  2631. else if C=TPasOperator then
  2632. Result:='operator'
  2633. else if C=TPasClassOperator then
  2634. Result:='class operator'
  2635. else if C=TPasConstructor then
  2636. Result:='constructor'
  2637. else if C=TPasClassConstructor then
  2638. Result:='class constructor'
  2639. else if C=TPasDestructor then
  2640. Result:='destructor'
  2641. else if C=TPasClassDestructor then
  2642. Result:='class destructor'
  2643. else if C=TPasClassProcedure then
  2644. Result:='class procedure'
  2645. else if C=TPasClassFunction then
  2646. Result:='class function'
  2647. else if C=TPasAnonymousProcedure then
  2648. Result:='anonymous procedure'
  2649. else if C=TPasAnonymousFunction then
  2650. Result:='anonymous function'
  2651. else if C=TPasMethodResolution then
  2652. Result:='method resolution'
  2653. else if C=TInterfaceSection then
  2654. Result:='interfacesection'
  2655. else if C=TImplementationSection then
  2656. Result:='implementation'
  2657. else if C=TProgramSection then
  2658. Result:='program section'
  2659. else if C=TLibrarySection then
  2660. Result:='library section'
  2661. else
  2662. Result:=C.ClassName;
  2663. end;
  2664. function GetElementDbgPath(El: TPasElement): string;
  2665. begin
  2666. if El=nil then exit('nil');
  2667. Result:='';
  2668. while El<>nil do
  2669. begin
  2670. if Result<>'' then Result:='.'+Result;
  2671. if El.Name<>'' then
  2672. Result:=El.Name+Result
  2673. else
  2674. Result:=GetElementTypeName(El)+Result;
  2675. El:=El.Parent;
  2676. end;
  2677. end;
  2678. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2679. var
  2680. C: TClass;
  2681. begin
  2682. while aType<>nil do
  2683. begin
  2684. C:=aType.ClassType;
  2685. if (C=TPasAliasType) then
  2686. aType:=TPasAliasType(aType).DestType
  2687. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  2688. and (aType.CustomData is TResolvedReference) then
  2689. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  2690. else
  2691. exit(aType);
  2692. end;
  2693. Result:=nil;
  2694. end;
  2695. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2696. BaseType: TResolverBaseType; IdentEl: TPasElement; LoTypeEl,
  2697. HiTypeEl: TPasType; Flags: TPasResolverResultFlags);
  2698. begin
  2699. if IdentEl is TPasExpr then
  2700. raise Exception.Create('20170729101017');
  2701. ResolvedType.BaseType:=BaseType;
  2702. ResolvedType.SubType:=btNone;
  2703. ResolvedType.IdentEl:=IdentEl;
  2704. ResolvedType.HiTypeEl:=HiTypeEl;
  2705. ResolvedType.LoTypeEl:=LoTypeEl;
  2706. ResolvedType.ExprEl:=nil;
  2707. ResolvedType.Flags:=Flags;
  2708. end;
  2709. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2710. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2711. Flags: TPasResolverResultFlags);
  2712. begin
  2713. ResolvedType.BaseType:=BaseType;
  2714. ResolvedType.SubType:=btNone;
  2715. ResolvedType.IdentEl:=nil;
  2716. ResolvedType.HiTypeEl:=HiTypeEl;
  2717. ResolvedType.LoTypeEl:=LoTypeEl;
  2718. ResolvedType.ExprEl:=nil;
  2719. ResolvedType.Flags:=Flags;
  2720. end;
  2721. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2722. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2723. Flags: TPasResolverResultFlags);
  2724. begin
  2725. ResolvedType.BaseType:=BaseType;
  2726. ResolvedType.SubType:=btNone;
  2727. ResolvedType.IdentEl:=nil;
  2728. ResolvedType.HiTypeEl:=HiTypeEl;
  2729. ResolvedType.LoTypeEl:=LoTypeEl;
  2730. ResolvedType.ExprEl:=ExprEl;
  2731. ResolvedType.Flags:=Flags;
  2732. end;
  2733. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2734. begin
  2735. Result:=true;
  2736. if Proc.IsExternal then exit(false);
  2737. if Proc.IsForward then exit;
  2738. if Proc.Parent.ClassType=TInterfaceSection then exit;
  2739. if Proc.Parent.ClassType=TPasClassType then
  2740. begin
  2741. // a method declaration
  2742. if not Proc.IsAbstract then exit;
  2743. end;
  2744. Result:=false;
  2745. end;
  2746. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2747. var
  2748. C: TClass;
  2749. begin
  2750. if Proc.IsForward or Proc.IsExternal then exit(false);
  2751. C:=Proc.Parent.ClassType;
  2752. if (C=TInterfaceSection) or C.InheritsFrom(TPasClassType) then exit(false);
  2753. Result:=true;
  2754. end;
  2755. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2756. var
  2757. Data: TObject;
  2758. begin
  2759. if Proc.IsOverload then
  2760. exit(true);
  2761. Data:=Proc.CustomData;
  2762. Result:=(Data is TPasProcedureScope)
  2763. and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
  2764. end;
  2765. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2766. var
  2767. i: Integer;
  2768. begin
  2769. if length(List)=0 then exit;
  2770. for i:=0 to length(List)-1 do
  2771. TPRHelperEntry(List[i]).Free;
  2772. List:=nil;
  2773. end;
  2774. function ChompDottedIdentifier(const Identifier: string): string;
  2775. var
  2776. p, Lvl: Integer;
  2777. begin
  2778. Result:=Identifier;
  2779. p:=length(Identifier);
  2780. Lvl:=0;
  2781. while (p>0) do
  2782. begin
  2783. case Identifier[p] of
  2784. '.': if Lvl=0 then break;
  2785. '>': inc(Lvl);
  2786. '<': dec(Lvl);
  2787. end;
  2788. dec(p);
  2789. end;
  2790. Result:=LeftStr(Identifier,p-1);
  2791. end;
  2792. function FirstDottedIdentifier(const Identifier: string): string;
  2793. var
  2794. p, l: SizeInt;
  2795. begin
  2796. p:=1;
  2797. l:=length(Identifier);
  2798. repeat
  2799. if p>l then
  2800. exit(Identifier)
  2801. else if Identifier[p] in ['<','.'] then
  2802. exit(LeftStr(Identifier,p-1))
  2803. else
  2804. inc(p);
  2805. until false;
  2806. end;
  2807. function LastDottedIdentifier(const Identifier: string): string;
  2808. var
  2809. p, Lvl, EndP: Integer;
  2810. begin
  2811. p:=length(Identifier);
  2812. EndP:=p;
  2813. Lvl:=0;
  2814. while (p>0) do
  2815. begin
  2816. case Identifier[p] of
  2817. '.': if Lvl=0 then break;
  2818. '>': inc(Lvl);
  2819. '<':
  2820. begin
  2821. dec(Lvl);
  2822. EndP:=p-1;
  2823. end;
  2824. end;
  2825. dec(p);
  2826. end;
  2827. Result:=copy(Identifier,p+1,EndP-p);
  2828. end;
  2829. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2830. var
  2831. l: Integer;
  2832. begin
  2833. l:=length(Prefix);
  2834. if (l>length(Identifier))
  2835. or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
  2836. exit(false);
  2837. Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
  2838. end;
  2839. function GetFirstDotPos(const Identifier: string): integer;
  2840. var
  2841. l: SizeInt;
  2842. Lvl: Integer;
  2843. begin
  2844. Result:=1;
  2845. l:=length(Identifier);
  2846. Lvl:=0;
  2847. repeat
  2848. if Result>l then
  2849. exit(-1);
  2850. case Identifier[Result] of
  2851. '.': if Lvl=0 then exit;
  2852. '<': inc(Lvl);
  2853. '>': dec(Lvl);
  2854. end;
  2855. inc(Result);
  2856. until false;
  2857. end;
  2858. function GetLastDotPos(const Identifier: string): integer;
  2859. var
  2860. Lvl: Integer;
  2861. begin
  2862. Result:=length(Identifier);
  2863. Lvl:=0;
  2864. while (Result>0) do
  2865. begin
  2866. case Identifier[Result] of
  2867. '.': if Lvl=0 then exit;
  2868. '>': inc(Lvl);
  2869. '<': dec(Lvl);
  2870. end;
  2871. dec(Result);
  2872. end;
  2873. end;
  2874. function DotExprToName(Expr: TPasExpr): string;
  2875. var
  2876. C: TClass;
  2877. Prim: TPrimitiveExpr;
  2878. Bin: TBinaryExpr;
  2879. s: String;
  2880. begin
  2881. Result:='';
  2882. if Expr=nil then exit;
  2883. C:=Expr.ClassType;
  2884. if C=TPrimitiveExpr then
  2885. begin
  2886. Prim:=TPrimitiveExpr(Expr);
  2887. case Prim.Kind of
  2888. pekIdent,pekString: Result:=Prim.Value;
  2889. pekSelf: Result:='Self';
  2890. else
  2891. EPasResolve.Create('[20180309155400] DotExprToName '+GetObjName(Prim)+' '+ExprKindNames[Prim.Kind]);
  2892. end;
  2893. end
  2894. else if C=TBinaryExpr then
  2895. begin
  2896. Bin:=TBinaryExpr(Expr);
  2897. if Bin.OpCode=eopSubIdent then
  2898. begin
  2899. Result:=DotExprToName(Bin.left);
  2900. if Result='' then exit;
  2901. s:=DotExprToName(Bin.right);
  2902. if s='' then exit('');
  2903. Result:=Result+'.'+s;
  2904. end;
  2905. end;
  2906. end;
  2907. function NoNil(o: TObject): TObject;
  2908. begin
  2909. if o=nil then
  2910. raise Exception.Create('');
  2911. Result:=o;
  2912. end;
  2913. {$IF FPC_FULLVERSION<30101}
  2914. function IsValidIdent(const Ident: string; AllowDots: Boolean;
  2915. StrictDots: Boolean): Boolean;
  2916. const
  2917. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2918. AlphaNum = Alpha + ['0'..'9'];
  2919. Dot = '.';
  2920. var
  2921. First: Boolean;
  2922. I, Len: Integer;
  2923. begin
  2924. Len := Length(Ident);
  2925. if Len < 1 then
  2926. Exit(False);
  2927. First := True;
  2928. for I := 1 to Len do
  2929. begin
  2930. if First then
  2931. begin
  2932. Result := Ident[I] in Alpha;
  2933. First := False;
  2934. end
  2935. else if AllowDots and (Ident[I] = Dot) then
  2936. begin
  2937. if StrictDots then
  2938. begin
  2939. Result := I < Len;
  2940. First := True;
  2941. end;
  2942. end
  2943. else
  2944. Result := Ident[I] in AlphaNum;
  2945. if not Result then
  2946. Break;
  2947. end;
  2948. end;
  2949. {$ENDIF}
  2950. function dbgs(const Flags: TPasResolverComputeFlags): string;
  2951. var
  2952. s: string;
  2953. f: TPasResolverComputeFlag;
  2954. begin
  2955. Result:='';
  2956. for f in Flags do
  2957. if f in Flags then
  2958. begin
  2959. if Result<>'' then Result:=Result+',';
  2960. str(f,s);
  2961. Result:=Result+s;
  2962. end;
  2963. Result:='['+Result+']';
  2964. end;
  2965. function dbgs(const a: TResolvedRefAccess): string;
  2966. begin
  2967. str(a,Result);
  2968. end;
  2969. function dbgs(const Flags: TResolvedReferenceFlags): string;
  2970. var
  2971. s: string;
  2972. f: TResolvedReferenceFlag;
  2973. begin
  2974. Result:='';
  2975. for f in Flags do
  2976. if f in Flags then
  2977. begin
  2978. if Result<>'' then Result:=Result+',';
  2979. str(f,s);
  2980. Result:=Result+s;
  2981. end;
  2982. Result:='['+Result+']';
  2983. end;
  2984. function dbgs(const a: TPSRefAccess): string;
  2985. begin
  2986. str(a,Result);
  2987. end;
  2988. { TPasResolverHub }
  2989. constructor TPasResolverHub.Create(TheOwner: TObject);
  2990. begin
  2991. FOwner:=TheOwner;
  2992. end;
  2993. procedure TPasResolverHub.Reset;
  2994. begin
  2995. FinishedInterfaceCount:=0;
  2996. end;
  2997. { TPRSpecializedItem }
  2998. destructor TPRSpecializedItem.Destroy;
  2999. var
  3000. i: Integer;
  3001. begin
  3002. for i:=0 to length(SpecializedConstraints)-1 do
  3003. SpecializedConstraints[i].Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  3004. SetLength(SpecializedConstraints,0);
  3005. inherited Destroy;
  3006. end;
  3007. { TPRSpecializedTypeItem }
  3008. procedure TPRSpecializedTypeItem.SetSpecializedType(AValue: TPasGenericType);
  3009. begin
  3010. if FSpecializedType=AValue then Exit;
  3011. if FSpecializedType<>nil then
  3012. FSpecializedType.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  3013. FSpecializedEl:=AValue;
  3014. FSpecializedType:=AValue;
  3015. if FSpecializedType<>nil then
  3016. FSpecializedType.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  3017. end;
  3018. destructor TPRSpecializedTypeItem.Destroy;
  3019. var
  3020. i: Integer;
  3021. begin
  3022. if ImplProcs<>nil then
  3023. begin
  3024. for i:=0 to ImplProcs.Count-1 do
  3025. TPasElement(ImplProcs[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  3026. ImplProcs.Free;
  3027. ImplProcs:=nil;
  3028. end;
  3029. HeaderScope.Free;
  3030. HeaderScope:=nil;
  3031. SpecializedType:=nil;
  3032. inherited Destroy;
  3033. end;
  3034. { TPRSpecializedProcItem }
  3035. procedure TPRSpecializedProcItem.SetSpecializedProc(const AValue: TPasProcedure
  3036. );
  3037. begin
  3038. if FSpecializedProc=AValue then Exit;
  3039. if FSpecializedProc<>nil then
  3040. FSpecializedProc.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  3041. FSpecializedEl:=AValue;
  3042. FSpecializedProc:=AValue;
  3043. if FSpecializedProc<>nil then
  3044. FSpecializedProc.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  3045. end;
  3046. destructor TPRSpecializedProcItem.Destroy;
  3047. begin
  3048. if ImplProc<>nil then
  3049. begin
  3050. ImplProc.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  3051. ImplProc:=nil;
  3052. end;
  3053. SpecializedProc:=nil;
  3054. inherited Destroy;
  3055. end;
  3056. { TPasGenericScope }
  3057. destructor TPasGenericScope.Destroy;
  3058. begin
  3059. if SpecializedItems<>nil then
  3060. begin
  3061. SpecializedItems.Free;
  3062. SpecializedItems:=nil;
  3063. end;
  3064. inherited Destroy;
  3065. end;
  3066. { TPasInheritedScope }
  3067. function TPasInheritedScope.FindIdentifier(const Identifier: String
  3068. ): TPasIdentifier;
  3069. var
  3070. aClassScope: TPasClassScope;
  3071. begin
  3072. Result:=inherited FindIdentifier(Identifier);
  3073. if Result<>nil then exit;
  3074. aClassScope:=AncestorScope;
  3075. while aClassScope<>nil do
  3076. begin
  3077. Result:=aClassScope.FindIdentifier(Identifier);
  3078. if Result<>nil then exit;
  3079. aClassScope:=aClassScope.AncestorScope;
  3080. end;
  3081. end;
  3082. procedure TPasInheritedScope.IterateElements(const aName: string;
  3083. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3084. Data: Pointer; var Abort: boolean);
  3085. var
  3086. aClassScope: TPasClassScope;
  3087. begin
  3088. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3089. if Abort then exit;
  3090. aClassScope:=AncestorScope;
  3091. while aClassScope<>nil do
  3092. begin
  3093. aClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3094. if Abort then exit;
  3095. aClassScope:=aClassScope.AncestorScope;
  3096. end;
  3097. end;
  3098. procedure TPasInheritedScope.WriteIdentifiers(Prefix: string);
  3099. var
  3100. aClassScope: TPasClassScope;
  3101. begin
  3102. inherited WriteIdentifiers(Prefix);
  3103. aClassScope:=AncestorScope;
  3104. while aClassScope<>nil do
  3105. begin
  3106. aClassScope.WriteIdentifiers(Prefix);
  3107. aClassScope:=aClassScope.AncestorScope;
  3108. end;
  3109. end;
  3110. { TPasDotEnumTypeScope }
  3111. function TPasDotEnumTypeScope.FindIdentifier(const Identifier: String
  3112. ): TPasIdentifier;
  3113. begin
  3114. Result:=EnumScope.FindLocalIdentifier(Identifier);
  3115. if Result<>nil then exit;
  3116. Result:=inherited FindIdentifier(Identifier);
  3117. end;
  3118. procedure TPasDotEnumTypeScope.IterateElements(const aName: string;
  3119. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3120. Data: Pointer; var Abort: boolean);
  3121. begin
  3122. EnumScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3123. if Abort then exit;
  3124. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3125. end;
  3126. procedure TPasDotEnumTypeScope.WriteIdentifiers(Prefix: string);
  3127. begin
  3128. EnumScope.WriteIdentifiers(Prefix);
  3129. inherited WriteIdentifiers(Prefix);
  3130. end;
  3131. { TPasGroupScope }
  3132. procedure TPasGroupScope.Add(Scope: TPasIdentifierScope);
  3133. var
  3134. i: Integer;
  3135. begin
  3136. for i:=0 to Count-1 do
  3137. if Scopes[i]=Scope then exit; // already added
  3138. if Scope.FreeOnPop then
  3139. raise Exception.Create('TPasGroupScope.Add '+GetObjName(Scope)+' '+GetObjName(Scope.Element));
  3140. if Count=length(Scopes) then
  3141. SetLength(Scopes,Count*2+4);
  3142. Scopes[Count]:=Scope;
  3143. inc(Count);
  3144. end;
  3145. destructor TPasGroupScope.Destroy;
  3146. begin
  3147. Scopes:=nil;
  3148. Count:=0;
  3149. inherited Destroy;
  3150. end;
  3151. function TPasGroupScope.GetFirstNonHelperScope: TPasIdentifierScope;
  3152. var
  3153. i: Integer;
  3154. Scope: TPasIdentifierScope;
  3155. begin
  3156. for i:=0 to Count-1 do
  3157. begin
  3158. Scope:=Scopes[i];
  3159. if (Scope.ClassType<>TPasClassScope)
  3160. or (TPasClassType(Scope.Element).HelperForType=nil) then
  3161. exit(Scope);
  3162. end;
  3163. Result:=nil;
  3164. end;
  3165. class function TPasGroupScope.IsStoredInElement: boolean;
  3166. begin
  3167. Result:=false;
  3168. end;
  3169. function TPasGroupScope.FindAncestorIdentifier(const Identifier: String
  3170. ): TPasIdentifier;
  3171. var
  3172. i: Integer;
  3173. begin
  3174. for i:=1 to Count-1 do
  3175. begin
  3176. Result:=Scopes[i].FindIdentifier(Identifier);
  3177. if Result<>nil then exit;
  3178. end;
  3179. Result:=nil;
  3180. end;
  3181. function TPasGroupScope.FindAncestorElement(const Identifier: String
  3182. ): TPasElement;
  3183. var
  3184. Item: TPasIdentifier;
  3185. begin
  3186. Item:=FindAncestorIdentifier(Identifier);
  3187. if Item<>nil then
  3188. Result:=Item.Element
  3189. else
  3190. Result:=nil;
  3191. end;
  3192. function TPasGroupScope.FindIdentifier(const Identifier: String
  3193. ): TPasIdentifier;
  3194. var
  3195. i: Integer;
  3196. begin
  3197. for i:=0 to Count-1 do
  3198. begin
  3199. Result:=Scopes[i].FindIdentifier(Identifier);
  3200. if Result<>nil then exit;
  3201. end;
  3202. Result:=nil;
  3203. end;
  3204. procedure TPasGroupScope.IterateElements(const aName: string;
  3205. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3206. Data: Pointer; var Abort: boolean);
  3207. var
  3208. i: Integer;
  3209. begin
  3210. for i:=0 to Count-1 do
  3211. begin
  3212. Scopes[i].IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
  3213. if Abort then exit;
  3214. end;
  3215. end;
  3216. procedure TPasGroupScope.WriteIdentifiers(Prefix: string);
  3217. var
  3218. i: Integer;
  3219. begin
  3220. for i:=0 to Count-1 do
  3221. Scopes[i].WriteIdentifiers(Prefix+'Group['+IntToStr(i)+'/'+IntToStr(Count)+']');
  3222. end;
  3223. {$ifdef pas2js}
  3224. { TPasResHashList }
  3225. constructor TPasResHashList.Create;
  3226. begin
  3227. FItems:=TJSObject.new;
  3228. end;
  3229. procedure TPasResHashList.Add(const aName: string; Item: Pointer);
  3230. begin
  3231. FItems['%'+aName]:=Item;
  3232. end;
  3233. function TPasResHashList.Find(const aName: string): Pointer;
  3234. begin
  3235. if FItems.hasOwnProperty('%'+aName) then
  3236. Result:=Pointer(FItems['%'+aName])
  3237. else
  3238. Result:=nil;
  3239. end;
  3240. procedure TPasResHashList.ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  3241. var
  3242. key: string;
  3243. begin
  3244. for key in FItems do
  3245. if FItems.hasOwnProperty(key) then
  3246. Proc(Pointer(FItems[key]),Arg);
  3247. end;
  3248. procedure TPasResHashList.Clear;
  3249. begin
  3250. FItems:=TJSObject.new;
  3251. end;
  3252. procedure TPasResHashList.Remove(const aName: string);
  3253. begin
  3254. if FItems.hasOwnProperty('%'+aName) then
  3255. JSDelete(FItems,'%'+aName);
  3256. end;
  3257. {$endif}
  3258. { TResElDataBuiltInProc }
  3259. destructor TResElDataBuiltInProc.Destroy;
  3260. begin
  3261. ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TResElDataBuiltInProc.Proc'{$ENDIF});
  3262. inherited Destroy;
  3263. end;
  3264. { TPasClassIntfMap }
  3265. destructor TPasClassIntfMap.Destroy;
  3266. begin
  3267. Element:=nil;
  3268. Intf:=nil;
  3269. FreeAndNil(Procs);
  3270. FreeAndNil(AncestorMap);
  3271. inherited Destroy;
  3272. end;
  3273. { TPasInitialFinalizationScope }
  3274. function TPasInitialFinalizationScope.AddReference(El: TPasElement;
  3275. Access: TPSRefAccess): TPasScopeReference;
  3276. begin
  3277. if References=nil then
  3278. References:=TPasScopeReferences.Create(Self);
  3279. Result:=References.Add(El,Access);
  3280. end;
  3281. destructor TPasInitialFinalizationScope.Destroy;
  3282. begin
  3283. FreeAndNil(References);
  3284. inherited Destroy;
  3285. end;
  3286. { TPasScopeReference }
  3287. procedure TPasScopeReference.SetElement(const AValue: TPasElement);
  3288. begin
  3289. if FElement=AValue then Exit;
  3290. if FElement<>nil then
  3291. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3292. FElement:=AValue;
  3293. if FElement<>nil then
  3294. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3295. end;
  3296. destructor TPasScopeReference.Destroy;
  3297. begin
  3298. {$IFDEF VerbosePasResolverMem}
  3299. writeln('TPasProcScopeReference.Destroy START ',ClassName,' "',GetObjName(Element),'"');
  3300. {$ENDIF}
  3301. Element:=nil;
  3302. inherited Destroy;
  3303. {$IFDEF VerbosePasResolverMem}
  3304. writeln('TPasProcScopeReference.Destroy END ',ClassName);
  3305. {$ENDIF}
  3306. end;
  3307. { TPasScopeReferences }
  3308. procedure TPasScopeReferences.OnClearItem(Item, Dummy: pointer);
  3309. var
  3310. Ref: TPasScopeReference absolute Item;
  3311. Ref2: TPasScopeReference;
  3312. begin
  3313. if Dummy=nil then ;
  3314. //writeln('TPasProcedureScope.OnClearReferenceItem ',GetObjName(Ref.Element));
  3315. while Ref<>nil do
  3316. begin
  3317. Ref2:=Ref;
  3318. Ref:=Ref.NextSameName;
  3319. Ref2.Free;
  3320. end;
  3321. end;
  3322. procedure TPasScopeReferences.OnCollectItem(Item, aList: pointer);
  3323. var
  3324. Ref: TPasScopeReference absolute Item;
  3325. List: TFPList absolute aList;
  3326. begin
  3327. while Ref<>nil do
  3328. begin
  3329. List.Add(Ref);
  3330. Ref:=Ref.NextSameName;
  3331. end;
  3332. end;
  3333. constructor TPasScopeReferences.Create(aScope: TPasScope);
  3334. begin
  3335. References:=TPasResHashList.Create;
  3336. FScope:=aScope;
  3337. end;
  3338. destructor TPasScopeReferences.Destroy;
  3339. begin
  3340. Clear;
  3341. {$ifdef pas2js}
  3342. References:=nil;
  3343. {$else}
  3344. FreeAndNil(References);
  3345. {$endif}
  3346. inherited Destroy;
  3347. end;
  3348. procedure TPasScopeReferences.Clear;
  3349. begin
  3350. if References=nil then exit;
  3351. References.ForEachCall(@OnClearItem,nil);
  3352. References.Clear;
  3353. end;
  3354. function TPasScopeReferences.Add(El: TPasElement; Access: TPSRefAccess
  3355. ): TPasScopeReference;
  3356. var
  3357. LoName: String;
  3358. OldItem, Item, LastItem: TPasScopeReference;
  3359. begin
  3360. LoName:=lowercase(El.Name);
  3361. OldItem:=TPasScopeReference(References.Find(LoName));
  3362. Item:=OldItem;
  3363. LastItem:=nil;
  3364. while Item<>nil do
  3365. begin
  3366. if Item.Element=El then
  3367. begin
  3368. // already marked as used -> combine access
  3369. case Access of
  3370. psraNone: ;
  3371. psraRead:
  3372. case Item.Access of
  3373. psraNone: Item.Access:=Access;
  3374. //psraRead: ;
  3375. psraWrite: Item.Access:=psraWriteRead;
  3376. //psraReadWrite: ;
  3377. //psraWriteRead: ;
  3378. //psraTypeInfo: ;
  3379. end;
  3380. psraWrite:
  3381. case Item.Access of
  3382. psraNone: Item.Access:=Access;
  3383. psraRead: Item.Access:=psraReadWrite;
  3384. //psraWrite: ;
  3385. //psraReadWrite: ;
  3386. //psraWriteRead: ;
  3387. //psraTypeInfo: ;
  3388. end;
  3389. psraReadWrite:
  3390. case Item.Access of
  3391. psraNone: Item.Access:=Access;
  3392. psraRead: Item.Access:=psraReadWrite;
  3393. psraWrite: Item.Access:=psraWriteRead;
  3394. //psraReadWrite: ;
  3395. //psraWriteRead: ;
  3396. //psraTypeInfo: ;
  3397. end;
  3398. psraWriteRead:
  3399. case Item.Access of
  3400. psraNone: Item.Access:=Access;
  3401. psraRead: Item.Access:=psraReadWrite;
  3402. psraWrite: Item.Access:=psraWriteRead;
  3403. //psraReadWrite: ;
  3404. //psraWriteRead: ;
  3405. //psraTypeInfo: ;
  3406. end;
  3407. psraTypeInfo: Item.Access:=psraTypeInfo;
  3408. else
  3409. raise EPasResolve.Create(GetObjName(El)+' unknown Access');
  3410. end;
  3411. exit(Item);
  3412. end;
  3413. LastItem:=Item;
  3414. Item:=Item.NextSameName;
  3415. end;
  3416. // new reference
  3417. Item:=TPasScopeReference.Create;
  3418. Item.Element:=El;
  3419. Item.Access:=Access;
  3420. if LastItem=nil then
  3421. begin
  3422. References.Add(LoName,Item);
  3423. {$IFDEF VerbosePCUFiler}
  3424. if TPasScopeReference(References.Find(LoName))<>Item then
  3425. raise EPasResolve.Create('20180219230028');
  3426. {$ENDIF}
  3427. end
  3428. else
  3429. LastItem.NextSameName:=Item;
  3430. Result:=Item;
  3431. end;
  3432. function TPasScopeReferences.Find(const aName: string): TPasScopeReference;
  3433. var
  3434. LoName: String;
  3435. begin
  3436. if References=nil then exit(nil);
  3437. LoName:=lowercase(aName);
  3438. Result:=TPasScopeReference(References.Find(LoName));
  3439. end;
  3440. function TPasScopeReferences.GetList: TFPList;
  3441. begin
  3442. Result:=TFPList.Create;
  3443. if References=nil then exit;
  3444. References.ForEachCall(@OnCollectItem,Result);
  3445. end;
  3446. { TPasPropertyScope }
  3447. destructor TPasPropertyScope.Destroy;
  3448. begin
  3449. {$IFDEF VerbosePasResolverMem}
  3450. writeln('TPasPropertyScope.Destroy START ',ClassName);
  3451. {$ENDIF}
  3452. AncestorProp:=nil;
  3453. inherited Destroy;
  3454. {$IFDEF VerbosePasResolverMem}
  3455. writeln('TPasPropertyScope.Destroy END',ClassName);
  3456. {$ENDIF}
  3457. end;
  3458. { TPasEnumTypeScope }
  3459. destructor TPasEnumTypeScope.Destroy;
  3460. begin
  3461. {$IFDEF VerbosePasResolverMem}
  3462. writeln('TPasEnumTypeScope.Destroy START ',ClassName);
  3463. {$ENDIF}
  3464. ReleaseAndNil(TPasElement(CanonicalSet){$IFDEF CheckPasTreeRefCount},'TPasEnumTypeScope.CanonicalSet'{$ENDIF});
  3465. inherited Destroy;
  3466. {$IFDEF VerbosePasResolverMem}
  3467. writeln('TPasEnumTypeScope.Destroy END ',ClassName);
  3468. {$ENDIF}
  3469. end;
  3470. { TPasDotBaseScope }
  3471. function TPasDotBaseScope.FindIdentifier(const Identifier: String
  3472. ): TPasIdentifier;
  3473. begin
  3474. Result:=GroupScope.FindIdentifier(Identifier);
  3475. end;
  3476. procedure TPasDotBaseScope.IterateElements(const aName: string;
  3477. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3478. Data: Pointer; var Abort: boolean);
  3479. begin
  3480. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3481. end;
  3482. procedure TPasDotBaseScope.WriteIdentifiers(Prefix: string);
  3483. begin
  3484. GroupScope.WriteIdentifiers(Prefix);
  3485. end;
  3486. destructor TPasDotBaseScope.Destroy;
  3487. begin
  3488. FreeAndNil(GroupScope);
  3489. inherited Destroy;
  3490. end;
  3491. { TPasWithExprScope }
  3492. class function TPasWithExprScope.IsStoredInElement: boolean;
  3493. begin
  3494. Result:=false;
  3495. end;
  3496. class function TPasWithExprScope.FreeOnPop: boolean;
  3497. begin
  3498. Result:=false;
  3499. end;
  3500. procedure TPasWithExprScope.IterateElements(const aName: string;
  3501. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3502. Data: Pointer; var Abort: boolean);
  3503. begin
  3504. Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3505. end;
  3506. procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
  3507. begin
  3508. {AllowWriteln}
  3509. writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
  3510. Scope.WriteIdentifiers(Prefix);
  3511. {AllowWriteln-}
  3512. end;
  3513. destructor TPasWithExprScope.Destroy;
  3514. begin
  3515. FreeAndNil(Scope);
  3516. inherited Destroy;
  3517. end;
  3518. { TPasWithScope }
  3519. constructor TPasWithScope.Create;
  3520. begin
  3521. inherited Create;
  3522. ExpressionScopes:=TObjectList.Create(true);
  3523. end;
  3524. destructor TPasWithScope.Destroy;
  3525. begin
  3526. {$IFDEF VerbosePasResolverMem}
  3527. writeln('TPasWithScope.Destroy START ',ClassName);
  3528. {$ENDIF}
  3529. FreeAndNil(ExpressionScopes);
  3530. inherited Destroy;
  3531. {$IFDEF VerbosePasResolverMem}
  3532. writeln('TPasWithScope.Destroy END ',ClassName);
  3533. {$ENDIF}
  3534. end;
  3535. { TPasProcedureScope }
  3536. function TPasProcedureScope.FindIdentifier(const Identifier: String
  3537. ): TPasIdentifier;
  3538. begin
  3539. Result:=inherited FindIdentifier(Identifier);
  3540. if (Result<>nil) or (GroupScope=nil) then exit;
  3541. Result:=GroupScope.FindIdentifier(Identifier);
  3542. end;
  3543. procedure TPasProcedureScope.IterateElements(const aName: string;
  3544. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3545. Data: Pointer; var Abort: boolean);
  3546. begin
  3547. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3548. if Abort then exit;
  3549. if GroupScope=nil then exit;
  3550. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3551. end;
  3552. function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
  3553. var
  3554. Proc: TPasProcedure;
  3555. El: TPasElement;
  3556. begin
  3557. Result:=Self;
  3558. repeat
  3559. if Result.ClassRecScope<>nil then exit;
  3560. Proc:=TPasProcedure(Result.Element);
  3561. El:=Proc.Parent;
  3562. repeat
  3563. if El=nil then exit(nil);
  3564. if El is TProcedureBody then break;
  3565. El:=El.Parent;
  3566. until false;
  3567. Proc:=El.Parent as TPasProcedure;
  3568. Result:=TPasProcedureScope(Proc.CustomData);
  3569. until false;
  3570. end;
  3571. procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
  3572. begin
  3573. inherited WriteIdentifiers(Prefix);
  3574. if GroupScope<>nil then
  3575. GroupScope.WriteIdentifiers(Prefix+'GS ');
  3576. end;
  3577. destructor TPasProcedureScope.Destroy;
  3578. begin
  3579. {$IFDEF VerbosePasResolverMem}
  3580. writeln('TPasProcedureScope.Destroy START ',ClassName);
  3581. {$ENDIF}
  3582. FreeAndNil(References);
  3583. FreeAndNil(GroupScope);
  3584. NestedMembersScope:=nil; // NestedMembersScope is auto freed
  3585. inherited Destroy;
  3586. ReleaseAndNil(TPasElement(SelfArg){$IFDEF CheckPasTreeRefCount},'TPasProcedureScope.SelfArg'{$ENDIF});
  3587. {$IFDEF VerbosePasResolverMem}
  3588. writeln('TPasProcedureScope.Destroy END ',ClassName);
  3589. {$ENDIF}
  3590. end;
  3591. function TPasProcedureScope.AddReference(El: TPasElement; Access: TPSRefAccess
  3592. ): TPasScopeReference;
  3593. begin
  3594. if References=nil then
  3595. References:=TPasScopeReferences.Create(Self);
  3596. Result:=References.Add(El,Access);
  3597. end;
  3598. function TPasProcedureScope.GetReferences: TFPList;
  3599. begin
  3600. if References=nil then
  3601. Result:=TFPList.Create
  3602. else
  3603. Result:=References.GetList;
  3604. end;
  3605. { TPasClassScope }
  3606. destructor TPasClassScope.Destroy;
  3607. var
  3608. i: Integer;
  3609. o: TObject;
  3610. begin
  3611. if Interfaces<>nil then
  3612. begin
  3613. for i:=0 to Interfaces.Count-1 do
  3614. begin
  3615. o:=TObject(Interfaces[i]);
  3616. if o=nil then
  3617. else if o is TPasProperty then
  3618. else if o is TPasClassIntfMap then
  3619. o.Free
  3620. else
  3621. raise Exception.Create('[20180322132757] '+GetElementDbgPath(Element)+' i='+IntToStr(i)+' '+GetObjName(o));
  3622. end;
  3623. FreeAndNil(Interfaces);
  3624. end;
  3625. if CanonicalClassOf<>nil then
  3626. begin
  3627. CanonicalClassOf.Parent:=nil;
  3628. ReleaseAndNil(TPasElement(CanonicalClassOf){$IFDEF CheckPasTreeRefCount},'TPasClassScope.CanonicalClassOf'{$ENDIF});
  3629. end;
  3630. inherited Destroy;
  3631. end;
  3632. { TPasIdentifier }
  3633. procedure TPasIdentifier.SetElement(AValue: TPasElement);
  3634. begin
  3635. if FElement=AValue then Exit;
  3636. if Element<>nil then
  3637. Element.Release{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3638. FElement:=AValue;
  3639. if Element<>nil then
  3640. Element.AddRef{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3641. end;
  3642. destructor TPasIdentifier.Destroy;
  3643. begin
  3644. {$IFDEF VerbosePasResolverMem}
  3645. writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
  3646. {$ENDIF}
  3647. Element:=nil;
  3648. inherited Destroy;
  3649. {$IFDEF VerbosePasResolverMem}
  3650. writeln('TPasIdentifier.Destroy END ',ClassName);
  3651. {$ENDIF}
  3652. end;
  3653. { EPasResolve }
  3654. procedure EPasResolve.SetPasElement(AValue: TPasElement);
  3655. var
  3656. Old: TPasElement;
  3657. begin
  3658. if FPasElement=AValue then Exit;
  3659. Old:=FPasElement;
  3660. if Old<>nil then
  3661. begin
  3662. Old:=nil;
  3663. PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3664. end;
  3665. FPasElement:=AValue;
  3666. if PasElement<>nil then
  3667. PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3668. end;
  3669. destructor EPasResolve.Destroy;
  3670. begin
  3671. {$IFDEF VerbosePasResolverMem}
  3672. writeln('EPasResolve.Destroy START ',ClassName);
  3673. {$ENDIF}
  3674. PasElement:=nil;
  3675. inherited Destroy;
  3676. {$IFDEF VerbosePasResolverMem}
  3677. writeln('EPasResolve.Destroy END ',ClassName);
  3678. {$ENDIF}
  3679. end;
  3680. { TResolvedReference }
  3681. procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
  3682. begin
  3683. if FDeclaration=AValue then Exit;
  3684. if Declaration<>nil then
  3685. Declaration.Release{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3686. FDeclaration:=AValue;
  3687. if Declaration<>nil then
  3688. Declaration.AddRef{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3689. end;
  3690. destructor TResolvedReference.Destroy;
  3691. begin
  3692. {$IFDEF VerbosePasResolverMem}
  3693. writeln('TResolvedReference.Destroy START ',ClassName);
  3694. {$ENDIF}
  3695. Declaration:=nil;
  3696. FreeAndNil(Context);
  3697. inherited Destroy;
  3698. {$IFDEF VerbosePasResolverMem}
  3699. writeln('TResolvedReference.Destroy END ',ClassName);
  3700. {$ENDIF}
  3701. end;
  3702. { TPasSubExprScope }
  3703. class function TPasSubExprScope.IsStoredInElement: boolean;
  3704. begin
  3705. Result:=false;
  3706. end;
  3707. { TPasModuleDotScope }
  3708. procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
  3709. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3710. var
  3711. FilterData: PPasIterateFilterData absolute Data;
  3712. begin
  3713. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3714. exit; // skip used units
  3715. // call the original iterator
  3716. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3717. end;
  3718. procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
  3719. begin
  3720. if FModule=AValue then Exit;
  3721. if Module<>nil then
  3722. Module.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3723. FModule:=AValue;
  3724. if Module<>nil then
  3725. Module.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3726. end;
  3727. destructor TPasModuleDotScope.Destroy;
  3728. begin
  3729. {$IFDEF VerbosePasResolverMem}
  3730. writeln('TPasSubModuleScope.Destroy START ',ClassName);
  3731. {$ENDIF}
  3732. Module:=nil;
  3733. inherited Destroy;
  3734. {$IFDEF VerbosePasResolverMem}
  3735. writeln('TPasSubModuleScope.Destroy END ',ClassName);
  3736. {$ENDIF}
  3737. end;
  3738. function TPasModuleDotScope.FindIdentifier(const Identifier: String
  3739. ): TPasIdentifier;
  3740. function Find(Scope: TPasIdentifierScope): boolean;
  3741. var
  3742. Found: TPasIdentifier;
  3743. C: TClass;
  3744. begin
  3745. if Scope=nil then exit(false);
  3746. Found:=Scope.FindLocalIdentifier(Identifier);
  3747. FindIdentifier:=Found;
  3748. if Found=nil then exit(false);
  3749. C:=Found.Element.ClassType;
  3750. Result:=(C<>TPasModule) and (C<>TPasUsesUnit);
  3751. end;
  3752. begin
  3753. Result:=nil;
  3754. if Find(ImplementationScope) then exit;
  3755. if Find(InterfaceScope) then exit;
  3756. Find(SystemScope);
  3757. end;
  3758. procedure TPasModuleDotScope.IterateElements(const aName: string;
  3759. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3760. Data: Pointer; var Abort: boolean);
  3761. var
  3762. FilterData: TPasIterateFilterData;
  3763. function Iterate(Scope: TPasIdentifierScope): boolean;
  3764. begin
  3765. if Scope=nil then exit(false);
  3766. Scope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3767. Result:=Abort;
  3768. end;
  3769. begin
  3770. FilterData.OnIterate:=OnIterateElement;
  3771. FilterData.Data:=Data;
  3772. if Iterate(ImplementationScope) then exit;
  3773. if Iterate(InterfaceScope) then exit;
  3774. Iterate(SystemScope);
  3775. end;
  3776. procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
  3777. begin
  3778. if ImplementationScope<>nil then
  3779. ImplementationScope.WriteIdentifiers(Prefix+' ');
  3780. if InterfaceScope<>nil then
  3781. InterfaceScope.WriteIdentifiers(Prefix+' ');
  3782. if SystemScope<>nil then
  3783. SystemScope.WriteIdentifiers(Prefix+' ');
  3784. end;
  3785. { TPasSectionScope }
  3786. procedure TPasSectionScope.OnInternalIterate(El: TPasElement; ElScope,
  3787. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3788. var
  3789. FilterData: PPasIterateFilterData absolute Data;
  3790. begin
  3791. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3792. exit; // skip used units
  3793. // call the original iterator
  3794. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3795. end;
  3796. constructor TPasSectionScope.Create;
  3797. begin
  3798. inherited Create;
  3799. UsesScopes:=TFPList.Create;
  3800. end;
  3801. destructor TPasSectionScope.Destroy;
  3802. begin
  3803. {$IFDEF VerbosePasResolverMem}
  3804. writeln('TPasSectionScope.Destroy START ',ClassName);
  3805. {$ENDIF}
  3806. ClearHelperList(Helpers);
  3807. FreeAndNil(UsesScopes);
  3808. inherited Destroy;
  3809. {$IFDEF VerbosePasResolverMem}
  3810. writeln('TPasSectionScope.Destroy END ',ClassName);
  3811. {$ENDIF}
  3812. end;
  3813. function TPasSectionScope.FindIdentifier(const Identifier: String
  3814. ): TPasIdentifier;
  3815. var
  3816. i: Integer;
  3817. UsesScope: TPasIdentifierScope;
  3818. C: TClass;
  3819. begin
  3820. Result:=inherited FindIdentifier(Identifier);
  3821. if Result<>nil then
  3822. exit;
  3823. for i:=UsesScopes.Count-1 downto 0 do
  3824. begin
  3825. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3826. {$IFDEF VerbosePasResolver}
  3827. writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
  3828. {$ENDIF}
  3829. Result:=UsesScope.FindLocalIdentifier(Identifier);
  3830. if Result<>nil then
  3831. begin
  3832. C:=Result.Element.ClassType;
  3833. if (C<>TPasModule) and (C<>TPasUsesUnit) then
  3834. exit;
  3835. end;
  3836. end;
  3837. end;
  3838. procedure TPasSectionScope.IterateElements(const aName: string;
  3839. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3840. Data: Pointer; var Abort: boolean);
  3841. var
  3842. i: Integer;
  3843. UsesScope: TPasSectionScope;
  3844. FilterData: TPasIterateFilterData;
  3845. begin
  3846. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3847. if Abort then exit;
  3848. FilterData.OnIterate:=OnIterateElement;
  3849. FilterData.Data:=Data;
  3850. for i:=UsesScopes.Count-1 downto 0 do
  3851. begin
  3852. UsesScope:=TPasSectionScope(UsesScopes[i]);
  3853. {$IFDEF VerbosePasResolver}
  3854. writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',UsesScope.Element.ParentPath,':',GetObjName(UsesScope.Element));
  3855. {$ENDIF}
  3856. UsesScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3857. if Abort then exit;
  3858. end;
  3859. end;
  3860. procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
  3861. var
  3862. i: Integer;
  3863. UsesScope: TPasIdentifierScope;
  3864. SubPrefix: String;
  3865. begin
  3866. {AllowWriteln}
  3867. inherited WriteIdentifiers(Prefix);
  3868. SubPrefix:=Prefix+' ';
  3869. for i:=UsesScopes.Count-1 downto 0 do
  3870. begin
  3871. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3872. writeln(Prefix+' Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
  3873. UsesScope.FItems.ForEachCall(@OnWriteItem,Pointer(SubPrefix));
  3874. end;
  3875. {AllowWriteln-}
  3876. end;
  3877. { TPasModuleScope }
  3878. procedure TPasModuleScope.SetAssertClass(const AValue: TPasClassType);
  3879. begin
  3880. if FAssertClass=AValue then Exit;
  3881. if FAssertClass<>nil then
  3882. FAssertClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3883. FAssertClass:=AValue;
  3884. if FAssertClass<>nil then
  3885. FAssertClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3886. end;
  3887. procedure TPasModuleScope.SetAssertDefConstructor(const AValue: TPasConstructor
  3888. );
  3889. begin
  3890. if FAssertDefConstructor=AValue then Exit;
  3891. if FAssertDefConstructor<>nil then
  3892. FAssertDefConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3893. FAssertDefConstructor:=AValue;
  3894. if FAssertDefConstructor<>nil then
  3895. FAssertDefConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3896. end;
  3897. procedure TPasModuleScope.SetAssertMsgConstructor(const AValue: TPasConstructor
  3898. );
  3899. begin
  3900. if FAssertMsgConstructor=AValue then Exit;
  3901. if FAssertMsgConstructor<>nil then
  3902. FAssertMsgConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3903. FAssertMsgConstructor:=AValue;
  3904. if FAssertMsgConstructor<>nil then
  3905. FAssertMsgConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3906. end;
  3907. procedure TPasModuleScope.SetRangeErrorClass(const AValue: TPasClassType);
  3908. begin
  3909. if FRangeErrorClass=AValue then Exit;
  3910. if FRangeErrorClass<>nil then
  3911. FRangeErrorClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3912. FRangeErrorClass:=AValue;
  3913. if FRangeErrorClass<>nil then
  3914. FRangeErrorClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3915. end;
  3916. procedure TPasModuleScope.SetRangeErrorConstructor(const AValue: TPasConstructor
  3917. );
  3918. begin
  3919. if FRangeErrorConstructor=AValue then Exit;
  3920. if FRangeErrorConstructor<>nil then
  3921. FRangeErrorConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3922. FRangeErrorConstructor:=AValue;
  3923. if FRangeErrorConstructor<>nil then
  3924. FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3925. end;
  3926. procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
  3927. begin
  3928. if FSystemTVarRec=AValue then Exit;
  3929. if FSystemTVarRec<>nil then
  3930. FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3931. FSystemTVarRec:=AValue;
  3932. if FSystemTVarRec<>nil then
  3933. FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3934. end;
  3935. constructor TPasModuleScope.Create;
  3936. begin
  3937. inherited Create;
  3938. PendingResolvers:=TFPList.Create;
  3939. end;
  3940. destructor TPasModuleScope.Destroy;
  3941. begin
  3942. AssertClass:=nil;
  3943. AssertDefConstructor:=nil;
  3944. AssertMsgConstructor:=nil;
  3945. RangeErrorClass:=nil;
  3946. RangeErrorConstructor:=nil;
  3947. SystemTVarRec:=nil;
  3948. FreeAndNil(PendingResolvers);
  3949. inherited Destroy;
  3950. end;
  3951. procedure TPasModuleScope.IterateElements(const aName: string;
  3952. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3953. Data: Pointer; var Abort: boolean);
  3954. begin
  3955. if CompareText(aName,FirstName)<>0 then exit;
  3956. OnIterateElement(Element,Self,StartScope,Data,Abort);
  3957. end;
  3958. { TPasDefaultScope }
  3959. class function TPasDefaultScope.IsStoredInElement: boolean;
  3960. begin
  3961. Result:=false;
  3962. end;
  3963. { TPasScope }
  3964. class function TPasScope.IsStoredInElement: boolean;
  3965. begin
  3966. Result:=true;
  3967. end;
  3968. class function TPasScope.FreeOnPop: boolean;
  3969. begin
  3970. Result:=not IsStoredInElement;
  3971. end;
  3972. procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
  3973. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  3974. var Abort: boolean);
  3975. begin
  3976. if aName='' then ;
  3977. if StartScope=nil then ;
  3978. if Data=nil then ;
  3979. if OnIterateElement=nil then ;
  3980. if Abort then ;
  3981. end;
  3982. procedure TPasScope.WriteIdentifiers(Prefix: string);
  3983. begin
  3984. {AllowWriteln}
  3985. writeln(Prefix,'(',ClassName,') Element: ',GetObjName(Element));
  3986. {AllowWriteln-}
  3987. end;
  3988. { TPasIdentifierScope }
  3989. // inline
  3990. function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
  3991. ): TPasIdentifier;
  3992. begin
  3993. Result:=TPasIdentifier(FItems.Find(lowercase(Identifier)));
  3994. end;
  3995. procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
  3996. var
  3997. PasIdentifier: TPasIdentifier absolute Item;
  3998. Ident: TPasIdentifier;
  3999. begin
  4000. if Dummy=nil then ;
  4001. //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  4002. while PasIdentifier<>nil do
  4003. begin
  4004. Ident:=PasIdentifier;
  4005. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  4006. Ident.Free;
  4007. end;
  4008. end;
  4009. procedure TPasIdentifierScope.OnCollectItem(Item, List: pointer);
  4010. var
  4011. PasIdentifier: TPasIdentifier absolute Item;
  4012. FPList: TFPList absolute List;
  4013. begin
  4014. FPList.Add(PasIdentifier);
  4015. end;
  4016. procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
  4017. var
  4018. PasIdentifier: TPasIdentifier absolute Item;
  4019. Prefix: String;
  4020. begin
  4021. {AllowWriteln}
  4022. Prefix:=String(Dummy);
  4023. while PasIdentifier<>nil do
  4024. begin
  4025. writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
  4026. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  4027. end;
  4028. {AllowWriteln-}
  4029. end;
  4030. procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
  4031. var
  4032. OldItem: TPasIdentifier;
  4033. LoName: string;
  4034. {$ifdef pas2js}
  4035. {$ELSE}
  4036. Index: Integer;
  4037. {$ENDIF}
  4038. begin
  4039. LoName:=lowercase(Item.Identifier);
  4040. {$ifdef pas2js}
  4041. OldItem:=TPasIdentifier(FItems.Find(LoName));
  4042. if OldItem<>nil then
  4043. begin
  4044. // insert LIFO - last in, first out
  4045. Item.NextSameIdentifier:=OldItem;
  4046. end;
  4047. FItems.Add(LoName,Item);
  4048. {$IFDEF VerbosePasResolver}
  4049. if Item.Owner<>nil then
  4050. raise Exception.Create('20160925184110');
  4051. Item.Owner:=Self;
  4052. {$ENDIF}
  4053. {$IFDEF VerbosePasResolver}
  4054. if FindIdentifier(Item.Identifier)<>Item then
  4055. raise Exception.Create('20181018173201');
  4056. {$ENDIF}
  4057. {$else}
  4058. Index:=FItems.FindIndexOf(LoName);
  4059. {$IFDEF VerbosePasResolver}
  4060. if Item.Owner<>nil then
  4061. raise Exception.Create('20160925184110');
  4062. Item.Owner:=Self;
  4063. {$ENDIF}
  4064. //writeln(' Index=',Index);
  4065. if Index>=0 then
  4066. begin
  4067. // insert LIFO - last in, first out
  4068. OldItem:=TPasIdentifier(FItems.List^[Index].Data);
  4069. {$IFDEF VerbosePasResolver}
  4070. if lowercase(OldItem.Identifier)<>LoName then
  4071. raise Exception.Create('20160925183438');
  4072. {$ENDIF}
  4073. Item.NextSameIdentifier:=OldItem;
  4074. FItems.List^[Index].Data:=Item;
  4075. end
  4076. else
  4077. begin
  4078. FItems.Add(LoName, Item);
  4079. {$IFDEF VerbosePasResolver}
  4080. if FindIdentifier(Item.Identifier)<>Item then
  4081. raise Exception.Create('20160925183849');
  4082. {$ENDIF}
  4083. end;
  4084. {$endif}
  4085. end;
  4086. constructor TPasIdentifierScope.Create;
  4087. begin
  4088. FItems:=TPasResHashList.Create;
  4089. end;
  4090. destructor TPasIdentifierScope.Destroy;
  4091. begin
  4092. ClearIdentifiers(true);
  4093. inherited Destroy;
  4094. {$IFDEF VerbosePasResolverMem}
  4095. writeln('TPasIdentifierScope.Destroy END ',ClassName);
  4096. {$ENDIF}
  4097. end;
  4098. procedure TPasIdentifierScope.ClearIdentifiers(FreeItems: boolean);
  4099. begin
  4100. {$IFDEF VerbosePasResolverMem}
  4101. writeln('TPasIdentifierScope.Clear START ',ClassName);
  4102. {$ENDIF}
  4103. FItems.ForEachCall(@OnClearItem,nil);
  4104. {$ifdef pas2js}
  4105. if FreeItems then
  4106. FItems:=nil
  4107. else
  4108. FItems.Clear;
  4109. {$else}
  4110. FItems.Clear;
  4111. if FreeItems then
  4112. FreeAndNil(FItems);
  4113. {$endif}
  4114. {$IFDEF VerbosePasResolverMem}
  4115. writeln('TPasIdentifierScope.Clear END ',ClassName);
  4116. {$ENDIF}
  4117. end;
  4118. function TPasIdentifierScope.FindIdentifier(const Identifier: String
  4119. ): TPasIdentifier;
  4120. begin
  4121. Result:=FindLocalIdentifier(Identifier);
  4122. {$IFDEF VerbosePasResolver}
  4123. {AllowWriteln}
  4124. if (Result<>nil) and (Result.Owner<>Self) then
  4125. begin
  4126. writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  4127. raise Exception.Create('20160925184159');
  4128. end;
  4129. {AllowWriteln-}
  4130. {$ENDIF}
  4131. end;
  4132. function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
  4133. var
  4134. Identifier, PrevIdentifier: TPasIdentifier;
  4135. LoName: string;
  4136. begin
  4137. LoName:=lowercase(El.Name);
  4138. Identifier:=TPasIdentifier(FItems.Find(LoName));
  4139. FindLocalIdentifier(El.Name);
  4140. PrevIdentifier:=nil;
  4141. Result:=false;
  4142. while Identifier<>nil do
  4143. begin
  4144. {$IFDEF VerbosePasResolver}
  4145. if (Identifier.Owner<>Self) then
  4146. raise Exception.Create('20160925184159');
  4147. {$ENDIF}
  4148. if Identifier.Element=El then
  4149. begin
  4150. if PrevIdentifier<>nil then
  4151. begin
  4152. PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
  4153. Identifier.Free;
  4154. Identifier:=PrevIdentifier.NextSameIdentifier;
  4155. end
  4156. else
  4157. begin
  4158. FItems.Remove({$ifdef pas2js}LoName{$else}Identifier{$endif});
  4159. PrevIdentifier:=Identifier;
  4160. Identifier:=Identifier.NextSameIdentifier;
  4161. PrevIdentifier.Free;
  4162. PrevIdentifier:=nil;
  4163. if Identifier<>nil then
  4164. FItems.Add(LoName,Identifier);
  4165. end;
  4166. Result:=true;
  4167. continue;
  4168. end;
  4169. PrevIdentifier:=Identifier;
  4170. Identifier:=Identifier.NextSameIdentifier;
  4171. end;
  4172. end;
  4173. function TPasIdentifierScope.AddIdentifier(const Identifier: String;
  4174. El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
  4175. var
  4176. Item: TPasIdentifier;
  4177. begin
  4178. //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
  4179. Item:=TPasIdentifier.Create;
  4180. Item.Identifier:=Identifier;
  4181. Item.Element:=El;
  4182. Item.Kind:=Kind;
  4183. InternalAdd(Item);
  4184. //writeln('TPasIdentifierScope.AddIdentifier END');
  4185. Result:=Item;
  4186. end;
  4187. function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
  4188. var
  4189. Item: TPasIdentifier;
  4190. begin
  4191. //writeln('TPasIdentifierScope.FindElement "',aName,'"');
  4192. Item:=FindIdentifier(aName);
  4193. if Item=nil then
  4194. Result:=nil
  4195. else
  4196. Result:=Item.Element;
  4197. //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
  4198. end;
  4199. procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
  4200. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4201. Data: Pointer; var Abort: boolean);
  4202. var
  4203. Item: TPasIdentifier;
  4204. {$IFDEF VerbosePasResolver}
  4205. OldElement: TPasElement;
  4206. {$ENDIF}
  4207. begin
  4208. Item:=FindLocalIdentifier(aName);
  4209. while Item<>nil do
  4210. begin
  4211. //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
  4212. {$IFDEF VerbosePasResolver}
  4213. OldElement:=Item.Element;
  4214. {$ENDIF}
  4215. OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
  4216. {$IFDEF VerbosePasResolver}
  4217. if OldElement<>Item.Element then
  4218. raise Exception.Create('20160925183503');
  4219. {$ENDIF}
  4220. if Abort then exit;
  4221. Item:=Item.NextSameIdentifier;
  4222. end;
  4223. end;
  4224. procedure TPasIdentifierScope.IterateElements(const aName: string;
  4225. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4226. Data: Pointer; var Abort: boolean);
  4227. begin
  4228. IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
  4229. end;
  4230. procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
  4231. begin
  4232. inherited WriteIdentifiers(Prefix);
  4233. WriteLocalIdentifiers(Prefix+' ');
  4234. end;
  4235. procedure TPasIdentifierScope.WriteLocalIdentifiers(Prefix: string);
  4236. begin
  4237. FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
  4238. end;
  4239. function TPasIdentifierScope.GetLocalIdentifiers: TFPList;
  4240. begin
  4241. Result:=TFPList.Create;
  4242. FItems.ForEachCall(@OnCollectItem,Result);
  4243. end;
  4244. { TPasResolver }
  4245. // inline
  4246. function TPasResolver.GetBaseTypes(bt: TResolverBaseType
  4247. ): TPasUnresolvedSymbolRef;
  4248. begin
  4249. Result:=FBaseTypes[bt];
  4250. end;
  4251. // inline
  4252. function TPasResolver.GetScopes(Index: integer): TPasScope;
  4253. begin
  4254. Result:=FScopes[Index];
  4255. end;
  4256. // inline
  4257. function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
  4258. begin
  4259. Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
  4260. end;
  4261. // inline
  4262. function TPasResolver.IsGenericTemplType(const ResolvedEl: TPasResolverResult
  4263. ): boolean;
  4264. begin
  4265. Result:=(ResolvedEl.BaseType=btContext)
  4266. and (ResolvedEl.LoTypeEl.ClassType=TPasGenericTemplateType);
  4267. end;
  4268. // inline
  4269. function TPasResolver.GetLocalScope: TPasScope;
  4270. begin
  4271. Result:=TopScope;
  4272. if Result.ClassType=TPasGroupScope then
  4273. Result:=TPasGroupScope(Result).Scopes[0];
  4274. end;
  4275. // inline
  4276. function TPasResolver.GetParentLocalScope: TPasScope;
  4277. begin
  4278. Result:=Scopes[ScopeCount-2];
  4279. if Result.ClassType=TPasGroupScope then
  4280. Result:=TPasGroupScope(Result).Scopes[0];
  4281. end;
  4282. function TPasResolver.GetNameExprValue(El: TPasExpr): string;
  4283. begin
  4284. if El=nil then
  4285. Result:=''
  4286. else if El.ClassType=TPrimitiveExpr then
  4287. begin
  4288. if TPrimitiveExpr(El).Kind=pekIdent then
  4289. Result:=TPrimitiveExpr(El).Value
  4290. else
  4291. Result:='';
  4292. end
  4293. else
  4294. Result:='';
  4295. end;
  4296. function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
  4297. // returns TPrimitiveExpr (Kind=pekIdent)
  4298. var
  4299. Bin: TBinaryExpr;
  4300. C: TClass;
  4301. begin
  4302. Result:=nil;
  4303. if El=nil then exit;
  4304. repeat
  4305. if not (El.Parent is TBinaryExpr) then exit;
  4306. Bin:=TBinaryExpr(El.Parent);
  4307. if Bin.OpCode<>eopSubIdent then exit;
  4308. if El=Bin.right then
  4309. El:=Bin
  4310. else
  4311. begin
  4312. El:=Bin.right;
  4313. // find left most
  4314. repeat
  4315. C:=El.ClassType;
  4316. if C=TPrimitiveExpr then
  4317. begin
  4318. if TPrimitiveExpr(El).Kind<>pekIdent then
  4319. RaiseNotYetImplemented(20170502163825,El);
  4320. exit(El);
  4321. end
  4322. else if C=TBinaryExpr then
  4323. begin
  4324. if TBinaryExpr(El).OpCode<>eopSubIdent then
  4325. RaiseNotYetImplemented(20170502163718,El);
  4326. El:=TBinaryExpr(El).left;
  4327. end
  4328. else if C=TParamsExpr then
  4329. begin
  4330. if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
  4331. RaiseNotYetImplemented(20170502163908,El);
  4332. El:=TParamsExpr(El).Value;
  4333. end;
  4334. until El=nil;
  4335. RaiseNotYetImplemented(20170502163953,Bin);
  4336. end;
  4337. until false;
  4338. end;
  4339. function TPasResolver.GetLeftMostExpr(El: TPasExpr): TPasExpr;
  4340. var
  4341. C: TClass;
  4342. begin
  4343. Result:=El;
  4344. while Result<>nil do
  4345. begin
  4346. El:=Result;
  4347. C:=Result.ClassType;
  4348. if C=TBinaryExpr then
  4349. begin
  4350. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4351. exit;
  4352. Result:=TBinaryExpr(Result).left;
  4353. end
  4354. else if C=TParamsExpr then
  4355. begin
  4356. if not (TParamsExpr(Result).Kind in [pekFuncParams,pekArrayParams]) then
  4357. exit;
  4358. Result:=TParamsExpr(Result).Value;
  4359. end
  4360. else
  4361. exit;
  4362. end;
  4363. end;
  4364. function TPasResolver.GetRightMostExpr(El: TPasExpr): TPasExpr;
  4365. var
  4366. C: TClass;
  4367. begin
  4368. Result:=El;
  4369. while Result<>nil do
  4370. begin
  4371. El:=Result;
  4372. C:=Result.ClassType;
  4373. if C=TBinaryExpr then
  4374. begin
  4375. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4376. exit;
  4377. Result:=TBinaryExpr(Result).right;
  4378. end
  4379. else
  4380. exit;
  4381. end;
  4382. end;
  4383. procedure TPasResolver.GetParamsOfNameExpr(El: TPasExpr; out
  4384. ParentParams: TPRParentParams);
  4385. // Checks if El is the name expression of a call or array access
  4386. // For example: a.b.El() a.El[]
  4387. // Note: TPasParser guarantees that there is at most one TBinaryExpr
  4388. // and one TInlineSpecializeExpr between El and TParamsExpr
  4389. var
  4390. Parent: TPasElement;
  4391. Bin: TBinaryExpr;
  4392. Params: TParamsExpr;
  4393. InlineSpec: TInlineSpecializeExpr;
  4394. begin
  4395. ParentParams.InlineSpec:=nil;
  4396. ParentParams.Params:=nil;
  4397. if not IsNameExpr(El) then exit;
  4398. Parent:=El.Parent;
  4399. if Parent=nil then exit;
  4400. if Parent.ClassType=TInlineSpecializeExpr then
  4401. begin
  4402. InlineSpec:=TInlineSpecializeExpr(Parent);
  4403. if InlineSpec.NameExpr<>El then exit;
  4404. ParentParams.InlineSpec:=InlineSpec;
  4405. El:=InlineSpec;
  4406. Parent:=El.Parent;
  4407. if Parent=nil then exit;
  4408. end;
  4409. if Parent.ClassType=TBinaryExpr then
  4410. begin
  4411. Bin:=TBinaryExpr(Parent);
  4412. if (Bin.OpCode<>eopSubIdent) or (Bin.right<>El) then
  4413. exit;
  4414. El:=Bin;
  4415. Parent:=El.Parent;
  4416. end;
  4417. if Parent.ClassType<>TParamsExpr then exit;
  4418. Params:=TParamsExpr(Parent);
  4419. if Params.Value<>El then exit;
  4420. if not (Params.Kind in [pekFuncParams,pekArrayParams]) then exit;
  4421. ParentParams.Params:=Params;
  4422. end;
  4423. function TPasResolver.GetInlineSpecOfNameExpr(El: TPasExpr
  4424. ): TInlineSpecializeExpr;
  4425. var
  4426. Parent: TPasElement;
  4427. begin
  4428. Result:=nil;
  4429. if not IsNameExpr(El) then exit;
  4430. Parent:=El.Parent;
  4431. if Parent=nil then exit;
  4432. if Parent is TBinaryExpr then
  4433. begin
  4434. if (TBinaryExpr(Parent).OpCode<>eopSubIdent)
  4435. or (TBinaryExpr(Parent).right<>El) then
  4436. exit;
  4437. El:=TBinaryExpr(Parent); // continue
  4438. Parent:=El.Parent;
  4439. end;
  4440. if Parent.ClassType<>TInlineSpecializeExpr then exit;
  4441. Result:=TInlineSpecializeExpr(Parent);
  4442. if Result.NameExpr<>El then
  4443. Result:=nil;
  4444. end;
  4445. function TPasResolver.GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  4446. var
  4447. Value: TResEvalValue;
  4448. begin
  4449. if not (InFileExpr is TPrimitiveExpr) then
  4450. RaiseXExpectedButYFound(20180221234828,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4451. Value:=ExprEvaluator.Eval(TPrimitiveExpr(InFileExpr),[refConst]);
  4452. try
  4453. if (Value=nil) then
  4454. RaiseXExpectedButYFound(20180222000004,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4455. case Value.Kind of
  4456. {$ifdef FPC_HAS_CPSTRING}
  4457. revkString:
  4458. Result:=ExprEvaluator.GetUTF8Str(TResEvalString(Value).S,InFileExpr);
  4459. revkUnicodeString:
  4460. Result:=UTF8Encode(TResEvalUTF16(Value).S);
  4461. {$else}
  4462. revkUnicodeString:
  4463. Result:=TResEvalUTF16(Value).S;
  4464. {$endif}
  4465. else
  4466. RaiseXExpectedButYFound(20180222000122,'string literal',Value.AsDebugString,InFileExpr);
  4467. end;
  4468. finally
  4469. ReleaseEvalValue(Value);
  4470. end;
  4471. end;
  4472. function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
  4473. // get leftmost name element (e.g. TPrimitiveExpr)
  4474. // nil if not found
  4475. var
  4476. C: TClass;
  4477. begin
  4478. Result:=nil;
  4479. while El<>nil do
  4480. begin
  4481. C:=El.ClassType;
  4482. if C=TPrimitiveExpr then
  4483. exit(El)
  4484. else if C=TBinaryExpr then
  4485. begin
  4486. if TBinaryExpr(El).OpCode=eopSubIdent then
  4487. El:=TBinaryExpr(El).left
  4488. else
  4489. exit;
  4490. end
  4491. else if C=TParamsExpr then
  4492. El:=TParamsExpr(El).Value
  4493. else
  4494. exit;
  4495. end;
  4496. end;
  4497. function TPasResolver.GetPathEndIdent(El: TPasExpr; AllowCall: boolean
  4498. ): TPasExpr;
  4499. // a -> a
  4500. // a.b -> b
  4501. // a.b() -> b
  4502. // a()() -> nil
  4503. // a[] -> nil
  4504. var
  4505. Bin: TBinaryExpr;
  4506. begin
  4507. Result:=nil;
  4508. if AllowCall and (El is TParamsExpr) then
  4509. El:=TParamsExpr(El).Value;
  4510. while El is TBinaryExpr do
  4511. begin
  4512. Bin:=TBinaryExpr(El);
  4513. if Bin.OpCode=eopSubIdent then
  4514. El:=Bin.right
  4515. else
  4516. exit(nil);
  4517. end;
  4518. if (El is TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent) then
  4519. Result:=El;
  4520. end;
  4521. function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  4522. // if the expression is a constructor newinstance call,
  4523. // return the element referring the constructor
  4524. // else nil
  4525. var
  4526. C: TClass;
  4527. begin
  4528. Result:=nil;
  4529. while El<>nil do
  4530. begin
  4531. if (El.CustomData is TResolvedReference)
  4532. and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
  4533. exit(El);
  4534. C:=El.ClassType;
  4535. if C=TBinaryExpr then
  4536. begin
  4537. if TBinaryExpr(El).OpCode=eopSubIdent then
  4538. El:=TBinaryExpr(El).right
  4539. else
  4540. exit;
  4541. end
  4542. else if C=TParamsExpr then
  4543. El:=TParamsExpr(El).Value
  4544. else
  4545. exit;
  4546. end;
  4547. end;
  4548. procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
  4549. var
  4550. El: TPasElement;
  4551. RData: TResolveData;
  4552. begin
  4553. // clear CustomData
  4554. while FLastCreatedData[Kind]<>nil do
  4555. begin
  4556. RData:=FLastCreatedData[Kind];
  4557. El:=RData.Element;
  4558. El.CustomData:=nil;
  4559. FLastCreatedData[Kind]:=RData.Next;
  4560. RData.Free;
  4561. end;
  4562. end;
  4563. function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
  4564. begin
  4565. if FBaseTypes[bt]<>nil then
  4566. Result:=FBaseTypes[bt].Name
  4567. else
  4568. Result:=ResBaseTypeNames[bt];
  4569. end;
  4570. function TPasResolver.GetBuiltInProcs(bp: TResolverBuiltInProc
  4571. ): TResElDataBuiltInProc;
  4572. begin
  4573. Result:=FBuiltInProcs[bp];
  4574. end;
  4575. procedure TPasResolver.SetRootElement(const AValue: TPasModule);
  4576. begin
  4577. if FRootElement=AValue then Exit;
  4578. FRootElement:=AValue;
  4579. end;
  4580. procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope,
  4581. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4582. var
  4583. Data: PPRFindData absolute FindFirstElementData;
  4584. ok: Boolean;
  4585. Proc: TPasProcedure;
  4586. Templates: TFPList;
  4587. begin
  4588. ok:=true;
  4589. if (El is TPasProcedure) then
  4590. begin
  4591. Proc:=TPasProcedure(El);
  4592. if Data^.SkipGenerics then
  4593. begin
  4594. Templates:=GetProcTemplateTypes(Proc);
  4595. if (Templates<>nil) and (Templates.Count>0) then
  4596. ok:=false;
  4597. end;
  4598. if ok and ProcNeedsParams(Proc.ProcType) then
  4599. // found a proc, but it needs parameters -> remember the first and continue
  4600. ok:=false;
  4601. end
  4602. else if Data^.SkipGenerics then
  4603. begin
  4604. if El is TPasGenericType then
  4605. begin
  4606. if GetTypeParameterCount(TPasGenericType(El))>0 then
  4607. ok:=false;
  4608. end;
  4609. end;
  4610. if ok or (Data^.Found=nil) then
  4611. begin
  4612. Data^.Found:=El;
  4613. Data^.ElScope:=ElScope;
  4614. Data^.StartScope:=StartScope;
  4615. end;
  4616. if ok then
  4617. Abort:=true;
  4618. end;
  4619. procedure TPasResolver.OnFindFirst(El: TPasElement; ElScope,
  4620. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4621. var
  4622. Data: PPRFindData absolute FindFirstElementData;
  4623. begin
  4624. Data^.Found:=El;
  4625. Data^.ElScope:=ElScope;
  4626. Data^.StartScope:=StartScope;
  4627. Abort:=true;
  4628. end;
  4629. procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
  4630. StartScope: TPasScope; FindFirstGenericData: Pointer; var Abort: boolean);
  4631. var
  4632. Data: PPRFindGenericData absolute FindFirstGenericData;
  4633. GenericTemplateTypes: TFPList;
  4634. begin
  4635. if El is TPasGenericType then
  4636. GenericTemplateTypes:=TPasGenericType(El).GenericTemplateTypes
  4637. else if El is TPasProcedure then
  4638. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(El))
  4639. else
  4640. exit;
  4641. if GenericTemplateTypes=nil then exit;
  4642. if GenericTemplateTypes.Count<>Data^.TemplateCount then
  4643. exit;
  4644. Data^.Find.Found:=El;
  4645. Data^.Find.ElScope:=ElScope;
  4646. Data^.Find.StartScope:=StartScope;
  4647. Abort:=true;
  4648. end;
  4649. procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
  4650. StartScope: TPasScope; FindCallElData: Pointer; var Abort: boolean);
  4651. var
  4652. Data: PFindCallElData absolute FindCallElData;
  4653. Proc, PrevProc: TPasProcedure;
  4654. Distance: integer;
  4655. BuiltInProc: TResElDataBuiltInProc;
  4656. CandidateFound: Boolean;
  4657. VarType, TypeEl: TPasType;
  4658. C: TClass;
  4659. ProcScope: TPasProcedureScope;
  4660. Templates: TFPList;
  4661. begin
  4662. {$IFDEF VerbosePasResolver}
  4663. writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
  4664. {$ENDIF}
  4665. CandidateFound:=false;
  4666. if (El is TPasProcedure) then
  4667. begin
  4668. // identifier is a proc
  4669. Proc:=TPasProcedure(El);
  4670. PrevProc:=nil;
  4671. if Data^.Found=Proc then
  4672. begin
  4673. // this proc was already found. This happens when this is the forward
  4674. // declaration or a previously found implementation.
  4675. exit;
  4676. end;
  4677. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4678. if ProcScope.DeclarationProc<>nil then
  4679. begin
  4680. // this proc has a forward declaration -> use that instead
  4681. Proc:=ProcScope.DeclarationProc;
  4682. El:=Proc;
  4683. end;
  4684. if Data^.Found is TPasProcedure then
  4685. begin
  4686. // there is already a previous proc
  4687. PrevProc:=TPasProcedure(Data^.Found);
  4688. if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
  4689. begin
  4690. if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
  4691. begin
  4692. Abort:=true;
  4693. exit;
  4694. end;
  4695. end
  4696. else
  4697. begin
  4698. // mode objfpc
  4699. if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
  4700. // mode objfpc: procs in same context have implicit overload
  4701. else
  4702. begin
  4703. // mode objfpc, different context
  4704. if not ProcHasGroupOverload(Data^.LastProc) then
  4705. begin
  4706. Abort:=true;
  4707. exit;
  4708. end;
  4709. end;
  4710. end;
  4711. if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
  4712. and (PrevProc.Parent.ClassType=TPasClassType) then
  4713. begin
  4714. // there was already a perfect proc in a descendant
  4715. Abort:=true;
  4716. exit;
  4717. end;
  4718. // check if previous found proc is override of found proc
  4719. if IsProcOverride(Proc,PrevProc) then
  4720. begin
  4721. // previous found proc is override of found proc -> skip
  4722. exit;
  4723. end;
  4724. end;
  4725. if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
  4726. Abort:=true; // stop searching after this proc
  4727. CandidateFound:=true;
  4728. if Data^.TemplCnt>0 then
  4729. begin
  4730. // proc must have templates
  4731. Templates:=GetProcTemplateTypes(Proc);
  4732. if (Templates=nil) or (Templates.Count<>Data^.TemplCnt) then
  4733. Distance:=cIncompatible
  4734. else
  4735. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4736. end
  4737. else
  4738. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4739. {$IFDEF VerbosePasResolver}
  4740. writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
  4741. ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',Data^.Distance,
  4742. ' Signature={',GetProcTypeDescription(Proc.ProcType,[prptdUseName,prptdAddPaths]),'}',
  4743. ' Abort=',Abort);
  4744. {$ENDIF}
  4745. Data^.LastProc:=Proc;
  4746. end
  4747. else if El is TPasType then
  4748. begin
  4749. TypeEl:=ResolveAliasType(TPasType(El));
  4750. C:=TypeEl.ClassType;
  4751. if Data^.TemplCnt<>0 then
  4752. begin
  4753. if (not C.InheritsFrom(TPasGenericType))
  4754. or (GetTypeParameterCount(TPasGenericType(TypeEl))<>Data^.TemplCnt)
  4755. then
  4756. exit;
  4757. end;
  4758. if C=TPasUnresolvedSymbolRef then
  4759. begin
  4760. if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
  4761. begin
  4762. // call of built-in proc
  4763. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  4764. if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
  4765. and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
  4766. begin
  4767. // str function can only be used within an expression
  4768. // str procedure can only be used outside an expression
  4769. {$IFDEF VerbosePasResolver}
  4770. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
  4771. {$ENDIF}
  4772. exit;
  4773. end;
  4774. Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
  4775. {$IFDEF VerbosePasResolver}
  4776. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
  4777. {$ENDIF}
  4778. CandidateFound:=true;
  4779. end
  4780. else if TypeEl.CustomData is TResElDataBaseType then
  4781. begin
  4782. // type cast to base type
  4783. Abort:=true; // can't be overloaded
  4784. if Data^.Found<>nil then exit;
  4785. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4786. {$IFDEF VerbosePasResolver}
  4787. writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
  4788. {$ENDIF}
  4789. CandidateFound:=true;
  4790. end;
  4791. end
  4792. else if (C=TPasClassType)
  4793. or (C=TPasClassOfType)
  4794. or (C=TPasPointerType)
  4795. or (C=TPasRecordType)
  4796. or (C=TPasEnumType)
  4797. or (C=TPasProcedureType)
  4798. or (C=TPasFunctionType)
  4799. or (C=TPasArrayType)
  4800. or (C=TPasRangeType)
  4801. or (C=TPasGenericTemplateType) then
  4802. begin
  4803. // type cast to user type
  4804. Abort:=true; // can't be overloaded
  4805. if Data^.Found<>nil then exit;
  4806. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4807. {$IFDEF VerbosePasResolver}
  4808. writeln('TPasResolver.OnFindCallElements type cast to "',GetObjName(El),'" Distance=',Distance);
  4809. {$ENDIF}
  4810. CandidateFound:=true;
  4811. end;
  4812. end
  4813. else if El is TPasVariable then
  4814. begin
  4815. Abort:=true; // can't be overloaded
  4816. if Data^.Found<>nil then exit;
  4817. if Data^.TemplCnt<>0 then exit;
  4818. if El.ClassType=TPasProperty then
  4819. VarType:=GetPasPropertyType(TPasProperty(El))
  4820. else
  4821. VarType:=TPasVariable(El).VarType;
  4822. VarType:=ResolveAliasType(VarType);
  4823. if VarType is TPasProcedureType then
  4824. begin
  4825. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4826. {$IFDEF VerbosePasResolver}
  4827. writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
  4828. {$ENDIF}
  4829. CandidateFound:=true;
  4830. end;
  4831. end
  4832. else if El.ClassType=TPasArgument then
  4833. begin
  4834. Abort:=true; // can't be overloaded
  4835. if Data^.Found<>nil then exit;
  4836. if Data^.TemplCnt<>0 then exit;
  4837. VarType:=ResolveAliasType(TPasArgument(El).ArgType);
  4838. if VarType is TPasProcedureType then
  4839. begin
  4840. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4841. {$IFDEF VerbosePasResolver}
  4842. writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
  4843. {$ENDIF}
  4844. CandidateFound:=true;
  4845. end;
  4846. end;
  4847. if not CandidateFound then
  4848. begin
  4849. // El does not support the () operator
  4850. Abort:=true;
  4851. if Data^.Found=nil then
  4852. begin
  4853. // El is the first element found -> raise error
  4854. // ToDo: use the ( as error position
  4855. RaiseMsg(20170216151525,nIllegalQualifierAfter,sIllegalQualifierAfter,
  4856. ['(',El.ElementTypeName],Data^.Params);
  4857. end;
  4858. exit;
  4859. end;
  4860. // El is a candidate (might be incompatible)
  4861. if (Data^.Found=nil)
  4862. or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
  4863. begin
  4864. {$IFDEF VerbosePasResolver}
  4865. writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
  4866. {$ENDIF}
  4867. Data^.Found:=El;
  4868. Data^.ElScope:=ElScope;
  4869. Data^.StartScope:=StartScope;
  4870. Data^.Distance:=Distance;
  4871. Data^.Count:=1;
  4872. if Data^.List<>nil then
  4873. begin
  4874. Data^.List.Clear;
  4875. Data^.List.Add(El);
  4876. end;
  4877. end
  4878. else if Distance=cIncompatible then
  4879. // another candidate, but it is incompatible -> ignore
  4880. {$IFDEF VerbosePasResolver}
  4881. writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
  4882. {$ENDIF}
  4883. else if (Data^.Distance=Distance)
  4884. or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)
  4885. and ((Distance>=cIntToFloatConversion)=(Data^.Distance>=cIntToFloatConversion))) then
  4886. begin
  4887. // found another similar compatible one -> collect
  4888. // Note: cLossyConversion is better than cIntToFloatConversion, not similar
  4889. {$IFDEF VerbosePasResolver}
  4890. writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
  4891. {$ENDIF}
  4892. inc(Data^.Count);
  4893. if (Data^.List<>nil) then
  4894. begin
  4895. if (Data^.List.IndexOf(El)>=0) then
  4896. begin
  4897. {$IFDEF VerbosePasResolver}
  4898. writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
  4899. ' ',GetElementSourcePosStr(El),
  4900. ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
  4901. ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
  4902. );
  4903. {$ENDIF}
  4904. RaiseInternalError(20160924230805);
  4905. end;
  4906. Data^.List.Add(El);
  4907. end;
  4908. end
  4909. else if (Distance<Data^.Distance) then
  4910. begin
  4911. // found a better one
  4912. {$IFDEF VerbosePasResolver}
  4913. writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4914. {$ENDIF}
  4915. if (Distance<cLossyConversion)
  4916. or ((Distance>=cIntToFloatConversion)<>(Data^.Distance>=cIntToFloatConversion)) then
  4917. begin
  4918. // found a good one
  4919. {$IFDEF VerbosePasResolver}
  4920. writeln('TPasResolver.OnFindCallElements Found a good candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4921. {$ENDIF}
  4922. Data^.Count:=1;
  4923. if Data^.List<>nil then
  4924. Data^.List.Clear;
  4925. end
  4926. else
  4927. begin
  4928. // found another lossy one
  4929. // -> collect them
  4930. {$IFDEF VerbosePasResolver}
  4931. writeln('TPasResolver.OnFindCallElements Found another lossy candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4932. {$ENDIF}
  4933. inc(Data^.Count);
  4934. end;
  4935. Data^.Found:=El;
  4936. Data^.ElScope:=ElScope;
  4937. Data^.StartScope:=StartScope;
  4938. Data^.Distance:=Distance;
  4939. if Data^.List<>nil then
  4940. Data^.List.Add(El);
  4941. end
  4942. else
  4943. begin
  4944. // found a worse one
  4945. end;
  4946. end;
  4947. procedure TPasResolver.OnFindProc(El: TPasElement; ElScope,
  4948. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  4949. var
  4950. Data: PFindProcData absolute FindProcData;
  4951. Proc: TPasProcedure;
  4952. Store, SameScope: Boolean;
  4953. ProcScope: TPasProcedureScope;
  4954. CurResolver: TPasResolver;
  4955. procedure CountProcInSameScope;
  4956. begin
  4957. inc(Data^.FoundInSameScope);
  4958. if Proc.IsOverload then
  4959. Data^.FoundOverloadModifier:=true;
  4960. end;
  4961. begin
  4962. //writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  4963. if not (El is TPasProcedure) then
  4964. begin
  4965. // identifier is not a proc
  4966. if (El is TPasVariable) then
  4967. begin
  4968. if TPasVariable(El).Visibility=visStrictPrivate then
  4969. exit; // not visible
  4970. if (TPasVariable(El).Visibility=visPrivate)
  4971. and (El.GetModule<>StartScope.Element.GetModule) then
  4972. exit; // not visible
  4973. end;
  4974. Data^.FoundNonProc:=El;
  4975. Abort:=true;
  4976. if (El.CustomData is TResElDataBuiltInProc) then
  4977. begin
  4978. if Data^.FoundOverloadModifier or Data^.Proc.IsOverload then
  4979. exit; // no hint
  4980. end;
  4981. case Data^.Kind of
  4982. fpkProc:
  4983. // proc hides a non proc
  4984. if (Data^.Proc.GetModule=El.GetModule) then
  4985. // forbidden within same module
  4986. RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
  4987. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
  4988. else
  4989. begin
  4990. // give a hint
  4991. if Data^.Proc.Parent is TPasMembersType then
  4992. begin
  4993. if El.Visibility=visStrictPrivate then
  4994. else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
  4995. else
  4996. LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
  4997. [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4998. end;
  4999. end;
  5000. fpkMethod:
  5001. // method hides a non proc
  5002. begin
  5003. ProcScope:=TPasProcedureScope(Data^.Proc.CustomData);
  5004. CurResolver:=ProcScope.Owner as TPasResolver;
  5005. if msDelphi in CurResolver.CurrentParser.CurrentModeswitches then
  5006. // ok in delphi
  5007. else
  5008. RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
  5009. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  5010. end;
  5011. end;
  5012. exit;
  5013. end;
  5014. // identifier is a proc
  5015. Proc:=TPasProcedure(El);
  5016. if El=Data^.Proc then
  5017. begin
  5018. // found itself -> this is normal when searching for overloads
  5019. CountProcInSameScope;
  5020. exit;
  5021. end;
  5022. {$IFDEF VerbosePasResolver}
  5023. writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
  5024. {$ENDIF}
  5025. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  5026. case Data^.Kind of
  5027. fpkProc:
  5028. SameScope:=Data^.Proc.GetModule=Proc.GetModule;
  5029. fpkMethod:
  5030. SameScope:=Data^.Proc.Parent=Proc.Parent;
  5031. else
  5032. // use OnFindProcDeclaration instead
  5033. RaiseNotYetImplemented(20191010123525,Data^.Proc);
  5034. end;
  5035. if SameScope then
  5036. begin
  5037. // same scope
  5038. if (msObjfpc in CurrentParser.CurrentModeswitches) then
  5039. begin
  5040. if ProcHasGroupOverload(Data^.Proc) then
  5041. Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
  5042. else if ProcHasGroupOverload(Proc) then
  5043. Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
  5044. end;
  5045. if Store then
  5046. begin
  5047. // same scope, same signature
  5048. // Note: forward declaration was already handled in FinishProcedureHeader
  5049. RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
  5050. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5051. end
  5052. else
  5053. begin
  5054. // same scope, different signature
  5055. if (msDelphi in CurrentParser.CurrentModeswitches) then
  5056. begin
  5057. // Delphi does not allow different procs without 'overload' in a scope
  5058. if not Proc.IsOverload then
  5059. RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
  5060. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  5061. else if not Data^.Proc.IsOverload then
  5062. RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
  5063. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5064. end
  5065. else
  5066. begin
  5067. // ObjFPC allows different procs without 'overload' modifier
  5068. end;
  5069. CountProcInSameScope;
  5070. end;
  5071. end
  5072. else
  5073. begin
  5074. // different scopes
  5075. if Data^.Proc.IsOverride then
  5076. else if Data^.Proc.IsReintroduced then
  5077. else
  5078. begin
  5079. if Store
  5080. or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
  5081. and not ProcHasGroupOverload(Data^.Proc)) then
  5082. begin
  5083. if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
  5084. // give a hint, that method hides a virtual method in ancestor
  5085. LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
  5086. sMethodHidesMethodOfBaseType,
  5087. [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  5088. else
  5089. begin
  5090. // Delphi/FPC do not give a message when hiding a non virtual method
  5091. // -> emit Hint with other message id
  5092. if (Data^.Proc.Parent is TPasMembersType) then
  5093. begin
  5094. ProcScope:=Proc.CustomData as TPasProcedureScope;
  5095. if (Proc.Visibility=visStrictPrivate)
  5096. or ((Proc.Visibility=visPrivate)
  5097. and (Proc.GetModule<>Data^.Proc.GetModule)) then
  5098. // a private private is hidden by definition -> no hint
  5099. else if (ProcScope.ImplProc<>nil) // not abstract, external
  5100. and (not ProcHasImplElements(ProcScope.ImplProc)) then
  5101. // hidden method has implementation, but no statements -> useless
  5102. // -> do not give a hint for hiding this useless method
  5103. // Note: if this happens in the same unit, the body was not yet parsed
  5104. else if (Proc is TPasConstructor)
  5105. and (Data^.Proc.ClassType=Proc.ClassType) then
  5106. // do not give a hint for hiding a constructor
  5107. else if Store then
  5108. begin
  5109. // method hides ancestor method with same signature
  5110. LogMsg(20190316152656,mtHint,
  5111. nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
  5112. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5113. end
  5114. else
  5115. begin
  5116. //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
  5117. LogMsg(20171118214523,mtHint,
  5118. nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
  5119. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5120. end;
  5121. end;
  5122. end;
  5123. Abort:=true;
  5124. end;
  5125. end;
  5126. end;
  5127. if Store then
  5128. begin
  5129. Data^.Found:=Proc;
  5130. Data^.ElScope:=ElScope;
  5131. Data^.StartScope:=StartScope;
  5132. Abort:=true;
  5133. end;
  5134. end;
  5135. procedure TPasResolver.OnFindProcDeclaration(El: TPasElement; ElScope,
  5136. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  5137. var
  5138. Data: PFindProcData absolute FindProcData;
  5139. Proc: TPasProcedure;
  5140. Store: Boolean;
  5141. begin
  5142. //writeln('TPasResolver.OnFindProcDeclaration START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  5143. if not (El is TPasProcedure) then
  5144. begin
  5145. // identifier is not a proc
  5146. Data^.FoundNonProc:=El;
  5147. Abort:=true;
  5148. exit;
  5149. end;
  5150. if El=Data^.Proc then
  5151. // found itself -> this is normal when searching for overloads
  5152. exit;
  5153. // identifier is a proc
  5154. Proc:=TPasProcedure(El);
  5155. {$IFDEF VerbosePasResolver}
  5156. writeln('TPasResolver.OnFindProcDeclaration ',GetTreeDbg(El,2));
  5157. {$ENDIF}
  5158. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  5159. if Store then
  5160. begin
  5161. Data^.Found:=Proc;
  5162. Data^.ElScope:=ElScope;
  5163. Data^.StartScope:=StartScope;
  5164. Abort:=true;
  5165. end;
  5166. end;
  5167. function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
  5168. ): boolean;
  5169. begin
  5170. if ProcParentA=ProcParentB then exit(true);
  5171. if (ProcParentA.ClassType=TInterfaceSection) then
  5172. begin
  5173. if (ProcParentB.ClassType=TImplementationSection)
  5174. and (ProcParentB.Parent=ProcParentA.Parent) then
  5175. exit(true);
  5176. end
  5177. else if (ProcParentB.ClassType=TInterfaceSection) then
  5178. begin
  5179. if (ProcParentA.ClassType=TImplementationSection)
  5180. and (ProcParentA.Parent=ProcParentB.Parent) then
  5181. exit(true);
  5182. end;
  5183. Result:=false;
  5184. end;
  5185. function TPasResolver.FindProcSameSignature(const ProcName: string;
  5186. Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
  5187. ): TPasProcedure;
  5188. var
  5189. FindData: TFindProcData;
  5190. Abort: boolean;
  5191. begin
  5192. FindData:=Default(TFindProcData);
  5193. FindData.Proc:=Proc;
  5194. FindData.Args:=Proc.ProcType.Args;
  5195. FindData.Kind:=fpkProcDeclaration;
  5196. Abort:=false;
  5197. //writeln('TPasResolver.FindProcSameSignature ',ProcName,' OnlyLocal=',OnlyLocal);
  5198. if OnlyLocal then
  5199. Scope.IterateLocalElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort)
  5200. else
  5201. Scope.IterateElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort);
  5202. Result:=FindData.Found;
  5203. end;
  5204. procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
  5205. var
  5206. Scanner: TPascalScanner;
  5207. begin
  5208. //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
  5209. if AValue=CurrentParser then exit;
  5210. Clear;
  5211. inherited SetCurrentParser(AValue);
  5212. if CurrentParser<>nil then
  5213. begin
  5214. CurrentParser.Options:=CurrentParser.Options+po_Resolver;
  5215. if CurrentParser.Scanner<>nil then
  5216. begin
  5217. Scanner:=CurrentParser.Scanner;
  5218. if (Scanner.OnWarnDirective=nil) then
  5219. Scanner.OnWarnDirective:=@ScannerWarnDirective;
  5220. Scanner.SetNonToken(tkself);
  5221. end;
  5222. end;
  5223. end;
  5224. procedure TPasResolver.ScannerWarnDirective(Sender: TObject;
  5225. Identifier: string; State: TWarnMsgState; var Handled: boolean);
  5226. var
  5227. MsgNumbers: TIntegerDynArray;
  5228. i: Integer;
  5229. begin
  5230. if not GetWarnIdentifierNumbers(Identifier,MsgNumbers) then exit;
  5231. Handled:=true;
  5232. for i:=0 to length(MsgNumbers)-1 do
  5233. TPascalScanner(Sender).WarnMsgState[MsgNumbers[i]]:=State;
  5234. end;
  5235. procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
  5236. AllowDescendants: boolean);
  5237. var
  5238. Scope: TPasScope;
  5239. begin
  5240. Scope:=TopScope;
  5241. if Scope=nil then
  5242. RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
  5243. if Scope.ClassType<>ExpectedClass then
  5244. if (not AllowDescendants) or (not Scope.InheritsFrom(ExpectedClass)) then
  5245. RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+Scope.ClassName);
  5246. end;
  5247. function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
  5248. const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
  5249. ): TPasIdentifier;
  5250. function SkipGenericTypes(Identifier: TPasIdentifier;
  5251. TypeParamCnt: integer): TPasIdentifier;
  5252. var
  5253. CurEl: TPasElement;
  5254. begin
  5255. while Identifier<>nil do
  5256. begin
  5257. CurEl:=Identifier.Element;
  5258. if CurEl is TPasGenericType then
  5259. begin
  5260. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
  5261. break;
  5262. end
  5263. else
  5264. begin
  5265. if TypeParamCnt=0 then
  5266. break;
  5267. end;
  5268. Identifier:=Identifier.NextSameIdentifier;
  5269. end;
  5270. Result:=Identifier;
  5271. end;
  5272. var
  5273. Group: TPasGroupScope;
  5274. Identifier, OlderIdentifier: TPasIdentifier;
  5275. OlderEl: TPasElement;
  5276. C: TClass;
  5277. i, TypeParamCnt: Integer;
  5278. OtherScope: TPasIdentifierScope;
  5279. ParentScope: TPasScope;
  5280. IsGeneric, IsDelphi: Boolean;
  5281. begin
  5282. if aName='' then exit(nil);
  5283. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  5284. if Scope is TPasGroupScope then
  5285. begin
  5286. Group:=TPasGroupScope(Scope);
  5287. Scope:=Group.Scopes[0];
  5288. end
  5289. else
  5290. Group:=nil;
  5291. if El is TPasGenericType then
  5292. begin
  5293. IsGeneric:=true;
  5294. TypeParamCnt:=GetTypeParameterCount(TPasGenericType(El));
  5295. end
  5296. else
  5297. begin
  5298. IsGeneric:=false;
  5299. TypeParamCnt:=0;
  5300. end;
  5301. if (El.Visibility=visPublished) then
  5302. begin
  5303. C:=El.ClassType;
  5304. if (C=TPasProperty) or (C=TPasVariable) then
  5305. // Note: VarModifiers are not yet set
  5306. else if (C=TPasProcedure) or (C=TPasFunction) then
  5307. // ok
  5308. else
  5309. RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  5310. end;
  5311. if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty)
  5312. and not IsDelphi then
  5313. begin
  5314. // check duplicate in ancestors and helpers
  5315. for i:=1 to Group.Count-1 do
  5316. begin
  5317. OtherScope:=Group.Scopes[i];
  5318. OlderIdentifier:=OtherScope.FindLocalIdentifier(aName);
  5319. if IsGeneric then
  5320. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5321. while OlderIdentifier<>nil do
  5322. begin
  5323. OlderEl:=OlderIdentifier.Element;
  5324. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  5325. if OlderEl is TPasVariable then
  5326. begin
  5327. if TPasVariable(OlderEl).Visibility=visStrictPrivate then
  5328. continue; // OlderEl is hidden
  5329. if (TPasVariable(OlderEl).Visibility=visPrivate)
  5330. and (OlderEl.GetModule<>El.GetModule) then
  5331. continue; // OlderEl is hidden
  5332. end;
  5333. RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
  5334. [aName,GetElementSourcePosStr(OlderEl)],El);
  5335. end;
  5336. end;
  5337. end;
  5338. Identifier:=Scope.AddIdentifier(aName,El,Kind);
  5339. // check duplicate in current scope
  5340. OlderIdentifier:=Identifier.NextSameIdentifier;
  5341. if IsGeneric and IsDelphi then
  5342. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5343. if OlderIdentifier<>nil then
  5344. begin
  5345. OlderEl:=OlderIdentifier.Element;
  5346. if (OlderEl.ClassType=TPasEnumValue)
  5347. and (OlderEl.Parent.Parent<>Scope.Element) then
  5348. begin
  5349. // this enum was propagated from a sub type -> remove enum from this scope
  5350. if OlderIdentifier.NextSameIdentifier<>nil then
  5351. RaiseNotYetImplemented(20190807114726,El,GetElementSourcePosStr(OlderEl));
  5352. Scope.RemoveLocalIdentifier(OlderEl);
  5353. OlderIdentifier:=nil;
  5354. OlderEl:=nil;
  5355. end
  5356. else if (El.Visibility=visPublished) and (El is TPasProcedure)
  5357. and (OlderEl is TPasProcedure) then
  5358. // published method bites method in same scope
  5359. RaiseMsg(20190626175432,nDuplicatePublishedMethodXAtY,
  5360. sDuplicatePublishedMethodXAtY,
  5361. [aName,GetElementSourcePosStr(OlderEl)],El)
  5362. else if (Identifier.Kind=pikSimple)
  5363. or (OlderIdentifier.Kind=pikSimple) then
  5364. // duplicate identifier
  5365. RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
  5366. [aName,GetElementSourcePosStr(OlderEl)],El);
  5367. end;
  5368. if (Scope=TopScope) and (Scope is TPasSectionScope) then
  5369. begin
  5370. ParentScope:=Scopes[ScopeCount-2];
  5371. if ParentScope is TPasSectionScope then
  5372. begin
  5373. // check unit interface and implementation duplicates
  5374. OlderIdentifier:=TPasSectionScope(ParentScope).FindLocalIdentifier(aName);
  5375. repeat
  5376. if IsGeneric then
  5377. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5378. if OlderIdentifier=nil then break;
  5379. OlderEl:=OlderIdentifier.Element;
  5380. if (Identifier.Kind=pikNamespace)
  5381. or (OlderIdentifier.Kind=pikNamespace) then
  5382. else if (Identifier.Kind=pikSimple)
  5383. or (OlderIdentifier.Kind=pikSimple) then
  5384. RaiseMsg(20190818141630,nDuplicateIdentifier,sDuplicateIdentifier,
  5385. [aName,GetElementSourcePosStr(OlderEl)],El);
  5386. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  5387. until OlderIdentifier=nil;
  5388. end;
  5389. end;
  5390. Result:=Identifier;
  5391. end;
  5392. procedure TPasResolver.FinishModule(CurModule: TPasModule);
  5393. var
  5394. CurModuleClass: TClass;
  5395. i: Integer;
  5396. ModScope: TPasModuleScope;
  5397. begin
  5398. {$IFDEF VerbosePasResolver}
  5399. writeln('TPasResolver.FinishModule START ',CurModule.Name);
  5400. {$ENDIF}
  5401. FStep:=prsFinishingModule;
  5402. CurModuleClass:=CurModule.ClassType;
  5403. ModScope:=CurModule.CustomData as TPasModuleScope;
  5404. if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
  5405. begin
  5406. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  5407. FindRangeErrorConstructors(nil);
  5408. end;
  5409. if (CurModuleClass=TPasProgram) then
  5410. begin
  5411. FinishSection(TPasProgram(CurModule).ProgramSection);
  5412. // resolve begin..end block
  5413. ResolveImplBlock(CurModule.InitializationSection);
  5414. end
  5415. else if (CurModuleClass=TPasLibrary) then
  5416. begin
  5417. FinishSection(TPasLibrary(CurModule).LibrarySection);
  5418. // resolve begin..end block
  5419. ResolveImplBlock(CurModule.InitializationSection);
  5420. ResolveImplBlock(CurModule.FinalizationSection);
  5421. end
  5422. else if (CurModuleClass=TPasModule) then
  5423. begin
  5424. // unit
  5425. FinishSection(CurModule.InterfaceSection);
  5426. if CurModule.ImplementationSection<>nil then
  5427. FinishSection(CurModule.ImplementationSection);
  5428. if CurModule.FinalizationSection<>nil then
  5429. // finalization section finished -> resolve
  5430. ResolveImplBlock(CurModule.FinalizationSection);
  5431. if CurModule.InitializationSection<>nil then
  5432. // initialization section finished -> resolve
  5433. ResolveImplBlock(CurModule.InitializationSection);
  5434. end
  5435. else
  5436. RaiseInternalError(20160922163327); // unknown module
  5437. // check all methods have bodies
  5438. // and all forward classes and pointers are resolved
  5439. for i:=0 to FPendingForwardProcs.Count-1 do
  5440. CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
  5441. FPendingForwardProcs.Clear;
  5442. // close all sections
  5443. while (TopScope<>nil) and (TopScope.ClassType=ScopeClass_Section) do
  5444. PopScope;
  5445. CheckTopScope(FScopeClass_Module);
  5446. PopScope;
  5447. FStep:=prsFinishedModule;
  5448. if (CurrentParser<>nil) and (CurrentParser.Scanner<>nil) then
  5449. begin
  5450. CurrentParser.NextToken;
  5451. if CurrentParser.Scanner.CurToken<>tkEOF then
  5452. LogMsg(20180628131456,mtHint,nTextAfterFinalIgnored,sTextAfterFinalIgnored,
  5453. [],nil);
  5454. end;
  5455. {$IFDEF VerbosePasResolver}
  5456. writeln('TPasResolver.FinishModule END ',CurModule.Name);
  5457. {$ENDIF}
  5458. end;
  5459. procedure TPasResolver.FinishUsesClause;
  5460. var
  5461. Section: TPasSection;
  5462. i, j: Integer;
  5463. PublicEl, UseModule: TPasElement;
  5464. Scope: TPasSectionScope;
  5465. UsesScope: TPasSectionScope;
  5466. UseUnit: TPasUsesUnit;
  5467. FirstName: String;
  5468. p: SizeInt;
  5469. OldIdentifier: TPasIdentifier;
  5470. IntfHelpers: TPRHelperEntryArray;
  5471. begin
  5472. CheckTopScope(ScopeClass_Section);
  5473. Scope:=TPasSectionScope(TopScope);
  5474. Section:=TPasSection(Scope.Element);
  5475. {$IFDEF VerbosePasResolver}
  5476. writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
  5477. {$ENDIF}
  5478. if Scope.UsesFinished then
  5479. RaiseInternalError(20180305145220);
  5480. Scope.UsesFinished:=true;
  5481. for i:=0 to Section.UsesList.Count-1 do
  5482. begin
  5483. UseUnit:=Section.UsesClause[i];
  5484. {$IFDEF VerbosePasResolver}
  5485. writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
  5486. {$ENDIF}
  5487. UseModule:=UseUnit.Module;
  5488. // check used unit
  5489. PublicEl:=nil;
  5490. if (UseModule.ClassType=TPasLibrary) then
  5491. PublicEl:=TPasLibrary(UseModule).LibrarySection
  5492. else if (UseModule.ClassType=TPasModule) then
  5493. PublicEl:=TPasModule(UseModule).InterfaceSection
  5494. else
  5495. RaiseXExpectedButYFound(20170503004803,'unit',GetElementTypeName(UseModule),UseUnit);
  5496. if PublicEl=nil then
  5497. RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
  5498. if PublicEl.CustomData=nil then
  5499. RaiseInternalError(20160922163358,'uses element has no resolver data: '
  5500. +UseUnit.Name+'->'+GetObjName(PublicEl));
  5501. if not (PublicEl.CustomData is TPasSectionScope) then
  5502. RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
  5503. +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
  5504. UsesScope:=TPasSectionScope(PublicEl.CustomData);
  5505. // add full uses name
  5506. AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
  5507. // add scope
  5508. {$IFDEF VerbosePasResolver}
  5509. writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
  5510. {$ENDIF}
  5511. Scope.UsesScopes.Add(UsesScope);
  5512. // add helpers
  5513. IntfHelpers:=UsesScope.Helpers;
  5514. for j:=0 to length(IntfHelpers)-1 do
  5515. AddActiveHelper(TPRHelperEntry(IntfHelpers[j]).Helper);
  5516. EmitElementHints(Section,UseUnit);
  5517. end;
  5518. // Add first name of dotted unitname (top level subnamespace) as identifier
  5519. for i:=Section.UsesList.Count-1 downto 0 do
  5520. begin
  5521. UseUnit:=Section.UsesClause[i];
  5522. FirstName:=UseUnit.Name;
  5523. p:=Pos('.',FirstName);
  5524. if p<1 then continue;
  5525. FirstName:=LeftStr(FirstName,p-1);
  5526. OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
  5527. if (OldIdentifier=nil) then
  5528. AddIdentifier(Scope,FirstName,UseUnit,pikNamespace);
  5529. end;
  5530. // Note: a sub identifier (e.g. a class member) hides all unitnames starting
  5531. // with this identifier
  5532. end;
  5533. procedure TPasResolver.FinishSection(Section: TPasSection);
  5534. // Note: can be called multiple times for a section
  5535. var
  5536. Scope: TPasSectionScope;
  5537. begin
  5538. Scope:=Section.CustomData as TPasSectionScope;
  5539. if Scope.Finished then exit;
  5540. Scope.Finished:=true;
  5541. if Section is TInterfaceSection then
  5542. FinishInterfaceSection(Section);
  5543. end;
  5544. procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
  5545. begin
  5546. {$IFDEF VerboseUnitQueue}
  5547. writeln('TPasResolver.FinishInterfaceSection ',GetObjName(RootElement));
  5548. {$ENDIF}
  5549. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  5550. if not IsUnitIntfFinished(Section.GetModule) then
  5551. RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+RootElement.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
  5552. {$ENDIF}
  5553. inc(Hub.FinishedInterfaceCount);
  5554. FFinishedInterfaceIndex:=Hub.FinishedInterfaceCount;
  5555. NotifyPendingUsedInterfaces;
  5556. if Section=nil then ;
  5557. end;
  5558. procedure TPasResolver.FinishTypeSection(El: TPasElement);
  5559. procedure FinishDeclarations(El: TPasDeclarations);
  5560. var
  5561. i: Integer;
  5562. Decl: TPasElement;
  5563. begin
  5564. for i:=0 to El.Declarations.Count-1 do
  5565. begin
  5566. Decl:=TPasElement(El.Declarations[i]);
  5567. if Decl is TPasType then
  5568. FinishTypeSectionEl(TPasType(Decl));
  5569. end;
  5570. end;
  5571. procedure FinishMembersType(El: TPasMembersType);
  5572. var
  5573. i: Integer;
  5574. Decl: TPasElement;
  5575. begin
  5576. for i:=0 to El.Members.Count-1 do
  5577. begin
  5578. Decl:=TPasElement(El.Members[i]);
  5579. if Decl is TPasType then
  5580. FinishTypeSectionEl(TPasType(Decl));
  5581. end;
  5582. end;
  5583. begin
  5584. // resolve pending forwards
  5585. if El is TPasDeclarations then
  5586. FinishDeclarations(TPasDeclarations(El))
  5587. else if El is TPasMembersType then
  5588. FinishMembersType(TPasMembersType(El))
  5589. else
  5590. RaiseNotYetImplemented(20181226105933,El);
  5591. end;
  5592. procedure TPasResolver.FinishTypeSectionEl(El: TPasType);
  5593. function ReplaceDestType(Decl: TPasType; var DestType: TPasType;
  5594. const DestName: string; MustExist: boolean; ErrorEl: TPasElement
  5595. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF}): boolean;
  5596. // returns true if replaces
  5597. var
  5598. Abort: boolean;
  5599. Data: TPRFindData;
  5600. OldDestType: TPasType;
  5601. begin
  5602. Abort:=false;
  5603. Data:=Default(TPRFindData);
  5604. Data.ErrorPosEl:=ErrorEl;
  5605. (TopScope as TPasIdentifierScope).IterateElements(DestName,
  5606. TopScope,@OnFindFirst,@Data,Abort);
  5607. //writeln('ReplaceDestType ',GetObjName(El),' DestType=',GetObjName(DestType),' DestType.Parent=',GetObjName(DestType.Parent),' RefCount=',DestType.RefCount);
  5608. if Data.Found=nil then
  5609. if MustExist then
  5610. begin
  5611. RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl);
  5612. end
  5613. else
  5614. exit(false);
  5615. if Data.Found=DestType then exit;
  5616. if Decl is TPasClassOfType then
  5617. begin
  5618. if (Data.Found.ClassType<>TPasClassType)
  5619. or (TPasClassType(Data.Found).ObjKind<>okClass) then
  5620. RaiseXExpectedButYFound(20170216151548,'class',GetElementTypeName(Data.Found),ErrorEl);
  5621. end;
  5622. // replace unresolved
  5623. OldDestType:=DestType;
  5624. DestType:=TPasType(Data.Found);
  5625. DestType.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5626. OldDestType.Release{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5627. CheckUseAsType(DestType,20190123100649,El);
  5628. // check cycles
  5629. if Decl is TPasPointerType then
  5630. CheckPointerCycle(TPasPointerType(Decl));
  5631. Result:=true;
  5632. end;
  5633. var
  5634. C: TClass;
  5635. ClassOfEl: TPasClassOfType;
  5636. TypeEl: TPasType;
  5637. UnresolvedEl: TUnresolvedPendingRef;
  5638. OldClassType: TPasClassType;
  5639. PtrType: TPasPointerType;
  5640. begin
  5641. C:=El.ClassType;
  5642. if C=TPasClassType then
  5643. begin
  5644. if TPasClassType(El).IsForward
  5645. and not (TPasClassType(El).CustomData is TResolvedReference) then
  5646. RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[El.Name],El);
  5647. end
  5648. else if (C=TPasClassOfType) then
  5649. begin
  5650. ClassOfEl:=TPasClassOfType(El);
  5651. TypeEl:=ResolveAliasType(ClassOfEl.DestType);
  5652. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5653. begin
  5654. // forward class-of -> resolve now
  5655. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5656. {$IFDEF VerbosePasResolver}
  5657. writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',TypeEl.Name,'"');
  5658. {$ENDIF}
  5659. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,TypeEl.Name,true,UnresolvedEl
  5660. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5661. end
  5662. else if TypeEl.ClassType=TPasClassType then
  5663. begin
  5664. // class-of has found a type
  5665. // another later in the same type section has priority -> check
  5666. OldClassType:=TypeEl as TPasClassType;
  5667. if OldClassType.Parent=ClassOfEl.Parent then
  5668. exit; // class in same type section -> ok
  5669. // class not in same type section -> check
  5670. {$IFDEF VerbosePasResolver}
  5671. writeln('TPasResolver.FinishTypeSection improving "',ClassOfEl.Name,'" = class of resolved "',TypeEl.Name,'"');
  5672. {$ENDIF}
  5673. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,ClassOfEl.DestType.Name,false,ClassOfEl
  5674. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5675. end;
  5676. end
  5677. else if C=TPasPointerType then
  5678. begin
  5679. PtrType:=TPasPointerType(El);
  5680. TypeEl:=ResolveAliasType(PtrType.DestType);
  5681. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5682. begin
  5683. // forward pointer -> resolve now
  5684. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5685. {$IFDEF VerbosePasResolver}
  5686. writeln('TPasResolver.FinishTypeSection resolving "',PtrType.Name,'" = pointer of unresolved "',TypeEl.Name,'"');
  5687. {$ENDIF}
  5688. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,true,UnresolvedEl
  5689. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5690. end
  5691. else
  5692. begin
  5693. // pointer-of has found a type
  5694. // another later in the same type section has priority -> check
  5695. if TypeEl.Parent=PtrType.Parent then
  5696. exit; // class in same type section -> ok
  5697. // dest not in same type section -> check
  5698. {$IFDEF VerbosePasResolver}
  5699. writeln('TPasResolver.FinishTypeSection improving "',PtrType.Name,'" = pointer of resolved "',TypeEl.Name,'"');
  5700. {$ENDIF}
  5701. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,false,PtrType
  5702. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5703. end;
  5704. end;
  5705. end;
  5706. procedure TPasResolver.FinishTypeDef(El: TPasType);
  5707. var
  5708. C: TClass;
  5709. begin
  5710. {$IFDEF VerbosePasResolver}
  5711. //writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
  5712. {$ENDIF}
  5713. C:=El.ClassType;
  5714. if C=TPasEnumType then
  5715. FinishEnumType(TPasEnumType(El))
  5716. else if C=TPasSetType then
  5717. FinishSetType(TPasSetType(El))
  5718. else if C=TPasRangeType then
  5719. FinishRangeType(TPasRangeType(El))
  5720. else if C=TPasRecordType then
  5721. FinishRecordType(TPasRecordType(El))
  5722. else if C=TPasClassType then
  5723. FinishClassType(TPasClassType(El))
  5724. else if C=TPasClassOfType then
  5725. FinishClassOfType(TPasClassOfType(El))
  5726. else if C=TPasPointerType then
  5727. FinishPointerType(TPasPointerType(El))
  5728. else if C=TPasArrayType then
  5729. FinishArrayType(TPasArrayType(El))
  5730. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  5731. FinishAliasType(TPasAliasType(El))
  5732. else if (C=TPasPointerType) then
  5733. EmitTypeHints(El,TPasPointerType(El).DestType)
  5734. else if C=TPasGenericTemplateType then
  5735. FinishGenericTemplateType(TPasGenericTemplateType(El))
  5736. else if C=TPasSpecializeType then
  5737. FinishSpecializeType(TPasSpecializeType(El));
  5738. end;
  5739. procedure TPasResolver.FinishEnumType(El: TPasEnumType);
  5740. begin
  5741. if TopScope.Element=El then
  5742. PopScope;
  5743. end;
  5744. procedure TPasResolver.FinishSetType(El: TPasSetType);
  5745. function GetEnumTypePosEl: TPasElement;
  5746. begin
  5747. Result:=El.EnumType;
  5748. if Result.Parent<>El then
  5749. Result:=El;
  5750. end;
  5751. var
  5752. BaseTypeData: TResElDataBaseType;
  5753. StartResolved, EndResolved: TPasResolverResult;
  5754. RangeExpr: TBinaryExpr;
  5755. C: TClass;
  5756. EnumType: TPasType;
  5757. begin
  5758. EnumType:=ResolveAliasType(El.EnumType);
  5759. C:=EnumType.ClassType;
  5760. if C=TPasEnumType then
  5761. begin
  5762. FinishSubElementType(El,EnumType);
  5763. exit;
  5764. end
  5765. else if C=TPasRangeType then
  5766. begin
  5767. RangeExpr:=TPasRangeType(EnumType).RangeExpr;
  5768. if (RangeExpr.Parent=El) and (RangeExpr.CustomData=nil) then
  5769. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5770. FinishSubElementType(El,EnumType);
  5771. exit;
  5772. end
  5773. else if C=TPasUnresolvedSymbolRef then
  5774. begin
  5775. if EnumType.CustomData is TResElDataBaseType then
  5776. begin
  5777. BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
  5778. if BaseTypeData.BaseType in (btAllChars+[btBoolean,btByte]) then
  5779. exit;
  5780. RaiseXExpectedButYFound(20170216151553,'char or boolean',
  5781. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5782. end;
  5783. end;
  5784. RaiseXExpectedButYFound(20170216151557,'enum type',
  5785. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5786. end;
  5787. procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
  5788. procedure InsertInFront(NewParent: TPasElement; List: TFPList
  5789. {$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF});
  5790. var
  5791. i: Integer;
  5792. p: TPasElement;
  5793. begin
  5794. p:=El.Parent;
  5795. if NewParent=p.Parent then
  5796. begin
  5797. // e.g. a:array of longint; -> insert a$a in front of a
  5798. i:=List.Count-1;
  5799. while (i>=0) and (List[i]<>Pointer(p)) do
  5800. dec(i);
  5801. if i<0 then
  5802. List.Add(El)
  5803. else
  5804. List.Insert(i,El);
  5805. end
  5806. else
  5807. begin
  5808. List.Add(El);
  5809. end;
  5810. El.AddRef{$IFDEF CheckPasTreeRefCount}(aID){$ENDIF};
  5811. El.Parent:=NewParent;
  5812. end;
  5813. var
  5814. Decl: TPasDeclarations;
  5815. EnumScope: TPasEnumTypeScope;
  5816. p: TPasElement;
  5817. MembersType: TPasMembersType;
  5818. begin
  5819. EmitTypeHints(Parent,El);
  5820. if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
  5821. if Parent.Name='' then
  5822. RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5823. if El.Parent<>Parent then
  5824. RaiseNotYetImplemented(20190215085011,Parent);
  5825. // give anonymous sub type a name
  5826. El.Name:=Parent.Name+AnonymousElTypePostfix;
  5827. {$IFDEF VerbosePasResolver}
  5828. writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
  5829. {$ENDIF}
  5830. p:=Parent.Parent;
  5831. repeat
  5832. if p is TPasDeclarations then
  5833. begin
  5834. Decl:=TPasDeclarations(p);
  5835. InsertInFront(Decl,Decl.Declarations{$IFDEF CheckPasTreeRefCount},'TPasDeclarations.Declarations'{$ENDIF});
  5836. Decl.Types.Add(El);
  5837. break;
  5838. end
  5839. else if p is TPasMembersType then
  5840. begin
  5841. MembersType:=TPasMembersType(p);
  5842. InsertInFront(MembersType,MembersType.Members{$IFDEF CheckPasTreeRefCount},'TPasMembersType.Members'{$ENDIF});
  5843. break;
  5844. end
  5845. else
  5846. p:=p.Parent;
  5847. if p=nil then
  5848. RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5849. until false;
  5850. if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
  5851. begin
  5852. // anonymous enumtype
  5853. EnumScope:=TPasEnumTypeScope(El.CustomData);
  5854. if EnumScope.CanonicalSet<>Parent then
  5855. begin
  5856. // When a TPasEnumType is created a CanonicalSet is created.
  5857. // Release the autocreated CanonicalSet and use the parent.
  5858. if EnumScope.CanonicalSet<>nil then
  5859. EnumScope.CanonicalSet.Release{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5860. EnumScope.CanonicalSet:=TPasSetType(Parent);
  5861. Parent.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5862. end;
  5863. end;
  5864. end;
  5865. procedure TPasResolver.FinishRangeType(El: TPasRangeType);
  5866. var
  5867. RangeExpr: TBinaryExpr;
  5868. StartResolved, EndResolved: TPasResolverResult;
  5869. begin
  5870. RangeExpr:=El.RangeExpr;
  5871. ResolveExpr(RangeExpr.left,rraRead);
  5872. ResolveExpr(RangeExpr.right,rraRead);
  5873. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5874. end;
  5875. procedure TPasResolver.FinishConstRangeExpr(RangeExpr: TBinaryExpr; out
  5876. LeftResolved, RightResolved: TPasResolverResult);
  5877. // for example Left..Right
  5878. var
  5879. RgValue: TResEvalValue;
  5880. Left, Right: TPasExpr;
  5881. begin
  5882. Left:=RangeExpr.left;
  5883. Right:=RangeExpr.right;
  5884. {$IFDEF VerbosePasResEval}
  5885. writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
  5886. {$ENDIF}
  5887. // check type compatibility
  5888. ComputeElement(Left,LeftResolved,[rcConstant]);
  5889. ComputeElement(Right,RightResolved,[rcConstant]);
  5890. CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
  5891. RgValue:=Eval(RangeExpr,[refConst]);
  5892. ReleaseEvalValue(RgValue);
  5893. end;
  5894. procedure TPasResolver.FinishRecordType(El: TPasRecordType);
  5895. var
  5896. Scope: TPasRecordScope;
  5897. begin
  5898. if TopScope.Element<>El then
  5899. RaiseNotYetImplemented(20190801232042,El);
  5900. PopScope;
  5901. Scope:=El.CustomData as TPasRecordScope;
  5902. FinishGenericClassOrRecIntf(Scope);
  5903. end;
  5904. procedure TPasResolver.FinishClassType(El: TPasClassType);
  5905. type
  5906. TMethResolution = record
  5907. InterfaceIndex: integer;
  5908. ProcClassType: TPasProcedureClass;
  5909. InterfaceName: string;
  5910. ImplementName: string;
  5911. ResolutionEl: TPasMethodResolution;
  5912. Count: integer; // needed to check if method resolution is used
  5913. end;
  5914. var
  5915. ClassScope: TPasClassScope;
  5916. i, j, k: Integer;
  5917. IntfType: TPasClassType;
  5918. Resolutions: array of TMethResolution;
  5919. Map: TPasClassIntfMap;
  5920. o: TObject;
  5921. Member, Parent: TPasElement;
  5922. IntfProc: TPasProcedure;
  5923. FindData: TFindProcData;
  5924. Abort: boolean;
  5925. MethRes: TPasMethodResolution;
  5926. ResolvedEl: TPasResolverResult;
  5927. ProcName, IntfProcName: String;
  5928. Expr: TPasExpr;
  5929. SectionScope: TPasSectionScope;
  5930. begin
  5931. Resolutions:=nil;
  5932. ClassScope:=nil;
  5933. if not El.IsForward then
  5934. begin
  5935. if TopScope.Element<>El then
  5936. RaiseInternalError(20180322142534,GetObjName(El)+'<>'+GetObjName(TopScope.Element));
  5937. ClassScope:=El.CustomData as TPasClassScope;
  5938. if ClassScope=nil then
  5939. RaiseNotYetImplemented(20190803204709,El);
  5940. if El.ObjKind=okClass then
  5941. begin
  5942. if (El.Interfaces.Count>0) then
  5943. begin
  5944. if (ClassScope.Interfaces=nil) then
  5945. RaiseInternalError(20180408162725,'');
  5946. if (ClassScope.Interfaces.Count<>El.Interfaces.Count) then
  5947. RaiseInternalError(20180408162746,'');
  5948. end
  5949. else if ClassScope.Interfaces<>nil then
  5950. RaiseInternalError(20180408162803,'');
  5951. // check explicit method resolutions, e.g. procedure intf.intfproc = implproc
  5952. for i:=0 to El.Members.Count-1 do
  5953. begin
  5954. Member:=TPasElement(El.Members[i]);
  5955. if not (Member is TPasMethodResolution) then continue;
  5956. MethRes:=TPasMethodResolution(Member);
  5957. // get interface
  5958. ComputeElement(MethRes.InterfaceName,ResolvedEl,[rcNoImplicitProc]);
  5959. if not (ResolvedEl.IdentEl is TPasType) then
  5960. RaiseInternalError(20180323135729,GetResolverResultDbg(ResolvedEl));
  5961. j:=El.Interfaces.IndexOf(ResolvedEl.IdentEl);
  5962. if j<0 then
  5963. RaiseInternalError(20180323135900,GetResolverResultDbg(ResolvedEl));
  5964. // get class-interface-map, check delegations
  5965. o:=TObject(ClassScope.Interfaces[j]);
  5966. if o is TPasProperty then
  5967. RaiseMsg(20180323140046,nCannotMixMethodResolutionAndDelegationAtX,
  5968. sCannotMixMethodResolutionAndDelegationAtX,
  5969. [GetElementSourcePosStr(TPasProperty(o))],MethRes.InterfaceName);
  5970. if o=nil then
  5971. o:=CreateClassIntfMap(El,j);
  5972. Map:=TPasClassIntfMap(o);
  5973. // get interface proc name
  5974. Expr:=MethRes.InterfaceProc;
  5975. if not (Expr is TPrimitiveExpr) then
  5976. RaiseXExpectedButYFound(20180327162230,'method name',GetElementTypeName(Expr),Expr);
  5977. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5978. RaiseXExpectedButYFound(20180327162236,'method name',GetElementTypeName(Expr),Expr);
  5979. IntfProcName:=TPrimitiveExpr(Expr).Value;
  5980. // get implementation proc name
  5981. Expr:=MethRes.ImplementationProc;
  5982. if not (Expr is TPrimitiveExpr) then
  5983. RaiseXExpectedButYFound(20180327152115,'method name',GetElementTypeName(Expr),Expr);
  5984. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5985. RaiseXExpectedButYFound(20180327152157,'method name',GetElementTypeName(Expr),Expr);
  5986. ProcName:=TPrimitiveExpr(Expr).Value;
  5987. for k:=0 to length(Resolutions)-1 do
  5988. with Resolutions[k] do
  5989. if (InterfaceIndex=j) and (ProcClassType=MethRes.ProcClass)
  5990. and (InterfaceName=IntfProcName) then
  5991. RaiseMsg(20180327164626,nDuplicateIdentifier,sDuplicateIdentifier,
  5992. [GetElementTypeName(ProcClassType)+' '+Map.Intf.Name+'.'+InterfaceName,
  5993. GetElementSourcePosStr(ResolutionEl)],MethRes.InterfaceProc);
  5994. // add resolution
  5995. k:=length(Resolutions);
  5996. SetLength(Resolutions,k+1);
  5997. with Resolutions[k] do
  5998. begin
  5999. InterfaceIndex:=j;
  6000. ProcClassType:=MethRes.ProcClass;
  6001. InterfaceName:=IntfProcName;
  6002. ImplementName:=ProcName;
  6003. ResolutionEl:=MethRes;
  6004. Count:=0;
  6005. end;
  6006. end;
  6007. // method resolution
  6008. for i:=0 to El.Interfaces.Count-1 do
  6009. begin
  6010. o:=TObject(ClassScope.Interfaces[i]);
  6011. //writeln('TPasResolver.FinishClassType class=',GetObjName(El),' i=',i,' Intf=',GetObjName(TObject(El.Interfaces[i])),' Map=',GetObjName(o));
  6012. if o is TPasProperty then
  6013. continue; // interface implemented via a property
  6014. if o=nil then
  6015. o:=CreateClassIntfMap(El,i);
  6016. Map:=TPasClassIntfMap(o);
  6017. while Map<>nil do
  6018. begin
  6019. IntfType:=Map.Intf;
  6020. //writeln('TPasResolver.FinishClassType ',GetObjName(Map),' ',GetObjName(IntfType),' Count=',IntfType.Members.Count);
  6021. for j:=0 to IntfType.Members.Count-1 do
  6022. begin
  6023. Member:=TPasElement(IntfType.Members[j]);
  6024. if not (Member is TPasProcedure) then continue;
  6025. IntfProc:=TPasProcedure(Member);
  6026. ProcName:=IntfProc.Name;
  6027. // check resolutions
  6028. for k:=0 to length(Resolutions)-1 do
  6029. with Resolutions[k] do
  6030. begin
  6031. if (InterfaceIndex=i) and (ProcClassType=IntfProc.ClassType)
  6032. and SameText(InterfaceName,IntfProc.Name) then
  6033. begin
  6034. ProcName:=ImplementName;
  6035. inc(Count);
  6036. end;
  6037. end;
  6038. // search interface method in class
  6039. FindData:=Default(TFindProcData);
  6040. FindData.Proc:=IntfProc;
  6041. FindData.Args:=IntfProc.ProcType.Args;
  6042. FindData.Kind:=fpkProcDeclaration;
  6043. Abort:=false;
  6044. IterateElements(ProcName,@OnFindProcDeclaration,@FindData,Abort);
  6045. if FindData.Found=nil then
  6046. RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
  6047. sNoMatchingImplForIntfMethodXFound,
  6048. [GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
  6049. // check calling conventions
  6050. //writeln('TPasResolver.FinishClassType Intf=',GetObjPath(IntfProc),' Found=',GetObjPath(FindData.Found));
  6051. CheckProcSignatureMatch(IntfProc,TPasProcedure(FindData.Found),true);
  6052. Map.Procs[j]:=FindData.Found;
  6053. end;
  6054. Map:=Map.AncestorMap;
  6055. end;
  6056. end;
  6057. // ToDo: hint if method resolution is not used
  6058. end;
  6059. if El.ObjKind in okAllHelpers then
  6060. begin
  6061. // activate helper
  6062. AddActiveHelper(El);
  6063. // cache helpers in interface, so other modules don't have to search
  6064. Parent:=El.Parent;
  6065. while Parent<>nil do
  6066. begin
  6067. if Parent.ClassType=TInterfaceSection then
  6068. begin
  6069. SectionScope:=Parent.CustomData as TPasSectionScope;
  6070. AddHelper(El,SectionScope.Helpers);
  6071. break;
  6072. end;
  6073. Parent:=Parent.Parent;
  6074. end;
  6075. end;
  6076. end;
  6077. if TopScope.Element=El then
  6078. PopScope // pop TPasClassScope
  6079. else
  6080. ; // e.g. class forward
  6081. if TopScope is TPasGenericParamsScope then
  6082. PopGenericParamScope(El);
  6083. if not El.IsForward then
  6084. FinishGenericClassOrRecIntf(ClassScope);
  6085. end;
  6086. procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
  6087. var
  6088. TypeEl: TPasType;
  6089. begin
  6090. TypeEl:=ResolveAliasType(El.DestType);
  6091. if TypeEl is TUnresolvedPendingRef then
  6092. begin
  6093. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  6094. exit;
  6095. end;
  6096. if (TypeEl is TPasClassType) and (TPasClassType(TypeEl).ObjKind=okClass) then exit;
  6097. RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  6098. [El.DestType.Name,'class'],El);
  6099. end;
  6100. procedure TPasResolver.FinishPointerType(El: TPasPointerType);
  6101. var
  6102. TypeEl: TPasType;
  6103. begin
  6104. TypeEl:=ResolveAliasType(El.DestType);
  6105. if TypeEl is TUnresolvedPendingRef then
  6106. begin
  6107. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  6108. exit;
  6109. end;
  6110. if El.DestType.Parent=El then
  6111. RaiseMsg(20180429094237,nNotYetImplemented,sNotYetImplemented,['pointer of anonymous type'], El.DestType);
  6112. CheckUseAsType(El.DestType,20190123095118,El);
  6113. CheckPointerCycle(El);
  6114. end;
  6115. procedure TPasResolver.FinishArrayType(El: TPasArrayType);
  6116. var
  6117. i: Integer;
  6118. Expr: TPasExpr;
  6119. RangeResolved: TPasResolverResult;
  6120. TypeEl: TPasType;
  6121. Parent: TPasArrayType;
  6122. Scope: TPasArrayScope;
  6123. begin
  6124. // check cycles
  6125. Parent:=El;
  6126. repeat
  6127. if Parent=El.ElType then
  6128. RaiseMsg(20190807104630,nIllegalExpression,sIllegalExpression,[],El);
  6129. if Parent.Parent is TPasArrayType then
  6130. Parent:=TPasArrayType(Parent.Parent)
  6131. else
  6132. break;
  6133. until false;
  6134. for i:=0 to length(El.Ranges)-1 do
  6135. begin
  6136. Expr:=El.Ranges[i];
  6137. ResolveExpr(Expr,rraRead);
  6138. ComputeElement(Expr,RangeResolved,[rcConstant]);
  6139. if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
  6140. begin
  6141. {$IFDEF VerbosePasResolver}
  6142. writeln('TPasResolver.FinishArrayType ',GetResolverResultDbg(RangeResolved));
  6143. {$ENDIF}
  6144. RaiseXExpectedButYFound(20170216151607,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6145. end;
  6146. if (RangeResolved.BaseType=btRange) then
  6147. begin
  6148. if (RangeResolved.SubType in btArrayRangeTypes) then
  6149. // range, e.g. 1..2
  6150. else if RangeResolved.SubType=btContext then
  6151. begin
  6152. TypeEl:=RangeResolved.LoTypeEl;
  6153. if TypeEl is TPasRangeType then
  6154. // custom range
  6155. else if TypeEl is TPasEnumType then
  6156. // anonymous enum range
  6157. else
  6158. RaiseXExpectedButYFound(20171009193629,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6159. end
  6160. else
  6161. RaiseXExpectedButYFound(20171009193514,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6162. end
  6163. else if RangeResolved.BaseType in btArrayRangeTypes then
  6164. // full range, e.g. array[char]
  6165. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasEnumType) then
  6166. // e.g. array[enumtype]
  6167. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasGenericTemplateType) then
  6168. // e.g. Tarr<T> = array[T] of ...
  6169. else if RangeResolved.IdentEl<>nil then
  6170. RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr)
  6171. else
  6172. RaiseXExpectedButYFound(20190830215123,'range',GetResolverResultDescription(RangeResolved),Expr);
  6173. end;
  6174. if El.ElType=nil then
  6175. begin
  6176. // array of const
  6177. if length(El.Ranges)>0 then
  6178. RaiseNotYetImplemented(20190215102529,El);
  6179. FindTVarRec(El);
  6180. end
  6181. else
  6182. begin
  6183. CheckUseAsType(El.ElType,20190123095401,El);
  6184. FinishSubElementType(El,El.ElType);
  6185. end;
  6186. if El.CustomData is TPasArrayScope then
  6187. begin
  6188. Scope:=TPasArrayScope(El.CustomData);
  6189. Scope.GenericStep:=psgsImplementationParsed;
  6190. end;
  6191. if TopScope.Element=El then
  6192. PopScope;
  6193. end;
  6194. procedure TPasResolver.FinishAliasType(El: TPasAliasType);
  6195. var
  6196. aType: TPasType;
  6197. begin
  6198. aType:=ResolveAliasType(El);
  6199. if (aType is TPasMembersType) and (aType.CustomData=nil) then
  6200. exit;
  6201. if (aType is TPasGenericType)
  6202. and (GetTypeParameterCount(TPasGenericType(aType))>0) then
  6203. RaiseMsg(20190818135830,nXExpectedButYFound,sXExpectedButYFound,
  6204. ['type',GetTypeDescription(aType)],El);
  6205. EmitTypeHints(El,TPasAliasType(El).DestType);
  6206. end;
  6207. procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
  6208. var
  6209. ConEl: TPasElement;
  6210. procedure RaiseCannotBeTogether(const Id: TMaxPrecInt; const X,Y: string);
  6211. begin
  6212. RaiseMsg(Id,nConstraintXAndConstraintYCannotBeTogether,
  6213. sConstraintXAndConstraintYCannotBeTogether,[X,Y],
  6214. GetGenericConstraintErrorEl(ConEl,El));
  6215. end;
  6216. procedure RaiseXIsNotAValidConstraint(const Id: TMaxPrecInt; const X: string);
  6217. begin
  6218. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[X],
  6219. GetGenericConstraintErrorEl(ConEl,El));
  6220. end;
  6221. var
  6222. i: Integer;
  6223. IsClass, IsRecord, IsConstructor: Boolean;
  6224. LastType: TPasType;
  6225. MemberType: TPasMembersType;
  6226. aClass: TPasClassType;
  6227. ConToken: TToken;
  6228. ResolvedEl: TPasResolverResult;
  6229. begin
  6230. {$IFDEF VerbosePasResolver}
  6231. writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
  6232. {$ENDIF}
  6233. IsClass:=false;
  6234. IsRecord:=false;
  6235. IsConstructor:=false;
  6236. LastType:=nil;
  6237. for i:=0 to length(El.Constraints)-1 do
  6238. begin
  6239. ConEl:=El.Constraints[i];
  6240. ConToken:=GetGenericConstraintKeyword(ConEl);
  6241. case ConToken of
  6242. tkclass:
  6243. begin
  6244. if IsClass then
  6245. RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
  6246. sConstraintXSpecifiedMoreThanOnce,['class'],ConEl);
  6247. if IsRecord then
  6248. RaiseCannotBeTogether(20190720202516,'record','class');
  6249. if LastType<>nil then
  6250. RaiseCannotBeTogether(20190720205708,LastType.Name,'class');
  6251. IsClass:=true;
  6252. end;
  6253. tkrecord:
  6254. begin
  6255. if IsRecord then
  6256. RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
  6257. sConstraintXSpecifiedMoreThanOnce,['record'],ConEl);
  6258. if IsClass then
  6259. RaiseCannotBeTogether(20190720203039,'class','record');
  6260. if IsConstructor then
  6261. RaiseCannotBeTogether(20190720203056,'constructor','record');
  6262. if LastType<>nil then
  6263. RaiseCannotBeTogether(20190720205938,LastType.Name,'record');
  6264. IsRecord:=true;
  6265. end;
  6266. tkconstructor:
  6267. begin
  6268. if IsConstructor then
  6269. RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
  6270. sConstraintXSpecifiedMoreThanOnce,['constructor'],ConEl);
  6271. if IsRecord then
  6272. RaiseCannotBeTogether(20190720203148,'record','constructor');
  6273. if LastType<>nil then
  6274. RaiseCannotBeTogether(20190720210005,LastType.Name,'constructor');
  6275. IsConstructor:=true;
  6276. end;
  6277. else
  6278. if not (ConEl is TPasType) then
  6279. RaiseXIsNotAValidConstraint(20190912215619,GetElementTypeName(ConEl));
  6280. // type identifier: class, record or interface
  6281. ComputeElement(ConEl,ResolvedEl,[rcType]);
  6282. if ResolvedEl.BaseType<>btContext then
  6283. RaiseXIsNotAValidConstraint(20190914105144,GetElementTypeName(ConEl));
  6284. if IsRecord then
  6285. RaiseCannotBeTogether(20190720210130,'record',ResolvedEl.HiTypeEl.Name);
  6286. if IsClass then
  6287. RaiseCannotBeTogether(20190720210202,'class',ResolvedEl.HiTypeEl.Name);
  6288. if IsConstructor then
  6289. RaiseCannotBeTogether(20190720210244,'constructor',ResolvedEl.HiTypeEl.Name);
  6290. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  6291. begin
  6292. if ResolvedEl.LoTypeEl=El then
  6293. RaiseMsg(20200820185313,nTypeCycleFound,sTypeCycleFound,[],
  6294. GetGenericConstraintErrorEl(ConEl,El));
  6295. // ok
  6296. if length(El.Constraints)>1 then
  6297. RaiseXIsNotAValidConstraint(20190831213645,ResolvedEl.HiTypeEl.Name);
  6298. end
  6299. else if ResolvedEl.LoTypeEl is TPasMembersType then
  6300. begin
  6301. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  6302. if MemberType is TPasClassType then
  6303. begin
  6304. aClass:=TPasClassType(MemberType);
  6305. case aClass.ObjKind of
  6306. okClass:
  6307. begin
  6308. // there can be at most one classtype constraint
  6309. if LastType<>nil then
  6310. RaiseCannotBeTogether(20190720210351,LastType.Name,MemberType.Name);
  6311. end;
  6312. okInterface:
  6313. begin
  6314. if LastType<>nil then
  6315. begin
  6316. // there can be multiple interfacetype constraint
  6317. if not (LastType is TPasClassType) then
  6318. RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name);
  6319. if TPasClassType(LastType).ObjKind<>okInterface then
  6320. RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
  6321. end;
  6322. end;
  6323. else
  6324. RaiseXIsNotAValidConstraint(20190720210919,MemberType.Name);
  6325. end;
  6326. end
  6327. else
  6328. RaiseXIsNotAValidConstraint(20190720210809,MemberType.Name);
  6329. end
  6330. else
  6331. RaiseXIsNotAValidConstraint(20190720204604,GetResolverResultDescription(ResolvedEl,true));
  6332. LastType:=ResolvedEl.LoTypeEl;
  6333. end; // end of case
  6334. end; // end of for
  6335. end;
  6336. procedure TPasResolver.FinishSpecializeType(El: TPasSpecializeType);
  6337. var
  6338. Params, GenericTemplateList: TFPList;
  6339. P: TPasElement;
  6340. DestType: TPasType;
  6341. i, ScopeDepth: Integer;
  6342. GenType: TPasGenericType;
  6343. begin
  6344. {$IFDEF VerbosePasResolver}
  6345. //writeln('TPasResolver.FinishSpecializeType ');
  6346. {$ENDIF}
  6347. // resolve Params
  6348. ScopeDepth:=StashSubExprScopes;
  6349. Params:=El.Params;
  6350. if Params.Count=0 then
  6351. RaiseMsg(20190724114416,nMissingParameterX,sMissingParameterX,['type'],El);
  6352. for i:=0 to Params.Count-1 do
  6353. begin
  6354. P:=TPasElement(Params[i]);
  6355. if P is TPasExpr then
  6356. ResolveExpr(TPasExpr(P),rraRead)
  6357. else if P is TPasType then
  6358. else
  6359. RaiseMsg(20190728113336,nXExpectedButYFound,sXExpectedButYFound,['type identifier',GetObjName(P)+' parameter '+IntToStr(i+1)],El);
  6360. end;
  6361. RestoreStashedScopes(ScopeDepth);
  6362. // check DestType
  6363. DestType:=El.DestType;
  6364. if DestType=nil then
  6365. RaiseMsg(20190725184734,nIdentifierNotFound,sIdentifierNotFound,['specialize type'],El)
  6366. else if not (DestType is TPasGenericType) then
  6367. RaiseMsg(20190725193552,nXExpectedButYFound,sXExpectedButYFound,['generic type',DestType.Name],El);
  6368. GenType:=TPasGenericType(DestType);
  6369. // Note: there can be TBird, TBird<T> and TBird<T,U>
  6370. GenericTemplateList:=GenType.GenericTemplateTypes;
  6371. if GenericTemplateList=nil then
  6372. RaiseMsg(20190725194222,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6373. ['type '+DestType.Name],El);
  6374. if GenericTemplateList.Count<>Params.Count then
  6375. RaiseMsg(20190801222656,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6376. ['type '+DestType.Name],El);
  6377. GetSpecializedEl(El,GenType,Params);
  6378. end;
  6379. procedure TPasResolver.FinishResourcestring(El: TPasResString);
  6380. var
  6381. ResolvedEl: TPasResolverResult;
  6382. begin
  6383. ResolveExpr(El.Expr,rraRead);
  6384. ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
  6385. if not (ResolvedEl.BaseType in btAllStringAndChars) then
  6386. RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
  6387. end;
  6388. procedure TPasResolver.FinishProcedure(Proc: TPasProcedure);
  6389. var
  6390. i: Integer;
  6391. Body: TProcedureBody;
  6392. SubEl: TPasElement;
  6393. SubProcScope, ProcScope, DeclProcScope: TPasProcedureScope;
  6394. SpecializedItem: TPRSpecializedItem;
  6395. begin
  6396. {$IFDEF VerbosePasResolver}
  6397. writeln('TPasResolver.FinishProcedure START');
  6398. {$ENDIF}
  6399. CheckTopScope(FScopeClass_Proc);
  6400. ProcScope:=TPasProcedureScope(TopScope);
  6401. if ProcScope.Element<>Proc then
  6402. RaiseInternalError(20170220163043);
  6403. SpecializedItem:=ProcScope.SpecializedFromItem;
  6404. if SpecializedItem<>nil then
  6405. begin
  6406. if SpecializedItem.Step<prssImplementationBuilding then
  6407. RaiseNotYetImplemented(20190920184908,Proc);
  6408. if SpecializedItem.Step>prssImplementationBuilding then
  6409. RaiseNotYetImplemented(20190920185123,Proc);
  6410. end;
  6411. Body:=Proc.Body;
  6412. if Body<>nil then
  6413. begin
  6414. StoreScannerFlagsInProc(ProcScope);
  6415. if Body.Body is TPasImplAsmStatement then
  6416. Proc.Modifiers:=Proc.Modifiers+[pmAssembler];
  6417. ResolveImplBlock(Body.Body);
  6418. // check if all nested forward procs are resolved
  6419. for i:=0 to Body.Declarations.Count-1 do
  6420. begin
  6421. SubEl:=TPasElement(Body.Declarations[i]);
  6422. if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
  6423. begin
  6424. SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
  6425. if SubProcScope.ImplProc=nil then
  6426. RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
  6427. [GetElementTypeName(SubEl),SubEl.Name],SubEl);
  6428. end;
  6429. end;
  6430. if ProcScope.GroupScope<>nil then
  6431. begin
  6432. ProcScope.GroupScope.Free;
  6433. ProcScope.GroupScope:=nil;
  6434. if ProcScope.NestedMembersScope<>nil then
  6435. begin
  6436. for i:=0 to ScopeCount-1 do
  6437. if Scopes[i]=ProcScope.NestedMembersScope then
  6438. begin
  6439. DeleteScope(i);
  6440. break;
  6441. end;
  6442. ProcScope.NestedMembersScope.Free;
  6443. ProcScope.NestedMembersScope:=nil;
  6444. end;
  6445. end;
  6446. ProcScope.GenericStep:=psgsImplementationParsed;
  6447. if ProcScope.DeclarationProc<>nil then
  6448. begin
  6449. DeclProcScope:=ProcScope.DeclarationProc.CustomData as TPasProcedureScope;
  6450. DeclProcScope.GenericStep:=psgsImplementationParsed;
  6451. end;
  6452. end;
  6453. if ProcScope.GroupScope<>nil then
  6454. RaiseNotYetImplemented(20190122142142,Proc);
  6455. if ProcScope.NestedMembersScope<>nil then
  6456. RaiseNotYetImplemented(20191014233200,Proc);
  6457. if TopScope.Element<>Proc then
  6458. RaiseInternalError(20190806094032);
  6459. PopScope;
  6460. if ProcScope.GenericStep=psgsImplementationParsed then
  6461. begin
  6462. if ProcScope.DeclarationProc<>nil then
  6463. ProcScope:=TPasProcedureScope(ProcScope.DeclarationProc.CustomData);
  6464. if ProcScope.SpecializedItems<>nil then
  6465. FinishSpecializations(ProcScope);
  6466. end;
  6467. end;
  6468. procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
  6469. var
  6470. ProcName: String;
  6471. FindData: TFindProcData;
  6472. DeclProc, Proc, ParentProc: TPasProcedure;
  6473. Abort, HasDots, IsClassConDestructor: boolean;
  6474. DeclProcScope, ProcScope: TPasProcedureScope;
  6475. ParentScope: TPasIdentifierScope;
  6476. pm: TProcedureModifier;
  6477. ptm: TProcTypeModifier;
  6478. ObjKind: TPasObjKind;
  6479. ParentBody: TProcedureBody;
  6480. HelperForType: TPasType;
  6481. Args, TemplTypes: TFPList;
  6482. Arg: TPasArgument;
  6483. ProcTypeScope: TPasProcTypeScope;
  6484. C: TClass;
  6485. FuncType: TPasFunctionType;
  6486. begin
  6487. if TopScope.Element=El then
  6488. begin
  6489. ProcTypeScope:=El.CustomData as TPasProcTypeScope;
  6490. ProcTypeScope.GenericStep:=psgsImplementationParsed;
  6491. PopScope;
  6492. end;
  6493. if El.Parent is TPasProcedure then
  6494. Proc:=TPasProcedure(El.Parent)
  6495. else
  6496. Proc:=nil;
  6497. if (Proc<>nil) and (Proc.ProcType=El) then
  6498. begin
  6499. // finished header of a procedure declaration
  6500. CheckTopScope(FScopeClass_Proc);
  6501. {$IFDEF VerbosePasResolver}
  6502. writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
  6503. {$ENDIF}
  6504. ProcName:=Proc.Name;
  6505. ProcScope:=Proc.CustomData as TPasProcedureScope;
  6506. TemplTypes:=GetProcTemplateTypes(Proc);
  6507. if (TemplTypes<>nil) then
  6508. begin
  6509. // Proc is parametrized
  6510. if (Proc is TPasConstructor) or (Proc is TPasDestructor) then
  6511. RaiseMsg(20190911104114,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6512. [Proc.ElementTypeName],Proc);
  6513. if Proc.IsVirtual or Proc.IsDynamic or Proc.IsMessage or Proc.IsOverride then
  6514. RaiseMsg(20190911112925,nXMethodsCannotHaveTypeParams,
  6515. sXMethodsCannotHaveTypeParams,['virtual, dynamic or message'],El);
  6516. if Proc.IsOverride then
  6517. RaiseMsg(20191016174218,nXMethodsCannotHaveTypeParams,
  6518. sXMethodsCannotHaveTypeParams,['override'],El);
  6519. if not (Proc.Visibility in [visDefault,visPrivate,visStrictPrivate,visProtected,visStrictProtected,visPublic]) then
  6520. RaiseMsg(20191016174327,nXMethodsCannotHaveTypeParams,
  6521. sXMethodsCannotHaveTypeParams,[VisibilityNames[Proc.Visibility]],El);
  6522. end;
  6523. if El is TPasFunctionType then
  6524. begin
  6525. FuncType:=TPasFunctionType(El);
  6526. if FuncType.ResultEl<>nil then
  6527. CheckUseAsType(FuncType.ResultEl.ResultType,20190123095743,FuncType.ResultEl);
  6528. end;
  6529. if (proProcTypeWithoutIsNested in Options) and El.IsNested then
  6530. RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
  6531. ParentBody:=GetParentProcBody(Proc.Parent);
  6532. if (ParentBody<>nil) then
  6533. begin
  6534. // nested sub proc
  6535. if TemplTypes<>nil then
  6536. RaiseMsg(20190912173450,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6537. ['nested '+Proc.ElementTypeName],Proc);
  6538. if not (proProcTypeWithoutIsNested in Options) then
  6539. El.IsNested:=true;
  6540. // inherit 'of Object'
  6541. ParentProc:=ParentBody.Parent as TPasProcedure;
  6542. if ParentProc.ProcType.IsOfObject then
  6543. El.IsOfObject:=true;
  6544. end;
  6545. if El.IsReferenceTo then
  6546. begin
  6547. if El.IsNested then
  6548. RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
  6549. if El.IsOfObject then
  6550. RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
  6551. end;
  6552. if Proc.IsExternal then
  6553. begin
  6554. for pm in Proc.Modifiers do
  6555. if not (pm in [pmVirtual, pmDynamic, pmOverride,
  6556. pmOverload, pmMessage, pmReintroduce,
  6557. pmExternal, pmDispId,
  6558. pmfar]) then
  6559. RaiseMsg(20170216151616,nInvalidXModifierY,
  6560. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ModifierNames[pm]],Proc);
  6561. for ptm in Proc.ProcType.Modifiers do
  6562. if not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo,ptmAsync]) then
  6563. RaiseMsg(20170411171224,nInvalidXModifierY,
  6564. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ProcTypeModifiers[ptm]],Proc);
  6565. end;
  6566. if El.IsAsync then
  6567. begin
  6568. // async procedure
  6569. C:=Proc.ClassType;
  6570. if (C<>TPasProcedure)
  6571. and (C<>TPasFunction)
  6572. and (C<>TPasClassProcedure)
  6573. and (C<>TPasClassFunction)
  6574. and (C<>TPasAnonymousProcedure)
  6575. and (C<>TPasAnonymousFunction) then
  6576. RaiseMsg(20200524105449,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'async'],Proc);
  6577. end;
  6578. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6579. or (Proc.ClassType=TPasClassDestructor);
  6580. if IsClassConDestructor then
  6581. begin
  6582. // class constructor/destructor
  6583. if Proc.IsVirtual then
  6584. RaiseMsg(20181231150237,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual'],Proc);
  6585. if Proc.IsOverride then
  6586. RaiseMsg(20181231150305,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'override'],Proc);
  6587. if Proc.IsDynamic then
  6588. RaiseMsg(20181231150319,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'dynamic'],Proc);
  6589. if Proc.IsStatic then
  6590. RaiseMsg(20190216214651,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6591. if El.Args.Count>0 then
  6592. RaiseMsg(20181231150404,nXCannotHaveParameters,sXCannotHaveParameters,[GetElementTypeName(Proc)],Proc);
  6593. end;
  6594. HasDots:=GetFirstDotPos(ProcName)>0;
  6595. if Proc.Parent is TPasClassType then
  6596. begin
  6597. // method declaration
  6598. ObjKind:=TPasClassType(Proc.Parent).ObjKind;
  6599. case ObjKind of
  6600. okInterface,okDispInterface:
  6601. begin
  6602. if Proc.IsVirtual then
  6603. RaiseMsg(20180321234324,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6604. if Proc.IsOverride then
  6605. RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6606. if TemplTypes<>nil then
  6607. RaiseMsg(20190912153024,nXMethodsCannotHaveTypeParams,sXMethodsCannotHaveTypeParams,['interface'],Proc);
  6608. end;
  6609. okClassHelper,okRecordHelper,okTypeHelper:
  6610. begin
  6611. if Proc.IsAbstract then
  6612. RaiseMsg(20190116215744,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'abstract'],Proc);
  6613. {if msDelphi in CurrentParser.CurrentModeswitches then
  6614. begin
  6615. // Delphi allows virtual/override in class helpers
  6616. // But using them crashes in Delphi 10.3
  6617. // -> do not support them
  6618. end
  6619. }
  6620. if Proc.IsVirtual then
  6621. RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6622. if Proc.IsOverride then
  6623. RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6624. HelperForType:=ResolveAliasType(TPasClassType(Proc.Parent).HelperForType);
  6625. if (not Proc.IsStatic) and IsClassMethod(Proc) and not IsClassConDestructor then
  6626. begin
  6627. // non static class methods require a class
  6628. if (not (HelperForType.ClassType=TPasClassType))
  6629. or (TPasClassType(HelperForType).ObjKind<>okClass) then
  6630. RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
  6631. end;
  6632. if Proc.ClassType=TPasDestructor then
  6633. RaiseMsg(20190302151019,nXIsNotSupported,sXIsNotSupported,['destructor'],Proc);
  6634. if (Proc.ClassType=TPasConstructor)
  6635. and (HelperForType.ClassType=TPasClassType)
  6636. and (TPasClassType(HelperForType).ObjKind<>okClass) then
  6637. RaiseMsg(20190302151514,nXIsNotSupported,sXIsNotSupported,['constructor'],Proc);
  6638. end;
  6639. end;
  6640. if Proc.IsAbstract then
  6641. begin
  6642. if not Proc.IsVirtual then
  6643. RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract without virtual'],Proc);
  6644. if Proc.IsOverride then
  6645. RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract, override'],Proc);
  6646. end;
  6647. if Proc.IsVirtual and Proc.IsOverride then
  6648. RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual, override'],Proc);
  6649. if Proc.IsReintroduced and Proc.IsOverride then
  6650. RaiseMsg(20171119111845,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'reintroduce, override'],Proc);
  6651. if Proc.IsForward then
  6652. RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'forward'],Proc);
  6653. if Proc.IsStatic then
  6654. if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
  6655. RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6656. end
  6657. else if Proc.Parent is TPasRecordType then
  6658. begin
  6659. if (Proc.ClassType=TPasConstructor)
  6660. and ((El.Args.Count=0)
  6661. or (TPasArgument(El.Args[0]).ValueExpr<>nil)) then
  6662. RaiseMsg(20181226231333,nParameterlessConstructorsNotAllowedInRecords,
  6663. sParameterlessConstructorsNotAllowedInRecords,[],El);
  6664. if Proc.IsReintroduced then
  6665. RaiseMsg(20181218195735,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'reintroduce'],Proc);
  6666. if Proc.IsVirtual then
  6667. RaiseMsg(20181218195431,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'virtual'],Proc);
  6668. if Proc.IsOverride then
  6669. RaiseMsg(20181218195437,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'override'],Proc);
  6670. if Proc.IsAbstract then
  6671. RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
  6672. if Proc.IsForward then
  6673. RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
  6674. if IsClassMethod(Proc) and not IsClassConDestructor then
  6675. begin
  6676. // Note: class constructor/destructor must not be static
  6677. if not Proc.IsStatic then
  6678. RaiseMsg(20190106121503,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,['records'],Proc);
  6679. end
  6680. else if Proc.IsStatic then
  6681. RaiseMsg(20190206150922,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6682. end
  6683. else
  6684. begin
  6685. // intf proc, forward proc, proc body, method body, anonymous proc
  6686. if Proc.IsAbstract then
  6687. RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
  6688. if Proc.IsVirtual then
  6689. RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
  6690. if Proc.IsOverride then
  6691. RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
  6692. if Proc.IsMessage then
  6693. RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
  6694. if Proc.IsStatic and not HasDots then
  6695. RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
  6696. if (not HasDots)
  6697. and (Proc.GetProcTypeEnum in [
  6698. ptClassOperator,
  6699. ptConstructor, ptDestructor,
  6700. ptClassProcedure, ptClassFunction,
  6701. ptClassConstructor, ptClassDestructor
  6702. ]) then
  6703. RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
  6704. end;
  6705. ProcScope.GenericStep:=psgsInterfaceParsed;
  6706. if HasDots then
  6707. begin
  6708. FinishMethodImplHeader(Proc);
  6709. exit;
  6710. end;
  6711. // finish interface/implementation/nested procedure/method declaration
  6712. if (ProcName='')
  6713. and not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction]) then
  6714. RaiseNotYetImplemented(20160922163407,El);
  6715. if (El is TPasFunctionType) and not (ppsfIsSpecialized in ProcScope.Flags) then
  6716. EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
  6717. if Proc.PublicName<>nil then
  6718. ResolveExpr(Proc.PublicName,rraRead);
  6719. if Proc.LibraryExpr<>nil then
  6720. ResolveExpr(Proc.LibraryExpr,rraRead);
  6721. if Proc.LibrarySymbolName<>nil then
  6722. ResolveExpr(Proc.LibrarySymbolName,rraRead);
  6723. if Proc.DispIDExpr<>nil then
  6724. ResolveExpr(Proc.DispIDExpr,rraRead);
  6725. if Proc.MessageExpr<>nil then
  6726. begin
  6727. // message modifier
  6728. ResolveExpr(Proc.MessageExpr,rraRead);
  6729. Args:=Proc.ProcType.Args;
  6730. if Args.Count<>1 then
  6731. RaiseMsg(20190303223701,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6732. Arg:=TPasArgument(Args[0]);
  6733. if not (Arg.Access in [argVar,argOut]) then
  6734. RaiseMsg(20190303223834,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6735. if (Proc.ClassType<>TPasProcedure)
  6736. and (Proc.ClassType<>TPasFunction) then
  6737. RaiseMsg(20190303224128,nXExpectedButYFound,sXExpectedButYFound,['procedure name(var Msg);message id;',GetElementTypeName(El)],El);
  6738. end;
  6739. if Proc.Parent is TPasMembersType then
  6740. begin
  6741. FinishMethodDeclHeader(Proc);
  6742. exit;
  6743. end;
  6744. // finish interface/implementation/nested procedure
  6745. if (ProcName<>'') and ProcNeedsBody(Proc) then
  6746. begin
  6747. if ppsfIsSpecialized in ProcScope.Flags then
  6748. begin
  6749. if ProcScope.DeclarationProc<>nil then
  6750. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6751. end
  6752. else
  6753. begin
  6754. // check if there is a forward declaration
  6755. //writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2]));
  6756. ParentScope:=GetParentLocalScope as TPasIdentifierScope;
  6757. //writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc));
  6758. DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true);
  6759. //writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
  6760. //if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc));
  6761. if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
  6762. DeclProc:=FindProcSameSignature(ProcName,Proc,
  6763. (Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true);
  6764. //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
  6765. if (DeclProc<>nil) then
  6766. begin
  6767. if ProcNeedsImplProc(DeclProc) then
  6768. begin
  6769. // found forward declaration
  6770. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6771. if DeclProcScope.ImplProc<>nil then
  6772. RaiseMsg(20180318222430,nDuplicateIdentifier,sDuplicateIdentifier,
  6773. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],Proc);
  6774. // connect
  6775. {$IFDEF VerbosePasResolver}
  6776. writeln('TPasResolver.FinishProcedureHeader forward found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
  6777. {$ENDIF}
  6778. CheckProcSignatureMatch(DeclProc,Proc,false);
  6779. DeclProcScope.ImplProc:=Proc;
  6780. if DeclProc.IsAssembler then
  6781. Proc.Modifiers:=Proc.Modifiers+[pmAssembler];
  6782. ProcScope.DeclarationProc:=DeclProc;
  6783. // remove ImplProc from scope
  6784. ParentScope.RemoveLocalIdentifier(Proc);
  6785. // replace arguments with declaration arguments
  6786. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6787. exit;
  6788. end
  6789. else
  6790. RaiseMsg(20180318220543,nDuplicateIdentifier,sDuplicateIdentifier,
  6791. [DeclProc.Name,GetElementSourcePosStr(DeclProc)],Proc);
  6792. end;
  6793. end;
  6794. end
  6795. else
  6796. begin
  6797. // forward declaration
  6798. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6799. StoreScannerFlagsInProc(ProcScope);
  6800. end;
  6801. if ProcName<>'' then
  6802. begin
  6803. // check for invalid overloads
  6804. FindData:=Default(TFindProcData);
  6805. FindData.Proc:=Proc;
  6806. FindData.Args:=Proc.ProcType.Args;
  6807. FindData.Kind:=fpkProc;
  6808. Abort:=false;
  6809. IterateElements(ProcName,@OnFindProc,@FindData,Abort);
  6810. end;
  6811. end
  6812. else if El.Name<>'' then
  6813. begin
  6814. // finished proc type, e.g. type TProcedure = procedure;
  6815. end
  6816. else
  6817. RaiseNotYetImplemented(20160922163411,El.Parent,'anonymous procedure type');
  6818. end;
  6819. procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
  6820. procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
  6821. begin
  6822. LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
  6823. sVirtualMethodXHasLowerVisibility,[Proc.Name,
  6824. VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
  6825. VisibilityNames[OverloadProc.Visibility]],Proc);
  6826. Proc.Visibility:=OverloadProc.Visibility;
  6827. end;
  6828. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  6829. procedure Delete(var A: TArrayOfPasProcedure; Index, Count: integer); overload;
  6830. var
  6831. i: Integer;
  6832. begin
  6833. if Index<0 then
  6834. RaiseInternalError(20171227121538);
  6835. if Index+Count>length(A) then
  6836. RaiseInternalError(20171227121156);
  6837. for i:=Index+Count to length(A)-1 do
  6838. A[i-Count]:=A[i];
  6839. SetLength(A,length(A)-Count);
  6840. end;
  6841. procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
  6842. var
  6843. i: Integer;
  6844. begin
  6845. if Index<0 then
  6846. RaiseInternalError(20171227121544);
  6847. if Index>length(A) then
  6848. RaiseInternalError(20171227121558);
  6849. SetLength(A,length(A)+1);
  6850. for i:=length(A)-1 downto Index+1 do
  6851. A[i]:=A[i-1];
  6852. A[Index]:=Item;
  6853. end;
  6854. {$ENDIF}
  6855. var
  6856. Abort, IsClassConDestructor: boolean;
  6857. ClassOrRecScope: TPasClassOrRecordScope;
  6858. FindData: TFindProcData;
  6859. OverloadProc: TPasProcedure;
  6860. ProcScope: TPasProcedureScope;
  6861. i: Integer;
  6862. ParentScope: TPasScope;
  6863. TemplTypes: TFPList;
  6864. ClassRecType: TPasMembersType;
  6865. begin
  6866. if not (ptmStatic in Proc.ProcType.Modifiers) then
  6867. Proc.ProcType.IsOfObject:=true;
  6868. ProcScope:=TopScope as TPasProcedureScope;
  6869. ParentScope:=Scopes[ScopeCount-2];
  6870. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6871. StoreScannerFlagsInProc(ProcScope);
  6872. ClassRecType:=TPasMembersType(Proc.Parent);
  6873. ClassOrRecScope:=ClassRecType.CustomData as TPasClassOrRecordScope;
  6874. ProcScope.ClassRecScope:=ClassOrRecScope;
  6875. TemplTypes:=GetProcTemplateTypes(Proc);
  6876. FindData:=Default(TFindProcData);
  6877. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6878. or (Proc.ClassType=TPasClassDestructor);
  6879. if IsClassConDestructor then
  6880. begin
  6881. if TemplTypes<>nil then
  6882. RaiseNotYetImplemented(20190911105953,Proc);
  6883. end
  6884. else
  6885. begin
  6886. FindData.Proc:=Proc;
  6887. FindData.Args:=Proc.ProcType.Args;
  6888. FindData.Kind:=fpkMethod;
  6889. Abort:=false;
  6890. ParentScope.IterateElements(Proc.Name,ClassOrRecScope,
  6891. @OnFindProc,@FindData,Abort);
  6892. end;
  6893. if FindData.Found=nil then
  6894. begin
  6895. // no overload
  6896. if Proc.IsOverride then
  6897. RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
  6898. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6899. end
  6900. else
  6901. begin
  6902. // overload found
  6903. OverloadProc:=FindData.Found;
  6904. // Note: 'inherited;' needs the OverriddenProc, even without 'override' modifier
  6905. ProcScope.OverriddenProc:=OverloadProc;
  6906. if Proc.IsOverride then
  6907. begin
  6908. if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
  6909. // the OverloadProc fits the signature, but is not virtual
  6910. RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
  6911. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6912. // override a virtual method
  6913. CheckProcSignatureMatch(OverloadProc,Proc,true);
  6914. // check visibility
  6915. if Proc.Visibility<>OverloadProc.Visibility then
  6916. case Proc.Visibility of
  6917. visPrivate,visStrictPrivate:
  6918. if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
  6919. VisibilityLowered(Proc,OverloadProc);
  6920. visProtected,visStrictProtected:
  6921. if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
  6922. VisibilityLowered(Proc,OverloadProc);
  6923. visPublic:
  6924. if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
  6925. VisibilityLowered(Proc,OverloadProc);
  6926. visPublished: ;
  6927. else
  6928. RaiseNotYetImplemented(20170325003315,Proc,'visibility');
  6929. end;
  6930. // check name case
  6931. if proFixCaseOfOverrides in Options then
  6932. Proc.Name:=OverloadProc.Name;
  6933. // remove abstract
  6934. if OverloadProc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6935. for i:=length(TPasClassScope(ClassOrRecScope).AbstractProcs)-1 downto 0 do
  6936. if TPasClassScope(ClassOrRecScope).AbstractProcs[i]=OverloadProc then
  6937. Delete(TPasClassScope(ClassOrRecScope).AbstractProcs,i,1);
  6938. end;
  6939. end;
  6940. // add abstract
  6941. if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6942. Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
  6943. length(TPasClassScope(ClassOrRecScope).AbstractProcs));
  6944. CreateProcSelfArg(Proc);
  6945. end;
  6946. procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
  6947. var
  6948. ProcName: String;
  6949. ImplProcScope, DeclProcScope: TPasProcedureScope;
  6950. DeclProc: TPasProcedure;
  6951. ClassOrRecScope: TPasClassOrRecordScope;
  6952. SelfArg: TPasArgument;
  6953. LastNamePart: TProcedureNamePart;
  6954. begin
  6955. if ImplProc.IsExternal then
  6956. RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'external'],ImplProc);
  6957. if ImplProc.IsExported then
  6958. RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'export'],ImplProc);
  6959. ProcName:=ImplProc.Name;
  6960. ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
  6961. ClassOrRecScope:=ImplProcScope.ClassRecScope;
  6962. if ClassOrRecScope=nil then
  6963. RaiseInternalError(20161013172346);
  6964. if ImplProcScope.GroupScope=nil then
  6965. RaiseInternalError(20190120135017);
  6966. if ImplProc.NameParts<>nil then
  6967. begin
  6968. LastNamePart:=TProcedureNamePart(ImplProc.NameParts[ImplProc.NameParts.Count-1]);
  6969. ProcName:=LastNamePart.Name;
  6970. end
  6971. else
  6972. begin
  6973. // remove path from ProcName
  6974. ProcName:=LastDottedIdentifier(ProcName);
  6975. end;
  6976. DeclProc:=nil;
  6977. DeclProcScope:=nil;
  6978. if ImplProcScope.DeclarationProc=nil then
  6979. begin
  6980. {$IFDEF VerbosePasResolver}
  6981. writeln('TPasResolver.FinishMethodImplHeader searching declaration "',ImplProc.Name,'" ...');
  6982. {$ENDIF}
  6983. // search ImplProc in class
  6984. if not IsValidIdent(ProcName) then
  6985. RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
  6986. // search proc in class/record
  6987. if ImplProc.ClassType=TPasClassConstructor then
  6988. DeclProc:=ClassOrRecScope.ClassConstructor
  6989. else if ImplProc.ClassType=TPasClassDestructor then
  6990. DeclProc:=ClassOrRecScope.ClassDestructor
  6991. else
  6992. DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
  6993. if DeclProc=nil then
  6994. RaiseIdentifierNotFound(20170216151720,GetProcName(ImplProc),ImplProc.ProcType);
  6995. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6996. ImplProc.ProcType.IsOfObject:=DeclProc.ProcType.IsOfObject;
  6997. // connect method declaration and body
  6998. if DeclProcScope.ImplProc<>nil then
  6999. RaiseMsg(20180212094546,nDuplicateIdentifier,sDuplicateIdentifier,
  7000. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],
  7001. ImplProc);
  7002. if DeclProc.IsAbstract then
  7003. RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
  7004. if DeclProc.IsExternal then
  7005. RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
  7006. CheckProcSignatureMatch(DeclProc,ImplProc,false);
  7007. if DeclProc.IsAssembler then
  7008. ImplProc.Modifiers:=ImplProc.Modifiers+[pmAssembler];
  7009. ImplProcScope.DeclarationProc:=DeclProc;
  7010. DeclProcScope.ImplProc:=ImplProc;
  7011. // replace arguments in scope with declaration arguments
  7012. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  7013. end
  7014. else if ppsfIsSpecialized in ImplProcScope.Flags then
  7015. begin
  7016. {$IFDEF VerbosePasResolver}
  7017. writeln('TPasResolver.FinishMethodImplHeader specialized "',ImplProc.Name,'" ...');
  7018. {$ENDIF}
  7019. DeclProc:=ImplProcScope.DeclarationProc;
  7020. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  7021. if DeclProcScope.ImplProc<>ImplProc then
  7022. RaiseNotYetImplemented(20190804182220,ImplProc);
  7023. // replace arguments in scope with declaration arguments
  7024. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  7025. end
  7026. else
  7027. RaiseNotYetImplemented(20190804181222,ImplProc);
  7028. SelfArg:=DeclProcScope.SelfArg;
  7029. if SelfArg<>nil then
  7030. begin
  7031. // add 'Self'
  7032. ImplProcScope.SelfArg:=SelfArg;
  7033. SelfArg.AddRef{$IFDEF CheckPasTreeRefCount}('TPasProcedureScope.SelfArg'){$ENDIF};
  7034. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  7035. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  7036. end;
  7037. {$IFDEF VerbosePasResolver}
  7038. writeln('TPasResolver.FinishMethodImplHeader END "',ImplProc.Name,'" ...');
  7039. {$ENDIF}
  7040. end;
  7041. procedure TPasResolver.FinishExceptOnExpr;
  7042. var
  7043. El: TPasImplExceptOn;
  7044. ResolvedType: TPasResolverResult;
  7045. TypeEl: TPasType;
  7046. begin
  7047. CheckTopScope(TPasExceptOnScope);
  7048. El:=TPasImplExceptOn(FTopScope.Element);
  7049. TypeEl:=El.TypeEl;
  7050. ComputeElement(TypeEl,ResolvedType,[rcType]);
  7051. CheckIsClass(TypeEl,ResolvedType);
  7052. end;
  7053. procedure TPasResolver.FinishExceptOnStatement;
  7054. begin
  7055. //writeln('TPasResolver.FinishExceptOnStatement START');
  7056. CheckTopScope(TPasExceptOnScope);
  7057. ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
  7058. PopScope;
  7059. end;
  7060. procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
  7061. begin
  7062. PopWithScope(El);
  7063. end;
  7064. procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop);
  7065. var
  7066. VarResolved, StartResolved, EndResolved,
  7067. OrigStartResolved: TPasResolverResult;
  7068. EnumeratorFound, HasInValues: Boolean;
  7069. InRange, VarRange: TResEvalValue;
  7070. InRangeInt, VarRangeInt: TResEvalRangeInt;
  7071. bt: TResolverBaseType;
  7072. TypeEl, ElType: TPasType;
  7073. C: TClass;
  7074. begin
  7075. CreateScope(Loop,TPasForLoopScope);
  7076. // loop var
  7077. ResolveExpr(Loop.VariableName,rraReadAndAssign);
  7078. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  7079. if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
  7080. RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
  7081. // resolve start expression
  7082. ResolveExpr(Loop.StartExpr,rraRead);
  7083. ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
  7084. case Loop.LoopType of
  7085. ltNormal,ltDown:
  7086. begin
  7087. // start value
  7088. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  7089. RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
  7090. [],StartResolved,VarResolved,Loop.StartExpr);
  7091. CheckAssignExprRange(VarResolved,Loop.StartExpr);
  7092. // end value
  7093. ResolveExpr(Loop.EndExpr,rraRead);
  7094. ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
  7095. if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
  7096. RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
  7097. [],EndResolved,VarResolved,Loop.EndExpr);
  7098. CheckAssignExprRange(VarResolved,Loop.EndExpr);
  7099. end;
  7100. ltIn:
  7101. begin
  7102. // check range
  7103. EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
  7104. if (not EnumeratorFound)
  7105. and not (StartResolved.IdentEl is TPasType)
  7106. and (rrfReadable in StartResolved.Flags) then
  7107. begin
  7108. EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
  7109. end;
  7110. if not EnumeratorFound then
  7111. begin
  7112. VarRange:=nil;
  7113. InRange:=nil;
  7114. try
  7115. OrigStartResolved:=StartResolved;
  7116. if StartResolved.IdentEl is TPasType then
  7117. begin
  7118. // e.g. for e in TEnum do
  7119. TypeEl:=StartResolved.LoTypeEl;
  7120. if TypeEl is TPasArrayType then
  7121. begin
  7122. if length(TPasArrayType(TypeEl).Ranges)=1 then
  7123. InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
  7124. end;
  7125. if InRange=nil then
  7126. InRange:=EvalTypeRange(TypeEl,[]);
  7127. {$IFDEF VerbosePasResolver}
  7128. {AllowWriteln}
  7129. if InRange<>nil then
  7130. writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
  7131. else
  7132. writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
  7133. {AllowWriteln-}
  7134. {$ENDIF}
  7135. end
  7136. else if rrfReadable in StartResolved.Flags then
  7137. begin
  7138. // value (variable or expression)
  7139. bt:=StartResolved.BaseType;
  7140. if bt in [btSet,btArrayOrSet] then
  7141. begin
  7142. if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
  7143. InRange:=Eval(StartResolved.ExprEl,[]);
  7144. if InRange=nil then
  7145. InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
  7146. end
  7147. else if bt=btContext then
  7148. begin
  7149. TypeEl:=StartResolved.LoTypeEl;
  7150. C:=TypeEl.ClassType;
  7151. if C=TPasArrayType then
  7152. begin
  7153. ElType:=GetArrayElType(TPasArrayType(TypeEl));
  7154. ComputeElement(ElType,StartResolved,[rcType]);
  7155. StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
  7156. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  7157. RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
  7158. [],StartResolved,VarResolved,Loop.StartExpr);
  7159. EnumeratorFound:=true;
  7160. end;
  7161. end
  7162. else
  7163. begin
  7164. bt:=GetActualBaseType(bt);
  7165. case bt of
  7166. {$ifdef FPC_HAS_CPSTRING}
  7167. btAnsiString:
  7168. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  7169. {$endif}
  7170. btUnicodeString:
  7171. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  7172. end;
  7173. end;
  7174. end;
  7175. if (not EnumeratorFound) and (InRange<>nil) then
  7176. begin
  7177. // for v in <constant> do
  7178. // -> check if same type
  7179. VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
  7180. if VarRange=nil then
  7181. RaiseXExpectedButYFound(20171109191528,'range',
  7182. GetResolverResultDescription(VarResolved),Loop.VariableName);
  7183. //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  7184. //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
  7185. case InRange.Kind of
  7186. revkRangeInt,revkSetOfInt:
  7187. begin
  7188. InRangeInt:=TResEvalRangeInt(InRange);
  7189. case VarRange.Kind of
  7190. revkRangeInt:
  7191. begin
  7192. VarRangeInt:=TResEvalRangeInt(VarRange);
  7193. HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
  7194. case InRangeInt.ElKind of
  7195. revskEnum:
  7196. if (VarRangeInt.ElKind<>revskEnum)
  7197. or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
  7198. RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
  7199. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7200. revskInt:
  7201. if VarRangeInt.ElKind<>revskInt then
  7202. RaiseXExpectedButYFound(20171109200752,'integer',
  7203. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7204. revskChar:
  7205. if VarRangeInt.ElKind<>revskChar then
  7206. RaiseXExpectedButYFound(20171109200753,'char',
  7207. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7208. revskBool:
  7209. if VarRangeInt.ElKind<>revskBool then
  7210. RaiseXExpectedButYFound(20171109200754,'boolean',
  7211. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7212. else
  7213. if HasInValues then
  7214. RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
  7215. end;
  7216. if HasInValues then
  7217. begin
  7218. if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
  7219. begin
  7220. {$IFDEF VerbosePasResolver}
  7221. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  7222. {$ENDIF}
  7223. fExprEvaluator.EmitRangeCheckConst(20171109201428,
  7224. InRangeInt.ElementAsString(InRangeInt.RangeStart),
  7225. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  7226. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  7227. end;
  7228. if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
  7229. begin
  7230. {$IFDEF VerbosePasResolver}
  7231. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  7232. {$ENDIF}
  7233. fExprEvaluator.EmitRangeCheckConst(20171109201429,
  7234. InRangeInt.ElementAsString(InRangeInt.RangeEnd),
  7235. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  7236. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  7237. end;
  7238. end;
  7239. EnumeratorFound:=true;
  7240. end;
  7241. else
  7242. {$IFDEF VerbosePasResolver}
  7243. writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  7244. {$ENDIF}
  7245. end;
  7246. end;
  7247. else
  7248. {$IFDEF VerbosePasResolver}
  7249. writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
  7250. {$ENDIF}
  7251. end;
  7252. end;
  7253. if not EnumeratorFound then
  7254. begin
  7255. {$IFDEF VerbosePasResolver}
  7256. {AllowWriteln}
  7257. writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
  7258. if VarRange<>nil then
  7259. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
  7260. {AllowWriteln-}
  7261. {$ENDIF}
  7262. RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  7263. [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
  7264. end;
  7265. finally
  7266. ReleaseEvalValue(VarRange);
  7267. ReleaseEvalValue(InRange);
  7268. end;
  7269. end;
  7270. end;
  7271. else
  7272. RaiseNotYetImplemented(20171108221334,Loop);
  7273. end;
  7274. end;
  7275. procedure TPasResolver.FinishDeclaration(El: TPasElement);
  7276. var
  7277. C: TClass;
  7278. begin
  7279. C:=El.ClassType;
  7280. if (C=TPasVariable) or (C=TPasConst) then
  7281. FinishVariable(TPasVariable(El))
  7282. else if C=TPasProperty then
  7283. FinishProperty(TPasProperty(El))
  7284. else if C=TPasArgument then
  7285. FinishArgument(TPasArgument(El))
  7286. else if C=TPasMethodResolution then
  7287. FinishMethodResolution(TPasMethodResolution(El))
  7288. else if C=TPasAttributes then
  7289. FinishAttributes(TPasAttributes(El))
  7290. else if C=TPasExportSymbol then
  7291. FinishExportSymbol(TPasExportSymbol(El))
  7292. else
  7293. begin
  7294. {$IFDEF VerbosePasResolver}
  7295. writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
  7296. {$ENDIF}
  7297. RaiseNotYetImplemented(20180127121557,El);
  7298. end;
  7299. end;
  7300. procedure TPasResolver.FinishVariable(El: TPasVariable);
  7301. var
  7302. ResolvedAbs: TPasResolverResult;
  7303. C: TClass;
  7304. Value: TResEvalValue;
  7305. begin
  7306. if (El.Visibility=visPublished) then
  7307. begin
  7308. if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
  7309. RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  7310. end;
  7311. if El.Expr<>nil then
  7312. ResolveExpr(El.Expr,rraRead);
  7313. if El.VarType<>nil then
  7314. begin
  7315. if (El.Parent is TPasRecordType) and (El.VarType=El.Parent) then
  7316. RaiseMsg(20181218173631,nTypeXIsNotYetCompletelyDefined,
  7317. sTypeXIsNotYetCompletelyDefined,[El.VarType.Name],El);
  7318. CheckUseAsType(El.VarType,20190123095916,El);
  7319. if El.Expr<>nil then
  7320. CheckAssignCompatibility(El,El.Expr,true);
  7321. if El.VarType.Parent=El then
  7322. FinishSubElementType(El,El.VarType);
  7323. end
  7324. else if El.Expr<>nil then
  7325. begin
  7326. // no VarType, has Expr, e.g. const a = Expr
  7327. Value:=Eval(El.Expr,[refConstExt]); // e.g. const Tau = 2*PI
  7328. ReleaseEvalValue(Value);
  7329. end;
  7330. if El.AbsoluteExpr<>nil then
  7331. begin
  7332. if El.ClassType=TPasConst then
  7333. RaiseMsg(20180201225530,nXModifierMismatchY,sXModifierMismatchY,
  7334. ['absolute','const'],El.AbsoluteExpr);
  7335. if El.VarType=nil then
  7336. RaiseMsg(20171225235125,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7337. if vmExternal in El.VarModifiers then
  7338. RaiseMsg(20171226104221,nXModifierMismatchY,sXModifierMismatchY,
  7339. ['absolute','external'],El.AbsoluteExpr);
  7340. {$IFDEF VerbosePasResolver}
  7341. writeln('TPasResolver.FinishVariable El=',GetObjName(El),' Absolute="',GetObjName(El.AbsoluteExpr),'"');
  7342. {$ENDIF}
  7343. ResolveExpr(El.AbsoluteExpr,rraRead);
  7344. ComputeElement(El.AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
  7345. if (not (rrfReadable in ResolvedAbs.Flags))
  7346. or (ResolvedAbs.IdentEl=nil) then
  7347. RaiseVarExpected(20171225234734,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7348. C:=ResolvedAbs.IdentEl.ClassType;
  7349. if (C=TPasVariable)
  7350. or (C=TPasArgument)
  7351. or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
  7352. else
  7353. RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7354. if not (rrfReadable in ResolvedAbs.Flags) then
  7355. RaiseVarExpected(20171225235249,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7356. // check for cycles
  7357. if ResolvedAbs.IdentEl=El then
  7358. RaiseMsg(20171226000703,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7359. end;
  7360. if El.VarType<>nil then
  7361. EmitTypeHints(El,El.VarType);
  7362. end;
  7363. procedure TPasResolver.FinishProperty(PropEl: TPasProperty);
  7364. var
  7365. PropType: TPasType;
  7366. ClassOrRecScope: TPasClassOrRecordScope;
  7367. ClassScope: TPasClassScope;
  7368. AncestorProp: TPasProperty;
  7369. IndexExpr: TPasExpr;
  7370. procedure GetPropType;
  7371. var
  7372. AncEl: TPasElement;
  7373. GroupScope: TPasGroupScope;
  7374. begin
  7375. if PropType<>nil then exit;
  7376. AncEl:=nil;
  7377. if (ClassScope<>nil) and (ClassScope.AncestorScope<>nil) then
  7378. begin
  7379. CheckTopScope(TPasGroupScope);
  7380. GroupScope:=TPasGroupScope(TopScope);
  7381. AncEl:=GroupScope.FindAncestorElement(PropEl.Name);
  7382. end;
  7383. if AncEl is TPasProperty then
  7384. begin
  7385. // override or redeclaration property
  7386. AncestorProp:=TPasProperty(AncEl);
  7387. TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncestorProp;
  7388. if proFixCaseOfOverrides in Options then
  7389. PropEl.Name:=AncestorProp.Name;
  7390. end
  7391. else
  7392. AncestorProp:=nil;
  7393. if PropEl.VarType<>nil then
  7394. begin
  7395. // new property or redeclaration
  7396. PropType:=PropEl.VarType;
  7397. CheckUseAsType(PropEl.VarType,20190123100011,PropEl);
  7398. end
  7399. else
  7400. begin
  7401. // property override
  7402. if AncestorProp=nil then
  7403. RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
  7404. // check property versus class property
  7405. if PropEl.ClassType<>AncestorProp.ClassType then
  7406. RaiseXExpectedButYFound(20170216151744,GetElementTypeName(AncestorProp),GetElementTypeName(PropEl),PropEl);
  7407. // get inherited type
  7408. PropType:=GetPasPropertyType(AncestorProp);
  7409. // update DefaultProperty
  7410. if ClassScope=nil then
  7411. RaiseNotYetImplemented(20181231130642,PropEl);
  7412. if ClassScope.DefaultProperty=AncestorProp then
  7413. ClassScope.DefaultProperty:=PropEl;
  7414. end;
  7415. end;
  7416. function CheckClassAccessorStatic(ProcIsStatic: boolean): boolean;
  7417. begin
  7418. if ClassScope=nil then
  7419. // record: class getter/setter must be static
  7420. Result:=ProcIsStatic=true
  7421. else if proClassPropertyNonStatic in Options then
  7422. Result:=true // both allowed
  7423. else
  7424. Result:=ProcIsStatic=true;
  7425. end;
  7426. procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
  7427. ProcArg: TPasArgument; ErrorEl: TPasElement);
  7428. var
  7429. ProcArgResolved: TPasResolverResult;
  7430. begin
  7431. // check access: const, ...
  7432. if not (ProcArg.Access in [argDefault,argConst]) then
  7433. RaiseMsg(20170924202437,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7434. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7435. AccessDescriptions[argConst]],ErrorEl);
  7436. // check argument type
  7437. if ProcArg.ArgType=nil then
  7438. RaiseMsg(20170924202531,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7439. [IntToStr(ArgNo),'untyped',GetTypeDescription(IndexResolved)],ErrorEl)
  7440. else
  7441. begin
  7442. if CheckParamCompatibility(IndexExpr,ProcArg,ArgNo,true)=cIncompatible then
  7443. begin
  7444. ComputeElement(ProcArg.ArgType,ProcArgResolved,[rcType]);
  7445. RaiseIncompatibleTypeRes(20170924203829,nIncompatibleTypeArgNo,
  7446. [IntToStr(ArgNo)],ProcArgResolved,IndexResolved,ErrorEl);
  7447. end;
  7448. end;
  7449. end;
  7450. procedure CheckArgs(Proc: TPasProcedure; const IndexVal: TResEvalValue;
  7451. const IndexResolved: TPasResolverResult; ErrorEl: TPasElement);
  7452. var
  7453. ArgNo: Integer;
  7454. PropArg, ProcArg: TPasArgument;
  7455. PropArgResolved, ProcArgResolved: TPasResolverResult;
  7456. NeedCheckingAccess: Boolean;
  7457. begin
  7458. ArgNo:=0;
  7459. while ArgNo<PropEl.Args.Count do
  7460. begin
  7461. if ArgNo>=Proc.ProcType.Args.Count then
  7462. RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
  7463. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7464. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  7465. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7466. inc(ArgNo);
  7467. // check access: var, const, ...
  7468. NeedCheckingAccess:=false;
  7469. if PropArg.Access<>ProcArg.Access then
  7470. begin
  7471. if (PropArg.Access in [argDefault, argConst])
  7472. and (ProcArg.Access in [argDefault, argConst]) then
  7473. begin
  7474. // passing an arg as default to const or const to default
  7475. if (PropArg.ArgType<>nil)
  7476. and (ProcArg.ArgType<>nil) then
  7477. NeedCheckingAccess:=true;
  7478. end;
  7479. if not NeedCheckingAccess then
  7480. RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7481. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7482. AccessDescriptions[PropArg.Access]],ErrorEl);
  7483. end;
  7484. // check argument type
  7485. if PropArg.ArgType=nil then
  7486. begin
  7487. if ProcArg.ArgType<>nil then
  7488. RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7489. [IntToStr(ArgNo),GetElementTypeName(ProcArg.ArgType),'untyped'],ErrorEl);
  7490. end
  7491. else if ProcArg.ArgType=nil then
  7492. RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7493. [IntToStr(ArgNo),'untyped',GetElementTypeName(PropArg.ArgType)],ErrorEl)
  7494. else
  7495. begin
  7496. ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
  7497. ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
  7498. if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
  7499. RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7500. [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
  7501. if PropArgResolved.LoTypeEl=nil then
  7502. RaiseInternalError(20161010125255);
  7503. if ProcArgResolved.LoTypeEl=nil then
  7504. RaiseInternalError(20161010125304);
  7505. if not IsSameType(PropArgResolved.HiTypeEl,ProcArgResolved.HiTypeEl,prraSimple) then
  7506. RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
  7507. [IntToStr(ArgNo)],ProcArgResolved.HiTypeEl,PropArgResolved.HiTypeEl,ErrorEl);
  7508. end;
  7509. if NeedCheckingAccess then
  7510. begin
  7511. // passing an arg as default to const or const to default
  7512. // e.g.
  7513. // function GetItems(const i: integer): byte;
  7514. // property Items[i: integer]: byte read GetItems;
  7515. // => allowed for simple types
  7516. if not (PropArgResolved.BaseType in (btAllBooleans+btAllInteger+btAllStringAndChars+btAllFloats)) then
  7517. RaiseMsg(20181007181647,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7518. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7519. AccessDescriptions[PropArg.Access]],ErrorEl);
  7520. end;
  7521. end;
  7522. if IndexVal<>nil then
  7523. begin
  7524. if ArgNo>=Proc.ProcType.Args.Count then
  7525. RaiseMsg(20170924202334,nWrongNumberOfParametersForCallTo,
  7526. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7527. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7528. CheckIndexArg(ArgNo,IndexResolved,ProcArg,ErrorEl);
  7529. end;
  7530. end;
  7531. procedure CheckImplements;
  7532. var
  7533. i, j: Integer;
  7534. Expr: TPasExpr;
  7535. ResolvedEl: TPasResolverResult;
  7536. aClass, PropClassType: TPasClassType;
  7537. IntfType, OrigIntfType, PropTypeRes: TPasType;
  7538. o: TObject;
  7539. begin
  7540. if not (PropEl.Parent is TPasClassType) then
  7541. RaiseInternalError(20180323172125,GetElementDbgPath(PropEl));
  7542. aClass:=TPasClassType(PropEl.Parent);
  7543. if PropEl.Args.Count>0 then
  7544. RaiseMsg(20180323170952,nImplementsDoesNotSupportArrayProperty,
  7545. sImplementsDoesNotSupportArrayProperty,[],PropEl.Implements[0]);
  7546. if IndexExpr<>nil then
  7547. RaiseMsg(20180323171354,nImplementsDoesNotSupportIndex,
  7548. sImplementsDoesNotSupportIndex,[],PropEl.Implements[0]);
  7549. if GetPasPropertyGetter(PropEl)=nil then
  7550. RaiseMsg(20180323221322,nImplPropMustHaveReadSpec,
  7551. sImplPropMustHaveReadSpec,[],PropEl.Implements[0]);
  7552. for i:=0 to length(PropEl.Implements)-1 do
  7553. begin
  7554. // resolve expression
  7555. Expr:=PropEl.Implements[i];
  7556. ResolveExpr(Expr,rraRead);
  7557. // check expr is an interface type
  7558. ComputeElement(Expr,ResolvedEl,[rcType,rcNoImplicitProc]);
  7559. if not (ResolvedEl.IdentEl is TPasType) then
  7560. if ResolvedEl.IdentEl=nil then
  7561. RaiseXExpectedButYFound(20180323171911,'interface',
  7562. GetElementTypeName(ResolvedEl.LoTypeEl),Expr)
  7563. else
  7564. RaiseXExpectedButYFound(20180323224846,'interface',
  7565. GetElementTypeName(ResolvedEl.IdentEl),Expr);
  7566. OrigIntfType:=TPasType(ResolvedEl.IdentEl);
  7567. IntfType:=ResolveAliasType(OrigIntfType);
  7568. if (not (IntfType is TPasClassType))
  7569. or (TPasClassType(IntfType).ObjKind<>okInterface) then
  7570. RaiseXExpectedButYFound(20180323172904,'interface',
  7571. GetElementTypeName(OrigIntfType),Expr);
  7572. // check it is one of the current implemented interfaces (not of ancestors)
  7573. j:=IndexOfImplementedInterface(aClass,IntfType);
  7574. if j<0 then
  7575. RaiseMsg(20180323172420,nImplementsUsedOnUnimplIntf,sImplementsUsedOnUnimplIntf,
  7576. [OrigIntfType.Name],Expr);
  7577. // check property type fits
  7578. PropTypeRes:=ResolveAliasType(PropType);
  7579. if not (PropTypeRes is TPasClassType) then
  7580. RaiseMsg(20180323222334,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7581. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7582. PropClassType:=TPasClassType(PropTypeRes);
  7583. case PropClassType.ObjKind of
  7584. okClass:
  7585. // e.g. property Obj: ClassType read Getter implements IntfType
  7586. // check ClassType or ancestors implements IntfType
  7587. if GetClassImplementsIntf(PropClassType,TPasClassType(IntfType))=nil then
  7588. RaiseMsg(20180323223324,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7589. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7590. okInterface:
  7591. // e.g. property IntfVar: IntfType read Getter implements IntfType2
  7592. // check that IntfType is IntfType2
  7593. if CheckClassIsClass(PropType,IntfType)=cIncompatible then
  7594. RaiseIncompatibleType(20180323173746,nIncompatibleTypesGotExpected,
  7595. [],OrigIntfType,PropType,Expr);
  7596. else
  7597. RaiseMsg(20180323222821,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7598. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7599. end;
  7600. // map
  7601. o:=TObject(ClassScope.Interfaces[j]);
  7602. if o is TPasProperty then
  7603. RaiseMsg(20180323174240,nDuplicateImplementsForIntf,sDuplicateImplementsForIntf,
  7604. [OrigIntfType.Name,GetElementSourcePosStr(TPasProperty(o))],Expr)
  7605. else if o is TPasClassIntfMap then
  7606. begin
  7607. // properties are checked before method resolutions
  7608. RaiseInternalError(20180323175919,GetElementDbgPath(PropEl));
  7609. end
  7610. else if o<>nil then
  7611. RaiseInternalError(20180323174342,GetObjName(o))
  7612. else
  7613. ClassScope.Interfaces[j]:=PropEl;
  7614. end;
  7615. end;
  7616. procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
  7617. const IndexResolved: TPasResolverResult);
  7618. var
  7619. ResolvedEl: TPasResolverResult;
  7620. Value: TResEvalValue;
  7621. Proc: TPasProcedure;
  7622. ResultType, TypeEl: TPasType;
  7623. aVar: TPasVariable;
  7624. IdentEl: TPasElement;
  7625. ExpArgCnt: Integer;
  7626. ProcArg: TPasArgument;
  7627. begin
  7628. ResolveExpr(Expr,rraRead);
  7629. ComputeElement(Expr,ResolvedEl,[rcNoImplicitProc]);
  7630. IdentEl:=ResolvedEl.IdentEl;
  7631. if IdentEl is TPasProcedure then
  7632. begin
  7633. // function
  7634. Proc:=TPasProcedure(IdentEl);
  7635. // check if member
  7636. if not (Expr is TPrimitiveExpr) then
  7637. RaiseXExpectedButYFound(20170923202002,'member function','foreign '+GetElementTypeName(Proc),Expr);
  7638. if Proc.ClassType<>TPasFunction then
  7639. RaiseXExpectedButYFound(20170216151925,'function',GetElementTypeName(Proc),Expr);
  7640. // check function result type
  7641. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7642. if not IsBaseType(ResultType,btBoolean,true) then
  7643. RaiseXExpectedButYFound(20170923200836,'function: boolean',
  7644. 'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
  7645. if Proc.IsAsync then
  7646. RaiseInvalidProcTypeModifier(20200524104719,Proc.ProcType,ptmAsync,Expr);
  7647. // check arg count
  7648. ExpArgCnt:=0;
  7649. if IndexVal<>nil then
  7650. inc(ExpArgCnt);
  7651. if Proc.ProcType.Args.Count<>ExpArgCnt then
  7652. RaiseMsg(20170923200840,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7653. [Proc.Name],Expr);
  7654. if IndexVal<>nil then
  7655. begin
  7656. // check arg type
  7657. ProcArg:=TPasArgument(Proc.ProcType.Args[0]);
  7658. CheckIndexArg(1,IndexResolved,ProcArg,Expr);
  7659. end;
  7660. exit;
  7661. end;
  7662. if (IdentEl<>nil)
  7663. and ((IdentEl.ClassType=TPasVariable)
  7664. or ((IdentEl.ClassType=TPasConst) and not TPasConst(IdentEl).IsConst)) then
  7665. begin
  7666. // field
  7667. aVar:=TPasVariable(IdentEl);
  7668. // check if member
  7669. if not (Expr is TPrimitiveExpr) then
  7670. RaiseXExpectedButYFound(20170923202003,'member variable','foreign '+GetElementTypeName(aVar),Expr);
  7671. // check type boolean
  7672. TypeEl:=aVar.VarType;
  7673. TypeEl:=ResolveAliasType(TypeEl);
  7674. if not IsBaseType(TypeEl,btBoolean,true) then
  7675. RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
  7676. [],TypeEl,BaseTypes[btBoolean],Expr);
  7677. // check class var
  7678. if (vmClass in PropEl.VarModifiers)<>(vmClass in aVar.VarModifiers) then
  7679. if vmClass in PropEl.VarModifiers then
  7680. RaiseXExpectedButYFound(20170409214351,'class var','var',Expr)
  7681. else
  7682. RaiseXExpectedButYFound(20170409214359,'var','class var',Expr);
  7683. exit;
  7684. end;
  7685. if (ResolvedEl.BaseType=btBoolean) and (ResolvedEl.ExprEl<>nil) then
  7686. begin
  7687. // try evaluating const boolean
  7688. Value:=Eval(Expr,[refConst]);
  7689. if Value<>nil then
  7690. try
  7691. if Value.Kind<>revkBool then
  7692. RaiseXExpectedButYFound(20170923200256,'boolean',GetResolverResultDescription(ResolvedEl),Expr);
  7693. exit;
  7694. finally
  7695. ReleaseEvalValue(Value);
  7696. end;
  7697. end;
  7698. RaiseXExpectedButYFound(20170923194234,'identifier',GetResolverResultDescription(ResolvedEl),Expr);
  7699. end;
  7700. var
  7701. ResultType, aType: TPasType;
  7702. MembersType: TPasMembersType;
  7703. AccEl: TPasElement;
  7704. Proc: TPasProcedure;
  7705. Arg: TPasArgument;
  7706. PropArgCount, NeedArgCnt: Integer;
  7707. PropTypeResolved, DefaultResolved, IndexResolved,
  7708. AncIndexResolved: TPasResolverResult;
  7709. m: TVariableModifier;
  7710. IndexVal: TResEvalValue;
  7711. AncIndexExpr, ErrorEl: TPasExpr;
  7712. CurClass: TPasClassType;
  7713. begin
  7714. CheckTopScope(TPasPropertyScope);
  7715. PopScope;
  7716. if PropEl.Visibility=visPublished then
  7717. for m in PropEl.VarModifiers do
  7718. if not (m in [vmExternal]) then
  7719. RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
  7720. ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
  7721. PropType:=nil;
  7722. MembersType:=PropEl.Parent as TPasMembersType;
  7723. ClassOrRecScope:=NoNil(MembersType.CustomData) as TPasClassOrRecordScope;
  7724. ClassScope:=nil;
  7725. CurClass:=nil;
  7726. if ClassOrRecScope is TPasClassScope then
  7727. begin
  7728. ClassScope:=TPasClassScope(ClassOrRecScope);
  7729. CurClass:=TPasClassType(MembersType);
  7730. end;
  7731. AncestorProp:=nil;
  7732. GetPropType;
  7733. IndexVal:=nil;
  7734. try
  7735. if PropEl.IndexExpr<>nil then
  7736. begin
  7737. // index specifier
  7738. // -> check if simple value
  7739. IndexExpr:=PropEl.IndexExpr;
  7740. ResolveExpr(IndexExpr,rraRead);
  7741. end
  7742. else
  7743. IndexExpr:=GetPasPropertyIndex(PropEl);
  7744. if IndexExpr<>nil then
  7745. begin
  7746. ComputeElement(IndexExpr,IndexResolved,[rcConstant]);
  7747. IndexVal:=Eval(IndexExpr,[refConst]);
  7748. case IndexVal.Kind of
  7749. revkBool,
  7750. revkInt, revkUInt,
  7751. revkFloat,
  7752. revkCurrency,
  7753. {$ifdef FPC_HAS_CPSTRING}
  7754. revkString,
  7755. {$endif}
  7756. revkUnicodeString,
  7757. revkEnum: ; // ok
  7758. else
  7759. RaiseXExpectedButYFound(20170924202837,'ordinal',GetTypeDescription(IndexResolved),PropEl.IndexExpr);
  7760. end;
  7761. if (PropEl.IndexExpr<>nil) and (PropEl.VarType=nil) then
  7762. begin
  7763. // check if index is compatible to ancestor index specifier
  7764. AncIndexExpr:=GetPasPropertyIndex(AncestorProp);
  7765. if AncIndexExpr=nil then
  7766. begin
  7767. // ancestor had no index specifier
  7768. if PropEl.ReadAccessor=nil then
  7769. begin
  7770. AccEl:=GetPasPropertyGetter(AncestorProp);
  7771. if AccEl is TPasProcedure then
  7772. RaiseMsg(20171002144103,nAddingIndexSpecifierRequiresNewX,
  7773. sAddingIndexSpecifierRequiresNewX,['read'],IndexExpr);
  7774. end;
  7775. if PropEl.WriteAccessor=nil then
  7776. begin
  7777. AccEl:=GetPasPropertySetter(AncestorProp);
  7778. if AccEl is TPasProcedure then
  7779. RaiseMsg(20171002144419,nAddingIndexSpecifierRequiresNewX,
  7780. sAddingIndexSpecifierRequiresNewX,['write'],IndexExpr);
  7781. end;
  7782. if PropEl.StoredAccessor=nil then
  7783. begin
  7784. AccEl:=GetPasPropertyStoredExpr(AncestorProp);
  7785. if AccEl<>nil then
  7786. begin
  7787. ComputeElement(AccEl,AncIndexResolved,[rcNoImplicitProc]);
  7788. if AncIndexResolved.IdentEl is TPasProcedure then
  7789. RaiseMsg(20171002144644,nAddingIndexSpecifierRequiresNewX,
  7790. sAddingIndexSpecifierRequiresNewX,['stored'],IndexExpr);
  7791. end;
  7792. end;
  7793. end
  7794. else
  7795. // ancestor had already an index specifier -> check same type
  7796. CheckEqualElCompatibility(PropEl.IndexExpr,AncIndexExpr,PropEl.IndexExpr,true);
  7797. end;
  7798. end;
  7799. if PropEl.ReadAccessor<>nil then
  7800. begin
  7801. // check compatibility
  7802. ErrorEl:=PropEl.ReadAccessor;
  7803. AccEl:=ResolveAccessor(PropEl.ReadAccessor);
  7804. if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
  7805. begin
  7806. if (PropEl.Args.Count>0) then
  7807. RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),ErrorEl);
  7808. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7809. RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
  7810. [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
  7811. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7812. if vmClass in PropEl.VarModifiers then
  7813. RaiseXExpectedButYFound(20170216151828,'class var','var',ErrorEl)
  7814. else
  7815. RaiseXExpectedButYFound(20170216151831,'var','class var',ErrorEl);
  7816. end
  7817. else if AccEl is TPasProcedure then
  7818. begin
  7819. // check function
  7820. Proc:=TPasProcedure(AccEl);
  7821. if (vmClass in PropEl.VarModifiers) then
  7822. begin
  7823. if Proc.ClassType<>TPasClassFunction then
  7824. RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),ErrorEl);
  7825. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7826. if Proc.IsStatic then
  7827. RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
  7828. else
  7829. RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
  7830. end
  7831. else
  7832. begin
  7833. if Proc.ClassType<>TPasFunction then
  7834. RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),ErrorEl);
  7835. end;
  7836. // check function result type
  7837. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7838. if not IsSameType(ResultType,PropType,prraAlias) then
  7839. RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
  7840. GetTypeDescription(ResultType,true),ErrorEl);
  7841. if Proc.IsAsync then
  7842. RaiseMsg(20200526101546,nInvalidXModifierY,sInvalidXModifierY,['property getter',
  7843. ProcTypeModifiers[ptmAsync]],ErrorEl);
  7844. // check args
  7845. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  7846. NeedArgCnt:=PropEl.Args.Count;
  7847. if IndexVal<>nil then
  7848. inc(NeedArgCnt);
  7849. if Proc.ProcType.Args.Count<>NeedArgCnt then
  7850. RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7851. [Proc.Name],ErrorEl);
  7852. end
  7853. else
  7854. RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),ErrorEl);
  7855. end;
  7856. if PropEl.WriteAccessor<>nil then
  7857. begin
  7858. // check compatibility
  7859. ErrorEl:=PropEl.WriteAccessor;
  7860. AccEl:=ResolveAccessor(PropEl.WriteAccessor);
  7861. if (AccEl.ClassType=TPasVariable)
  7862. or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
  7863. begin
  7864. if (PropEl.Args.Count>0) then
  7865. RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),ErrorEl);
  7866. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7867. RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
  7868. [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
  7869. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7870. if vmClass in PropEl.VarModifiers then
  7871. RaiseXExpectedButYFound(20170216151858,'class var','var',ErrorEl)
  7872. else
  7873. RaiseXExpectedButYFound(20170216151900,'var','class var',ErrorEl);
  7874. end
  7875. else if AccEl is TPasProcedure then
  7876. begin
  7877. // check procedure
  7878. Proc:=TPasProcedure(AccEl);
  7879. if (vmClass in PropEl.VarModifiers) then
  7880. begin
  7881. if Proc.ClassType<>TPasClassProcedure then
  7882. RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),ErrorEl);
  7883. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7884. if Proc.IsStatic then
  7885. RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
  7886. else
  7887. RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
  7888. end
  7889. else
  7890. begin
  7891. if Proc.ClassType<>TPasProcedure then
  7892. RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),ErrorEl);
  7893. end;
  7894. if Proc.IsAsync then
  7895. RaiseMsg(20200526101635,nInvalidXModifierY,sInvalidXModifierY,['property setter',
  7896. ProcTypeModifiers[ptmAsync]],ErrorEl);
  7897. // check args
  7898. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.WriteAccessor);
  7899. // check write arg
  7900. PropArgCount:=PropEl.Args.Count;
  7901. if IndexVal<>nil then
  7902. inc(PropArgCount);
  7903. if Proc.ProcType.Args.Count<>PropArgCount+1 then
  7904. RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7905. [Proc.Name],ErrorEl);
  7906. Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
  7907. if not (Arg.Access in [argDefault,argConst]) then
  7908. RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7909. [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
  7910. AccessDescriptions[argConst]],ErrorEl);
  7911. if not IsSameType(Arg.ArgType,PropType,prraAlias) then
  7912. RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
  7913. [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,ErrorEl);
  7914. end
  7915. else
  7916. RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),ErrorEl);
  7917. end
  7918. else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
  7919. RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
  7920. if length(PropEl.Implements)>0 then
  7921. CheckImplements;
  7922. if PropEl.StoredAccessor<>nil then
  7923. begin
  7924. // check compatibility
  7925. CheckStoredAccessor(PropEl.StoredAccessor,IndexVal,IndexResolved);
  7926. end;
  7927. if PropEl.DefaultExpr<>nil then
  7928. begin
  7929. // check compatibility with type
  7930. ResolveExpr(PropEl.DefaultExpr,rraRead);
  7931. ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
  7932. ComputeElement(PropType,PropTypeResolved,[rcType]);
  7933. PropTypeResolved.IdentEl:=PropEl;
  7934. PropTypeResolved.Flags:=[rrfReadable];
  7935. CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
  7936. end;
  7937. if PropEl.IsDefault then
  7938. begin
  7939. if (CurClass<>nil) and (CurClass.HelperForType<>nil) then
  7940. begin
  7941. aType:=ResolveAliasType(CurClass.HelperForType);
  7942. if not (aType is TPasMembersType) then
  7943. RaiseMsg(20190117125004,nDefaultPropertyNotAllowedInHelperForX,
  7944. sDefaultPropertyNotAllowedInHelperForX,
  7945. [GetTypeDescription(CurClass.HelperForType)],PropEl);
  7946. end;
  7947. // set default array property
  7948. if (ClassOrRecScope.DefaultProperty<>nil)
  7949. and (ClassOrRecScope.DefaultProperty.Parent=PropEl.Parent) then
  7950. RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
  7951. ClassOrRecScope.DefaultProperty:=PropEl;
  7952. end;
  7953. EmitTypeHints(PropEl,PropEl.VarType);
  7954. finally
  7955. ReleaseEvalValue(IndexVal);
  7956. end;
  7957. end;
  7958. procedure TPasResolver.FinishArgument(El: TPasArgument);
  7959. procedure CheckHasGenTemplRef(Arg: TPasArgument);
  7960. procedure Check(Parent: TPasElement; Cur: TPasType; TemplTypes: TFPList);
  7961. var
  7962. C: TClass;
  7963. Arr: TPasArrayType;
  7964. begin
  7965. if Cur=nil then exit;
  7966. C:=Cur.ClassType;
  7967. if C=TPasGenericTemplateType then
  7968. begin
  7969. if TemplTypes.IndexOf(Cur)>=0 then
  7970. RaiseMsg(20191007213121,nParamOfThisTypeCannotHaveDefVal,sParamOfThisTypeCannotHaveDefVal,[],El);
  7971. end
  7972. else if Cur.Parent<>Parent then
  7973. exit
  7974. else if C=TPasArrayType then
  7975. begin
  7976. Arr:=TPasArrayType(Cur);
  7977. Check(Arr,Arr.ElType,TemplTypes);
  7978. end;
  7979. end;
  7980. var
  7981. Proc: TPasProcedure;
  7982. TemplTypes: TFPList;
  7983. begin
  7984. if Arg.ArgType=nil then exit;
  7985. if not (Arg.Parent is TPasProcedureType) then exit;
  7986. if not (Arg.Parent.Parent is TPasProcedure) then exit;
  7987. Proc:=TPasProcedure(Arg.Parent.Parent);
  7988. TemplTypes:=GetProcTemplateTypes(Proc);
  7989. if TemplTypes=nil then exit;
  7990. Check(Arg,Arg.ArgType,TemplTypes);
  7991. end;
  7992. var
  7993. IsDelphi: Boolean;
  7994. begin
  7995. if not (El.Access in [argDefault,argConst,argVar,argOut,argConstRef]) then
  7996. RaiseMsg(20191018235644,nNotYetImplemented,sNotYetImplemented,[AccessDescriptions[El.Access]],El);
  7997. if El.ArgType<>nil then
  7998. CheckUseAsType(El.ArgType,20190123100049,El);
  7999. if El.ValueExpr<>nil then
  8000. begin
  8001. ResolveExpr(El.ValueExpr,rraRead);
  8002. if El.ArgType<>nil then
  8003. begin
  8004. CheckAssignCompatibility(El,El.ValueExpr,true);
  8005. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  8006. if IsDelphi then
  8007. CheckHasGenTemplRef(El);
  8008. end;
  8009. end;
  8010. EmitTypeHints(El,El.ArgType);
  8011. end;
  8012. procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
  8013. // called when the ancestor and interface list of a class has been parsed,
  8014. // before parsing the class elements
  8015. var
  8016. DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
  8017. AncestorClassEl: TPasClassType;
  8018. function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
  8019. begin
  8020. Result:=SameText(c.Name,DefAncestorName)
  8021. and (c.Parent is TPasSection);
  8022. end;
  8023. procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
  8024. var
  8025. CurEl: TPasElement;
  8026. begin
  8027. AncestorClassEl:=nil;
  8028. if SameText(aClass.Name,DefAncestorName) then
  8029. begin
  8030. if IsDefaultAncestor(aClass,DefAncestorName) then exit;
  8031. RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
  8032. end;
  8033. CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false,true);
  8034. if not (CurEl is TPasType) then
  8035. RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
  8036. DirectAncestor:=TPasType(CurEl);
  8037. CurEl:=ResolveAliasType(DirectAncestor);
  8038. if not (CurEl is TPasClassType) then
  8039. RaiseXExpectedButYFound(20170216151941,Expected,GetElementTypeName(DirectAncestor),aClass);
  8040. AncestorClassEl:=TPasClassType(CurEl);
  8041. end;
  8042. var
  8043. ClassScope, AncestorClassScope: TPasClassScope;
  8044. AncestorType, El: TPasType;
  8045. i: Integer;
  8046. aModifier, DefAncestorName: String;
  8047. IsSealed, IsDelphi: Boolean;
  8048. CanonicalSelf: TPasClassOfType;
  8049. Decl: TPasElement;
  8050. j, TypeParamCnt: integer;
  8051. IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
  8052. ResIntfList, Members: TFPList;
  8053. GroupScope: TPasGroupScope;
  8054. C: TClass;
  8055. begin
  8056. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  8057. if aClass.IsForward then
  8058. begin
  8059. PopGenericParamScope(aClass);
  8060. // check for duplicate forwards
  8061. C:=aClass.Parent.ClassType;
  8062. if C.InheritsFrom(TPasDeclarations) then
  8063. Members:=TPasDeclarations(aClass.Parent).Declarations
  8064. else if (C=TPasClassType) or (C=TPasRecordType) then
  8065. Members:=TPasMembersType(aClass.Parent).Members
  8066. else
  8067. RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
  8068. TypeParamCnt:=GetTypeParameterCount(aClass);
  8069. for i:=0 to Members.Count-1 do
  8070. begin
  8071. Decl:=TPasElement(Members[i]);
  8072. if (CompareText(Decl.Name,aClass.Name)<>0)
  8073. or (Decl=aClass) then continue;
  8074. if (Decl is TPasGenericType)
  8075. and (GetTypeParameterCount(TPasGenericType(Decl))<>TypeParamCnt) then
  8076. continue;
  8077. RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
  8078. [Decl.Name,GetElementSourcePosStr(Decl)],aClass);
  8079. end;
  8080. if TypeParamCnt>0 then
  8081. begin
  8082. // A generic forward needs TPasClassScope to store the specialized types.
  8083. // Will later be transferred to the actual class.
  8084. CreateScope(aClass,ScopeClass_Class);
  8085. end;
  8086. exit;
  8087. end;
  8088. // not forward, actual declaration ...
  8089. case aClass.ObjKind of
  8090. okClass:
  8091. begin
  8092. AncestorType:=ResolveAliasType(aClass.AncestorType);
  8093. if (AncestorType is TPasClassType)
  8094. and (TPasClassType(AncestorType).ObjKind=okInterface)
  8095. and not isDelphi then
  8096. begin
  8097. // e.g. type c = class(intf)
  8098. // ObjFPC allows to omit TObject as default ancestor, Delphi does not
  8099. aClass.Interfaces.Insert(0,aClass.AncestorType);
  8100. aClass.AncestorType:=nil;
  8101. end;
  8102. end;
  8103. okInterface:
  8104. begin
  8105. if aClass.IsExternal then
  8106. RaiseMsg(20180321115831,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8107. if not (aClass.InterfaceType in [citCom,citCorba]) then
  8108. RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
  8109. [CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
  8110. end;
  8111. okClassHelper,okRecordHelper,okTypeHelper:
  8112. begin
  8113. if aClass.IsExternal then
  8114. RaiseMsg(20190116192722,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8115. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8116. if HelperForType=nil then
  8117. RaiseNotYetImplemented(20191016125557,aClass);
  8118. if (aClass=HelperForType) or (aClass.HasParent(HelperForType)) then
  8119. RaiseMsg(20190118190935,nTypeXIsNotYetCompletelyDefined,
  8120. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8121. case aClass.ObjKind of
  8122. okClassHelper:
  8123. begin
  8124. if not (HelperForType is TPasClassType) then
  8125. RaiseXExpectedButYFound(20190116194751,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  8126. if TPasClassType(HelperForType).ObjKind<>okClass then
  8127. RaiseXExpectedButYFound(20190116194855,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  8128. if TPasClassType(HelperForType).IsForward then
  8129. RaiseMsg(20190116194931,nTypeXIsNotYetCompletelyDefined,
  8130. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8131. end;
  8132. okRecordHelper:
  8133. if isDelphi then
  8134. begin
  8135. if (HelperForType.ClassType=TPasRecordType)
  8136. or (HelperForType.ClassType=TPasArrayType)
  8137. or (HelperForType.ClassType=TPasSetType)
  8138. or (HelperForType.ClassType=TPasEnumType)
  8139. or (HelperForType.ClassType=TPasRangeType)
  8140. then
  8141. // ok
  8142. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  8143. and (HelperForType.CustomData is TResElDataBaseType)) then
  8144. else
  8145. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByARecordHelper,
  8146. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  8147. end
  8148. else
  8149. begin
  8150. // mode objfpc
  8151. if (HelperForType.ClassType=TPasRecordType) then
  8152. else
  8153. RaiseMsg(20190116200519,nTypeXCannotBeExtendedByARecordHelper,
  8154. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  8155. end;
  8156. okTypeHelper:
  8157. begin
  8158. if (HelperForType.ClassType=TPasRecordType)
  8159. or (HelperForType.ClassType=TPasArrayType)
  8160. or (HelperForType.ClassType=TPasSetType)
  8161. or (HelperForType.ClassType=TPasEnumType)
  8162. or (HelperForType.ClassType=TPasRangeType)
  8163. then
  8164. // ok
  8165. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  8166. and (HelperForType.CustomData is TResElDataBaseType)) then
  8167. else if (HelperForType.ClassType=TPasClassType)
  8168. and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
  8169. begin
  8170. if TPasClassType(HelperForType).IsForward then
  8171. RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
  8172. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8173. end
  8174. else
  8175. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
  8176. sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass);
  8177. end;
  8178. end;
  8179. end
  8180. else
  8181. RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
  8182. end;
  8183. IsSealed:=false;
  8184. for i:=0 to aClass.Modifiers.Count-1 do
  8185. begin
  8186. aModifier:=lowercase(aClass.Modifiers[i]);
  8187. case aModifier of
  8188. 'sealed': IsSealed:=true;
  8189. 'abstract': ;
  8190. else
  8191. RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
  8192. end;
  8193. end;
  8194. AncestorClassEl:=nil;
  8195. DirectAncestor:=aClass.AncestorType;
  8196. AncestorType:=ResolveAliasType(DirectAncestor);
  8197. if AncestorType=nil then
  8198. begin
  8199. if DirectAncestor<>nil then
  8200. RaiseInternalError(20180321151851,GetObjName(DirectAncestor));
  8201. // use default ancestor
  8202. DefAncestorName:='';
  8203. case aClass.ObjKind of
  8204. okClass:
  8205. begin
  8206. DefAncestorName:='TObject';
  8207. if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
  8208. begin
  8209. // ok, no ancestor
  8210. AncestorClassEl:=nil;
  8211. end
  8212. else
  8213. begin
  8214. // search default ancestor TObject
  8215. FindDefaultAncestor(DefAncestorName,'class type');
  8216. if TPasClassType(AncestorClassEl).ObjKind<>okClass then
  8217. RaiseXExpectedButYFound(20180321145626,'class type',GetElementTypeName(AncestorClassEl),aClass);
  8218. end;
  8219. end;
  8220. okInterface:
  8221. begin
  8222. if aClass.InterfaceType=citCom then
  8223. begin
  8224. if isDelphi then
  8225. DefAncestorName:='IInterface'
  8226. else
  8227. DefAncestorName:='IUnknown';
  8228. if IsDefaultAncestor(aClass,DefAncestorName) then
  8229. AncestorClassEl:=nil
  8230. else
  8231. begin
  8232. // search default ancestor interface
  8233. FindDefaultAncestor(DefAncestorName,'interface type');
  8234. if TPasClassType(AncestorClassEl).ObjKind<>okInterface then
  8235. RaiseXExpectedButYFound(20180321145725,'interface type',
  8236. GetElementTypeName(AncestorClassEl),aClass);
  8237. end;
  8238. end;
  8239. end;
  8240. okClassHelper,okRecordHelper,okTypeHelper: ; // no root ancestor
  8241. end;
  8242. end
  8243. else if AncestorType.ClassType<>TPasClassType then
  8244. RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
  8245. else if aClass=AncestorType then
  8246. RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
  8247. else
  8248. begin
  8249. AncestorClassEl:=TPasClassType(AncestorType);
  8250. if AncestorClassEl.ObjKind<>aClass.ObjKind then
  8251. RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
  8252. GetElementTypeName(AncestorClassEl)+' type',aClass);
  8253. if aClass.ObjKind in okAllHelpers then
  8254. begin
  8255. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8256. AncestorHelperFor:=ResolveAliasType(AncestorClassEl.HelperForType);
  8257. if IsSameType(HelperForType,AncestorHelperFor,prraNone) then
  8258. // helper for same type as ancestor helper -> ok
  8259. else if (HelperForType is TPasClassType)
  8260. and (AncestorHelperFor is TPasClassType)
  8261. and (CheckClassIsClass(HelperForType,AncestorHelperFor)<>cIncompatible) then
  8262. // helper for descendant class of ancestor helper for -> ok
  8263. else
  8264. RaiseMsg(20190116203931,nDerivedXMustExtendASubClassY,sDerivedXMustExtendASubClassY,
  8265. [GetElementTypeName(aClass),AncestorClassEl.HelperForType.Name],aClass);
  8266. end;
  8267. EmitTypeHints(aClass,AncestorClassEl);
  8268. end;
  8269. AncestorClassScope:=nil;
  8270. if AncestorClassEl=nil then
  8271. begin
  8272. // root class e.g. TObject, IUnknown, helper
  8273. end
  8274. else
  8275. begin
  8276. // inherited class
  8277. if AncestorClassEl.IsForward then
  8278. RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
  8279. sCantUseForwardDeclarationAsAncestor,[AncestorClassEl.Name],aClass);
  8280. if aClass.IsExternal and not AncestorClassEl.IsExternal then
  8281. RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
  8282. [AncestorClassEl.Name],aClass);
  8283. AncestorClassScope:=AncestorClassEl.CustomData as TPasClassScope;
  8284. if pcsfSealed in AncestorClassScope.Flags then
  8285. RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedXY,
  8286. sCannotCreateADescendantOfTheSealedXY,
  8287. [GetElementTypeName(AncestorClassEl),AncestorClassEl.Name],aClass);
  8288. // check for cycle
  8289. El:=AncestorClassEl;
  8290. repeat
  8291. if El=aClass then
  8292. RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
  8293. if (El.ClassType=TPasAliasType)
  8294. or (El.ClassType=TPasTypeAliasType)
  8295. or (El.ClassType=TPasSpecializeType)
  8296. then
  8297. El:=TPasAliasType(El).DestType
  8298. else if El.ClassType=TPasClassType then
  8299. El:=TPasClassType(El).AncestorType
  8300. else
  8301. RaiseNotYetImplemented(20190825195203,aClass,GetObjName(El));
  8302. until El=nil;
  8303. end;
  8304. if TopScope is TPasGenericParamsScope then
  8305. PopGenericParamScope(aClass);
  8306. // start scope for members
  8307. {$IFDEF VerbosePasResolver}
  8308. //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
  8309. {$ENDIF}
  8310. if aClass.CustomData=nil then
  8311. ClassScope:=TPasClassScope(CreateScope(aClass,ScopeClass_Class))
  8312. else
  8313. begin
  8314. // has already the scope, e.g. scope moved from a generic forward
  8315. ClassScope:=aClass.CustomData as TPasClassScope;
  8316. if pcsfAncestorResolved in ClassScope.Flags then
  8317. RaiseNotYetImplemented(20190803203715,aClass);
  8318. end;
  8319. Include(ClassScope.Flags,pcsfAncestorResolved);
  8320. if IsSealed then
  8321. Include(ClassScope.Flags,pcsfSealed);
  8322. AddGenericTemplateIdentifiers(aClass.GenericTemplateTypes,ClassScope);
  8323. ClassScope.DirectAncestor:=DirectAncestor;
  8324. if AncestorClassEl<>nil then
  8325. begin
  8326. ClassScope.AncestorScope:=AncestorClassScope;
  8327. ClassScope.DefaultProperty:=AncestorClassScope.DefaultProperty;
  8328. if pcsfPublished in AncestorClassScope.Flags then
  8329. Include(ClassScope.Flags,pcsfPublished);
  8330. ClassScope.AbstractProcs:=copy(AncestorClassScope.AbstractProcs);
  8331. end;
  8332. if bsTypeInfo in CurrentParser.Scanner.CurrentBoolSwitches then
  8333. Include(ClassScope.Flags,pcsfPublished);
  8334. if aClass.ObjKind in ([okClass]+okAllHelpers) then
  8335. begin
  8336. // create canonical class-of for the "Self" in non static class functions
  8337. CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
  8338. ClassScope.CanonicalClassOf:=CanonicalSelf;
  8339. {$IFDEF CheckPasTreeRefCount}CanonicalSelf.RefIds.Add('TPasClassScope.CanonicalClassOf');{$ENDIF}
  8340. CanonicalSelf.DestType:=aClass;
  8341. aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
  8342. CanonicalSelf.Visibility:=visStrictPrivate;
  8343. CanonicalSelf.SourceFilename:=aClass.SourceFilename;
  8344. CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
  8345. end;
  8346. // push scope (must be done after setting aClass.AncestorScope)
  8347. GroupScope:=PushGroupScope(aClass);
  8348. GroupScope.VisibilityContext:=aClass;
  8349. // check interfaces
  8350. if aClass.Interfaces.Count>0 then
  8351. begin
  8352. if not (aClass.ObjKind in [okClass]) then
  8353. RaiseXExpectedButYFound(20180322001341,'one ancestor',
  8354. IntToStr(1+aClass.Interfaces.Count),aClass);
  8355. if aClass.IsExternal then
  8356. RaiseMsg(20180324183641,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8357. ResIntfList:=TFPList.Create;
  8358. try
  8359. for i:=0 to aClass.Interfaces.Count-1 do
  8360. begin
  8361. IntfType:=TPasType(aClass.Interfaces[i]);
  8362. IntfTypeRes:=ResolveAliasType(IntfType);
  8363. if IntfTypeRes=nil then
  8364. RaiseMsg(20180322140044,nCantUseForwardDeclarationAsAncestor,
  8365. sCantUseForwardDeclarationAsAncestor,[IntfType.Name],aClass);
  8366. if not (IntfTypeRes is TPasClassType) then
  8367. RaiseXExpectedButYFound(20180322001051,'interface type',
  8368. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8369. if TPasClassType(IntfTypeRes).ObjKind<>okInterface then
  8370. RaiseXExpectedButYFound(20180322001143,'interface type',
  8371. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8372. j:=ResIntfList.IndexOf(IntfTypeRes);
  8373. if j>=0 then
  8374. RaiseMsg(20180322001505,nDuplicateIdentifier,sDuplicateIdentifier,
  8375. [IntfType.Name,IntToStr(j+1)],aClass); // todo: jump to interface list
  8376. ResIntfList.Add(IntfTypeRes);
  8377. end;
  8378. finally
  8379. ResIntfList.Free;
  8380. end;
  8381. // create interfaces maps
  8382. ClassScope.Interfaces:=TFPList.Create;
  8383. ClassScope.Interfaces.Count:=aClass.Interfaces.Count;
  8384. end;
  8385. end;
  8386. procedure TPasResolver.FinishMethodResolution(El: TPasMethodResolution);
  8387. var
  8388. ResolvedEl: TPasResolverResult;
  8389. aClass, IntfType: TPasClassType;
  8390. i: Integer;
  8391. IntfProc: TPasProcedure;
  8392. Expr: TPasExpr;
  8393. ProcName: String;
  8394. IntfScope: TPasClassScope;
  8395. Identifier: TPasIdentifier;
  8396. begin
  8397. // procedure InterfaceName.InterfaceProc = ...
  8398. // check InterfaceName
  8399. ResolveExpr(El.InterfaceName,rraRead);
  8400. ComputeElement(El.InterfaceName,ResolvedEl,[rcType,rcNoImplicitProc]);
  8401. if not (ResolvedEl.IdentEl is TPasType) then
  8402. RaiseXExpectedButYFound(20180323132601,'interface type',
  8403. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8404. aClass:=El.Parent as TPasClassType;
  8405. i:=IndexOfImplementedInterface(aClass,TPasType(ResolvedEl.IdentEl));
  8406. if i<0 then
  8407. RaiseXExpectedButYFound(20180323133055,'interface type',
  8408. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8409. IntfType:=TPasClassType(ResolveAliasType(TPasClassType(aClass.Interfaces[i])));
  8410. // check InterfaceProc
  8411. Expr:=El.InterfaceProc;
  8412. if not (Expr is TPrimitiveExpr) then
  8413. RaiseXExpectedButYFound(20180327152808,'method name',GetElementTypeName(Expr),Expr);
  8414. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  8415. RaiseXExpectedButYFound(20180327152841,'method name',GetElementTypeName(Expr),Expr);
  8416. ProcName:=TPrimitiveExpr(Expr).Value;
  8417. IntfScope:=IntfType.CustomData as TPasClassScope;
  8418. IntfProc:=nil;
  8419. while IntfScope<>nil do
  8420. begin
  8421. Identifier:=IntfScope.FindLocalIdentifier(ProcName);
  8422. while Identifier<>nil do
  8423. begin
  8424. if not (Identifier.Element is TPasProcedure) then
  8425. RaiseXExpectedButYFound(20180327153110,'interface method',GetElementTypeName(Identifier.Element),Expr);
  8426. IntfProc:=TPasProcedure(Identifier.Element);
  8427. if IntfProc.ClassType=El.ProcClass then
  8428. break;
  8429. Identifier:=Identifier.NextSameIdentifier;
  8430. end;
  8431. IntfScope:=IntfScope.AncestorScope;
  8432. end;
  8433. if IntfProc=nil then
  8434. RaiseIdentifierNotFound(20180327153044,ProcName,Expr);
  8435. CreateReference(IntfProc,Expr,rraRead);
  8436. if IntfProc.ClassType<>El.ProcClass then
  8437. RaiseXExpectedButYFound(20180323144107,GetElementTypeName(El.ProcClass),GetElementTypeName(IntfProc),El.InterfaceProc);
  8438. // Note: do not create map here. CheckImplements in FinishProperty must be called before.
  8439. // El.ImplementationProc is resolved in FinishClassType
  8440. end;
  8441. procedure TPasResolver.FinishAttributes(El: TPasAttributes);
  8442. var
  8443. i, j: Integer;
  8444. NameExpr, Expr: TPasExpr;
  8445. Bin: TBinaryExpr;
  8446. LeftResolved, ParamResolved: TPasResolverResult;
  8447. aModule: TPasModule;
  8448. LTypeEl: TPasType;
  8449. AttrName: String;
  8450. Data: TPRFindData;
  8451. CurEl, DeclEl: TPasElement;
  8452. ClassEl: TPasClassType;
  8453. aConstructor: TPasConstructor;
  8454. Args: TFPList;
  8455. AttrRef, ParamRef: TResolvedReference;
  8456. DotScope: TPasDotBaseScope;
  8457. Params: TPasExprArray;
  8458. begin
  8459. for i:=0 to length(El.Calls)-1 do
  8460. begin
  8461. NameExpr:=El.Calls[i];
  8462. {$IFDEF VerbosePasResolver}
  8463. //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
  8464. {$ENDIF}
  8465. if NameExpr is TParamsExpr then
  8466. NameExpr:=TParamsExpr(NameExpr).Value;
  8467. DotScope:=nil;
  8468. if NameExpr is TBinaryExpr then
  8469. begin
  8470. Bin:=TBinaryExpr(NameExpr);
  8471. ResolveExpr(Bin.left,rraRead);
  8472. ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
  8473. if LeftResolved.BaseType=btModule then
  8474. begin
  8475. // e.g. unitname.identifier
  8476. // => search in interface and if this is our module in the implementation
  8477. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  8478. DotScope:=PushModuleDotScope(aModule);
  8479. end
  8480. else if (LeftResolved.BaseType=btContext)
  8481. and (LeftResolved.IdentEl is TPasType)
  8482. and (LeftResolved.LoTypeEl is TPasMembersType) then
  8483. begin
  8484. // classtype.identifier or recordtype.identifier
  8485. LTypeEl:=LeftResolved.LoTypeEl;
  8486. if LTypeEl.ClassType=TPasClassType then
  8487. begin
  8488. DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
  8489. DotScope.OnlyTypeMembers:=true;
  8490. end
  8491. else if LTypeEl.ClassType=TPasRecordType then
  8492. begin
  8493. DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
  8494. DotScope.OnlyTypeMembers:=true;
  8495. end
  8496. else
  8497. RaiseNotYetImplemented(20190221124930,Bin);
  8498. end
  8499. else
  8500. RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
  8501. ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
  8502. NameExpr:=Bin.right;
  8503. end;
  8504. // find attribute class
  8505. if not IsNameExpr(NameExpr) then
  8506. RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
  8507. ['identifier',GetElementTypeName(Bin)],NameExpr);
  8508. AttrName:=TPrimitiveExpr(NameExpr).Value;
  8509. CurEl:=nil;
  8510. if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
  8511. begin
  8512. // first search AttrName+'Attribute'
  8513. CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
  8514. end;
  8515. // then search the name
  8516. if CurEl=nil then
  8517. CurEl:=FindFirstEl(AttrName,Data,NameExpr);
  8518. if DotScope<>nil then
  8519. PopScope;
  8520. {$IFDEF VerbosePasResolver}
  8521. writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
  8522. {$ENDIF}
  8523. // check if found element is a TCustomAttribute
  8524. if CurEl=nil then
  8525. begin
  8526. LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
  8527. [AttrName],NameExpr);
  8528. continue;
  8529. end;
  8530. if not IsCustomAttribute(CurEl) then
  8531. RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8532. [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
  8533. ClassEl:=TPasClassType(CurEl);
  8534. AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
  8535. if ClassEl.IsAbstract then
  8536. // Delphi silently skips attributes using abstract classes/methods
  8537. LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8538. sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
  8539. // search constructor "Create" using the params
  8540. DotScope:=PushClassDotScope(ClassEl);
  8541. DotScope.OnlyTypeMembers:=true;
  8542. Expr:=El.Calls[i];
  8543. if Expr is TParamsExpr then
  8544. begin
  8545. // attribute with params
  8546. if Expr.Kind<>pekFuncParams then
  8547. begin
  8548. {$IFDEF VerbosePasResolver}
  8549. writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
  8550. {$ENDIF}
  8551. RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
  8552. ['(','['],Expr);
  8553. end;
  8554. // first resolve params
  8555. ResolveParamsExprParams(TParamsExpr(Expr));
  8556. // then resolve call 'Create'
  8557. ResolveFuncParamsExprName(Expr,nil,TParamsExpr(Expr),rraRead,'Create');
  8558. // then check that each parameter is a constant expression
  8559. Params:=TParamsExpr(Expr).Params;
  8560. for j:=0 to length(Params)-1 do
  8561. ComputeElement(Params[j],ParamResolved,[rcConstant]);
  8562. // check if call is constructor
  8563. ParamRef:=Expr.CustomData as TResolvedReference;
  8564. DeclEl:=ParamRef.Declaration;
  8565. if DeclEl.ClassType<>TPasConstructor then
  8566. RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
  8567. aConstructor:=TPasConstructor(DeclEl);
  8568. end
  8569. else
  8570. begin
  8571. // attribute without params
  8572. // -> resolve call 'Create'
  8573. DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false,true);
  8574. if DeclEl=nil then
  8575. RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
  8576. // check call is constructor
  8577. if DeclEl.ClassType<>TPasConstructor then
  8578. RaiseXExpectedButYFound(20190221145003,'constructor Create',
  8579. GetElementTypeName(DeclEl),NameExpr);
  8580. aConstructor:=TPasConstructor(DeclEl);
  8581. // check constructor without needed args
  8582. Args:=aConstructor.ProcType.Args;
  8583. if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
  8584. RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
  8585. sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
  8586. end;
  8587. if aConstructor.IsAbstract then
  8588. LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8589. sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
  8590. // store reference to constructor in NameExpr
  8591. if AttrRef.Context<>nil then
  8592. RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
  8593. AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
  8594. TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
  8595. PopScope;
  8596. end;
  8597. end;
  8598. procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
  8599. procedure CheckConstExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string);
  8600. var
  8601. Value: TResEvalValue;
  8602. ResolvedEl: TPasResolverResult;
  8603. begin
  8604. if Expr=nil then exit;
  8605. ResolveExpr(Expr,rraRead);
  8606. Value:=Eval(Expr,[refConst]);
  8607. if (Value<>nil) and (Value.Kind in Kinds) then
  8608. begin
  8609. ReleaseEvalValue(Value);
  8610. exit;
  8611. end;
  8612. ReleaseEvalValue(Value);
  8613. ComputeElement(Expr,ResolvedEl,[rcConstant]);
  8614. RaiseXExpectedButYFound(20210101194628,Expected,GetTypeDescription(ResolvedEl),Expr);
  8615. end;
  8616. var
  8617. Expr: TPasExpr;
  8618. DeclEl: TPasElement;
  8619. FindData: TPRFindData;
  8620. Ref: TResolvedReference;
  8621. ResolvedEl: TPasResolverResult;
  8622. Section: TPasSection;
  8623. Scope: TPasIdentifierScope;
  8624. ScopeIdent: TPasIdentifier;
  8625. begin
  8626. Expr:=El.NameExpr;
  8627. if Expr<>nil then
  8628. begin
  8629. ResolveExpr(Expr,rraRead);
  8630. ComputeElement(Expr,ResolvedEl,[rcConstant]);
  8631. DeclEl:=ResolvedEl.IdentEl;
  8632. if DeclEl=nil then
  8633. RaiseMsg(20210103012907,nXExpectedButYFound,sXExpectedButYFound,['symbol',GetTypeDescription(ResolvedEl)],Expr);
  8634. if not (DeclEl.Parent is TPasSection) then
  8635. RaiseMsg(20210103012908,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetElementTypeName(DeclEl)],Expr);
  8636. end
  8637. else
  8638. begin
  8639. FindFirstEl(El.Name,FindData,El);
  8640. DeclEl:=FindData.Found;
  8641. if DeclEl=nil then
  8642. RaiseMsg(20210103002747,nIdentifierNotFound,sIdentifierNotFound,[El.Name],El);
  8643. if not (DeclEl.Parent is TPasSection) then
  8644. RaiseMsg(20210103003244,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetObjPath(DeclEl)],El);
  8645. Ref:=CreateReference(DeclEl,El,rraRead,@FindData);
  8646. CheckFoundElement(FindData,Ref);
  8647. end;
  8648. if DeclEl is TPasProcedure then
  8649. begin
  8650. Section:=DeclEl.Parent as TPasSection;
  8651. Scope:=Section.CustomData as TPasIdentifierScope;
  8652. ScopeIdent:=Scope.FindLocalIdentifier(DeclEl.Name);
  8653. if (ScopeIdent=nil) then
  8654. RaiseNotYetImplemented(20210106103001,El,GetObjPath(DeclEl));
  8655. if ScopeIdent.NextSameIdentifier<>nil then
  8656. RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
  8657. sCantDetermineWhichOverloadedFunctionToCall,[],El);
  8658. end;
  8659. // check index and name
  8660. CheckConstExpr(El.ExportIndex,[revkInt,revkUInt],'integer');
  8661. CheckConstExpr(El.ExportName,revkAllStrings,'string');
  8662. end;
  8663. procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
  8664. Params: TParamsExpr);
  8665. var
  8666. ParamAccess: TResolvedRefAccess;
  8667. i: Integer;
  8668. ArrParams: TPasExprArray;
  8669. begin
  8670. ArrParams:=Params.Params;
  8671. for i:=0 to length(ArrParams)-1 do
  8672. begin
  8673. ParamAccess:=rraRead;
  8674. if i<ProcType.Args.Count then
  8675. case TPasArgument(ProcType.Args[i]).Access of
  8676. argVar: ParamAccess:=rraVarParam;
  8677. argOut: ParamAccess:=rraOutParam;
  8678. end;
  8679. AccessExpr(ArrParams[i],ParamAccess);
  8680. end;
  8681. CheckCallProcCompatibility(ProcType,Params,false,true);
  8682. end;
  8683. procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
  8684. Prop: TPasProperty);
  8685. var
  8686. i: Integer;
  8687. ParamAccess: TResolvedRefAccess;
  8688. begin
  8689. for i:=0 to length(Params.Params)-1 do
  8690. begin
  8691. ParamAccess:=rraRead;
  8692. if i<Prop.Args.Count then
  8693. case TPasArgument(Prop.Args[i]).Access of
  8694. argVar: ParamAccess:=rraVarParam;
  8695. argOut: ParamAccess:=rraOutParam;
  8696. end;
  8697. FinishCallArgAccess(Params.Params[i],ParamAccess);
  8698. end;
  8699. end;
  8700. procedure TPasResolver.FinishCallArgAccess(Expr: TPasExpr;
  8701. Access: TResolvedRefAccess);
  8702. var
  8703. ResolvedEl: TPasResolverResult;
  8704. Flags: TPasResolverComputeFlags;
  8705. begin
  8706. AccessExpr(Expr,Access);
  8707. Flags:=[rcSetReferenceFlags];
  8708. if Access<>rraRead then
  8709. Include(Flags,rcNoImplicitProc);
  8710. ComputeElement(Expr,ResolvedEl,Flags);
  8711. end;
  8712. procedure TPasResolver.FinishInitialFinalization(El: TPasImplBlock);
  8713. begin
  8714. if El=nil then ;
  8715. CheckTopScope(ScopeClass_InitialFinalization);
  8716. PopScope;
  8717. end;
  8718. procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
  8719. begin
  8720. while aType<>nil do
  8721. begin
  8722. if EmitElementHints(PosEl,aType) then
  8723. exit; // give only hints for the nearest
  8724. if aType.InheritsFrom(TPasAliasType) then
  8725. aType:=TPasAliasType(aType).DestType
  8726. else if aType.ClassType=TPasPointerType then
  8727. aType:=TPasPointerType(aType).DestType
  8728. else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
  8729. and (aType.CustomData is TResolvedReference) then
  8730. aType:=TPasType(TResolvedReference(aType.CustomData).Declaration)
  8731. else
  8732. exit;
  8733. end;
  8734. end;
  8735. function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
  8736. begin
  8737. if IsElementSkipped(El) then
  8738. RaiseNotYetImplemented(20170927160030,PosEl,GetObjName(El));
  8739. if El.Hints=[] then exit(false);
  8740. Result:=true;
  8741. if hDeprecated in El.Hints then
  8742. begin
  8743. if El.HintMessage<>'' then
  8744. LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
  8745. [El.Name,El.HintMessage],PosEl)
  8746. else
  8747. LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
  8748. [El.Name],PosEl);
  8749. end;
  8750. if hLibrary in El.Hints then
  8751. LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
  8752. [El.Name],PosEl);
  8753. if hPlatform in El.Hints then
  8754. LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
  8755. [El.Name],PosEl);
  8756. if hExperimental in El.Hints then
  8757. LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
  8758. [El.Name],PosEl);
  8759. if hUnimplemented in El.Hints then
  8760. LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
  8761. [El.Name],PosEl);
  8762. end;
  8763. procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  8764. var
  8765. ModScope: TPasModuleScope;
  8766. begin
  8767. if ppsfIsSpecialized in ProcScope.Flags then exit;
  8768. ProcScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  8769. if bsRangeChecks in ProcScope.BoolSwitches then
  8770. begin
  8771. ModScope:=RootElement.CustomData as TPasModuleScope;
  8772. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  8773. end;
  8774. end;
  8775. procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
  8776. ImplProcScope: TPasProcedureScope);
  8777. var
  8778. DeclProc, ImplProc: TPasProcedure;
  8779. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8780. i, j: Integer;
  8781. DeclArg, ImplArg: TPasArgument;
  8782. Identifier: TPasIdentifier;
  8783. ImplNameParts: TProcedureNameParts;
  8784. ImplNamePart: TProcedureNamePart;
  8785. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8786. FuncType: TPasFunctionType;
  8787. begin
  8788. ImplProc:=ImplProcScope.Element as TPasProcedure;
  8789. DeclProc:=ImplProcScope.DeclarationProc;
  8790. // redirect impl generic template types with declaration types
  8791. ImplNameParts:=ImplProc.NameParts;
  8792. if ImplNameParts<>nil then
  8793. begin
  8794. // For example: "procedure TA<T>.Fly<U>;"
  8795. // The generic type templates (e.g. "T") are in the class
  8796. // -> remove generic type templates from proc scope
  8797. for i:=0 to ImplNameParts.Count-2 do
  8798. begin
  8799. ImplNamePart:=TProcedureNamePart(ImplNameParts[i]);
  8800. ImplTemplates:=ImplNamePart.Templates;
  8801. if ImplTemplates=nil then continue;
  8802. for j:=0 to ImplTemplates.Count-1 do
  8803. begin
  8804. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[j]);
  8805. ImplProcScope.RemoveLocalIdentifier(ImplTemplType);
  8806. end;
  8807. end;
  8808. // redirect implproc parameters to declproc parameters
  8809. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8810. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8811. if ImplTemplates<>nil then
  8812. begin
  8813. if (DeclTemplates=nil) or (ImplTemplates.Count<>DeclTemplates.Count) then
  8814. RaiseNotYetImplemented(20190912153602,ImplProc); // inconsistency
  8815. for i:=0 to ImplTemplates.Count-1 do
  8816. begin
  8817. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8818. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8819. Identifier:=ImplProcScope.FindLocalIdentifier(ImplTemplType.Name);
  8820. if Identifier.Element<>ImplTemplType then
  8821. RaiseInternalError(20190912154009,GetObjName(DeclTemplType)+' '+GetObjName(ImplTemplType));
  8822. Identifier.Element:=DeclTemplType;
  8823. Identifier.Identifier:=DeclTemplType.Name;
  8824. end;
  8825. end
  8826. else if DeclTemplates<>nil then
  8827. // declproc is parametrized, implproc is not
  8828. RaiseNotYetImplemented(20190912153439,ImplProc); // inconsistency
  8829. end;
  8830. // redirect impl arguments to declaration args
  8831. ImplArgs:=ImplProc.ProcType.Args;
  8832. DeclArgs:=DeclProc.ProcType.Args;
  8833. for i:=0 to DeclArgs.Count-1 do
  8834. begin
  8835. DeclArg:=TPasArgument(DeclArgs[i]);
  8836. if i<ImplArgs.Count then
  8837. begin
  8838. ImplArg:=TPasArgument(ImplArgs[i]);
  8839. Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
  8840. //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
  8841. if Identifier.Element<>ImplArg then
  8842. RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
  8843. Identifier.Element:=DeclArg;
  8844. Identifier.Identifier:=DeclArg.Name;
  8845. end
  8846. else
  8847. begin
  8848. // e.g. when Delphi mode omits ImplProc signature
  8849. AddIdentifier(ImplProcScope,DeclArg.Name,DeclArg,pikSimple);
  8850. end;
  8851. end;
  8852. if DeclProc.ProcType is TPasFunctionType then
  8853. begin
  8854. // redirect implementation 'Result' to declaration FuncType.ResultEl
  8855. FuncType:=TPasFunctionType(DeclProc.ProcType);
  8856. if FuncType.ResultEl<>nil then
  8857. begin
  8858. Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
  8859. if Identifier=nil then
  8860. begin
  8861. // e.g. when Delphi mode omits ImplProc signature
  8862. AddIdentifier(ImplProcScope,ResolverResultVar,FuncType.ResultEl,pikSimple);
  8863. end
  8864. else if Identifier.Element is TPasResultElement then
  8865. Identifier.Element:=FuncType.ResultEl;
  8866. end;
  8867. end;
  8868. end;
  8869. function TPasResolver.CreateClassIntfMap(El: TPasClassType; Index: integer
  8870. ): TPasClassIntfMap;
  8871. var
  8872. IntfType: TPasClassType;
  8873. Map: TPasClassIntfMap;
  8874. ClassScope: TPasClassScope;
  8875. begin
  8876. ClassScope:=El.CustomData as TPasClassScope;
  8877. if ClassScope.Interfaces[Index]<>nil then
  8878. RaiseInternalError(20180322141916,GetElementDbgPath(El)+' '+IntToStr(Index)+' '+GetObjName(TObject(ClassScope.Interfaces[Index])));
  8879. IntfType:=TPasClassType(ResolveAliasType(TPasType(El.Interfaces[Index])));
  8880. Map:=nil;
  8881. while IntfType<>nil do
  8882. begin
  8883. if Map=nil then
  8884. begin
  8885. Map:=TPasClassIntfMap.Create;
  8886. Map.Element:=El;
  8887. Result:=Map;
  8888. ClassScope.Interfaces[Index]:=Map;
  8889. end
  8890. else
  8891. begin
  8892. Map.AncestorMap:=TPasClassIntfMap.Create;
  8893. Map:=Map.AncestorMap;
  8894. Map.Element:=El;
  8895. end;
  8896. Map.Intf:=IntfType;
  8897. Map.Procs:=TFPList.Create;
  8898. Map.Procs.Count:=IntfType.Members.Count;
  8899. IntfType:=GetPasClassAncestor(IntfType,true) as TPasClassType;
  8900. end;
  8901. end;
  8902. procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
  8903. const ResolvedEl: TPasResolverResult);
  8904. begin
  8905. if ResolvedEl.BaseType=btBoolean then exit;
  8906. if IsGenericTemplType(ResolvedEl) then exit;
  8907. RaiseXExpectedButYFound(20170216152135,
  8908. BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
  8909. end;
  8910. procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
  8911. ImplProc: TPasProcedure; IsOverride: boolean);
  8912. var
  8913. i: Integer;
  8914. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8915. DeclName, ImplName: String;
  8916. ImplResult, DeclResult: TPasType;
  8917. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8918. NewImplPTMods, DeclPTMods, ImplPTMods: TProcTypeModifiers;
  8919. ptm: TProcTypeModifier;
  8920. NewImplProcMods: TProcedureModifiers;
  8921. pm: TProcedureModifier;
  8922. begin
  8923. if ImplProc.ClassType<>DeclProc.ClassType then
  8924. RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
  8925. DeclArgs:=DeclProc.ProcType.Args;
  8926. ImplArgs:=ImplProc.ProcType.Args;
  8927. if DeclArgs.Count<>ImplArgs.Count then
  8928. RaiseNotYetImplemented(20190912110642,ImplProc);
  8929. DeclPTMods:=DeclProc.ProcType.Modifiers;
  8930. ImplPTMods:=ImplProc.ProcType.Modifiers;
  8931. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8932. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8933. if DeclTemplates<>nil then
  8934. begin
  8935. // DeclProc has templates
  8936. if IsOverride then
  8937. RaiseNotYetImplemented(20190912113857,ImplProc); // inconsistency
  8938. if ImplTemplates=nil then
  8939. RaiseMsg(20190912144529,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8940. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8941. // declaration proc has template type aka is parametrized
  8942. // -> check template types
  8943. if ImplTemplates.Count<>DeclTemplates.Count then
  8944. RaiseMsg(20190912145320,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8945. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplates[0]))],ImplProc);
  8946. for i:=0 to DeclTemplates.Count-1 do
  8947. begin
  8948. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8949. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8950. if not SameText(DeclTemplType.Name,ImplTemplType.Name) then
  8951. RaiseMsg(20190912150311,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8952. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplType))],ImplTemplType);
  8953. if length(ImplTemplType.Constraints)>0 then
  8954. RaiseMsg(20190912150739,nImplMustNotRepeatConstraints,sImplMustNotRepeatConstraints,[],ImplTemplType);
  8955. end;
  8956. end
  8957. else if ImplTemplates<>nil then
  8958. begin
  8959. // ImplProc has templates, DeclProc does not
  8960. RaiseMsg(20190912113857,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8961. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8962. end;
  8963. if not IsOverride then
  8964. begin
  8965. // check argument names
  8966. for i:=0 to DeclArgs.Count-1 do
  8967. begin
  8968. DeclName:=TPasArgument(DeclArgs[i]).Name;
  8969. ImplName:=TPasArgument(ImplArgs[i]).Name;
  8970. if CompareText(DeclName,ImplName)<>0 then
  8971. RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
  8972. sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
  8973. end;
  8974. end;
  8975. if ImplProc.ProcType is TPasFunctionType then
  8976. begin
  8977. // check result type
  8978. ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
  8979. DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
  8980. if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
  8981. RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
  8982. [],DeclResult,ImplResult,ImplProc);
  8983. end;
  8984. // calling convention
  8985. if ImplProc.CallingConvention<>DeclProc.CallingConvention then
  8986. RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
  8987. // modifiers
  8988. if IsOverride then
  8989. begin
  8990. // override/class-intf-impl: calling conventions must match
  8991. NewImplPTMods:=ImplPTMods><DeclPTMods;
  8992. for ptm in NewImplPTMods do
  8993. RaiseMsg(20201227213020,nXModifierMismatchY,sXModifierMismatchY,
  8994. ['procedure type',ProcTypeModifiers[ptm]],ImplProc.ProcType);
  8995. end
  8996. else
  8997. begin
  8998. // implementation proc must not add modifiers, except "assembler"
  8999. NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
  9000. if NewImplProcMods<>[] then
  9001. for pm in NewImplProcMods do
  9002. RaiseMsg(20200518182445,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
  9003. [ModifierNames[pm]],ImplProc.ProcType);
  9004. // implementation proc must not add modifiers
  9005. NewImplPTMods:=ImplPTMods-DeclPTMods;
  9006. if NewImplPTMods<>[] then
  9007. for ptm in NewImplPTMods do
  9008. RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
  9009. [ProcTypeModifiers[ptm]],ImplProc.ProcType);
  9010. end;
  9011. end;
  9012. procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
  9013. var
  9014. i: Integer;
  9015. begin
  9016. if Block=nil then exit;
  9017. for i:=0 to Block.Elements.Count-1 do
  9018. ResolveImplElement(TPasImplElement(Block.Elements[i]));
  9019. end;
  9020. procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
  9021. var
  9022. C: TClass;
  9023. begin
  9024. //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
  9025. if El=nil then exit;
  9026. C:=El.ClassType;
  9027. if C=TPasImplBeginBlock then
  9028. ResolveImplBlock(TPasImplBeginBlock(El))
  9029. else if C=TPasImplAssign then
  9030. ResolveImplAssign(TPasImplAssign(El))
  9031. else if C=TPasImplSimple then
  9032. ResolveImplSimple(TPasImplSimple(El))
  9033. else if C=TPasImplBlock then
  9034. ResolveImplBlock(TPasImplBlock(El))
  9035. else if C=TPasImplRepeatUntil then
  9036. begin
  9037. ResolveImplBlock(TPasImplBlock(El));
  9038. ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
  9039. end
  9040. else if C=TPasImplIfElse then
  9041. begin
  9042. ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
  9043. ResolveImplElement(TPasImplIfElse(El).IfBranch);
  9044. ResolveImplElement(TPasImplIfElse(El).ElseBranch);
  9045. end
  9046. else if C=TPasImplWhileDo then
  9047. begin
  9048. ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
  9049. ResolveImplElement(TPasImplWhileDo(El).Body);
  9050. end
  9051. else if C=TPasImplCaseOf then
  9052. ResolveImplCaseOf(TPasImplCaseOf(El))
  9053. else if C=TPasImplLabelMark then
  9054. ResolveImplLabelMark(TPasImplLabelMark(El))
  9055. else if C=TPasImplForLoop then
  9056. // the header was already resolved
  9057. ResolveImplElement(TPasImplForLoop(El).Body)
  9058. else if C=TPasImplTry then
  9059. begin
  9060. ResolveImplBlock(TPasImplTry(El));
  9061. ResolveImplBlock(TPasImplTry(El).FinallyExcept);
  9062. ResolveImplBlock(TPasImplTry(El).ElseBranch);
  9063. end
  9064. else if C=TPasImplExceptOn then
  9065. // handled in FinishExceptOnStatement
  9066. else if C=TPasImplRaise then
  9067. ResolveImplRaise(TPasImplRaise(El))
  9068. else if C=TPasImplCommand then
  9069. begin
  9070. if TPasImplCommand(El).Command<>'' then
  9071. RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
  9072. end
  9073. else if C=TPasImplAsmStatement then
  9074. ResolveImplAsm(TPasImplAsmStatement(El))
  9075. else if C=TPasImplWithDo then
  9076. ResolveImplWithDo(TPasImplWithDo(El))
  9077. else
  9078. RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
  9079. end;
  9080. procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
  9081. type
  9082. TRangeItem = record
  9083. RangeStart, RangeEnd: TMaxPrecInt;
  9084. Expr: TPasExpr;
  9085. aString: UnicodeString;
  9086. // Note: for case-of-string:
  9087. // single values are stored in aString and RangeStart=1, RangeEnd=0
  9088. // ranges are stored as aString='', RangeStart, RangeEnd
  9089. end;
  9090. PRangeItem = ^TRangeItem;
  9091. function CreateValues(const ResolvedEl: TPasResolverResult;
  9092. var ValueSet: TResEvalSet): boolean;
  9093. var
  9094. CaseExprType: TPasType;
  9095. bt: TResolverBaseType;
  9096. ElTypeResolved: TPasResolverResult;
  9097. begin
  9098. Result:=false;
  9099. bt:=ResolvedEl.BaseType;
  9100. if bt in btAllStrings then
  9101. exit(true)
  9102. else if bt=btRange then
  9103. bt:=ResolvedEl.SubType;
  9104. if bt in btAllInteger then
  9105. begin
  9106. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  9107. Result:=true;
  9108. end
  9109. else if bt in btAllBooleans then
  9110. begin
  9111. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  9112. Result:=true;
  9113. end
  9114. else if bt in btAllChars then
  9115. begin
  9116. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  9117. Result:=true;
  9118. end
  9119. else if bt=btContext then
  9120. begin
  9121. CaseExprType:=ResolvedEl.LoTypeEl;
  9122. if CaseExprType.ClassType=TPasEnumType then
  9123. begin
  9124. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  9125. Result:=true;
  9126. end
  9127. else if CaseExprType.ClassType=TPasRangeType then
  9128. begin
  9129. ComputeElement(TPasRangeType(CaseExprType).RangeExpr.left,ElTypeResolved,[rcConstant]);
  9130. Result:=CreateValues(ElTypeResolved,ValueSet);
  9131. end;
  9132. end;
  9133. end;
  9134. function AddRangeItem(Values: TFPList; const RangeStart, RangeEnd: TMaxPrecInt;
  9135. Expr: TPasExpr): PRangeItem;
  9136. begin
  9137. New(Result);
  9138. Result^.RangeStart:=RangeStart;
  9139. Result^.RangeEnd:=RangeEnd;
  9140. Result^.Expr:=Expr;
  9141. Values.Add(Result);
  9142. end;
  9143. function AddValue(Value: TResEvalValue; Values: TFPList; ValueSet: TResEvalSet;
  9144. Expr: TPasExpr): boolean;
  9145. function AddString(const s: UnicodeString): boolean;
  9146. var
  9147. Dupl: TPasExpr;
  9148. i, o: Integer;
  9149. Item: PRangeItem;
  9150. begin
  9151. if length(s)=1 then
  9152. o:=ord(s[1])
  9153. else
  9154. o:=-1;
  9155. for i:=0 to Values.Count-1 do
  9156. begin
  9157. Item:=PRangeItem(Values[i]);
  9158. if (Item^.aString=s)
  9159. or ((o>=Item^.RangeStart) and (o<=Item^.RangeEnd)) then
  9160. begin
  9161. Dupl:=PRangeItem(Values[i])^.Expr;
  9162. RaiseMsg(20180424220139,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9163. ['string',GetElementSourcePosStr(Dupl)],Expr);
  9164. end;
  9165. end;
  9166. Item:=AddRangeItem(Values,1,0,Expr);
  9167. Item^.aString:=s;
  9168. Result:=true;
  9169. end;
  9170. function AddStringRange(CharStart, CharEnd: TMaxPrecInt): boolean;
  9171. var
  9172. i, o: Integer;
  9173. s: UnicodeString;
  9174. Item: PRangeItem;
  9175. Dupl: TPasExpr;
  9176. begin
  9177. if CharEnd>$ffff then
  9178. RaiseNotYetImplemented(20180501221359,Expr,Value.AsDebugString);
  9179. for i:=0 to Values.Count-1 do
  9180. begin
  9181. Item:=PRangeItem(Values[i]);
  9182. s:=Item^.aString;
  9183. if length(s)=1 then
  9184. o:=ord(s[1])
  9185. else
  9186. o:=-1;
  9187. if ((o>=CharStart) and (o<=CharEnd))
  9188. or ((Item^.RangeStart<=CharEnd) and (Item^.RangeEnd>=CharStart)) then
  9189. begin
  9190. Dupl:=PRangeItem(Values[i])^.Expr;
  9191. RaiseMsg(20180501223914,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9192. ['string',GetElementSourcePosStr(Dupl)],Expr);
  9193. end;
  9194. end;
  9195. AddRangeItem(Values,CharStart,CharEnd,Expr);
  9196. Result:=true;
  9197. end;
  9198. var
  9199. RangeStart, RangeEnd: TMaxPrecInt;
  9200. i: Integer;
  9201. Item: PRangeItem;
  9202. begin
  9203. {$IFDEF VerbosePasResolver}
  9204. //writeln('TPasResolver.ResolveImplCaseOf.AddValue Value={',Value.AsDebugString,'} Values.Count=',Values.Count);
  9205. {$ENDIF}
  9206. Result:=true;
  9207. case Value.Kind of
  9208. revkBool:
  9209. begin
  9210. RangeStart:=ord(TResEvalBool(Value).B);
  9211. RangeEnd:=RangeStart;
  9212. end;
  9213. revkInt:
  9214. begin
  9215. RangeStart:=TResEvalInt(Value).Int;
  9216. RangeEnd:=RangeStart;
  9217. end;
  9218. revkUInt:
  9219. begin
  9220. // Note: when FPC compares int64 with qword it converts the qword to an int64
  9221. if TResEvalUInt(Value).UInt>HighIntAsUInt then
  9222. ExprEvaluator.EmitRangeCheckConst(20180424212414,Value.AsString,
  9223. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  9224. RangeStart:=TResEvalUInt(Value).UInt;
  9225. RangeEnd:=RangeStart;
  9226. end;
  9227. {$ifdef FPC_HAS_CPSTRING}
  9228. revkString:
  9229. if ValueSet=nil then
  9230. exit(AddString(ExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Expr)))
  9231. else
  9232. begin
  9233. RangeStart:=fExprEvaluator.StringToOrd(Value,nil);
  9234. if RangeStart>$ffff then
  9235. exit(false);
  9236. RangeEnd:=RangeStart;
  9237. end;
  9238. {$endif}
  9239. revkUnicodeString:
  9240. if ValueSet=nil then
  9241. exit(AddString(TResEvalUTF16(Value).S))
  9242. else
  9243. begin
  9244. if length(TResEvalUTF16(Value).S)<>1 then
  9245. exit(false);
  9246. RangeStart:=ord(TResEvalUTF16(Value).S[1]);
  9247. RangeEnd:=RangeStart;
  9248. end;
  9249. revkEnum:
  9250. begin
  9251. RangeStart:=TResEvalEnum(Value).Index;
  9252. RangeEnd:=RangeStart;
  9253. end;
  9254. revkRangeInt:
  9255. if ValueSet=nil then
  9256. exit(AddStringRange(TResEvalRangeInt(Value).RangeStart,TResEvalRangeInt(Value).RangeEnd))
  9257. else
  9258. begin
  9259. RangeStart:=TResEvalRangeInt(Value).RangeStart;
  9260. RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
  9261. end;
  9262. revkRangeUInt:
  9263. begin
  9264. // Note: when FPC compares int64 with qword it converts the qword to an int64
  9265. if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
  9266. ExprEvaluator.EmitRangeCheckConst(20180424212648,Value.AsString,
  9267. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  9268. RangeStart:=TResEvalRangeUInt(Value).RangeStart;
  9269. RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
  9270. end;
  9271. else
  9272. Result:=false;
  9273. end;
  9274. if ValueSet=nil then
  9275. RaiseNotYetImplemented(20180424215728,Expr,Value.AsDebugString);
  9276. i:=ValueSet.Intersects(RangeStart,RangeEnd);
  9277. if i<0 then
  9278. begin
  9279. ValueSet.Add(RangeStart,RangeEnd);
  9280. AddRangeItem(Values,RangeStart,RangeEnd,Expr);
  9281. exit(true);
  9282. end;
  9283. // duplicate value -> show where
  9284. for i:=0 to Values.Count-1 do
  9285. begin
  9286. Item:=PRangeItem(Values[i]);
  9287. if (Item^.RangeStart>RangeEnd) or (Item^.RangeEnd<RangeStart) then continue;
  9288. RaiseMsg(20180424214305,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9289. [Value.AsString,GetElementSourcePosStr(Item^.Expr)],Expr);
  9290. end;
  9291. Result:=false;
  9292. end;
  9293. var
  9294. i, j: Integer;
  9295. El: TPasElement;
  9296. Stat: TPasImplCaseStatement;
  9297. CaseExprResolved, OfExprResolved: TPasResolverResult;
  9298. OfExpr: TPasExpr;
  9299. ok: Boolean;
  9300. Values: TFPList; // list of PRangeItem
  9301. ValueSet: TResEvalSet;
  9302. Value: TResEvalValue;
  9303. Item: PRangeItem;
  9304. begin
  9305. ResolveExpr(CaseOf.CaseExpr,rraRead);
  9306. ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
  9307. ok:=false;
  9308. Values:=TFPList.Create;
  9309. ValueSet:=nil;
  9310. Value:=nil;
  9311. try
  9312. if (rrfReadable in CaseExprResolved.Flags) then
  9313. ok:=CreateValues(CaseExprResolved,ValueSet);
  9314. if not ok then
  9315. begin
  9316. if not IsGenericTemplType(CaseExprResolved) then
  9317. RaiseXExpectedButYFound(20170216151952,'ordinal expression',
  9318. GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
  9319. end;
  9320. for i:=0 to CaseOf.Elements.Count-1 do
  9321. begin
  9322. El:=TPasElement(CaseOf.Elements[i]);
  9323. if El.ClassType=TPasImplCaseStatement then
  9324. begin
  9325. Stat:=TPasImplCaseStatement(El);
  9326. for j:=0 to Stat.Expressions.Count-1 do
  9327. begin
  9328. //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
  9329. OfExpr:=TPasExpr(Stat.Expressions[j]);
  9330. ResolveExpr(OfExpr,rraRead);
  9331. ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
  9332. if OfExprResolved.BaseType=btRange then
  9333. ConvertRangeToElement(OfExprResolved);
  9334. if not ok then
  9335. continue;
  9336. CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
  9337. Value:=Eval(OfExpr,[refConstExt]);
  9338. if Value<>nil then
  9339. begin
  9340. if Value.Kind=revkExternal then
  9341. begin
  9342. // external const
  9343. end
  9344. else if not AddValue(Value,Values,ValueSet,OfExpr) then
  9345. RaiseIncompatibleTypeRes(20180424210815,nIncompatibleTypesGotExpected,
  9346. [],OfExprResolved,CaseExprResolved,OfExpr);
  9347. ReleaseEvalValue(Value);
  9348. end
  9349. else
  9350. RaiseMsg(20180518102047,nConstantExpressionExpected,sConstantExpressionExpected,[],OfExpr);
  9351. end;
  9352. ResolveImplElement(Stat.Body);
  9353. end
  9354. else if El.ClassType=TPasImplCaseElse then
  9355. ResolveImplBlock(TPasImplCaseElse(El))
  9356. else
  9357. RaiseNotYetImplemented(20160922163448,El);
  9358. end;
  9359. // Note: CaseOf.ElseBranch was already resolved via Elements
  9360. finally
  9361. ReleaseEvalValue(Value);
  9362. ValueSet.Free;
  9363. for i:=0 to Values.Count-1 do
  9364. begin
  9365. Item:=PRangeItem(Values[i]);
  9366. Dispose(Item);
  9367. end;
  9368. Values.Free;
  9369. end;
  9370. end;
  9371. procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
  9372. begin
  9373. RaiseNotYetImplemented(20161014141636,Mark);
  9374. end;
  9375. procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
  9376. // Note: the expressions were already resolved during parsing
  9377. // and the scopes were already stored in a TPasWithScope.
  9378. // -> simply push them onto the scope stack
  9379. var
  9380. i: Integer;
  9381. WithScope: TPasWithScope;
  9382. ExprScope: TPasWithExprScope;
  9383. begin
  9384. if not (El.CustomData is TPasWithScope) then
  9385. RaiseInternalError(20181210175349);
  9386. WithScope:=TPasWithScope(El.CustomData);
  9387. PushScope(WithScope);
  9388. for i:=0 to WithScope.ExpressionScopes.Count-1 do
  9389. begin
  9390. ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
  9391. PushScope(ExprScope);
  9392. end;
  9393. ResolveImplElement(El.Body);
  9394. PopWithScope(El);
  9395. end;
  9396. procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  9397. begin
  9398. if El=nil then ;
  9399. end;
  9400. procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
  9401. var
  9402. LeftResolved, RightResolved: TPasResolverResult;
  9403. Flags: TPasResolverComputeFlags;
  9404. Access: TResolvedRefAccess;
  9405. Value: TResEvalValue;
  9406. begin
  9407. if El.Kind=akDefault then
  9408. Access:=rraAssign
  9409. else
  9410. Access:=rraReadAndAssign;
  9411. ResolveExpr(El.left,Access);
  9412. {$IFDEF VerbosePasResolver}
  9413. writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
  9414. {$ENDIF}
  9415. // check LHS can be assigned
  9416. ComputeElement(El.left,LeftResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  9417. CheckCanBeLHS(LeftResolved,true,GetRightMostExpr(El.left));
  9418. // compute RHS
  9419. ResolveExpr(El.right,rraRead);
  9420. Flags:=[rcSetReferenceFlags];
  9421. if IsProcedureType(LeftResolved,true) then
  9422. begin
  9423. if (msDelphi in CurrentParser.CurrentModeswitches) then
  9424. Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
  9425. else
  9426. Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
  9427. end;
  9428. {$IFDEF VerbosePasResolver}
  9429. writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
  9430. {$ENDIF}
  9431. ComputeElement(El.right,RightResolved,Flags);
  9432. {$IFDEF VerbosePasResolver}
  9433. writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
  9434. {$ENDIF}
  9435. case El.Kind of
  9436. akDefault:
  9437. begin
  9438. CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
  9439. CheckAssignExprRange(LeftResolved,El.right);
  9440. if (LeftResolved.BaseType=btContext) and (LeftResolved.LoTypeEl.ClassType=TPasArrayType) then
  9441. MarkArrayExprRecursive(El.right,TPasArrayType(LeftResolved.LoTypeEl));
  9442. end;
  9443. akAdd, akMinus,akMul,akDivision:
  9444. begin
  9445. if (LeftResolved.BaseType in btAllInteger) and (El.Kind in [akAdd,akMinus,akMul]) then
  9446. begin
  9447. if (not (rrfReadable in RightResolved.Flags))
  9448. or not (RightResolved.BaseType in btAllInteger) then
  9449. RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9450. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9451. end
  9452. else if (LeftResolved.BaseType in btAllStrings) and (El.Kind=akAdd) then
  9453. begin
  9454. if (not (rrfReadable in RightResolved.Flags))
  9455. or not (RightResolved.BaseType in btAllStringAndChars) then
  9456. RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9457. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9458. end
  9459. else if (LeftResolved.BaseType in btAllFloats)
  9460. and (El.Kind in [akAdd,akMinus,akMul,akDivision]) then
  9461. begin
  9462. if (not (rrfReadable in RightResolved.Flags))
  9463. or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  9464. RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9465. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9466. end
  9467. else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
  9468. begin
  9469. if (not (rrfReadable in RightResolved.Flags))
  9470. or not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  9471. RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9472. [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9473. if (LeftResolved.SubType=RightResolved.SubType)
  9474. or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
  9475. or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
  9476. then
  9477. else
  9478. RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9479. ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9480. end
  9481. else if LeftResolved.BaseType=btContext then
  9482. begin
  9483. if (LeftResolved.LoTypeEl.ClassType=TPasArrayType) and (El.Kind=akAdd)
  9484. and (rrfReadable in RightResolved.Flags)
  9485. and IsDynArray(LeftResolved.LoTypeEl) then
  9486. begin
  9487. // DynArr+=...
  9488. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,El,true);
  9489. exit;
  9490. end
  9491. else
  9492. RaiseIncompatibleTypeRes(20180615235749,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9493. end
  9494. else
  9495. RaiseIncompatibleTypeRes(20180208115707,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9496. // store const expression result
  9497. Value:=Eval(El.right,[]);
  9498. ReleaseEvalValue(Value);
  9499. end;
  9500. else
  9501. RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
  9502. end;
  9503. end;
  9504. procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
  9505. var
  9506. ExprResolved: TPasResolverResult;
  9507. Expr: TPasExpr;
  9508. begin
  9509. Expr:=El.expr;
  9510. ResolveExpr(Expr,rraRead);
  9511. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  9512. if (rrfCanBeStatement in ExprResolved.Flags) then
  9513. exit;
  9514. {$IFDEF VerbosePasResolver}
  9515. writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  9516. {$ENDIF}
  9517. RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
  9518. end;
  9519. procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
  9520. var
  9521. ResolvedEl: TPasResolverResult;
  9522. begin
  9523. if El.ExceptObject<>nil then
  9524. begin
  9525. ResolveExpr(El.ExceptObject,rraRead);
  9526. ComputeElement(El.ExceptObject,ResolvedEl,[rcSetReferenceFlags]);
  9527. CheckIsClass(El.ExceptObject,ResolvedEl);
  9528. if ResolvedEl.IdentEl<>nil then
  9529. begin
  9530. if (ResolvedEl.IdentEl is TPasVariable)
  9531. or (ResolvedEl.IdentEl is TPasArgument)
  9532. or (ResolvedEl.IdentEl is TPasResultElement) then
  9533. else
  9534. begin
  9535. {$IFDEF VerbosePasResolver}
  9536. writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
  9537. {$ENDIF}
  9538. RaiseXExpectedButYFound(20170216152133,
  9539. 'variable',GetElementTypeName(ResolvedEl.IdentEl),El.ExceptObject);
  9540. end;
  9541. end
  9542. else if ResolvedEl.ExprEl<>nil then
  9543. else
  9544. RaiseXExpectedButYFound(201702303145230,
  9545. 'variable',GetResolverResultDbg(ResolvedEl),El.ExceptObject);
  9546. if not (rrfReadable in ResolvedEl.Flags) then
  9547. RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
  9548. end;
  9549. if El.ExceptAddr<>nil then
  9550. ResolveExpr(El.ExceptAddr,rraRead);
  9551. end;
  9552. procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
  9553. var
  9554. Primitive: TPrimitiveExpr;
  9555. ElClass: TClass;
  9556. begin
  9557. {$IFDEF VerbosePasResolver}
  9558. writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
  9559. {$ENDIF}
  9560. if El=nil then
  9561. RaiseNotYetImplemented(20160922163453,El);
  9562. ElClass:=El.ClassType;
  9563. if ElClass=TPrimitiveExpr then
  9564. begin
  9565. Primitive:=TPrimitiveExpr(El);
  9566. case Primitive.Kind of
  9567. pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
  9568. pekNumber: ;
  9569. pekString: ;
  9570. pekNil,pekBoolConst: ;
  9571. else
  9572. RaiseNotYetImplemented(20160922163451,El);
  9573. end;
  9574. end
  9575. else if ElClass=TUnaryExpr then
  9576. ResolveExpr(TUnaryExpr(El).Operand,Access)
  9577. else if ElClass=TBinaryExpr then
  9578. ResolveBinaryExpr(TBinaryExpr(El),Access)
  9579. else if ElClass=TParamsExpr then
  9580. ResolveParamsExpr(TParamsExpr(El),Access)
  9581. else if ElClass=TBoolConstExpr then
  9582. else if ElClass=TNilExpr then
  9583. else if ElClass=TInheritedExpr then
  9584. ResolveInherited(TInheritedExpr(El),Access)
  9585. else if ElClass=TArrayValues then
  9586. begin
  9587. if Access<>rraRead then
  9588. RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9589. [],El);
  9590. ResolveArrayValues(TArrayValues(El));
  9591. end
  9592. else if ElClass=TRecordValues then
  9593. begin
  9594. if Access<>rraRead then
  9595. RaiseMsg(20180429103024,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9596. [],El);
  9597. ResolveRecordValues(TRecordValues(El));
  9598. end
  9599. else if ElClass=TProcedureExpr then
  9600. // resolved by FinishScope(stProcedure)
  9601. else if ElClass=TInlineSpecializeExpr then
  9602. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(El),Access)
  9603. else
  9604. RaiseNotYetImplemented(20170222184329,El);
  9605. if El.format1<>nil then
  9606. ResolveExpr(El.format1,rraRead);
  9607. if El.format2<>nil then
  9608. ResolveExpr(El.format2,rraRead);
  9609. end;
  9610. procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
  9611. var
  9612. ResolvedCond: TPasResolverResult;
  9613. begin
  9614. ResolveExpr(El,rraRead);
  9615. ComputeElement(El,ResolvedCond,[rcSetReferenceFlags]);
  9616. CheckConditionExpr(El,ResolvedCond);
  9617. end;
  9618. procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
  9619. Access: TResolvedRefAccess);
  9620. var
  9621. FindData: TPRFindData;
  9622. DeclEl: TPasElement;
  9623. Proc, ImplProc: TPasProcedure;
  9624. Ref: TResolvedReference;
  9625. BuiltInProc: TResElDataBuiltInProc;
  9626. p: SizeInt;
  9627. DottedName: String;
  9628. Bin: TBinaryExpr;
  9629. ProcScope: TPasProcedureScope;
  9630. ParentParams: TPRParentParams;
  9631. TypeCnt: Integer;
  9632. InlParams, TemplTypes: TFPList;
  9633. begin
  9634. {$IFDEF VerbosePasResolver}
  9635. writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
  9636. {$ENDIF}
  9637. GetParamsOfNameExpr(El,ParentParams);
  9638. if ParentParams.InlineSpec<>nil then
  9639. InlParams:=ParentParams.InlineSpec.Params
  9640. else
  9641. InlParams:=nil;
  9642. //writeln('TPasResolver.ResolveNameExpr Inline=',GetObjName(ParentParams.InlineSpec),' Params=',GetObjName(ParentParams.Params),' ',GetObjPath(El));
  9643. if ParentParams.Params<>nil then
  9644. begin
  9645. case ParentParams.Params.Kind of
  9646. pekFuncParams:
  9647. ResolveFuncParamsExprName(El,InlParams,ParentParams.Params,Access);
  9648. pekArrayParams:
  9649. ResolveArrayParamsExprName(El,ParentParams.Params,Access);
  9650. else
  9651. RaiseNotYetImplemented(20190912190428,El,GetObjPath(ParentParams.Params));
  9652. end;
  9653. exit;
  9654. end;
  9655. if ParentParams.InlineSpec<>nil then
  9656. begin
  9657. TypeCnt:=InlParams.Count;
  9658. DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
  9659. if DeclEl<>nil then
  9660. begin
  9661. // GenType<params> -> create specialize type/proc
  9662. DeclEl:=GetSpecializedEl(ParentParams.InlineSpec,DeclEl,InlParams);
  9663. end
  9664. else
  9665. RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El);
  9666. end
  9667. else
  9668. DeclEl:=FindElementWithoutParams(aName,FindData,El,false,false);
  9669. if DeclEl.ClassType=TPasUsesUnit then
  9670. begin
  9671. // the first name of a unit matches -> find unit with longest match
  9672. FindLongestUnitName(DeclEl,El);
  9673. FindData.Found:=DeclEl;
  9674. end;
  9675. Ref:=CreateReference(DeclEl,El,Access,@FindData);
  9676. CheckFoundElement(FindData,Ref);
  9677. if DeclEl is TPasProcedure then
  9678. begin
  9679. // identifier is a proc and args brackets are missing
  9680. Proc:=TPasProcedure(DeclEl);
  9681. if ParentParams.InlineSpec=nil then
  9682. begin
  9683. TemplTypes:=GetProcTemplateTypes(Proc);
  9684. if (TemplTypes<>nil) then
  9685. begin
  9686. // implicit function specialization without bracket
  9687. {$IFDEF VerbosePasResolver}
  9688. DeclEl:=El;
  9689. while DeclEl.Parent is TPasExpr do
  9690. DeclEl:=DeclEl.Parent;
  9691. {AllowWriteln}
  9692. writeln('TPasResolver.ResolveNameExpr ',WritePasElTree(TPasExpr(DeclEl),' '));
  9693. {AllowWriteln-}
  9694. {$ENDIF}
  9695. RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
  9696. sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
  9697. end;
  9698. end;
  9699. if El.Parent.ClassType=TPasProperty then
  9700. // a property accessor does not need args -> ok
  9701. // Note: the detailed tests are in FinishProperty
  9702. else
  9703. begin
  9704. // examples: funca or @proca or a.funca or @a.funca ...
  9705. if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
  9706. and (El.ClassType=TPrimitiveExpr)
  9707. and (El.Parent.ClassType=TPasImplAssign)
  9708. and (TPasImplAssign(El.Parent).left=El) then
  9709. begin
  9710. // e.g. funcname:=
  9711. ProcScope:=Proc.CustomData as TPasProcedureScope;
  9712. ImplProc:=ProcScope.ImplProc;
  9713. if ImplProc=nil then
  9714. ImplProc:=Proc;
  9715. if El.HasParent(ImplProc) then
  9716. begin
  9717. // "FuncA:=" within FuncA -> redirect to ResultEl
  9718. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  9719. exit;
  9720. end;
  9721. end;
  9722. if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
  9723. begin
  9724. {$IFDEF VerbosePasResolver}
  9725. writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El));
  9726. {$ENDIF}
  9727. RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
  9728. sWrongNumberOfParametersForCallTo,[Proc.Name],El);
  9729. end;
  9730. end;
  9731. end
  9732. else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  9733. begin
  9734. if DeclEl.CustomData is TResElDataBuiltInProc then
  9735. begin
  9736. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  9737. BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
  9738. end;
  9739. end
  9740. else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
  9741. begin
  9742. // unit reference
  9743. // dotted unit name needs a ref for each expression identifier
  9744. // Note: El is the first TPrimitiveExpr of the dotted unit name reference
  9745. DottedName:=DeclEl.Name;
  9746. repeat
  9747. p:=Pos('.',DottedName);
  9748. if p<1 then break;
  9749. Delete(DottedName,1,p);
  9750. El:=GetNextDottedExpr(El);
  9751. if El=nil then
  9752. RaiseInternalError(20170503002012);
  9753. CreateReference(DeclEl,El,Access);
  9754. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
  9755. begin
  9756. Bin:=TBinaryExpr(El.Parent);
  9757. while Bin.OpCode=eopSubIdent do
  9758. begin
  9759. CreateReference(DeclEl,Bin,Access);
  9760. if not (Bin.Parent is TBinaryExpr) then break;
  9761. if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
  9762. Bin:=TBinaryExpr(Bin.Parent);
  9763. end;
  9764. end;
  9765. until false;
  9766. end;
  9767. end;
  9768. procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
  9769. Access: TResolvedRefAccess);
  9770. var
  9771. SelfScope: TPasProcedureScope;
  9772. AncestorScope: TPasClassScope;
  9773. ClassRecScope: TPasClassOrRecordScope;
  9774. DeclProc, AncestorProc: TPasProcedure;
  9775. aClass: TPasClassType;
  9776. HelperForType: TPasType;
  9777. InhScope: TPasInheritedScope;
  9778. begin
  9779. {$IFDEF VerbosePasResolver}
  9780. writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
  9781. {$ENDIF}
  9782. if (El.Parent.ClassType=TBinaryExpr)
  9783. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  9784. begin
  9785. // e.g. 'inherited Proc;'
  9786. ResolveInheritedName(TBinaryExpr(El.Parent),Access);
  9787. exit;
  9788. end;
  9789. // 'inherited;' without expression
  9790. SelfScope:=GetCurrentSelfScope(El);
  9791. if SelfScope=nil then
  9792. RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9793. DeclProc:=SelfScope.DeclarationProc;
  9794. if DeclProc=nil then
  9795. RaiseNotYetImplemented(20190121172251,El);
  9796. ClassRecScope:=SelfScope.ClassRecScope;
  9797. if not (ClassRecScope is TPasClassScope) then
  9798. begin
  9799. // inherited in record method
  9800. RaiseMsg(20181218194022,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9801. ['inherited'],El);
  9802. end;
  9803. AncestorProc:=nil;
  9804. // inherited in class/interface/helper method
  9805. aClass:=ClassRecScope.Element as TPasClassType;
  9806. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9807. //writeln('TPasResolver.ResolveInherited aClass=',GetObjName(aClass),' HelperForType=',GetObjName(HelperForType));
  9808. if HelperForType is TPasMembersType then
  9809. begin
  9810. // inherited; inside helper -> skip helper ancestors and search in HelperForType
  9811. if msDelphi in CurrentParser.CurrentModeswitches then
  9812. begin
  9813. // Delphi skips ancestors and HelperForType
  9814. if not (HelperForType is TPasClassType) then
  9815. // 'inherited;' without ancestor class is silently ignored
  9816. exit;
  9817. AncestorScope:=TPasClassScope(HelperForType.CustomData).AncestorScope;
  9818. if AncestorScope=nil then
  9819. // 'inherited;' without ancestor class is silently ignored
  9820. exit;
  9821. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9822. end
  9823. else
  9824. begin
  9825. // ObjFPC searches first in HelperForType and its ancestors, then in
  9826. // own ancestors
  9827. AncestorScope:=TPasClassScope(aClass.CustomData).AncestorScope;
  9828. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9829. AncestorScope);
  9830. end;
  9831. end
  9832. else
  9833. begin
  9834. // inherited; inside class/interface method
  9835. // -> search in ancestor and its helper(s)
  9836. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9837. if AncestorScope=nil then
  9838. // 'inherited;' without ancestor class is silently ignored
  9839. exit;
  9840. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9841. end;
  9842. AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
  9843. PopScope;
  9844. if AncestorProc=nil then
  9845. // 'inherited;' without ancestor DeclProc is silently ignored
  9846. exit;
  9847. if not (AncestorProc.Parent is TPasMembersType) then
  9848. RaiseNotYetImplemented(20190121181234,El); // inconsistency
  9849. CreateReference(AncestorProc,El,Access);
  9850. if AncestorProc.IsAbstract then
  9851. RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
  9852. sAbstractMethodsCannotBeCalledDirectly,[],El);
  9853. end;
  9854. procedure TPasResolver.ResolveInheritedName(El: TBinaryExpr;
  9855. Access: TResolvedRefAccess);
  9856. // El.OpCode=eopNone
  9857. // El.left is TInheritedExpr
  9858. // El.right is the identifier and/or paramexpr
  9859. var
  9860. SelfScope: TPasProcedureScope;
  9861. ClassRecScope: TPasClassOrRecordScope;
  9862. AncestorClass, aClass: TPasClassType;
  9863. HelperForType: TPasType;
  9864. OnlyTypeMembers: Boolean;
  9865. Proc: TPasProcedure;
  9866. AncestorScope: TPasClassScope;
  9867. InhScope: TPasInheritedScope;
  9868. begin
  9869. {$IFDEF VerbosePasResolver}
  9870. writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El),' Access=',Access);
  9871. {$ENDIF}
  9872. SelfScope:=GetCurrentSelfScope(El);
  9873. if SelfScope=nil then
  9874. RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9875. ClassRecScope:=SelfScope.ClassRecScope;
  9876. if not (ClassRecScope is TPasClassScope) then
  9877. // inherited in a method of a record
  9878. RaiseMsg(20181218194436,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9879. ['inherited'],El);
  9880. Proc:=TPasProcedure(SelfScope.Element);
  9881. OnlyTypeMembers:=IsClassMethod(Proc);
  9882. // inherited in a method of a class/interface/helper
  9883. aClass:=TPasClassType(ClassRecScope.Element);
  9884. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9885. if aClass.ObjKind in okAllHelpers then
  9886. begin
  9887. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9888. if HelperForType is TPasMembersType then
  9889. begin
  9890. // record helper(ancestor) for aRecord
  9891. // or class helper(ancestor) for aClass
  9892. // -> search in helperfortype, then in ancestors
  9893. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9894. AncestorScope);
  9895. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9896. ResolveExpr(El.right,Access);
  9897. PopScope;
  9898. exit;
  9899. end
  9900. else
  9901. begin
  9902. // type helper(ancestortype) for simpletype -> search in ancestortype
  9903. end;
  9904. end
  9905. else
  9906. begin
  9907. // class or interface -> search in ancestor and its helpers
  9908. end;
  9909. // search in ancestor and its helpers
  9910. if AncestorScope=nil then
  9911. RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
  9912. // search call in ancestor
  9913. AncestorClass:=TPasClassType(AncestorScope.Element);
  9914. InhScope:=PushInheritedScope(AncestorClass,true,nil);
  9915. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9916. ResolveExpr(El.right,Access);
  9917. PopScope;
  9918. end;
  9919. procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
  9920. Access: TResolvedRefAccess);
  9921. begin
  9922. {$IFDEF VerbosePasResolver}
  9923. //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
  9924. {$ENDIF}
  9925. case El.OpCode of
  9926. eopNone:
  9927. case El.Kind of
  9928. pekRange:
  9929. begin
  9930. ResolveExpr(El.left,rraRead);
  9931. if El.right=nil then exit;
  9932. ResolveExpr(El.right,rraRead);
  9933. end;
  9934. else
  9935. if El.left.ClassType=TInheritedExpr then
  9936. begin
  9937. ResolveExpr(El.left,Access);
  9938. end
  9939. else
  9940. begin
  9941. {$IFDEF VerbosePasResolver}
  9942. writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
  9943. {$ENDIF}
  9944. RaiseNotYetImplemented(20160922163456,El);
  9945. end;
  9946. end;
  9947. eopAdd,
  9948. eopSubtract,
  9949. eopMultiply,
  9950. eopDivide,
  9951. eopDiv,
  9952. eopMod,
  9953. eopPower,
  9954. eopShr,
  9955. eopShl,
  9956. eopNot,
  9957. eopAnd,
  9958. eopOr,
  9959. eopXor,
  9960. eopEqual,
  9961. eopNotEqual,
  9962. eopLessThan,
  9963. eopGreaterThan,
  9964. eopLessthanEqual,
  9965. eopGreaterThanEqual,
  9966. eopIn,
  9967. eopIs,
  9968. eopAs,
  9969. eopSymmetricaldifference:
  9970. begin
  9971. ResolveExpr(El.left,rraRead);
  9972. if El.right=nil then exit;
  9973. ResolveExpr(El.right,rraRead);
  9974. end;
  9975. eopSubIdent:
  9976. begin
  9977. ResolveExpr(El.left,rraRead);
  9978. if El.right=nil then exit;
  9979. ResolveSubIdent(El,Access);
  9980. end;
  9981. else
  9982. RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
  9983. end;
  9984. end;
  9985. procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
  9986. Access: TResolvedRefAccess);
  9987. procedure ResolveRight; inline;
  9988. begin
  9989. ResolveExpr(El.right,Access);
  9990. PopScope;
  9991. end;
  9992. function SearchInTypeHelpers(HiType: TPasType; IdentEl: TPasElement): boolean;
  9993. var
  9994. DotScope: TPasDotBaseScope;
  9995. begin
  9996. if HiType=nil then exit(false);
  9997. DotScope:=PushHelperDotScope(HiType);
  9998. if DotScope=nil then exit(false);
  9999. if IdentEl is TPasType then
  10000. // e.g. TFlag.HelperProc
  10001. DotScope.OnlyTypeMembers:=true;
  10002. ResolveRight;
  10003. Result:=true;
  10004. end;
  10005. var
  10006. aModule: TPasModule;
  10007. ClassEl: TPasClassType;
  10008. ClassScope: TPasDotClassScope;
  10009. LeftResolved: TPasResolverResult;
  10010. Left: TPasExpr;
  10011. RecordEl: TPasRecordType;
  10012. RecordScope: TPasDotClassOrRecordScope;
  10013. LLoTypeEl, LHiTypeEl: TPasType;
  10014. DotScope: TPasDotBaseScope;
  10015. SetType: TPasSetType;
  10016. begin
  10017. if El.CustomData is TResolvedReference then
  10018. exit; // for example, when a.b has a dotted unit name
  10019. Left:=El.left;
  10020. //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
  10021. ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
  10022. if LeftResolved.BaseType=btModule then
  10023. begin
  10024. // e.g. unitname.identifier
  10025. // => search in interface and if this is our module in the implementation
  10026. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  10027. PushModuleDotScope(aModule);
  10028. ResolveRight;
  10029. exit;
  10030. end
  10031. else if LeftResolved.LoTypeEl=nil then
  10032. begin
  10033. // illegal qualifier, see below
  10034. end
  10035. else
  10036. begin
  10037. LHiTypeEl:=LeftResolved.HiTypeEl;
  10038. LLoTypeEl:=LeftResolved.LoTypeEl;
  10039. if (LLoTypeEl.ClassType=TPasPointerType)
  10040. and ElHasModeSwitch(El,msAutoDeref)
  10041. and (rrfReadable in LeftResolved.Flags)
  10042. then
  10043. begin
  10044. // a.b -> a^.b
  10045. LHiTypeEl:=TPasPointerType(LLoTypeEl).DestType;
  10046. LLoTypeEl:=ResolveAliasType(LHiTypeEl);
  10047. Include(LeftResolved.Flags,rrfWritable);
  10048. end;
  10049. //writeln('TPasResolver.ResolveSubIdent ',GetObjPath(El),' ',GetObjPath(LLoTypeEl));
  10050. if LLoTypeEl.ClassType=TPasClassType then
  10051. begin
  10052. ClassEl:=TPasClassType(LLoTypeEl);
  10053. if ClassEl.HelperForType<>nil then
  10054. RaiseHelpersCannotBeUsedAsType(20190123093438,El);
  10055. ClassScope:=PushClassDotScope(ClassEl);
  10056. if LeftResolved.IdentEl is TPasType then
  10057. // e.g. TFPMemoryImage.FindHandlerFromExtension()
  10058. ClassScope.OnlyTypeMembers:=true
  10059. else
  10060. // e.g. Image.Width
  10061. ClassScope.OnlyTypeMembers:=false;
  10062. ResolveRight;
  10063. exit;
  10064. end
  10065. else if LLoTypeEl.ClassType=TPasClassOfType then
  10066. begin
  10067. // e.g. ImageClass.FindHandlerFromExtension()
  10068. ClassEl:=ResolveAliasType(TPasClassOfType(LLoTypeEl).DestType) as TPasClassType;
  10069. ClassScope:=PushClassDotScope(ClassEl);
  10070. ClassScope.OnlyTypeMembers:=true;
  10071. ClassScope.IsClassOf:=true;
  10072. ResolveRight;
  10073. exit;
  10074. end
  10075. else if LLoTypeEl.ClassType=TPasRecordType then
  10076. begin
  10077. RecordEl:=TPasRecordType(LLoTypeEl);
  10078. RecordScope:=PushRecordDotScope(RecordEl);
  10079. RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
  10080. if LeftResolved.IdentEl is TPasType then
  10081. // e.g. TPoint.PointInCircle
  10082. RecordScope.OnlyTypeMembers:=true
  10083. else
  10084. begin
  10085. // e.g. aPoint.X
  10086. AccessExpr(El.left,Access);
  10087. RecordScope.OnlyTypeMembers:=false;
  10088. end;
  10089. ResolveRight;
  10090. exit;
  10091. end
  10092. else if LLoTypeEl.ClassType=TPasEnumType then
  10093. begin
  10094. if (LeftResolved.IdentEl is TPasType)
  10095. and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
  10096. begin
  10097. // e.g. TShiftState.ssAlt
  10098. DotScope:=PushEnumDotScope(LHiTypeEl,TPasEnumType(LLoTypeEl));
  10099. DotScope.OnlyTypeMembers:=true;
  10100. ResolveRight;
  10101. exit;
  10102. end;
  10103. end
  10104. else if LLoTypeEl.ClassType=TPasGenericTemplateType then
  10105. begin
  10106. DotScope:=PushTemplateDotScope(TPasGenericTemplateType(LLoTypeEl),El);
  10107. if DotScope<>nil then
  10108. begin
  10109. if LeftResolved.IdentEl is TPasType then
  10110. // e.g. T.Member
  10111. DotScope.OnlyTypeMembers:=true
  10112. else
  10113. // e.g. VarOfTypeT.Member
  10114. DotScope.OnlyTypeMembers:=false;
  10115. ResolveRight;
  10116. exit;
  10117. end;
  10118. end;
  10119. // default: search for type helpers
  10120. if (LeftResolved.BaseType in btAllIntrinsicTypes)
  10121. or (LeftResolved.BaseType=btContext)
  10122. or (LeftResolved.BaseType=btCustom) then
  10123. begin
  10124. if SearchInTypeHelpers(LeftResolved.HiTypeEl,LeftResolved.IdentEl) then exit;
  10125. end
  10126. else if LeftResolved.BaseType=btSet then
  10127. begin
  10128. SetType:=GetSetType(LeftResolved);
  10129. if SearchInTypeHelpers(SetType,LeftResolved.IdentEl) then exit;
  10130. end;
  10131. end;
  10132. {$IFDEF VerbosePasResolver}
  10133. writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
  10134. {$ENDIF}
  10135. RaiseMsg(20170216152157,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10136. ['.',GetResolverResultDescription(LeftResolved)],El);
  10137. end;
  10138. procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
  10139. Access: TResolvedRefAccess);
  10140. begin
  10141. if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
  10142. begin
  10143. {$IFDEF VerbosePasResolver}
  10144. writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
  10145. {$ENDIF}
  10146. RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10147. end;
  10148. // first resolve params
  10149. ResolveParamsExprParams(Params);
  10150. // then resolve the call, typecast, array, set
  10151. if (Params.Kind=pekFuncParams) then
  10152. ResolveFuncParamsExpr(Params,Access)
  10153. else if (Params.Kind=pekArrayParams) then
  10154. ResolveArrayParamsExpr(Params,Access)
  10155. else if (Params.Kind=pekSet) then
  10156. ResolveSetParamsExpr(Params)
  10157. else
  10158. RaiseNotYetImplemented(20160922163501,Params);
  10159. end;
  10160. procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
  10161. var
  10162. ScopeDepth, i: integer;
  10163. ParamAccess: TResolvedRefAccess;
  10164. Pars: TPasExprArray;
  10165. begin
  10166. ScopeDepth:=StashSubExprScopes;
  10167. if Params.Kind in [pekFuncParams,pekArrayParams] then
  10168. ParamAccess:=rraParamToUnknownProc
  10169. else
  10170. ParamAccess:=rraRead;
  10171. Pars:=Params.Params;
  10172. for i:=0 to length(Pars)-1 do
  10173. ResolveExpr(Pars[i],ParamAccess);
  10174. RestoreStashedScopes(ScopeDepth);
  10175. end;
  10176. procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
  10177. Access: TResolvedRefAccess);
  10178. var
  10179. Value: TPasExpr;
  10180. SubParams: TParamsExpr;
  10181. ResolvedEl: TPasResolverResult;
  10182. begin
  10183. Value:=Params.Value;
  10184. if Value is TBinaryExpr then
  10185. begin
  10186. // Note: a.b() is the same as (a.b)()
  10187. // Note: a.b().c is stored as
  10188. // TBinaryExpr eopSubIdent
  10189. // / \
  10190. // left = TParamsExpr right = TPrimitiveExpr 'c'
  10191. // Value = TBinaryExpr
  10192. // / \
  10193. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  10194. if (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) then
  10195. Value:=TBinaryExpr(Value).right;
  10196. if IsNameExpr(Value) then
  10197. begin
  10198. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10199. if not (Value.CustomData is TResolvedReference) then
  10200. RaiseNotYetImplemented(20190115140557,Params);
  10201. // already resolved
  10202. exit;
  10203. end
  10204. else if Value.ClassType=TInlineSpecializeExpr then
  10205. begin
  10206. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10207. // already resolved
  10208. exit;
  10209. end;
  10210. // ToDo: (a+b)()
  10211. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  10212. RaiseNotYetImplemented(20190115140809,Params);
  10213. end
  10214. else if IsNameExpr(Value) then
  10215. ResolveFuncParamsExprName(Value,nil,Params,Access)
  10216. else if Value.ClassType=TInlineSpecializeExpr then
  10217. begin
  10218. // e.g. Name<>()
  10219. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),Access);
  10220. end
  10221. else if Value.ClassType=TParamsExpr then
  10222. begin
  10223. SubParams:=TParamsExpr(Value);
  10224. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  10225. begin
  10226. // e.g. Name()() or Name[]()
  10227. ResolveParamsExpr(SubParams,rraRead);
  10228. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10229. if IsProcedureType(ResolvedEl,true) then
  10230. begin
  10231. CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
  10232. FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
  10233. exit;
  10234. end
  10235. end;
  10236. RaiseMsg(20170216152202,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10237. ['(',SubParams.ElementTypeName],Params);
  10238. end
  10239. else
  10240. RaiseNotYetImplemented(20161014085118,Params.Value);
  10241. end;
  10242. procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
  10243. TemplParams: TFPList; Params: TParamsExpr; Access: TResolvedRefAccess;
  10244. CallName: string);
  10245. procedure RaiseMultiFit;
  10246. var
  10247. FindCallData: TFindCallElData;
  10248. Msg: String;
  10249. i: Integer;
  10250. El: TPasElement;
  10251. Abort: boolean;
  10252. begin
  10253. FindCallData:=Default(TFindCallElData);
  10254. FindCallData.Params:=Params;
  10255. FindCallData.List:=TFPList.Create;
  10256. try
  10257. Abort:=false;
  10258. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  10259. Msg:='';
  10260. for i:=0 to FindCallData.List.Count-1 do
  10261. begin
  10262. El:=TPasElement(FindCallData.List[i]);
  10263. {$IFDEF VerbosePasResolver}
  10264. writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
  10265. {$ENDIF}
  10266. // emit a hint for each candidate
  10267. if El is TPasProcedure then
  10268. LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
  10269. [GetProcTypeDescription(TPasProcedure(El).ProcType,
  10270. [prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
  10271. Msg:=Msg+', '+GetElementSourcePosStr(El);
  10272. end;
  10273. finally
  10274. FindCallData.List.Free;
  10275. end;
  10276. RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
  10277. sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
  10278. end;
  10279. procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
  10280. var
  10281. i: Integer;
  10282. begin
  10283. if ParamAccess=rraParamToUnknownProc then exit;
  10284. for i:=0 to length(Params.Params)-1 do
  10285. FinishCallArgAccess(Params.Params[i],ParamAccess);
  10286. end;
  10287. procedure CheckTemplParams(GenTemplates, TemplParams: TFPList);
  10288. var
  10289. i: Integer;
  10290. Param, PosEl: TPasElement;
  10291. ResolvedEl: TPasResolverResult;
  10292. begin
  10293. for i:=0 to TemplParams.Count-1 do
  10294. begin
  10295. Param:=TPasElement(TemplParams[i]);
  10296. ComputeElement(Param,ResolvedEl,[rcType]);
  10297. if Param is TPasExpr then
  10298. PosEl:=Param
  10299. else
  10300. PosEl:=Params;
  10301. if CheckTemplateFitsParamRes(TPasGenericTemplateType(GenTemplates[i]),
  10302. ResolvedEl,prtcoAssignToTempl,PosEl)=cIncompatible then
  10303. // should have raise error
  10304. RaiseNotYetImplemented(20190919095604,PosEl,GetResolverResultDbg(ResolvedEl));
  10305. end;
  10306. end;
  10307. procedure CheckIncompatibleProc(const CallName: string;
  10308. FoundProcType: TPasProcedureType; TemplParamsCnt: integer);
  10309. var
  10310. FoundTemplCnt: Integer;
  10311. aName: String;
  10312. begin
  10313. CheckCallProcCompatibility(FoundProcType,Params,true);
  10314. if FoundProcType.GenericTemplateTypes<>nil then
  10315. FoundTemplCnt:=FoundProcType.GenericTemplateTypes.Count
  10316. else
  10317. FoundTemplCnt:=0;
  10318. if TemplParamsCnt<>FoundTemplCnt then
  10319. begin
  10320. if FoundProcType.Parent is TPasProcedure then
  10321. aName:=FoundProcType.Parent.Name
  10322. else
  10323. aName:=FoundProcType.Name;
  10324. if aName='' then
  10325. aName:=GetObjPath(FoundProcType);
  10326. RaiseMsg(20201101205447,nXExpectedButYFound,sXExpectedButYFound,
  10327. [aName,CallName+GetGenericParamCommas(TemplParamsCnt)],Params);
  10328. end;
  10329. end;
  10330. var
  10331. FindCallData: TFindCallElData;
  10332. Abort: boolean;
  10333. FoundEl: TPasElement;
  10334. Ref: TResolvedReference;
  10335. FindData: TPRFindData;
  10336. BuiltInProc: TResElDataBuiltInProc;
  10337. ResolvedEl: TPasResolverResult;
  10338. TypeEl: TPasType;
  10339. C: TClass;
  10340. TemplParamsCnt: Integer;
  10341. GenTemplates, InferenceParams: TFPList;
  10342. begin
  10343. // e.g. Name() -> find compatible
  10344. {$IFDEF VerbosePasResolver}
  10345. //writeln('TPasResolver.ResolveFuncParamsExprName NameExpr=',GetObjName(NameExpr),' TemplParams=',TemplParams<>nil,' CallName="',CallName,'"');
  10346. {$ENDIF}
  10347. if CallName<>'' then
  10348. else if NameExpr.ClassType=TPrimitiveExpr then
  10349. CallName:=TPrimitiveExpr(NameExpr).Value
  10350. else
  10351. RaiseNotYetImplemented(20190115143539,NameExpr);
  10352. FindCallData:=Default(TFindCallElData);
  10353. FindCallData.Params:=Params;
  10354. if TemplParams<>nil then
  10355. begin
  10356. TemplParamsCnt:=TemplParams.Count;
  10357. FindCallData.TemplCnt:=TemplParamsCnt;
  10358. end
  10359. else
  10360. TemplParamsCnt:=0;
  10361. Abort:=false;
  10362. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  10363. FoundEl:=FindCallData.Found;
  10364. if FoundEl=nil then
  10365. RaiseIdentifierNotFound(20170216152544,CallName,NameExpr);
  10366. if FindCallData.Distance=cIncompatible then
  10367. begin
  10368. // FoundEl one element, but it was incompatible => raise error
  10369. {$IFDEF VerbosePasResolver}
  10370. writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
  10371. WriteScopes;
  10372. {$ENDIF}
  10373. if FoundEl is TPasProcedure then
  10374. CheckIncompatibleProc(CallName,TPasProcedure(FoundEl).ProcType,TemplParamsCnt)
  10375. else if FoundEl is TPasProcedureType then
  10376. CheckTypeCast(TPasProcedureType(FoundEl),Params,true)
  10377. else if FoundEl.ClassType=TPasUnresolvedSymbolRef then
  10378. begin
  10379. if FoundEl.CustomData is TResElDataBuiltInProc then
  10380. begin
  10381. BuiltInProc:=TResElDataBuiltInProc(FoundEl.CustomData);
  10382. BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
  10383. RaiseNotYetImplemented(20200525124749,FoundEl,'missing exception, Found=['+BuiltInProc.Signature+']');
  10384. end
  10385. else if FoundEl.CustomData is TResElDataBaseType then
  10386. CheckTypeCast(TPasUnresolvedSymbolRef(FoundEl),Params,true)
  10387. else
  10388. RaiseNotYetImplemented(20161006132825,FoundEl);
  10389. end
  10390. else if FoundEl is TPasType then
  10391. // Note: check TPasType after TPasUnresolvedSymbolRef
  10392. CheckTypeCast(TPasType(FoundEl),Params,true)
  10393. else if FoundEl is TPasVariable then
  10394. begin
  10395. TypeEl:=ResolveAliasType(TPasVariable(FoundEl).VarType);
  10396. if TypeEl is TPasProcedureType then
  10397. CheckIncompatibleProc(CallName,TPasProcedureType(TypeEl),TemplParamsCnt)
  10398. else
  10399. RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10400. ['(',TypeEl.ElementTypeName],Params);
  10401. end
  10402. else if FoundEl is TPasArgument then
  10403. begin
  10404. TypeEl:=ResolveAliasType(TPasArgument(FoundEl).ArgType);
  10405. if TypeEl is TPasProcedureType then
  10406. CheckIncompatibleProc(CallName,TPasProcedureType(TypeEl),TemplParamsCnt)
  10407. else
  10408. RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10409. ['(',TypeEl.ElementTypeName],Params);
  10410. end
  10411. else
  10412. RaiseNotYetImplemented(20161003134755,FoundEl);
  10413. // missing raise exception
  10414. RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FoundEl));
  10415. end;
  10416. if FindCallData.Count>1 then
  10417. begin
  10418. // multiple overloads fit
  10419. if (FoundEl is TPasProcedure)
  10420. and (IndexOfGenericParam(Params.Params)>=0) then
  10421. // generic params -> ignore ambiguity
  10422. else
  10423. // => search again and list the candidates
  10424. RaiseMultiFit;
  10425. end;
  10426. // check template params
  10427. if FoundEl is TPasProcedure then
  10428. GenTemplates:=GetProcTemplateTypes(TPasProcedure(FoundEl))
  10429. else if FoundEl is TPasGenericType then
  10430. GenTemplates:=TPasGenericType(FoundEl).GenericTemplateTypes
  10431. else
  10432. GenTemplates:=nil;
  10433. if TemplParamsCnt>0 then
  10434. begin
  10435. // check template types
  10436. if GenTemplates=nil then
  10437. RaiseMsg(20190919100922,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  10438. [FoundEl.Name],NameExpr);
  10439. if TemplParamsCnt<>GenTemplates.Count then
  10440. RaiseMsg(20190919101051,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10441. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10442. CheckTemplParams(GenTemplates,TemplParams);
  10443. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
  10444. if FoundEl is TPasProcedure then
  10445. begin
  10446. // check if params fit the explicit specialized function, e.g. Run<Word>()
  10447. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
  10448. end;
  10449. end
  10450. else if (GenTemplates<>nil) and (GenTemplates.Count>0) then
  10451. begin
  10452. if (FoundEl is TPasProcedure)
  10453. and (msImplicitFunctionSpec in CurrentParser.CurrentModeswitches) then
  10454. begin
  10455. // GenericProc() -> create template types by inference
  10456. InferenceParams:=CreateInferenceTypesForCall(Params,TPasProcedure(FoundEl));
  10457. try
  10458. CheckTemplParams(GenTemplates,InferenceParams);
  10459. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
  10460. // check if params fit the implicit specialized function, e.g. Run()
  10461. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
  10462. finally
  10463. ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
  10464. FreeAndNil(InferenceParams);
  10465. end;
  10466. end
  10467. else
  10468. // GenericType() -> missing type params
  10469. RaiseMsg(20190919120728,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10470. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10471. end;
  10472. if FoundEl is TPasType then
  10473. begin
  10474. // typecast
  10475. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  10476. C:=TypeEl.ClassType;
  10477. if C=TPasUnresolvedSymbolRef then
  10478. begin
  10479. // typecast to built-in type
  10480. if TypeEl.CustomData is TResElDataBaseType then
  10481. CheckTypeCast(TypeEl,Params,true); // emit warnings
  10482. end
  10483. else
  10484. begin
  10485. // typecast to user type
  10486. CheckTypeCast(TypeEl,Params,true); // emit warnings, and errors for specializations
  10487. end;
  10488. end;
  10489. // FoundEl compatible element -> create reference
  10490. Ref:=CreateReference(FoundEl,NameExpr,rraRead);
  10491. if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
  10492. Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
  10493. FindData:=Default(TPRFindData);
  10494. FindData.ErrorPosEl:=NameExpr;
  10495. FindData.StartScope:=FindCallData.StartScope;
  10496. FindData.ElScope:=FindCallData.ElScope;
  10497. FindData.Found:=FoundEl;
  10498. CheckFoundElement(FindData,Ref);
  10499. // set param expression Access flags
  10500. if FoundEl is TPasProcedure then
  10501. begin
  10502. // now it is known which overloaded proc to call
  10503. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10504. begin
  10505. {$IFDEF VerbosePasResolver}
  10506. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10507. {$ENDIF}
  10508. RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10509. end;
  10510. FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
  10511. end
  10512. else if FoundEl is TPasType then
  10513. begin
  10514. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  10515. C:=TypeEl.ClassType;
  10516. if (C=TPasClassType)
  10517. or (C=TPasClassOfType)
  10518. or (C=TPasRecordType)
  10519. or (C=TPasEnumType)
  10520. or (C=TPasSetType)
  10521. or (C=TPasPointerType)
  10522. or (C=TPasArrayType)
  10523. or (C=TPasRangeType)
  10524. or (C=TPasGenericTemplateType) then
  10525. begin
  10526. // type cast
  10527. FinishUntypedParams(Access);
  10528. end
  10529. else if (C=TPasProcedureType)
  10530. or (C=TPasFunctionType) then
  10531. begin
  10532. // type cast to proc type
  10533. AccessExpr(Params.Params[0],Access);
  10534. end
  10535. else if C=TPasUnresolvedSymbolRef then
  10536. begin
  10537. if TypeEl.CustomData is TResElDataBuiltInProc then
  10538. begin
  10539. // call built-in proc
  10540. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  10541. if Assigned(BuiltInProc.FinishParamsExpression) then
  10542. BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
  10543. else
  10544. FinishUntypedParams(rraRead);
  10545. end
  10546. else if TypeEl.CustomData is TResElDataBaseType then
  10547. begin
  10548. // type cast to base type
  10549. FinishUntypedParams(Access);
  10550. end
  10551. else
  10552. begin
  10553. {$IFDEF VerbosePasResolver}
  10554. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10555. {$ENDIF}
  10556. RaiseNotYetImplemented(20170325145720,Params);
  10557. end;
  10558. end
  10559. else
  10560. begin
  10561. {$IFDEF VerbosePasResolver}
  10562. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10563. {$ENDIF}
  10564. RaiseMsg(20170306121908,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10565. ['(',TypeEl.ElementTypeName],Params);
  10566. end;
  10567. end
  10568. else
  10569. begin
  10570. // FoundEl is not a type, maybe a var
  10571. ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10572. TypeEl:=ResolvedEl.LoTypeEl;
  10573. if TypeEl is TPasProcedureType then
  10574. begin
  10575. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10576. begin
  10577. {$IFDEF VerbosePasResolver}
  10578. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10579. {$ENDIF}
  10580. RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10581. end;
  10582. FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
  10583. exit;
  10584. end;
  10585. {$IFDEF VerbosePasResolver}
  10586. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
  10587. {$ENDIF}
  10588. RaiseMsg(20170306104301,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10589. ['(',TypeEl.ElementTypeName],Params);
  10590. end;
  10591. end;
  10592. procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
  10593. Access: TResolvedRefAccess);
  10594. var
  10595. ResolvedEl: TPasResolverResult;
  10596. Value: TPasExpr;
  10597. SubParams: TParamsExpr;
  10598. begin
  10599. Value:=Params.Value;
  10600. if Value=nil then
  10601. RaiseInternalError(20180423093120,GetObjName(Params));
  10602. if IsNameExpr(Value) then
  10603. begin
  10604. // e.g. Name[]
  10605. ResolveArrayParamsExprName(Value,Params,Access);
  10606. exit;
  10607. end
  10608. else if Value.ClassType=TParamsExpr then
  10609. begin
  10610. SubParams:=TParamsExpr(Value);
  10611. // e.g. Name()[] or Name[][] or [][]
  10612. ResolveExpr(SubParams,rraRead);
  10613. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10614. if Value.CustomData=nil then
  10615. CreateReference(ResolvedEl.LoTypeEl,Value,Access);
  10616. ResolvedEl.IdentEl:=nil;
  10617. end
  10618. else if Value.InheritsFrom(TUnaryExpr) then
  10619. begin
  10620. ResolveExpr(TUnaryExpr(Value).Operand,Access);
  10621. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  10622. end
  10623. else if Value is TBinaryExpr then
  10624. begin
  10625. // Note: a.b[] is the same as (a.b)[]
  10626. // Note: a.b[].c is stored as
  10627. // TBinaryExpr eopSubIdent
  10628. // / \
  10629. // left = TParamsExpr right = TPrimitiveExpr 'c'
  10630. // Value = TBinaryExpr
  10631. // / \
  10632. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  10633. while (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) do
  10634. Value:=TBinaryExpr(Value).right;
  10635. if IsNameExpr(Value) then
  10636. begin
  10637. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10638. if not (Value.CustomData is TResolvedReference) then
  10639. RaiseNotYetImplemented(20190115144534,Params);
  10640. // already resolved via ResolveNameExpr, which calls ResolveArrayParamsExprName
  10641. exit;
  10642. end
  10643. else
  10644. begin
  10645. // For example (a+b)[] or (a as b)[]
  10646. Value:=Params.Value;
  10647. ResolveBinaryExpr(TBinaryExpr(Value),rraRead);
  10648. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  10649. end;
  10650. end
  10651. else
  10652. RaiseNotYetImplemented(20160927212610,Value);
  10653. {$IFDEF VerbosePasResolver}
  10654. writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
  10655. {$ENDIF}
  10656. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10657. end;
  10658. procedure TPasResolver.ResolveArrayParamsExprName(NameExpr: TPasExpr;
  10659. Params: TParamsExpr; Access: TResolvedRefAccess);
  10660. // e.g. a.NameExpr[]
  10661. var
  10662. ArrayName: String;
  10663. FindData: TPRFindData;
  10664. Ref: TResolvedReference;
  10665. DeclEl: TPasElement;
  10666. Proc, ImplProc: TPasProcedure;
  10667. ProcScope: TPasProcedureScope;
  10668. ResolvedEl: TPasResolverResult;
  10669. begin
  10670. if (NameExpr.ClassType=TPrimitiveExpr)
  10671. and (TPrimitiveExpr(NameExpr).Kind=pekIdent) then
  10672. // e.g. Name[]
  10673. ArrayName:=TPrimitiveExpr(NameExpr).Value
  10674. else if NameExpr.ClassType=TInlineSpecializeExpr then
  10675. RaiseMsg(20190912190518,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10676. ['[','inline specialize'],Params)
  10677. else
  10678. RaiseNotYetImplemented(20190131154557,NameExpr);
  10679. DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true,true);
  10680. Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData);
  10681. CheckFoundElement(FindData,Ref);
  10682. if DeclEl is TPasProcedure then
  10683. begin
  10684. Proc:=TPasProcedure(DeclEl);
  10685. if (Access=rraAssign)
  10686. and (Proc.ProcType is TPasFunctionType)
  10687. and (Params.Parent.ClassType=TPasImplAssign)
  10688. and (TPasImplAssign(Params.Parent).left=Params) then
  10689. begin
  10690. // e.g. funcname[]:=
  10691. ProcScope:=Proc.CustomData as TPasProcedureScope;
  10692. ImplProc:=ProcScope.ImplProc;
  10693. if ImplProc=nil then
  10694. ImplProc:=Proc;
  10695. if Params.HasParent(ImplProc) then
  10696. begin
  10697. // "FuncA[]:=" within FuncA -> redirect to ResultEl
  10698. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  10699. end;
  10700. end;
  10701. end;
  10702. ComputeElement(NameExpr,ResolvedEl,[rcSetReferenceFlags]);
  10703. {$IFDEF VerbosePasResolver}
  10704. writeln('TPasResolver.ResolveArrayParamsExprName NameExp=',GetObjName(NameExpr),' ',GetResolverResultDbg(ResolvedEl));
  10705. {$ENDIF}
  10706. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10707. end;
  10708. procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
  10709. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
  10710. procedure ReadAccessParamValue;
  10711. var
  10712. Left: TPasExpr;
  10713. Ref: TResolvedReference;
  10714. begin
  10715. if Access=rraAssign then
  10716. begin
  10717. // ArrayStringPointer[]:=
  10718. // -> writing the element needs reading the value
  10719. Left:=Params.Value;
  10720. if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode=eopSubIdent) then
  10721. Left:=TBinaryExpr(Left).right;
  10722. if Left.CustomData is TResolvedReference then
  10723. begin
  10724. Ref:=TResolvedReference(Left.CustomData);
  10725. if Ref.Access=rraAssign then
  10726. Ref.Access:=rraReadAndAssign;
  10727. end;
  10728. end;
  10729. end;
  10730. function CheckStringOrPointerIndex(IsStringIndex: boolean): boolean;
  10731. var
  10732. ArgExp: TPasExpr;
  10733. ResolvedArg: TPasResolverResult;
  10734. begin
  10735. ReadAccessParamValue;
  10736. if not IsStringIndex then
  10737. begin
  10738. // pointer
  10739. if not ElHasBoolSwitch(Params,bsPointerMath) then
  10740. exit(false);
  10741. end;
  10742. Result:=true;
  10743. if not (rrfReadable in ResolvedValue.Flags) then
  10744. RaiseXExpectedButYFound(20170216152548,'index',GetElementTypeName(ResolvedValue.LoTypeEl),Params);
  10745. // check single argument
  10746. if length(Params.Params)<1 then
  10747. RaiseMsg(20170216152204,nMissingParameterX,
  10748. sMissingParameterX,[BoolToStr(IsStringIndex,'character index','index')],Params)
  10749. else if length(Params.Params)>1 then
  10750. RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
  10751. // check argument is integer
  10752. ArgExp:=Params.Params[0];
  10753. ComputeElement(ArgExp,ResolvedArg,[rcSetReferenceFlags]);
  10754. if not (ResolvedArg.BaseType in btAllInteger) then
  10755. RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10756. [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
  10757. if not (rrfReadable in ResolvedArg.Flags) then
  10758. RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10759. ['type','value'],ArgExp);
  10760. AccessExpr(ArgExp,rraRead);
  10761. end;
  10762. var
  10763. PropEl: TPasProperty;
  10764. i: Integer;
  10765. TypeEl: TPasType;
  10766. C: TClass;
  10767. begin
  10768. if ResolvedValue.BaseType in btAllStrings then
  10769. begin
  10770. // string -> check that ResolvedValue is not merely a type, but has a value
  10771. if CheckStringOrPointerIndex(true) then
  10772. exit;
  10773. end
  10774. else if (ResolvedValue.IdentEl is TPasProperty)
  10775. and (GetPasPropertyArgs(TPasProperty(ResolvedValue.IdentEl)).Count>0) then
  10776. begin
  10777. PropEl:=TPasProperty(ResolvedValue.IdentEl);
  10778. CheckCallPropertyCompatibility(PropEl,Params,true);
  10779. FinishPropertyParamAccess(Params,PropEl);
  10780. exit;
  10781. end
  10782. else if ResolvedValue.BaseType=btPointer then
  10783. begin
  10784. if CheckStringOrPointerIndex(false) then
  10785. exit;
  10786. end
  10787. else if ResolvedValue.BaseType=btContext then
  10788. begin
  10789. TypeEl:=ResolvedValue.LoTypeEl;
  10790. C:=TypeEl.ClassType;
  10791. if (C=TPasClassType)
  10792. or (C=TPasRecordType)
  10793. or (C=TPasClassOfType) then
  10794. begin
  10795. if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,Access) then
  10796. exit;
  10797. end
  10798. else if C=TPasArrayType then
  10799. begin
  10800. if ResolvedValue.IdentEl is TPasType then
  10801. RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10802. ['[',ResolvedValue.IdentEl.ElementTypeName],Params);
  10803. ReadAccessParamValue;
  10804. CheckCallArrayCompatibility(TPasArrayType(TypeEl),Params,true,true);
  10805. for i:=0 to length(Params.Params)-1 do
  10806. AccessExpr(Params.Params[i],rraRead);
  10807. exit;
  10808. end
  10809. else if C=TPasPointerType then
  10810. begin
  10811. if CheckStringOrPointerIndex(false) then exit;
  10812. end;
  10813. end;
  10814. RaiseMsg(20170216152217,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10815. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10816. end;
  10817. function TPasResolver.ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  10818. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess): boolean;
  10819. var
  10820. PropEl: TPasProperty;
  10821. Value: TPasExpr;
  10822. Group: TPasGroupScope;
  10823. i: Integer;
  10824. Scope: TPasIdentifierScope;
  10825. HiType, LoType: TPasType;
  10826. IsClassOf: Boolean;
  10827. begin
  10828. HiType:=ResolvedValue.HiTypeEl;
  10829. LoType:=ResolvedValue.LoTypeEl;
  10830. IsClassOf:=LoType.ClassType=TPasClassOfType;
  10831. if IsClassOf then
  10832. begin
  10833. HiType:=TPasClassOfType(LoType).DestType;
  10834. LoType:=ResolveAliasType(LoType);
  10835. end;
  10836. Group:=CreateGroupScope(HiType);
  10837. PropEl:=nil;
  10838. for i:=0 to Group.Count-1 do
  10839. begin
  10840. Scope:=Group.Scopes[i];
  10841. if Scope is TPasClassOrRecordScope then
  10842. begin
  10843. PropEl:=TPasClassOrRecordScope(Scope).DefaultProperty;
  10844. if PropEl<>nil then break;
  10845. end;
  10846. end;
  10847. Group.Free;
  10848. if PropEl=nil then exit(false);
  10849. // class/record/interface has default property
  10850. if (IsClassOf or (ResolvedValue.IdentEl is TPasType)) and (not PropEl.IsClass) then
  10851. RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10852. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10853. Value:=Params.Value;
  10854. if Value.CustomData is TResolvedReference then
  10855. SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
  10856. CreateReference(PropEl,Params,Access);
  10857. CheckCallPropertyCompatibility(PropEl,Params,true);
  10858. FinishPropertyParamAccess(Params,PropEl);
  10859. Result:=true;
  10860. end;
  10861. procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
  10862. // e.g. resolving '[1,2..3]'
  10863. var
  10864. i: Integer;
  10865. Param: TPasExpr;
  10866. ParamResolved: TPasResolverResult;
  10867. begin
  10868. {$IFDEF VerbosePasResolver}
  10869. writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
  10870. {$ENDIF}
  10871. if Params.Value<>nil then
  10872. RaiseNotYetImplemented(20160930135910,Params);
  10873. for i:=0 to length(Params.Params)-1 do
  10874. begin
  10875. Param:=Params.Params[i];
  10876. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType,rcSetReferenceFlags]);
  10877. end;
  10878. end;
  10879. procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
  10880. var
  10881. i: Integer;
  10882. begin
  10883. for i:=0 to length(El.Values)-1 do
  10884. ResolveExpr(El.Values[i],rraRead);
  10885. end;
  10886. procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
  10887. function GetMember(RecType: TPasRecordType; const aName: string): TPasElement;
  10888. var
  10889. i: Integer;
  10890. begin
  10891. for i:=0 to RecType.Members.Count-1 do
  10892. begin
  10893. Result:=TPasElement(RecType.Members[i]);
  10894. if SameText(Result.Name,aName) then
  10895. exit;
  10896. end;
  10897. if RecType.VariantEl is TPasVariable then
  10898. begin
  10899. Result:=TPasVariable(RecType.VariantEl);
  10900. if SameText(Result.Name,aName) then
  10901. exit;
  10902. end;
  10903. if RecType.Variants<>nil then
  10904. for i:=0 to RecType.Variants.Count-1 do
  10905. begin
  10906. Result:=GetMember(TPasVariant(RecType.Variants[i]).Members,aName);
  10907. if Result<>nil then
  10908. exit;
  10909. end;
  10910. Result:=nil;
  10911. end;
  10912. var
  10913. i, j: Integer;
  10914. Member: TPasElement;
  10915. RecType: TPasRecordType;
  10916. Field: PRecordValuesItem;
  10917. s: String;
  10918. ResolvedEl: TPasResolverResult;
  10919. begin
  10920. {$IFDEF VerbosePasResolver}
  10921. writeln('TPasResolver.ResolveRecordValues ',El.Fields[0].Name,' ',GetObjName(El.Parent),' ',GetObjName(El.Parent.Parent));
  10922. {$ENDIF}
  10923. ComputeElement(El,ResolvedEl,[]);
  10924. if (ResolvedEl.BaseType<>btContext)
  10925. or (ResolvedEl.LoTypeEl.ClassType<>TPasRecordType) then
  10926. begin
  10927. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  10928. [],'record value',GetTypeDescription(ResolvedEl),El);
  10929. end;
  10930. RecType:=TPasRecordType(ResolvedEl.LoTypeEl);
  10931. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(El.Parent),' ',GetObjName(RecType));
  10932. for i:=0 to length(El.Fields)-1 do
  10933. begin
  10934. Field:[email protected][i];
  10935. // check member exists
  10936. Member:=GetMember(RecType,Field^.Name);
  10937. if Member=nil then
  10938. RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
  10939. if Member.ClassType<>TPasVariable then
  10940. RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10941. [],Field^.ValueExp);
  10942. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10943. RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10944. ['record assignment'],Field^.ValueExp);
  10945. CreateReference(Member,Field^.NameExp,rraAssign);
  10946. // check duplicates
  10947. for j:=0 to i-1 do
  10948. if SameText(Field^.Name,El.Fields[j].Name) then
  10949. RaiseMsg(20180429104942,nDuplicateIdentifier,sDuplicateIdentifier,
  10950. [Field^.Name,GetElementSourcePosStr(El.Fields[j].NameExp)],Field^.NameExp);
  10951. // resolve expression
  10952. ResolveExpr(El.Fields[i].ValueExp,rraRead);
  10953. // check compatible
  10954. CheckAssignCompatibility(Member,Field^.ValueExp);
  10955. end;
  10956. // hint for missing fields
  10957. s:='';
  10958. for i:=0 to RecType.Members.Count-1 do
  10959. begin
  10960. Member:=TPasElement(RecType.Members[i]);
  10961. if Member.ClassType<>TPasVariable then continue;
  10962. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10963. continue;
  10964. j:=length(El.Fields)-1;
  10965. while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
  10966. dec(j);
  10967. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(Member),' ',j);
  10968. if j<0 then
  10969. begin
  10970. if s<>'' then s:=s+', ';
  10971. if length(s)>30 then
  10972. begin
  10973. s:=s+'...';
  10974. break;
  10975. end;
  10976. s:=s+Member.Name;
  10977. end;
  10978. end;
  10979. // ToDo: hint for missing variants
  10980. if s<>'' then
  10981. LogMsg(20180429121127,mtHint,nMissingFieldsX,sMissingFieldsX,[s],El);
  10982. end;
  10983. procedure TPasResolver.ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr;
  10984. Access: TResolvedRefAccess);
  10985. begin
  10986. // params are TPasTypes and already resolved
  10987. if El.Params.Count=0 then
  10988. RaiseMsg(20190916155014,nMissingParameterX,sMissingParameterX,['type'],El);
  10989. // resolve name
  10990. // Note: ResolveNameExpr considers the params
  10991. ResolveExpr(El.NameExpr,Access);
  10992. end;
  10993. function TPasResolver.ResolveAccessor(Expr: TPasExpr): TPasElement;
  10994. function SubResolvePrimitive(Prim: TPrimitiveExpr): TPasElement;
  10995. var
  10996. FindData: TPRFindData;
  10997. Ref: TResolvedReference;
  10998. Scope: TPasScope;
  10999. Abort: boolean;
  11000. begin
  11001. if Prim.Kind<>pekIdent then
  11002. RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
  11003. // search in class and ancestors, not in unit interface
  11004. Scope:=TopScope;
  11005. FindData:=Default(TPRFindData);
  11006. FindData.ErrorPosEl:=Expr;
  11007. Abort:=false;
  11008. Scope.IterateElements(Prim.Value,Scope,@OnFindFirst,@FindData,Abort);
  11009. Result:=FindData.Found;
  11010. if Result=nil then
  11011. RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
  11012. Ref:=CreateReference(Result,Prim,rraRead);
  11013. CheckFoundElementVisibility(FindData,Ref);
  11014. end;
  11015. var
  11016. Prim: TPrimitiveExpr;
  11017. DeclEl: TPasElement;
  11018. begin
  11019. if Expr.ClassType=TBinaryExpr then
  11020. begin
  11021. DeclEl:=nil;
  11022. if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
  11023. begin
  11024. Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
  11025. DeclEl:=SubResolvePrimitive(Prim);
  11026. if not (DeclEl is TPasMembersType) then
  11027. RaiseXExpectedButYFound(20170216151752,'class',GetElementTypeName(DeclEl),Prim);
  11028. end
  11029. else
  11030. RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  11031. if TBinaryExpr(Expr).OpCode<>eopSubIdent then
  11032. RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  11033. if DeclEl.ClassType=TPasClassType then
  11034. PushClassDotScope(TPasClassType(DeclEl))
  11035. else if DeclEl.ClassType=TPasRecordType then
  11036. PushRecordDotScope(TPasRecordType(DeclEl))
  11037. else
  11038. RaiseMsg(20190123145559,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  11039. Expr:=TBinaryExpr(Expr).right;
  11040. Result:=ResolveAccessor(Expr);
  11041. PopScope;
  11042. end
  11043. else if Expr.ClassType=TPrimitiveExpr then
  11044. begin
  11045. Prim:=TPrimitiveExpr(Expr);
  11046. Result:=SubResolvePrimitive(Prim);
  11047. end
  11048. else
  11049. RaiseNotYetImplemented(20160922163436,Expr);
  11050. end;
  11051. procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
  11052. Ref: TResolvedReference; Access: TResolvedRefAccess);
  11053. begin
  11054. if (Ref.Access=Access) then exit;
  11055. if Access in [rraNone,rraParamToUnknownProc] then
  11056. exit;
  11057. if Expr=nil then ;
  11058. case Ref.Access of
  11059. rraNone,rraParamToUnknownProc:
  11060. Ref.Access:=Access;
  11061. rraRead:
  11062. if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
  11063. Ref.Access:=rraReadAndAssign
  11064. else
  11065. exit;
  11066. rraAssign,rraOutParam:
  11067. if Access in [rraRead,rraReadAndAssign,rraVarParam] then
  11068. Ref.Access:=rraReadAndAssign
  11069. else
  11070. exit;
  11071. rraReadAndAssign: exit;
  11072. rraVarParam: exit;
  11073. else
  11074. RaiseInternalError(20170403163727);
  11075. end;
  11076. end;
  11077. procedure TPasResolver.AccessExpr(Expr: TPasExpr;
  11078. Access: TResolvedRefAccess);
  11079. // called after a call target was found, called for each element
  11080. // to change the rraParamToUnknownProc value to Access
  11081. var
  11082. Ref: TResolvedReference;
  11083. Bin: TBinaryExpr;
  11084. Params: TParamsExpr;
  11085. ValueResolved: TPasResolverResult;
  11086. C: TClass;
  11087. begin
  11088. if (Expr.CustomData is TResolvedReference) then
  11089. begin
  11090. Ref:=TResolvedReference(Expr.CustomData);
  11091. SetResolvedRefAccess(Expr,Ref,Access);
  11092. end;
  11093. C:=Expr.ClassType;
  11094. if C=TBinaryExpr then
  11095. begin
  11096. Bin:=TBinaryExpr(Expr);
  11097. if Bin.OpCode in [eopSubIdent,eopNone] then
  11098. AccessExpr(Bin.right,Access);
  11099. end
  11100. else if C=TParamsExpr then
  11101. begin
  11102. Params:=TParamsExpr(Expr);
  11103. case Params.Kind of
  11104. pekFuncParams:
  11105. if IsTypeCast(Params) then
  11106. FinishCallArgAccess(Params.Params[0],Access)
  11107. else
  11108. AccessExpr(Params.Value,Access);
  11109. pekArrayParams:
  11110. begin
  11111. ComputeElement(Params.Value,ValueResolved,[]);
  11112. if IsDynArray(ValueResolved.LoTypeEl,false)
  11113. or (ValueResolved.BaseType=btPointer) then
  11114. // when accessing an element of a dynamic array the array is read
  11115. AccessExpr(Params.Value,rraRead)
  11116. else
  11117. AccessExpr(Params.Value,Access);
  11118. // Note: an element of an open or static array or a string is connected to the variable
  11119. end;
  11120. pekSet:
  11121. if Access<>rraRead then
  11122. RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  11123. else
  11124. RaiseNotYetImplemented(20170403173831,Params);
  11125. end;
  11126. end
  11127. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  11128. // ok
  11129. else if (Access in [rraRead,rraParamToUnknownProc])
  11130. and ((C=TPrimitiveExpr)
  11131. or (C=TNilExpr)
  11132. or (C=TBoolConstExpr)
  11133. or (C=TInheritedExpr)
  11134. or (C=TProcedureExpr))
  11135. or (C=TInlineSpecializeExpr) then
  11136. // ok
  11137. else if C=TUnaryExpr then
  11138. AccessExpr(TUnaryExpr(Expr).Operand,Access)
  11139. else
  11140. begin
  11141. {$IFDEF VerbosePasResolver}
  11142. writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  11143. {$ENDIF}
  11144. RaiseNotYetImplemented(20170306102158,Expr);
  11145. end;
  11146. end;
  11147. function TPasResolver.MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType
  11148. ): boolean;
  11149. var
  11150. Ref: TResolvedReference;
  11151. begin
  11152. if Expr.CustomData=nil then
  11153. begin
  11154. // mark set expression as array
  11155. CreateReference(ArrayType,Expr,rraRead);
  11156. Result:=true;
  11157. end
  11158. else if Expr.CustomData is TResolvedReference then
  11159. begin
  11160. // already set
  11161. Result:=false;
  11162. // check consistency
  11163. Ref:=TResolvedReference(Expr.CustomData);
  11164. if not (Ref.Declaration is TPasArrayType) then
  11165. begin
  11166. {$IFDEF VerbosePasResolver}
  11167. writeln('TPasResolver.MarkArrayExpr Expr=',GetObjName(Expr),' Ref.Declaration=',GetObjName(Ref.Declaration),' ',Ref.Declaration.ParentPath);
  11168. {$ENDIF}
  11169. RaiseNotYetImplemented(20180618102230,Expr,GetObjName(Ref.Declaration));
  11170. end;
  11171. end
  11172. else
  11173. // already set with something else
  11174. RaiseNotYetImplemented(20180618102408,Expr,GetObjName(Expr.CustomData));
  11175. end;
  11176. procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
  11177. ArrType: TPasArrayType);
  11178. procedure Traverse(CurExpr: TPasExpr; ArrayType: TPasArrayType; RgIndex: integer);
  11179. var
  11180. Params: TPasExprArray;
  11181. i: Integer;
  11182. ResolvedElType: TPasResolverResult;
  11183. ParamsExpr: TParamsExpr;
  11184. BuiltInProc: TResElDataBuiltInProc;
  11185. Ref: TResolvedReference;
  11186. begin
  11187. if IsArrayOperatorAdd(CurExpr) then
  11188. begin
  11189. Traverse(TBinaryExpr(CurExpr).left,ArrayType,RgIndex);
  11190. Traverse(TBinaryExpr(CurExpr).right,ArrayType,RgIndex);
  11191. end
  11192. else if CurExpr.ClassType=TParamsExpr then
  11193. begin
  11194. ParamsExpr:=TParamsExpr(CurExpr);
  11195. Params:=ParamsExpr.Params;
  11196. if CurExpr.Kind=pekSet then
  11197. begin
  11198. MarkArrayExpr(ParamsExpr,ArrayType);
  11199. // traverse into nested expressions, e.g. [ A, B ]
  11200. if length(Params)=0 then exit;
  11201. inc(RgIndex);
  11202. if RgIndex>length(ArrayType.Ranges) then
  11203. begin
  11204. if ArrayType.ElType=nil then
  11205. exit; // elements are not arrays
  11206. ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
  11207. if (ResolvedElType.BaseType=btContext)
  11208. and (ResolvedElType.LoTypeEl is TPasArrayType) then
  11209. begin
  11210. ArrayType:=TPasArrayType(ResolvedElType.LoTypeEl);
  11211. RgIndex:=0;
  11212. end
  11213. else
  11214. exit; // elements are not arrays
  11215. end;
  11216. for i:=0 to length(Params)-1 do
  11217. Traverse(Params[i],ArrayType,RgIndex);
  11218. end
  11219. else if CurExpr.Kind=pekFuncParams then
  11220. begin
  11221. if TParamsExpr(CurExpr).Value.CustomData is TResolvedReference then
  11222. begin
  11223. Ref:=TResolvedReference(TParamsExpr(CurExpr).Value.CustomData);
  11224. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  11225. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  11226. begin
  11227. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  11228. if BuiltInProc.BuiltIn=bfConcatArray then
  11229. begin
  11230. // concat(array1,array2,...)
  11231. for i:=0 to length(Params)-1 do
  11232. Traverse(Params[i],ArrayType,RgIndex);
  11233. end
  11234. else if BuiltInProc.BuiltIn=bfCopyArray then
  11235. // copy(array,...)
  11236. Traverse(Params[0],ArrayType,RgIndex);
  11237. end;
  11238. end;
  11239. end;
  11240. end;
  11241. end;
  11242. begin
  11243. Traverse(Expr,ArrType,0);
  11244. end;
  11245. procedure TPasResolver.CheckPointerCycle(El: TPasPointerType);
  11246. var
  11247. C: TClass;
  11248. CurEl, Dest: TPasType;
  11249. begin
  11250. CurEl:=El;
  11251. while CurEl<>nil do
  11252. begin
  11253. C:=CurEl.ClassType;
  11254. if C=TPasPointerType then
  11255. Dest:=TPasPointerType(CurEl).DestType
  11256. else if C.InheritsFrom(TPasAliasType) then
  11257. Dest:=TPasAliasType(CurEl).DestType
  11258. else
  11259. exit;
  11260. if Dest=El then
  11261. RaiseMsg(20180422165758,nTypeCycleFound,sTypeCycleFound,[],El);
  11262. CurEl:=Dest;
  11263. end;
  11264. end;
  11265. procedure TPasResolver.CheckGenericTemplateTypes(El: TPasGenericType);
  11266. var
  11267. GenTemplates: TFPList;
  11268. i: Integer;
  11269. TemplType: TPasGenericTemplateType;
  11270. begin
  11271. GenTemplates:=El.GenericTemplateTypes;
  11272. if (GenTemplates=nil) or (GenTemplates.Count=0) then
  11273. RaiseNotYetImplemented(20190726184902,El,'empty generic template list');
  11274. // template names must differ from generic type name
  11275. for i:=0 to GenTemplates.Count-1 do
  11276. begin
  11277. TemplType:=TPasGenericTemplateType(GenTemplates[i]);
  11278. if SameText(TemplType.Name,El.Name) then
  11279. RaiseMsg(20190801101444,nDuplicateIdentifier,sDuplicateIdentifier,[
  11280. TemplType.Name,GetElementSourcePosStr(El)],TemplType);
  11281. end;
  11282. end;
  11283. procedure TPasResolver.ComputeUnaryNot(El: TUnaryExpr;
  11284. var ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  11285. begin
  11286. RaiseMsg(20180208121532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  11287. [OpcodeStrings[El.OpCode],GetResolverResultDescription(ResolvedEl)],El);
  11288. if Flags=[] then ;
  11289. end;
  11290. procedure TPasResolver.AddModule(El: TPasModule);
  11291. var
  11292. C: TClass;
  11293. ModScope: TPasModuleScope;
  11294. begin
  11295. if Hub=nil then
  11296. RaiseNotYetImplemented(20200815182122,El);
  11297. if TopScope<>DefaultScope then
  11298. RaiseInvalidScopeForElement(20160922163504,El);
  11299. ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module));
  11300. ModScope.VisibilityContext:=El;
  11301. ModScope.FirstName:=FirstDottedIdentifier(El.Name);
  11302. C:=El.ClassType;
  11303. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  11304. FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
  11305. else
  11306. FDefaultNameSpace:='';
  11307. ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11308. end;
  11309. procedure TPasResolver.AddSection(El: TPasSection);
  11310. // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
  11311. // Note: implementation scope is within the interface scope
  11312. var
  11313. Scope: TPasSectionScope;
  11314. begin
  11315. if TopScope is TPasSectionScope then
  11316. FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
  11317. if TopScope is TPasModuleScope then
  11318. TPasModuleScope(TopScope).BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11319. {$IFDEF VerbosePasResolver}
  11320. if FPendingForwardProcs.IndexOf(El)=0 then
  11321. RaiseNotYetImplemented(20190804114718,El);
  11322. {$ENDIF}
  11323. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11324. Scope:=TPasSectionScope(PushScope(El,ScopeClass_Section));
  11325. Scope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11326. Scope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  11327. end;
  11328. procedure TPasResolver.AddInitialFinalizationSection(El: TPasImplBlock);
  11329. begin
  11330. PushScope(El,ScopeClass_InitialFinalization);
  11331. end;
  11332. procedure TPasResolver.AddType(El: TPasType);
  11333. begin
  11334. if (El.Name='') then exit; // sub type
  11335. {$IFDEF VerbosePasResolver}
  11336. writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
  11337. {$ENDIF}
  11338. if not (TopScope is TPasIdentifierScope) then
  11339. RaiseInvalidScopeForElement(20160922163506,El);
  11340. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11341. end;
  11342. procedure TPasResolver.AddArrayType(El: TPasArrayType; TypeParams: TFPList);
  11343. var
  11344. Scope: TPasArrayScope;
  11345. begin
  11346. {$IFDEF VerbosePasResolver}
  11347. writeln('TPasResolver.AddArrayType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11348. {$ENDIF}
  11349. if TypeParams<>nil then
  11350. begin
  11351. El.SetGenericTemplates(TypeParams);
  11352. TypeParams:=El.GenericTemplateTypes;
  11353. CheckGenericTemplateTypes(El);
  11354. end;
  11355. PopGenericParamScope(El);
  11356. if El.Name<>'' then begin
  11357. if not (TopScope is TPasIdentifierScope) then
  11358. RaiseInvalidScopeForElement(20190812215622,El);
  11359. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11360. if TypeParams<>nil then
  11361. begin
  11362. Scope:=TPasArrayScope(PushScope(El,ScopeClass_Array));
  11363. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11364. end;
  11365. end else if TypeParams<>nil then
  11366. RaiseNotYetImplemented(20190812215851,El); // anonymous generic array type
  11367. end;
  11368. procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList);
  11369. var
  11370. Scope: TPasRecordScope;
  11371. begin
  11372. {$IFDEF VerbosePasResolver}
  11373. writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11374. {$ENDIF}
  11375. if TypeParams<>nil then
  11376. begin
  11377. El.SetGenericTemplates(TypeParams);
  11378. TypeParams:=El.GenericTemplateTypes;
  11379. CheckGenericTemplateTypes(El);
  11380. end;
  11381. PopGenericParamScope(El);
  11382. if not (TopScope is TPasIdentifierScope) then
  11383. RaiseInvalidScopeForElement(20160922163508,El);
  11384. if El.Name<>'' then begin
  11385. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11386. {$IFDEF VerbosePasResolver}
  11387. if FPendingForwardProcs.IndexOf(El)=0 then
  11388. RaiseNotYetImplemented(20190804114737,El);
  11389. {$ENDIF}
  11390. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11391. end;
  11392. if El.Parent.ClassType<>TPasVariant then
  11393. begin
  11394. Scope:=TPasRecordScope(PushScope(El,ScopeClass_Record));
  11395. Scope.VisibilityContext:=El;
  11396. if TypeParams<>nil then
  11397. begin
  11398. // generic array
  11399. if El.Name='' then
  11400. RaiseNotYetImplemented(20190812220821,El);
  11401. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11402. end;
  11403. end;
  11404. end;
  11405. procedure TPasResolver.AddClassType(El: TPasClassType; TypeParams: TFPList);
  11406. // Note: IsForward is not yet set!
  11407. var
  11408. Duplicate: TPasIdentifier;
  11409. ForwardDecl: TPasClassType;
  11410. CurScope, LocalScope: TPasIdentifierScope;
  11411. GenTemplCnt, i, j: Integer;
  11412. ClassScope: TPasClassScope;
  11413. ForwGenTempl, ActGenTempl: TPasGenericTemplateType;
  11414. ForwConstraints, ActConstraints: TPasElementArray;
  11415. DuplEl, ForwConstraint, ActConstraint: TPasElement;
  11416. ForwToken, ActToken: TToken;
  11417. ForwConstraintResolved, ActConstraintResolved: TPasResolverResult;
  11418. begin
  11419. // Beware: El.ObjKind is not yet set!
  11420. {$IFDEF VerbosePasResolver}
  11421. //writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
  11422. {$ENDIF}
  11423. if not (TopScope is TPasIdentifierScope) then
  11424. RaiseInvalidScopeForElement(20160922163510,El);
  11425. if TypeParams=nil then
  11426. begin
  11427. GenTemplCnt:=0;
  11428. if TopScope is TPasGenericParamsScope then
  11429. RaiseNotYetImplemented(20190831205006,El,GetObjName(TopScope));
  11430. CurScope:=TPasIdentifierScope(TopScope);
  11431. end
  11432. else
  11433. begin
  11434. if not (TopScope is TPasGenericParamsScope) then
  11435. RaiseInvalidScopeForElement(20190831205038,El,GetObjName(TopScope));
  11436. CurScope:=TPasIdentifierScope(Scopes[ScopeCount-2]);
  11437. GenTemplCnt:=TypeParams.Count;
  11438. El.SetGenericTemplates(TypeParams);
  11439. TypeParams:=El.GenericTemplateTypes;
  11440. CheckGenericTemplateTypes(El);
  11441. end;
  11442. if CurScope is TPasGroupScope then
  11443. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11444. else
  11445. LocalScope:=CurScope;
  11446. Duplicate:=LocalScope.FindLocalIdentifier(El.Name);
  11447. while Duplicate<>nil do
  11448. begin
  11449. DuplEl:=Duplicate.Element;
  11450. if (DuplEl is TPasGenericType)
  11451. and (GetTypeParameterCount(TPasGenericType(DuplEl))=GenTemplCnt) then
  11452. break;
  11453. Duplicate:=Duplicate.NextSameIdentifier;
  11454. end;
  11455. //if Duplicate<>nil then
  11456. //writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
  11457. if (Duplicate<>nil)
  11458. and (Duplicate.Element is TPasClassType)
  11459. and TPasClassType(Duplicate.Element).IsForward
  11460. and (Duplicate.Element.Parent=El.Parent)
  11461. then
  11462. begin
  11463. // forward declaration found
  11464. ForwardDecl:=TPasClassType(Duplicate.Element);
  11465. {$IFDEF VerbosePasResolver}
  11466. writeln(' Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
  11467. {$ENDIF}
  11468. if GenTemplCnt>0 then
  11469. begin
  11470. // check generic constraints match exactly
  11471. for i:=0 to GenTemplCnt-1 do
  11472. begin
  11473. ForwGenTempl:=TPasGenericTemplateType(ForwardDecl.GenericTemplateTypes[i]);
  11474. ActGenTempl:=TPasGenericTemplateType(TypeParams[i]);
  11475. if not SameText(ForwGenTempl.Name,ActGenTempl.Name) then
  11476. RaiseMsg(20190814114811,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11477. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11478. ForwConstraints:=ForwGenTempl.Constraints;
  11479. ActConstraints:=ActGenTempl.Constraints;
  11480. if length(ForwConstraints)<>length(ActConstraints) then
  11481. RaiseMsg(20190814121031,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11482. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11483. for j:=0 to length(ForwConstraints)-1 do
  11484. begin
  11485. ForwConstraint:=ForwConstraints[j];
  11486. ActConstraint:=ActConstraints[j];
  11487. ForwToken:=GetGenericConstraintKeyword(ForwConstraint);
  11488. ActToken:=GetGenericConstraintKeyword(ActConstraint);
  11489. if ForwToken<>ActToken then
  11490. RaiseMsg(20190814121139,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11491. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwConstraint)],
  11492. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11493. if ForwToken=tkEOF then
  11494. begin
  11495. ComputeElement(ForwConstraint,ForwConstraintResolved,[rcType]);
  11496. ComputeElement(ActConstraint,ActConstraintResolved,[rcType]);
  11497. if CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,
  11498. ActConstraintResolved.LoTypeEl,prraNone)<>cExact then
  11499. RaiseMsg(20190814121509,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11500. [GetTypeDescription(ActGenTempl),
  11501. GetElementSourcePosStr(GetGenericConstraintErrorEl(ForwConstraint,ForwGenTempl))],
  11502. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11503. end;
  11504. end;
  11505. end;
  11506. end;
  11507. if ForwardDecl.CustomData<>nil then
  11508. begin
  11509. // move the classscope to the real declaration
  11510. ClassScope:=ForwardDecl.CustomData as TPasClassScope;
  11511. if El.CustomData<>nil then
  11512. RaiseInternalError(20190803202959,'real class has already customdata');
  11513. ForwardDecl.CustomData:=nil;
  11514. El.CustomData:=ClassScope;
  11515. ClassScope.Element:=El;
  11516. end;
  11517. // create a ref from the forward to the real declaration
  11518. CreateReference(El,ForwardDecl,rraRead);
  11519. // change the cache item
  11520. Duplicate.Element:=El;
  11521. end
  11522. else
  11523. AddIdentifier(CurScope,El.Name,El,pikSimple);
  11524. if TypeParams<>nil then
  11525. begin
  11526. // Parsing the ancestor+interface list requires the type params.
  11527. // AddGenericTemplateIdentifiers not needed, already in TPasGenericParamsScope
  11528. end;
  11529. {$IFDEF VerbosePasResolver}
  11530. if FPendingForwardProcs.IndexOf(El)>=0 then
  11531. RaiseNotYetImplemented(20190804114746,El);
  11532. {$ENDIF}
  11533. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11534. end;
  11535. procedure TPasResolver.AddVariable(El: TPasVariable);
  11536. begin
  11537. if (El.Name='') then exit; // anonymous var
  11538. {$IFDEF VerbosePasResolver}
  11539. writeln('TPasResolver.AddVariable ',GetObjName(El));
  11540. {$ENDIF}
  11541. if not (TopScope is TPasIdentifierScope) then
  11542. RaiseInvalidScopeForElement(20160929205730,El);
  11543. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11544. end;
  11545. procedure TPasResolver.AddResourceString(El: TPasResString);
  11546. var
  11547. C: TClass;
  11548. begin
  11549. {$IFDEF VerbosePasResolver}
  11550. writeln('TPasResolver.AddResourceString ',GetObjName(El));
  11551. {$ENDIF}
  11552. if not (TopScope is TPasIdentifierScope) then
  11553. RaiseInvalidScopeForElement(20171004092114,El);
  11554. C:=El.Parent.ClassType;
  11555. if not C.InheritsFrom(TPasSection) then
  11556. RaiseNotYetImplemented(20171004092518,El);
  11557. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11558. end;
  11559. procedure TPasResolver.AddExportSymbol(El: TPasExportSymbol);
  11560. begin
  11561. {$IFDEF VerbosePasResolver}
  11562. writeln('TPasResolver.AddExportSymbol ',GetObjName(El));
  11563. {$ENDIF}
  11564. // Note: export symbol is not added to scope
  11565. if El=nil then ;
  11566. end;
  11567. procedure TPasResolver.AddEnumType(El: TPasEnumType);
  11568. var
  11569. CanonicalSet: TPasSetType;
  11570. EnumScope: TPasEnumTypeScope;
  11571. begin
  11572. {$IFDEF VerbosePasResolver}
  11573. writeln('TPasResolver.AddEnumType ',GetObjName(El));
  11574. {$ENDIF}
  11575. if not (TopScope is TPasIdentifierScope) then
  11576. RaiseInvalidScopeForElement(20160929205732,El);
  11577. if El.Name<>'' then
  11578. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple)
  11579. else
  11580. begin
  11581. // anonymous enumtype
  11582. end;
  11583. EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
  11584. // add canonical set
  11585. if El.Parent is TPasSetType then
  11586. begin
  11587. // set of anonymous enumtype, e.g. "set of ()"
  11588. CanonicalSet:=TPasSetType(El.Parent);
  11589. CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11590. end
  11591. else
  11592. begin
  11593. CanonicalSet:=TPasSetType.Create('',El);
  11594. {$IFDEF CheckPasTreeRefCount}CanonicalSet.RefIds.Add('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11595. CanonicalSet.EnumType:=El;
  11596. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSetType.EnumType'){$ENDIF};
  11597. end;
  11598. EnumScope.CanonicalSet:=CanonicalSet;
  11599. end;
  11600. procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
  11601. var
  11602. i: Integer;
  11603. Scope: TPasScope;
  11604. Old: TPasIdentifier;
  11605. ClassOrRec: TPasMembersType;
  11606. begin
  11607. {$IFDEF VerbosePasResolver}
  11608. writeln('TPasResolver.AddEnumValue ',GetObjName(El));
  11609. {$ENDIF}
  11610. if not (TopScope is TPasEnumTypeScope) then
  11611. RaiseInvalidScopeForElement(20160929205736,El);
  11612. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11613. // propagate enum to parent scopes
  11614. // TEnum = (red, green); -> dot not propagate
  11615. // TFlags = set of (red,blue); -> propagate
  11616. if (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches)
  11617. and not (El.Parent.Parent is TPasSetType) then
  11618. exit;
  11619. for i:=ScopeCount-2 downto 0 do
  11620. begin
  11621. Scope:=Scopes[i];
  11622. if Scope is TPasGroupScope then
  11623. Scope:=TPasGroupScope(Scope).Scopes[0];
  11624. if Scope is TPasClassOrRecordScope then
  11625. begin
  11626. // class or record: add if not duplicate
  11627. Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
  11628. if Old=nil then
  11629. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11630. ClassOrRec:=Scope.Element as TPasMembersType;
  11631. if GetTypeParameterCount(ClassOrRec)>0 then
  11632. break; // enums in generics do not propagate
  11633. end
  11634. else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
  11635. begin
  11636. // procedure or section: check for duplicate and add
  11637. Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
  11638. if Old<>nil then
  11639. RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
  11640. [El.Name,GetElementSourcePosStr(Old.Element)],El);
  11641. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11642. break;
  11643. end
  11644. else
  11645. break;
  11646. end;
  11647. end;
  11648. procedure TPasResolver.AddProperty(El: TPasProperty);
  11649. begin
  11650. if (El.Name='') then
  11651. RaiseNotYetImplemented(20160922163518,El);
  11652. {$IFDEF VerbosePasResolver}
  11653. writeln('TPasResolver.AddProperty ',GetObjName(El));
  11654. {$ENDIF}
  11655. if not (GetLocalScope is TPasClassOrRecordScope) then
  11656. RaiseInvalidScopeForElement(20160922163520,El);
  11657. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11658. PushScope(El,TPasPropertyScope);
  11659. end;
  11660. procedure TPasResolver.AddProcedureType(El: TPasProcedureType;
  11661. TypeParams: TFPList);
  11662. var
  11663. Scope: TPasProcTypeScope;
  11664. begin
  11665. if El.Name<>'' then begin
  11666. {$IFDEF VerbosePasResolver}
  11667. writeln('TPasResolver.AddProcedureType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11668. {$ENDIF}
  11669. if El.Parent is TPasProcedure then
  11670. RaiseNotYetImplemented(20190911102852,El,GetObjPath(El.Parent));
  11671. if TypeParams<>nil then
  11672. begin
  11673. El.SetGenericTemplates(TypeParams);
  11674. TypeParams:=El.GenericTemplateTypes;
  11675. CheckGenericTemplateTypes(El);
  11676. end;
  11677. PopGenericParamScope(El);
  11678. if not (TopScope is TPasIdentifierScope) then
  11679. RaiseInvalidScopeForElement(20190813193703,El);
  11680. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11681. if TypeParams<>nil then
  11682. begin
  11683. Scope:=TPasProcTypeScope(PushScope(El,ScopeClass_ProcType));
  11684. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11685. end;
  11686. end else if TypeParams<>nil then
  11687. RaiseNotYetImplemented(20190813193745,El);
  11688. end;
  11689. procedure TPasResolver.AddProcedure(El: TPasProcedure; TypeParams: TFPList);
  11690. procedure AddClassConDestructor(ClassOrRecordScope: TPasClassOrRecordScope;
  11691. var Field: TPasProcedure);
  11692. begin
  11693. if Field<>nil then
  11694. RaiseMsg(20181231144353,nMultipleXinTypeYNameZCAandB,
  11695. sMultipleXinTypeYNameZCAandB,[GetElementTypeName(El),
  11696. GetElementTypeName(ClassOrRecordScope.Element),
  11697. ClassOrRecordScope.Element.Name,Field.Name,El.Name],El);
  11698. Field:=El;
  11699. end;
  11700. function FindBestMembersType(const ClassOrRecName: string;
  11701. TypeParamCnt: integer; Scope: TPasIdentifierScope;
  11702. var Best: TPasMembersType; ErrorPos: TPasElement): integer;
  11703. // returns number of candidates
  11704. var
  11705. Identifier: TPasIdentifier;
  11706. CurEl: TPasElement;
  11707. begin
  11708. Result:=0;
  11709. Identifier:=Scope.FindLocalIdentifier(ClassOrRecName);
  11710. while Identifier<>nil do
  11711. begin
  11712. CurEl:=Identifier.Element;
  11713. if not (CurEl is TPasMembersType) then
  11714. RaiseXExpectedButYFound(20170216152557,
  11715. 'class',CurEl.Name+':'+GetElementTypeName(CurEl),ErrorPos);
  11716. inc(Result);
  11717. if Best=nil then
  11718. Best:=TPasMembersType(CurEl);
  11719. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
  11720. begin
  11721. // fits
  11722. Best:=TPasMembersType(CurEl);
  11723. exit;
  11724. end;
  11725. Identifier:=Identifier.NextSameIdentifier;
  11726. end;
  11727. end;
  11728. function FindMembersType(Scope: TPasIdentifierScope;
  11729. const ClassOrRecName: string; TypeParamCnt: integer; IsDelphi: boolean;
  11730. ErrorPos: TPasElement): TPasMembersType;
  11731. var
  11732. Found: integer;
  11733. begin
  11734. Result:=nil;
  11735. if Scope<>nil then
  11736. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,Scope,Result,ErrorPos)
  11737. else if TopScope is TPasIdentifierScope then
  11738. begin
  11739. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11740. TPasIdentifierScope(TopScope),Result,ErrorPos);
  11741. if (Result=nil) or (TypeParamCnt<>GetTypeParameterCount(Result)) then
  11742. begin
  11743. if (TopScope is TPasSectionScope)
  11744. and (ScopeCount>1) and (Scopes[ScopeCount-2] is TPasSectionScope) then
  11745. // search in unit interface too
  11746. Found:=Found+FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11747. TPasIdentifierScope(Scopes[ScopeCount-2]),Result,ErrorPos);
  11748. end;
  11749. end;
  11750. if Result=nil then
  11751. RaiseMsg(20190818112356,nClassXNotFoundInThisModule,sClassXNotFoundInThisModule,
  11752. [ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11753. if TypeParamCnt=GetTypeParameterCount(Result) then
  11754. exit; // fits perfectly
  11755. if (not IsDelphi) and (TypeParamCnt=0) and (Found=1) then
  11756. exit; // in objfpc type params can be omitted if there is only one type
  11757. // found one or more, but type param count do not fit
  11758. RaiseMsg(20190818112856,nXExpectedButYFound,sXExpectedButYFound,
  11759. [Result.Name+GetGenericParamCommas(GetTypeParameterCount(Result)),
  11760. ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11761. end;
  11762. procedure CheckTemplateNames;
  11763. var
  11764. i, j: Integer;
  11765. NamePart: TProcedureNamePart;
  11766. TemplTypes: TFPList;
  11767. TemplType: TPasGenericTemplateType;
  11768. begin
  11769. for i:=0 to TypeParams.Count-1 do
  11770. begin
  11771. NamePart:=TProcedureNamePart(TypeParams[i]);
  11772. TemplTypes:=NamePart.Templates;
  11773. if TemplTypes=nil then continue;
  11774. for j:=0 to TemplTypes.Count-1 do
  11775. begin
  11776. TemplType:=TPasGenericTemplateType(TemplTypes[j]);
  11777. if SameText(TemplType.Name,El.Name) then
  11778. RaiseMsg(20190912174817,nDuplicateIdentifier,sDuplicateIdentifier,
  11779. [],TemplType);
  11780. end;
  11781. end;
  11782. end;
  11783. var
  11784. ProcName, aClassName: String;
  11785. p: SizeInt;
  11786. ClassOrRecType: TPasMembersType;
  11787. ProcScope: TPasProcedureScope;
  11788. HasDot, IsClassConDestructor, IsDelphi: Boolean;
  11789. ClassOrRecScope: TPasClassOrRecordScope;
  11790. C: TClass;
  11791. CurScope: TPasScope;
  11792. LocalScope: TPasScope;
  11793. Level, TypeParamCount, i: Integer;
  11794. NamePart: TProcedureNamePart;
  11795. TemplType, FoundTemplType: TPasGenericTemplateType;
  11796. NestedMembersScope: TPasGroupScope;
  11797. begin
  11798. {$IFDEF VerbosePasResolver}
  11799. writeln('TPasResolver.AddProcedure ',GetObjName(El));
  11800. {$ENDIF}
  11801. if TypeParams<>nil then
  11802. begin
  11803. // move type param elements to El
  11804. El.SetNameParts(TypeParams);
  11805. TypeParams:=El.NameParts;
  11806. if TopScope is TPasGenericParamsScope then
  11807. PopScope;
  11808. CheckTemplateNames;
  11809. end;
  11810. CurScope:=TopScope;
  11811. if CurScope.ClassType=TPasGroupScope then
  11812. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11813. else
  11814. LocalScope:=CurScope;
  11815. ProcName:=El.Name;
  11816. if El.Name<>'' then
  11817. begin
  11818. // named proc
  11819. if not (LocalScope is TPasIdentifierScope) then
  11820. RaiseInvalidScopeForElement(20160922163522,El);
  11821. end
  11822. else
  11823. begin
  11824. // anonymous proc
  11825. if TypeParams<>nil then
  11826. RaiseNotYetImplemented(20190818101856,El);
  11827. C:=LocalScope.ClassType;
  11828. if (C=ScopeClass_InitialFinalization)
  11829. or C.InheritsFrom(TPasProcedureScope)
  11830. or (C=TPasWithScope)
  11831. or (C=ScopeClass_WithExpr)
  11832. or (C=TPasExceptOnScope)
  11833. or (C=TPasForLoopScope) then
  11834. // ok
  11835. else
  11836. RaiseInvalidScopeForElement(20181210173134,El);
  11837. end;
  11838. // Note: El.ProcType is nil ! It is parsed later.
  11839. HasDot:=GetFirstDotPos(ProcName)>1;
  11840. if (TypeParams<>nil) then
  11841. if HasDot<>(TypeParams.Count>1) then
  11842. RaiseNotYetImplemented(20190818093923,El);
  11843. IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
  11844. or (El.ClassType=TPasClassDestructor);
  11845. ClassOrRecType:=nil;
  11846. if El.CustomData is TPasProcedureScope then
  11847. begin
  11848. // adding a specialized implementation proc
  11849. ProcScope:=TPasProcedureScope(El.CustomData);
  11850. if ProcScope.DeclarationProc<>nil then
  11851. TypeParams:=ProcScope.DeclarationProc.NameParts;
  11852. ClassOrRecScope:=ProcScope.ClassRecScope;
  11853. if ClassOrRecScope<>nil then
  11854. begin
  11855. ClassOrRecType:=TPasMembersType(ClassOrRecScope.Element);
  11856. if GetTypeParameterCount(ClassOrRecType)>0 then
  11857. RaiseNotYetImplemented(20190804175518,El);
  11858. if ProcScope.GroupScope<>nil then
  11859. RaiseNotYetImplemented(20190804175451,El);
  11860. if (not HasDot) and IsClassConDestructor then
  11861. begin
  11862. if El.ClassType=TPasClassConstructor then
  11863. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11864. else
  11865. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11866. end;
  11867. end;
  11868. PushScope(ProcScope);
  11869. end
  11870. else
  11871. begin
  11872. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  11873. if (not HasDot) and IsClassConDestructor then
  11874. begin
  11875. if ProcName='' then
  11876. RaiseNotYetImplemented(20181231145302,El);
  11877. if not (LocalScope is TPasClassOrRecordScope) then
  11878. RaiseInvalidScopeForElement(20181231143831,El);
  11879. ClassOrRecScope:=TPasClassOrRecordScope(LocalScope);
  11880. if El.ClassType=TPasClassConstructor then
  11881. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11882. else
  11883. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11884. if TypeParams<>nil then
  11885. RaiseMsg(20190818094753,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  11886. [El.ElementTypeName],El);
  11887. end;
  11888. if (not HasDot) and (ProcName<>'')
  11889. and not IsClassConDestructor // the name of a class con/destructor is irrelevant and cannot be referenced
  11890. then
  11891. begin
  11892. // add proc name to scope
  11893. AddIdentifier(TPasIdentifierScope(CurScope),ProcName,El,pikProc);
  11894. end;
  11895. ProcScope:=TPasProcedureScope(CreateScope(El,FScopeClass_Proc));
  11896. ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
  11897. if HasDot then
  11898. begin
  11899. // method implementation -> search class
  11900. {$IFDEF VerbosePasResolver}
  11901. writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
  11902. {$ENDIF}
  11903. ClassOrRecType:=nil;
  11904. Level:=0;
  11905. repeat
  11906. inc(Level);
  11907. p:=GetFirstDotPos(ProcName);
  11908. if p<1 then
  11909. begin
  11910. if ClassOrRecType=nil then
  11911. RaiseInternalError(20161013170829);
  11912. break;
  11913. end;
  11914. aClassName:=FirstDottedIdentifier(ProcName);
  11915. Delete(ProcName,1,p);
  11916. TypeParamCount:=0;
  11917. if TypeParams<>nil then
  11918. begin
  11919. // e.g. aclassname<T>.
  11920. if Level>TypeParams.Count then
  11921. RaiseNotYetImplemented(20190818122217,El);
  11922. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11923. if NamePart.Name<>aClassName then
  11924. RaiseNotYetImplemented(20190818102541,El,IntToStr(Level)+': '+NamePart.Name+'<>'+aClassName);
  11925. if NamePart.Templates<>nil then
  11926. begin
  11927. TypeParamCount:=NamePart.Templates.Count;
  11928. for i:=0 to TypeParamCount-1 do
  11929. begin
  11930. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11931. if length(TemplType.Constraints)>0 then
  11932. RaiseMsg(20190818102850,nIllegalQualifierAfter,sIllegalQualifierAfter,
  11933. [':',TemplType.name],TemplType);
  11934. end;
  11935. end;
  11936. end
  11937. else
  11938. NamePart:=nil;
  11939. {$IFDEF VerbosePasResolver}
  11940. writeln('TPasResolver.AddProcedure searching class "',aClassName,GetGenericParamCommas(TypeParamCount),'" ProcName="',ProcName,'" ...');
  11941. {$ENDIF}
  11942. if not IsValidIdent(aClassName) then
  11943. RaiseNotYetImplemented(20161013170844,El);
  11944. if ClassOrRecType<>nil then
  11945. begin
  11946. ClassOrRecScope:=TPasClassOrRecordScope(ClassOrRecType.CustomData);
  11947. ClassOrRecType:=FindMembersType(ClassOrRecScope,aClassName,
  11948. TypeParamCount,IsDelphi,El);
  11949. end
  11950. else
  11951. ClassOrRecType:=FindMembersType(nil,aClassName,
  11952. TypeParamCount,IsDelphi,El);
  11953. if ClassOrRecType is TPasClassType then
  11954. begin
  11955. if not (TPasClassType(ClassOrRecType).ObjKind in
  11956. ([okClass]+okAllHelpers)) then
  11957. begin
  11958. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  11959. RaiseXExpectedButYFound(20180321161722,'class',
  11960. aClassname+GetGenericParamCommas(GetTypeParameterCount(ClassOrRecType))+':'+GetElementTypeName(ClassOrRecType),El);
  11961. end
  11962. end;
  11963. if ClassOrRecType.GetModule<>El.GetModule then
  11964. RaiseNotYetImplemented(20190818120051,El);
  11965. if NamePart<>nil then
  11966. begin
  11967. // check that all type param names match
  11968. for i:=0 to TypeParamCount-1 do
  11969. begin
  11970. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11971. FoundTemplType:=TPasGenericTemplateType(ClassOrRecType.GenericTemplateTypes[i]);
  11972. if not SameText(TemplType.Name,FoundTemplType.Name) then
  11973. RaiseMsg(20190822014652,nXExpectedButYFound,
  11974. sXExpectedButYFound,[FoundTemplType.Name,TemplType.Name],TemplType);
  11975. end;
  11976. end;
  11977. until false;
  11978. if not IsValidIdent(ProcName) then
  11979. RaiseNotYetImplemented(20161013170956,El);
  11980. ProcScope.VisibilityContext:=ClassOrRecType;
  11981. ProcScope.ClassRecScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
  11982. if TypeParams<>nil then
  11983. begin
  11984. if Level<>TypeParams.Count then
  11985. RaiseNotYetImplemented(20190818122315,El);
  11986. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11987. if NamePart.Name<>ProcName then
  11988. RaiseNotYetImplemented(20190818122551,El,IntToStr(Level)+': '+NamePart.Name+'<>'+ProcName);
  11989. end;
  11990. end
  11991. else
  11992. begin
  11993. // HasDot=false
  11994. end;
  11995. PushScope(ProcScope);
  11996. end;// end source proc, not specialized
  11997. if HasDot then
  11998. begin
  11999. // create GroupScope
  12000. if TopScope<>ProcScope then
  12001. RaiseNotYetImplemented(20191014235935,El,GetObjName(TopScope));
  12002. ProcScope.GroupScope:=CreateGroupScope(ClassOrRecType);
  12003. if ClassOrRecType.Parent is TPasMembersType then
  12004. begin
  12005. // nested class
  12006. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  12007. NestedMembersScope:=CreateGroupScope(ClassOrRecType);
  12008. ProcScope.NestedMembersScope:=NestedMembersScope;
  12009. NestedMembersScope.OnlyTypeMembers:=true;
  12010. // Delphi searches the parent class scopes *after* the section scopes
  12011. // and before the module scope - sigh
  12012. // -> Move scope between module scope and section scope
  12013. i:=0;
  12014. while (i<ScopeCount) and not (FScopes[i] is TPasModuleScope) do
  12015. inc(i);
  12016. InsertScope(NestedMembersScope,i+1);
  12017. while ClassOrRecType.Parent is TPasMembersType do
  12018. begin
  12019. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  12020. GroupScope_AddTypeAndAncestors(NestedMembersScope,ClassOrRecType);
  12021. end;
  12022. end;
  12023. end;
  12024. // add generic params to scope
  12025. if TypeParams<>nil then
  12026. begin
  12027. NamePart:=TProcedureNamePart(TypeParams[TypeParams.Count-1]);
  12028. if NamePart<>nil then
  12029. AddGenericTemplateIdentifiers(NamePart.Templates,ProcScope);
  12030. end;
  12031. end;
  12032. procedure TPasResolver.AddArgument(El: TPasArgument);
  12033. var
  12034. ProcType: TPasProcedureType;
  12035. i: Integer;
  12036. Arg: TPasArgument;
  12037. CurScope: TPasScope;
  12038. begin
  12039. if (El.Name='') then
  12040. RaiseInternalError(20160922163526,GetObjName(El));
  12041. {$IFDEF VerbosePasResolver}
  12042. writeln('TPasResolver.AddArgument ',GetObjName(El));
  12043. {$ENDIF}
  12044. CurScope:=TopScope;
  12045. if (CurScope=nil) then
  12046. RaiseInvalidScopeForElement(20160922163529,El);
  12047. if El.Parent.ClassType=TPasProperty then
  12048. begin
  12049. if CurScope.ClassType<>TPasPropertyScope then
  12050. RaiseInvalidScopeForElement(20161014124530,El);
  12051. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  12052. end
  12053. else if El.Parent is TPasProcedureType then
  12054. begin
  12055. ProcType:=TPasProcedureType(El.Parent);
  12056. if ProcType.Parent is TPasProcedure then
  12057. begin
  12058. if CurScope.ClassType<>FScopeClass_Proc then
  12059. RaiseInvalidScopeForElement(20160922163529,El,GetObjName(TopScope));
  12060. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  12061. end
  12062. else
  12063. begin
  12064. for i:=0 to ProcType.Args.Count-1 do
  12065. begin
  12066. Arg:=TPasArgument(ProcType.Args[i]);
  12067. if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
  12068. RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
  12069. end;
  12070. end;
  12071. end
  12072. else
  12073. RaiseNotYetImplemented(20161014124937,El);
  12074. end;
  12075. procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
  12076. var
  12077. CurScope: TPasScope;
  12078. begin
  12079. CurScope:=TopScope;
  12080. if CurScope.ClassType<>FScopeClass_Proc then exit;
  12081. if El.Parent is TPasProcedureType then
  12082. begin
  12083. if not (El.Parent.Parent is TPasProcedure) then
  12084. exit;
  12085. end
  12086. else if not (El.Parent is TPasProcedure) then
  12087. exit;
  12088. AddIdentifier(TPasProcedureScope(CurScope),ResolverResultVar,El,pikSimple);
  12089. end;
  12090. procedure TPasResolver.AddGenericTemplateType(El: TPasGenericTemplateType);
  12091. var
  12092. ParamScope: TPasGenericParamsScope;
  12093. OldIdentifier: TPasIdentifier;
  12094. begin
  12095. if TopScope is TPasGenericParamsScope then
  12096. begin
  12097. ParamScope:=TPasGenericParamsScope(TopScope);
  12098. if ParamScope.Element.Parent<>El.Parent then
  12099. RaiseNotYetImplemented(20190831203132,El,GetObjName(ParamScope.Element));
  12100. end
  12101. else
  12102. begin
  12103. if El.CustomData<>nil then
  12104. RaiseNotYetImplemented(20190831202627,El,GetObjName(El.CustomData));
  12105. ParamScope:=TPasGenericParamsScope.Create;
  12106. AddResolveData(El,ParamScope,lkModule);
  12107. PushScope(ParamScope);
  12108. end;
  12109. OldIdentifier:=ParamScope.FindIdentifier(El.Name);
  12110. if OldIdentifier<>nil then
  12111. RaiseMsg(20190831202920,nDuplicateIdentifier,sDuplicateIdentifier,
  12112. [OldIdentifier.Identifier,GetElementSourcePosStr(OldIdentifier.Element)],El);
  12113. ParamScope.AddIdentifier(El.Name,El,pikSimple);
  12114. end;
  12115. procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
  12116. begin
  12117. PushScope(El,TPasExceptOnScope);
  12118. end;
  12119. procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
  12120. begin
  12121. if TPasWithScope.FreeOnPop then
  12122. RaiseInternalError(20181210162344);
  12123. PushScope(El,TPasWithScope);
  12124. end;
  12125. procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
  12126. begin
  12127. if El=nil then ;
  12128. CheckTopScope(FScopeClass_Proc);
  12129. end;
  12130. procedure TPasResolver.WriteScopes;
  12131. {AllowWriteln}
  12132. var
  12133. i: Integer;
  12134. Scope: TPasScope;
  12135. begin
  12136. writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
  12137. for i:=ScopeCount-1 downto 0 do
  12138. begin
  12139. Scope:=Scopes[i];
  12140. writeln(' ',i,'/',ScopeCount,' ',GetObjName(Scope));
  12141. Scope.WriteIdentifiers(' ');
  12142. end;
  12143. {AllowWriteln-}
  12144. end;
  12145. procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
  12146. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12147. StartEl: TPasElement);
  12148. var
  12149. LeftResolved, RightResolved: TPasResolverResult;
  12150. begin
  12151. if (Bin.OpCode=eopSubIdent)
  12152. or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
  12153. begin
  12154. // Note: bin.left was already resolved via ResolveSubIdent
  12155. ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
  12156. exit;
  12157. end;
  12158. if Bin.OpCode in [eopEqual,eopNotEqual] then
  12159. begin
  12160. if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
  12161. rcSetReferenceFlags in Flags)=cIncompatible then
  12162. RaiseInternalError(20161007215912);
  12163. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  12164. Bin,[rrfReadable]);
  12165. exit;
  12166. end;
  12167. ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
  12168. ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
  12169. // ToDo: check operator overloading
  12170. ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
  12171. end;
  12172. procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
  12173. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12174. var LeftResolved, RightResolved: TPasResolverResult);
  12175. procedure SetBaseType(BaseType: TResolverBaseType);
  12176. begin
  12177. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  12178. Bin,[rrfReadable]);
  12179. end;
  12180. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  12181. begin
  12182. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  12183. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,Flags);
  12184. end;
  12185. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  12186. begin
  12187. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  12188. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,Flags);
  12189. end;
  12190. var
  12191. ElTypeResolved: TPasResolverResult;
  12192. LeftTypeEl, RightTypeEl: TPasType;
  12193. begin
  12194. if LeftResolved.BaseType=btRange then
  12195. ConvertRangeToElement(LeftResolved);
  12196. if RightResolved.BaseType=btRange then
  12197. ConvertRangeToElement(RightResolved);
  12198. //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  12199. if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
  12200. begin
  12201. // cannot yet be decided
  12202. case Bin.OpCode of
  12203. eopEqual, eopNotEqual,
  12204. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual,
  12205. eopIn,eopIs:
  12206. begin
  12207. SetBaseType(btBoolean);
  12208. exit;
  12209. end;
  12210. eopAs:
  12211. begin
  12212. SetRightValueExpr([rrfReadable]);
  12213. exit;
  12214. end;
  12215. end;
  12216. ResolvedEl:=LeftResolved;
  12217. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  12218. exit;
  12219. end;
  12220. if LeftResolved.BaseType in btAllInteger then
  12221. begin
  12222. if (rrfReadable in LeftResolved.Flags)
  12223. and (rrfReadable in RightResolved.Flags) then
  12224. begin
  12225. if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  12226. case Bin.OpCode of
  12227. eopNone:
  12228. if (Bin.Kind=pekRange) then
  12229. begin
  12230. if not (RightResolved.BaseType in btAllInteger) then
  12231. RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
  12232. // use left type for result
  12233. SetLeftValueExpr([rrfReadable]);
  12234. if Bin.Parent is TPasRangeType then
  12235. begin
  12236. ResolvedEl.LoTypeEl:=TPasRangeType(Bin.Parent);
  12237. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  12238. end;
  12239. exit;
  12240. end;
  12241. eopAdd, eopSubtract,
  12242. eopMultiply, eopDiv, eopMod,
  12243. eopPower,
  12244. eopShl, eopShr,
  12245. eopAnd, eopOr, eopXor:
  12246. begin
  12247. if RightResolved.BaseType in btAllFloats then
  12248. // use right type for result
  12249. SetRightValueExpr([rrfReadable])
  12250. else
  12251. // use left type for result
  12252. SetLeftValueExpr([rrfReadable]);
  12253. exit;
  12254. end;
  12255. eopLessThan,
  12256. eopGreaterThan,
  12257. eopLessthanEqual,
  12258. eopGreaterThanEqual:
  12259. begin
  12260. SetBaseType(btBoolean);
  12261. exit;
  12262. end;
  12263. eopDivide:
  12264. begin
  12265. SetBaseType(BaseTypeExtended);
  12266. exit;
  12267. end;
  12268. end
  12269. else if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12270. begin
  12271. if (Bin.OpCode=eopIn) and (RightResolved.SubType in btAllInteger) then
  12272. begin
  12273. SetBaseType(btBoolean);
  12274. exit;
  12275. end;
  12276. end
  12277. else if RightResolved.BaseType=btPointer then
  12278. begin
  12279. if (Bin.OpCode in [eopAdd,eopSubtract])
  12280. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12281. begin
  12282. // integer+CanonicalPointer
  12283. SetResolverValueExpr(ResolvedEl,btPointer,
  12284. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,[rrfReadable]);
  12285. exit;
  12286. end;
  12287. end
  12288. else if RightResolved.BaseType=btContext then
  12289. begin
  12290. RightTypeEl:=RightResolved.LoTypeEl;
  12291. if RightTypeEl.ClassType=TPasPointerType then
  12292. begin
  12293. if (Bin.OpCode in [eopAdd,eopSubtract])
  12294. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12295. begin
  12296. // integer+TypedPointer
  12297. RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
  12298. SetResolverValueExpr(ResolvedEl,btPointer,
  12299. ResolveAliasType(RightTypeEl),RightTypeEl,Bin,[rrfReadable]);
  12300. exit;
  12301. end;
  12302. end;
  12303. end;
  12304. end;
  12305. end
  12306. else if LeftResolved.BaseType in btAllBooleans then
  12307. begin
  12308. if (rrfReadable in LeftResolved.Flags)
  12309. and (RightResolved.BaseType in btAllBooleans)
  12310. and (rrfReadable in RightResolved.Flags) then
  12311. case Bin.OpCode of
  12312. eopNone:
  12313. if Bin.Kind=pekRange then
  12314. begin
  12315. SetResolverValueExpr(ResolvedEl,btRange,
  12316. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  12317. Bin,[rrfReadable]);
  12318. ResolvedEl.SubType:=LeftResolved.BaseType;
  12319. exit;
  12320. end;
  12321. eopAnd, eopOr, eopXor:
  12322. begin
  12323. // use left type for result
  12324. SetLeftValueExpr([rrfReadable]);
  12325. exit;
  12326. end;
  12327. end;
  12328. end
  12329. else if LeftResolved.BaseType in btAllStringAndChars then
  12330. begin
  12331. if (rrfReadable in LeftResolved.Flags)
  12332. and (rrfReadable in RightResolved.Flags) then
  12333. begin
  12334. if (RightResolved.BaseType in btAllStringAndChars) then
  12335. case Bin.OpCode of
  12336. eopNone:
  12337. if (Bin.Kind=pekRange) and (LeftResolved.BaseType in btAllChars) then
  12338. begin
  12339. if not (RightResolved.BaseType in btAllChars) then
  12340. RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
  12341. SetResolverValueExpr(ResolvedEl,btRange,
  12342. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  12343. Bin,[rrfReadable]);
  12344. ResolvedEl.SubType:=LeftResolved.BaseType;
  12345. exit;
  12346. end;
  12347. eopAdd:
  12348. if RightResolved.BaseType in btAllStringAndChars then
  12349. if ComputeAddStringRes(LeftResolved,RightResolved,Bin,ResolvedEl) then
  12350. exit;
  12351. eopLessThan,
  12352. eopGreaterThan,
  12353. eopLessthanEqual,
  12354. eopGreaterThanEqual:
  12355. begin
  12356. SetBaseType(btBoolean);
  12357. exit;
  12358. end;
  12359. end
  12360. else if (RightResolved.BaseType in [btSet,btArrayOrSet])
  12361. and (RightResolved.SubType in btAllChars)
  12362. and (LeftResolved.BaseType in btAllChars) then
  12363. begin
  12364. case Bin.OpCode of
  12365. eopIn:
  12366. begin
  12367. SetBaseType(btBoolean);
  12368. exit;
  12369. end;
  12370. end;
  12371. end
  12372. end
  12373. end
  12374. else if LeftResolved.BaseType in btAllFloats then
  12375. begin
  12376. if (rrfReadable in LeftResolved.Flags)
  12377. and (RightResolved.BaseType in (btAllInteger+btAllFloats))
  12378. and (rrfReadable in RightResolved.Flags) then
  12379. case Bin.OpCode of
  12380. eopAdd, eopSubtract,
  12381. eopMultiply, eopDivide, eopMod,
  12382. eopPower:
  12383. begin
  12384. if (RightResolved.BaseType=btCurrency)
  12385. or ((RightResolved.BaseType in btAllFloats)
  12386. and (RightResolved.BaseType>LeftResolved.BaseType)) then
  12387. // use right side as result
  12388. SetRightValueExpr([rrfReadable])
  12389. else
  12390. // use left side as result
  12391. SetLeftValueExpr([rrfReadable]);
  12392. exit;
  12393. end;
  12394. eopLessThan,
  12395. eopGreaterThan,
  12396. eopLessthanEqual,
  12397. eopGreaterThanEqual:
  12398. begin
  12399. SetBaseType(btBoolean);
  12400. exit;
  12401. end;
  12402. end;
  12403. end
  12404. else if LeftResolved.BaseType=btPointer then
  12405. begin
  12406. if (rrfReadable in LeftResolved.Flags)
  12407. and (rrfReadable in RightResolved.Flags) then
  12408. begin
  12409. if (RightResolved.BaseType in btAllInteger) then
  12410. case Bin.OpCode of
  12411. eopAdd,eopSubtract:
  12412. if ElHasBoolSwitch(Bin,bsPointerMath) then
  12413. begin
  12414. // pointer+integer -> pointer
  12415. SetResolverValueExpr(ResolvedEl,btPointer,
  12416. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,[rrfReadable]);
  12417. exit;
  12418. end;
  12419. end
  12420. else if RightResolved.BaseType=btPointer then
  12421. case Bin.OpCode of
  12422. eopLessThan,
  12423. eopGreaterThan,
  12424. eopLessthanEqual,
  12425. eopGreaterThanEqual:
  12426. begin
  12427. SetBaseType(btBoolean);
  12428. exit;
  12429. end;
  12430. end;
  12431. end;
  12432. end
  12433. else if LeftResolved.BaseType=btContext then
  12434. begin
  12435. LeftTypeEl:=LeftResolved.LoTypeEl;
  12436. case Bin.OpCode of
  12437. eopNone:
  12438. if Bin.Kind=pekRange then
  12439. begin
  12440. if (rrfReadable in LeftResolved.Flags)
  12441. and (rrfReadable in RightResolved.Flags) then
  12442. begin
  12443. CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
  12444. ResolvedEl:=LeftResolved;
  12445. ResolvedEl.IdentEl:=nil;
  12446. ResolvedEl.SubType:=ResolvedEl.BaseType;
  12447. ResolvedEl.BaseType:=btRange;
  12448. ResolvedEl.ExprEl:=Bin;
  12449. exit;
  12450. end;
  12451. end;
  12452. eopIn:
  12453. if (rrfReadable in LeftResolved.Flags)
  12454. and (rrfReadable in RightResolved.Flags) then
  12455. begin
  12456. if LeftResolved.BaseType in btArrayRangeTypes then
  12457. begin
  12458. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12459. RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12460. if LeftResolved.BaseType in btAllBooleans then
  12461. begin
  12462. if not (RightResolved.SubType in btAllBooleans) then
  12463. RaiseXExpectedButYFound(20170216152610,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12464. end
  12465. else if LeftResolved.BaseType in btAllChars then
  12466. begin
  12467. if not (RightResolved.SubType in btAllChars) then
  12468. RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12469. end
  12470. else if not (RightResolved.SubType in btAllInteger) then
  12471. RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12472. SetBaseType(btBoolean);
  12473. exit;
  12474. end
  12475. else if (LeftResolved.BaseType=btContext)
  12476. and (LeftTypeEl.ClassType=TPasEnumType) then
  12477. begin
  12478. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12479. RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.LoTypeEl.Name,GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12480. RightTypeEl:=RightResolved.LoTypeEl;
  12481. if LeftTypeEl=RightTypeEl then
  12482. // enum in setofenum
  12483. else if RightResolved.LoTypeEl.ClassType=TPasRangeType then
  12484. begin
  12485. ComputeElement(TPasRangeType(RightTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
  12486. if LeftTypeEl<>ElTypeResolved.LoTypeEl then
  12487. RaiseXExpectedButYFound(20171109215833,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12488. end
  12489. else
  12490. RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12491. SetBaseType(btBoolean);
  12492. exit;
  12493. end
  12494. else
  12495. RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
  12496. sInOperatorExpectsSetElementButGot,[GetElementTypeName(LeftResolved.LoTypeEl)],Bin);
  12497. end;
  12498. eopIs:
  12499. begin
  12500. RightTypeEl:=RightResolved.LoTypeEl;
  12501. if (LeftTypeEl is TPasClassType) then
  12502. begin
  12503. if not (rrfReadable in LeftResolved.Flags) then
  12504. RaiseIncompatibleTypeRes(20180204124637,nOperatorIsNotOverloadedAOpB,
  12505. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12506. if (LeftResolved.IdentEl is TPasType) then
  12507. RaiseIncompatibleTypeRes(20180204124638,nOperatorIsNotOverloadedAOpB,
  12508. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12509. // left side is a class instance
  12510. if (RightResolved.IdentEl is TPasType)
  12511. and (RightTypeEl is TPasClassType) then
  12512. begin
  12513. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12514. begin
  12515. if CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible then
  12516. begin
  12517. // e.g. if obj is TFPMemoryImage then ;
  12518. // Note: at compile time the check is reversed: right must inherit from left
  12519. SetBaseType(btBoolean);
  12520. exit;
  12521. end
  12522. else if CheckSrcIsADstType(LeftResolved,RightResolved)<>cIncompatible then
  12523. begin
  12524. // e.g. if Image is TObject then ;
  12525. // This is useful after some unchecked typecast -> allow
  12526. SetBaseType(btBoolean);
  12527. exit;
  12528. end;
  12529. end
  12530. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12531. begin
  12532. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12533. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12534. begin
  12535. // e.g. if classintvar is intftype then ;
  12536. SetBaseType(btBoolean);
  12537. exit;
  12538. end;
  12539. end
  12540. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12541. begin
  12542. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12543. and (not TPasClassType(RightTypeEl).IsExternal) then
  12544. begin
  12545. // e.g. if intfvar is classtype then ;
  12546. SetBaseType(btBoolean);
  12547. exit;
  12548. end;
  12549. end;
  12550. {$IFDEF VerbosePasResolver}
  12551. writeln('TPasResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)));
  12552. writeln('TPasResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
  12553. {$ENDIF}
  12554. end
  12555. else if (RightTypeEl is TPasClassOfType)
  12556. and (rrfReadable in RightResolved.Flags) then
  12557. begin
  12558. // e.g. if Image is ImageClass then ;
  12559. if (CheckClassesAreRelated(LeftResolved.LoTypeEl,
  12560. TPasClassOfType(RightTypeEl).DestType)<>cIncompatible) then
  12561. begin
  12562. SetBaseType(btBoolean);
  12563. exit;
  12564. end;
  12565. end
  12566. else
  12567. RaiseXExpectedButYFound(20170216152625,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12568. end
  12569. else if (proClassOfIs in Options) and (LeftTypeEl is TPasClassOfType)
  12570. and (rrfReadable in LeftResolved.Flags) then
  12571. begin
  12572. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  12573. RaiseIncompatibleTypeRes(20180204124657,nOperatorIsNotOverloadedAOpB,
  12574. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12575. // left side is class-of variable
  12576. LeftTypeEl:=ResolveAliasType(TPasClassOfType(LeftTypeEl).DestType);
  12577. if (RightResolved.IdentEl is TPasType)
  12578. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  12579. begin
  12580. // e.g. if ImageClass is TFPMemoryImage then ;
  12581. // Note: at compile time the check is reversed: right must inherit from left
  12582. if CheckClassIsClass(RightResolved.LoTypeEl,LeftTypeEl)<>cIncompatible then
  12583. begin
  12584. SetBaseType(btBoolean);
  12585. exit;
  12586. end
  12587. end
  12588. else if (RightTypeEl is TPasClassOfType) then
  12589. begin
  12590. // e.g. if ImageClassA is ImageClassB then ;
  12591. // or if ImageClassA is TFPImageClass then ;
  12592. RightTypeEl:=ResolveAliasType(TPasClassOfType(RightTypeEl).DestType);
  12593. if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl)<>cIncompatible) then
  12594. begin
  12595. SetBaseType(btBoolean);
  12596. exit;
  12597. end
  12598. end
  12599. else
  12600. RaiseXExpectedButYFound(20170322105252,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12601. end
  12602. else if LeftResolved.LoTypeEl=nil then
  12603. begin
  12604. {$IFDEF VerbosePasResolver}
  12605. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12606. {$ENDIF}
  12607. RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12608. [BaseTypeNames[LeftResolved.BaseType]],Bin.left);
  12609. end
  12610. else
  12611. begin
  12612. {$IFDEF VerbosePasResolver}
  12613. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12614. {$ENDIF}
  12615. RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12616. [GetElementTypeName(LeftResolved.LoTypeEl)],Bin.left);
  12617. end;
  12618. end;
  12619. eopAs:
  12620. begin
  12621. if (LeftTypeEl.ClassType=TPasClassType) then
  12622. begin
  12623. if (LeftResolved.IdentEl is TPasType)
  12624. or (not (rrfReadable in LeftResolved.Flags)) then
  12625. RaiseIncompatibleTypeRes(20180204124711,nOperatorIsNotOverloadedAOpB,
  12626. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12627. if RightResolved.IdentEl=nil then
  12628. RaiseXExpectedButYFound(20170216152630,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12629. if not (RightResolved.IdentEl is TPasType) then
  12630. RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
  12631. if not (RightResolved.BaseType=btContext) then
  12632. RaiseXExpectedButYFound(20180426195816,'class',RightResolved.IdentEl.Name,Bin.right);
  12633. RightTypeEl:=RightResolved.LoTypeEl;
  12634. if RightTypeEl is TPasClassType then
  12635. begin
  12636. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12637. begin
  12638. // e.g. classinst as classtype
  12639. if (CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible) then
  12640. begin
  12641. SetRightValueExpr([rrfReadable]);
  12642. exit;
  12643. end;
  12644. end
  12645. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12646. begin
  12647. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12648. and (not TPasClassType(RightTypeEl).IsExternal) then
  12649. begin
  12650. // e.g. intfvar as classtype
  12651. SetRightValueExpr([rrfReadable]);
  12652. exit;
  12653. end;
  12654. end
  12655. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12656. begin
  12657. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12658. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12659. begin
  12660. // e.g. classinst as intftype
  12661. SetRightValueExpr([rrfReadable]);
  12662. exit;
  12663. end;
  12664. end;
  12665. end;
  12666. RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12667. end
  12668. else if LeftTypeEl.ClassType=TPasGenericTemplateType then
  12669. begin
  12670. // genericvar as ...
  12671. if (LeftResolved.IdentEl is TPasType)
  12672. or (not (rrfReadable in LeftResolved.Flags)) then
  12673. RaiseIncompatibleTypeRes(20190908191127,nOperatorIsNotOverloadedAOpB,
  12674. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12675. if RightResolved.IdentEl=nil then
  12676. RaiseXExpectedButYFound(20190908191202,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12677. if not (RightResolved.IdentEl is TPasType) then
  12678. RaiseXExpectedButYFound(20190908191204,'class',RightResolved.IdentEl.Name,Bin.right);
  12679. if not (RightResolved.BaseType=btContext) then
  12680. RaiseXExpectedButYFound(20190908191206,'class',RightResolved.IdentEl.Name,Bin.right);
  12681. RightTypeEl:=RightResolved.LoTypeEl;
  12682. if RightTypeEl is TPasClassType then
  12683. begin
  12684. // e.g. genericvar as classtype
  12685. SetRightValueExpr([rrfReadable]);
  12686. exit;
  12687. end;
  12688. RaiseIncompatibleTypeRes(20190908192345,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12689. end;
  12690. end;
  12691. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  12692. if (rrfReadable in LeftResolved.Flags)
  12693. and (rrfReadable in RightResolved.Flags) then
  12694. begin
  12695. RightTypeEl:=RightResolved.LoTypeEl;
  12696. if (LeftTypeEl.ClassType=TPasEnumType) and (LeftTypeEl=RightTypeEl) then
  12697. begin
  12698. SetBaseType(btBoolean);
  12699. exit;
  12700. end
  12701. else if (LeftTypeEl.ClassType=TPasPointerType)
  12702. and (RightResolved.BaseType in btAllInteger) then
  12703. begin
  12704. SetBaseType(btBoolean);
  12705. exit;
  12706. end;
  12707. end;
  12708. eopSubIdent:
  12709. begin
  12710. ResolvedEl:=RightResolved;
  12711. exit;
  12712. end;
  12713. eopAdd,eopSubtract:
  12714. if (rrfReadable in LeftResolved.Flags)
  12715. and (rrfReadable in RightResolved.Flags) then
  12716. begin
  12717. if (LeftTypeEl.ClassType=TPasArrayType) then
  12718. begin
  12719. if IsDynArray(LeftTypeEl)
  12720. and (Bin.OpCode=eopAdd)
  12721. and ElHasModeSwitch(Bin,msArrayOperators)
  12722. and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
  12723. or IsDynArray(RightResolved.LoTypeEl)) then
  12724. begin
  12725. // dynarr+[...]
  12726. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,Bin,true);
  12727. SetLeftValueExpr([rrfReadable]);
  12728. exit;
  12729. end;
  12730. end
  12731. else if LeftTypeEl.ClassType=TPasPointerType then
  12732. begin
  12733. if (RightResolved.BaseType in btAllInteger)
  12734. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12735. begin
  12736. // TypedPointer+Integer
  12737. SetLeftValueExpr([rrfReadable]);
  12738. exit;
  12739. end;
  12740. end;
  12741. end;
  12742. end;
  12743. end
  12744. else if LeftResolved.BaseType in [btSet,btArrayOrSet] then
  12745. begin
  12746. if (rrfReadable in LeftResolved.Flags)
  12747. and (rrfReadable in RightResolved.Flags) then
  12748. begin
  12749. if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12750. case Bin.OpCode of
  12751. eopAdd,
  12752. eopSubtract,
  12753. eopMultiply,
  12754. eopSymmetricaldifference,
  12755. eopLessthanEqual,
  12756. eopGreaterThanEqual:
  12757. begin
  12758. if RightResolved.LoTypeEl=nil then
  12759. begin
  12760. // right is empty set/array
  12761. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12762. SetBaseType(btBoolean)
  12763. else
  12764. begin
  12765. ResolvedEl:=LeftResolved;
  12766. ResolvedEl.IdentEl:=nil;
  12767. ResolvedEl.ExprEl:=Bin;
  12768. end;
  12769. exit;
  12770. end
  12771. else if LeftResolved.LoTypeEl=nil then
  12772. begin
  12773. // left is empty set/array
  12774. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12775. SetBaseType(btBoolean)
  12776. else
  12777. begin
  12778. ResolvedEl:=RightResolved;
  12779. ResolvedEl.IdentEl:=nil;
  12780. ResolvedEl.ExprEl:=Bin;
  12781. end;
  12782. exit;
  12783. end
  12784. else if (LeftResolved.SubType=RightResolved.SubType)
  12785. or ((LeftResolved.SubType in btAllBooleans)
  12786. and (RightResolved.SubType in btAllBooleans))
  12787. or ((LeftResolved.SubType in btAllInteger)
  12788. and (RightResolved.SubType in btAllInteger)) then
  12789. begin
  12790. // compatible set
  12791. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12792. SetBaseType(btBoolean)
  12793. else
  12794. begin
  12795. ResolvedEl:=LeftResolved;
  12796. ResolvedEl.IdentEl:=nil;
  12797. ResolvedEl.ExprEl:=Bin;
  12798. end;
  12799. exit;
  12800. end;
  12801. {$IFDEF VerbosePasResolver}
  12802. writeln('TPasResolver.ComputeBinaryExprRes + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
  12803. +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
  12804. {$ENDIF}
  12805. end;
  12806. end
  12807. else if RightResolved.BaseType=btContext then
  12808. begin
  12809. RightTypeEl:=RightResolved.LoTypeEl;
  12810. if RightTypeEl.ClassType=TPasArrayType then
  12811. begin
  12812. if IsDynArray(RightTypeEl) then
  12813. begin
  12814. // [...]+dynarr
  12815. CheckAssignCompatibilityArrayType(RightResolved,LeftResolved,Bin,true);
  12816. SetRightValueExpr([rrfReadable]);
  12817. exit;
  12818. end;
  12819. end;
  12820. end;
  12821. end;
  12822. end
  12823. else if LeftResolved.BaseType=btArrayLit then
  12824. begin
  12825. if (rrfReadable in LeftResolved.Flags)
  12826. and (rrfReadable in RightResolved.Flags)
  12827. and (Bin.OpCode=eopAdd)
  12828. and ElHasModeSwitch(Bin,msArrayOperators) then
  12829. begin
  12830. if RightResolved.BaseType=btArrayLit then
  12831. begin
  12832. if LeftResolved.LoTypeEl<>nil then
  12833. ResolvedEl:=LeftResolved
  12834. else
  12835. ResolvedEl:=RightResolved;
  12836. ResolvedEl.IdentEl:=nil;
  12837. ResolvedEl.ExprEl:=Bin;
  12838. exit;
  12839. end
  12840. else if (RightResolved.BaseType=btContext)
  12841. and (RightResolved.LoTypeEl.ClassType=TPasArrayType) then
  12842. begin
  12843. ResolvedEl:=RightResolved;
  12844. ResolvedEl.IdentEl:=nil;
  12845. ResolvedEl.ExprEl:=Bin;
  12846. exit;
  12847. end;
  12848. end;
  12849. end
  12850. else if LeftResolved.BaseType=btModule then
  12851. begin
  12852. if Bin.OpCode=eopSubIdent then
  12853. begin
  12854. ResolvedEl:=RightResolved;
  12855. exit;
  12856. end;
  12857. end;
  12858. {$IFDEF VerbosePasResolver}
  12859. writeln('TPasResolver.ComputeBinaryExprRes OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  12860. {$ENDIF}
  12861. RaiseIncompatibleTypeRes(20180204114631,nOperatorIsNotOverloadedAOpB,
  12862. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12863. if Flags=[] then ;
  12864. end;
  12865. function TPasResolver.ComputeAddStringRes(const LeftResolved,
  12866. RightResolved: TPasResolverResult; ExprEl: TPasExpr; out
  12867. ResolvedEl: TPasResolverResult): boolean;
  12868. procedure SetBaseType(BaseType: TResolverBaseType);
  12869. begin
  12870. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  12871. ExprEl,[rrfReadable]);
  12872. end;
  12873. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  12874. begin
  12875. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  12876. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,ExprEl,Flags);
  12877. end;
  12878. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  12879. begin
  12880. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  12881. RightResolved.LoTypeEl,RightResolved.HiTypeEl,ExprEl,Flags);
  12882. end;
  12883. begin
  12884. Result:=true;
  12885. case LeftResolved.BaseType of
  12886. btChar:
  12887. begin
  12888. case RightResolved.BaseType of
  12889. btChar: SetBaseType(btString);
  12890. {$ifdef FPC_HAS_CPSTRING}
  12891. btAnsiChar:
  12892. if BaseTypeChar=btAnsiChar then
  12893. SetBaseType(btString)
  12894. else
  12895. SetBaseType(btUnicodeString);
  12896. {$endif}
  12897. btWideChar:
  12898. if BaseTypeChar=btWideChar then
  12899. SetBaseType(btString)
  12900. else
  12901. SetBaseType(btUnicodeString);
  12902. else
  12903. // use right type for result
  12904. SetRightValueExpr([rrfReadable]);
  12905. end;
  12906. exit;
  12907. end;
  12908. {$ifdef FPC_HAS_CPSTRING}
  12909. btAnsiChar:
  12910. begin
  12911. case RightResolved.BaseType of
  12912. btChar:
  12913. if BaseTypeChar=btAnsiChar then
  12914. SetBaseType(btString)
  12915. else
  12916. SetBaseType(btUnicodeString);
  12917. btAnsiChar:
  12918. if BaseTypeChar=btAnsiChar then
  12919. SetBaseType(btString)
  12920. else
  12921. SetBaseType(btAnsiString);
  12922. btWideChar:
  12923. if BaseTypeChar=btWideChar then
  12924. SetBaseType(btString)
  12925. else
  12926. SetBaseType(btUnicodeString);
  12927. else
  12928. // use right type for result
  12929. SetRightValueExpr([rrfReadable]);
  12930. end;
  12931. exit;
  12932. end;
  12933. {$endif}
  12934. btWideChar:
  12935. begin
  12936. case RightResolved.BaseType of
  12937. btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
  12938. if BaseTypeChar=btWideChar then
  12939. SetBaseType(btString)
  12940. else
  12941. SetBaseType(btUnicodeString);
  12942. else
  12943. // use right type for result
  12944. SetRightValueExpr([rrfReadable]);
  12945. end;
  12946. exit;
  12947. end;
  12948. {$ifdef FPC_HAS_CPSTRING}
  12949. btShortString:
  12950. begin
  12951. case RightResolved.BaseType of
  12952. btChar,btAnsiChar,btShortString,btWideChar:
  12953. // use left type for result
  12954. SetLeftValueExpr([rrfReadable]);
  12955. else
  12956. // shortstring + string => string
  12957. SetRightValueExpr([rrfReadable]);
  12958. end;
  12959. exit;
  12960. end;
  12961. {$endif}
  12962. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  12963. begin
  12964. // string + x => string
  12965. SetLeftValueExpr([rrfReadable]);
  12966. exit;
  12967. end;
  12968. end;
  12969. Result:=false;
  12970. end;
  12971. procedure TPasResolver.ComputeArgumentAndExpr(Arg: TPasArgument; out
  12972. ArgResolved: TPasResolverResult; Expr: TPasExpr; out
  12973. ExprResolved: TPasResolverResult; SetReferenceFlags: boolean);
  12974. begin
  12975. ComputeElement(Arg,ArgResolved,[]);
  12976. {$IFDEF VerbosePasResolver}
  12977. writeln('TPasResolver.ComputeArgumentAndExpr Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  12978. {$ENDIF}
  12979. if (ArgResolved.LoTypeEl=nil) and (Arg.ArgType<>nil) then
  12980. RaiseInternalError(20160922163628,'TypeEl=nil for '+GetTreeDbg(Arg));
  12981. ComputeArgumentExpr(ArgResolved,Arg.Access,Expr,ExprResolved,SetReferenceFlags);
  12982. end;
  12983. procedure TPasResolver.ComputeArgumentExpr(
  12984. const ArgResolved: TPasResolverResult; Access: TArgumentAccess;
  12985. Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  12986. SetReferenceFlags: boolean);
  12987. var
  12988. NeedVar: Boolean;
  12989. RHSFlags: TPasResolverComputeFlags;
  12990. begin
  12991. RHSFlags:=[];
  12992. NeedVar:=Access in [argVar, argOut];
  12993. if NeedVar then
  12994. Include(RHSFlags,rcNoImplicitProc)
  12995. else if IsProcedureType(ArgResolved,true)
  12996. or (ArgResolved.BaseType=btPointer)
  12997. or ((ArgResolved.LoTypeEl=nil) and (ArgResolved.IdentEl is TPasArgument)) then
  12998. Include(RHSFlags,rcNoImplicitProcType);
  12999. if SetReferenceFlags then
  13000. Include(RHSFlags,rcSetReferenceFlags);
  13001. ComputeElement(Expr,ExprResolved,RHSFlags);
  13002. {$IFDEF VerbosePasResolver}
  13003. writeln('TPasResolver.ComputeArgumentExpr Expr=',GetTreeDbg(Expr,2),' ExprResolved=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
  13004. {$ENDIF}
  13005. end;
  13006. procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
  13007. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13008. StartEl: TPasElement);
  13009. procedure ComputeIndexProperty(Prop: TPasProperty);
  13010. begin
  13011. if [rcConstant,rcType]*Flags<>[] then
  13012. RaiseConstantExprExp(20170216152635,Params);
  13013. ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
  13014. ResolvedEl.IdentEl:=Prop;
  13015. ResolvedEl.Flags:=[];
  13016. if GetPasPropertyGetter(Prop)<>nil then
  13017. Include(ResolvedEl.Flags,rrfReadable);
  13018. if GetPasPropertySetter(Prop)<>nil then
  13019. Include(ResolvedEl.Flags,rrfWritable);
  13020. end;
  13021. procedure ComputeArrayPointer(TypeEl: TPasType);
  13022. begin
  13023. if TypeEl=nil then
  13024. RaiseInternalError(20180423092254);
  13025. ComputeElement(TypeEl,ResolvedEl,[rcType],Params);
  13026. ResolvedEl.IdentEl:=nil;
  13027. ResolvedEl.ExprEl:=Params;
  13028. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  13029. end;
  13030. var
  13031. TypeEl, ElType: TPasType;
  13032. ArrayEl: TPasArrayType;
  13033. ArgNo: Integer;
  13034. OrigResolved: TPasResolverResult;
  13035. ClassOrRecordScope: TPasClassOrRecordScope;
  13036. Ref: TResolvedReference;
  13037. begin
  13038. ComputeElement(Params.Value,ResolvedEl,
  13039. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  13040. {$IFDEF VerbosePasResolver}
  13041. writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  13042. {$ENDIF}
  13043. if ResolvedEl.BaseType in btAllStrings then
  13044. begin
  13045. // stringvar[] => char
  13046. case GetActualBaseType(ResolvedEl.BaseType) of
  13047. {$ifdef FPC_HAS_CPSTRING}
  13048. btAnsiString,btRawByteString,btShortString:
  13049. if BaseTypeChar=btAnsiChar then
  13050. ResolvedEl.BaseType:=btChar
  13051. else
  13052. ResolvedEl.BaseType:=btAnsiChar;
  13053. {$endif}
  13054. btWideString,btUnicodeString:
  13055. if BaseTypeChar=btWideChar then
  13056. ResolvedEl.BaseType:=btChar
  13057. else
  13058. ResolvedEl.BaseType:=btWideChar;
  13059. else
  13060. RaiseNotYetImplemented(20170417202354,Params);
  13061. end;
  13062. // keep ResolvedEl.IdentEl the string var
  13063. ResolvedEl.LoTypeEl:=FBaseTypes[ResolvedEl.BaseType];
  13064. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  13065. ResolvedEl.ExprEl:=Params;
  13066. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
  13067. end
  13068. else if ResolvedEl.BaseType=btPointer then
  13069. // (@something)[]
  13070. ComputeArrayPointer(ResolvedEl.LoTypeEl)
  13071. else if (ResolvedEl.IdentEl is TPasProperty)
  13072. and (GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then
  13073. // property with args
  13074. ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
  13075. else if ResolvedEl.BaseType=btContext then
  13076. begin
  13077. TypeEl:=ResolvedEl.LoTypeEl;
  13078. if (TypeEl.ClassType=TPasClassType)
  13079. or (TypeEl.ClassType=TPasRecordType)
  13080. or (TypeEl.ClassType=TPasClassOfType) then
  13081. begin
  13082. if not (Params.CustomData is TResolvedReference) then
  13083. RaiseNotYetImplemented(20190125143203,Params,GetObjName(Params.CustomData));
  13084. Ref:=TResolvedReference(Params.CustomData);
  13085. if Ref.Declaration is TPasProperty then
  13086. ComputeIndexProperty(TPasProperty(Ref.Declaration))
  13087. else if TypeEl is TPasMembersType then
  13088. begin
  13089. ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
  13090. ComputeArrayParams_Class(Params,ResolvedEl,ClassOrRecordScope,Flags,StartEl);
  13091. end
  13092. else
  13093. RaiseNotYetImplemented(20161010174916,Params);
  13094. end
  13095. else if TypeEl.ClassType=TPasArrayType then
  13096. begin
  13097. if not (rrfReadable in ResolvedEl.Flags) then
  13098. RaiseMsg(20170517001140,nIllegalQualifierAfter,sIllegalQualifierAfter,
  13099. ['[',TypeEl.ElementTypeName],Params);
  13100. ArrayEl:=TPasArrayType(TypeEl);
  13101. ArgNo:=0;
  13102. repeat
  13103. if length(ArrayEl.Ranges)=0 then
  13104. begin
  13105. inc(ArgNo); // dynamic/open array has one dimension
  13106. if IsDynArray(ArrayEl) then
  13107. Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
  13108. end
  13109. else
  13110. inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
  13111. if ArgNo>length(Params.Params) then
  13112. RaiseInternalError(20161010185535);
  13113. if ArgNo=length(Params.Params) then
  13114. break;
  13115. // continue in sub array
  13116. ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
  13117. until false;
  13118. OrigResolved:=ResolvedEl;
  13119. ElType:=GetArrayElType(ArrayEl);
  13120. ComputeElement(ElType,ResolvedEl,Flags,StartEl);
  13121. // identifier and value is the array itself
  13122. ResolvedEl.IdentEl:=OrigResolved.IdentEl;
  13123. ResolvedEl.ExprEl:=OrigResolved.ExprEl;
  13124. ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
  13125. if IsDynArray(ArrayEl) then
  13126. // dyn array elements are writable independent of the array
  13127. Include(ResolvedEl.Flags,rrfWritable);
  13128. end
  13129. else if TypeEl.ClassType=TPasPointerType then
  13130. ComputeArrayPointer(TPasPointerType(TypeEl).DestType)
  13131. else
  13132. RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
  13133. end
  13134. else
  13135. RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
  13136. end;
  13137. procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
  13138. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  13139. Flags: TPasResolverComputeFlags; StartEl: TPasElement);
  13140. begin
  13141. RaiseNotYetImplemented(20190125142240,Params);
  13142. if Params=nil then ;
  13143. if ClassOrRecScope=nil then ;
  13144. if Flags=[] then ;
  13145. if StartEl=nil then ;
  13146. SetResolverIdentifier(ResolvedEl,btNone,nil,nil,nil,[]);
  13147. end;
  13148. procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
  13149. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13150. StartEl: TPasElement);
  13151. var
  13152. DeclEl: TPasElement;
  13153. BuiltInProc: TResElDataBuiltInProc;
  13154. Proc: TPasProcedure;
  13155. ParamResolved: TPasResolverResult;
  13156. Ref: TResolvedReference;
  13157. DeclType: TPasType;
  13158. Param0: TPasExpr;
  13159. begin
  13160. Ref:=GetParamsValueRef(Params);
  13161. if Ref=nil then
  13162. RaiseNotYetImplemented(20160928174124,Params);
  13163. DeclEl:=Ref.Declaration;
  13164. if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  13165. begin
  13166. if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
  13167. begin
  13168. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  13169. if Assigned(BuiltInProc.GetCallResult) then
  13170. // built-in function
  13171. BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
  13172. else
  13173. // built-in procedure
  13174. SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,
  13175. BuiltInProc.Proc,BuiltInProc.Proc,[]);
  13176. if bipfCanBeStatement in BuiltInProc.Flags then
  13177. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13178. end
  13179. else if DeclEl.CustomData is TResElDataBaseType then
  13180. begin
  13181. // type cast to base type
  13182. DeclType:=TPasUnresolvedSymbolRef(DeclEl);
  13183. if length(Params.Params)<>1 then
  13184. begin
  13185. {$IFDEF VerbosePasResolver}
  13186. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl));
  13187. {$ENDIF}
  13188. RaiseMsg(20180503105409,nWrongNumberOfParametersForTypeCast,
  13189. sWrongNumberOfParametersForTypeCast,[DeclType.Name],Params);
  13190. end;
  13191. Param0:=Params.Params[0];
  13192. ComputeElement(Param0,ParamResolved,[]);
  13193. ComputeTypeCast(DeclType,DeclType,Param0,ParamResolved,ResolvedEl,Flags);
  13194. end
  13195. else
  13196. RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
  13197. end
  13198. else
  13199. begin
  13200. // normal identifier (not built-in)
  13201. ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  13202. if ResolvedEl.BaseType=btProc then
  13203. begin
  13204. if not (ResolvedEl.IdentEl is TPasProcedure) then
  13205. RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
  13206. Proc:=TPasProcedure(ResolvedEl.IdentEl);
  13207. if rcConstant in Flags then
  13208. RaiseConstantExprExp(20170216152637,Params);
  13209. if Proc.ProcType is TPasFunctionType then
  13210. // function call => return result
  13211. ComputeResultElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
  13212. Flags+[rcCall],StartEl)
  13213. else if (Proc.ClassType=TPasConstructor) then
  13214. begin
  13215. // constructor -> return value of type class
  13216. ResolvedEl:=GetReference_ConstructorType(Ref,Params.Value);
  13217. end
  13218. else
  13219. // procedure call, result is neither readable nor writable
  13220. SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,Proc.ProcType,[]);
  13221. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13222. end
  13223. else if ResolvedEl.LoTypeEl is TPasProcedureType then
  13224. begin
  13225. if Params.Value is TParamsExpr then
  13226. begin
  13227. // e.g. Name()() or Name[]()
  13228. Include(ResolvedEl.Flags,rrfReadable);
  13229. end;
  13230. if rrfReadable in ResolvedEl.Flags then
  13231. begin
  13232. // call procvar
  13233. if rcConstant in Flags then
  13234. RaiseConstantExprExp(20170216152639,Params);
  13235. if ResolvedEl.LoTypeEl is TPasFunctionType then
  13236. // function call => return result
  13237. ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  13238. ResolvedEl,Flags+[rcCall],StartEl)
  13239. else
  13240. // procedure call, result is neither readable nor writable
  13241. SetResolverTypeExpr(ResolvedEl,btProc,
  13242. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,[]);
  13243. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13244. end
  13245. else
  13246. begin
  13247. // typecast to proctype
  13248. if length(Params.Params)<>1 then
  13249. begin
  13250. {$IFDEF VerbosePasResolver}
  13251. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
  13252. {$ENDIF}
  13253. RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
  13254. sWrongNumberOfParametersForTypeCast,[ResolvedEl.LoTypeEl.Name],Params);
  13255. end;
  13256. Param0:=Params.Params[0];
  13257. ComputeElement(Param0,ParamResolved,[]);
  13258. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  13259. ParamResolved,ResolvedEl,Flags);
  13260. end;
  13261. end
  13262. else if (DeclEl is TPasType) then
  13263. begin
  13264. // type cast
  13265. Param0:=Params.Params[0];
  13266. ComputeElement(Param0,ParamResolved,Flags);
  13267. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  13268. ParamResolved,ResolvedEl,Flags);
  13269. end
  13270. else
  13271. RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
  13272. end;
  13273. end;
  13274. procedure TPasResolver.ComputeTypeCast(ToLoType, ToHiType: TPasType;
  13275. Param: TPasExpr; const ParamResolved: TPasResolverResult; out
  13276. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  13277. function ParamIsVar: boolean;
  13278. var
  13279. IdentEl: TPasElement;
  13280. begin
  13281. IdentEl:=ParamResolved.IdentEl;
  13282. if IdentEl=nil then exit(false);
  13283. if [rcConstant,rcType]*Flags<>[] then
  13284. Result:=(IdentEl.ClassType=TPasConst) and (TPasConst(IdentEl).IsConst)
  13285. else
  13286. Result:=(IdentEl is TPasVariable)
  13287. or (IdentEl.ClassType=TPasArgument)
  13288. or (IdentEl.ClassType=TPasResultElement);
  13289. end;
  13290. var
  13291. WriteFlags: TPasResolverResultFlags;
  13292. KeepWriteFlags: Boolean;
  13293. bt: TResolverBaseType;
  13294. Expr: TPasExpr;
  13295. begin
  13296. {$IFDEF VerbosePasResolver}
  13297. writeln('TPasResolver.ComputeFuncParams START ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved));
  13298. {$ENDIF}
  13299. if ToLoType.CustomData is TResElDataBaseType then
  13300. begin
  13301. // type cast to base type (or alias of base type)
  13302. bt:=GetActualBaseType(TResElDataBaseType(ToLoType.CustomData).BaseType);
  13303. SetResolverValueExpr(ResolvedEl,
  13304. TResElDataBaseType(ToLoType.CustomData).BaseType,
  13305. ToLoType,ToHiType,
  13306. Param,[rrfReadable]);
  13307. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13308. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  13309. if (WriteFlags<>[]) and ParamIsVar then
  13310. begin
  13311. KeepWriteFlags:=false;
  13312. // Param is writable -> check if typecast keeps this
  13313. if (bt=btPointer) then
  13314. begin
  13315. // typecast to pointer
  13316. if (ParamResolved.BaseType=btPointer)
  13317. or (ParamResolved.BaseType in [btString,btUnicodeString,btWideString])
  13318. or (ParamResolved.LoTypeEl=nil) // untyped
  13319. or (ParamResolved.LoTypeEl.ClassType=TPasClassType)
  13320. or IsDynArray(ParamResolved.LoTypeEl)
  13321. then
  13322. // e.g. pointer(ObjVar)
  13323. KeepWriteFlags:=true;
  13324. end
  13325. else if IsSameType(ToLoType,ParamResolved.LoTypeEl,prraNone) then
  13326. // e.g. Byte(TAliasByte)
  13327. KeepWriteFlags:=true;
  13328. if KeepWriteFlags then
  13329. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  13330. end;
  13331. end
  13332. else if ToLoType is TPasProcedureType then
  13333. begin
  13334. // typecast to proctype
  13335. if ParamIsVar then
  13336. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable]
  13337. else
  13338. WriteFlags:=[];
  13339. SetResolverValueExpr(ResolvedEl,btContext,
  13340. ToLoType,ToHiType,
  13341. Param,[rrfReadable]+WriteFlags);
  13342. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13343. end
  13344. else
  13345. begin
  13346. // typecast to custom type, e.g. to classtype, recordtype, arraytype, range, set
  13347. if (Param.Parent is TParamsExpr) then
  13348. Expr:=TParamsExpr(Param.Parent)
  13349. else
  13350. Expr:=Param;
  13351. ComputeElement(ToHiType,ResolvedEl,Flags,Expr);
  13352. ResolvedEl.ExprEl:=Expr;
  13353. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13354. ResolvedEl.Flags:=[rrfReadable];
  13355. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  13356. if (WriteFlags<>[]) and ParamIsVar then
  13357. begin
  13358. KeepWriteFlags:=false;
  13359. if (rrfReadable in ResolvedEl.Flags) then
  13360. begin
  13361. // typecast a value
  13362. if ParamResolved.BaseType=btPointer then
  13363. begin
  13364. if (ToLoType.ClassType=TPasClassType)
  13365. or IsDynArray(ParamResolved.LoTypeEl) then
  13366. // aClassType(aPointer)
  13367. KeepWriteFlags:=true;
  13368. end
  13369. else if ParamResolved.LoTypeEl=nil then
  13370. // e.g. TAliasType(untyped)
  13371. KeepWriteFlags:=true
  13372. else if ToLoType=ParamResolved.LoTypeEl then
  13373. // e.g. TAliasType(ActualType)
  13374. KeepWriteFlags:=true
  13375. else if (ToLoType.ClassType=TPasClassType)
  13376. and (ParamResolved.LoTypeEl.ClassType=TPasClassType) then
  13377. begin
  13378. // e.g. aClassType(ObjVar)
  13379. if (TPasClassType(ToLoType).ObjKind<>TPasClassType(ParamResolved.LoTypeEl).ObjKind) then
  13380. // e.g. IntfType(ObjVar)
  13381. else
  13382. KeepWriteFlags:=true;
  13383. end
  13384. else if (ToLoType.ClassType=TPasRecordType)
  13385. and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
  13386. // typecast record
  13387. KeepWriteFlags:=true
  13388. else if (ToLoType.ClassType=TPasArrayType)
  13389. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  13390. and IsDynArray(ToLoType)
  13391. and IsDynArray(ParamResolved.LoTypeEl) then
  13392. // typecast dyn array to dyn array
  13393. KeepWriteFlags:=true;
  13394. end
  13395. else
  13396. begin
  13397. // typecast a type to a value, e.g. Pointer(TObject)
  13398. end;
  13399. if KeepWriteFlags then
  13400. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  13401. end;
  13402. end;
  13403. {$IFDEF VerbosePasResolver}
  13404. writeln('TPasResolver.ComputeFuncParams END ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved),' Result=',GetResolverResultDbg(ResolvedEl));
  13405. {$ENDIF}
  13406. end;
  13407. procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
  13408. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13409. StartEl: TPasElement);
  13410. // [param,param,...]
  13411. var
  13412. ParamResolved, FirstResolved: TPasResolverResult;
  13413. i: Integer;
  13414. Param: TPasExpr;
  13415. IsRange, IsArray: Boolean;
  13416. ArrayType: TPasArrayType;
  13417. begin
  13418. ArrayType:=IsArrayExpr(Params);
  13419. IsArray:=ArrayType<>nil;
  13420. if length(Params.Params)=0 then
  13421. begin
  13422. SetResolverValueExpr(ResolvedEl,btArrayOrSet,nil,nil,Params,[rrfReadable]);
  13423. if IsArray then
  13424. ResolvedEl.BaseType:=btArrayLit;
  13425. exit;
  13426. end;
  13427. FirstResolved:=Default(TPasResolverResult);
  13428. Flags:=Flags-[rcNoImplicitProc]+[rcNoImplicitProcType];
  13429. for i:=0 to length(Params.Params)-1 do
  13430. begin
  13431. Param:=Params.Params[i];
  13432. ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
  13433. IsRange:=ParamResolved.BaseType=btRange;
  13434. if IsRange then
  13435. begin
  13436. if IsArray then
  13437. RaiseXExpectedButYFound(20180615111713,'array value','range expression',Param);
  13438. ConvertRangeToElement(ParamResolved);
  13439. end;
  13440. if FirstResolved.BaseType=btNone then
  13441. begin
  13442. // first value -> check if type usable in a set/array
  13443. FirstResolved:=ParamResolved;
  13444. if IsRange then
  13445. CheckIsOrdinal(FirstResolved,Param,true);
  13446. if rrfReadable in FirstResolved.Flags then
  13447. begin
  13448. // has a value
  13449. if (not IsArray) and (not IsRange)
  13450. and (not CheckIsOrdinal(FirstResolved,Param,false)) then
  13451. begin
  13452. // can't be a set
  13453. IsArray:=true;
  13454. end;
  13455. end
  13456. else
  13457. begin
  13458. IsArray:=true;
  13459. if (FirstResolved.BaseType=btContext) then
  13460. begin
  13461. if FirstResolved.IdentEl is TPasClassType then
  13462. // array of classtypes
  13463. else
  13464. begin
  13465. {$IFDEF VerbosePasResolver}
  13466. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13467. {$ENDIF}
  13468. RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
  13469. end;
  13470. end
  13471. else
  13472. begin
  13473. {$IFDEF VerbosePasResolver}
  13474. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13475. {$ENDIF}
  13476. RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
  13477. end;
  13478. end;
  13479. end
  13480. else
  13481. begin
  13482. // next value
  13483. CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
  13484. end;
  13485. end;
  13486. FirstResolved.IdentEl:=nil;
  13487. FirstResolved.ExprEl:=Params;
  13488. FirstResolved.SubType:=FirstResolved.BaseType;
  13489. if IsArray then
  13490. FirstResolved.BaseType:=btArrayLit
  13491. else
  13492. FirstResolved.BaseType:=btArrayOrSet;
  13493. FirstResolved.Flags:=[rrfReadable];
  13494. ResolvedEl:=FirstResolved;
  13495. end;
  13496. procedure TPasResolver.ComputeDereference(El: TUnaryExpr;
  13497. var ResolvedEl: TPasResolverResult);
  13498. procedure Deref(TypeEl: TPasType);
  13499. var
  13500. Expr: TPasExpr;
  13501. begin
  13502. Expr:=ResolvedEl.ExprEl;
  13503. if Expr=nil then
  13504. Expr:=El;
  13505. ComputeElement(TypeEl,ResolvedEl,[rcNoImplicitProc],El);
  13506. ResolvedEl.IdentEl:=nil;
  13507. ResolvedEl.ExprEl:=Expr;
  13508. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  13509. end;
  13510. var
  13511. TypeEl: TPasType;
  13512. begin
  13513. if ResolvedEl.BaseType=btPointer then
  13514. begin
  13515. Deref(ResolvedEl.LoTypeEl);
  13516. exit;
  13517. end
  13518. else if ResolvedEl.BaseType=btContext then
  13519. begin
  13520. TypeEl:=ResolvedEl.LoTypeEl;
  13521. if TypeEl.ClassType=TPasPointerType then
  13522. begin
  13523. Deref(TPasPointerType(TypeEl).DestType);
  13524. exit;
  13525. end;
  13526. end;
  13527. RaiseMsg(20180422191139,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  13528. [OpcodeStrings[eopDeref],GetResolverResultDescription(ResolvedEl)],El);
  13529. end;
  13530. procedure TPasResolver.ComputeArrayValuesExpectedType(El: TArrayValues; out
  13531. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13532. StartEl: TPasElement);
  13533. // (expr, expr, ...)
  13534. var
  13535. Parent: TPasElement;
  13536. HiTypeEl, LoTypeEl: TPasType;
  13537. Field: PRecordValuesItem;
  13538. Ref: TResolvedReference;
  13539. Member: TPasVariable;
  13540. i: Integer;
  13541. ArrType: TPasArrayType;
  13542. begin
  13543. Parent:=El.Parent;
  13544. if Parent is TPasVariable then
  13545. begin
  13546. HiTypeEl:=TPasVariable(Parent).VarType;
  13547. if HiTypeEl=nil then
  13548. RaiseMsg(20180429171628,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13549. ['const','array values'],El);
  13550. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13551. if LoTypeEl.ClassType=TPasArrayType then
  13552. // ok
  13553. else
  13554. RaiseIncompatibleTypeDesc(20180429171714,nIncompatibleTypesGotExpected,
  13555. [],'array value',GetTypeDescription(HiTypeEl),El);
  13556. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13557. El,[rrfReadable]);
  13558. end
  13559. else if Parent.ClassType=TRecordValues then
  13560. begin
  13561. // record field array
  13562. // get field
  13563. i:=length(TRecordValues(Parent).Fields)-1;
  13564. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13565. dec(i);
  13566. if i<0 then
  13567. RaiseInternalError(20180429181150);
  13568. Field:=@TRecordValues(Parent).Fields[i];
  13569. // get member
  13570. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13571. Member:=Ref.Declaration as TPasVariable;
  13572. if Member=nil then
  13573. RaiseInternalError(20180429181210);
  13574. ComputeElement(Member,ResolvedEl,[],StartEl);
  13575. ResolvedEl.Flags:=[rrfReadable];
  13576. end
  13577. else if Parent.ClassType=TArrayValues then
  13578. begin
  13579. // array of array
  13580. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13581. if (ResolvedEl.BaseType=btContext)
  13582. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13583. begin
  13584. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13585. if length(ArrType.Ranges)>1 then
  13586. RaiseNotYetImplemented(20180429180930,El);
  13587. HiTypeEl:=ArrType.ElType;
  13588. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13589. if LoTypeEl.ClassType<>TPasArrayType then
  13590. RaiseIncompatibleTypeDesc(20180429180938,nIncompatibleTypesGotExpected,
  13591. [],'array values',GetTypeDescription(HiTypeEl),El);
  13592. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13593. El,[rrfReadable]);
  13594. end
  13595. else
  13596. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13597. [],'array values',GetTypeDescription(ResolvedEl),El);
  13598. end
  13599. else
  13600. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable]);
  13601. end;
  13602. procedure TPasResolver.ComputeRecordValues(El: TRecordValues; out
  13603. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13604. StartEl: TPasElement);
  13605. // (name:expr; name:expr; ...)
  13606. var
  13607. Parent, Member: TPasElement;
  13608. LoTypeEl, HiTypeEl: TPasType;
  13609. i: Integer;
  13610. Field: PRecordValuesItem;
  13611. Ref: TResolvedReference;
  13612. ArrType: TPasArrayType;
  13613. begin
  13614. Parent:=El.Parent;
  13615. if Parent is TPasVariable then
  13616. begin
  13617. HiTypeEl:=TPasVariable(Parent).VarType;
  13618. if HiTypeEl=nil then
  13619. RaiseMsg(20180429105451,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13620. ['const','record values'],El);
  13621. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13622. if LoTypeEl.ClassType<>TPasRecordType then
  13623. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  13624. [],'record value',GetTypeDescription(HiTypeEl),El);
  13625. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13626. El,[rrfReadable]);
  13627. end
  13628. else if Parent.ClassType=TRecordValues then
  13629. begin
  13630. // nested record
  13631. // get field
  13632. i:=length(TRecordValues(Parent).Fields)-1;
  13633. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13634. dec(i);
  13635. if i<0 then
  13636. RaiseInternalError(20180429130244);
  13637. Field:=@TRecordValues(Parent).Fields[i];
  13638. // get member
  13639. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13640. Member:=Ref.Declaration as TPasVariable;
  13641. if Member=nil then
  13642. RaiseInternalError(20180429130548);
  13643. ComputeElement(Member,ResolvedEl,[],StartEl);
  13644. ResolvedEl.Flags:=[rrfReadable];
  13645. end
  13646. else if Parent.ClassType=TArrayValues then
  13647. begin
  13648. // array of record
  13649. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13650. if (ResolvedEl.BaseType=btContext)
  13651. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13652. begin
  13653. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13654. if length(ArrType.Ranges)>1 then
  13655. RaiseNotYetImplemented(20180429180450,El);
  13656. HiTypeEl:=ArrType.ElType;
  13657. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13658. if LoTypeEl.ClassType<>TPasRecordType then
  13659. RaiseIncompatibleTypeDesc(20180429180642,nIncompatibleTypesGotExpected,
  13660. [],'record values',GetTypeDescription(HiTypeEl),El);
  13661. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13662. El,[rrfReadable]);
  13663. end
  13664. else
  13665. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13666. [],'array values',GetTypeDescription(ResolvedEl),El);
  13667. end
  13668. else
  13669. RaiseMsg(20180429110227,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13670. ['const','(name:'],El);
  13671. end;
  13672. procedure TPasResolver.CheckIsClass(El: TPasElement;
  13673. const ResolvedEl: TPasResolverResult);
  13674. var
  13675. TypeEl: TPasType;
  13676. begin
  13677. if (ResolvedEl.BaseType<>btContext) then
  13678. RaiseXExpectedButYFound(20170216152245,'class',BaseTypeNames[ResolvedEl.BaseType],El);
  13679. TypeEl:=ResolvedEl.LoTypeEl;
  13680. if (TypeEl.ClassType<>TPasClassType)
  13681. or (TPasClassType(TypeEl).ObjKind<>okClass) then
  13682. RaiseXExpectedButYFound(20170216152246,'class',GetElementTypeName(ResolvedEl.LoTypeEl),El);
  13683. end;
  13684. function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  13685. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  13686. // called when type casting a class instance into an unrelated class
  13687. begin
  13688. if FromClassRes.BaseType=btNone then ;
  13689. if ToClassRes.BaseType=btNone then ;
  13690. if ErrorEl=nil then ;
  13691. Result:=cIncompatible;
  13692. end;
  13693. procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
  13694. const LHS, RHS: TPasResolverResult);
  13695. var
  13696. LBT, RBT: TResolverBaseType;
  13697. begin
  13698. // check both are values
  13699. if not (rrfReadable in LHS.Flags) then
  13700. begin
  13701. if LHS.LoTypeEl<>nil then
  13702. RaiseXExpectedButYFound(20170216152645,'ordinal',GetElementTypeName(LHS.LoTypeEl),Left)
  13703. else
  13704. RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13705. end;
  13706. if not (rrfReadable in RHS.Flags) then
  13707. begin
  13708. if RHS.LoTypeEl<>nil then
  13709. RaiseXExpectedButYFound(20170216152651,'ordinal',GetElementTypeName(RHS.LoTypeEl),Right)
  13710. else
  13711. RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
  13712. end;
  13713. // check both have the same ordinal type
  13714. LBT:=GetActualBaseType(LHS.BaseType);
  13715. RBT:=GetActualBaseType(RHS.BaseType);
  13716. if LBT in btAllBooleans then
  13717. begin
  13718. if RBT in btAllBooleans then
  13719. exit;
  13720. RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13721. end
  13722. else if LBT in btAllInteger then
  13723. begin
  13724. if RBT in btAllInteger then
  13725. exit;
  13726. RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
  13727. end
  13728. else if LBT in btAllChars then
  13729. begin
  13730. if RBT in btAllChars then
  13731. exit;
  13732. RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
  13733. end
  13734. else if LBT=btContext then
  13735. begin
  13736. if LHS.LoTypeEl.ClassType=TPasEnumType then
  13737. begin
  13738. if LHS.LoTypeEl=RHS.LoTypeEl then
  13739. exit;
  13740. if RHS.LoTypeEl.ClassType<>TPasEnumType then
  13741. RaiseXExpectedButYFound(20170216152707,LHS.LoTypeEl.Parent.Name,GetElementTypeName(RHS.LoTypeEl),Right);
  13742. if LHS.LoTypeEl.Parent<>RHS.LoTypeEl.Parent then
  13743. RaiseXExpectedButYFound(20170216152710,LHS.LoTypeEl.Parent.Name,RHS.LoTypeEl.Parent.Name,Right);
  13744. end
  13745. else
  13746. RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13747. end
  13748. else
  13749. RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13750. end;
  13751. function TPasResolver.CheckIsOrdinal(
  13752. const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
  13753. RaiseOnError: boolean): boolean;
  13754. begin
  13755. Result:=false;
  13756. if ResolvedEl.BaseType in btAllRanges then
  13757. else if (ResolvedEl.BaseType=btContext) then
  13758. begin
  13759. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  13760. else if RaiseOnError then
  13761. RaiseXExpectedButYFound(20170216152718,'ordinal value',GetElementTypeName(ResolvedEl.LoTypeEl),ErrorEl)
  13762. else
  13763. exit;
  13764. end
  13765. else if RaiseOnError then
  13766. RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
  13767. else
  13768. exit;
  13769. Result:=true;
  13770. end;
  13771. procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
  13772. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  13773. // LHS defines the array element type
  13774. // check if RHS
  13775. var
  13776. LBT, RBT: TResolverBaseType;
  13777. C: TClass;
  13778. begin
  13779. if (LHS.LoTypeEl=RHS.LoTypeEl) and (LHS.BaseType=RHS.BaseType) then
  13780. exit; // exact same type
  13781. LBT:=GetActualBaseType(LHS.BaseType);
  13782. RBT:=GetActualBaseType(RHS.BaseType);
  13783. if rrfReadable in LHS.Flags then
  13784. begin
  13785. if not (rrfReadable in RHS.Flags) then
  13786. RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
  13787. [],RHS,LHS,Right);
  13788. // array of values
  13789. if LBT in btAllBooleans then
  13790. begin
  13791. if RBT in btAllBooleans then
  13792. begin
  13793. LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
  13794. exit;
  13795. end;
  13796. RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13797. end
  13798. else if LBT in btAllInteger then
  13799. begin
  13800. if RBT in btAllInteger then
  13801. begin
  13802. LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
  13803. exit;
  13804. end;
  13805. RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
  13806. end
  13807. else if LBT in btAllChars then
  13808. begin
  13809. if RBT in btAllChars then
  13810. begin
  13811. LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
  13812. exit;
  13813. end;
  13814. RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
  13815. end
  13816. else if LBT in btAllStrings then
  13817. begin
  13818. if RBT in btAllStringAndChars then
  13819. begin
  13820. LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
  13821. exit;
  13822. end;
  13823. RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
  13824. end
  13825. else if LBT=btNil then
  13826. begin
  13827. if RBT=btNil then
  13828. exit
  13829. else if RBT=btPointer then
  13830. begin
  13831. LHS:=RHS;
  13832. exit;
  13833. end
  13834. else if RBT=btContext then
  13835. begin
  13836. C:=RHS.LoTypeEl.ClassType;
  13837. if (C=TPasClassType)
  13838. or (C=TPasClassOfType)
  13839. or (C=TPasPointerType)
  13840. or ((C=TPasArrayType) and IsDynArray(RHS.LoTypeEl))
  13841. or (C=TPasProcedureType)
  13842. or (C=TPasFunctionType) then
  13843. begin
  13844. LHS:=RHS;
  13845. exit;
  13846. end;
  13847. end;
  13848. end
  13849. else if LBT=btContext then
  13850. begin
  13851. C:=LHS.LoTypeEl.ClassType;
  13852. if C=TPasEnumType then
  13853. begin
  13854. if LHS.LoTypeEl=RHS.LoTypeEl then
  13855. exit;
  13856. end
  13857. else if C=TPasClassType then
  13858. begin
  13859. // array of class instances
  13860. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13861. RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
  13862. [],RHS,LHS,Right);
  13863. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13864. begin
  13865. // right class type is a left class type -> ok
  13866. exit;
  13867. end
  13868. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13869. begin
  13870. // left class type is a right class type -> right is the new base class type
  13871. LHS:=RHS;
  13872. exit;
  13873. end;
  13874. end;
  13875. end;
  13876. end
  13877. else
  13878. begin
  13879. // array of types
  13880. if rrfReadable in RHS.Flags then
  13881. RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
  13882. [],RHS,LHS,Right);
  13883. if LBT=btContext then
  13884. begin
  13885. if LHS.LoTypeEl.ClassType=TPasClassType then
  13886. begin
  13887. // array of class type
  13888. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13889. RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
  13890. [],RHS,LHS,Right);
  13891. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13892. begin
  13893. // right class type is a left class type -> ok
  13894. exit;
  13895. end
  13896. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13897. begin
  13898. // left class type is a right class type -> right is the new base class type
  13899. LHS:=RHS;
  13900. exit;
  13901. end;
  13902. end;
  13903. end;
  13904. end;
  13905. // can't combine
  13906. if LHS.LoTypeEl=nil then
  13907. RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
  13908. if RHS.LoTypeEl=nil then
  13909. RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
  13910. RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
  13911. [],RHS,LHS,Right);
  13912. end;
  13913. procedure TPasResolver.ConvertRangeToElement(
  13914. var ResolvedEl: TPasResolverResult);
  13915. var
  13916. TypeEl: TPasType;
  13917. begin
  13918. if ResolvedEl.BaseType<>btRange then
  13919. RaiseInternalError(20161001155732);
  13920. if ResolvedEl.LoTypeEl=nil then
  13921. if ResolvedEl.IdentEl<>nil then
  13922. RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
  13923. else
  13924. RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
  13925. TypeEl:=ResolvedEl.LoTypeEl;
  13926. if TypeEl is TPasRangeType then
  13927. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant])
  13928. else
  13929. begin
  13930. ResolvedEl.BaseType:=ResolvedEl.SubType;
  13931. ResolvedEl.SubType:=btNone;
  13932. end;
  13933. end;
  13934. function TPasResolver.IsCharLiteral(const Value: string; ErrorPos: TPasElement
  13935. ): TResolverBaseType;
  13936. // returns true if Value is a Pascal char literal
  13937. // btAnsiChar: #65, #$50, ^G, 'a'
  13938. // btWideChar: #10000, 'ä'
  13939. var
  13940. i: SizeInt;
  13941. p, base, l: Integer;
  13942. begin
  13943. Result:=btNone;
  13944. //writeln('TPasResolver.IsCharLiteral ',BaseTypeChar,' "',Value,'" l=',length(Value));
  13945. l:=length(Value);
  13946. if l=0 then exit;
  13947. p:=1;
  13948. case Value[1] of
  13949. '''':
  13950. begin
  13951. inc(p);
  13952. if p>l then exit;
  13953. {$ifdef FPC_HAS_CPSTRING}
  13954. case Value[2] of
  13955. '''':
  13956. if Value='''''''''' then
  13957. Result:=btAnsiChar; // ''''
  13958. #32..#38,#40..#191:
  13959. if (l=3) and (Value[3]='''') then
  13960. Result:=btAnsiChar; // e.g. 'a'
  13961. #192..#255:
  13962. if BaseTypeChar=btWideChar then
  13963. begin
  13964. // default char is widechar: UTF-8 'ä' is a widechar
  13965. i:=Utf8CodePointLen(@Value[2],4,false);
  13966. //writeln('TPasResolver.IsCharLiteral "',Value,'" ',length(Value),' i=',i);
  13967. if i<2 then
  13968. exit;
  13969. p:=2+i;
  13970. if (p=l) and (Value[p]='''') then
  13971. // single UTF-8 codepoint
  13972. Result:=btWideChar;
  13973. end;
  13974. end;
  13975. {$else}
  13976. case Value[p] of
  13977. '''':
  13978. if (p+2=l) and (Value[p+1]='''') and (Value[p+2]='''') then
  13979. Result:=btWideChar; // ''''
  13980. #$DC00..#$DFFF: ;
  13981. else
  13982. if (l=3) and (Value[3]='''') then
  13983. Result:=btWideChar; // e.g. 'a'
  13984. end;
  13985. {$endif}
  13986. end;
  13987. '#':
  13988. begin
  13989. inc(p);
  13990. if p>l then exit;
  13991. case Value[p] of
  13992. '$': begin base:=16; inc(p); end;
  13993. '&': begin base:=8; inc(p); end;
  13994. '%': begin base:=2; inc(p); end;
  13995. '0'..'9': base:=10;
  13996. else RaiseNotYetImplemented(20170728142709,ErrorPos);
  13997. end;
  13998. i:=0;
  13999. while p<=l do
  14000. begin
  14001. case Value[p] of
  14002. '0'..'9': i:=i*base+ord(Value[p])-ord('0');
  14003. 'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
  14004. 'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
  14005. end;
  14006. inc(p);
  14007. end;
  14008. if p>l then
  14009. begin
  14010. {$ifdef FPC_HAS_CPSTRING}
  14011. if i<256 then
  14012. Result:=btAnsiChar
  14013. else
  14014. {$endif}
  14015. Result:=btWideChar;
  14016. end;
  14017. end;
  14018. '^':
  14019. begin
  14020. if (l=2) and (Value[2] in ['a'..'z','A'..'Z']) then
  14021. Result:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  14022. end;
  14023. end;
  14024. if Result in [{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar] then
  14025. begin
  14026. if FBaseTypes[Result]=nil then
  14027. begin
  14028. {$ifdef FPC_HAS_CPSTRING}
  14029. if Result=btAnsiChar then
  14030. Result:=btWideChar
  14031. else
  14032. {$endif}
  14033. Result:=btChar;
  14034. end;
  14035. if Result=BaseTypeChar then
  14036. Result:=btChar;
  14037. end;
  14038. end;
  14039. function TPasResolver.CheckForIn(Loop: TPasImplForLoop; const VarResolved,
  14040. InResolved: TPasResolverResult): boolean;
  14041. begin
  14042. Result:=false;
  14043. if Loop=nil then ;
  14044. if VarResolved.BaseType=btCustom then ;
  14045. if InResolved.BaseType=btCustom then ;
  14046. end;
  14047. function TPasResolver.CheckForInClassOrRec(Loop: TPasImplForLoop; const VarResolved,
  14048. InResolved: TPasResolverResult): boolean;
  14049. var
  14050. LoTypeEl: TPasType;
  14051. EnumeratorClass: TPasClassType;
  14052. EnumeratorScope: TPasDotClassScope;
  14053. Getter, MoveNext, Current: TPasIdentifier;
  14054. GetterFunc, MoveNextFunc: TPasFunction;
  14055. ptm: TProcTypeModifier;
  14056. ResultResolved, MoveNextResolved, CurrentResolved: TPasResolverResult;
  14057. CurrentProp: TPasProperty;
  14058. ForScope: TPasForLoopScope;
  14059. DotScope: TPasDotBaseScope;
  14060. begin
  14061. Result:=false;
  14062. if InResolved.IdentEl is TPasType then
  14063. RaiseMsg(20190120180525,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  14064. [GetBaseDescription(InResolved)],Loop.StartExpr);
  14065. if not (rrfReadable in InResolved.Flags) then
  14066. RaiseMsg(20171221195421,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  14067. [GetBaseDescription(InResolved)],Loop.StartExpr);
  14068. LoTypeEl:=InResolved.LoTypeEl;
  14069. if LoTypeEl=nil then exit;
  14070. // check function InVar.GetEnumerator
  14071. DotScope:=PushDotScope(InResolved.HiTypeEl);
  14072. if DotScope=nil then
  14073. exit;
  14074. // find aRecord.GetEnumerator
  14075. Getter:=DotScope.FindIdentifier('GetEnumerator');
  14076. PopScope;
  14077. if Getter=nil then
  14078. begin
  14079. if LoTypeEl is TPasMembersType then
  14080. RaiseIdentifierNotFound(20171221191511,'GetEnumerator',Loop.StartExpr)
  14081. else
  14082. exit;
  14083. end;
  14084. // check is function
  14085. if Getter.Element.ClassType<>TPasFunction then
  14086. RaiseContextXExpectedButYFound(20171221191638,'GetEnumerator','function',GetElementTypeName(Getter.Element),Loop.StartExpr);
  14087. GetterFunc:=TPasFunction(Getter.Element);
  14088. // check visibility
  14089. if not (GetterFunc.Visibility in [visPublic,visPublished]) then
  14090. RaiseContextXExpectedButYFound(20171221191824,'function GetEnumerator','public',VisibilityNames[GetterFunc.Visibility],Loop.StartExpr);
  14091. // check arguments
  14092. if GetterFunc.FuncType.Args.Count>0 then
  14093. RaiseContextXExpectedButYFound(20171221191944,'function GetEnumerator','no arguments',IntToStr(GetterFunc.ProcType.Args.Count),Loop.StartExpr);
  14094. // check proc type modifiers
  14095. for ptm in GetterFunc.ProcType.Modifiers do
  14096. if not (ptm in [ptmOfObject]) then
  14097. RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  14098. // check result type
  14099. ComputeResultElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcCall]);
  14100. if (ResultResolved.BaseType<>btContext) then
  14101. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
  14102. LoTypeEl:=ResultResolved.LoTypeEl;
  14103. if not (LoTypeEl is TPasClassType) then
  14104. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  14105. if not (rrfReadable in ResultResolved.Flags) then
  14106. RaiseContextXExpectedButYFound(20171221195506,'function GetEnumerator','result class instance',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  14107. // find function MoveNext: boolean in Enumerator class
  14108. EnumeratorClass:=TPasClassType(LoTypeEl);
  14109. EnumeratorScope:=PushClassDotScope(EnumeratorClass);
  14110. MoveNext:=EnumeratorScope.FindIdentifier('MoveNext');
  14111. if MoveNext=nil then
  14112. RaiseIdentifierNotFound(20171221195632,'MoveNext',Loop.StartExpr);
  14113. // check is function
  14114. if MoveNext.Element.ClassType<>TPasFunction then
  14115. RaiseContextXExpectedButYFound(20171221195651,'MoveNext','function',GetElementTypeName(MoveNext.Element),Loop.StartExpr);
  14116. MoveNextFunc:=TPasFunction(MoveNext.Element);
  14117. // check visibility
  14118. if not (MoveNextFunc.Visibility in [visPublic,visPublished]) then
  14119. RaiseContextXExpectedButYFound(20171221195712,'function MoveNext','public',VisibilityNames[MoveNextFunc.Visibility],Loop.StartExpr);
  14120. // check arguments
  14121. if MoveNextFunc.FuncType.Args.Count>0 then
  14122. RaiseContextXExpectedButYFound(20171221195723,'function MoveNext','no arguments',IntToStr(MoveNextFunc.ProcType.Args.Count),Loop.StartExpr);
  14123. // check proc type modifiers
  14124. for ptm in MoveNextFunc.ProcType.Modifiers do
  14125. if not (ptm in [ptmOfObject]) then
  14126. RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  14127. // check result type
  14128. ComputeResultElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcCall]);
  14129. if not (MoveNextResolved.BaseType in btAllBooleans) then
  14130. RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
  14131. // check property Current
  14132. Current:=EnumeratorScope.FindIdentifier('Current');
  14133. if Current=nil then
  14134. RaiseIdentifierNotFound(20171221200433,'Current',Loop.StartExpr);
  14135. // check is property
  14136. if Current.Element.ClassType<>TPasProperty then
  14137. RaiseContextXExpectedButYFound(20171221200508,'Current','property',GetElementTypeName(Current.Element),Loop.StartExpr);
  14138. CurrentProp:=TPasProperty(Current.Element);
  14139. // check visibility
  14140. if not (CurrentProp.Visibility in [visPublic,visPublished]) then
  14141. RaiseContextXExpectedButYFound(20171221200546,'property Current','public',VisibilityNames[CurrentProp.Visibility],Loop.StartExpr);
  14142. // check arguments
  14143. if CurrentProp.Args.Count>0 then
  14144. RaiseContextXExpectedButYFound(20171221200638,'property Current','no arguments',IntToStr(CurrentProp.Args.Count),Loop.StartExpr);
  14145. // check readable
  14146. if GetPasPropertyGetter(CurrentProp)=nil then
  14147. RaiseContextXInvalidY(20171221200823,'property Current','read accessor',Loop.StartExpr);
  14148. // check result type fits for-loop variable
  14149. ComputeElement(CurrentProp,CurrentResolved,[rcType]);
  14150. if CheckAssignResCompatibility(VarResolved,CurrentResolved,Loop.VariableName,false)=cIncompatible then
  14151. RaiseIncompatibleTypeRes(20171221200018,nIncompatibleTypesGotExpected,[],VarResolved,CurrentResolved,Loop.VariableName);
  14152. PopScope; // pop EnumeratorScope
  14153. ForScope:=Loop.CustomData as TPasForLoopScope;
  14154. ForScope.GetEnumerator:=GetterFunc;
  14155. ForScope.MoveNext:=MoveNextFunc;
  14156. ForScope.Current:=CurrentProp;
  14157. Result:=true;
  14158. end;
  14159. function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
  14160. Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
  14161. begin
  14162. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
  14163. begin
  14164. if RaiseOnError then
  14165. RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
  14166. sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
  14167. exit(false);
  14168. end;
  14169. Result:=true;
  14170. end;
  14171. function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
  14172. Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean;
  14173. Signature: string): integer;
  14174. begin
  14175. if length(Params.Params)>MaxCount then
  14176. begin
  14177. if RaiseOnError then
  14178. begin
  14179. if Signature='' then Signature:=Proc.Signature;
  14180. RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
  14181. sWrongNumberOfParametersForCallTo,[Signature],Params.Params[MaxCount]);
  14182. end;
  14183. exit(cIncompatible);
  14184. end;
  14185. Result:=cExact;
  14186. end;
  14187. function TPasResolver.CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer;
  14188. Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
  14189. RaiseOnError: boolean): integer;
  14190. begin
  14191. if RaiseOnError then
  14192. RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  14193. [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
  14194. Result:=cIncompatible;
  14195. end;
  14196. function TPasResolver.FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
  14197. var
  14198. Clause: TPasUsesClause;
  14199. i: Integer;
  14200. Use: TPasUsesUnit;
  14201. ModName: String;
  14202. begin
  14203. Result:=nil;
  14204. if (Section=nil) then exit;
  14205. Clause:=Section.UsesClause;
  14206. for i:=0 to length(Clause)-1 do
  14207. begin
  14208. Use:=Clause[i];
  14209. if (Use.Module=nil) or not (Use.Module is TPasModule) then continue;
  14210. ModName:=Use.Module.Name;
  14211. if CompareText(ModName,aName)=0 then
  14212. exit(TPasModule(Use.Module));
  14213. end;
  14214. end;
  14215. function TPasResolver.FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
  14216. var
  14217. C: TClass;
  14218. begin
  14219. C:=aMod.ClassType;
  14220. if C.InheritsFrom(TPasProgram) then
  14221. Result:=FindUsedUnitnameInSection(aName,TPasProgram(aMod).ProgramSection)
  14222. else if C.InheritsFrom(TPasLibrary) then
  14223. Result:=FindUsedUnitnameInSection(aName,TPasLibrary(aMod).LibrarySection)
  14224. else
  14225. begin
  14226. Result:=FindUsedUnitnameInSection(aName,aMod.InterfaceSection);
  14227. if Result<>nil then exit;
  14228. Result:=FindUsedUnitnameInSection(aName,aMod.ImplementationSection);
  14229. end
  14230. end;
  14231. procedure TPasResolver.FinishAssertCall(Proc: TResElDataBuiltInProc;
  14232. Params: TParamsExpr);
  14233. var
  14234. aMod: TPasModule;
  14235. ModScope: TPasModuleScope;
  14236. aConstructor: TPasConstructor;
  14237. begin
  14238. if Proc=nil then ;
  14239. aMod:=RootElement;
  14240. ModScope:=aMod.CustomData as TPasModuleScope;
  14241. if not (pmsfAssertSearched in ModScope.Flags) then
  14242. FindAssertExceptionConstructors(nil); // no ErrorEl
  14243. if ModScope.AssertClass=nil then exit;
  14244. if length(Params.Params)>1 then
  14245. aConstructor:=ModScope.AssertMsgConstructor
  14246. else
  14247. aConstructor:=ModScope.AssertDefConstructor;
  14248. if aConstructor=nil then exit;
  14249. CreateReference(aConstructor,Params,rraRead);
  14250. end;
  14251. function TPasResolver.FindSystemIdentifier(const aUnitName, aName: string;
  14252. ErrorEl: TPasElement): TPasElement;
  14253. var
  14254. aMod, UtilsMod: TPasModule;
  14255. SectionScope: TPasSectionScope;
  14256. Identifier: TPasIdentifier;
  14257. begin
  14258. Result:=nil;
  14259. // find unit in uses clauses
  14260. aMod:=RootElement;
  14261. UtilsMod:=FindUsedUnitname(aUnitName,aMod);
  14262. if UtilsMod=nil then
  14263. if ErrorEl<>nil then
  14264. RaiseIdentifierNotFound(20200523224738,'unit '+aUnitName,ErrorEl)
  14265. else
  14266. exit;
  14267. // find class in interface
  14268. if UtilsMod.InterfaceSection=nil then
  14269. if ErrorEl<>nil then
  14270. RaiseIdentifierNotFound(20200523224831,aUnitName+'.'+aName,ErrorEl)
  14271. else
  14272. exit;
  14273. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  14274. Identifier:=SectionScope.FindLocalIdentifier(aName);
  14275. if Identifier=nil then
  14276. if ErrorEl<>nil then
  14277. RaiseIdentifierNotFound(20200523224841,aUnitName+'.'+aName,ErrorEl)
  14278. else
  14279. exit;
  14280. Result:=Identifier.Element;
  14281. end;
  14282. function TPasResolver.FindSystemClassType(const aUnitName, aClassName: string;
  14283. ErrorEl: TPasElement): TPasClassType;
  14284. var
  14285. El: TPasElement;
  14286. begin
  14287. Result:=nil;
  14288. El:=FindSystemIdentifier(aUnitName,aClassName,ErrorEl);
  14289. if not (El is TPasClassType) then
  14290. if ErrorEl<>nil then
  14291. RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl)
  14292. else
  14293. exit;
  14294. Result:=TPasClassType(El);
  14295. if Result.IsForward then
  14296. if ErrorEl<>nil then
  14297. RaiseXExpectedButYFound(20200523225546,'class '+aClassName,'forward '+GetTypeDescription(Result,true),ErrorEl)
  14298. else
  14299. exit;
  14300. if Result.ObjKind<>okClass then
  14301. if ErrorEl<>nil then
  14302. RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetTypeDescription(Result,true),ErrorEl)
  14303. else
  14304. exit;
  14305. end;
  14306. function TPasResolver.FindSystemClassTypeAndConstructor(const aUnitName,
  14307. aClassName: string; out aClass: TPasClassType; out
  14308. aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
  14309. var
  14310. Identifier: TPasIdentifier;
  14311. ClassScope: TPasClassScope;
  14312. begin
  14313. Result:=false;
  14314. aClass:=nil;
  14315. aConstructor:=nil;
  14316. aClass:=FindSystemClassType(aUnitName,aClassName,ErrorEl);
  14317. if aClass=nil then exit;
  14318. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  14319. repeat
  14320. Identifier:=ClassScope.FindIdentifier('create');
  14321. while Identifier<>nil do
  14322. begin
  14323. if Identifier.Element.ClassType=TPasConstructor then
  14324. begin
  14325. aConstructor:=TPasConstructor(Identifier.Element);
  14326. if aConstructor.ProcType.Args.Count=0 then
  14327. exit(true);
  14328. end;
  14329. Identifier:=Identifier.NextSameIdentifier;
  14330. end;
  14331. ClassScope:=ClassScope.AncestorScope;
  14332. until ClassScope=nil;
  14333. aConstructor:=nil;
  14334. if ErrorEl<>nil then
  14335. RaiseIdentifierNotFound(20200523224856,'constructor '+aClassName,ErrorEl);
  14336. end;
  14337. procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
  14338. var
  14339. aMod: TPasModule;
  14340. ModScope: TPasModuleScope;
  14341. Identifier: TPasIdentifier;
  14342. aClass: TPasClassType;
  14343. ClassScope: TPasClassScope;
  14344. aConstructor: TPasConstructor;
  14345. Arg: TPasArgument;
  14346. ArgResolved: TPasResolverResult;
  14347. begin
  14348. aMod:=RootElement;
  14349. ModScope:=aMod.CustomData as TPasModuleScope;
  14350. if pmsfAssertSearched in ModScope.Flags then exit;
  14351. Include(ModScope.Flags,pmsfAssertSearched);
  14352. FindSystemClassTypeAndConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
  14353. if aClass=nil then
  14354. exit;
  14355. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  14356. ModScope.AssertClass:=aClass;
  14357. repeat
  14358. Identifier:=ClassScope.FindIdentifier('create');
  14359. while Identifier<>nil do
  14360. begin
  14361. if Identifier.Element.ClassType=TPasConstructor then
  14362. begin
  14363. aConstructor:=TPasConstructor(Identifier.Element);
  14364. //writeln('TPasResolver.FindAssertExceptionConstructors ',aConstructor.Name,' ',aConstructor.ProcType.Args.Count);
  14365. if aConstructor.ProcType.Args.Count=0 then
  14366. begin
  14367. if ModScope.AssertDefConstructor=nil then
  14368. ModScope.AssertDefConstructor:=aConstructor;
  14369. end
  14370. else if aConstructor.ProcType.Args.Count=1 then
  14371. begin
  14372. if ModScope.AssertMsgConstructor=nil then
  14373. begin
  14374. Arg:=TPasArgument(aConstructor.ProcType.Args[0]);
  14375. //writeln('TPasResolver.FindAssertExceptionConstructors ',GetObjName(Arg.ArgType),' ',GetObjName(BaseTypes[BaseTypeString]));
  14376. ComputeElement(Arg.ArgType,ArgResolved,[rcType]);
  14377. if ArgResolved.BaseType in btAllStrings then
  14378. ModScope.AssertMsgConstructor:=aConstructor;
  14379. end;
  14380. end;
  14381. end;
  14382. Identifier:=Identifier.NextSameIdentifier;
  14383. end;
  14384. ClassScope:=ClassScope.AncestorScope;
  14385. until ClassScope=nil;
  14386. end;
  14387. procedure TPasResolver.FindRangeErrorConstructors(ErrorEl: TPasElement);
  14388. var
  14389. aMod: TPasModule;
  14390. ModScope: TPasModuleScope;
  14391. aClass: TPasClassType;
  14392. aConstructor: TPasConstructor;
  14393. begin
  14394. aMod:=RootElement;
  14395. ModScope:=aMod.CustomData as TPasModuleScope;
  14396. if pmsfRangeErrorSearched in ModScope.Flags then exit;
  14397. Include(ModScope.Flags,pmsfRangeErrorSearched);
  14398. FindSystemClassTypeAndConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
  14399. ModScope.RangeErrorClass:=aClass;
  14400. ModScope.RangeErrorConstructor:=aConstructor;
  14401. end;
  14402. function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
  14403. var
  14404. aMod, UtilsMod: TPasModule;
  14405. SectionScope: TPasSectionScope;
  14406. Identifier: TPasIdentifier;
  14407. El: TPasElement;
  14408. ModScope: TPasModuleScope;
  14409. begin
  14410. aMod:=RootElement;
  14411. ModScope:=aMod.CustomData as TPasModuleScope;
  14412. Result:=ModScope.SystemTVarRec;
  14413. if Result<>nil then exit;
  14414. // find unit in uses clauses
  14415. UtilsMod:=FindUsedUnitname('system',aMod);
  14416. if UtilsMod=nil then
  14417. RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
  14418. // find class in interface
  14419. if UtilsMod.InterfaceSection=nil then
  14420. RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
  14421. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  14422. Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
  14423. if Identifier=nil then
  14424. RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
  14425. El:=Identifier.Element;
  14426. if not (El is TPasRecordType) then
  14427. RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
  14428. Result:=TPasRecordType(El);
  14429. ModScope.SystemTVarRec:=Result;
  14430. end;
  14431. function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
  14432. var
  14433. aModule: TPasModule;
  14434. ModScope: TPasModuleScope;
  14435. begin
  14436. aModule:=El.GetModule;
  14437. ModScope:=aModule.CustomData as TPasModuleScope;
  14438. Result:=ModScope.SystemTVarRec;
  14439. if Result=nil then
  14440. RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
  14441. end;
  14442. function TPasResolver.FindDefaultConstructor(aClass: TPasClassType
  14443. ): TPasConstructor;
  14444. var
  14445. ClassScope: TPasClassScope;
  14446. Identifier: TPasIdentifier;
  14447. El: TPasElement;
  14448. HasOverload: Boolean;
  14449. Proc: TPasProcedure;
  14450. begin
  14451. Result:=nil;
  14452. if (aClass=nil) or aClass.IsExternal or (aClass.ObjKind<>okClass) then exit;
  14453. ClassScope:=aClass.CustomData as TPasClassScope;
  14454. repeat
  14455. Identifier:=ClassScope.FindLocalIdentifier('create');
  14456. if Identifier<>nil then
  14457. begin
  14458. HasOverload:=false;
  14459. while Identifier<>nil do
  14460. begin
  14461. El:=Identifier.Element;
  14462. if not (El is TPasProcedure) then exit;
  14463. Proc:=TPasProcedure(El);
  14464. if Proc.ClassType=TPasConstructor then
  14465. begin
  14466. if Proc.ProcType.Args.Count=0 then
  14467. exit(TPasConstructor(El));
  14468. end;
  14469. if Proc.IsOverload then
  14470. HasOverload:=true;
  14471. Identifier:=Identifier.NextSameIdentifier;
  14472. end;
  14473. if not HasOverload then exit;
  14474. end;
  14475. ClassScope:=ClassScope.AncestorScope;
  14476. until false;
  14477. end;
  14478. function TPasResolver.GetTypeInfoParamType(Param: TPasExpr; out
  14479. ParamResolved: TPasResolverResult; LoType: boolean): TPasType;
  14480. var
  14481. Decl: TPasElement;
  14482. begin
  14483. Result:=nil;
  14484. // check type or var
  14485. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14486. Decl:=ParamResolved.IdentEl;
  14487. if Decl=nil then exit;
  14488. if Decl is TPasType then
  14489. Result:=TPasType(Decl)
  14490. else if Decl is TPasVariable then
  14491. Result:=TPasVariable(Decl).VarType
  14492. else if Decl.ClassType=TPasArgument then
  14493. Result:=TPasArgument(Decl).ArgType
  14494. else if Decl.ClassType=TPasResultElement then
  14495. Result:=TPasResultElement(Decl).ResultType
  14496. else if (Decl is TPasProcedure)
  14497. and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
  14498. Result:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
  14499. {$IFDEF VerbosePasResolver}
  14500. {AllowWriteln}
  14501. if Result=nil then
  14502. writeln('TPasResolver.GetTypeInfoParamType Decl=',GetObjName(Decl),' ParamResolved=',GetResolverResultDbg(ParamResolved));
  14503. {AllowWriteln-}
  14504. {$ENDIF}
  14505. if LoType then
  14506. Result:=ResolveAliasType(Result);
  14507. end;
  14508. procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
  14509. const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  14510. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  14511. PosEl: TPasElement);
  14512. begin
  14513. if MsgType<=mtError then
  14514. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
  14515. else
  14516. LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  14517. if Sender=nil then ;
  14518. end;
  14519. function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
  14520. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
  14521. var
  14522. Ref: TResolvedReference;
  14523. Decl: TPasElement;
  14524. C: TClass;
  14525. ResolvedType: TPasResolverResult;
  14526. EnumValue: TPasEnumValue;
  14527. EnumType: TPasEnumType;
  14528. EvalFlags: TResEvalFlags;
  14529. begin
  14530. Result:=nil;
  14531. if not (Expr.CustomData is TResolvedReference) then
  14532. RaiseNotYetImplemented(20170518203134,Expr,GetObjName(Expr.CustomData));
  14533. Ref:=TResolvedReference(Expr.CustomData);
  14534. Decl:=Ref.Declaration;
  14535. {$IFDEF VerbosePasResEval}
  14536. writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
  14537. {$ENDIF}
  14538. C:=Decl.ClassType;
  14539. if C=TPasConst then
  14540. begin
  14541. if (TPasConst(Decl).Expr<>nil)
  14542. and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
  14543. begin
  14544. if TPasConst(Decl).VarType<>nil then
  14545. begin
  14546. // typed const
  14547. ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
  14548. end
  14549. else
  14550. ResolvedType.BaseType:=btNone;
  14551. EvalFlags:=Flags;
  14552. if not (refConstExt in EvalFlags) then
  14553. Include(EvalFlags,refConst);
  14554. Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,EvalFlags);
  14555. if Result<>nil then
  14556. begin
  14557. if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
  14558. Result:=Result.Clone;
  14559. Result.IdentEl:=Decl;
  14560. if TPasConst(Decl).VarType<>nil then
  14561. begin
  14562. // typed const
  14563. if Result.Kind=revkInt then
  14564. case ResolvedType.BaseType of
  14565. btByte: TResEvalInt(Result).Typed:=reitByte;
  14566. btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
  14567. btWord: TResEvalInt(Result).Typed:=reitWord;
  14568. btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
  14569. btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
  14570. btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
  14571. btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
  14572. btLongint: TResEvalInt(Result).Typed:=reitLongInt;
  14573. btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
  14574. {$ifdef HasInt64}
  14575. btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
  14576. btInt64: TResEvalInt(Result).Typed:=reitNone; // default
  14577. {$else}
  14578. btIntDouble: TResEvalInt(Result).Typed:=reitNone; // default
  14579. {$endif}
  14580. else
  14581. ReleaseEvalValue(Result);
  14582. RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
  14583. end;
  14584. end;
  14585. exit;
  14586. end;
  14587. end
  14588. else if vmExternal in TPasConst(Decl).VarModifiers then
  14589. begin
  14590. Result:=TResEvalExternal.Create;
  14591. Result.IdentEl:=Decl;
  14592. exit;
  14593. end;
  14594. if refConst in Flags then
  14595. begin
  14596. ReleaseEvalValue(Result);
  14597. RaiseConstantExprExp(20170518214928,Expr);
  14598. end;
  14599. end
  14600. else if C=TPasEnumValue then
  14601. begin
  14602. EnumValue:=TPasEnumValue(Decl);
  14603. EnumType:=EnumValue.Parent as TPasEnumType;
  14604. Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
  14605. exit;
  14606. end
  14607. else if C.InheritsFrom(TPasType) then
  14608. Result:=EvalTypeRange(TPasType(Decl),Flags);
  14609. {$IFDEF VerbosePasResEval}
  14610. writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags,' refConstExt=',refConstExt in Flags);
  14611. {$ENDIF}
  14612. if (Result=nil) and ([refConst,refConstExt]*Flags<>[]) then
  14613. RaiseConstantExprExp(20170518213616,Expr);
  14614. if Sender=nil then ;
  14615. end;
  14616. function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
  14617. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  14618. var
  14619. Ref: TResolvedReference;
  14620. Decl: TPasElement;
  14621. C: TClass;
  14622. BuiltInProc: TResElDataBuiltInProc;
  14623. bt: TResolverBaseType;
  14624. ResolvedEl: TPasResolverResult;
  14625. TypeEl: TPasType;
  14626. begin
  14627. Result:=nil;
  14628. case Params.Kind of
  14629. pekArrayParams: ;
  14630. pekFuncParams:
  14631. if Params.Value.CustomData is TResolvedReference then
  14632. begin
  14633. Ref:=TResolvedReference(Params.Value.CustomData);
  14634. Decl:=Ref.Declaration;
  14635. if Decl is TPasType then
  14636. Decl:=ResolveAliasType(TPasType(Decl));
  14637. C:=Decl.ClassType;
  14638. if C=TPasUnresolvedSymbolRef then
  14639. begin
  14640. if Decl.CustomData is TResElDataBuiltInProc then
  14641. begin
  14642. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  14643. {$IFDEF VerbosePasResEval}
  14644. writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14645. {$ENDIF}
  14646. if BuiltInProc.Eval<>nil then
  14647. BuiltInProc.Eval(BuiltInProc,Params,Flags,Result)
  14648. else
  14649. case BuiltInProc.BuiltIn of
  14650. bfAssigned: Result:=nil;
  14651. bfConcatArray: Result:=nil;
  14652. bfCopyArray: Result:=nil;
  14653. bfTypeInfo: Result:=nil;
  14654. else
  14655. {$IFDEF VerbosePasResEval}
  14656. writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14657. {$ENDIF}
  14658. RaiseNotYetImplemented(20170624192324,Params);
  14659. end;
  14660. {$IFDEF VerbosePasResEval}
  14661. {AllowWriteln}
  14662. if Result<>nil then
  14663. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
  14664. else
  14665. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
  14666. {AllowWriteln-}
  14667. {$ENDIF}
  14668. exit;
  14669. end
  14670. else if Decl.CustomData is TResElDataBaseType then
  14671. begin
  14672. // typecast to basetype
  14673. bt:=TResElDataBaseType(Decl.CustomData).BaseType;
  14674. Result:=EvalBaseTypeCast(Params,bt);
  14675. end;
  14676. {$IFDEF VerbosePasResEval}
  14677. writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
  14678. {$ENDIF}
  14679. end
  14680. else if C=TPasEnumType then
  14681. begin
  14682. // typecast to enumtype
  14683. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
  14684. end
  14685. else if C=TPasRangeType then
  14686. begin
  14687. // typecast to custom range
  14688. ComputeElement(TPasRangeType(Decl).RangeExpr.left,ResolvedEl,[rcConstant]);
  14689. if ResolvedEl.BaseType=btContext then
  14690. begin
  14691. TypeEl:=ResolvedEl.LoTypeEl;
  14692. if TypeEl.ClassType=TPasEnumType then
  14693. begin
  14694. // typecast to enumtype
  14695. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(TypeEl),Params.Params[0],Flags);
  14696. end
  14697. else
  14698. RaiseNotYetImplemented(20171009223403,Params);
  14699. end
  14700. else
  14701. RaiseNotYetImplemented(20171009223303,Params);
  14702. end;
  14703. end;
  14704. pekSet: ;
  14705. end;
  14706. if Flags=[] then ;
  14707. if Sender=nil then ;
  14708. end;
  14709. procedure TPasResolver.OnRangeCheckEl(Sender: TResExprEvaluator;
  14710. El: TPasElement; var MsgType: TMessageType);
  14711. begin
  14712. if El=nil then exit;
  14713. if (MsgType=mtWarning)
  14714. and (bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
  14715. MsgType:=mtError;
  14716. if Sender=nil then ;
  14717. end;
  14718. function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
  14719. bt: TResolverBaseType): TResEvalvalue;
  14720. procedure TCFloatToInt(Value: TResEvalValue; Flo: TMaxPrecFloat);
  14721. var
  14722. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14723. begin
  14724. if bt in btAllIntegerNoQWord then
  14725. begin
  14726. // float to int
  14727. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14728. if (Flo<MinIntVal) or (Flo>MaxIntVal) then
  14729. fExprEvaluator.EmitRangeCheckConst(20170711001228,
  14730. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14731. {$R-}
  14732. try
  14733. Int:=Round(Flo);
  14734. except
  14735. RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
  14736. end;
  14737. case bt of
  14738. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14739. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14740. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14741. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14742. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14743. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14744. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14745. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14746. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14747. {$ifdef HasInt64}
  14748. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14749. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14750. {$else}
  14751. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14752. {$endif}
  14753. else
  14754. RaiseNotYetImplemented(20170711001513,Params);
  14755. end;
  14756. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14757. exit;
  14758. end
  14759. else if bt=btSingle then
  14760. begin
  14761. // float to single
  14762. try
  14763. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Flo));
  14764. except
  14765. RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
  14766. end;
  14767. end
  14768. else if bt=btDouble then
  14769. begin
  14770. // float to double
  14771. try
  14772. Result:=TResEvalFloat.CreateValue(double(Flo));
  14773. except
  14774. RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
  14775. end;
  14776. end
  14777. else if bt=btCurrency then
  14778. begin
  14779. // float to currency
  14780. try
  14781. Result:=TResEvalCurrency.CreateValue(Currency(Flo));
  14782. except
  14783. RaiseMsg(20180421171840,nRangeCheckError,sRangeCheckError,[],Params);
  14784. end;
  14785. end
  14786. else
  14787. begin
  14788. {$IFDEF VerbosePasResEval}
  14789. writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
  14790. {$ENDIF}
  14791. RaiseNotYetImplemented(20170711002542,Params);
  14792. end;
  14793. end;
  14794. var
  14795. Value: TResEvalValue;
  14796. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14797. Flo: TMaxPrecFloat;
  14798. w: WideChar;
  14799. begin
  14800. Result:=nil;
  14801. {$IFDEF VerbosePasResEval}
  14802. writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
  14803. {$ENDIF}
  14804. Value:=Eval(Params.Params[0],[refAutoConstExt]);
  14805. if Value=nil then exit;
  14806. try
  14807. case Value.Kind of
  14808. revkInt:
  14809. begin
  14810. Int:=TResEvalInt(Value).Int;
  14811. {$ifdef HasInt64}
  14812. if bt=btQWord then
  14813. begin
  14814. // int to qword
  14815. {$R-}
  14816. Result:=TResEvalUInt.CreateValue(TMaxPrecUInt(Int));
  14817. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14818. end
  14819. else
  14820. {$endif}
  14821. if bt in btAllIntegerNoQWord then
  14822. begin
  14823. // int to int
  14824. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14825. if (Int<MinIntVal) or (Int>MaxIntVal) then
  14826. begin
  14827. {$R-}
  14828. case bt of
  14829. btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
  14830. btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
  14831. btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
  14832. btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
  14833. btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
  14834. btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
  14835. {$ifdef HasInt64}
  14836. btInt64: Result:=TResEvalInt.CreateValue(Int);
  14837. {$endif}
  14838. btUIntSingle,
  14839. btIntSingle,
  14840. btUIntDouble,
  14841. btIntDouble:
  14842. fExprEvaluator.EmitRangeCheckConst(20170624194534,
  14843. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14844. else
  14845. RaiseNotYetImplemented(20170624200109,Params);
  14846. end;
  14847. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14848. end
  14849. else
  14850. begin
  14851. {$R-}
  14852. case bt of
  14853. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14854. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14855. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14856. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14857. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14858. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14859. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14860. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14861. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14862. {$ifdef HasInt64}
  14863. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14864. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14865. {$else}
  14866. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14867. {$endif}
  14868. else
  14869. RaiseNotYetImplemented(20170624200109,Params);
  14870. end;
  14871. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14872. end;
  14873. exit;
  14874. end
  14875. else if bt in btAllBooleans then
  14876. case Int of
  14877. 0: Result:=TResEvalBool.CreateValue(false);
  14878. 1: Result:=TResEvalBool.CreateValue(true);
  14879. else
  14880. fExprEvaluator.EmitRangeCheckConst(20170710203254,
  14881. Value.AsString,0,1,Params,mtError);
  14882. end
  14883. {$ifdef FPC_HAS_CPSTRING}
  14884. else if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14885. try
  14886. Result:=TResEvalString.CreateValue(Char(Int));
  14887. except
  14888. RaiseMsg(20180125112510,nRangeCheckError,sRangeCheckError,[],Params);
  14889. end
  14890. {$endif}
  14891. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14892. try
  14893. w:=WideChar(Int);
  14894. Result:=TResEvalUTF16.CreateValue(w);
  14895. except
  14896. RaiseMsg(20180125112716,nRangeCheckError,sRangeCheckError,[],Params);
  14897. end
  14898. else if bt=btSingle then
  14899. try
  14900. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Int));
  14901. except
  14902. RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
  14903. end
  14904. else if bt=btDouble then
  14905. try
  14906. Result:=TResEvalFloat.CreateValue(Double(Int));
  14907. except
  14908. RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
  14909. end
  14910. else if bt=btCurrency then
  14911. try
  14912. Result:=TResEvalCurrency.CreateValue(Currency(Int));
  14913. except
  14914. RaiseMsg(20180422093631,nRangeCheckError,sRangeCheckError,[],Params);
  14915. end
  14916. else
  14917. begin
  14918. {$IFDEF VerbosePasResEval}
  14919. writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
  14920. {$ENDIF}
  14921. RaiseNotYetImplemented(20170624194308,Params);
  14922. end;
  14923. end;
  14924. revkFloat:
  14925. begin
  14926. Flo:=TResEvalFloat(Value).FloatValue;
  14927. TCFloatToInt(Value,Flo);
  14928. end;
  14929. revkCurrency:
  14930. begin
  14931. if bt=btCurrency then
  14932. begin
  14933. Result:=Value;
  14934. Value:=nil;
  14935. end
  14936. else
  14937. begin
  14938. Flo:=TResEvalCurrency(Value).Value;
  14939. TCFloatToInt(Value,Flo);
  14940. end;
  14941. end;
  14942. {$ifdef FPC_HAS_CPSTRING}
  14943. revkString:
  14944. begin
  14945. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14946. begin
  14947. // ansichar(ansistring)
  14948. if fExprEvaluator.StringToOrd(Value,nil)>$ffff then
  14949. RaiseXExpectedButYFound(20181005141025,'char','string',Params);
  14950. Result:=Value;
  14951. Value:=nil;
  14952. end
  14953. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14954. begin
  14955. // widechar(ansistring)
  14956. if fExprEvaluator.GetWideChar(TResEvalString(Value).S,w) then
  14957. begin
  14958. Result:=Value;
  14959. Value:=nil;
  14960. end
  14961. else
  14962. RaiseXExpectedButYFound(20181005141058,'char','string',Params);
  14963. end
  14964. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  14965. begin
  14966. // ansistring(ansistring)
  14967. Result:=Value;
  14968. Value:=nil;
  14969. end
  14970. else if (bt=btUnicodeString) or (bt=btWideString)
  14971. or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  14972. begin
  14973. // unicodestring(ansistring)
  14974. Result:=TResEvalUTF16.CreateValue(
  14975. fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Params));
  14976. end
  14977. else if bt=btRawByteString then
  14978. begin
  14979. // rawbytestring(ansistring)
  14980. SetCodePage(TResEvalString(Value).S,CP_NONE,false);
  14981. end;
  14982. end;
  14983. {$endif}
  14984. revkUnicodeString:
  14985. if (length(TResEvalUTF16(Value).S)=1) and (bt in btAllChars) then
  14986. begin
  14987. w:=TResEvalUTF16(Value).S[1];
  14988. {$ifdef FPC_HAS_CPSTRING}
  14989. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14990. begin
  14991. // ansichar(unicodestring)
  14992. if ord(w)<=255 then
  14993. begin
  14994. Result:=Value;
  14995. Value:=nil;
  14996. end
  14997. else
  14998. RaiseMsg(20181005141632,nRangeCheckError,sRangeCheckError,[],Params);
  14999. end
  15000. else
  15001. {$endif}
  15002. if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  15003. begin
  15004. // widechar(unicodestring)
  15005. Result:=Value;
  15006. Value:=nil;
  15007. end;
  15008. end
  15009. {$ifdef FPC_HAS_CPSTRING}
  15010. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  15011. begin
  15012. // ansistring(unicodestring)
  15013. Result:=TResEvalString.CreateValue(
  15014. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
  15015. end
  15016. else if bt=btRawByteString then
  15017. begin
  15018. // rawbytestring(unicodestring)
  15019. Result:=TResEvalString.CreateValue(
  15020. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
  15021. end
  15022. {$endif}
  15023. else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  15024. begin
  15025. // unicodestring(unicodestring)
  15026. Result:=Value;
  15027. Value:=nil;
  15028. end;
  15029. revkExternal:
  15030. exit;
  15031. else
  15032. {$IFDEF VerbosePasResEval}
  15033. writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
  15034. {$ENDIF}
  15035. RaiseNotYetImplemented(20170624193436,Params);
  15036. end;
  15037. finally
  15038. ReleaseEvalValue(Value);
  15039. end;
  15040. end;
  15041. procedure TPasResolver.AddGenericTemplateIdentifiers(
  15042. GenericTemplateTypes: TFPList; Scope: TPasIdentifierScope);
  15043. var
  15044. TemplType: TPasGenericTemplateType;
  15045. i: Integer;
  15046. begin
  15047. if GenericTemplateTypes=nil then exit;
  15048. for i:=0 to GenericTemplateTypes.Count-1 do
  15049. begin
  15050. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  15051. Scope.AddIdentifier(TemplType.Name,TemplType,pikSimple);
  15052. end;
  15053. end;
  15054. procedure TPasResolver.AddSpecializedTemplateIdentifiers(
  15055. GenericTemplateTypes: TFPList; SpecializedItem: TPRSpecializedItem;
  15056. Scope: TPasIdentifierScope; CheckConstraints: boolean);
  15057. var
  15058. i: Integer;
  15059. TemplType: TPasGenericTemplateType;
  15060. ParamTypes: TPasTypeArray;
  15061. ParamType: TPasType;
  15062. ErrorPos: TPasElement;
  15063. begin
  15064. ParamTypes:=SpecializedItem.Params;
  15065. ErrorPos:=SpecializedItem.FirstSpecialize;
  15066. for i:=0 to length(ParamTypes)-1 do
  15067. begin
  15068. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  15069. ParamType:=ParamTypes[i];
  15070. if CheckConstraints then
  15071. begin
  15072. if ParamType is TPasGenericTemplateType then
  15073. CheckTemplateFitsTemplate(TPasGenericTemplateType(ParamType),
  15074. TemplType,ErrorPos)
  15075. else
  15076. CheckTemplateFitsParam(ParamType,TemplType,SpecializedItem,
  15077. prtcoAssignToTempl,ErrorPos);
  15078. end;
  15079. AddIdentifier(Scope,TemplType.Name,ParamTypes[i],pikSimple);
  15080. end;
  15081. end;
  15082. function TPasResolver.CreateInferenceTypesForCall(Params: TParamsExpr;
  15083. TargetProc: TPasProcedure): TFPList;
  15084. type
  15085. TInferredType = record
  15086. InferType: TPasType;
  15087. IsVarOut: boolean;
  15088. end;
  15089. TInferredTypes = array of TInferredType;
  15090. procedure RaiseInferTypeMismatch(const Id: TMaxPrecInt; ArgType: TPasType;
  15091. ErrorPos: TPasElement);
  15092. begin
  15093. RaiseMsg(Id,nInferredTypeXFromDiffArgsMismatchFromMethodY,
  15094. sInferredTypeXFromDiffArgsMismatchFromMethodY,
  15095. [ArgType.Name,TargetProc.Name],ErrorPos);
  15096. end;
  15097. procedure Infer(ArgParent: TPasElement; ArgType, ParamLoType, ParamHiType: TPasType;
  15098. NeedVar, IsSubType, IsDelphi: boolean;
  15099. InferenceParams: TInferredTypes; TemplTypes: TFPList;
  15100. ErrorPos: TPasElement);
  15101. var
  15102. C: TClass;
  15103. i: Integer;
  15104. OldInferType, ParamElType: TPasType;
  15105. ResolveAlias: TPRResolveAlias;
  15106. Arr: TPasArrayType;
  15107. Param1Resolved, Param2Resolved: TPasResolverResult;
  15108. NewBaseType, BaseType1, BaseType2: TResolverBaseType;
  15109. begin
  15110. if (ArgType=nil) or (ParamLoType=nil) then exit;
  15111. C:=ArgType.ClassType;
  15112. if C=TPasGenericTemplateType then
  15113. begin
  15114. i:=TemplTypes.IndexOf(ArgType);
  15115. if i>=0 then
  15116. begin
  15117. // a generic type param corresponds to ParamType
  15118. OldInferType:=InferenceParams[i].InferType;
  15119. if OldInferType=nil then
  15120. begin
  15121. // template type inferred first time
  15122. InferenceParams[i].InferType:=ParamHiType;
  15123. InferenceParams[i].IsVarOut:=NeedVar;
  15124. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15125. exit;
  15126. end;
  15127. // already inferred -> check compatibility
  15128. ResolveAlias:=prraAlias;
  15129. if IsDelphi and (NeedVar or InferenceParams[i].IsVarOut) then
  15130. // Delphi allows passing alias, but not type alias to a var arg
  15131. ResolveAlias:=prraSimple;
  15132. if IsSameType(OldInferType,ParamHiType,ResolveAlias) then
  15133. exit; // same types -> ok
  15134. if IsSubType then
  15135. begin
  15136. if CheckElTypeCompatibility(OldInferType,InferenceParams[i].InferType,
  15137. ResolveAlias)<=cGenericExact then
  15138. exit;
  15139. // e.g. "array of TA" and "array of TB"
  15140. RaiseInferTypeMismatch(20191006215539,ArgType,ErrorPos);
  15141. end;
  15142. // top level type does not fit exactly
  15143. if NeedVar then
  15144. begin
  15145. // second is var/out
  15146. if InferenceParams[i].IsVarOut then
  15147. // two var/out arguments mismatch
  15148. RaiseInferTypeMismatch(20191006220355,ArgType,ErrorPos);
  15149. if CheckAssignCompatibility(ParamHiType,OldInferType,
  15150. false,ErrorPos)=cIncompatible then
  15151. // second is var/out, and do not match
  15152. RaiseInferTypeMismatch(20191006220402,ArgType,ErrorPos);
  15153. // first can be widened to fit
  15154. InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15155. InferenceParams[i].InferType:=ParamHiType;
  15156. InferenceParams[i].IsVarOut:=NeedVar;
  15157. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15158. exit;
  15159. end
  15160. else if InferenceParams[i].IsVarOut then
  15161. begin
  15162. // first was var/out
  15163. if CheckAssignCompatibility(OldInferType,ParamHiType,
  15164. false,ErrorPos)=cIncompatible then
  15165. // first was var/out, and do not match
  15166. RaiseInferTypeMismatch(20191006220750,ArgType,ErrorPos);
  15167. // second can be widened to fit
  15168. exit;
  15169. end;
  15170. // None is var/out -> find a type compatible to both
  15171. // widen type to some common base types to avoid high number of specialization
  15172. ComputeElement(ParamHiType,Param1Resolved,[],ErrorPos);
  15173. ComputeElement(InferenceParams[i].InferType,Param2Resolved,[],ErrorPos);
  15174. NewBaseType:=btNone;
  15175. BaseType1:=Param1Resolved.BaseType;
  15176. BaseType2:=Param2Resolved.BaseType;
  15177. if BaseType1 in btAllBooleans then
  15178. begin
  15179. if BaseType2 in btAllBooleans then
  15180. if BaseTypes[btBoolean]<>nil then
  15181. NewBaseType:=btBoolean
  15182. else
  15183. NewBaseType:=GetCombinedBoolean(BaseType1,BaseType2,ErrorPos);
  15184. end
  15185. else if BaseType1 in btAllInteger then
  15186. begin
  15187. NewBaseType:=TResolverBaseType(Max(ord(BaseType1),ord(BaseType2)));
  15188. if (BaseTypes[btLongint]<>nil)
  15189. and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint])
  15190. and (BaseType1<>btLongWord) and (BaseType2<>btLongWord) then
  15191. NewBaseType:=btLongint
  15192. {$ifdef HasInt64}
  15193. else if (BaseTypes[btInt64]<>nil)
  15194. and (NewBaseType<=btInt64)
  15195. and (BaseType1<>btQWord) and (BaseType2<>btQWord) then
  15196. NewBaseType:=btInt64
  15197. {$endif}
  15198. else if (BaseTypes[btIntDouble]<>nil)
  15199. and (NewBaseType<=btIntDouble) then
  15200. NewBaseType:=btIntDouble
  15201. {$ifdef HasInt64}
  15202. else if (BaseTypes[btQWord]<>nil)
  15203. and not (NewBaseType in btAllSignedInteger) then
  15204. NewBaseType:=btQWord
  15205. {$endif}
  15206. else
  15207. NewBaseType:=GetCombinedInt(Param1Resolved,Param2Resolved,ErrorPos);
  15208. end
  15209. else if Param1Resolved.BaseType in btAllStringAndChars then
  15210. begin
  15211. if Param2Resolved.BaseType in btAllStringAndChars then
  15212. if BaseTypes[btUnicodeString]<>nil then
  15213. NewBaseType:=btUnicodeString
  15214. else
  15215. NewBaseType:=GetCombinedString(Param1Resolved,Param2Resolved,ErrorPos);
  15216. end
  15217. else if Param1Resolved.BaseType in btAllFloats then
  15218. begin
  15219. if BaseTypes[btDouble]<>nil then
  15220. NewBaseType:=btDouble;
  15221. end;
  15222. if NewBaseType<>btNone then
  15223. begin
  15224. InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15225. InferenceParams[i].InferType:=BaseTypes[NewBaseType];
  15226. InferenceParams[i].IsVarOut:=NeedVar;
  15227. BaseTypes[NewBaseType].AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15228. exit;
  15229. end;
  15230. // ToDo
  15231. RaiseInferTypeMismatch(20191006220406,ArgType,ErrorPos);
  15232. end;
  15233. end
  15234. else if ArgParent<>ArgType.Parent then
  15235. // ArgType is a reference
  15236. else if C=TPasArrayType then
  15237. begin
  15238. // e.g. Proc(a: array...)
  15239. Arr:=TPasArrayType(ArgType);
  15240. if ParamLoType.ClassType<>TPasArrayType then
  15241. exit;
  15242. ParamElType:=TPasArrayType(ParamLoType).ElType;
  15243. Infer(Arr,Arr.ElType,ParamElType,ResolveAliasType(ParamElType),
  15244. NeedVar,true,IsDelphi,InferenceParams,TemplTypes,ErrorPos);
  15245. end
  15246. else
  15247. begin
  15248. {$IFDEF VerbosePasResolver}
  15249. //writeln('Infer ArgType=',GetObjName(ArgType),' ParamLoType=',GetObjName(ParamLoType));
  15250. {$ENDIF}
  15251. end;
  15252. end;
  15253. procedure InferParam(i: integer; NeedVar: boolean; ParamsExprs: TPasExprArray;
  15254. ProcArgs: TFPList;
  15255. InferenceParams: TInferredTypes; TemplTypes: TFPList; IsDelphi: boolean);
  15256. var
  15257. Arg: TPasArgument;
  15258. ArgType: TPasType;
  15259. ArgResolved, ExprResolved: TPasResolverResult;
  15260. Expr: TPasExpr;
  15261. begin
  15262. //writeln('InferParam i=',i,' NeedVar=',NeedVar,' IsDelphi=',IsDelphi,' ProcArgs.Count=',ProcArgs.Count);
  15263. Arg:=TPasArgument(ProcArgs[i]);
  15264. ArgType:=Arg.ArgType;
  15265. if ArgType=nil then
  15266. exit; // untyped arg
  15267. if (ArgType.Parent<>Arg) and (ArgType.ClassType<>TPasGenericTemplateType) then
  15268. exit; // a reference -> no need to search for a template reference
  15269. if NeedVar<>(Arg.Access in [argVar, argOut]) then
  15270. exit;
  15271. if i<length(ParamsExprs) then
  15272. Expr:=ParamsExprs[i]
  15273. else
  15274. begin
  15275. Expr:=Arg.ValueExpr;
  15276. if Expr=nil then exit;
  15277. end;
  15278. ComputeArgumentAndExpr(Arg,ArgResolved,Expr,ExprResolved,false);
  15279. {$IFDEF VerbosePasResolver}
  15280. writeln('TPasResolver.CreateInferenceTypesForCall Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  15281. {$ENDIF}
  15282. if ExprResolved.BaseType in btAllWithSubType then
  15283. begin
  15284. // passing a literal set or array or custom range
  15285. {$IFDEF VerbosePasResolver}
  15286. writeln('TPasResolver.CreateInferenceTypesForCall.InferParam ToDo: ',GetResolverResultDbg(ExprResolved));
  15287. {$ENDIF}
  15288. end
  15289. else if (ExprResolved.SubType<>btNone) then
  15290. RaiseNotYetImplemented(20191006203622,Expr)
  15291. else
  15292. Infer(Arg,ArgType,ExprResolved.LoTypeEl,ExprResolved.HiTypeEl,
  15293. NeedVar,false,IsDelphi,
  15294. InferenceParams,TemplTypes,Expr);
  15295. end;
  15296. var
  15297. TemplTypes, ProcArgs: TFPList;
  15298. InferenceTypes: TInferredTypes;
  15299. ParamsExprs: TPasExprArray;
  15300. IsDelphi: Boolean;
  15301. i: Integer;
  15302. begin
  15303. Result:=nil;
  15304. TemplTypes:=GetProcTemplateTypes(TargetProc);
  15305. if (TemplTypes=nil) or (TemplTypes.Count=0) then
  15306. RaiseNotYetImplemented(20191006174321,Params);
  15307. ProcArgs:=TargetProc.ProcType.Args;
  15308. ParamsExprs:=Params.Params;
  15309. if ProcArgs.Count<length(ParamsExprs) then
  15310. RaiseNotYetImplemented(20191006183021,Params);
  15311. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  15312. try
  15313. SetLength(InferenceTypes{%H-},TemplTypes.Count);
  15314. for i:=0 to TemplTypes.Count-1 do
  15315. InferenceTypes[i]:=Default(TInferredType);
  15316. // first infer from var/out args exact types
  15317. for i:=0 to ProcArgs.Count-1 do
  15318. InferParam(i,true,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  15319. // then infer from the other args
  15320. for i:=0 to ProcArgs.Count-1 do
  15321. InferParam(i,false,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  15322. // check that all types are inferred
  15323. for i:=0 to TemplTypes.Count-1 do
  15324. if InferenceTypes[i].InferType=nil then
  15325. RaiseMsg(20191006175104,nCouldNotInferTypeArgXForMethodY,
  15326. sCouldNotInferTypeArgXForMethodY,
  15327. [TPasGenericTemplateType(TemplTypes[i]).Name,TargetProc.Name],Params);
  15328. Result:=TFPList.Create;
  15329. for i:=0 to length(InferenceTypes)-1 do
  15330. begin
  15331. Result.Add(InferenceTypes[i].InferType);
  15332. InferenceTypes[i].InferType:=nil;
  15333. end;
  15334. finally
  15335. if Result=nil then
  15336. for i:=0 to length(InferenceTypes)-1 do
  15337. if InferenceTypes[i].InferType<>nil then
  15338. InferenceTypes[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15339. end;
  15340. end;
  15341. function TPasResolver.CheckGenericConstraintFitsParam(ParamType: TPasType;
  15342. SpecializedItem: TPRSpecializedItem; TemplType: TPasGenericTemplateType;
  15343. ConEl: TPasElement; Operation: TPRTemplateCompOp; ErrorPos: TPasElement
  15344. ): integer;
  15345. function RaiseXExpButYFound(id: TMaxPrecInt; const X: string; Y: TPasType): integer;
  15346. begin
  15347. if ErrorPos<>nil then
  15348. RaiseXExpectedButTypeYFound(id,X,Y,ErrorPos);
  15349. Result:=cIncompatible;
  15350. end;
  15351. procedure RaiseNotValidConstraint(Id: TMaxPrecInt; ConEl: TPasElement);
  15352. begin
  15353. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15354. [GetElementSourcePosStr(ConEl)],ErrorPos);
  15355. end;
  15356. function ElementReferencesTemplateTypes(El: TPasElement;
  15357. GenericTemplateTypes: TFPList): boolean;
  15358. var
  15359. C: TClass;
  15360. Prim: TPrimitiveExpr;
  15361. Decl: TPasElement;
  15362. Bin: TBinaryExpr;
  15363. Spec: TPasSpecializeType;
  15364. Arr: TPasArrayType;
  15365. i: Integer;
  15366. InlineSpec: TInlineSpecializeExpr;
  15367. begin
  15368. Result:=false;
  15369. if El=nil then exit;
  15370. C:=El.ClassType;
  15371. if C=TPrimitiveExpr then
  15372. begin
  15373. Prim:=TPrimitiveExpr(El);
  15374. if Prim.Kind=pekIdent then
  15375. begin
  15376. if Prim.CustomData is TResolvedReference then
  15377. begin
  15378. Decl:=TResolvedReference(Prim.CustomData).Declaration;
  15379. exit(ElementReferencesTemplateTypes(Decl,GenericTemplateTypes));
  15380. end;
  15381. end
  15382. else
  15383. exit;
  15384. end
  15385. else if C=TBinaryExpr then
  15386. begin
  15387. Bin:=TBinaryExpr(El);
  15388. Result:=ElementReferencesTemplateTypes(Bin.left,GenericTemplateTypes)
  15389. or ElementReferencesTemplateTypes(Bin.right,GenericTemplateTypes);
  15390. end
  15391. else if C=TInlineSpecializeExpr then
  15392. begin
  15393. InlineSpec:=TInlineSpecializeExpr(El);
  15394. if ElementReferencesTemplateTypes(InlineSpec.NameExpr,GenericTemplateTypes) then
  15395. exit(true);
  15396. for i:=0 to InlineSpec.Params.Count-1 do
  15397. begin
  15398. Decl:=TPasElement(InlineSpec.Params[i]);
  15399. if Decl.Parent<>InlineSpec then continue;
  15400. if ElementReferencesTemplateTypes(Decl,GenericTemplateTypes) then
  15401. exit(true);
  15402. end;
  15403. end
  15404. else if C=TPasGenericTemplateType then
  15405. Result:=GenericTemplateTypes.IndexOf(El)>=0
  15406. else if C.InheritsFrom(TPasType) then
  15407. begin
  15408. if TPasType(El).Name<>'' then exit;
  15409. if C=TPasSpecializeType then
  15410. begin
  15411. Spec:=TPasSpecializeType(El);
  15412. if ElementReferencesTemplateTypes(Spec.DestType,GenericTemplateTypes) then
  15413. exit(true);
  15414. for i:=0 to Spec.Params.Count-1 do
  15415. if ElementReferencesTemplateTypes(TPasElement(Spec.Params[i]),GenericTemplateTypes) then
  15416. exit(true);
  15417. end
  15418. else if C=TPasArrayType then
  15419. begin
  15420. Arr:=TPasArrayType(El);
  15421. for i:=0 to length(Arr.Ranges)-1 do
  15422. if ElementReferencesTemplateTypes(Arr.Ranges[i],GenericTemplateTypes) then exit(true);
  15423. Result:=ElementReferencesTemplateTypes(Arr.ElType,GenericTemplateTypes);
  15424. end
  15425. else if C=TPasPointerType then
  15426. Result:=ElementReferencesTemplateTypes(TPasPointerType(El).DestType,GenericTemplateTypes)
  15427. else if C=TPasSetType then
  15428. Result:=ElementReferencesTemplateTypes(TPasSetType(El).EnumType,GenericTemplateTypes)
  15429. else if C=TPasEnumType then
  15430. else
  15431. RaiseNotYetImplemented(20190905110152,El);
  15432. end
  15433. else
  15434. RaiseNotYetImplemented(20190905105648,El);
  15435. end;
  15436. var
  15437. ConToken: TToken;
  15438. aClass, ConstraintClass: TPasClassType;
  15439. GenTempl: TPasGenericTemplateType;
  15440. i: Integer;
  15441. ResolvedEl: TPasResolverResult;
  15442. ConType: TPasType;
  15443. GenericTemplateTypes: TFPList;
  15444. GenericEl: TPasElement;
  15445. begin
  15446. ConToken:=GetGenericConstraintKeyword(ConEl);
  15447. case ConToken of
  15448. tkrecord:
  15449. begin
  15450. if ParamType is TPasRecordType then exit(cExact);
  15451. exit(RaiseXExpButYFound(20190725200015,'record type',ParamType));
  15452. end;
  15453. tkclass,tkconstructor:
  15454. begin
  15455. if not (ParamType is TPasClassType) then
  15456. exit(RaiseXExpButYFound(20190726133231,'class type',ParamType));
  15457. aClass:=TPasClassType(ParamType);
  15458. if aClass.ObjKind<>okClass then
  15459. exit(RaiseXExpButYFound(20190726133232,'class type',ParamType));
  15460. if aClass.IsExternal then
  15461. exit(RaiseXExpButYFound(20190726133233,'non external class type',ParamType));
  15462. if ConToken=tkconstructor then
  15463. begin
  15464. if FindDefaultConstructor(aClass)=nil then
  15465. exit(RaiseXExpButYFound(20190831000225,'class type with constructor create()',ParamType));
  15466. end;
  15467. exit;
  15468. end;
  15469. end;
  15470. if not (ConEl is TPasType) then
  15471. RaiseNotYetImplemented(20190912214727,ConEl,GetObjPath(ErrorPos));
  15472. // constraint can be a class type, interface type or a template type
  15473. // Param must be a class
  15474. if SpecializedItem<>nil then
  15475. begin
  15476. GenericEl:=SpecializedItem.GenericEl;
  15477. if GenericEl is TPasGenericType then
  15478. GenericTemplateTypes:=TPasGenericType(GenericEl).GenericTemplateTypes
  15479. else if GenericEl is TPasProcedure then
  15480. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(GenericEl))
  15481. else
  15482. RaiseNotYetImplemented(20190920114755,ConEl);
  15483. if ElementReferencesTemplateTypes(ConEl,GenericTemplateTypes) then
  15484. begin
  15485. // constraint contains templates -> specialize constraint
  15486. if ConEl is TPasType then
  15487. begin
  15488. // type reference
  15489. ConType:=TPasType(ConEl);
  15490. i:=length(SpecializedItem.SpecializedConstraints);
  15491. Setlength(SpecializedItem.SpecializedConstraints,i+1);
  15492. SpecializedItem.SpecializedConstraints[i]:=nil;
  15493. SpecializeElType(TemplType,SpecializedItem.SpecializedEl,ConType,
  15494. TPasType(SpecializedItem.SpecializedConstraints[i]));
  15495. ConEl:=SpecializedItem.SpecializedConstraints[i];
  15496. end
  15497. else
  15498. // non type reference
  15499. RaiseNotValidConstraint(20190915181137,ConEl);
  15500. end;
  15501. end;
  15502. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15503. if ResolvedEl.BaseType<>btContext then
  15504. RaiseNotValidConstraint(20190914105836,ConEl);
  15505. if ResolvedEl.HiTypeEl.Name='' then
  15506. RaiseNotValidConstraint(20190726134037,GetGenericConstraintErrorEl(ConEl,TemplType));
  15507. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  15508. begin
  15509. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  15510. if GenTempl=ConEl.Parent then
  15511. RaiseNotYetImplemented(20190831213359,GenTempl);
  15512. Result:=CheckTemplateFitsParam(ParamType,GenTempl,nil,Operation,ErrorPos);
  15513. end
  15514. else if ResolvedEl.LoTypeEl is TPasClassType then
  15515. begin
  15516. // constraint is classtype or interfacetype
  15517. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15518. if not (ParamType is TPasClassType) then
  15519. begin
  15520. if ErrorPos<>nil then
  15521. RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],
  15522. ParamType,ConstraintClass,ErrorPos);
  15523. exit(cIncompatible);
  15524. end;
  15525. if not (TPasClassType(ParamType).ObjKind in [okClass,okInterface]) then
  15526. begin
  15527. if ErrorPos<>nil then
  15528. RaiseMsg(20190904175144,nXExpectedButYFound,sXExpectedButYFound,
  15529. ['class',GetTypeDescription(ParamType)],ErrorPos);
  15530. exit(cIncompatible);
  15531. end;
  15532. case ConstraintClass.ObjKind of
  15533. okClass:
  15534. case Operation of
  15535. prtcoAssignToTempl:
  15536. // TemplateClass:=ParamClassType
  15537. if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
  15538. begin
  15539. // ParamType is not ConstraintClass
  15540. if ErrorPos<>nil then
  15541. RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],
  15542. ParamType,ConstraintClass,ErrorPos);
  15543. exit(cIncompatible);
  15544. end;
  15545. prtcoAssignFromTempl:
  15546. // ParamClassType:=TemplateClass
  15547. if CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible then
  15548. begin
  15549. // ConstraintClass is not ParamType
  15550. if ErrorPos<>nil then
  15551. RaiseIncompatibleType(20190915202812,nIncompatibleTypesGotExpected,[''],
  15552. ConstraintClass,ParamType,ErrorPos);
  15553. exit(cIncompatible);
  15554. end;
  15555. prtcoEqual:
  15556. // TemplateClass=ParamClassType
  15557. if (CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible)
  15558. and (CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible) then
  15559. begin
  15560. // ParamType is not related to ConstraintClass
  15561. if ErrorPos<>nil then
  15562. RaiseIncompatibleType(20190915203651,nIncompatibleTypesGotExpected,[''],
  15563. ParamType,ConstraintClass,ErrorPos);
  15564. exit(cIncompatible);
  15565. end;
  15566. else
  15567. RaiseNotYetImplemented(20190915203439,ConEl);
  15568. end;
  15569. okInterface:
  15570. case Operation of
  15571. prtcoAssignToTempl:
  15572. // TemplateClassWithIntf:=ParamClassType
  15573. if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
  15574. begin
  15575. // ParamType does not implement ConstraintClass
  15576. if ErrorPos<>nil then
  15577. RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],
  15578. ParamType,ConstraintClass,ErrorPos);
  15579. exit(cIncompatible);
  15580. end;
  15581. prtcoAssignFromTempl:
  15582. // ParamClassType:=TemplateClassWithIntf
  15583. begin
  15584. // check when specialize
  15585. end;
  15586. prtcoEqual:
  15587. // TemplateClassWithIntf=ParamClassType
  15588. begin
  15589. // check when specialize
  15590. end;
  15591. else
  15592. RaiseNotYetImplemented(20190915203218,ConEl);
  15593. end;
  15594. else
  15595. if ErrorPos<>nil then
  15596. RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],
  15597. ParamType,ConstraintClass,ErrorPos);
  15598. exit(cIncompatible);
  15599. end;
  15600. end
  15601. else
  15602. begin
  15603. {$IFDEF VerbosePasResolver}
  15604. writeln('TPasResolver.CheckSpecializedParamFitsConstraintExpr ',GetObjPath(ResolvedEl.LoTypeEl));
  15605. {$ENDIF}
  15606. RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15607. [GetElementSourcePosStr(GetGenericConstraintErrorEl(ConEl,ConEl.Parent))],
  15608. ErrorPos);
  15609. end;
  15610. Result:=cExact;
  15611. end;
  15612. function TPasResolver.CheckTemplateFitsParam(ParamType: TPasType;
  15613. GenTempl: TPasGenericTemplateType; SpecializedItem: TPRSpecializedItem;
  15614. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15615. var
  15616. i: Integer;
  15617. begin
  15618. // check if the ParamType fits the constraints
  15619. for i:=0 to length(GenTempl.Constraints)-1 do
  15620. begin
  15621. Result:=CheckGenericConstraintFitsParam(ParamType,SpecializedItem,
  15622. GenTempl,GenTempl.Constraints[i],Operation,ErrorPos);
  15623. if Result=cIncompatible then exit;
  15624. end;
  15625. Result:=cExact;
  15626. end;
  15627. function TPasResolver.CheckTemplateFitsParamRes(
  15628. GenTempl: TPasGenericTemplateType; const ResolvedEl: TPasResolverResult;
  15629. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15630. var
  15631. i: Integer;
  15632. ConEl: TPasElement;
  15633. ConToken: TToken;
  15634. LoTypeEl: TPasType;
  15635. begin
  15636. if length(GenTempl.Constraints)=0 then
  15637. exit(cGenericExact);
  15638. if ResolvedEl.BaseType=btContext then
  15639. begin
  15640. LoTypeEl:=ResolvedEl.LoTypeEl;
  15641. if LoTypeEl is TPasGenericTemplateType then
  15642. begin
  15643. if LoTypeEl=GenTempl then
  15644. exit(cGenericExact);
  15645. if (Operation=prtcoAssignToTempl) and (ErrorPos<>nil) then
  15646. CheckTemplateFitsTemplate(TPasGenericTemplateType(LoTypeEl),GenTempl,ErrorPos);
  15647. Result:=cGenericExact;
  15648. end
  15649. else
  15650. Result:=CheckTemplateFitsParam(LoTypeEl,GenTempl,nil,Operation,ErrorPos);
  15651. end
  15652. else if ResolvedEl.BaseType=btNil then
  15653. begin
  15654. for i:=0 to length(GenTempl.Constraints)-1 do
  15655. begin
  15656. ConEl:=GenTempl.Constraints[i];
  15657. ConToken:=GetGenericConstraintKeyword(ConEl);
  15658. if ConToken=tkrecord then
  15659. begin
  15660. if ErrorPos<>nil then
  15661. RaiseXExpectedButYFound(20190915211000,'record type','nil',ErrorPos);
  15662. exit(cIncompatible);
  15663. end;
  15664. end;
  15665. Result:=cGenericExact;
  15666. end
  15667. else
  15668. begin
  15669. if ErrorPos<>nil then
  15670. RaiseNotYetImplemented(20190915205441,ErrorPos);
  15671. Result:=cIncompatible;
  15672. end;
  15673. end;
  15674. procedure TPasResolver.CheckTemplateFitsTemplate(ParamTemplType,
  15675. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  15676. procedure RaiseNotValidConstraint(const Id: TMaxPrecInt; ConEl: TPasElement);
  15677. begin
  15678. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15679. [GetElementTypeName(ConEl)],GetGenericConstraintErrorEl(ConEl,GenTempl));
  15680. end;
  15681. var
  15682. ParamConstraints: TPasElementArray;
  15683. j, k: Integer;
  15684. ConToken: TToken;
  15685. ConstraintClass, ParamClassType: TPasClassType;
  15686. ConEl, ParamConstraintEl: TPasElement;
  15687. ParamLoType, ParamHiType: TPasType;
  15688. ResolvedEl: TPasResolverResult;
  15689. begin
  15690. ParamConstraints:=ParamTemplType.Constraints;
  15691. for j:=0 to length(GenTempl.Constraints)-1 do
  15692. begin
  15693. ConEl:=GenTempl.Constraints[j];
  15694. ConToken:=GetGenericConstraintKeyword(ConEl);
  15695. if ConToken<>tkEOF then
  15696. begin
  15697. // constraint is keyword
  15698. // -> check if keyword is in ParamConstraints
  15699. k:=length(ParamConstraints)-1;
  15700. while (k>=0) and (GetGenericConstraintKeyword(ParamConstraints[k])<>ConToken) do
  15701. dec(k);
  15702. if k<0 then
  15703. RaiseMsg(20190816230021,nTypeParamXIsMissingConstraintY,
  15704. sTypeParamXIsMissingConstraintY,
  15705. [ParamTemplType.Name,TokenInfos[ConToken]],ErrorPos);
  15706. end
  15707. else if ConEl is TPasType then
  15708. begin
  15709. // constraint is a type
  15710. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15711. if ResolvedEl.BaseType<>btContext then
  15712. RaiseNotValidConstraint(20190816231846,ConEl);
  15713. if not (ResolvedEl.LoTypeEl is TPasClassType) then
  15714. RaiseNotValidConstraint(20190816231849,ConEl);
  15715. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15716. // constraint is class/interface type
  15717. // -> check if one of ParamConstraints fits the constraint type
  15718. // i.e. ParamConstraints must be more strict than target constraints
  15719. k:=length(ParamConstraints)-1;
  15720. while k>=0 do
  15721. begin
  15722. ParamConstraintEl:=ParamConstraints[k];
  15723. if ParamConstraintEl is TPasType then
  15724. begin
  15725. ParamHiType:=TPasType(ParamConstraintEl);
  15726. ParamLoType:=ResolveAliasType(ParamHiType);
  15727. if not (ParamLoType is TPasClassType) then
  15728. RaiseMsg(20190816232459,nXExpectedButYFound,sXExpectedButYFound,
  15729. ['type',GetTypeDescription(ParamHiType)],
  15730. GetGenericConstraintErrorEl(ParamConstraintEl,ParamTemplType));
  15731. ParamClassType:=TPasClassType(ParamLoType);
  15732. if (ConstraintClass.ObjKind=okInterface)
  15733. and (ParamClassType.ObjKind=okClass) then
  15734. begin
  15735. if GetClassImplementsIntf(ParamClassType,ConstraintClass)<>nil then
  15736. break;
  15737. end
  15738. else
  15739. begin
  15740. if CheckClassIsClass(ParamClassType,ConstraintClass)<cIncompatible then
  15741. break;
  15742. end;
  15743. end;
  15744. dec(k);
  15745. end;
  15746. if k<0 then
  15747. begin
  15748. if ConstraintClass.ObjKind=okInterface then
  15749. RaiseMsg(20190816233102,nTypeParamXMustSupportIntfY,
  15750. sTypeParamXMustSupportIntfY,
  15751. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos)
  15752. else
  15753. RaiseMsg(20190816230021,nTypeParamXIsNotCompatibleWithY,
  15754. sTypeParamXIsNotCompatibleWithY,
  15755. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos);
  15756. end;
  15757. end
  15758. else
  15759. RaiseNotYetImplemented(20190912215702,GetGenericConstraintErrorEl(ConEl,GenTempl));
  15760. end;
  15761. end;
  15762. function TPasResolver.CreateSpecializedItem(El: TPasElement;
  15763. GenericEl: TPasElement; const ParamsResolved: TPasTypeArray
  15764. ): TPRSpecializedItem;
  15765. var
  15766. NewEl: TPasElement;
  15767. GenScope: TPasGenericScope;
  15768. SpecializedItems: TObjectList;
  15769. procedure InsertBehind(List: TFPList);
  15770. var
  15771. Last: TPasElement;
  15772. i, LastIndex: Integer;
  15773. GenScope: TPasGenericScope;
  15774. ProcScope: TPasProcedureScope;
  15775. begin
  15776. // insert in front of currently parsed elements
  15777. // beware: specializing an element can create other specialized elements
  15778. // add behind last finished specialized element of this GenericEl
  15779. // for example: A = class(B<C<D>>)
  15780. // =>
  15781. // D
  15782. // C<D>
  15783. // B<C<D>>
  15784. // A
  15785. Last:=GenericEl;
  15786. if SpecializedItems<>nil then
  15787. begin
  15788. i:=SpecializedItems.Count-2;
  15789. if i>=0 then
  15790. Last:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
  15791. end;
  15792. LastIndex:=List.IndexOf(Last);
  15793. if (LastIndex<0) then
  15794. if GenericEl is TPasProcedure then
  15795. else
  15796. RaiseNotYetImplemented(20200725093218,El);
  15797. i:=List.Count-1;
  15798. while i>LastIndex do
  15799. begin
  15800. Last:=TPasElement(List[i]);
  15801. if Last is TPasGenericType then
  15802. begin
  15803. if (Last.CustomData<>nil) then
  15804. begin
  15805. GenScope:=Last.CustomData as TPasGenericScope;
  15806. if GenScope.GenericStep>=psgsInterfaceParsed then
  15807. break; // finished generic type
  15808. end;
  15809. // type is still parsed => insert in front
  15810. dec(i);
  15811. end
  15812. else if Last is TPasProcedure then
  15813. begin
  15814. ProcScope:=Last.CustomData as TPasProcedureScope;
  15815. if ProcScope.GenericStep>=psgsInterfaceParsed then
  15816. break; // finished generic proc
  15817. // proc is still parsed => insert in front
  15818. dec(i);
  15819. end
  15820. else
  15821. break;
  15822. end;
  15823. List.Insert(i+1,NewEl);
  15824. end;
  15825. var
  15826. NewName: String;
  15827. NewClass: TPTreeElement;
  15828. SrcModule: TPasModule;
  15829. SrcModuleScope: TPasModuleScope;
  15830. SrcResolver: TPasResolver;
  15831. NewParent: TPasElement;
  15832. TypeItem: TPRSpecializedTypeItem;
  15833. ProcItem: TPRSpecializedProcItem;
  15834. begin
  15835. Result:=nil;
  15836. SrcModule:=GenericEl.GetModule;
  15837. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  15838. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  15839. if SrcResolver<>Self then
  15840. RaiseInternalError(20190728121705);
  15841. GenScope:=TPasGenericScope(GenericEl.CustomData);
  15842. SpecializedItems:=GenScope.SpecializedItems;
  15843. TypeItem:=nil;
  15844. ProcItem:=nil;
  15845. if GenericEl is TPasGenericType then
  15846. begin
  15847. TypeItem:=TPRSpecializedTypeItem.Create;
  15848. Result:=TypeItem;
  15849. end
  15850. else if GenericEl is TPasProcedure then
  15851. begin
  15852. ProcItem:=TPRSpecializedProcItem.Create;
  15853. Result:=ProcItem;
  15854. end
  15855. else
  15856. RaiseNotYetImplemented(20190920140756,GenericEl);
  15857. Result.GenericEl:=GenericEl;
  15858. Result.FirstSpecialize:=El;
  15859. Result.Params:=ParamsResolved;
  15860. Result.Index:=SpecializedItems.Count;
  15861. SpecializedItems.Add(Result);
  15862. NewName:=CreateSpecializedTypeName(Result);
  15863. NewClass:=TPTreeElement(GenericEl.ClassType);
  15864. NewParent:=GenericEl.Parent;
  15865. NewEl:=TPasElement(NewClass.Create(NewName,NewParent));
  15866. if TypeItem<>nil then
  15867. TypeItem.SpecializedType:=TPasGenericType(NewEl) // this calls AddRef
  15868. else
  15869. ProcItem.SpecializedProc:=TPasProcedure(NewEl); // this calls AddRef
  15870. if NewParent is TPasDeclarations then
  15871. begin
  15872. InsertBehind(TPasDeclarations(NewParent).Declarations);
  15873. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasDeclarations.Children');{$ENDIF}
  15874. end
  15875. else if NewParent is TPasMembersType then
  15876. begin
  15877. InsertBehind(TPasMembersType(NewParent).Members);
  15878. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasMembersType.Members');{$ENDIF}
  15879. end
  15880. else
  15881. NewEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; // fix refcount
  15882. if GenScope.GenericStep>=psgsInterfaceParsed then
  15883. SpecializeGenericIntf(Result);
  15884. if GenScope.GenericStep>=psgsImplementationParsed then
  15885. SpecializeGenericImpl(Result);
  15886. end;
  15887. function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): string;
  15888. function Get_ProcName(aProc: TPasProcedure): string; forward;
  15889. function GetTypeName(aType: TPasType): string; forward;
  15890. function GetParentName(El: TPasElement): string;
  15891. begin
  15892. if El.Parent is TPasType then
  15893. Result:=GetTypeName(TPasType(El.Parent))
  15894. else if El is TPasUnresolvedSymbolRef then
  15895. Result:='System'
  15896. else if El.Parent is TPasProcedure then
  15897. Result:=Get_ProcName(TPasProcedure(El.Parent))
  15898. else
  15899. Result:=El.GetModule.Name;
  15900. end;
  15901. function Get_ProcName(aProc: TPasProcedure): string;
  15902. begin
  15903. Result:=GetParentName(aProc);
  15904. if aProc.Name<>'' then
  15905. Result:=Result+'.'+aProc.Name;
  15906. end;
  15907. function GetSpecParams(Item: TPRSpecializedItem): string;
  15908. var
  15909. i: Integer;
  15910. begin
  15911. Result:='<';
  15912. for i:=0 to length(Item.Params)-1 do
  15913. begin
  15914. if i>0 then Result:=Result+',';
  15915. Result:=Result+GetTypeName(Item.Params[i]);
  15916. end;
  15917. Result:=Result+'>';
  15918. end;
  15919. function GetTypeName(aType: TPasType): string;
  15920. var
  15921. Arr: TPasArrayType;
  15922. ElType: TPasType;
  15923. ChildItem: TPRSpecializedItem;
  15924. begin
  15925. if aType.Name='' then
  15926. begin
  15927. if aType is TPasArrayType then
  15928. begin
  15929. // e.g. TBird<array of word>
  15930. Result:='array of ';
  15931. Arr:=TPasArrayType(aType);
  15932. if length(Arr.Ranges)>0 then
  15933. RaiseNotYetImplemented(20200905173026,Item.FirstSpecialize);
  15934. ElType:=ResolveAliasType(Arr.ElType,false);
  15935. if ElType is TPasArrayType then
  15936. RaiseNotYetImplemented(20200905173159,Arr,'multidimensional anonymous array as generic param');
  15937. Result:=Result+GetTypeName(ElType);
  15938. end
  15939. else
  15940. RaiseNotYetImplemented(20200905173241,aType);
  15941. end
  15942. else
  15943. begin
  15944. Result:=GetParentName(aType)+'.'+aType.Name;
  15945. if (aType.CustomData is TPasGenericScope) and (Pos('<',aType.Name)<1) then
  15946. begin
  15947. ChildItem:=TPasGenericScope(aType.CustomData).SpecializedFromItem;
  15948. if ChildItem<>nil then
  15949. Result:=Result+GetSpecParams(ChildItem);
  15950. end;
  15951. end;
  15952. end;
  15953. begin
  15954. if Pos('<',Item.GenericEl.Name)>0 then
  15955. RaiseNotYetImplemented(20201203140102,Item.SpecializedEl,Item.GenericEl.Name);
  15956. Result:=Item.GenericEl.Name+GetSpecParams(Item);
  15957. if Pos('><',Result)>0 then
  15958. RaiseNotYetImplemented(20201203140223,Item.SpecializedEl,Result);
  15959. end;
  15960. procedure TPasResolver.InitSpecializeScopes(El: TPasElement; out
  15961. State: TScopeStashState);
  15962. function PushParentScopes(CurEl: TPasElement): integer;
  15963. var
  15964. Keep: Integer;
  15965. Scope: TPasScope;
  15966. IntfSection: TInterfaceSection;
  15967. begin
  15968. {$IFDEF VerboseInitSpecializeScopes}
  15969. writeln(' PushParentScopes START ',GetObjName(CurEl));
  15970. {$ENDIF}
  15971. if CurEl=nil then
  15972. RaiseInternalError(20190728125025);
  15973. if CurEl is TPasModule then
  15974. begin
  15975. if not (CurEl.CustomData is TPasModuleScope) then
  15976. RaiseNotYetImplemented(20190728142609,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15977. Keep:=0;
  15978. if FScopeCount<=Keep then
  15979. RaiseInternalError(20190728124857);
  15980. if not (FScopes[Keep] is TPasDefaultScope) then
  15981. RaiseInternalError(20190728124858);
  15982. end
  15983. else
  15984. begin
  15985. if CurEl.Parent=nil then
  15986. RaiseInternalError(20190728130238,GetObjName(CurEl));
  15987. if CurEl.CustomData=nil then
  15988. exit(PushParentScopes(CurEl.Parent));
  15989. if not (CurEl.CustomData is TPasIdentifierScope) then
  15990. RaiseNotYetImplemented(20190728131934,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15991. Keep:=PushParentScopes(CurEl.Parent);
  15992. end;
  15993. inc(Keep);
  15994. Scope:=TPasScope(CurEl.CustomData);
  15995. {$IFDEF VerboseInitSpecializeScopes}
  15996. writeln(' PushParentScopes ',GetObjName(CurEl),' Scope=',GetObjName(Scope),' Keep=',Keep);
  15997. {$ENDIF}
  15998. if Scope.FreeOnPop then
  15999. RaiseInternalError(20190728131153,GetObjName(CurEl));
  16000. if (Keep<FScopeCount) and (FScopes[Keep]=Scope) then
  16001. // Scope is already on the scopestack
  16002. else
  16003. begin
  16004. if Keep<FScopeCount then
  16005. begin
  16006. // cannot use current scope stack -> stash
  16007. {$IFDEF VerboseInitSpecializeScopes}
  16008. writeln(' PushParentScopes StashScopes Keep=',Keep);
  16009. {$ENDIF}
  16010. StashScopes(Keep);
  16011. if Keep<>FScopeCount then
  16012. RaiseNotYetImplemented(20190813005130,El);
  16013. State.ScopeCount:=ScopeCount;
  16014. end;
  16015. if (CurEl.ClassType=TImplementationSection) then
  16016. begin
  16017. // unit implementation -> push interface scope
  16018. IntfSection:=CurEl.GetModule.InterfaceSection;
  16019. if IntfSection=nil then
  16020. RaiseNotYetImplemented(20190825112907,CurEl);
  16021. if not (IntfSection.CustomData is TPasSectionScope) then
  16022. RaiseNotYetImplemented(20190825112907,CurEl);
  16023. PushScope(TPasSectionScope(IntfSection.CustomData));
  16024. inc(Keep);
  16025. end;
  16026. PushScope(Scope);
  16027. end;
  16028. exit(Keep);
  16029. end;
  16030. var
  16031. Keep: Integer;
  16032. begin
  16033. {$IFDEF VerboseInitSpecializeScopes}
  16034. writeln('TPasResolver.InitSpecializeScopes START ',GetObjName(El));
  16035. {$ENDIF}
  16036. State.ScopeCount:=ScopeCount;
  16037. State.StashCount:=FStashScopeCount;
  16038. Keep:=PushParentScopes(El.Parent)+1;
  16039. if Keep<FScopeCount then
  16040. begin
  16041. // cannot use current scope stack -> stash
  16042. {$IFDEF VerboseInitSpecializeScopes}
  16043. writeln('TPasResolver.InitSpecializeScopes StashScopes Keep=',Keep);
  16044. {$ENDIF}
  16045. StashScopes(Keep);
  16046. if Keep<>FScopeCount then
  16047. RaiseNotYetImplemented(20190813005859,El);
  16048. end;
  16049. {$IFDEF VerboseInitSpecializeScopes}
  16050. WriteScopesShort('TPasResolver.InitSpecializeScopes END');
  16051. {$ENDIF}
  16052. end;
  16053. procedure TPasResolver.RestoreSpecializeScopes(const State: TScopeStashState);
  16054. begin
  16055. while ScopeCount>State.ScopeCount do
  16056. PopScope;
  16057. RestoreStashedScopes(State.StashCount);
  16058. end;
  16059. procedure TPasResolver.SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem
  16060. );
  16061. var
  16062. SpecEl, GenericEl: TPasElement;
  16063. C: TClass;
  16064. NewRecordType, GenRecordType: TPasRecordType;
  16065. NewClassType, GenClassType: TPasClassType;
  16066. NewArrayType, GenArrayType: TPasArrayType;
  16067. GenProcType, NewProcType: TPasProcedureType;
  16068. GenProc, NewProc: TPasProcedure;
  16069. OldScopeState: TScopeStashState;
  16070. begin
  16071. if SpecializedItem.Step<>prssNone then
  16072. exit;
  16073. SpecializedItem.Step:=prssInterfaceBuilding;
  16074. SpecEl:=SpecializedItem.SpecializedEl;
  16075. GenericEl:=SpecializedItem.GenericEl;
  16076. // change scope
  16077. InitSpecializeScopes(GenericEl,OldScopeState);
  16078. {$IFDEF VerbosePasResolver}
  16079. WriteScopesShort('TPasResolver.SpecializeGenericIntf Init SpecEl='+SpecEl.FullName+' GenericEl='+GenericEl.FullName);
  16080. {$ENDIF}
  16081. SpecializePasElementProperties(GenericEl,SpecEl);
  16082. C:=SpecEl.ClassType;
  16083. if C=TPasRecordType then
  16084. begin
  16085. NewRecordType:=TPasRecordType(SpecEl);
  16086. GenRecordType:=TPasRecordType(GenericEl);
  16087. SpecializeRecordType(GenRecordType,NewRecordType,TPRSpecializedTypeItem(SpecializedItem));
  16088. end
  16089. else if C=TPasClassType then
  16090. begin
  16091. NewClassType:=TPasClassType(SpecEl);
  16092. GenClassType:=TPasClassType(GenericEl);
  16093. SpecializeClassType(GenClassType,NewClassType,TPRSpecializedTypeItem(SpecializedItem));
  16094. end
  16095. else if C=TPasArrayType then
  16096. begin
  16097. GenArrayType:=TPasArrayType(GenericEl);
  16098. NewArrayType:=TPasArrayType(SpecEl);
  16099. SpecializeArrayType(GenArrayType,NewArrayType,TPRSpecializedTypeItem(SpecializedItem));
  16100. end
  16101. else if (C=TPasProcedureType)
  16102. or (C=TPasFunctionType) then
  16103. begin
  16104. GenProcType:=TPasProcedureType(GenericEl);
  16105. NewProcType:=TPasProcedureType(SpecEl);
  16106. SpecializeProcedureType(GenProcType,NewProcType,TPRSpecializedTypeItem(SpecializedItem));
  16107. end
  16108. else if C.InheritsFrom(TPasProcedure) then
  16109. begin
  16110. GenProc:=TPasProcedure(GenericEl);
  16111. NewProc:=TPasProcedure(SpecEl);
  16112. SpecializeProcedure(GenProc,NewProc,SpecializedItem);
  16113. end
  16114. else
  16115. RaiseNotYetImplemented(20190728134933,GenericEl);
  16116. {$IFDEF VerbosePasResolver}
  16117. WriteScopesShort('TPasResolver.SpecializeGenericIntf Finish: '+SpecEl.FullName);
  16118. {$ENDIF}
  16119. RestoreSpecializeScopes(OldScopeState);
  16120. {$IFDEF VerbosePasResolver}
  16121. WriteScopesShort('TPasResolver.SpecializeGenericIntf RestoreStashedScopes: '+SpecEl.FullName);
  16122. {$ENDIF}
  16123. end;
  16124. procedure TPasResolver.SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem
  16125. );
  16126. var
  16127. GenericEl: TPasElement;
  16128. GenScope: TPasGenericScope;
  16129. SpecializedTypeItem: TPRSpecializedTypeItem;
  16130. SpecializedProcItem: TPRSpecializedProcItem;
  16131. GenImplProc, GenIntfProc, SpecDeclProc: TPasProcedure;
  16132. GenDeclProcScope: TPasProcedureScope;
  16133. OldScopeState: TScopeStashState;
  16134. begin
  16135. // check specialized type step
  16136. if SpecializedItem.Step>prssInterfaceFinished then
  16137. exit;
  16138. GenericEl:=SpecializedItem.GenericEl;
  16139. if SpecializedItem.Step<prssInterfaceFinished then
  16140. if GenericEl is TPasType then
  16141. RaiseMsg(20190804120128,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  16142. [GetTypeDescription(TPasType(GenericEl))],SpecializedItem.FirstSpecialize)
  16143. else
  16144. RaiseMsg(20190920190727,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  16145. [GenericEl.Name],SpecializedItem.FirstSpecialize);
  16146. SpecializedItem.Step:=prssImplementationBuilding;
  16147. // check generic type is resolved completely
  16148. GenScope:=TPasGenericScope(GenericEl.CustomData);
  16149. if GenScope.GenericStep<psgsImplementationParsed then
  16150. RaiseNotYetImplemented(20190804174019,GenericEl,GetObjName(SpecializedItem.SpecializedEl));
  16151. if GenericEl is TPasMembersType then
  16152. begin
  16153. // specialize all method bodies
  16154. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem);
  16155. if SpecializedTypeItem.ImplProcs=nil then
  16156. SpecializedTypeItem.ImplProcs:=TFPList.Create;
  16157. SpecializeMembersImpl(TPasMembersType(GenericEl),
  16158. TPasMembersType(SpecializedTypeItem.SpecializedType),
  16159. SpecializedTypeItem);
  16160. end
  16161. else if GenericEl is TPasProcedure then
  16162. begin
  16163. // specialize proc implementation
  16164. GenIntfProc:=TPasProcedure(GenericEl);
  16165. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then
  16166. //
  16167. else
  16168. begin
  16169. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem);
  16170. GenDeclProcScope:=TPasProcedureScope(GenScope);
  16171. GenImplProc:=GenDeclProcScope.ImplProc;
  16172. if GenImplProc=nil then
  16173. RaiseNotYetImplemented(20190920211609,SpecializedProcItem.SpecializedProc);
  16174. if GenImplProc.Body=nil then
  16175. RaiseNotYetImplemented(20190920192731,GenImplProc); // GenScope.GenericStep is wrong
  16176. SpecDeclProc:=SpecializedProcItem.SpecializedProc;
  16177. InitSpecializeScopes(GenImplProc,OldScopeState);
  16178. SpecializeGenImplProc(GenIntfProc,SpecDeclProc,SpecializedProcItem);
  16179. RestoreSpecializeScopes(OldScopeState);
  16180. end;
  16181. end;
  16182. SpecializedItem.Step:=prssImplementationFinished;
  16183. end;
  16184. procedure TPasResolver.SpecializeMembers(GenMembersType,
  16185. SpecMembersType: TPasMembersType);
  16186. var
  16187. i: Integer;
  16188. GenEl, NewEl: TPasElement;
  16189. NewClass: TPTreeElement;
  16190. begin
  16191. for i:=0 to GenMembersType.Members.Count-1 do
  16192. begin
  16193. GenEl:=TPasElement(GenMembersType.Members[i]);
  16194. if GenEl.Parent<>GenMembersType then
  16195. RaiseNotYetImplemented(20190728145634,GenEl,GetObjName(GenEl.Parent));
  16196. NewClass:=TPTreeElement(GenEl.ClassType);
  16197. NewEl:=TPasElement(NewClass.Create(GenEl.Name,SpecMembersType));
  16198. SpecMembersType.Members.Add(NewEl);
  16199. SpecializeElement(GenEl,NewEl);
  16200. end;
  16201. end;
  16202. procedure TPasResolver.SpecializeMembersImpl(GenericType,
  16203. SpecType: TPasMembersType; SpecializedItem: TPRSpecializedTypeItem);
  16204. var
  16205. GenClassOrRec, SpecClassOrRec: TPasMembersType;
  16206. i: Integer;
  16207. GenMember, SpecMember, ImplParent: TPasElement;
  16208. GenIntfProc, GenImplProc, SpecIntfProc: TPasProcedure;
  16209. GenIntfProcScope: TPasProcedureScope;
  16210. OldScopeState: TScopeStashState;
  16211. begin
  16212. GenClassOrRec:=TPasMembersType(GenericType);
  16213. SpecClassOrRec:=TPasMembersType(SpecType);
  16214. {$IFDEF VerbosePasResolver}
  16215. writeln('TPasResolver.SpecializeMembersImpl RestoreStashedScopes ',GetObjPath(SpecClassOrRec),' ',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  16216. {$ENDIF}
  16217. // specialize member bodies
  16218. ImplParent:=nil;
  16219. OldScopeState:=default(TScopeStashState);
  16220. for i:=0 to GenClassOrRec.Members.Count-1 do
  16221. begin
  16222. GenMember:=TPasElement(GenClassOrRec.Members[i]);
  16223. SpecMember:=TPasElement(SpecClassOrRec.Members[i]);
  16224. if SpecMember.ClassType<>GenMember.ClassType then
  16225. RaiseNotYetImplemented(20190816002658,GenMember,GetObjName(SpecMember));
  16226. if SpecMember.Name<>GenMember.Name then
  16227. RaiseNotYetImplemented(20190804124220,GenMember,GetObjName(SpecMember));
  16228. if GenMember is TPasProcedure then
  16229. begin
  16230. GenIntfProc:=TPasProcedure(GenMember);
  16231. SpecIntfProc:=TPasProcedure(SpecMember);
  16232. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then continue;
  16233. GenIntfProcScope:=TPasProcedureScope(GenIntfProc.CustomData);
  16234. GenImplProc:=GenIntfProcScope.ImplProc;
  16235. if GenImplProc=nil then
  16236. RaiseNotYetImplemented(20190921221246,GenIntfProc);
  16237. if ImplParent=nil then
  16238. begin
  16239. // switch scope (e.g. unit implementation section)
  16240. ImplParent:=GenImplProc.Parent;
  16241. InitSpecializeScopes(GenImplProc,OldScopeState);
  16242. {$IFDEF VerbosePasResolver}
  16243. writeln('TPasResolver.SpecializeGenImplProc Specialize implprocs: SpecType=',GetObjName(SpecType),' ImplParent=',GetObjName(ImplParent),' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount,' TopScope=',GetObjName(TopScope));
  16244. {$ENDIF}
  16245. end
  16246. else if ImplParent<>GenImplProc.Parent then
  16247. RaiseNotYetImplemented(20190804130322,GenImplProc,GetObjName(ImplParent));
  16248. SpecializeGenImplProc(GenIntfProc,SpecIntfProc,SpecializedItem);
  16249. end
  16250. else if GenMember is TPasMembersType then
  16251. begin
  16252. // nested record/class type
  16253. SpecializeMembersImpl(TPasMembersType(GenMember),TPasMembersType(SpecMember),
  16254. SpecializedItem);
  16255. end;
  16256. end;
  16257. if ImplParent<>nil then
  16258. begin
  16259. // restore scope
  16260. RestoreSpecializeScopes(OldScopeState);
  16261. end;
  16262. end;
  16263. procedure TPasResolver.SpecializeGenImplProc(GenDeclProc,
  16264. SpecDeclProc: TPasProcedure; SpecializedItem: TPRSpecializedItem);
  16265. procedure InsertBehind(ParentElList: TFPList;
  16266. SpecializedItems: TObjectList; GenImplProc, SpecImplProc: TPasProcedure);
  16267. // insert SpecImplProc behind last specialized impl proc
  16268. // Note: impl procs are not always specialized in order
  16269. var
  16270. Last: TPasProcedure;
  16271. i: Integer;
  16272. begin
  16273. Last:=nil;
  16274. if SpecializedItems<>nil then
  16275. begin
  16276. i:=SpecializedItems.Count-1;
  16277. while i>=0 do
  16278. begin
  16279. Last:=TPRSpecializedProcItem(SpecializedItems[i]).ImplProc;
  16280. if Last=SpecImplProc then
  16281. Last:=nil
  16282. else if Last<>nil then
  16283. break;
  16284. dec(i);
  16285. end;
  16286. end;
  16287. if Last=nil then
  16288. Last:=GenImplProc;
  16289. i:=ParentElList.IndexOf(Last);
  16290. if i<0 then
  16291. begin
  16292. {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
  16293. {AllowWriteln}
  16294. writeln('InsertBehind GenImplProc=',GetObjPath(GenImplProc),' Last=',GetObjPath(Last));
  16295. for i:=0 to ParentElList.Count-1 do
  16296. begin
  16297. writeln(' ',GetObjName(TObject(ParentElList[i])));
  16298. if TObject(ParentElList[i]) is TPasProcedure then
  16299. writeln(' IsForward=',TPasProcedure(ParentElList[i]).IsForward);
  16300. end;
  16301. {AllowWriteln-}
  16302. {$ENDIF}
  16303. RaiseNotYetImplemented(20191017122900,GenDeclProc);
  16304. end;
  16305. ParentElList.Insert(i+1,SpecImplProc);
  16306. SpecImplProc.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Children'){$ENDIF};
  16307. end;
  16308. var
  16309. GenDeclProcScope, GenImplProcScope, SpecDeclProcScope,
  16310. SpecImplProcScope: TPasProcedureScope;
  16311. GenImplProc, SpecImplProc: TPasProcedure;
  16312. NewClass: TPTreeElement;
  16313. SpecClassOrRec, GenClassOrRec: TPasMembersType;
  16314. SpecClassOrRecScope: TPasClassOrRecordScope;
  16315. NewImplProcName, OldClassname: String;
  16316. p, LastDotP: Integer;
  16317. SpecializedProcItem: TPRSpecializedProcItem;
  16318. SpecializedTypeItem: TPRSpecializedTypeItem;
  16319. Templates: TFPList;
  16320. NewParent: TPasElement;
  16321. begin
  16322. SpecializedProcItem:=nil;
  16323. SpecializedTypeItem:=nil;
  16324. if SpecializedItem is TPRSpecializedProcItem then
  16325. // impl proc of a specialized forward proc
  16326. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem)
  16327. else if SpecializedItem is TPRSpecializedTypeItem then
  16328. // method of a specialized class/record
  16329. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem)
  16330. else
  16331. RaiseNotYetImplemented(20190922145050,SpecDeclProc);
  16332. GenDeclProcScope:=TPasProcedureScope(GenDeclProc.CustomData);
  16333. GenImplProc:=GenDeclProcScope.ImplProc;
  16334. if GenImplProc=nil then
  16335. RaiseNotYetImplemented(20190804122134,GenDeclProc);
  16336. if GenImplProc.Body=nil then
  16337. RaiseNotYetImplemented(20190921220216,GenImplProc);
  16338. GenImplProcScope:=TPasProcedureScope(GenImplProc.CustomData);
  16339. SpecDeclProcScope:=TPasProcedureScope(SpecDeclProc.CustomData);
  16340. if SpecDeclProc.Parent is TPasMembersType then
  16341. begin
  16342. SpecClassOrRec:=SpecDeclProc.Parent as TPasMembersType;
  16343. SpecClassOrRecScope:=SpecClassOrRec.CustomData as TPasClassOrRecordScope;
  16344. end
  16345. else
  16346. begin
  16347. SpecClassOrRec:=nil;
  16348. SpecClassOrRecScope:=nil;
  16349. end;
  16350. {$IFDEF VerbosePasResolver}
  16351. writeln('TPasResolver.SpecializeGenImplProc Specialize GenImplProc: ',GetObjName(GenImplProc));
  16352. {$ENDIF}
  16353. // create impl proc name
  16354. if SpecializedTypeItem<>nil then
  16355. begin
  16356. // method of a specialized class/record
  16357. if SpecClassOrRecScope=nil then
  16358. RaiseNotYetImplemented(20190921221839,SpecDeclProc);
  16359. NewImplProcName:=GenImplProc.Name;
  16360. LastDotP:=GetLastDotPos(NewImplProcName);
  16361. if LastDotP<1 then
  16362. RaiseNotYetImplemented(20190921221730,GenImplProc);
  16363. // has classname -> replace generic classname with specialized classname
  16364. p:=LastDotP;
  16365. while (p>1) and (NewImplProcName[p-1]<>'.') do dec(p);
  16366. OldClassname:=copy(NewImplProcName,p,LastDotP-p);
  16367. GenClassOrRec:=GenDeclProc.Parent as TPasMembersType;
  16368. if not SameText(OldClassname,GenClassOrRec.Name) then
  16369. RaiseNotYetImplemented(20190814141833,GenImplProc);
  16370. NewImplProcName:=LeftStr(NewImplProcName,p-1)+SpecClassOrRec.Name+copy(NewImplProcName,LastDotP,length(NewImplProcName));
  16371. end
  16372. else
  16373. begin
  16374. // use classname of GenImplProc and name of SpecDeclProc
  16375. OldClassname:=GenImplProc.Name;
  16376. p:=GetLastDotPos(OldClassname);
  16377. if p>0 then
  16378. NewImplProcName:=LeftStr(OldClassname,p)+SpecDeclProc.Name
  16379. else
  16380. NewImplProcName:=SpecDeclProc.Name;
  16381. end;
  16382. // create impl proc
  16383. NewClass:=TPTreeElement(GenImplProc.ClassType);
  16384. NewParent:=GenImplProc.Parent;
  16385. SpecImplProc:=TPasProcedure(NewClass.Create(NewImplProcName,NewParent));
  16386. SpecDeclProcScope.ImplProc:=SpecImplProc;
  16387. if SpecializedProcItem<>nil then
  16388. SpecializedProcItem.ImplProc:=SpecImplProc
  16389. else
  16390. SpecializedTypeItem.ImplProcs.Add(SpecImplProc);
  16391. if (SpecializedProcItem<>nil) and (NewParent is TPasDeclarations) then
  16392. InsertBehind(TPasDeclarations(NewParent).Declarations,
  16393. GenDeclProcScope.SpecializedItems,GenImplProc,SpecImplProc);
  16394. // create impl proc scope
  16395. SpecImplProcScope:=TPasProcedureScope(CreateScope(SpecImplProc,FScopeClass_Proc));
  16396. SpecImplProcScope.Flags:=[ppsfIsSpecialized];
  16397. SpecImplProcScope.DeclarationProc:=SpecDeclProc;
  16398. SpecImplProcScope.ModeSwitches:=GenImplProcScope.Modeswitches;
  16399. SpecImplProcScope.BoolSwitches:=GenImplProcScope.BoolSwitches;
  16400. SpecImplProcScope.VisibilityContext:=SpecClassOrRec;
  16401. SpecImplProcScope.ClassRecScope:=SpecClassOrRecScope;
  16402. if SpecializedProcItem<>nil then
  16403. begin
  16404. Templates:=GetProcTemplateTypes(GenDeclProc);
  16405. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecImplProcScope,
  16406. false);
  16407. end;
  16408. // specialize props
  16409. SpecializePasElementProperties(GenImplProc,SpecImplProc);
  16410. AddProcedure(SpecImplProc,nil);
  16411. SpecializeProcedure(GenImplProc,SpecImplProc,SpecializedItem);
  16412. end;
  16413. procedure TPasResolver.SpecializeElement(GenEl, SpecEl: TPasElement);
  16414. var
  16415. C: TClass;
  16416. begin
  16417. // first copy sourcefilename and linenumber needed by error messages
  16418. SpecializePasElementProperties(GenEl,SpecEl);
  16419. C:=GenEl.ClassType;
  16420. // expressions
  16421. if C=TPrimitiveExpr then
  16422. SpecializePrimitiveExpr(TPrimitiveExpr(GenEl),TPrimitiveExpr(SpecEl))
  16423. else if C=TUnaryExpr then
  16424. SpecializeUnaryExpr(TUnaryExpr(GenEl),TUnaryExpr(SpecEl))
  16425. else if C=TBinaryExpr then
  16426. SpecializeBinaryExpr(TBinaryExpr(GenEl),TBinaryExpr(SpecEl))
  16427. else if C=TBoolConstExpr then
  16428. SpecializeBoolConstExpr(TBoolConstExpr(GenEl),TBoolConstExpr(SpecEl))
  16429. else if C=TNilExpr then
  16430. SpecializeExpr(TNilExpr(GenEl),TNilExpr(SpecEl))
  16431. else if C=TInheritedExpr then
  16432. SpecializeExpr(TInheritedExpr(GenEl),TInheritedExpr(SpecEl))
  16433. else if C=TParamsExpr then
  16434. SpecializeParamsExpr(TParamsExpr(GenEl),TParamsExpr(SpecEl))
  16435. else if C=TRecordValues then
  16436. SpecializeRecordValues(TRecordValues(GenEl),TRecordValues(SpecEl))
  16437. else if C=TArrayValues then
  16438. SpecializeArrayValues(TArrayValues(GenEl),TArrayValues(SpecEl))
  16439. else if C=TInlineSpecializeExpr then
  16440. SpecializeInlineSpecializeExpr(TInlineSpecializeExpr(GenEl),TInlineSpecializeExpr(SpecEl))
  16441. else if C=TProcedureExpr then
  16442. SpecializeProcedureExpr(TProcedureExpr(GenEl),TProcedureExpr(SpecEl))
  16443. // TPasType
  16444. else if (C=TPasAliasType)
  16445. or (C=TPasTypeAliasType)
  16446. or (C=TPasClassOfType) then
  16447. begin
  16448. AddType(TPasAliasType(SpecEl));
  16449. SpecializeAliasType(TPasAliasType(GenEl),TPasAliasType(SpecEl));
  16450. end
  16451. else if C=TPasPointerType then
  16452. begin
  16453. AddType(TPasPointerType(SpecEl));
  16454. SpecializePointerType(TPasPointerType(GenEl),TPasPointerType(SpecEl));
  16455. end
  16456. else if C=TPasRangeType then
  16457. begin
  16458. AddType(TPasRangeType(SpecEl));
  16459. SpecializeRangeType(TPasRangeType(GenEl),TPasRangeType(SpecEl));
  16460. end
  16461. else if C=TPasArrayType then
  16462. begin
  16463. if GetTypeParameterCount(TPasArrayType(GenEl))>0 then
  16464. RaiseNotYetImplemented(20190815201219,GenEl);
  16465. AddArrayType(TPasArrayType(SpecEl),nil);
  16466. SpecializeArrayType(TPasArrayType(GenEl),TPasArrayType(SpecEl),nil);
  16467. end
  16468. else if C=TPasEnumValue then
  16469. begin
  16470. AddEnumValue(TPasEnumValue(SpecEl));
  16471. SpecializeEnumValue(TPasEnumValue(GenEl),TPasEnumValue(SpecEl));
  16472. end
  16473. else if C=TPasEnumType then
  16474. begin
  16475. AddEnumType(TPasEnumType(SpecEl));
  16476. SpecializeEnumType(TPasEnumType(GenEl),TPasEnumType(SpecEl));
  16477. end
  16478. else if C=TPasSetType then
  16479. SpecializeSetType(TPasSetType(GenEl),TPasSetType(SpecEl))
  16480. else if C=TPasVariant then
  16481. SpecializeVariant(TPasVariant(GenEl),TPasVariant(SpecEl))
  16482. else if C=TPasRecordType then
  16483. begin
  16484. if GetTypeParameterCount(TPasRecordType(GenEl))>0 then
  16485. RaiseNotYetImplemented(20190815201201,GenEl);
  16486. AddRecordType(TPasRecordType(SpecEl),nil);
  16487. SpecializeRecordType(TPasRecordType(GenEl),TPasRecordType(SpecEl),nil);
  16488. end
  16489. else if C=TPasClassType then
  16490. begin
  16491. if GetTypeParameterCount(TPasClassType(GenEl))>0 then
  16492. RaiseNotYetImplemented(20190816214947,GenEl);
  16493. AddClassType(TPasClassType(SpecEl),nil);
  16494. SpecializeClassType(TPasClassType(GenEl),TPasClassType(SpecEl),nil);
  16495. end
  16496. else if C=TPasStringType then
  16497. begin
  16498. AddType(TPasStringType(SpecEl));
  16499. SpecializeStringType(TPasStringType(GenEl),TPasStringType(SpecEl));
  16500. end
  16501. else if C=TPasSpecializeType then
  16502. begin
  16503. AddType(TPasSpecializeType(SpecEl));
  16504. SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
  16505. end
  16506. else if C=TPasGenericTemplateType then
  16507. SpecializeGenericTemplateType(TPasGenericTemplateType(GenEl),TPasGenericTemplateType(SpecEl))
  16508. // empty statement
  16509. else if C=TPasImplCommand then
  16510. // TPasImplBlock
  16511. else if C=TPasImplBeginBlock then
  16512. SpecializeImplBlock(TPasImplBeginBlock(GenEl),TPasImplBeginBlock(SpecEl))
  16513. else if C=TPasImplAsmStatement then
  16514. SpecializeImplAsmStatement(TPasImplAsmStatement(GenEl),TPasImplAsmStatement(SpecEl))
  16515. else if C=TPasImplRepeatUntil then
  16516. SpecializeImplRepeatUntil(TPasImplRepeatUntil(GenEl),TPasImplRepeatUntil(SpecEl))
  16517. else if C=TPasImplIfElse then
  16518. SpecializeImplIfElse(TPasImplIfElse(GenEl),TPasImplIfElse(SpecEl))
  16519. else if C=TPasImplWhileDo then
  16520. SpecializeImplWhileDo(TPasImplWhileDo(GenEl),TPasImplWhileDo(SpecEl))
  16521. else if C=TPasImplWithDo then
  16522. SpecializeImplWithDo(TPasImplWithDo(GenEl),TPasImplWithDo(SpecEl))
  16523. else if C=TPasImplCaseOf then
  16524. SpecializeImplCaseOf(TPasImplCaseOf(GenEl),TPasImplCaseOf(SpecEl))
  16525. else if C=TPasImplCaseStatement then
  16526. SpecializeImplCaseStatement(TPasImplCaseStatement(GenEl),TPasImplCaseStatement(SpecEl))
  16527. else if C=TPasImplCaseElse then
  16528. SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
  16529. else if C=TPasImplAssign then
  16530. SpecializeImplAssign(TPasImplAssign(GenEl),TPasImplAssign(SpecEl))
  16531. else if C=TPasImplSimple then
  16532. SpecializeImplSimple(TPasImplSimple(GenEl),TPasImplSimple(SpecEl))
  16533. else if C=TPasImplForLoop then
  16534. SpecializeImplForLoop(TPasImplForLoop(GenEl),TPasImplForLoop(SpecEl))
  16535. else if C=TPasImplTry then
  16536. SpecializeImplTry(TPasImplTry(GenEl),TPasImplTry(SpecEl))
  16537. else if (C=TPasImplTryFinally)
  16538. or (C=TPasImplTryExcept)
  16539. or (C=TPasImplTryExceptElse) then
  16540. SpecializeImplBlock(TPasImplTryHandler(GenEl),TPasImplTryHandler(SpecEl))
  16541. else if C=TPasImplExceptOn then
  16542. begin
  16543. AddExceptOn(TPasImplExceptOn(SpecEl));
  16544. SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl));
  16545. end
  16546. else if C=TPasImplRaise then
  16547. SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
  16548. // declaration
  16549. else if C=TPasResString then
  16550. begin
  16551. AddResourceString(TPasResString(SpecEl));
  16552. SpecializeResString(TPasResString(GenEl),TPasResString(SpecEl));
  16553. end
  16554. else if C=TPasVariable then
  16555. begin
  16556. AddVariable(TPasVariable(SpecEl));
  16557. SpecializeVariable(TPasVariable(GenEl),TPasVariable(SpecEl),true);
  16558. end
  16559. else if C=TPasConst then
  16560. begin
  16561. AddVariable(TPasConst(SpecEl));
  16562. SpecializeConst(TPasConst(GenEl),TPasConst(SpecEl));
  16563. end
  16564. else if C=TPasProperty then
  16565. begin
  16566. AddProperty(TPasProperty(SpecEl));
  16567. SpecializeProperty(TPasProperty(GenEl),TPasProperty(SpecEl));
  16568. end
  16569. else if C=TPasAttributes then
  16570. SpecializeAttributes(TPasAttributes(GenEl),TPasAttributes(SpecEl))
  16571. else if C=TPasMethodResolution then
  16572. SpecializeMethodResolution(TPasMethodResolution(GenEl),TPasMethodResolution(SpecEl))
  16573. // procedure
  16574. else if C=TPasArgument then
  16575. begin
  16576. AddArgument(TPasArgument(SpecEl));
  16577. SpecializeArgument(TPasArgument(GenEl),TPasArgument(SpecEl));
  16578. end
  16579. else if C=TProcedureBody then
  16580. begin
  16581. AddProcedureBody(TProcedureBody(SpecEl));
  16582. SpecializeProcedureBody(TProcedureBody(GenEl),TProcedureBody(SpecEl));
  16583. end
  16584. else if C=TPasOperator then
  16585. begin
  16586. AddProcedure(TPasOperator(SpecEl),nil);
  16587. SpecializeOperator(TPasOperator(GenEl),TPasOperator(SpecEl));
  16588. end
  16589. else if C.InheritsFrom(TPasProcedure) then
  16590. begin
  16591. AddProcedure(TPasProcedure(SpecEl),nil);
  16592. SpecializeProcedure(TPasProcedure(GenEl),TPasProcedure(SpecEl),nil);
  16593. end
  16594. else if C.InheritsFrom(TPasProcedureType) then
  16595. begin
  16596. AddProcedureType(TPasProcedureType(SpecEl),nil);
  16597. SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
  16598. end
  16599. else if C=TPasExportSymbol then
  16600. RaiseMsg(20210101234958,nSymbolCannotExportedFromALibrary,sSymbolCannotExportedFromALibrary,[],GenEl)
  16601. else
  16602. RaiseNotYetImplemented(20190728151215,GenEl);
  16603. end;
  16604. procedure TPasResolver.SpecializePasElementProperties(GenEl, SpecEl: TPasElement
  16605. );
  16606. begin
  16607. SpecEl.SourceFilename:=GenEl.SourceFilename;
  16608. SpecEl.SourceLinenumber:=GenEl.SourceLinenumber;;
  16609. SpecEl.SourceEndLinenumber:=GenEl.SourceEndLinenumber;
  16610. SpecEl.Visibility:=GenEl.Visibility;
  16611. SpecEl.Hints:=GenEl.Hints;
  16612. SpecEl.HintMessage:=GenEl.HintMessage;
  16613. SpecEl.DocComment:=GenEl.DocComment;
  16614. end;
  16615. procedure TPasResolver.SpecializeVariable(GenEl, SpecEl: TPasVariable;
  16616. Finish: boolean);
  16617. begin
  16618. SpecializeElType(GenEl,SpecEl,GenEl.VarType,SpecEl.VarType);
  16619. SpecEl.VarModifiers:=GenEl.VarModifiers;
  16620. if GenEl.LibraryName<>nil then
  16621. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryName,SpecEl.LibraryName);
  16622. if GenEl.ExportName<>nil then
  16623. SpecializeElExpr(GenEl,SpecEl,GenEl.ExportName,SpecEl.ExportName);
  16624. SpecEl.Modifiers:=GenEl.Modifiers;
  16625. if GenEl.AbsoluteExpr<>nil then
  16626. SpecializeElExpr(GenEl,SpecEl,GenEl.AbsoluteExpr,SpecEl.AbsoluteExpr);
  16627. if GenEl.Expr<>nil then
  16628. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16629. if Finish then
  16630. FinishVariable(SpecEl);
  16631. end;
  16632. procedure TPasResolver.SpecializeConst(GenEl, SpecEl: TPasConst);
  16633. begin
  16634. SpecEl.IsConst:=GenEl.IsConst;
  16635. SpecializeVariable(GenEl,SpecEl,true);
  16636. end;
  16637. procedure TPasResolver.SpecializeProperty(GenEl, SpecEl: TPasProperty);
  16638. begin
  16639. SpecializeVariable(GenEl,SpecEl,false);
  16640. SpecializeElExpr(GenEl,SpecEl,GenEl.IndexExpr,SpecEl.IndexExpr);
  16641. SpecializeElExpr(GenEl,SpecEl,GenEl.ReadAccessor,SpecEl.ReadAccessor);
  16642. SpecializeElExpr(GenEl,SpecEl,GenEl.WriteAccessor,SpecEl.WriteAccessor);
  16643. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16644. SpecializeExprArray(GenEl,SpecEl,GenEl.Implements,SpecEl.Implements);
  16645. SpecializeElExpr(GenEl,SpecEl,GenEl.StoredAccessor,SpecEl.StoredAccessor);
  16646. SpecializeElExpr(GenEl,SpecEl,GenEl.DefaultExpr,SpecEl.DefaultExpr);
  16647. SpecEl.DispIDReadOnly:=GenEl.DispIDReadOnly;
  16648. SpecEl.IsDefault:=GenEl.IsDefault;
  16649. SpecEl.IsNodefault:=GenEl.IsNodefault;
  16650. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16651. {$IFDEF CheckPasTreeRefCount},'TPasProperty.Args'{$ENDIF});
  16652. FinishProperty(SpecEl);
  16653. end;
  16654. function TPasResolver.SpecializeTypeRef(GenEl, SpecEl: TPasElement;
  16655. GenTypeRef: TPasType): TPasType;
  16656. var
  16657. Ref: TPasElement;
  16658. begin
  16659. if GenTypeRef.Name='' then
  16660. RaiseNotYetImplemented(20190813213555,GenEl,GetObjPath(GenTypeRef));
  16661. Ref:=FindElement(GenTypeRef.Name);
  16662. if not (Ref is TPasType) then
  16663. RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
  16664. if SpecEl=nil then ;
  16665. Result:=TPasType(Ref);
  16666. end;
  16667. procedure TPasResolver.SpecializeElType(GenEl, SpecEl: TPasElement;
  16668. GenElType: TPasType; var SpecElType: TPasType);
  16669. var
  16670. NewClass: TPTreeElement;
  16671. begin
  16672. if GenElType=nil then exit;
  16673. if SpecElType<>nil then
  16674. RaiseNotYetImplemented(20190812021617,GenEl);
  16675. if (GenElType.Parent<>GenEl)
  16676. or (GenElType.ClassType=TPasGenericTemplateType) then
  16677. begin
  16678. // reference
  16679. GenElType:=SpecializeTypeRef(GenEl,SpecEl,GenElType);
  16680. SpecElType:=GenElType;
  16681. SpecElType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  16682. exit;
  16683. end;
  16684. // e.g. anonymous type
  16685. if SpecElType<>nil then
  16686. RaiseNotYetImplemented(20190808222744,SpecEl,GetObjName(SpecElType));
  16687. NewClass:=TPTreeElement(GenElType.ClassType);
  16688. SpecElType:=TPasType(NewClass.Create(GenElType.Name,SpecEl));
  16689. SpecializeElement(GenElType,SpecElType);
  16690. end;
  16691. procedure TPasResolver.SpecializeElExpr(GenEl, SpecEl: TPasElement;
  16692. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  16693. var
  16694. NewClass: TPTreeElement;
  16695. begin
  16696. if GenElExpr=nil then exit;
  16697. if SpecElExpr<>nil then
  16698. RaiseNotYetImplemented(20190803220248,SpecEl,GetObjName(SpecElExpr));
  16699. if GenElExpr.Parent<>GenEl then
  16700. RaiseNotYetImplemented(20190809160834,GenEl);
  16701. // normal expression
  16702. NewClass:=TPTreeElement(GenElExpr.ClassType);
  16703. SpecElExpr:=TPasExpr(NewClass.Create(GenElExpr.Name,SpecEl));
  16704. SpecializeElement(GenElExpr,SpecElExpr);
  16705. end;
  16706. procedure TPasResolver.SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  16707. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  16708. var
  16709. NewClass: TPTreeElement;
  16710. begin
  16711. if GenImplEl=nil then exit;
  16712. if GenImplEl.Parent<>GenEl then
  16713. RaiseNotYetImplemented(20190808222638,GenEl,GetObjName(GenImplEl.Parent));
  16714. NewClass:=TPTreeElement(GenImplEl.ClassType);
  16715. SpecImplEl:=TPasImplElement(NewClass.Create(GenImplEl.Name,SpecEl));
  16716. SpecializeElement(GenImplEl,SpecImplEl);
  16717. end;
  16718. procedure TPasResolver.SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  16719. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  16720. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16721. var
  16722. i: Integer;
  16723. begin
  16724. if GenImplAlias=nil then exit;
  16725. i:=GenEl.Elements.IndexOf(GenImplAlias);
  16726. if i<0 then
  16727. RaiseNotYetImplemented(20190808225239,GenEl);
  16728. SpecImplAlias:=TObject(SpecEl.Elements[i]) as TPasImplElement;
  16729. if SpecImplAlias.ClassType<>GenImplAlias.ClassType then
  16730. RaiseNotYetImplemented(20190808231616,GenImplAlias,GetObjName(SpecImplAlias));
  16731. SpecImplAlias.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16732. end;
  16733. procedure TPasResolver.SpecializeElList(GenEl, SpecEl: TPasElement;
  16734. GenList, SpecList: TFPList; AllowReferences: boolean
  16735. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16736. var
  16737. i: Integer;
  16738. GenListItem, SpecListItem, Ref: TPasElement;
  16739. NewClass: TPTreeElement;
  16740. begin
  16741. for i:=0 to GenList.Count-1 do
  16742. begin
  16743. GenListItem:=TPasElement(GenList[i]);
  16744. if GenListItem.Parent<>GenEl then
  16745. begin
  16746. if not AllowReferences then
  16747. RaiseNotYetImplemented(20190808212421,GenEl,IntToStr(i));
  16748. if not (GenListItem is TPasType) then
  16749. RaiseNotYetImplemented(20190812025715,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16750. // reference
  16751. Ref:=SpecializeTypeRef(GenEl,SpecEl,TpasType(GenListItem));
  16752. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16753. SpecList.Add(Ref);
  16754. continue;
  16755. end;
  16756. if GenListItem.ClassType=TPasGenericTemplateType then
  16757. RaiseNotYetImplemented(20190812233309,GenEl);
  16758. NewClass:=TPTreeElement(GenListItem.ClassType);
  16759. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16760. SpecList.Add(SpecListItem);
  16761. SpecializeElement(GenListItem,SpecListItem);
  16762. end;
  16763. end;
  16764. procedure TPasResolver.SpecializeElArray(GenEl, SpecEl: TPasElement;
  16765. GenList: TPasElementArray; var SpecList: TPasElementArray;
  16766. AllowReferences: boolean{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16767. var
  16768. l, i: Integer;
  16769. GenListItem, Ref, SpecListItem: TPasElement;
  16770. NewClass: TPTreeElement;
  16771. begin
  16772. if length(SpecList)>0 then
  16773. RaiseNotYetImplemented(20190914102814,GenEl,GetObjName(SpecEl));
  16774. l:=length(GenList);
  16775. SetLength(SpecList,l);
  16776. for i:=0 to l-1 do
  16777. SpecList[i]:=nil;
  16778. for i:=0 to l-1 do
  16779. begin
  16780. GenListItem:=GenList[i];
  16781. if GenListItem.Parent<>GenEl then
  16782. begin
  16783. if not AllowReferences then
  16784. RaiseNotYetImplemented(20190914102952,GenEl,IntToStr(i));
  16785. if not (GenListItem is TPasType) then
  16786. RaiseNotYetImplemented(20190914102957,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16787. // reference
  16788. Ref:=SpecializeTypeRef(GenEl,SpecEl,TPasType(GenListItem));
  16789. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16790. SpecList[i]:=Ref;
  16791. continue;
  16792. end;
  16793. if GenListItem.ClassType=TPasGenericTemplateType then
  16794. RaiseNotYetImplemented(20190914103040,GenEl);
  16795. NewClass:=TPTreeElement(GenListItem.ClassType);
  16796. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16797. SpecList[i]:=SpecListItem;
  16798. SpecializeElement(GenListItem,SpecListItem);
  16799. end;
  16800. end;
  16801. procedure TPasResolver.SpecializeProcedure(GenEl, SpecEl: TPasProcedure;
  16802. SpecializedItem: TPRSpecializedItem);
  16803. var
  16804. GenProcType: TPasProcedureType;
  16805. NewClass: TPTreeElement;
  16806. SpecProcScope, GenProcScope: TPasProcedureScope;
  16807. i, j: Integer;
  16808. GenPart, SpecPart: TProcedureNamePart;
  16809. GenTempl, SpecTempl: TPasGenericTemplateType;
  16810. Templates: TFPList;
  16811. GenBody: TProcedureBody;
  16812. begin
  16813. GenProcScope:=GenEl.CustomData as TPasProcedureScope;
  16814. SpecProcScope:=SpecEl.CustomData as TPasProcedureScope;
  16815. if SpecProcScope<>nil then
  16816. begin
  16817. if TopScope<>SpecProcScope then
  16818. RaiseNotYetImplemented(20190920194151,SpecEl);
  16819. end
  16820. else if SpecializedItem<>nil then
  16821. begin
  16822. // specialized generic/parametrized procedure
  16823. SpecProcScope:=TPasProcedureScope(PushScope(SpecEl,ScopeClass_Procedure));
  16824. SpecProcScope.SpecializedFromItem:=SpecializedItem;
  16825. if GenProcScope.DeclarationProc<>nil then
  16826. RaiseNotYetImplemented(20190920203700,SpecEl);
  16827. if GenProcScope.OverriddenProc<>nil then
  16828. RaiseNotYetImplemented(20190920203536,SpecEl);
  16829. SpecProcScope.ClassRecScope:=GenProcScope.ClassRecScope;
  16830. // SpecProcScope.Flags
  16831. SpecProcScope.ModeSwitches:=GenProcScope.ModeSwitches;
  16832. SpecProcScope.BoolSwitches:=GenProcScope.BoolSwitches;
  16833. Templates:=GetProcTemplateTypes(GenEl);
  16834. if (Templates=nil) or (Templates.Count=0) then
  16835. RaiseNotYetImplemented(20190920183140,SpecEl);
  16836. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecProcScope,true);
  16837. end
  16838. else
  16839. RaiseNotYetImplemented(20190922153918,SpecEl);
  16840. Include(SpecProcScope.Flags,ppsfIsSpecialized);
  16841. if GenEl.PublicName<>nil then
  16842. SpecializeElExpr(GenEl,SpecEl,GenEl.PublicName,SpecEl.PublicName);
  16843. if GenEl.LibrarySymbolName<>nil then
  16844. SpecializeElExpr(GenEl,SpecEl,GenEl.LibrarySymbolName,SpecEl.LibrarySymbolName);
  16845. if GenEl.LibraryExpr<>nil then
  16846. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryExpr,SpecEl.LibraryExpr);
  16847. if GenEl.DispIDExpr<>nil then
  16848. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16849. if GenEl.MessageExpr<>nil then
  16850. SpecializeElExpr(GenEl,SpecEl,GenEl.MessageExpr,SpecEl.MessageExpr);
  16851. SpecEl.MessageName:=GenEl.MessageName;
  16852. SpecEl.MessageType:=GenEl.MessageType;
  16853. SpecEl.AliasName:=GenEl.AliasName;
  16854. SpecEl.Modifiers:=GenEl.Modifiers;
  16855. if GenEl.NameParts<>nil then
  16856. begin
  16857. if SpecEl.NameParts<>nil then
  16858. RaiseNotYetImplemented(20190818125620,SpecEl);
  16859. SpecEl.NameParts:=TFPList.Create;
  16860. for i:=0 to GenEl.NameParts.Count-1 do
  16861. begin
  16862. GenPart:=TProcedureNamePart(GenEl.NameParts[i]);
  16863. SpecPart:=TProcedureNamePart.Create;
  16864. SpecEl.NameParts.Add(SpecPart);
  16865. SpecPart.Name:=GenPart.Name;
  16866. if GenPart.Templates<>nil then
  16867. begin
  16868. if (SpecializedItem<>nil) and (i=GenEl.NameParts.Count-1) then
  16869. begin
  16870. // the templates have been specialized to SpecializedItem.Params
  16871. continue;
  16872. end;
  16873. SpecPart.Templates:=TFPList.Create;
  16874. for j:=0 to GenPart.Templates.Count-1 do
  16875. begin
  16876. GenTempl:=TPasGenericTemplateType(GenPart.Templates[j]);
  16877. if GenTempl.Parent<>GenEl then
  16878. RaiseNotYetImplemented(20190818130001,GenEl,IntToStr(i)+','+IntToStr(j)+':'+GenTempl.Name+' GenParent='+GetObjName(GenTempl.Parent)+' GenEl='+GetObjName(GenEl));
  16879. NewClass:=TPTreeElement(GenTempl.ClassType);
  16880. SpecTempl:=TPasGenericTemplateType(NewClass.Create(GenTempl.Name,SpecEl));
  16881. SpecPart.Templates.Add(SpecTempl);
  16882. SpecializeElement(GenTempl,SpecTempl);
  16883. end;
  16884. end;
  16885. end;
  16886. end;
  16887. if GenEl.ProcType<>nil then
  16888. begin
  16889. GenProcType:=GenEl.ProcType;
  16890. if GenProcType.Parent<>GenEl then
  16891. begin
  16892. {$IFDEF defined(VerbosePCUFiler) or defined(VerbosePJUFiler)}
  16893. writeln('TPasResolver.SpecializeProcedure GenEl=',GetObjPath(GenEl),' GenProcType.Parent=',GetObjPath(GenProcType.Parent));
  16894. {$ENDIF}
  16895. RaiseNotYetImplemented(20190803212426,GenEl,GetObjPath(GenProcType.Parent));
  16896. end;
  16897. NewClass:=TPTreeElement(GenProcType.ClassType);
  16898. SpecEl.ProcType:=TPasProcedureType(NewClass.Create(GenProcType.Name,SpecEl));
  16899. SpecializeElement(GenProcType,SpecEl.ProcType);
  16900. end;
  16901. SpecProcScope.GenericStep:=psgsInterfaceParsed;
  16902. if GenEl.Body<>nil then
  16903. begin
  16904. // implementation proc
  16905. if SpecializedItem<>nil then
  16906. SpecializedItem.Step:=prssImplementationBuilding;
  16907. GenBody:=GenEl.Body;
  16908. if GenBody.Parent<>GenEl then
  16909. RaiseNotYetImplemented(20190804183308,GenEl,GetObjName(GenBody.Parent));
  16910. if SpecEl.Body<>nil then
  16911. RaiseNotYetImplemented(20190920211853,SpecEl);
  16912. NewClass:=TPTreeElement(GenBody.ClassType);
  16913. SpecEl.Body:=TProcedureBody(NewClass.Create(GenBody.Name,SpecEl));
  16914. SpecializeElement(GenBody,SpecEl.Body);
  16915. FinishProcedure(SpecEl);
  16916. end
  16917. else if SpecializedItem=nil then
  16918. // declaration proc, parent is specialized
  16919. FinishProcedure(SpecEl)
  16920. else
  16921. begin
  16922. // specialized generic procedure, body is not yet parsed
  16923. SpecializedItem.Step:=prssInterfaceFinished;
  16924. if TopScope<>SpecProcScope then
  16925. RaiseNotYetImplemented(20190920190400,SpecEl);
  16926. PopScope;
  16927. end;
  16928. end;
  16929. procedure TPasResolver.SpecializeOperator(GenEl, SpecEl: TPasOperator);
  16930. begin
  16931. SpecEl.OperatorType:=GenEl.OperatorType;
  16932. SpecEl.TokenBased:=GenEl.TokenBased;
  16933. SpecializeProcedure(GenEl,SpecEl,nil);
  16934. end;
  16935. procedure TPasResolver.SpecializeProcedureType(GenEl,
  16936. SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  16937. var
  16938. GenResultEl, NewResultEl: TPasResultElement;
  16939. NewClass: TPTreeElement;
  16940. i: Integer;
  16941. SpecScope: TPasGenericScope;
  16942. begin
  16943. if GenEl.GenericTemplateTypes<>nil then
  16944. begin
  16945. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_ProcType));
  16946. if SpecializedItem<>nil then
  16947. begin
  16948. // specialized procedure type
  16949. SpecScope.SpecializedFromItem:=SpecializedItem;
  16950. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  16951. SpecializedItem,SpecScope,true);
  16952. end
  16953. else
  16954. begin
  16955. // generic procedure type inside a generic type
  16956. RaiseNotYetImplemented(20190813194550,GenEl);
  16957. end;
  16958. end;
  16959. // Args
  16960. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16961. {$IFDEF CheckPasTreeRefCount},'TPasProcedureType.Args'{$ENDIF});
  16962. for i:=0 to SpecEl.Args.Count-1 do
  16963. FinishArgument(TPasArgument(SpecEl.Args[i]));
  16964. // varargs
  16965. SpecializeElType(GenEl,SpecEl,GenEl.VarArgsType,SpecEl.VarArgsType);
  16966. // calling convention and proc type modifiers
  16967. SpecEl.CallingConvention:=GenEl.CallingConvention;
  16968. SpecEl.Modifiers:=GenEl.Modifiers;
  16969. // function result
  16970. if SpecEl is TPasFunctionType then
  16971. begin
  16972. GenResultEl:=TPasFunctionType(GenEl).ResultEl;
  16973. if GenResultEl<>nil then
  16974. begin
  16975. if GenResultEl.Parent<>GenEl then
  16976. RaiseNotYetImplemented(20190803212935,GenEl,GetObjName(GenResultEl.Parent));
  16977. NewClass:=TPTreeElement(GenResultEl.ClassType);
  16978. NewResultEl:=TPasResultElement(NewClass.Create(GenResultEl.Name,SpecEl));
  16979. TPasFunctionType(SpecEl).ResultEl:=NewResultEl;
  16980. AddFunctionResult(NewResultEl);
  16981. SpecializeElType(GenResultEl,NewResultEl,GenResultEl.ResultType,NewResultEl.ResultType);
  16982. end;
  16983. end;
  16984. FinishProcedureType(SpecEl);
  16985. if SpecializedItem<>nil then
  16986. SpecializedItem.Step:=prssImplementationFinished;
  16987. end;
  16988. procedure TPasResolver.SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  16989. var
  16990. GenBody, NewBody: TPasImplBlock;
  16991. NewClass: TPTreeElement;
  16992. begin
  16993. SpecializeDeclarations(GenEl,SpecEl);
  16994. FinishTypeSection(SpecEl);
  16995. if GenEl.Body<>nil then
  16996. begin
  16997. GenBody:=GenEl.Body;
  16998. if GenBody.Parent<>GenEl then
  16999. RaiseNotYetImplemented(20190804184934,GenBody);
  17000. NewClass:=TPTreeElement(GenBody.ClassType);
  17001. NewBody:=TPasImplBlock(NewClass.Create(GenBody.Name,SpecEl));
  17002. SpecEl.Body:=NewBody;
  17003. SpecializeElement(GenBody,NewBody);
  17004. end;
  17005. end;
  17006. procedure TPasResolver.SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  17007. var
  17008. i: Integer;
  17009. GenDecl, NewDecl: TPasElement;
  17010. NewClass: TPTreeElement;
  17011. begin
  17012. for i:=0 to GenEl.Declarations.Count-1 do
  17013. begin
  17014. GenDecl:=TPasElement(GenEl.Declarations[i]);
  17015. if GenDecl.Parent<>GenEl then
  17016. RaiseNotYetImplemented(20190806091336,GenEl,GetObjName(GenDecl));
  17017. NewClass:=TPTreeElement(GenDecl.ClassType);
  17018. NewDecl:=TPasElement(NewClass.Create(GenDecl.Name,SpecEl));
  17019. SpecEl.Declarations.Add(NewDecl);
  17020. if NewClass=TPasAttributes then
  17021. SpecEl.Attributes.Add(NewDecl)
  17022. else if (NewClass=TPasClassType)
  17023. or (NewClass=TPasRecordType) then
  17024. SpecEl.Classes.Add(NewDecl)
  17025. else if NewClass=TPasConst then
  17026. SpecEl.Consts.Add(NewDecl)
  17027. else if NewClass=TPasExportSymbol then
  17028. SpecEl.ExportSymbols.Add(NewDecl)
  17029. else if NewClass.InheritsFrom(TPasProcedure) then
  17030. SpecEl.Functions.Add(NewDecl)
  17031. else if NewClass=TPasProperty then
  17032. SpecEl.Properties.Add(NewDecl)
  17033. else if NewClass=TPasResString then
  17034. SpecEl.ResStrings.Add(NewDecl)
  17035. else if NewClass.InheritsFrom(TPasType) then
  17036. SpecEl.Types.Add(NewDecl)
  17037. else if NewClass=TPasVariable then
  17038. SpecEl.Variables.Add(NewDecl)
  17039. else
  17040. RaiseNotYetImplemented(20190804184718,GenDecl);
  17041. SpecializeElement(GenDecl,NewDecl);
  17042. end;
  17043. end;
  17044. procedure TPasResolver.SpecializeSpecializeType(GenEl,
  17045. SpecEl: TPasSpecializeType);
  17046. var
  17047. GenDestType: TPasType;
  17048. Ref: TPasElement;
  17049. begin
  17050. // search DestType<ParamCount>
  17051. GenDestType:=GenEl.DestType;
  17052. if GenDestType=nil then
  17053. RaiseNotYetImplemented(20190812022211,GenEl);
  17054. if GenDestType.Parent=GenEl then
  17055. RaiseNotYetImplemented(20190812022251,GenEl);
  17056. Ref:=FindElementFor(GenDestType.Name,GenEl.Parent,GenEl.Params.Count);
  17057. if not (Ref is TPasGenericType) then
  17058. RaiseNotYetImplemented(20190812022359,GenEl,GetObjName(Ref));
  17059. SpecEl.DestType:=TPasGenericType(Ref);
  17060. SpecEl.DestType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  17061. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17062. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true
  17063. {$IFDEF CheckPasTreeRefCount},'TPasSpecializeType.Params'{$ENDIF});
  17064. FinishSpecializeType(SpecEl);
  17065. {$IFDEF VerbosePasResolver}
  17066. //writeln('TPasResolver.SpecializeSpecializeType ',GetObjName(SpecEl.DestType),' ',GetObjName(SpecEl.CustomData));
  17067. {$ENDIF}
  17068. end;
  17069. procedure TPasResolver.SpecializeGenericTemplateType(GenEl,
  17070. SpecEl: TPasGenericTemplateType);
  17071. var
  17072. GenConstraints, SpecConstraints: TPasElementArray;
  17073. i: Integer;
  17074. ConEl: TPasElement;
  17075. begin
  17076. GenConstraints:=GenEl.Constraints;
  17077. if length(SpecEl.Constraints)>0 then
  17078. RaiseNotYetImplemented(20190914070209,GenEl);
  17079. SetLength(SpecEl.Constraints,length(GenConstraints));
  17080. SpecConstraints:=SpecEl.Constraints;
  17081. for i:=0 to length(SpecConstraints)-1 do
  17082. SpecConstraints[i]:=nil;
  17083. for i:=0 to length(GenConstraints)-1 do
  17084. begin
  17085. ConEl:=GenConstraints[i];
  17086. if ConEl is TPasExpr then
  17087. SpecializeElExpr(GenEl,SpecEl,TPasExpr(ConEl),TPasExpr(SpecConstraints[i]))
  17088. else if ConEl is TPasType then
  17089. SpecializeElType(GenEl,SpecEl,TPasType(ConEl),TPasType(SpecConstraints[i]))
  17090. else
  17091. RaiseNotYetImplemented(20190914070522,GenEl,IntToStr(i)+' '+GetObjName(ConEl));
  17092. end;
  17093. end;
  17094. procedure TPasResolver.SpecializeArgument(GenEl, SpecEl: TPasArgument);
  17095. begin
  17096. SpecEl.Access:=GenEl.Access;
  17097. SpecializeElType(GenEl,SpecEl,GenEl.ArgType,SpecEl.ArgType);
  17098. if GenEl.ValueExpr<>nil then
  17099. SpecializeElExpr(GenEl,SpecEl,GenEl.ValueExpr,SpecEl.ValueExpr);
  17100. // FinishArgument is called when all arguments are ready
  17101. end;
  17102. procedure TPasResolver.SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  17103. var
  17104. i: Integer;
  17105. GenImpl, NewImpl: TPasImplElement;
  17106. NewClass: TPTreeElement;
  17107. begin
  17108. for i:=0 to GenEl.Elements.Count-1 do
  17109. begin
  17110. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  17111. if GenImpl.Parent<>GenEl then
  17112. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  17113. NewClass:=TPTreeElement(GenImpl.ClassType);
  17114. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  17115. SpecEl.Elements.Add(NewImpl);
  17116. SpecializeElement(GenImpl,NewImpl);
  17117. end;
  17118. end;
  17119. procedure TPasResolver.SpecializeImplAsmStatement(GenEl,
  17120. SpecEl: TPasImplAsmStatement);
  17121. begin
  17122. SpecializeImplBlock(GenEl,SpecEl);
  17123. SpecEl.Tokens.Assign(GenEl.Tokens);
  17124. end;
  17125. procedure TPasResolver.SpecializeImplRepeatUntil(GenEl,
  17126. SpecEl: TPasImplRepeatUntil);
  17127. begin
  17128. SpecializeImplBlock(GenEl,SpecEl);
  17129. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  17130. end;
  17131. procedure TPasResolver.SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  17132. begin
  17133. // do not call SpecializeImplBlock(GenEl,SpecEl);
  17134. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  17135. SpecializeElImplEl(GenEl,SpecEl,GenEl.IfBranch,SpecEl.IfBranch);
  17136. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,SpecEl.ElseBranch);
  17137. end;
  17138. procedure TPasResolver.SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  17139. begin
  17140. // do not call SpecializeImplBlock(GenEl,SpecEl);
  17141. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  17142. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17143. end;
  17144. procedure TPasResolver.SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  17145. var
  17146. i: Integer;
  17147. GenExpr, SpecExpr: TPasExpr;
  17148. NewClass: TPTreeElement;
  17149. begin
  17150. if SpecEl.CustomData<>nil then
  17151. RaiseNotYetImplemented(20200530201007,GenEl,GetObjName(SpecEl.CustomData));
  17152. PushScope(SpecEl,TPasWithScope);
  17153. for i:=0 to GenEl.Expressions.Count-1 do
  17154. begin
  17155. GenExpr:=TPasExpr(GenEl.Expressions[i]);
  17156. if GenExpr.Parent<>GenEl then
  17157. RaiseNotYetImplemented(20190808224343,GenEl,IntToStr(i));
  17158. NewClass:=TPTreeElement(GenExpr.ClassType);
  17159. SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
  17160. SpecEl.Expressions.Add(SpecExpr);
  17161. SpecializeElement(GenExpr,SpecExpr);
  17162. BeginScope(stWithExpr,SpecExpr);
  17163. end;
  17164. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17165. FinishWithDo(SpecEl);
  17166. end;
  17167. procedure TPasResolver.SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  17168. begin
  17169. SpecializeElExpr(GenEl,SpecEl,GenEl.CaseExpr,SpecEl.CaseExpr);
  17170. SpecializeImplBlock(GenEl,SpecEl); // Elements
  17171. if GenEl.ElseBranch<>nil then
  17172. SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,TPasImplElement(SpecEl.ElseBranch)
  17173. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseOf.ElseBranch'{$ENDIF});
  17174. end;
  17175. procedure TPasResolver.SpecializeImplCaseStatement(GenEl,
  17176. SpecEl: TPasImplCaseStatement);
  17177. begin
  17178. SpecializeElList(GenEl,SpecEl,GenEl.Expressions,SpecEl.Expressions,false
  17179. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseStatement.CaseExpr'{$ENDIF});
  17180. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17181. end;
  17182. procedure TPasResolver.SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  17183. begin
  17184. if GenEl.Elements.Count>0 then
  17185. RaiseNotYetImplemented(20190808142935,GenEl);
  17186. SpecEl.Kind:=GenEl.Kind;
  17187. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  17188. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  17189. end;
  17190. procedure TPasResolver.SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  17191. begin
  17192. if GenEl.Elements.Count>0 then
  17193. RaiseNotYetImplemented(20190808142935,GenEl);
  17194. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17195. end;
  17196. procedure TPasResolver.SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  17197. var
  17198. i: Integer;
  17199. GenImpl, NewImpl: TPasImplElement;
  17200. NewClass: TPTreeElement;
  17201. begin
  17202. if GenEl.Variable<>nil then
  17203. RaiseNotYetImplemented(20190808142627,GenEl);
  17204. SpecializeElExpr(GenEl,SpecEl,GenEl.VariableName,SpecEl.VariableName);
  17205. SpecEl.LoopType:=GenEl.LoopType;
  17206. SpecializeElExpr(GenEl,SpecEl,GenEl.StartExpr,SpecEl.StartExpr);
  17207. SpecializeElExpr(GenEl,SpecEl,GenEl.EndExpr,SpecEl.EndExpr);
  17208. FinishForLoopHeader(SpecEl);
  17209. // SpecEl.Body is set via AddElement
  17210. for i:=0 to GenEl.Elements.Count-1 do
  17211. begin
  17212. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  17213. if GenImpl.Parent<>GenEl then
  17214. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  17215. NewClass:=TPTreeElement(GenImpl.ClassType);
  17216. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  17217. SpecEl.AddElement(NewImpl);
  17218. SpecializeElement(GenImpl,NewImpl);
  17219. end;
  17220. end;
  17221. procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  17222. begin
  17223. SpecializeImplBlock(GenEl,SpecEl); // clone elements
  17224. if GenEl.FinallyExcept<>nil then
  17225. SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
  17226. TPasImplElement(SpecEl.FinallyExcept));
  17227. if GenEl.ElseBranch<>nil then
  17228. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
  17229. TPasImplElement(SpecEl.ElseBranch));
  17230. end;
  17231. procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  17232. var
  17233. GenVar: TPasVariable;
  17234. NewClass: TPTreeElement;
  17235. begin
  17236. GenVar:=GenEl.VarEl;
  17237. if GenVar<>nil then
  17238. begin
  17239. if GenVar.Parent<>GenEl then
  17240. RaiseNotYetImplemented(20190808232327,GenEl);
  17241. NewClass:=TPTreeElement(GenVar.ClassType);
  17242. SpecEl.VarEl:=TPasVariable(NewClass.Create(GenVar.Name,SpecEl));
  17243. SpecializeElement(GenVar,SpecEl.VarEl);
  17244. if GenVar.VarType<>GenEl.TypeEl then
  17245. RaiseNotYetImplemented(20190808232601,GenEl);
  17246. SpecEl.TypeEl:=SpecEl.VarEl.VarType;
  17247. SpecEl.TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
  17248. end
  17249. else
  17250. SpecializeElType(GenEl,SpecEl,GenEl.TypeEl,SpecEl.TypeEl);
  17251. FinishExceptOnExpr;
  17252. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17253. FinishExceptOnStatement;
  17254. end;
  17255. procedure TPasResolver.SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  17256. begin
  17257. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptObject,SpecEl.ExceptObject);
  17258. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptAddr,SpecEl.ExceptAddr);
  17259. end;
  17260. procedure TPasResolver.SpecializeExpr(GenEl, SpecEl: TPasExpr);
  17261. begin
  17262. SpecEl.Kind:=GenEl.Kind;
  17263. SpecEl.OpCode:=GenEl.OpCode;
  17264. SpecializeElExpr(GenEl,SpecEl,GenEl.format1,SpecEl.format1);
  17265. SpecializeElExpr(GenEl,SpecEl,GenEl.format2,SpecEl.format2);
  17266. end;
  17267. procedure TPasResolver.SpecializeExprArray(GenEl, SpecEl: TPasElement;
  17268. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  17269. var
  17270. i: Integer;
  17271. begin
  17272. if length(SpecArray)>0 then
  17273. RaiseNotYetImplemented(20190808205855,GenEl);
  17274. SetLength(SpecArray,length(GenArray));
  17275. for i:=0 to length(SpecArray)-1 do
  17276. SpecArray[i]:=nil;
  17277. for i:=0 to length(GenArray)-1 do
  17278. SpecializeElExpr(GenEl,SpecEl,GenArray[i],SpecArray[i]);
  17279. end;
  17280. procedure TPasResolver.SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  17281. begin
  17282. SpecializeExpr(GenEl,SpecEl);
  17283. SpecEl.Value:=GenEl.Value;
  17284. end;
  17285. procedure TPasResolver.SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  17286. begin
  17287. SpecializeExpr(GenEl,SpecEl);
  17288. SpecializeElExpr(GenEl,SpecEl,GenEl.Operand,SpecEl.Operand);
  17289. end;
  17290. procedure TPasResolver.SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  17291. begin
  17292. SpecializeExpr(GenEl,SpecEl);
  17293. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  17294. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  17295. end;
  17296. procedure TPasResolver.SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  17297. begin
  17298. SpecializeExpr(GenEl,SpecEl);
  17299. SpecEl.Value:=GenEl.Value;
  17300. end;
  17301. procedure TPasResolver.SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  17302. begin
  17303. SpecializeExpr(GenEl,SpecEl);
  17304. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  17305. SpecializeExprArray(GenEl,SpecEl,GenEl.Params,SpecEl.Params);
  17306. end;
  17307. procedure TPasResolver.SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  17308. var
  17309. GenField: TRecordValuesItem;
  17310. i: Integer;
  17311. SpecFieldP: PRecordValuesItem;
  17312. begin
  17313. SpecializeExpr(GenEl,SpecEl);
  17314. // fields
  17315. SetLength(SpecEl.Fields,length(GenEl.Fields));
  17316. for i:=0 to length(SpecEl.Fields)-1 do
  17317. with SpecEl.Fields[i] do
  17318. begin
  17319. NameExp:=nil;
  17320. ValueExp:=nil;
  17321. end;
  17322. for i:=0 to length(GenEl.Fields)-1 do
  17323. begin
  17324. GenField:=GenEl.Fields[i];
  17325. if GenField.NameExp.Parent<>GenEl then
  17326. RaiseNotYetImplemented(20190808205128,GenEl);
  17327. if GenField.ValueExp.Parent<>GenEl then
  17328. RaiseNotYetImplemented(20190808205138,GenEl);
  17329. SpecFieldP:[email protected][i];
  17330. SpecializeElExpr(GenEl,SpecEl,GenField.NameExp,TPasExpr(SpecFieldP^.NameExp));
  17331. SpecializeElExpr(GenEl,SpecEl,GenField.ValueExp,SpecFieldP^.ValueExp);
  17332. end;
  17333. end;
  17334. procedure TPasResolver.SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  17335. begin
  17336. SpecializeExpr(GenEl,SpecEl);
  17337. SpecializeExprArray(GenEl,SpecEl,GenEl.Values,SpecEl.Values);
  17338. end;
  17339. procedure TPasResolver.SpecializeInlineSpecializeExpr(GenEl,
  17340. SpecEl: TInlineSpecializeExpr);
  17341. begin
  17342. SpecializeExpr(GenEl,SpecEl);
  17343. SpecializeElExpr(GenEl,SpecEl,GenEl.NameExpr,SpecEl.NameExpr);
  17344. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,
  17345. true{$IFDEF CheckPasTreeRefCount},'TInlineSpecializeExpr.Params'{$ENDIF});
  17346. end;
  17347. procedure TPasResolver.SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  17348. begin
  17349. SpecializeExpr(GenEl,SpecEl);
  17350. if GenEl.Proc=nil then
  17351. RaiseNotYetImplemented(20190808221018,GenEl);
  17352. RaiseNotYetImplemented(20190808221040,GenEl);
  17353. end;
  17354. procedure TPasResolver.SpecializeResString(GenEl, SpecEl: TPasResString);
  17355. begin
  17356. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17357. FinishResourcestring(SpecEl);
  17358. end;
  17359. procedure TPasResolver.SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  17360. begin
  17361. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  17362. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17363. // not needed by specialize: FinishTypeAlias();
  17364. FinishTypeDef(SpecEl);
  17365. end;
  17366. procedure TPasResolver.SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  17367. begin
  17368. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  17369. FinishPointerType(SpecEl);
  17370. end;
  17371. procedure TPasResolver.SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  17372. begin
  17373. SpecializeElExpr(GenEl,SpecEl,GenEl.RangeExpr,TPasExpr(SpecEl.RangeExpr));
  17374. FinishRangeType(SpecEl);
  17375. end;
  17376. procedure TPasResolver.SpecializeArrayType(GenEl, SpecEl: TPasArrayType;
  17377. SpecializedItem: TPRSpecializedTypeItem);
  17378. var
  17379. SpecScope: TPasGenericScope;
  17380. begin
  17381. SpecEl.IndexRange:=GenEl.IndexRange;
  17382. SpecEl.PackMode:=GenEl.PackMode;
  17383. if GenEl.GenericTemplateTypes<>nil then
  17384. begin
  17385. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_Array));
  17386. if SpecializedItem<>nil then
  17387. begin
  17388. // specialized generic array
  17389. SpecScope.SpecializedFromItem:=SpecializedItem;
  17390. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  17391. SpecializedItem,SpecScope,true);
  17392. end
  17393. else
  17394. begin
  17395. // generic arraytype inside a generic type
  17396. RaiseNotYetImplemented(20190812225218,GenEl);
  17397. end;
  17398. end;
  17399. SpecializeExprArray(GenEl,SpecEl,GenEl.Ranges,SpecEl.Ranges);
  17400. SpecializeElType(GenEl,SpecEl,GenEl.ElType,SpecEl.ElType);
  17401. FinishArrayType(SpecEl);
  17402. if SpecializedItem<>nil then
  17403. SpecializedItem.Step:=prssImplementationFinished;
  17404. end;
  17405. procedure TPasResolver.SpecializeRecordType(GenEl, SpecEl: TPasRecordType;
  17406. SpecializedItem: TPRSpecializedTypeItem);
  17407. var
  17408. SpecScope: TPasGenericScope;
  17409. begin
  17410. SpecEl.PackMode:=GenEl.PackMode;
  17411. if SpecializedItem<>nil then
  17412. begin
  17413. // specialized generic record
  17414. if SpecEl.CustomData<>nil then
  17415. RaiseNotYetImplemented(20190921204740,SpecEl);
  17416. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_Record));
  17417. SpecScope.VisibilityContext:=SpecEl;
  17418. SpecScope.SpecializedFromItem:=SpecializedItem;
  17419. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  17420. SpecializedItem,SpecScope,true);
  17421. if not (msDelphi in CurrentParser.CurrentModeswitches) then
  17422. begin
  17423. // ObjFPC: add canonical type alias
  17424. SpecScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
  17425. end;
  17426. end
  17427. else if GenEl.GenericTemplateTypes.Count>0 then
  17428. begin
  17429. // generic recordtype inside a generic type
  17430. if SpecEl.CustomData=nil then
  17431. RaiseNotYetImplemented(20190815201634,SpecEl);
  17432. SpecScope:=TPasGenericScope(SpecEl.CustomData);
  17433. RaiseNotYetImplemented(20190815194327,GenEl);
  17434. end;
  17435. // specialize sub elements
  17436. SpecializeMembers(GenEl,SpecEl);
  17437. FinishRecordType(SpecEl);
  17438. if SpecializedItem<>nil then
  17439. SpecializedItem.Step:=prssInterfaceFinished;
  17440. end;
  17441. procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType;
  17442. SpecializedItem: TPRSpecializedTypeItem);
  17443. var
  17444. HeaderScope: TPasGenericParamsScope;
  17445. TemplType: TPasGenericTemplateType;
  17446. GenericTemplateTypes: TFPList;
  17447. SpecClassScope: TPasClassScope;
  17448. begin
  17449. GenericTemplateTypes:=GenEl.GenericTemplateTypes;
  17450. SpecEl.ObjKind:=GenEl.ObjKind;
  17451. SpecEl.PackMode:=GenEl.PackMode;
  17452. if GenEl.HelperForType<>nil then
  17453. RaiseNotYetImplemented(20190730182758,GenEl,'');
  17454. if GenEl.IsForward then
  17455. RaiseNotYetImplemented(20190730182858,GenEl);
  17456. SpecEl.IsExternal:=GenEl.IsExternal;
  17457. SpecEl.IsShortDefinition:=GenEl.IsShortDefinition;
  17458. if GenEl.GUIDExpr<>nil then
  17459. SpecializeElExpr(GenEl,SpecEl,GenEl.GUIDExpr,SpecEl.GUIDExpr);
  17460. SpecEl.Modifiers.Assign(GenEl.Modifiers);
  17461. SpecEl.ExternalNameSpace:=GenEl.ExternalNameSpace;
  17462. SpecEl.ExternalName:=GenEl.ExternalName;
  17463. SpecEl.InterfaceType:=GenEl.InterfaceType;
  17464. // ancestor+interfaces
  17465. if SpecializedItem<>nil then
  17466. begin
  17467. // ancestor can be a specialized type. For example: = class(TAncestor<T>)
  17468. // -> create a scope with the specialized parameters
  17469. HeaderScope:=TPasGenericParamsScope.Create;
  17470. SpecializedItem.HeaderScope:=HeaderScope;
  17471. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
  17472. HeaderScope.Element:=TemplType;
  17473. PushScope(HeaderScope);
  17474. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  17475. SpecializedItem,HeaderScope,true);
  17476. end
  17477. else
  17478. HeaderScope:=nil;
  17479. SpecializeElType(GenEl,SpecEl,
  17480. GenEl.AncestorType,SpecEl.AncestorType);
  17481. SpecializeElList(GenEl,SpecEl,
  17482. GenEl.Interfaces,SpecEl.Interfaces,true
  17483. {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF});
  17484. if HeaderScope<>nil then
  17485. begin
  17486. if TopScope<>HeaderScope then
  17487. RaiseNotYetImplemented(20190813003056,GenEl);
  17488. PopScope;
  17489. SpecializedItem.HeaderScope:=nil;
  17490. HeaderScope.Free;
  17491. end;
  17492. FinishAncestors(SpecEl);
  17493. if GenEl.Interfaces.Count<>SpecEl.Interfaces.Count then
  17494. RaiseNotYetImplemented(20200601125556,GenEl,IntToStr(GenEl.Interfaces.Count)+'<>'+IntToStr(SpecEl.Interfaces.Count));
  17495. // Note: class scope was created by FinishAncestors
  17496. SpecClassScope:=NoNil(SpecEl.CustomData) as TPasClassScope;
  17497. if SpecClassScope.SpecializedFromItem<>nil then
  17498. RaiseNotYetImplemented(20190816215413,SpecEl);
  17499. if SpecializedItem<>nil then
  17500. begin
  17501. SpecClassScope.SpecializedFromItem:=SpecializedItem;
  17502. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  17503. SpecializedItem,SpecClassScope,false);
  17504. if not (msDelphi in CurrentParser.CurrentModeswitches) then
  17505. begin
  17506. // ObjFPC: add canonical type alias
  17507. SpecClassScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
  17508. end;
  17509. end;
  17510. // specialize sub elements
  17511. SpecializeMembers(GenEl,SpecEl);
  17512. if SpecializedItem<>nil then
  17513. SpecializedItem.Step:=prssInterfaceFinished;
  17514. FinishClassType(SpecEl);
  17515. end;
  17516. procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  17517. begin
  17518. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  17519. end;
  17520. procedure TPasResolver.SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  17521. begin
  17522. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  17523. {$IFDEF CheckPasTreeRefCount},'TPasEnumType.Values'{$ENDIF});
  17524. FinishEnumType(SpecEl);
  17525. end;
  17526. procedure TPasResolver.SpecializeSetType(GenEl, SpecEl: TPasSetType);
  17527. begin
  17528. SpecEl.IsPacked:=GenEl.IsPacked;
  17529. SpecializeElType(GenEl,SpecEl,GenEl.EnumType,SpecEl.EnumType);
  17530. FinishSetType(SpecEl);
  17531. end;
  17532. procedure TPasResolver.SpecializeVariant(GenEl, SpecEl: TPasVariant);
  17533. begin
  17534. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  17535. {$IFDEF CheckPasTreeRefCount},'TPasVariant.Values'{$ENDIF});
  17536. RaiseNotYetImplemented(20190808214218,GenEl)
  17537. //ToDo: Members: TPasRecordType;
  17538. end;
  17539. procedure TPasResolver.SpecializeStringType(GenEl, SpecEl: TPasStringType);
  17540. begin
  17541. SpecEl.LengthExpr:=GenEl.LengthExpr;
  17542. FinishTypeDef(SpecEl);
  17543. end;
  17544. procedure TPasResolver.SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  17545. begin
  17546. SpecializeExprArray(GenEl,SpecEl,GenEl.Calls,SpecEl.Calls);
  17547. FinishAttributes(SpecEl);
  17548. end;
  17549. procedure TPasResolver.SpecializeMethodResolution(GenEl,
  17550. SpecEl: TPasMethodResolution);
  17551. begin
  17552. SpecEl.ProcClass:=GenEl.ProcClass;
  17553. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceName,SpecEl.InterfaceName);
  17554. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceProc,SpecEl.InterfaceProc);
  17555. SpecializeElExpr(GenEl,SpecEl,GenEl.ImplementationProc,SpecEl.ImplementationProc);
  17556. FinishMethodResolution(SpecEl);
  17557. end;
  17558. function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
  17559. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  17560. var Handled: boolean): integer;
  17561. // called when LHS or RHS BaseType is btCustom
  17562. // if RaiseOnIncompatible=true you can raise an useful error.
  17563. begin
  17564. Result:=cIncompatible;
  17565. if LHS.BaseType=btNone then ;
  17566. if RHS.BaseType=btNone then ;
  17567. if ErrorEl=nil then ;
  17568. if RaiseOnIncompatible then ;
  17569. if Handled then ;
  17570. end;
  17571. function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
  17572. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  17573. ): integer;
  17574. begin
  17575. Result:=cIncompatible;
  17576. if LHS.BaseType=RHS.BaseType then;
  17577. if ErrorEl=nil then;
  17578. if RaiseOnIncompatible then ;
  17579. end;
  17580. function TPasResolver.BI_Length_OnGetCallCompatibility(
  17581. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17582. // check params of built in proc 'length'
  17583. var
  17584. Params: TParamsExpr;
  17585. Param: TPasExpr;
  17586. ParamResolved: TPasResolverResult;
  17587. Ranges: TPasExprArray;
  17588. begin
  17589. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17590. exit(cIncompatible);
  17591. Params:=TParamsExpr(Expr);
  17592. // first param: string or dynamic array or type/const of static array
  17593. Param:=Params.Params[0];
  17594. ComputeElement(Param,ParamResolved,[]);
  17595. Result:=cIncompatible;
  17596. if ParamResolved.BaseType in btAllStringAndChars then
  17597. begin
  17598. if rrfReadable in ParamResolved.Flags then
  17599. Result:=cExact;
  17600. end
  17601. else if ParamResolved.BaseType=btContext then
  17602. begin
  17603. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17604. begin
  17605. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17606. if length(Ranges)=0 then
  17607. begin
  17608. if rrfReadable in ParamResolved.Flags then
  17609. Result:=cExact;
  17610. end
  17611. else
  17612. // static array
  17613. Result:=cExact;
  17614. end;
  17615. end;
  17616. if Result=cIncompatible then
  17617. exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
  17618. 'string or dynamic array',RaiseOnError));
  17619. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17620. end;
  17621. procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17622. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17623. begin
  17624. if Params=nil then ;
  17625. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  17626. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
  17627. end;
  17628. procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  17629. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17630. var
  17631. Param, Expr: TPasExpr;
  17632. ParamResolved: TPasResolverResult;
  17633. Value: TResEvalValue;
  17634. Ranges: TPasExprArray;
  17635. IdentEl: TPasElement;
  17636. begin
  17637. Evaluated:=nil;
  17638. // first param: string or dynamic array or type/const of static array
  17639. Param:=Params.Params[0];
  17640. ComputeElement(Param,ParamResolved,[]);
  17641. if ParamResolved.BaseType in btAllStringAndChars then
  17642. begin
  17643. if rrfReadable in ParamResolved.Flags then
  17644. begin
  17645. Value:=Eval(Param,Flags);
  17646. if Value=nil then exit;
  17647. case Value.Kind of
  17648. {$ifdef FPC_HAS_CPSTRING}
  17649. revkString:
  17650. Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
  17651. {$endif}
  17652. revkUnicodeString:
  17653. Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
  17654. end;
  17655. ReleaseEvalValue(Value);
  17656. end
  17657. end
  17658. else if ParamResolved.BaseType=btContext then
  17659. begin
  17660. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17661. begin
  17662. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17663. if length(Ranges)=0 then
  17664. begin
  17665. // open or dynamic array
  17666. IdentEl:=ParamResolved.IdentEl;
  17667. if (IdentEl is TPasVariable)
  17668. and (TPasVariable(IdentEl).Expr is TPasExpr) then
  17669. begin
  17670. Expr:=TPasVariable(IdentEl).Expr;
  17671. if Expr is TArrayValues then
  17672. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values))
  17673. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  17674. Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params));
  17675. end;
  17676. end
  17677. else
  17678. begin
  17679. // static array
  17680. Evaluated:=TResEvalInt.CreateValue(GetRangeLength(Ranges[0]));
  17681. end;
  17682. end;
  17683. end;
  17684. if Proc=nil then ;
  17685. end;
  17686. function TPasResolver.BI_SetLength_OnGetCallCompatibility(
  17687. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17688. // check params of built in proc 'setlength'
  17689. var
  17690. Params: TParamsExpr;
  17691. Param: TPasExpr;
  17692. ParamResolved, DimResolved: TPasResolverResult;
  17693. ArgNo: Integer;
  17694. DynArr: TPasArrayType;
  17695. ElType: TPasType;
  17696. begin
  17697. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17698. exit(cIncompatible);
  17699. Params:=TParamsExpr(Expr);
  17700. // first param: string or array variable
  17701. Param:=Params.Params[0];
  17702. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17703. Result:=cIncompatible;
  17704. DynArr:=nil;
  17705. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17706. begin
  17707. if ParamResolved.BaseType in btAllStrings then
  17708. Result:=cExact
  17709. else if ParamResolved.BaseType=btContext then
  17710. begin
  17711. if IsDynArray(ParamResolved.LoTypeEl) then
  17712. begin
  17713. Result:=cExact;
  17714. DynArr:=NoNil(ParamResolved.LoTypeEl) as TPasArrayType;
  17715. end;
  17716. end;
  17717. end;
  17718. if Result=cIncompatible then
  17719. exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
  17720. 'string or dynamic array variable',RaiseOnError));
  17721. // second param: new length
  17722. ArgNo:=2;
  17723. repeat
  17724. Param:=Params.Params[ArgNo-1];
  17725. ComputeElement(Param,DimResolved,[]);
  17726. Result:=cIncompatible;
  17727. if (rrfReadable in DimResolved.Flags)
  17728. and (DimResolved.BaseType in btAllInteger) then
  17729. Result:=cExact;
  17730. if Result=cIncompatible then
  17731. exit(CheckRaiseTypeArgNo(20170329160338,ArgNo,Param,DimResolved,
  17732. 'integer',RaiseOnError));
  17733. if (DynArr=nil) or (ArgNo=length(Params.Params)) then break;
  17734. ElType:=ResolveAliasType(DynArr.ElType);
  17735. if not IsDynArray(ElType) then break;
  17736. DynArr:=NoNil(ElType) as TPasArrayType;
  17737. inc(ArgNo);
  17738. until false;
  17739. Result:=CheckBuiltInMaxParamCount(Proc,Params,ArgNo,RaiseOnError);
  17740. end;
  17741. procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
  17742. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17743. var
  17744. P: TPasExprArray;
  17745. begin
  17746. if Proc=nil then ;
  17747. P:=Params.Params;
  17748. if P=nil then ;
  17749. FinishCallArgAccess(P[0],rraVarParam);
  17750. FinishCallArgAccess(P[1],rraRead);
  17751. end;
  17752. function TPasResolver.BI_InExclude_OnGetCallCompatibility(
  17753. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17754. // check params of built in proc 'include'
  17755. var
  17756. Params: TParamsExpr;
  17757. Param0, Param1: TPasExpr;
  17758. Param0Resolved, Param1Resolved: TPasResolverResult;
  17759. EnumType: TPasEnumType;
  17760. C: TClass;
  17761. LoTypeEl: TPasType;
  17762. RgType: TPasRangeType;
  17763. begin
  17764. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17765. exit(cIncompatible);
  17766. Params:=TParamsExpr(Expr);
  17767. // first Param0: set variable
  17768. // todo set of int, set of char, set of bool
  17769. Param0:=Params.Params[0];
  17770. ComputeElement(Param0,Param0Resolved,[rcNoImplicitProc]);
  17771. Param1:=Params.Params[1];
  17772. ComputeElement(Param1,Param1Resolved,[]);
  17773. EnumType:=nil;
  17774. RgType:=nil;
  17775. if ([rrfReadable,rrfWritable]*Param0Resolved.Flags=[rrfReadable,rrfWritable])
  17776. and (Param0Resolved.IdentEl<>nil) then
  17777. begin
  17778. C:=Param0Resolved.IdentEl.ClassType;
  17779. if (C.InheritsFrom(TPasVariable)
  17780. or (C=TPasArgument)
  17781. or (C=TPasResultElement)) then
  17782. begin
  17783. if Param0Resolved.BaseType=btSet then
  17784. begin
  17785. LoTypeEl:=Param0Resolved.LoTypeEl;
  17786. if LoTypeEl.ClassType=TPasEnumType then
  17787. begin
  17788. EnumType:=TPasEnumType(LoTypeEl);
  17789. if (not (rrfReadable in Param0Resolved.Flags))
  17790. or (Param0Resolved.LoTypeEl<>EnumType) then
  17791. begin
  17792. if RaiseOnError then
  17793. RaiseIncompatibleType(20210201225926,nIncompatibleTypeArgNo,
  17794. ['2'],Param0Resolved.LoTypeEl,EnumType,Param0);
  17795. exit(cIncompatible);
  17796. end;
  17797. end
  17798. else if LoTypeEl.ClassType=TPasRangeType then
  17799. begin
  17800. RgType:=TPasRangeType(LoTypeEl);
  17801. ComputeElement(RgType.RangeExpr.left,Param0Resolved,[]);
  17802. Result:=CheckAssignResCompatibility(Param0Resolved,Param1Resolved,Param1,RaiseOnError);
  17803. end;
  17804. end;
  17805. end;
  17806. end;
  17807. if (EnumType=nil) and (RgType=nil) then
  17808. begin
  17809. {$IFDEF VerbosePasResolver}
  17810. writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(Param0Resolved));
  17811. {$ENDIF}
  17812. exit(CheckRaiseTypeArgNo(20170216152301,1,Param0,Param0Resolved,
  17813. 'variable of set of enumtype',RaiseOnError));
  17814. end;
  17815. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17816. end;
  17817. procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
  17818. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17819. var
  17820. P: TPasExprArray;
  17821. begin
  17822. if Proc=nil then ;
  17823. P:=Params.Params;
  17824. if P=nil then ;
  17825. FinishCallArgAccess(P[0],rraVarParam);
  17826. FinishCallArgAccess(P[1],rraRead);
  17827. end;
  17828. function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17829. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17830. var
  17831. Params: TParamsExpr;
  17832. begin
  17833. if GetLoop(Expr)=nil then
  17834. RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
  17835. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17836. exit(cExact);
  17837. Params:=TParamsExpr(Expr);
  17838. {$IFDEF VerbosePasResolver}
  17839. writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
  17840. {$ENDIF}
  17841. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17842. end;
  17843. function TPasResolver.BI_Continue_OnGetCallCompatibility(
  17844. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17845. var
  17846. Params: TParamsExpr;
  17847. begin
  17848. if GetLoop(Expr)=nil then
  17849. RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
  17850. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17851. exit(cExact);
  17852. Params:=TParamsExpr(Expr);
  17853. {$IFDEF VerbosePasResolver}
  17854. writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
  17855. {$ENDIF}
  17856. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17857. end;
  17858. function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17859. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17860. var
  17861. Params: TParamsExpr;
  17862. Param: TPasExpr;
  17863. ParamResolved, ResultResolved: TPasResolverResult;
  17864. i: Integer;
  17865. ProcScope: TPasProcedureScope;
  17866. ResultEl: TPasResultElement;
  17867. Flags: TPasResolverComputeFlags;
  17868. CtxProc: TPasProcedure;
  17869. begin
  17870. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17871. exit(cExact);
  17872. Params:=TParamsExpr(Expr);
  17873. {$IFDEF VerbosePasResolver}
  17874. writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
  17875. {$ENDIF}
  17876. // first param: result
  17877. Param:=Params.Params[0];
  17878. Result:=cIncompatible;
  17879. i:=ScopeCount-1;
  17880. while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
  17881. if i>0 then
  17882. begin
  17883. // inside procedure: first param is function result
  17884. ProcScope:=TPasProcedureScope(Scopes[i]);
  17885. if ProcScope.DeclarationProc<>nil then
  17886. CtxProc:=ProcScope.DeclarationProc
  17887. else
  17888. CtxProc:=TPasProcedure(ProcScope.Element);
  17889. if not (CtxProc.ProcType is TPasFunctionType) then
  17890. begin
  17891. if RaiseOnError then
  17892. RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
  17893. sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
  17894. exit(cIncompatible);
  17895. end;
  17896. ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
  17897. ComputeResultElement(ResultEl,ResultResolved,[],Expr);
  17898. end
  17899. else
  17900. begin
  17901. // default: main program, param is an integer
  17902. SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],FBaseTypes[btLongint],
  17903. [rrfReadable,rrfWritable]);
  17904. end;
  17905. {$IFDEF VerbosePasResolver}
  17906. writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
  17907. {$ENDIF}
  17908. Flags:=[];
  17909. if IsProcedureType(ResultResolved,true) then
  17910. Include(Flags,rcNoImplicitProc);
  17911. ComputeElement(Param,ParamResolved,Flags);
  17912. {$IFDEF VerbosePasResolver}
  17913. writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
  17914. {$ENDIF}
  17915. if rrfReadable in ParamResolved.Flags then
  17916. Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
  17917. if Result=cIncompatible then
  17918. begin
  17919. if RaiseOnError then
  17920. RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
  17921. ['1'],ParamResolved,ResultResolved,Param);
  17922. exit;
  17923. end;
  17924. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17925. end;
  17926. function TPasResolver.BI_IncDec_OnGetCallCompatibility(
  17927. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17928. var
  17929. Params: TParamsExpr;
  17930. Param: TPasExpr;
  17931. ParamResolved, IncrResolved: TPasResolverResult;
  17932. TypeEl: TPasType;
  17933. bt: TResolverBaseType;
  17934. begin
  17935. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17936. exit(cIncompatible);
  17937. Params:=TParamsExpr(Expr);
  17938. // first param: var Integer
  17939. Param:=Params.Params[0];
  17940. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17941. {$IFDEF VerbosePasResolver}
  17942. writeln('TPasResolver.BI_IncDec_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  17943. {$ENDIF}
  17944. Result:=cIncompatible;
  17945. // Expr must be a variable
  17946. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17947. begin
  17948. if RaiseOnError then
  17949. RaiseVarExpected(20170216152319,Expr,ParamResolved.IdentEl);
  17950. exit;
  17951. end;
  17952. bt:=ParamResolved.BaseType;
  17953. if bt=btRange then
  17954. bt:=ParamResolved.SubType;
  17955. if bt in btAllInteger then
  17956. Result:=cExact
  17957. else if bt=btPointer then
  17958. begin
  17959. if ElHasBoolSwitch(Expr,bsPointerMath) then
  17960. Result:=cExact;
  17961. end
  17962. else if bt=btContext then
  17963. begin
  17964. TypeEl:=ParamResolved.LoTypeEl;
  17965. if (TypeEl.ClassType=TPasPointerType)
  17966. and ElHasBoolSwitch(Expr,bsPointerMath) then
  17967. Result:=cExact
  17968. else if TypeEl.ClassType=TPasRangeType then
  17969. Result:=cExact;
  17970. end;
  17971. if Result=cIncompatible then
  17972. exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
  17973. if length(Params.Params)=1 then
  17974. exit;
  17975. // second param: increment/decrement
  17976. Param:=Params.Params[1];
  17977. ComputeElement(Param,IncrResolved,[]);
  17978. Result:=cIncompatible;
  17979. if rrfReadable in IncrResolved.Flags then
  17980. begin
  17981. if IncrResolved.BaseType in btAllInteger then
  17982. Result:=cExact;
  17983. end;
  17984. if Result=cIncompatible then
  17985. exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
  17986. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17987. end;
  17988. procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
  17989. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17990. var
  17991. P: TPasExprArray;
  17992. begin
  17993. if Proc=nil then ;
  17994. P:=Params.Params;
  17995. FinishCallArgAccess(P[0],rraVarParam);
  17996. if Length(P)>1 then
  17997. FinishCallArgAccess(P[1],rraRead);
  17998. end;
  17999. function TPasResolver.BI_Assigned_OnGetCallCompatibility(
  18000. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18001. // check params of built in proc 'Assigned'
  18002. var
  18003. Params: TParamsExpr;
  18004. Param: TPasExpr;
  18005. ParamResolved: TPasResolverResult;
  18006. C: TClass;
  18007. begin
  18008. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18009. exit(cIncompatible);
  18010. Params:=TParamsExpr(Expr);
  18011. // first param: pointer, class, class instance, proc type or array
  18012. Param:=Params.Params[0];
  18013. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  18014. Result:=cIncompatible;
  18015. if ParamResolved.BaseType in [btNil,btPointer] then
  18016. Result:=cExact
  18017. else if (ParamResolved.BaseType=btContext) then
  18018. begin
  18019. C:=ParamResolved.LoTypeEl.ClassType;
  18020. if (C=TPasClassType)
  18021. or (C=TPasClassOfType)
  18022. or C.InheritsFrom(TPasProcedureType)
  18023. or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.LoTypeEl).Ranges)=0)) then
  18024. Result:=cExact;
  18025. end;
  18026. if Result=cIncompatible then
  18027. exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
  18028. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18029. end;
  18030. procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18031. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18032. begin
  18033. SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,
  18034. FBaseTypes[btBoolean],FBaseTypes[btBoolean],[rrfReadable]);
  18035. if Params=nil then ;
  18036. end;
  18037. procedure TPasResolver.BI_Assigned_OnFinishParamsExpr(
  18038. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18039. var
  18040. P: TPasExpr;
  18041. ResolvedEl: TPasResolverResult;
  18042. begin
  18043. if Proc=nil then ;
  18044. P:=Params.Params[0];
  18045. AccessExpr(P,rraRead);
  18046. ComputeElement(P,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
  18047. end;
  18048. function TPasResolver.BI_Chr_OnGetCallCompatibility(
  18049. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18050. var
  18051. Params: TParamsExpr;
  18052. Param: TPasExpr;
  18053. ParamResolved: TPasResolverResult;
  18054. begin
  18055. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18056. exit(cIncompatible);
  18057. Params:=TParamsExpr(Expr);
  18058. // first param: integer
  18059. Param:=Params.Params[0];
  18060. ComputeElement(Param,ParamResolved,[]);
  18061. Result:=cIncompatible;
  18062. if rrfReadable in ParamResolved.Flags then
  18063. begin
  18064. if ParamResolved.BaseType in btAllInteger then
  18065. Result:=cExact;
  18066. end;
  18067. if Result=cIncompatible then
  18068. exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
  18069. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18070. end;
  18071. procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18072. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18073. begin
  18074. SetResolverIdentifier(ResolvedEl,BaseTypeChar,Proc.Proc,
  18075. FBaseTypes[BaseTypeChar],FBaseTypes[BaseTypeChar],[rrfReadable]);
  18076. if Params=nil then ;
  18077. end;
  18078. procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  18079. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18080. var
  18081. Param: TPasExpr;
  18082. Value: TResEvalValue;
  18083. begin
  18084. Evaluated:=nil;
  18085. Param:=Params.Params[0];
  18086. Value:=Eval(Param,Flags);
  18087. {$IFDEF VerbosePasResEval}
  18088. {AllowWriteln}
  18089. if Value=nil then
  18090. writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
  18091. else
  18092. writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
  18093. {AllowWriteln-}
  18094. {$ENDIF}
  18095. if Value=nil then exit;
  18096. try
  18097. Evaluated:=fExprEvaluator.ChrValue(Value,Params);
  18098. finally
  18099. ReleaseEvalValue(Value);
  18100. end;
  18101. if Proc=nil then ;
  18102. end;
  18103. function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  18104. Expr: TPasExpr; RaiseOnError: boolean): integer;
  18105. var
  18106. Params: TParamsExpr;
  18107. Param: TPasExpr;
  18108. ParamResolved, ResolvedEl: TPasResolverResult;
  18109. TypeEl: TPasType;
  18110. begin
  18111. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18112. exit(cIncompatible);
  18113. Params:=TParamsExpr(Expr);
  18114. // first param: bool, integer, enum or char
  18115. Param:=Params.Params[0];
  18116. ComputeElement(Param,ParamResolved,[]);
  18117. Result:=cIncompatible;
  18118. if rrfReadable in ParamResolved.Flags then
  18119. begin
  18120. if ParamResolved.BaseType in btArrayRangeTypes then
  18121. Result:=cExact
  18122. else if (ParamResolved.BaseType=btContext) and (ParamResolved.LoTypeEl is TPasEnumType) then
  18123. Result:=cExact
  18124. else if ParamResolved.BaseType=btRange then
  18125. begin
  18126. if ParamResolved.SubType in btArrayRangeTypes then
  18127. Result:=cExact
  18128. else if ParamResolved.SubType=btContext then
  18129. begin
  18130. TypeEl:=ParamResolved.LoTypeEl;
  18131. if TypeEl.ClassType=TPasRangeType then
  18132. begin
  18133. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  18134. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  18135. exit(cExact);
  18136. end;
  18137. end;
  18138. end;
  18139. end;
  18140. if Result=cIncompatible then
  18141. exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
  18142. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18143. end;
  18144. procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18145. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18146. begin
  18147. SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,
  18148. FBaseTypes[btLongint],FBaseTypes[btLongint],[rrfReadable]);
  18149. if Params=nil then ;
  18150. end;
  18151. procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  18152. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18153. var
  18154. Param: TPasExpr;
  18155. Value: TResEvalValue;
  18156. begin
  18157. Evaluated:=nil;
  18158. Param:=Params.Params[0];
  18159. Value:=Eval(Param,Flags);
  18160. {$IFDEF VerbosePasResEval}
  18161. {AllowWriteln}
  18162. if Value=nil then
  18163. writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
  18164. else
  18165. writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
  18166. {AllowWriteln-}
  18167. {$ENDIF}
  18168. if Value=nil then exit;
  18169. try
  18170. Evaluated:=fExprEvaluator.OrdValue(Value,Params);
  18171. finally
  18172. ReleaseEvalValue(Value);
  18173. end;
  18174. if Proc=nil then ;
  18175. end;
  18176. function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
  18177. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18178. // check params of built in proc 'Low' or 'High'
  18179. var
  18180. Params: TParamsExpr;
  18181. Param: TPasExpr;
  18182. ParamResolved: TPasResolverResult;
  18183. C: TClass;
  18184. begin
  18185. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18186. exit(cIncompatible);
  18187. Params:=TParamsExpr(Expr);
  18188. // first param: enumtype, range, built-in ordinal type (char, longint, ...)
  18189. Param:=Params.Params[0];
  18190. ComputeElement(Param,ParamResolved,[]);
  18191. Result:=cIncompatible;
  18192. if ParamResolved.BaseType in btAllRanges then
  18193. // e.g. high(char)
  18194. Result:=cExact
  18195. else if ParamResolved.BaseType=btSet then
  18196. Result:=cExact
  18197. else if (ParamResolved.BaseType=btContext) then
  18198. begin
  18199. C:=ParamResolved.LoTypeEl.ClassType;
  18200. if (C=TPasArrayType)
  18201. or (C=TPasSetType)
  18202. or (C=TPasEnumType) then
  18203. Result:=cExact;
  18204. end;
  18205. if Result=cIncompatible then
  18206. begin
  18207. {$IFDEF VerbosePasResolver}
  18208. writeln('TPasResolver.BI_LowHigh_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  18209. {$ENDIF}
  18210. exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
  18211. end;
  18212. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18213. end;
  18214. procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18215. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18216. var
  18217. ArrayEl: TPasArrayType;
  18218. Param: TPasExpr;
  18219. TypeEl: TPasType;
  18220. begin
  18221. Param:=Params.Params[0];
  18222. ComputeElement(Param,ResolvedEl,[]);
  18223. if ResolvedEl.BaseType=btContext then
  18224. begin
  18225. TypeEl:=ResolvedEl.LoTypeEl;
  18226. if TypeEl.ClassType=TPasArrayType then
  18227. begin
  18228. // array: result type is type of first dimension
  18229. ArrayEl:=TPasArrayType(TypeEl);
  18230. if length(ArrayEl.Ranges)=0 then
  18231. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  18232. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable])
  18233. else
  18234. begin
  18235. ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
  18236. if ResolvedEl.BaseType=btRange then
  18237. ConvertRangeToElement(ResolvedEl);
  18238. end;
  18239. end
  18240. else if TypeEl.ClassType=TPasSetType then
  18241. begin
  18242. ResolvedEl.LoTypeEl:=TPasSetType(TypeEl).EnumType;
  18243. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  18244. end;
  18245. end
  18246. else if ResolvedEl.BaseType=btSet then
  18247. begin
  18248. ResolvedEl.BaseType:=ResolvedEl.SubType;
  18249. ResolvedEl.SubType:=btNone;
  18250. end
  18251. else
  18252. ;// ordinal: result type is argument type
  18253. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
  18254. end;
  18255. procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  18256. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18257. function IsDynArrayConstExpr(IdentEl: TPasElement): boolean;
  18258. begin
  18259. Result:=false;
  18260. if not (IdentEl is TPasVariable) then exit;
  18261. if not (TPasVariable(IdentEl).Expr is TPasExpr) then exit;
  18262. if (IdentEl.ClassType=TPasConst) and TPasConst(IdentEl).IsConst then
  18263. exit(true);
  18264. if fExprEvaluator.IsConst(Params) then
  18265. exit(true); // a const refers an initial value
  18266. end;
  18267. var
  18268. Param: TPasExpr;
  18269. ParamResolved: TPasResolverResult;
  18270. var
  18271. TypeEl: TPasType;
  18272. ArrayEl: TPasArrayType;
  18273. Value: TResEvalValue;
  18274. EnumType: TPasEnumType;
  18275. aSet: TResEvalSet;
  18276. bt: TResolverBaseType;
  18277. Int, MinInt, MaxInt: TMaxPrecInt;
  18278. i: Integer;
  18279. Expr: TPasExpr;
  18280. begin
  18281. Evaluated:=nil;
  18282. Param:=Params.Params[0];
  18283. ComputeElement(Param,ParamResolved,[]);
  18284. TypeEl:=ParamResolved.LoTypeEl;
  18285. if ParamResolved.BaseType=btContext then
  18286. begin
  18287. if TypeEl.ClassType=TPasArrayType then
  18288. begin
  18289. // array: low/high of first dimension
  18290. ArrayEl:=TPasArrayType(TypeEl);
  18291. if length(ArrayEl.Ranges)=0 then
  18292. begin
  18293. // dyn or open array
  18294. if Proc.BuiltIn=bfLow then
  18295. Evaluated:=TResEvalInt.CreateValue(0)
  18296. else if IsDynArrayConstExpr(ParamResolved.IdentEl) then
  18297. begin
  18298. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  18299. if Expr is TArrayValues then
  18300. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
  18301. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  18302. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
  18303. if Evaluated=nil then
  18304. RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
  18305. end
  18306. else
  18307. exit;
  18308. end
  18309. else
  18310. begin
  18311. // static array
  18312. Evaluated:=EvalRangeLimit(ArrayEl.Ranges[0],Flags,Proc.BuiltIn=bfLow,Param);
  18313. end;
  18314. end
  18315. else if TypeEl.ClassType=TPasSetType then
  18316. begin
  18317. // set: first/last enum
  18318. TypeEl:=TPasSetType(TypeEl).EnumType;
  18319. if TypeEl.ClassType=TPasEnumType then
  18320. begin
  18321. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  18322. if Proc.BuiltIn=bfLow then
  18323. Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
  18324. else
  18325. Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
  18326. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  18327. end
  18328. else
  18329. begin
  18330. {$IFDEF VerbosePasResolver}
  18331. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  18332. {$ENDIF}
  18333. RaiseNotYetImplemented(20170601203026,Params);
  18334. end;
  18335. end
  18336. else if TypeEl.ClassType=TPasEnumType then
  18337. begin
  18338. EnumType:=TPasEnumType(TypeEl);
  18339. if Proc.BuiltIn=bfLow then
  18340. i:=0
  18341. else
  18342. i:=EnumType.Values.Count-1;
  18343. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  18344. end;
  18345. end
  18346. else if ParamResolved.BaseType=btSet then
  18347. begin
  18348. Value:=Eval(Param,Flags);
  18349. if Value=nil then exit;
  18350. case Value.Kind of
  18351. revkSetOfInt:
  18352. begin
  18353. aSet:=TResEvalSet(Value);
  18354. if length(aSet.Ranges)=0 then
  18355. RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
  18356. if Proc.BuiltIn=bfLow then
  18357. Int:=aSet.RangeStart
  18358. else
  18359. Int:=aSet.RangeEnd;
  18360. case aSet.ElKind of
  18361. revskEnum:
  18362. begin
  18363. EnumType:=aSet.IdentEl as TPasEnumType;
  18364. Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
  18365. end;
  18366. revskInt:
  18367. Evaluated:=TResEvalInt.CreateValue(Int);
  18368. revskChar:
  18369. {$ifdef FPC_HAS_CPSTRING}
  18370. if Int<256 then
  18371. Evaluated:=TResEvalString.CreateValue(chr(Int))
  18372. else
  18373. {$endif}
  18374. Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
  18375. revskBool:
  18376. if Int=0 then
  18377. Evaluated:=TResEvalBool.CreateValue(false)
  18378. else
  18379. Evaluated:=TResEvalBool.CreateValue(true)
  18380. end;
  18381. end;
  18382. else
  18383. RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
  18384. end;
  18385. end
  18386. else if (TypeEl is TPasUnresolvedSymbolRef)
  18387. and (TypeEl.CustomData is TResElDataBaseType) then
  18388. begin
  18389. // low,high(base type)
  18390. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  18391. bt:=GetActualBaseType(bt);
  18392. if bt in btAllBooleans then
  18393. Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
  18394. {$ifdef HasInt64}
  18395. else if bt=btQWord then
  18396. begin
  18397. if Proc.BuiltIn=bfLow then
  18398. Evaluated:=TResEvalInt.CreateValue(0)
  18399. else
  18400. Evaluated:=TResEvalUInt.CreateValue(High(QWord));
  18401. end
  18402. {$endif}
  18403. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  18404. begin
  18405. if Proc.BuiltIn=bfLow then
  18406. Evaluated:=TResEvalInt.CreateValue(MinInt)
  18407. else
  18408. Evaluated:=TResEvalInt.CreateValue(MaxInt);
  18409. end
  18410. {$ifdef FPC_HAS_CPSTRING}
  18411. else if bt=btAnsiChar then
  18412. begin
  18413. if Proc.BuiltIn=bfLow then
  18414. Evaluated:=TResEvalString.CreateValue(#0)
  18415. else
  18416. Evaluated:=TResEvalString.CreateValue(#255);
  18417. end
  18418. {$endif}
  18419. else if bt=btWideChar then
  18420. begin
  18421. if Proc.BuiltIn=bfLow then
  18422. Evaluated:=TResEvalUTF16.CreateValue(#0)
  18423. else
  18424. Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
  18425. end
  18426. else
  18427. begin
  18428. {$IFDEF VerbosePasResolver}
  18429. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  18430. {$ENDIF}
  18431. RaiseNotYetImplemented(20170602070738,Params);
  18432. end;
  18433. end
  18434. else if ParamResolved.LoTypeEl is TPasRangeType then
  18435. begin
  18436. // e.g. type t = 2..10;
  18437. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
  18438. end
  18439. else
  18440. begin
  18441. {$IFDEF VerbosePasResolver}
  18442. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  18443. {$ENDIF}
  18444. RaiseNotYetImplemented(20170601202353,Params);
  18445. end;
  18446. {$IFDEF VerbosePasResEval}
  18447. {AllowWriteln}
  18448. if Evaluated=nil then
  18449. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
  18450. else
  18451. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
  18452. {AllowWriteln-}
  18453. {$ENDIF}
  18454. end;
  18455. function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
  18456. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18457. // check params of built in proc 'Pred' or 'Succ'
  18458. var
  18459. Params: TParamsExpr;
  18460. Param: TPasExpr;
  18461. ParamResolved: TPasResolverResult;
  18462. begin
  18463. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18464. exit(cIncompatible);
  18465. Params:=TParamsExpr(Expr);
  18466. // first param: enum, range, set, char or integer
  18467. Param:=Params.Params[0];
  18468. ComputeElement(Param,ParamResolved,[]);
  18469. Result:=cIncompatible;
  18470. if CheckIsOrdinal(ParamResolved,Param,false) then
  18471. Result:=cExact;
  18472. if Result=cIncompatible then
  18473. exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
  18474. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18475. end;
  18476. procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18477. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18478. begin
  18479. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18480. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18481. if Proc=nil then ;
  18482. end;
  18483. procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  18484. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18485. var
  18486. Param: TPasExpr;
  18487. begin
  18488. //writeln('TPasResolver.BI_PredSucc_OnEval START');
  18489. Evaluated:=nil;
  18490. Param:=Params.Params[0];
  18491. Evaluated:=Eval(Param,Flags);
  18492. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
  18493. if Evaluated=nil then exit;
  18494. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
  18495. if Evaluated.Element<>nil then
  18496. Evaluated:=Evaluated.Clone;
  18497. if Proc.BuiltIn=bfPred then
  18498. fExprEvaluator.PredValue(Evaluated,Params)
  18499. else
  18500. fExprEvaluator.SuccValue(Evaluated,Params);
  18501. end;
  18502. function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  18503. const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
  18504. ): integer;
  18505. function CheckFormat(FormatExpr: TPasExpr; Index: integer;
  18506. const ParamResolved: TPasResolverResult): boolean;
  18507. var
  18508. ResolvedEl: TPasResolverResult;
  18509. Ok: Boolean;
  18510. begin
  18511. if FormatExpr=nil then exit(true);
  18512. Result:=false;
  18513. Ok:=false;
  18514. if ParamResolved.BaseType in btAllFloats then
  18515. // floats supports value:Width:Precision
  18516. Ok:=true
  18517. else
  18518. // all other only support value:Width
  18519. Ok:=Index<2;
  18520. if not Ok then
  18521. begin
  18522. if RaiseOnError then
  18523. RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
  18524. exit;
  18525. end;
  18526. ComputeElement(FormatExpr,ResolvedEl,[]);
  18527. if not (ResolvedEl.BaseType in btAllInteger) then
  18528. begin
  18529. if RaiseOnError then
  18530. RaiseXExpectedButYFound(20170319221515,
  18531. 'integer',GetResolverResultDescription(ResolvedEl,true),FormatExpr);
  18532. exit;
  18533. end;
  18534. if not (rrfReadable in ResolvedEl.Flags) then
  18535. begin
  18536. if RaiseOnError then
  18537. RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
  18538. exit;
  18539. end;
  18540. Result:=true;
  18541. end;
  18542. var
  18543. bt: TResolverBaseType;
  18544. C: TClass;
  18545. begin
  18546. Result:=cIncompatible;
  18547. bt:=ParamResolved.BaseType;
  18548. if bt=btRange then
  18549. bt:=ParamResolved.SubType;
  18550. if bt in (btAllInteger+btAllBooleans+btAllFloats) then
  18551. Result:=cExact
  18552. else if IsFunc and (bt in btAllStringAndChars) then
  18553. Result:=cExact
  18554. else if bt=btContext then
  18555. begin
  18556. C:=ParamResolved.LoTypeEl.ClassType;
  18557. if (C=TPasEnumType) or (C=TPasRangeType) then
  18558. Result:=cExact
  18559. end;
  18560. if Result=cIncompatible then
  18561. exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
  18562. if not CheckFormat(Param.format1,1,ParamResolved) then
  18563. exit(cIncompatible);
  18564. if not CheckFormat(Param.format2,2,ParamResolved) then
  18565. exit(cIncompatible);
  18566. end;
  18567. function TPasResolver.BI_StrProc_OnGetCallCompatibility(
  18568. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18569. // check params of built-in procedure 'Str'
  18570. var
  18571. Params: TParamsExpr;
  18572. Param: TPasExpr;
  18573. ParamResolved: TPasResolverResult;
  18574. begin
  18575. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  18576. exit(cIncompatible);
  18577. Params:=TParamsExpr(Expr);
  18578. if ParentNeedsExprResult(Params) then
  18579. begin
  18580. if RaiseOnError then
  18581. RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
  18582. sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
  18583. exit(cIncompatible);
  18584. end;
  18585. // first param: boolean, integer, enum, class instance
  18586. Param:=Params.Params[0];
  18587. ComputeElement(Param,ParamResolved,[]);
  18588. Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
  18589. if Result=cIncompatible then
  18590. exit;
  18591. // second parameter: string variable
  18592. Param:=Params.Params[1];
  18593. ComputeElement(Param,ParamResolved,[]);
  18594. Result:=cIncompatible;
  18595. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18596. begin
  18597. if ParamResolved.BaseType in btAllStrings then
  18598. Result:=cExact;
  18599. end;
  18600. if Result=cIncompatible then
  18601. exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
  18602. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  18603. end;
  18604. procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  18605. Params: TParamsExpr);
  18606. var
  18607. P: TPasExprArray;
  18608. begin
  18609. if Proc=nil then ;
  18610. P:=Params.Params;
  18611. if P=nil then ;
  18612. FinishCallArgAccess(P[0],rraRead);
  18613. FinishCallArgAccess(P[1],rraVarParam);
  18614. end;
  18615. function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
  18616. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18617. var
  18618. Params: TParamsExpr;
  18619. Param: TPasExpr;
  18620. ParamResolved: TPasResolverResult;
  18621. i: Integer;
  18622. begin
  18623. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18624. exit(cIncompatible);
  18625. Params:=TParamsExpr(Expr);
  18626. if not ParentNeedsExprResult(Params) then
  18627. begin
  18628. // not in an expression -> the 'procedure str' is needed, not the 'function str'
  18629. if RaiseOnError then
  18630. RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
  18631. sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
  18632. exit(cIncompatible);
  18633. end;
  18634. // param: string, boolean, integer, enum, class instance
  18635. for i:=0 to length(Params.Params)-1 do
  18636. begin
  18637. Param:=Params.Params[i];
  18638. ComputeElement(Param,ParamResolved,[]);
  18639. Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
  18640. if Result=cIncompatible then
  18641. exit;
  18642. end;
  18643. Result:=cExact;
  18644. end;
  18645. procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18646. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18647. begin
  18648. SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,
  18649. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable]);
  18650. if Params=nil then ;
  18651. if Proc=nil then ;
  18652. end;
  18653. procedure TPasResolver.BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  18654. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18655. begin
  18656. Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
  18657. if Proc=nil then ;
  18658. end;
  18659. function TPasResolver.BI_WriteStrProc_OnGetCallCompatibility(
  18660. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18661. // check params of built-in procedure 'Str'
  18662. var
  18663. Params: TParamsExpr;
  18664. Param: TPasExpr;
  18665. ParamResolved: TPasResolverResult;
  18666. i: Integer;
  18667. begin
  18668. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  18669. exit(cIncompatible);
  18670. Params:=TParamsExpr(Expr);
  18671. // first parameter: string variable
  18672. Param:=Params.Params[0];
  18673. ComputeElement(Param,ParamResolved,[]);
  18674. Result:=cIncompatible;
  18675. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18676. begin
  18677. if ParamResolved.BaseType in btAllStrings then
  18678. Result:=cExact;
  18679. end;
  18680. if Result=cIncompatible then
  18681. exit(CheckRaiseTypeArgNo(20180527190304,1,Param,ParamResolved,'string variable',RaiseOnError));
  18682. // other parameters: boolean, integer, enum, class instance
  18683. for i:=1 to length(Params.Params)-1 do
  18684. begin
  18685. Param:=Params.Params[i];
  18686. ComputeElement(Param,ParamResolved,[]);
  18687. Result:=BI_Str_CheckParam(false,Param,ParamResolved,i,RaiseOnError);
  18688. if Result=cIncompatible then
  18689. exit;
  18690. end;
  18691. end;
  18692. procedure TPasResolver.BI_WriteStrProc_OnFinishParamsExpr(
  18693. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18694. var
  18695. P: TPasExprArray;
  18696. i: Integer;
  18697. begin
  18698. if Proc=nil then ;
  18699. P:=Params.Params;
  18700. if P=nil then ;
  18701. FinishCallArgAccess(P[0],rraOutParam);
  18702. for i:=0 to length(Params.Params)-1 do
  18703. FinishCallArgAccess(P[i],rraRead);
  18704. end;
  18705. function TPasResolver.BI_Val_OnGetCallCompatibility(
  18706. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18707. // check params of built-in procedure 'Val(const s: string; out v: valtype; out code: integer)'
  18708. var
  18709. Params: TParamsExpr;
  18710. Param: TPasExpr;
  18711. ParamResolved: TPasResolverResult;
  18712. bt: TResolverBaseType;
  18713. C: TClass;
  18714. begin
  18715. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18716. exit(cIncompatible);
  18717. Params:=TParamsExpr(Expr);
  18718. // first parameter: string
  18719. Param:=Params.Params[0];
  18720. ComputeElement(Param,ParamResolved,[]);
  18721. Result:=cIncompatible;
  18722. if ParamResolved.BaseType in btAllStrings then
  18723. Result:=cExact;
  18724. if Result=cIncompatible then
  18725. exit(CheckRaiseTypeArgNo(20181214141250,1,Param,ParamResolved,'string',RaiseOnError));
  18726. // second parameter: var value
  18727. Param:=Params.Params[1];
  18728. ComputeElement(Param,ParamResolved,[]);
  18729. Result:=cIncompatible;
  18730. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18731. begin
  18732. bt:=ParamResolved.BaseType;
  18733. if bt=btRange then
  18734. bt:=ParamResolved.SubType;
  18735. if bt in (btAllInteger+btAllBooleans+btAllFloats) then
  18736. Result:=cExact
  18737. else if bt=btContext then
  18738. begin
  18739. C:=ParamResolved.LoTypeEl.ClassType;
  18740. if (C=TPasEnumType) or (C=TPasRangeType) then
  18741. Result:=cExact;
  18742. end;
  18743. end;
  18744. if Result=cIncompatible then
  18745. exit(CheckRaiseTypeArgNo(20181214141704,2,Param,ParamResolved,
  18746. 'boolean/integer/float/enum variable',RaiseOnError));
  18747. // third parameter: out Code: integer
  18748. Param:=Params.Params[2];
  18749. ComputeElement(Param,ParamResolved,[]);
  18750. Result:=cIncompatible;
  18751. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18752. begin
  18753. if ParamResolved.BaseType in btAllInteger then
  18754. Result:=cExact;
  18755. end;
  18756. if Result=cIncompatible then
  18757. exit(CheckRaiseTypeArgNo(20181214141511,3,Param,ParamResolved,'integer variable',RaiseOnError));
  18758. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18759. end;
  18760. procedure TPasResolver.BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  18761. Params: TParamsExpr);
  18762. var
  18763. P: TPasExprArray;
  18764. begin
  18765. if Proc=nil then ;
  18766. P:=Params.Params;
  18767. if P=nil then ;
  18768. FinishCallArgAccess(P[0],rraRead);
  18769. FinishCallArgAccess(P[1],rraOutParam);
  18770. FinishCallArgAccess(P[2],rraOutParam);
  18771. end;
  18772. function TPasResolver.BI_LoHi_OnGetCallCompatibility(
  18773. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18774. var
  18775. Params: TParamsExpr;
  18776. Param: TPasExpr;
  18777. ParamResolved: TPasResolverResult;
  18778. begin
  18779. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18780. Exit(cIncompatible);
  18781. Params:=TParamsExpr(Expr);
  18782. // first Param: any integer type
  18783. Param:=Params.params[0];
  18784. ComputeElement(Param,ParamResolved,[]);
  18785. Result:=cIncompatible;
  18786. if (rrfReadable in ParamResolved.Flags)
  18787. and (ParamResolved.BaseType in btAllInteger)
  18788. then
  18789. Result:=cExact;
  18790. if Result=cIncompatible then
  18791. Exit(CheckRaiseTypeArgNo(20190128232600,1,Param,ParamResolved,'integer type',RaiseOnError));
  18792. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18793. end;
  18794. procedure TPasResolver.BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18795. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18796. var
  18797. ResolvedParam: TPasResolverResult;
  18798. BaseType: TResolverBaseType;
  18799. Mask: LongWord;
  18800. begin
  18801. ComputeElement(Params.Params[0],ResolvedParam,[]);
  18802. GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18803. case Mask of
  18804. $F, $FF: BaseType := btByte;
  18805. $FFFF: BaseType := btWord;
  18806. else { $FFFFFFFF } BaseType := btLongWord;
  18807. end;
  18808. SetResolverIdentifier(ResolvedEl,BaseType,Proc.Proc,
  18809. FBaseTypes[BaseType],FBaseTypes[BaseType],[rrfReadable]);
  18810. end;
  18811. procedure TPasResolver.BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  18812. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18813. var
  18814. Param: TPasExpr;
  18815. ResolvedParam: TPasResolverResult;
  18816. Value: TResEvalValue;
  18817. Shift: Integer;
  18818. Mask: LongWord;
  18819. begin
  18820. Evaluated := nil;
  18821. Param := Params.Params[0];
  18822. Value := Eval(Param,Flags);
  18823. {$IFDEF VerbosePasResEval}
  18824. {AllowWriteln}
  18825. if value=nil then
  18826. writeln('TPasResolver.BI_LoHi_OnEval Value=NIL')
  18827. else
  18828. writeln('TPasResolver.BI_LoHi_OnEval Value=',value.AsDebugString);
  18829. {AllowWriteln-}
  18830. {$ENDIF}
  18831. if Value=nil then exit;
  18832. try
  18833. ComputeElement(Param,ResolvedParam,[]);
  18834. Shift := GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18835. Evaluated := fExprEvaluator.LoHiValue(Value,Shift,Mask,Params);
  18836. finally
  18837. ReleaseEvalValue(Value);
  18838. end;
  18839. end;
  18840. function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
  18841. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18842. var
  18843. Params: TParamsExpr;
  18844. Param: TPasExpr;
  18845. ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
  18846. i: Integer;
  18847. ArrType: TPasArrayType;
  18848. ElType: TPasType;
  18849. begin
  18850. Result:=cIncompatible;
  18851. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18852. exit;
  18853. Params:=TParamsExpr(Expr);
  18854. FirstElTypeResolved:=Default(TPasResolverResult);
  18855. for i:=0 to length(Params.Params)-1 do
  18856. begin
  18857. // all params: array
  18858. Param:=Params.Params[i];
  18859. ComputeElement(Param,ParamResolved,[]);
  18860. ElTypeResolved:=default(TPasResolverResult);
  18861. if rrfReadable in ParamResolved.Flags then
  18862. begin
  18863. if ParamResolved.BaseType=btContext then
  18864. begin
  18865. if IsDynArray(ParamResolved.LoTypeEl) then
  18866. begin
  18867. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  18868. ElType:=GetArrayElType(ArrType);
  18869. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18870. end;
  18871. end
  18872. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  18873. SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
  18874. ParamResolved.LoTypeEl,ParamResolved.HiTypeEl,Param,ParamResolved.Flags);
  18875. end;
  18876. if ElTypeResolved.BaseType=btNone then
  18877. exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18878. Include(ElTypeResolved.Flags,rrfReadable);
  18879. if i=0 then
  18880. begin
  18881. FirstElTypeResolved:=ElTypeResolved;
  18882. Include(FirstElTypeResolved.Flags,rrfWritable);
  18883. end
  18884. else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
  18885. exit(cIncompatible);
  18886. end;
  18887. Result:=cExact;
  18888. end;
  18889. procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
  18890. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18891. ResolvedEl: TPasResolverResult);
  18892. begin
  18893. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18894. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18895. ResolvedEl.ExprEl:=Params;
  18896. ResolvedEl.IdentEl:=nil;
  18897. if ResolvedEl.BaseType=btArrayOrSet then
  18898. ResolvedEl.BaseType:=btArrayLit;
  18899. if Proc=nil then ;
  18900. end;
  18901. function TPasResolver.BI_ConcatString_OnGetCallCompatibility(
  18902. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18903. var
  18904. Params: TParamsExpr;
  18905. i: Integer;
  18906. Param: TPasExpr;
  18907. ParamResolved: TPasResolverResult;
  18908. begin
  18909. Result:=cIncompatible;
  18910. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18911. exit;
  18912. Params:=TParamsExpr(Expr);
  18913. for i:=0 to length(Params.Params)-1 do
  18914. begin
  18915. // all params: char or string
  18916. Param:=Params.Params[i];
  18917. ComputeElement(Param,ParamResolved,[]);
  18918. if not (rrfReadable in ParamResolved.Flags)
  18919. or not (ParamResolved.BaseType in btAllStringAndChars) then
  18920. exit(CheckRaiseTypeArgNo(20181219230329,i+1,Param,ParamResolved,'string',RaiseOnError));
  18921. end;
  18922. Result:=cExact;
  18923. end;
  18924. procedure TPasResolver.BI_ConcatString_OnGetCallResult(
  18925. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18926. ResolvedEl: TPasResolverResult);
  18927. var
  18928. i: Integer;
  18929. Param: TPasExpr;
  18930. ParamResolved, CombinedResolved: TPasResolverResult;
  18931. ParamsArr: TPasExprArray;
  18932. begin
  18933. if Proc=nil then ;
  18934. ParamsArr:=Params.Params;
  18935. for i:=0 to length(ParamsArr)-1 do
  18936. begin
  18937. // all params: char or string
  18938. Param:=ParamsArr[i];
  18939. ComputeElement(Param,ParamResolved,[]);
  18940. if i=0 then
  18941. ResolvedEl:=ParamResolved
  18942. else
  18943. begin
  18944. ComputeAddStringRes(ResolvedEl,ParamResolved,Params,CombinedResolved);
  18945. ResolvedEl:=CombinedResolved;
  18946. end;
  18947. end;
  18948. end;
  18949. procedure TPasResolver.BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  18950. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18951. var
  18952. i: Integer;
  18953. Param: TPasExpr;
  18954. Value, NewValue: TResEvalValue;
  18955. ok: Boolean;
  18956. begin
  18957. if Proc=nil then ;
  18958. Value:=nil;
  18959. Evaluated:=nil;
  18960. ok:=false;
  18961. try
  18962. for i:=0 to length(Params.Params)-1 do
  18963. begin
  18964. // all params: char or string
  18965. Param:=Params.Params[i];
  18966. Value:=Eval(Param,Flags);
  18967. if Value=nil then
  18968. exit;
  18969. if i=0 then
  18970. begin
  18971. Evaluated:=Value;
  18972. Value:=nil;
  18973. end
  18974. else
  18975. begin
  18976. NewValue:=ExprEvaluator.EvalStringAddExpr(Param,Params.Params[i-1],Param,
  18977. Evaluated,Value);
  18978. ReleaseEvalValue(Evaluated);
  18979. Evaluated:=NewValue;
  18980. ReleaseEvalValue(Value);
  18981. end;
  18982. end;
  18983. ok:=true;
  18984. finally
  18985. ReleaseEvalValue(Value);
  18986. if not ok then
  18987. ReleaseEvalValue(Evaluated);
  18988. end;
  18989. end;
  18990. function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
  18991. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18992. var
  18993. Params: TParamsExpr;
  18994. Param: TPasExpr;
  18995. ParamResolved: TPasResolverResult;
  18996. begin
  18997. Result:=cIncompatible;
  18998. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18999. exit;
  19000. Params:=TParamsExpr(Expr);
  19001. // first param: array
  19002. Param:=Params.Params[0];
  19003. ComputeElement(Param,ParamResolved,[]);
  19004. if rrfReadable in ParamResolved.Flags then
  19005. begin
  19006. if ParamResolved.BaseType=btContext then
  19007. begin
  19008. if IsDynArray(ParamResolved.LoTypeEl) then
  19009. Result:=cExact;
  19010. end
  19011. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  19012. Result:=cExact;
  19013. end;
  19014. if Result=cIncompatible then
  19015. exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  19016. if length(Params.Params)=1 then
  19017. exit(cExact);
  19018. // check optional Start index
  19019. Param:=Params.Params[1];
  19020. ComputeElement(Param,ParamResolved,[]);
  19021. if not (rrfReadable in ParamResolved.Flags)
  19022. or not (ParamResolved.BaseType in btAllInteger) then
  19023. exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
  19024. if length(Params.Params)=2 then
  19025. exit(cExact);
  19026. // check optional Count
  19027. Param:=Params.Params[2];
  19028. ComputeElement(Param,ParamResolved,[]);
  19029. if not (rrfReadable in ParamResolved.Flags)
  19030. or not (ParamResolved.BaseType in btAllInteger) then
  19031. exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
  19032. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  19033. end;
  19034. procedure TPasResolver.BI_CopyArray_OnGetCallResult(
  19035. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  19036. ResolvedEl: TPasResolverResult);
  19037. begin
  19038. if Proc=nil then ;
  19039. ComputeElement(Params.Params[0],ResolvedEl,[]);
  19040. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  19041. ResolvedEl.ExprEl:=Params;
  19042. ResolvedEl.IdentEl:=nil;
  19043. if ResolvedEl.BaseType=btArrayOrSet then
  19044. ResolvedEl.BaseType:=btArrayLit;
  19045. end;
  19046. function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
  19047. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19048. // Insert(Item,var Array,Index)
  19049. var
  19050. Params: TParamsExpr;
  19051. Param, ItemParam: TPasExpr;
  19052. ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
  19053. ArrType: TPasArrayType;
  19054. ElType: TPasType;
  19055. begin
  19056. Result:=cIncompatible;
  19057. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  19058. exit;
  19059. Params:=TParamsExpr(Expr);
  19060. // check Item
  19061. ItemParam:=Params.Params[0];
  19062. ComputeElement(ItemParam,ItemResolved,[]);
  19063. if not (rrfReadable in ItemResolved.Flags) then
  19064. exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
  19065. // check Array
  19066. Param:=Params.Params[1];
  19067. ComputeElement(Param,ParamResolved,[]);
  19068. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  19069. begin
  19070. if RaiseOnError then
  19071. RaiseVarExpected(20170329171514,Param,ParamResolved.IdentEl);
  19072. exit;
  19073. end;
  19074. if (ParamResolved.BaseType<>btContext)
  19075. or not IsDynArray(ParamResolved.LoTypeEl) then
  19076. exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
  19077. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  19078. ElType:=GetArrayElType(ArrType);
  19079. ComputeElement(ElType,ElTypeResolved,[rcType]);
  19080. if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
  19081. exit(cIncompatible);
  19082. // check insert Index
  19083. Param:=Params.Params[2];
  19084. ComputeElement(Param,ParamResolved,[]);
  19085. if not (rrfReadable in ParamResolved.Flags)
  19086. or not (ParamResolved.BaseType in btAllInteger) then
  19087. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  19088. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  19089. end;
  19090. procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
  19091. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19092. var
  19093. P: TPasExprArray;
  19094. Param0, Param1: TPasExpr;
  19095. ArrayResolved, ElTypeResolved: TPasResolverResult;
  19096. ElType: TPasType;
  19097. begin
  19098. if Proc=nil then ;
  19099. P:=Params.Params;
  19100. Param0:=P[0];
  19101. Param1:=P[1];
  19102. FinishCallArgAccess(Param0,rraRead);
  19103. FinishCallArgAccess(Param1,rraVarParam);
  19104. FinishCallArgAccess(P[2],rraRead);
  19105. if not (Param0 is TPrimitiveExpr) then
  19106. begin
  19107. // insert complex expression, e.g. insert([1],Arr,index)
  19108. // -> mark array and set literals
  19109. ComputeElement(Param1,ArrayResolved,[]);
  19110. if (ArrayResolved.BaseType<>btContext)
  19111. or not IsDynArray(ArrayResolved.LoTypeEl) then
  19112. RaiseNotYetImplemented(20180622144039,Param1);
  19113. ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
  19114. ComputeElement(ElType,ElTypeResolved,[rcType]);
  19115. if (ElTypeResolved.BaseType=btContext)
  19116. and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
  19117. MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
  19118. end;
  19119. end;
  19120. function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
  19121. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19122. // DeleteScope(var Array; Start, Count: integer)
  19123. var
  19124. Params: TParamsExpr;
  19125. Param: TPasExpr;
  19126. ParamResolved: TPasResolverResult;
  19127. begin
  19128. Result:=cIncompatible;
  19129. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  19130. exit;
  19131. Params:=TParamsExpr(Expr);
  19132. // check Array
  19133. Param:=Params.Params[0];
  19134. ComputeElement(Param,ParamResolved,[]);
  19135. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  19136. begin
  19137. if RaiseOnError then
  19138. RaiseVarExpected(20170329173421,Param,ParamResolved.IdentEl);
  19139. exit;
  19140. end;
  19141. if (ParamResolved.BaseType<>btContext)
  19142. or not IsDynArray(ParamResolved.LoTypeEl) then
  19143. exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  19144. // check param Start
  19145. Param:=Params.Params[1];
  19146. ComputeElement(Param,ParamResolved,[]);
  19147. if not (rrfReadable in ParamResolved.Flags)
  19148. or not (ParamResolved.BaseType in btAllInteger) then
  19149. exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
  19150. // check param Count
  19151. Param:=Params.Params[2];
  19152. ComputeElement(Param,ParamResolved,[]);
  19153. if not (rrfReadable in ParamResolved.Flags)
  19154. or not (ParamResolved.BaseType in btAllInteger) then
  19155. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  19156. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  19157. end;
  19158. procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
  19159. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19160. var
  19161. P: TPasExprArray;
  19162. begin
  19163. if Proc=nil then ;
  19164. P:=Params.Params;
  19165. if P=nil then ;
  19166. FinishCallArgAccess(P[0],rraVarParam);
  19167. FinishCallArgAccess(P[1],rraRead);
  19168. FinishCallArgAccess(P[2],rraRead);
  19169. end;
  19170. function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
  19171. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19172. var
  19173. Params: TParamsExpr;
  19174. Param: TPasExpr;
  19175. aType: TPasType;
  19176. ParamResolved: TPasResolverResult;
  19177. begin
  19178. Result:=cIncompatible;
  19179. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19180. exit;
  19181. Params:=TParamsExpr(Expr);
  19182. Param:=Params.Params[0];
  19183. aType:=GetTypeInfoParamType(Param,ParamResolved,true);
  19184. if aType=nil then
  19185. RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19186. aType:=ResolveAliasType(aType);
  19187. if not HasTypeInfo(aType) then
  19188. RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
  19189. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19190. end;
  19191. procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  19192. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  19193. begin
  19194. if Proc=nil then;
  19195. if Params=nil then ;
  19196. SetResolverTypeExpr(ResolvedEl,btPointer,
  19197. FBaseTypes[btPointer],FBaseTypes[btPointer],[rrfReadable]);
  19198. end;
  19199. function TPasResolver.BI_GetTypeKind_OnGetCallCompatibility(
  19200. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19201. var
  19202. Params: TParamsExpr;
  19203. Param: TPasExpr;
  19204. aType: TPasType;
  19205. ParamResolved: TPasResolverResult;
  19206. begin
  19207. Result:=cIncompatible;
  19208. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19209. exit;
  19210. Params:=TParamsExpr(Expr);
  19211. Param:=Params.Params[0];
  19212. aType:=GetTypeInfoParamType(Param,ParamResolved,true);
  19213. if aType=nil then
  19214. RaiseMsg(20200826205441,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19215. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19216. end;
  19217. procedure TPasResolver.BI_GetTypeKind_OnGetCallResult(
  19218. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  19219. ResolvedEl: TPasResolverResult);
  19220. var
  19221. El: TPasElement;
  19222. EnumType: TPasEnumType;
  19223. begin
  19224. El:=FindSystemIdentifier('system','ttypekind',Params);
  19225. if not (El is TPasEnumType) then
  19226. RaiseXExpectedButYFound(20200826211458,'enum type System.TTypeKind',GetElementTypeName(El),Params);
  19227. EnumType:=TPasEnumType(El);
  19228. SetResolverTypeExpr(ResolvedEl,btContext,EnumType,EnumType,[rrfReadable]);
  19229. if Proc=nil then ;
  19230. end;
  19231. procedure TPasResolver.BI_GetTypeKind_OnEval(Proc: TResElDataBuiltInProc;
  19232. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  19233. var
  19234. aType: TPasType;
  19235. El: TPasElement;
  19236. TypeKindType: TPasEnumType;
  19237. C: TClass;
  19238. aClass: TPasClassType;
  19239. bt: TResolverBaseType;
  19240. Value: TPasEnumValue;
  19241. aName: String;
  19242. i: Integer;
  19243. ParamResolved: TPasResolverResult;
  19244. begin
  19245. Evaluated:=nil;
  19246. aType:=GetTypeInfoParamType(Params.Params[0],ParamResolved,true);
  19247. C:=aType.ClassType;
  19248. aName:='tkUnknown';
  19249. if C=TPasEnumType then
  19250. aName:='tkEnumeration'
  19251. else if C=TPasSetType then
  19252. aName:='tkSet'
  19253. else if C=TPasRecordType then
  19254. aName:='tkRecord'
  19255. else if C=TPasClassType then
  19256. begin
  19257. aClass:=TPasClassType(aType);
  19258. case aClass.ObjKind of
  19259. okObject: aName:='tkObject';
  19260. okInterface:
  19261. case aClass.InterfaceType of
  19262. citCom: aName:='tkInterface';
  19263. else aName:='tkInterfaceRaw';
  19264. end;
  19265. okClassHelper, okRecordHelper, okTypeHelper: aName:='tkHelper';
  19266. else
  19267. aName:='tkClass';
  19268. end;
  19269. end
  19270. else if C=TPasClassOfType then
  19271. aName:='tkClassRef'
  19272. else if C.InheritsFrom(TPasProcedure) then
  19273. aName:='tkMethod'
  19274. else if C.InheritsFrom(TPasProcedureType) then
  19275. aName:='tkProcVar'
  19276. else
  19277. begin
  19278. bt:=ParamResolved.BaseType;
  19279. case bt of
  19280. btChar: {$ifdef FPC_HAS_CPSTRING}if BaseTypeChar=btAnsiChar then aName:='tkChar' else {$ENDIF}aName:='tkWChar';
  19281. {$ifdef FPC_HAS_CPSTRING}
  19282. btAnsiChar: aName:='tkChar';
  19283. {$endif}
  19284. btWideChar: aName:='tkWChar';
  19285. btString: {$ifdef FPC_HAS_CPSTRING}if BaseTypeString=btAnsiString then aName:='tkAString' else {$ENDIF}aName:='tkUString';
  19286. {$ifdef FPC_HAS_CPSTRING}
  19287. btAnsiString,
  19288. btShortString,
  19289. btRawByteString: aName:='tkAString';
  19290. {$endif}
  19291. btWideString: aName:='tkWString';
  19292. btUnicodeString: aName:='tkUString';
  19293. btPointer: aName:='tkPointer';
  19294. {$ifdef HasInt64}
  19295. btQWord,
  19296. btInt64,
  19297. btComp: aName:='tkInt64';
  19298. {$endif}
  19299. else
  19300. if bt in btAllBooleans then
  19301. aName:='tkBool'
  19302. else if bt in btAllInteger then
  19303. aName:='tkInteger'
  19304. else if bt in btAllFloats then
  19305. aName:='tkFloat';
  19306. end;
  19307. end;
  19308. El:=FindSystemIdentifier('system','ttypekind',Params);
  19309. TypeKindType:=El as TPasEnumType;
  19310. for i:=0 to TypeKindType.Values.Count-1 do
  19311. begin
  19312. Value:=TPasEnumValue(TypeKindType.Values[i]);
  19313. if SameText(aName,Value.Name) then
  19314. begin
  19315. Evaluated:=TResEvalEnum.CreateValue(i,Value);
  19316. exit;
  19317. end;
  19318. end;
  19319. if Proc=nil then ;
  19320. if Flags=[] then ;
  19321. end;
  19322. function TPasResolver.BI_Assert_OnGetCallCompatibility(
  19323. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19324. // check params of built-in procedure 'Assert'
  19325. // Assert(bool)
  19326. // Assert(bool,string)
  19327. var
  19328. Params: TParamsExpr;
  19329. Param: TPasExpr;
  19330. ParamResolved: TPasResolverResult;
  19331. begin
  19332. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19333. exit(cIncompatible);
  19334. Params:=TParamsExpr(Expr);
  19335. // first param: boolean
  19336. Param:=Params.Params[0];
  19337. ComputeElement(Param,ParamResolved,[]);
  19338. if not (rrfReadable in ParamResolved.Flags)
  19339. or not (ParamResolved.BaseType in btAllBooleans) then
  19340. exit(CheckRaiseTypeArgNo(20180117123819,1,Param,ParamResolved,'boolean',RaiseOnError));
  19341. // optional second parameter: string
  19342. if length(Params.Params)>1 then
  19343. begin
  19344. Param:=Params.Params[1];
  19345. ComputeElement(Param,ParamResolved,[]);
  19346. if not (rrfReadable in ParamResolved.Flags)
  19347. or not (ParamResolved.BaseType in btAllStringAndChars) then
  19348. exit(CheckRaiseTypeArgNo(20180117123932,2,Param,ParamResolved,'string',RaiseOnError));
  19349. end;
  19350. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  19351. end;
  19352. procedure TPasResolver.BI_Assert_OnFinishParamsExpr(
  19353. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19354. begin
  19355. FinishAssertCall(Proc,Params);
  19356. end;
  19357. function TPasResolver.BI_New_OnGetCallCompatibility(
  19358. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19359. var
  19360. Params: TParamsExpr;
  19361. Param: TPasExpr;
  19362. TypeEl, SubTypeEl: TPasType;
  19363. ParamResolved: TPasResolverResult;
  19364. begin
  19365. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19366. exit(cIncompatible);
  19367. Params:=TParamsExpr(Expr);
  19368. // first param: var PRecord
  19369. Param:=Params.Params[0];
  19370. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19371. {$IFDEF VerbosePasResolver}
  19372. writeln('TPasResolver.BI_New_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  19373. {$ENDIF}
  19374. Result:=cIncompatible;
  19375. // Expr must be a variable
  19376. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  19377. begin
  19378. if RaiseOnError then
  19379. RaiseVarExpected(20180425005303,Expr,ParamResolved.IdentEl);
  19380. exit;
  19381. end;
  19382. if ParamResolved.BaseType=btContext then
  19383. begin
  19384. TypeEl:=ParamResolved.LoTypeEl;
  19385. if TypeEl.ClassType=TPasPointerType then
  19386. begin
  19387. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  19388. if SubTypeEl.ClassType=TPasRecordType then
  19389. Result:=cExact;
  19390. end;
  19391. end;
  19392. if Result=cIncompatible then
  19393. exit(CheckRaiseTypeArgNo(20180425005421,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  19394. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19395. end;
  19396. procedure TPasResolver.BI_New_OnFinishParamsExpr(
  19397. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19398. begin
  19399. if Proc=nil then ;
  19400. FinishCallArgAccess(Params.Params[0],rraOutParam);
  19401. end;
  19402. function TPasResolver.BI_Dispose_OnGetCallCompatibility(
  19403. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19404. var
  19405. Params: TParamsExpr;
  19406. Param: TPasExpr;
  19407. TypeEl, SubTypeEl: TPasType;
  19408. ParamResolved: TPasResolverResult;
  19409. begin
  19410. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19411. exit(cIncompatible);
  19412. Params:=TParamsExpr(Expr);
  19413. // first param: var PRecord
  19414. Param:=Params.Params[0];
  19415. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19416. {$IFDEF VerbosePasResolver}
  19417. writeln('TPasResolver.BI_Dispose_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  19418. {$ENDIF}
  19419. Result:=cIncompatible;
  19420. if (rrfReadable in ParamResolved.Flags) then
  19421. if ParamResolved.BaseType=btContext then
  19422. begin
  19423. TypeEl:=ParamResolved.LoTypeEl;
  19424. if TypeEl.ClassType=TPasPointerType then
  19425. begin
  19426. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  19427. if SubTypeEl.ClassType=TPasRecordType then
  19428. Result:=cExact;
  19429. end;
  19430. end;
  19431. if Result=cIncompatible then
  19432. exit(CheckRaiseTypeArgNo(20180425010620,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  19433. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19434. end;
  19435. procedure TPasResolver.BI_Dispose_OnFinishParamsExpr(
  19436. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19437. begin
  19438. if Proc=nil then ;
  19439. FinishCallArgAccess(Params.Params[0],rraRead);
  19440. end;
  19441. function TPasResolver.BI_Default_OnGetCallCompatibility(
  19442. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19443. var
  19444. Params: TParamsExpr;
  19445. Param: TPasExpr;
  19446. ParamResolved: TPasResolverResult;
  19447. Decl: TPasElement;
  19448. aType: TPasType;
  19449. begin
  19450. Result:=cIncompatible;
  19451. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19452. exit;
  19453. Params:=TParamsExpr(Expr);
  19454. // check type or var
  19455. Param:=Params.Params[0];
  19456. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19457. Decl:=ParamResolved.IdentEl;
  19458. aType:=nil;
  19459. if (Decl<>nil) and (ParamResolved.LoTypeEl<>nil) then
  19460. begin
  19461. if Decl is TPasType then
  19462. aType:=TPasType(Decl)
  19463. else if Decl is TPasVariable then
  19464. aType:=TPasVariable(Decl).VarType
  19465. else if Decl.ClassType=TPasArgument then
  19466. aType:=TPasArgument(Decl).ArgType;
  19467. {$IFDEF VerbosePasResolver}
  19468. {AllowWriteln}
  19469. if aType=nil then
  19470. writeln('TPasResolver.BI_Default_OnGetCallCompatibility Decl=',GetObjName(Decl));
  19471. {AllowWriteln-}
  19472. {$ENDIF}
  19473. end;
  19474. if aType=nil then
  19475. begin
  19476. {$IFDEF VerbosePasResolver}
  19477. writeln('TPasResolver.BI_Default_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  19478. {$ENDIF}
  19479. RaiseMsg(20180501004009,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19480. end;
  19481. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19482. end;
  19483. procedure TPasResolver.BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  19484. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  19485. var
  19486. Param: TPasExpr;
  19487. begin
  19488. if Proc=nil then ;
  19489. Param:=Params.Params[0];
  19490. ComputeElement(Param,ResolvedEl,[rcNoImplicitProc]);
  19491. ResolvedEl.Flags:=[rrfReadable];
  19492. ResolvedEl.IdentEl:=nil;
  19493. end;
  19494. procedure TPasResolver.BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  19495. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  19496. var
  19497. Param: TPasExpr;
  19498. ParamResolved: TPasResolverResult;
  19499. TypeEl: TPasType;
  19500. EnumType: TPasEnumType;
  19501. i: Integer;
  19502. ArrayEl: TPasArrayType;
  19503. bt: TResolverBaseType;
  19504. MinInt, MaxInt: TMaxPrecInt;
  19505. begin
  19506. if Proc=nil then ;
  19507. Evaluated:=nil;
  19508. Param:=Params.Params[0];
  19509. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19510. TypeEl:=ParamResolved.LoTypeEl;
  19511. if ParamResolved.BaseType=btContext then
  19512. begin
  19513. if TypeEl.ClassType=TPasArrayType then
  19514. begin
  19515. // array: []
  19516. RaiseNotYetImplemented(20180501005214,Param);
  19517. ArrayEl:=TPasArrayType(TypeEl);
  19518. if length(ArrayEl.Ranges)=0 then
  19519. begin
  19520. // dyn or open array
  19521. end
  19522. else
  19523. begin
  19524. // static array
  19525. end;
  19526. end
  19527. else if TypeEl.ClassType=TPasSetType then
  19528. begin
  19529. // set: first/last enum
  19530. TypeEl:=TPasSetType(TypeEl).EnumType;
  19531. if TypeEl.ClassType=TPasEnumType then
  19532. begin
  19533. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  19534. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,EnumType);
  19535. end
  19536. else
  19537. begin
  19538. {$IFDEF VerbosePasResolver}
  19539. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  19540. {$ENDIF}
  19541. RaiseNotYetImplemented(20180501005348,Params);
  19542. end;
  19543. end
  19544. else if TypeEl.ClassType=TPasEnumType then
  19545. begin
  19546. EnumType:=TPasEnumType(TypeEl);
  19547. i:=0;
  19548. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  19549. end;
  19550. end
  19551. else if (TypeEl is TPasUnresolvedSymbolRef)
  19552. and (TypeEl.CustomData is TResElDataBaseType) then
  19553. begin
  19554. // default(base type)
  19555. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  19556. bt:=GetActualBaseType(bt);
  19557. if bt in btAllBooleans then
  19558. Evaluated:=TResEvalBool.CreateValue(false)
  19559. {$ifdef HasInt64}
  19560. else if bt=btQWord then
  19561. Evaluated:=TResEvalInt.CreateValue(0)
  19562. {$endif}
  19563. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  19564. Evaluated:=TResEvalInt.CreateValue(MinInt)
  19565. {$ifdef FPC_HAS_CPSTRING}
  19566. else if bt in [btAnsiString,btShortString] then
  19567. Evaluated:=TResEvalString.CreateValue('')
  19568. {$endif}
  19569. else if bt in [btUnicodeString,btWideString] then
  19570. Evaluated:=TResEvalUTF16.CreateValue('')
  19571. {$ifdef FPC_HAS_CPSTRING}
  19572. else if bt=btAnsiChar then
  19573. Evaluated:=TResEvalString.CreateValue(#0)
  19574. {$endif}
  19575. else if bt=btWideChar then
  19576. Evaluated:=TResEvalUTF16.CreateValue(#0)
  19577. else if bt in btAllFloats then
  19578. Evaluated:=TResEvalFloat.CreateValue(0.0)
  19579. else
  19580. begin
  19581. {$IFDEF VerbosePasResolver}
  19582. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19583. {$ENDIF}
  19584. RaiseNotYetImplemented(20180501005645,Params);
  19585. end;
  19586. end
  19587. else if ParamResolved.LoTypeEl is TPasRangeType then
  19588. begin
  19589. // e.g. type t = 2..10;
  19590. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,true,Param);
  19591. end
  19592. else if ParamResolved.BaseType=btSet then
  19593. begin
  19594. if ParamResolved.SubType=btContext then
  19595. begin
  19596. if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
  19597. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,TPasEnumType(ParamResolved.LoTypeEl))
  19598. else
  19599. begin
  19600. {$IFDEF VerbosePasResolver}
  19601. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19602. {$ENDIF}
  19603. RaiseNotYetImplemented(20180501125138,Param);
  19604. end;
  19605. end
  19606. else
  19607. begin
  19608. {$IFDEF VerbosePasResolver}
  19609. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19610. {$ENDIF}
  19611. RaiseNotYetImplemented(20180501125014,Param);
  19612. end;
  19613. end
  19614. else
  19615. begin
  19616. {$IFDEF VerbosePasResolver}
  19617. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19618. {$ENDIF}
  19619. RaiseNotYetImplemented(20180501004839,Param);
  19620. end;
  19621. end;
  19622. constructor TPasResolver.Create;
  19623. begin
  19624. inherited Create;
  19625. FDefaultScope:=TPasDefaultScope.Create;
  19626. FPendingForwardProcs:=TFPList.Create;
  19627. FBaseTypeChar:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  19628. FBaseTypeString:={$ifdef FPC_HAS_CPSTRING}btAnsiString{$else}btUnicodeString{$endif};
  19629. FBaseTypeExtended:=btDouble;
  19630. FBaseTypeLength:={$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  19631. FDynArrayMinIndex:=0;
  19632. FDynArrayMaxIndex:=High(TMaxPrecInt);
  19633. cTGUIDToString:=cTypeConversion+1;
  19634. cStringToTGUID:=cTypeConversion+1;
  19635. cInterfaceToTGUID:=cTypeConversion+1;
  19636. cInterfaceToString:=cTypeConversion+2;
  19637. FScopeClass_Array:=TPasArrayScope;
  19638. FScopeClass_Class:=TPasClassScope;
  19639. FScopeClass_InitialFinalization:=TPasInitialFinalizationScope;
  19640. FScopeClass_Module:=TPasModuleScope;
  19641. FScopeClass_Proc:=TPasProcedureScope;
  19642. FScopeClass_ProcType:=TPasProcTypeScope;
  19643. FScopeClass_Record:=TPasRecordScope;
  19644. FScopeClass_Section:=TPasSectionScope;
  19645. FScopeClass_WithExpr:=TPasWithExprScope;
  19646. fExprEvaluator:=TResExprEvaluator.Create;
  19647. fExprEvaluator.OnLog:=@OnExprEvalLog;
  19648. fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
  19649. fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
  19650. fExprEvaluator.OnRangeCheckEl:=@OnRangeCheckEl;
  19651. PushScope(FDefaultScope);
  19652. end;
  19653. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  19654. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  19655. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  19656. var
  19657. aScanner: TPascalScanner;
  19658. SrcPos: TPasSourcePos;
  19659. begin
  19660. // get source position for good error messages
  19661. aScanner:=CurrentParser.Scanner;
  19662. if (ASourceFilename='') or StoreSrcColumns then
  19663. begin
  19664. SrcPos.FileName:=aScanner.CurFilename;
  19665. SrcPos.Row:=aScanner.CurRow;
  19666. SrcPos.Column:=aScanner.CurColumn;
  19667. end
  19668. else
  19669. begin
  19670. SrcPos.FileName:=ASourceFilename;
  19671. SrcPos.Row:=ASourceLinenumber;
  19672. SrcPos.Column:=0;
  19673. end;
  19674. Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
  19675. end;
  19676. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  19677. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  19678. const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
  19679. var
  19680. El: TPasElement;
  19681. SrcY: integer;
  19682. SectionScope: TPasSectionScope;
  19683. begin
  19684. Result:=nil;
  19685. {$IFDEF VerbosePasResolver}
  19686. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  19687. {$ENDIF}
  19688. if (AParent=nil) and (FRootElement<>nil) then
  19689. RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
  19690. if ASrcPos.FileName='' then
  19691. begin
  19692. {$IFDEF VerbosePasResolver}
  19693. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  19694. {$ENDIF}
  19695. RaiseInternalError(20160922163541,'missing filename');
  19696. end;
  19697. SrcY:=ASrcPos.Row;
  19698. if StoreSrcColumns then
  19699. SrcY:=MangleSourceLineNumber(SrcY,ASrcPos.Column);
  19700. if AClass=TSelfExpr then
  19701. RaiseInternalError(20190131154235);
  19702. // create element
  19703. El:=AClass.Create(AName,AParent);
  19704. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('CreateElement');{$ENDIF}
  19705. FLastElement:=El;
  19706. try
  19707. El.Visibility:=AVisibility;
  19708. El.SourceFilename:=ASrcPos.FileName;
  19709. El.SourceLinenumber:=SrcY;
  19710. if FRootElement=nil then
  19711. begin
  19712. RootElement:=El as TPasModule;
  19713. if FStep=prsInit then
  19714. FStep:=prsParsing;
  19715. end
  19716. else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
  19717. begin
  19718. // first element of section
  19719. SectionScope:=TPasSectionScope(AParent.CustomData);
  19720. SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  19721. SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  19722. end;
  19723. if IsElementSkipped(El) then exit;
  19724. // create scope
  19725. if AClass.InheritsFrom(TPasExpr) then
  19726. // resolved when finished
  19727. else if (AClass=TPasVariable)
  19728. or (AClass=TPasConst) then
  19729. AddVariable(TPasVariable(El))
  19730. else if AClass=TPasResString then
  19731. AddResourceString(TPasResString(El))
  19732. else if (AClass=TPasProperty) then
  19733. AddProperty(TPasProperty(El))
  19734. else if AClass=TPasArgument then
  19735. AddArgument(TPasArgument(El))
  19736. else if AClass=TPasEnumType then
  19737. AddEnumType(TPasEnumType(El))
  19738. else if AClass=TPasEnumValue then
  19739. AddEnumValue(TPasEnumValue(El))
  19740. else if (AClass=TUnresolvedPendingRef) then
  19741. else if (AClass=TPasAliasType)
  19742. or (AClass=TPasTypeAliasType)
  19743. or (AClass=TPasClassOfType)
  19744. or (AClass=TPasPointerType)
  19745. or (AClass=TPasSetType)
  19746. or (AClass=TPasRangeType)
  19747. or (AClass=TPasSpecializeType) then
  19748. AddType(TPasType(El))
  19749. else if AClass=TPasArrayType then
  19750. AddArrayType(TPasArrayType(El),TypeParams)
  19751. else if (AClass=TPasProcedureType)
  19752. or (AClass=TPasFunctionType) then
  19753. AddProcedureType(TPasProcedureType(El),TypeParams)
  19754. else if AClass=TPasGenericTemplateType then
  19755. AddGenericTemplateType(TPasGenericTemplateType(El))
  19756. else if AClass=TPasStringType then
  19757. begin
  19758. AddType(TPasType(El));
  19759. {$ifdef FPC_HAS_CPSTRING}
  19760. if BaseTypes[btShortString]=nil then
  19761. {$endif}
  19762. RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
  19763. end
  19764. else if AClass=TPasRecordType then
  19765. AddRecordType(TPasRecordType(El),TypeParams)
  19766. else if AClass=TPasClassType then
  19767. AddClassType(TPasClassType(El),TypeParams)
  19768. else if AClass=TPasVariant then
  19769. else if AClass.InheritsFrom(TPasProcedure) then
  19770. AddProcedure(TPasProcedure(El),TypeParams)
  19771. else if AClass=TPasResultElement then
  19772. AddFunctionResult(TPasResultElement(El))
  19773. else if AClass=TProcedureBody then
  19774. AddProcedureBody(TProcedureBody(El))
  19775. else if AClass=TPasMethodResolution then
  19776. else if AClass=TPasImplExceptOn then
  19777. AddExceptOn(TPasImplExceptOn(El))
  19778. else if AClass=TPasImplWithDo then
  19779. AddWithDo(TPasImplWithDo(El))
  19780. else if AClass=TPasImplLabelMark then
  19781. else if AClass=TPasOverloadedProc then
  19782. else if (AClass=TInterfaceSection)
  19783. or (AClass=TImplementationSection)
  19784. or (AClass=TProgramSection)
  19785. or (AClass=TLibrarySection) then
  19786. AddSection(TPasSection(El))
  19787. else if (AClass=TPasModule)
  19788. or (AClass=TPasProgram)
  19789. or (AClass=TPasLibrary) then
  19790. AddModule(TPasModule(El))
  19791. else if AClass=TPasUsesUnit then
  19792. else if AClass=TInitializationSection then
  19793. AddInitialFinalizationSection(TInitializationSection(El))
  19794. else if AClass=TFinalizationSection then
  19795. AddInitialFinalizationSection(TFinalizationSection(El))
  19796. else if AClass=TPasImplCommand then
  19797. else if AClass.InheritsFrom(TPasImplBlock) then
  19798. // resolved when finished
  19799. else if AClass=TPasAttributes then
  19800. else if AClass=TPasExportSymbol then
  19801. AddExportSymbol(TPasExportSymbol(El))
  19802. else if AClass=TPasUnresolvedUnitRef then
  19803. RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
  19804. else
  19805. RaiseNotYetImplemented(20160922163544,El);
  19806. Result:=El;
  19807. finally
  19808. if Result=nil then
  19809. El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  19810. end;
  19811. end;
  19812. function TPasResolver.FindModule(const AName: String; NameExpr,
  19813. InFileExpr: TPasExpr): TPasModule;
  19814. var
  19815. InFilename, FileUnitName: String;
  19816. begin
  19817. if InFileExpr<>nil then
  19818. begin
  19819. InFilename:=GetUsesUnitInFilename(InFileExpr);
  19820. if InFilename='' then
  19821. RaiseXExpectedButYFound(20180222001220,
  19822. 'file path','empty string',InFileExpr);
  19823. if msDelphi in CurrentParser.CurrentModeswitches then
  19824. begin
  19825. // in delphi the last unit name must match the filename
  19826. FileUnitName:=ChangeFileExt(ExtractFileName(InFilename),'');
  19827. if CompareText(AName,FileUnitName)<>0 then
  19828. RaiseXExpectedButYFound(20180222230400,AName,FileUnitName,InFileExpr);
  19829. end;
  19830. end;
  19831. Result:=FindUnit(AName,InFilename,NameExpr,InFileExpr);
  19832. if Result=nil then
  19833. begin
  19834. if InFileExpr<>nil then
  19835. RaiseMsg(20180223140434,nCantFindUnitX,sCantFindUnitX,[InFilename],InFileExpr)
  19836. else
  19837. RaiseMsg(20180223140409,nCantFindUnitX,sCantFindUnitX,[AName],NameExpr);
  19838. end;
  19839. end;
  19840. function TPasResolver.FindElement(const aName: String): TPasElement;
  19841. begin
  19842. Result:=FindElementFor(aName,nil,0);
  19843. end;
  19844. function TPasResolver.FindElementFor(const aName: String; AParent: TPasElement;
  19845. TypeParamCount: integer): TPasElement;
  19846. // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
  19847. var
  19848. ErrorEl: TPasElement;
  19849. procedure CheckGenericRefWithoutParams(GenEl: TPasGenericType);
  19850. // called when TypeParamCount=0 check if reference to a generic type is allowed with
  19851. begin
  19852. if (GenEl.GenericTemplateTypes=nil) or (GenEl.GenericTemplateTypes.Count=0) then
  19853. exit;
  19854. // referrring to a generic type without params
  19855. if not (msDelphi in CurrentParser.CurrentModeswitches)
  19856. and (AParent<>nil)
  19857. and AParent.HasParent(GenEl) then
  19858. exit; // mode objfpc: inside the generic type it can be referred without params
  19859. RaiseMsg(20201129005025,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,['variable'],ErrorEl);
  19860. end;
  19861. var
  19862. p: SizeInt;
  19863. RightPath, CurName, LeftPath: String;
  19864. NeedPop: Boolean;
  19865. CurScopeEl, NextEl, BestEl: TPasElement;
  19866. CurSection: TPasSection;
  19867. i: Integer;
  19868. UsesUnit: TPasUsesUnit;
  19869. CurScope: TPasDotBaseScope;
  19870. FindData: TPRFindData;
  19871. begin
  19872. Result:=nil;
  19873. ErrorEl:=nil; // use nil to use scanner position as error position
  19874. RightPath:=aName;
  19875. LeftPath:='';
  19876. p:=1;
  19877. CurScopeEl:=nil;
  19878. repeat
  19879. p:=Pos('.',RightPath);
  19880. if p<1 then
  19881. begin
  19882. CurName:=RightPath;
  19883. RightPath:='';
  19884. end
  19885. else
  19886. begin
  19887. CurName:=LeftStr(RightPath,p-1);
  19888. Delete(RightPath,1,p);
  19889. if RightPath='' then
  19890. RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  19891. end;
  19892. if LeftPath='' then
  19893. LeftPath:=CurName
  19894. else
  19895. LeftPath:=LeftPath+'.'+CurName;
  19896. {$IFDEF VerbosePasResolver}
  19897. {AllowWriteln}
  19898. if RightPath<>'' then
  19899. writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
  19900. {AllowWriteln-}
  19901. {$ENDIF}
  19902. // Note: CurName can be a non Pascal name, when specializing an autogenerated anonymous type
  19903. //if not IsValidIdent(CurName) then ;
  19904. if CurScopeEl<>nil then
  19905. begin
  19906. NeedPop:=true;
  19907. if CurScopeEl is TPasType then
  19908. begin
  19909. if (CurScopeEl is TPasGenericType)
  19910. and not IsFullySpecialized(TPasGenericType(CurScopeEl)) then
  19911. RaiseMsg(20200217131215,nGenericsWithoutSpecializationAsType,
  19912. sGenericsWithoutSpecializationAsType,['reference'],ErrorEl);
  19913. CurScope:=PushDotScope(TPasType(CurScopeEl));
  19914. if CurScope=nil then
  19915. RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19916. ['.',LeftPath],ErrorEl);
  19917. CurScope.OnlyTypeMembers:=true;
  19918. end
  19919. else if CurScopeEl is TPasModule then
  19920. PushModuleDotScope(TPasModule(CurScopeEl))
  19921. else
  19922. RaiseMsg(20170504174021,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19923. ['.',LeftPath],ErrorEl);
  19924. end
  19925. else
  19926. NeedPop:=false;
  19927. if (RightPath='') and (TypeParamCount>0) then
  19928. begin
  19929. NextEl:=FindGenericEl(CurName,TypeParamCount,FindData,ErrorEl);
  19930. if (FindData.StartScope<>nil) and (FindData.StartScope.ClassType=ScopeClass_WithExpr)
  19931. and (wesfNeedTmpVar in TPasWithExprScope(FindData.StartScope).Flags) then
  19932. RaiseInternalError(20190801104033); // caller forgot to handle "With"
  19933. end
  19934. else
  19935. begin
  19936. NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true);
  19937. if (NextEl is TPasGenericType) and (RightPath='') then
  19938. CheckGenericRefWithoutParams(TPasGenericType(NextEl));
  19939. end;
  19940. {$IFDEF VerbosePasResolver}
  19941. //if RightPath<>'' then
  19942. // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
  19943. {$ENDIF}
  19944. if NextEl=nil then
  19945. RaiseIdentifierNotFound(20201129004745,CurName,ErrorEl);
  19946. if NextEl is TPasModule then
  19947. begin
  19948. if CurScopeEl is TPasModule then
  19949. RaiseXExpectedButYFound(20170328001619,'class',GetElementTypeName(NextEl)+' '+NextEl.Name,ErrorEl);
  19950. if Pos('.',NextEl.Name)>0 then
  19951. begin
  19952. // dotted module name -> check if the full module name is in aName
  19953. if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
  19954. begin
  19955. if CompareText(NextEl.Name,aName)=0 then
  19956. RaiseXExpectedButYFound(20170504165825,'type',GetElementTypeName(NextEl),ErrorEl)
  19957. else
  19958. RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
  19959. end;
  19960. RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
  19961. end;
  19962. CurScopeEl:=NextEl;
  19963. end
  19964. else if NextEl.ClassType=TPasUsesUnit then
  19965. begin
  19966. // the first name of a used unit matches -> find longest match
  19967. CurSection:=NextEl.Parent as TPasSection;
  19968. i:=length(CurSection.UsesClause)-1;
  19969. BestEl:=nil;
  19970. while i>=0 do
  19971. begin
  19972. UsesUnit:=CurSection.UsesClause[i];
  19973. CurName:=UsesUnit.Name;
  19974. if IsDottedIdentifierPrefix(CurName,aName)
  19975. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19976. BestEl:=UsesUnit;
  19977. dec(i);
  19978. if (i<0) and (CurSection.ClassType=TImplementationSection) then
  19979. begin
  19980. CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
  19981. if CurSection=nil then break;
  19982. i:=length(CurSection.UsesClause)-1;
  19983. end;
  19984. end;
  19985. // check module name too
  19986. CurName:=RootElement.Name;
  19987. if IsDottedIdentifierPrefix(CurName,aName)
  19988. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19989. BestEl:=RootElement;
  19990. if BestEl=nil then
  19991. RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
  19992. RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
  19993. if BestEl.ClassType=TPasUsesUnit then
  19994. CurScopeEl:=TPasUsesUnit(BestEl).Module
  19995. else
  19996. CurScopeEl:=BestEl;
  19997. end
  19998. else
  19999. CurScopeEl:=NextEl;
  20000. // restore scope
  20001. if NeedPop then
  20002. PopScope;
  20003. if RightPath='' then
  20004. exit(NextEl);
  20005. until false;
  20006. if AParent=nil then ;;
  20007. end;
  20008. function TPasResolver.FindElementWithoutParams(const AName: String;
  20009. ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  20010. // ErrorPosEl=nil means to use scanner position as error position
  20011. var
  20012. Data: TPRFindData;
  20013. begin
  20014. Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs,NoGenerics);
  20015. if Data.Found=nil then exit; // forward type: class-of or ^
  20016. CheckFoundElement(Data,nil);
  20017. if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
  20018. and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
  20019. RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
  20020. end;
  20021. function TPasResolver.FindElementWithoutParams(const AName: String; out
  20022. Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs,
  20023. NoGenerics: boolean): TPasElement;
  20024. // ErrorPosEl=nil means to use scanner position as error position
  20025. var
  20026. Abort: boolean;
  20027. begin
  20028. //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
  20029. Result:=Nil;
  20030. Abort:=false;
  20031. Data:=Default(TPRFindData);
  20032. Data.ErrorPosEl:=ErrorPosEl;
  20033. Data.SkipGenerics:=NoGenerics;
  20034. IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort);
  20035. Result:=Data.Found;
  20036. if Result=nil then
  20037. begin
  20038. if (ErrorPosEl=nil) and (LastElement<>nil) then
  20039. begin
  20040. if (LastElement.ClassType=TPasClassOfType)
  20041. and (TPasClassOfType(LastElement).DestType=nil) then
  20042. begin
  20043. // 'class of' of a not yet defined class
  20044. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  20045. CurrentParser.CurSourcePos);
  20046. exit;
  20047. end
  20048. else if (LastElement.ClassType=TPasPointerType)
  20049. and (TPasPointerType(LastElement).DestType=nil) then
  20050. begin
  20051. // pointer of a not yet defined type
  20052. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  20053. CurrentParser.CurSourcePos);
  20054. exit;
  20055. end
  20056. end;
  20057. RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
  20058. end;
  20059. if NoProcsWithArgs and (Result is TPasProcedure)
  20060. and ProcNeedsParams(TPasProcedure(Result).ProcType)
  20061. then
  20062. // proc needs parameters
  20063. RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
  20064. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
  20065. end;
  20066. function TPasResolver.FindFirstEl(const AName: String; out Data: TPRFindData;
  20067. ErrorPosEl: TPasElement): TPasElement;
  20068. var
  20069. Abort: boolean;
  20070. begin
  20071. Abort:=false;
  20072. Data:=Default(TPRFindData);
  20073. Data.ErrorPosEl:=ErrorPosEl;
  20074. IterateElements(AName,@OnFindFirst,@Data,Abort);
  20075. Result:=Data.Found;
  20076. end;
  20077. procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  20078. // Input: El is TPasUsesUnit
  20079. // Output: El is either a TPasUsesUnit or the root module
  20080. var
  20081. CurUsesUnit: TPasUsesUnit;
  20082. BestEl: TPasElement;
  20083. aName, CurName: String;
  20084. Clause: TPasUsesClause;
  20085. i: Integer;
  20086. Section: TPasSection;
  20087. begin
  20088. {$IFDEF VerbosePasResolver}
  20089. //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
  20090. {$ENDIF}
  20091. if not (El is TPasUsesUnit) then
  20092. RaiseInternalError(20170503000945);
  20093. aName:=GetNameExprValue(Expr);
  20094. if aName='' then
  20095. RaiseNotYetImplemented(20170503110217,Expr);
  20096. repeat
  20097. Expr:=GetNextDottedExpr(Expr);
  20098. if Expr=nil then break;
  20099. CurName:=GetNameExprValue(Expr);
  20100. if CurName='' then
  20101. RaiseNotYetImplemented(20170502164242,Expr);
  20102. aName:=aName+'.'+CurName;
  20103. until false;
  20104. {$IFDEF VerbosePasResolver}
  20105. //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
  20106. {$ENDIF}
  20107. // search in uses clause
  20108. BestEl:=nil;
  20109. Section:=TPasUsesUnit(El).Parent as TPasSection;
  20110. repeat
  20111. Clause:=Section.UsesClause;
  20112. for i:=0 to length(Clause)-1 do
  20113. begin
  20114. CurUsesUnit:=Clause[i];
  20115. CurName:=CurUsesUnit.Name;
  20116. if IsDottedIdentifierPrefix(CurName,aName)
  20117. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  20118. BestEl:=CurUsesUnit; // a better match
  20119. end;
  20120. if Section is TImplementationSection then
  20121. begin
  20122. // search in interface uses clause too
  20123. Section:=(Section.Parent as TPasModule).InterfaceSection;
  20124. end
  20125. else
  20126. break;
  20127. until Section=nil;
  20128. {$IFDEF VerbosePasResolver}
  20129. //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
  20130. {$ENDIF}
  20131. // check module name
  20132. CurName:=El.GetModule.Name;
  20133. if IsDottedIdentifierPrefix(CurName,aName)
  20134. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  20135. BestEl:=El.GetModule; // a better match
  20136. if BestEl=nil then
  20137. begin
  20138. // no dotted module name fits the expression
  20139. RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
  20140. end;
  20141. El:=BestEl;
  20142. {$IFDEF VerbosePasResolver}
  20143. //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
  20144. {$ENDIF}
  20145. end;
  20146. function TPasResolver.FindGenericEl(const AName: string;
  20147. TemplateCount: integer; out Find: TPRFindData; ErrorPosEl: TPasElement
  20148. ): TPasElement;
  20149. var
  20150. Data: TPRFindGenericData;
  20151. Abort: boolean;
  20152. begin
  20153. Data:=Default(TPRFindGenericData);
  20154. Data.TemplateCount:=TemplateCount;
  20155. Data.Find.ErrorPosEl:=ErrorPosEl;
  20156. Abort:=false;
  20157. IterateElements(AName,@OnFindFirst_GenericEl,@Data,Abort);
  20158. Find:=Data.Find;
  20159. Result:=Find.Found;
  20160. if Result=nil then
  20161. begin
  20162. {$IFDEF VerbosePasResolver}
  20163. WriteScopesShort('TPasResolver.FindGenericType');
  20164. {$ENDIF}
  20165. RaiseMsg(20190801104759,nIdentifierNotFound,sIdentifierNotFound,[AName+GetGenericParamCommas(TemplateCount)],ErrorPosEl);
  20166. end;
  20167. CheckFoundElement(Find,nil);
  20168. end;
  20169. procedure TPasResolver.IterateElements(const aName: string;
  20170. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  20171. var Abort: boolean);
  20172. var
  20173. i: Integer;
  20174. Scope: TPasScope;
  20175. begin
  20176. for i:=FScopeCount-1 downto 0 do
  20177. begin
  20178. Scope:=Scopes[i];
  20179. Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
  20180. if Abort then
  20181. exit;
  20182. if Scope is TPasSubExprScope then break;
  20183. end;
  20184. end;
  20185. procedure TPasResolver.CheckFoundElement(
  20186. const FindData: TPRFindData; Ref: TResolvedReference);
  20187. // check visibility rules
  20188. // Call this method after finding an element by searching the scopes.
  20189. function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
  20190. // returns true if aRef is a TPasVariable that inherits its const from parent.
  20191. // For example
  20192. // type TRecord = record
  20193. // a: word; // inherits const
  20194. // const b: word = 3; // does not inherit const
  20195. // class var c: word; // does not inherit const
  20196. // end;
  20197. // procedure DoIt(const r:TRecord)
  20198. var
  20199. El: TPasElement;
  20200. begin
  20201. El:=aRef.Declaration;
  20202. Result:=(El.ClassType=TPasVariable)
  20203. and (TPasVariable(El).VarModifiers*[vmClass, vmStatic]=[]);
  20204. //writeln('IsFieldInheritingConst ',GetObjName(El),' ',Result,' vmClass=',vmClass in TPasVariable(El).VarModifiers);
  20205. end;
  20206. var
  20207. Proc: TPasProcedure;
  20208. StartScope: TPasScope;
  20209. OnlyTypeMembers, IsClassOf: Boolean;
  20210. C: TClass;
  20211. ClassRecScope: TPasClassOrRecordScope;
  20212. i: Integer;
  20213. AbstractProcs: TArrayOfPasProcedure;
  20214. TypeEl: TPasType;
  20215. begin
  20216. StartScope:=FindData.StartScope;
  20217. OnlyTypeMembers:=false;
  20218. IsClassOf:=false;
  20219. if StartScope is TPasDotBaseScope then
  20220. begin
  20221. OnlyTypeMembers:=TPasDotBaseScope(StartScope).OnlyTypeMembers;
  20222. if StartScope.ClassType=TPasDotClassScope then
  20223. IsClassOf:=TPasDotClassScope(StartScope).IsClassOf;
  20224. if Ref<>nil then
  20225. begin
  20226. Include(Ref.Flags,rrfDotScope);
  20227. if TPasDotBaseScope(StartScope).ConstParent
  20228. and IsFieldInheritingConst(Ref) then
  20229. Include(Ref.Flags,rrfConstInherited);
  20230. end;
  20231. end
  20232. else if StartScope.ClassType=FScopeClass_WithExpr then
  20233. begin
  20234. OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
  20235. IsClassOf:=wesfIsClassOf in TPasWithExprScope(StartScope).Flags;
  20236. if Ref<>nil then
  20237. begin
  20238. Include(Ref.Flags,rrfDotScope);
  20239. if (wesfConstParent in TPasWithExprScope(StartScope).Flags)
  20240. and IsFieldInheritingConst(Ref) then
  20241. Include(Ref.Flags,rrfConstInherited);
  20242. end;
  20243. end
  20244. else if StartScope.ClassType=FScopeClass_Proc then
  20245. begin
  20246. Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
  20247. //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
  20248. if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
  20249. OnlyTypeMembers:=true;
  20250. end
  20251. else if StartScope.ClassType=TPasGroupScope then
  20252. OnlyTypeMembers:=TPasGroupScope(StartScope).OnlyTypeMembers;
  20253. //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
  20254. // ' StartIsDot=',StartScope is TPasDotBaseScope,
  20255. // ' OnlyTypeMembers=',(StartScope is TPasDotBaseScope)
  20256. // and TPasDotBaseScope(StartScope).OnlyTypeMembers,
  20257. // ' FindData.Found=',GetObjName(FindData.Found));
  20258. if OnlyTypeMembers then
  20259. begin
  20260. //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
  20261. // and (vmClass in TPasVariable(FindData.Found).VarModifiers));
  20262. // only class vars/procs allowed
  20263. if FindData.Found.ClassType=TPasConstructor then
  20264. // constructor: ok
  20265. else if IsClassMethod(FindData.Found)
  20266. then
  20267. // class proc: ok
  20268. else if (FindData.Found is TPasVariable)
  20269. and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
  20270. // class var/const/property: ok
  20271. else if FindData.Found is TPasType then
  20272. // nested type: ok
  20273. else if FindData.Found is TPasEnumValue then
  20274. // e.g. enumtype.enumvalue: ok
  20275. else
  20276. begin
  20277. RaiseMsg(20170216152348,nInstanceMemberXInaccessible,
  20278. sInstanceMemberXInaccessible,[FindData.Found.Name],FindData.ErrorPosEl);
  20279. end;
  20280. end
  20281. else if (proExtClassInstanceNoTypeMembers in Options)
  20282. and (StartScope is TPasDotClassScope)
  20283. and TPasClassType(TPasDotClassScope(StartScope).ClassRecScope.Element).IsExternal then
  20284. begin
  20285. // e.g. ExtClassInstance.Member
  20286. C:=FindData.Found.ClassType;
  20287. if (C=TPasProcedure) or (C=TPasFunction) then
  20288. // ok
  20289. else if (C=TPasConst) then
  20290. // ok
  20291. else if ((C=TPasVariable) or (C=TPasProperty))
  20292. and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
  20293. // ok
  20294. else if IsHelper(FindData.Found.Parent) then
  20295. // ok
  20296. else
  20297. begin
  20298. RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
  20299. sExternalClassInstanceCannotAccessStaticX,
  20300. [GetElementTypeName(FindData.Found)+' '+FindData.Found.Name],
  20301. FindData.ErrorPosEl);
  20302. end;
  20303. end;
  20304. if (FindData.Found is TPasProcedure) then
  20305. begin
  20306. Proc:=TPasProcedure(FindData.Found);
  20307. if Proc.IsVirtual or Proc.IsOverride then
  20308. begin
  20309. if StartScope.ClassType=TPasInheritedScope then
  20310. begin
  20311. // inherited expr -> call directly
  20312. if Proc.IsAbstract then
  20313. RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
  20314. sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
  20315. end
  20316. else
  20317. begin
  20318. // call via virtual method table
  20319. if Ref<>nil then
  20320. Ref.Flags:=Ref.Flags+[rrfVMT];
  20321. end;
  20322. end;
  20323. // constructor: NewInstance or normal call
  20324. // it is a NewInstance iff the scope is a class/record, e.g. TObject.Create
  20325. if (Proc.ClassType=TPasConstructor)
  20326. and (Ref<>nil) then
  20327. begin
  20328. if OnlyTypeMembers then
  20329. Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
  20330. // store the class in Ref.Context
  20331. if Ref.Context<>nil then
  20332. RaiseInternalError(20170131141936);
  20333. Ref.Context:=TResolvedRefCtxConstructor.Create;
  20334. TypeEl:=nil;
  20335. ClassRecScope:=nil;
  20336. C:=StartScope.ClassType;
  20337. if C.InheritsFrom(TPasDotClassOrRecordScope) then
  20338. ClassRecScope:=TPasDotClassOrRecordScope(StartScope).ClassRecScope
  20339. else if C=ScopeClass_WithExpr then
  20340. begin
  20341. ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope;
  20342. if ClassRecScope=nil then
  20343. TypeEl:=TPasWithExprScope(StartScope).Scope.Element as TPasType;
  20344. end
  20345. else if C=ScopeClass_Procedure then
  20346. ClassRecScope:=TPasProcedureScope(StartScope).ClassRecScope
  20347. else if C=TPasDotHelperScope then
  20348. TypeEl:=NoNil(TPasDotHelperScope(StartScope).Element) as TPasType
  20349. else
  20350. RaiseInternalError(20170131150855,GetObjName(StartScope));
  20351. if TypeEl<>nil then
  20352. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl
  20353. else
  20354. begin
  20355. if ClassRecScope=nil then
  20356. RaiseInternalError(20190123120156,GetObjName(StartScope));
  20357. TypeEl:=ClassRecScope.Element as TPasMembersType;
  20358. if (TypeEl.ClassType=TPasClassType)
  20359. and (TPasClassType(TypeEl).HelperForType<>nil) then
  20360. TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
  20361. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
  20362. if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
  20363. begin
  20364. if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
  20365. LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
  20366. sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
  20367. else
  20368. begin
  20369. AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
  20370. if (length(AbstractProcs)>0) then
  20371. begin
  20372. if IsClassOf then
  20373. // aClass.Create: do not warn
  20374. else
  20375. for i:=0 to length(AbstractProcs)-1 do
  20376. LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
  20377. sConstructingClassXWithAbstractMethodY,
  20378. [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
  20379. end;
  20380. end;
  20381. end;
  20382. end;
  20383. end;
  20384. {$IFDEF VerbosePasResolver}
  20385. {AllowWriteln}
  20386. if (Proc.ClassType=TPasConstructor) then
  20387. begin
  20388. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  20389. if Ref=nil then
  20390. write(' no ref!')
  20391. else
  20392. begin
  20393. write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
  20394. ' StartScope=',GetObjName(StartScope),
  20395. ' OnlyTypeMembers=',OnlyTypeMembers);
  20396. end;
  20397. writeln;
  20398. end;
  20399. {AllowWriteln-}
  20400. {$ENDIF}
  20401. // destructor: FreeInstance or normal call
  20402. // it is a normal call if 'inherited'
  20403. if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
  20404. if not (StartScope is TPasInheritedScope) then
  20405. Ref.Flags:=Ref.Flags+[rrfFreeInstance];
  20406. {$IFDEF VerbosePasResolver}
  20407. {AllowWriteln}
  20408. if (Proc.ClassType=TPasDestructor) then
  20409. begin
  20410. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  20411. if Ref=nil then
  20412. write(' no ref!')
  20413. else
  20414. begin
  20415. write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
  20416. ' StartScope=',GetObjName(StartScope));
  20417. if StartScope is TPasDotClassOrRecordScope then
  20418. write(' InheritedExpr=',StartScope is TPasInheritedScope);
  20419. end;
  20420. writeln;
  20421. end;
  20422. {AllowWriteln-}
  20423. {$ENDIF}
  20424. end;
  20425. CheckFoundElementVisibility(FindData,Ref);
  20426. end;
  20427. procedure TPasResolver.CheckFoundElementVisibility(const FindData: TPRFindData;
  20428. Ref: TResolvedReference);
  20429. var
  20430. Context: TPasElement;
  20431. FoundContext: TPasMembersType;
  20432. CurScope: TPasScope;
  20433. {$IFDEF VerbosePasResolver}
  20434. i: Integer;
  20435. {$ENDIF}
  20436. begin
  20437. // check class visibility
  20438. if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
  20439. begin
  20440. Context:=GetVisibilityContext;
  20441. FoundContext:=FindData.Found.Parent as TPasMembersType;
  20442. case FindData.Found.Visibility of
  20443. visPrivate:
  20444. // private members can only be accessed in same module
  20445. if FoundContext.GetModule<>Context.GetModule then
  20446. RaiseMsg(20170216152354,nCantAccessXMember,sCantAccessXMember,
  20447. ['private',FindData.Found.Name],FindData.ErrorPosEl);
  20448. visProtected:
  20449. begin
  20450. // protected members can only be accessed in same module
  20451. // or descendant classes
  20452. CurScope:=TopScope;
  20453. if FoundContext.GetModule=Context.GetModule then
  20454. // same module -> ok
  20455. else if (Context is TPasType)
  20456. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  20457. // context in class or descendant
  20458. else if (CurScope is TPasDotClassOrRecordScope)
  20459. and (TPasDotClassOrRecordScope(CurScope).ClassRecScope.Element.GetModule=Context.GetModule) then
  20460. // e.g. aClassInThisModule.identifier
  20461. else if (CurScope is TPasWithExprScope)
  20462. and (TPasWithExprScope(CurScope).Scope.Element<>nil)
  20463. and (TPasWithExprScope(CurScope).Scope.Element.GetModule=Context.GetModule) then
  20464. // e.g. with aClassInThisModule do identifier
  20465. else
  20466. RaiseMsg(20170216152356,nCantAccessXMember,sCantAccessXMember,
  20467. ['protected',FindData.Found.Name],FindData.ErrorPosEl);
  20468. end;
  20469. visStrictPrivate:
  20470. // strict private members can only be accessed in their class
  20471. if Context<>FoundContext then
  20472. begin
  20473. {$IFDEF VerbosePasResolver}
  20474. {AllowWriteln}
  20475. writeln('TPasResolver.CheckFoundElement Context=',GetElementDbgPath(Context),' FoundContext=',GetElementDbgPath(FoundContext));
  20476. for i:=ScopeCount-1 downto 0 do
  20477. writeln(' ',i,' ',Scopes[i].ClassName,' Element=',GetObjName(Scopes[i].Element),' VisibilityContext=',GetObjName(Scopes[i].VisibilityContext));
  20478. {AllowWriteln-}
  20479. {$ENDIF}
  20480. RaiseMsg(20170216152357,nCantAccessXMember,sCantAccessXMember,
  20481. ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
  20482. end;
  20483. visStrictProtected:
  20484. // strict protected members can only be accessed in their and descendant classes
  20485. if (Context is TPasType)
  20486. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  20487. // context in class or descendant
  20488. else
  20489. RaiseMsg(20170216152400,nCantAccessXMember,sCantAccessXMember,
  20490. ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
  20491. end;
  20492. end;
  20493. if Ref=nil then ;
  20494. end;
  20495. function TPasResolver.GetVisibilityContext: TPasElement;
  20496. var
  20497. i: Integer;
  20498. begin
  20499. for i:=ScopeCount-1 downto 0 do
  20500. begin
  20501. Result:=Scopes[i].VisibilityContext;
  20502. if Result<>nil then exit;
  20503. end;
  20504. Result:=nil;
  20505. end;
  20506. procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
  20507. begin
  20508. case ScopeType of
  20509. stWithExpr: PushWithExprScope(El as TPasExpr);
  20510. else
  20511. RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
  20512. end;
  20513. end;
  20514. procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
  20515. begin
  20516. if IsElementSkipped(El) then exit;
  20517. case ScopeType of
  20518. stModule: FinishModule(El as TPasModule);
  20519. stUsesClause: FinishUsesClause;
  20520. stTypeSection: FinishTypeSection(El);
  20521. stTypeDef: FinishTypeDef(El as TPasType);
  20522. stResourceString: FinishResourcestring(El as TPasResString);
  20523. stProcedure: FinishProcedure(El as TPasProcedure);
  20524. stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
  20525. stExceptOnExpr: FinishExceptOnExpr;
  20526. stExceptOnStatement: FinishExceptOnStatement;
  20527. stWithExpr: FinishWithDo(El as TPasImplWithDo);
  20528. stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop);
  20529. stDeclaration: FinishDeclaration(El);
  20530. stAncestors: FinishAncestors(El as TPasClassType);
  20531. stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
  20532. else
  20533. RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
  20534. end;
  20535. end;
  20536. procedure TPasResolver.FinishTypeAlias(var NewType: TPasType);
  20537. var
  20538. TypeEl, DestType: TPasType;
  20539. AncestorClass, aClass: TPasClassType;
  20540. Scope: TPasIdentifierScope;
  20541. OldType: TPasTypeAliasType;
  20542. LocalScope: TPasScope;
  20543. begin
  20544. DestType:=TPasTypeAliasType(NewType).DestType;
  20545. TypeEl:=ResolveSimpleAliasType(DestType);
  20546. if TypeEl is TPasClassType then
  20547. begin
  20548. // change "=type aClassType" to "=class(aClassType)"
  20549. // or change "=type aInterfaceType" to "=interface(aInterfaceType)"
  20550. AncestorClass := TPasClassType(TypeEl);
  20551. // remove aliastype from scope
  20552. LocalScope:=GetLocalScope;
  20553. Scope:=LocalScope as TPasIdentifierScope;
  20554. Scope.RemoveLocalIdentifier(NewType);
  20555. // create class or interface
  20556. aClass := TPasClassType(CreateElement(TPasClassType,
  20557. NewType.Name,NewType.Parent,NewType.Visibility,
  20558. NewType.SourceFilename,NewType.SourceLinenumber));
  20559. aClass.ObjKind := AncestorClass.ObjKind;
  20560. // release old alias type
  20561. OldType := TPasTypeAliasType(NewType);
  20562. NewType := aClass;
  20563. TPasTypeAliasType(OldType).DestType:=nil; // clear reference
  20564. OldType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  20565. // set ancestor
  20566. aClass.AncestorType := DestType;
  20567. {$IFDEF CheckPasTreeRefCount}DestType.ChangeRefId('ResolveTypeReference','TPasClassType.AncestorType');{$ENDIF}
  20568. FinishScope(stAncestors,aClass);
  20569. end;
  20570. end;
  20571. function TPasResolver.IsUnitIntfFinished(AModule: TPasModule): boolean;
  20572. var
  20573. CurIntf: TInterfaceSection;
  20574. begin
  20575. CurIntf:=AModule.InterfaceSection;
  20576. Result:=(CurIntf<>nil)
  20577. and (CurIntf.CustomData is TPasSectionScope)
  20578. and TPasSectionScope(CurIntf.CustomData).Finished;
  20579. end;
  20580. procedure TPasResolver.NotifyPendingUsedInterfaces;
  20581. // called after unit interface is ready to be used by other modules
  20582. var
  20583. ModuleScope: TPasModuleScope;
  20584. i: Integer;
  20585. PendingResolver: TPasResolver;
  20586. PendingSection: TPasSection;
  20587. begin
  20588. // call all PendingResolvers
  20589. // Note that a waiting resolver might continue parsing
  20590. ModuleScope:=RootElement.CustomData as TPasModuleScope;
  20591. i:=ModuleScope.PendingResolvers.Count-1;
  20592. while i>=0 do
  20593. begin
  20594. PendingResolver:=TObject(ModuleScope.PendingResolvers[i]) as TPasResolver;
  20595. PendingSection:=PendingResolver.GetLastSection;
  20596. {$IFDEF VerbosePasResolver}
  20597. writeln('TPasResolver.NotifyPendingUsedInterfaces "',ModuleScope.Element.Name,'" Pending="',PendingResolver.RootElement.Name,'"');
  20598. {$ENDIF}
  20599. if PendingSection=nil then
  20600. RaiseInternalError(20180305141421);
  20601. PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
  20602. dec(i);
  20603. if i>=ModuleScope.PendingResolvers.Count then
  20604. i:=ModuleScope.PendingResolvers.Count-1;
  20605. end;
  20606. end;
  20607. function TPasResolver.GetPendingUsedInterface(Section: TPasSection
  20608. ): TPasUsesUnit;
  20609. var
  20610. i: Integer;
  20611. UseUnit: TPasUsesUnit;
  20612. begin
  20613. Result:=nil;
  20614. for i:=0 to length(Section.UsesClause)-1 do
  20615. begin
  20616. UseUnit:=Section.UsesClause[i];
  20617. if not (UseUnit.Module is TPasModule) then continue;
  20618. if not IsUnitIntfFinished(TPasModule(UseUnit.Module)) then
  20619. exit(UseUnit);
  20620. end;
  20621. end;
  20622. function TPasResolver.CheckPendingUsedInterface(Section: TPasSection): boolean;
  20623. var
  20624. PendingModule: TPasModule;
  20625. PendingModuleScope: TPasModuleScope;
  20626. List: TFPList;
  20627. WasPending: Boolean;
  20628. begin
  20629. {$IFDEF VerbosePasResolver}
  20630. //writeln('TPasResolver.CheckPendingUsedInterface START "',RootElement.Name,'" Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
  20631. {$ENDIF}
  20632. WasPending:=Section.PendingUsedIntf<>nil;
  20633. if WasPending then
  20634. begin
  20635. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  20636. if not IsUnitIntfFinished(PendingModule) then
  20637. exit; // still pending
  20638. // other unit interface is finished
  20639. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20640. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" UnitIntf finished of "',PendingModule.Name,'"');
  20641. {$ENDIF}
  20642. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  20643. PendingModuleScope.PendingResolvers.Remove(Self);
  20644. Section.PendingUsedIntf:=nil;
  20645. end;
  20646. Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
  20647. //writeln('TPasResolver.CheckPendingUsedInterface ',GetObjName(RootElement),' Section=',GetObjName(Section),' PendingUsedIntf=',GetObjName(Section.PendingUsedIntf));
  20648. if Section.PendingUsedIntf<>nil then
  20649. begin
  20650. // module not yet finished due to pending used interfaces
  20651. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  20652. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  20653. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20654. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" waiting for unit intf of "',PendingModule.Name,'"');
  20655. {$ENDIF}
  20656. List:=PendingModuleScope.PendingResolvers;
  20657. if List.IndexOf(Self)<0 then
  20658. List.Add(Self);
  20659. Result:=not WasPending;
  20660. end
  20661. else
  20662. begin
  20663. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20664. {AllowWriteln}
  20665. if WasPending then
  20666. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" uses section complete: ',Section.ClassName);
  20667. {AllowWriteln-}
  20668. {$ENDIF}
  20669. Result:=WasPending;
  20670. if Result then
  20671. UsedInterfacesFinished(Section);
  20672. end;
  20673. end;
  20674. procedure TPasResolver.UsedInterfacesFinished(Section: TPasSection);
  20675. // if there is a unit cycle that stopped parsing this unit
  20676. // this method is called after the needed used unit interfaces have finished
  20677. begin
  20678. {$IFDEF VerbosePasResolver}
  20679. writeln('TPasResolver.UsesSectionFinished ',Section.ElementTypeName,' "',RootElement.Name,'"...');
  20680. {$ENDIF}
  20681. CurrentParser.ParseContinue;
  20682. if Section=nil then ;
  20683. end;
  20684. function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
  20685. // called by the parser when reading DoParseConstValueExpression
  20686. var
  20687. C: TClass;
  20688. V: TPasVariable;
  20689. TypeEl: TPasType;
  20690. begin
  20691. Result:=false;
  20692. if El=nil then exit;
  20693. C:=El.ClassType;
  20694. if (C=TPasConst) or (C=TPasVariable) then
  20695. begin
  20696. V:=TPasVariable(El);
  20697. if V.VarType=nil then exit;
  20698. TypeEl:=ResolveAliasType(V.VarType);
  20699. Result:=TypeEl.ClassType=TPasArrayType;
  20700. end;
  20701. //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
  20702. end;
  20703. function TPasResolver.GetDefaultClassVisibility(AClass: TPasClassType
  20704. ): TPasMemberVisibility;
  20705. var
  20706. ClassScope: TPasClassScope;
  20707. begin
  20708. if AClass.CustomData=nil then
  20709. exit(visDefault);
  20710. ClassScope:=(AClass.CustomData as TPasClassScope);
  20711. if pcsfPublished in ClassScope.Flags then
  20712. Result:=visPublished
  20713. else
  20714. Result:=visPublic;
  20715. end;
  20716. procedure TPasResolver.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  20717. Before: boolean; var Handled: boolean);
  20718. begin
  20719. inherited ModeChanged(Sender, NewMode, Before, Handled);
  20720. if not Before then
  20721. begin
  20722. if LastElement is TPasSection then
  20723. TPasSectionScope(LastElement.CustomData).ModeSwitches:=CurrentParser.CurrentModeswitches;
  20724. end;
  20725. end;
  20726. class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
  20727. Line, Column: integer);
  20728. begin
  20729. Line:=Linenumber;
  20730. Column:=0;
  20731. if Line<0 then begin
  20732. Line:=-Line;
  20733. Column:=Line mod ParserMaxEmbeddedColumn;
  20734. Line:=Line div ParserMaxEmbeddedColumn;
  20735. end;
  20736. end;
  20737. class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
  20738. var
  20739. Line, Column: integer;
  20740. begin
  20741. if El=nil then exit('nil');
  20742. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  20743. Result:=El.SourceFilename+'('+IntToStr(Line);
  20744. if Column>0 then
  20745. Result:=Result+','+IntToStr(Column);
  20746. Result:=Result+')';
  20747. end;
  20748. function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
  20749. var
  20750. Line, Column: integer;
  20751. begin
  20752. if El=nil then exit('nil');
  20753. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  20754. if (Line=0) then
  20755. begin
  20756. if El is TPasUnresolvedSymbolRef then
  20757. exit('intrinsic');
  20758. end;
  20759. Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
  20760. if Column>0 then
  20761. Result:=Result+','+IntToStr(Column);
  20762. Result:=Result+')';
  20763. end;
  20764. destructor TPasResolver.Destroy;
  20765. begin
  20766. {$IFDEF VerbosePasResolverMem}
  20767. writeln('TPasResolver.Destroy START ',ClassName);
  20768. {$ENDIF}
  20769. Clear;
  20770. {$IFDEF VerbosePasResolverMem}
  20771. writeln('TPasResolver.Destroy PopScope...');
  20772. {$ENDIF}
  20773. PopScope; // free default scope
  20774. {$IFDEF VerbosePasResolverMem}
  20775. writeln('TPasResolver.Destroy FPendingForwards...');
  20776. {$ENDIF}
  20777. FreeAndNil(FPendingForwardProcs);
  20778. FreeAndNil(fExprEvaluator);
  20779. ClearBuiltInIdentifiers;
  20780. inherited Destroy;
  20781. {$IFDEF VerbosePasResolverMem}
  20782. writeln('TPasResolver.Destroy END ',ClassName);
  20783. {$ENDIF}
  20784. end;
  20785. procedure TPasResolver.Clear;
  20786. begin
  20787. ClearHelperList(FActiveHelpers);
  20788. RestoreStashedScopes(0);
  20789. // clear stack, keep DefaultScope
  20790. while (FScopeCount>0) and (FTopScope<>DefaultScope) do
  20791. PopScope;
  20792. ClearResolveDataList(lkModule);
  20793. end;
  20794. procedure TPasResolver.ClearBuiltInIdentifiers;
  20795. var
  20796. bt: TResolverBaseType;
  20797. bp: TResolverBuiltInProc;
  20798. begin
  20799. ClearResolveDataList(lkBuiltIn);
  20800. for bt in TResolverBaseType do
  20801. ReleaseAndNil(TPasElement(FBaseTypes[bt]){$IFDEF CheckPasTreeRefCount},'TPasResolver.AddBaseType'{$ENDIF});
  20802. for bp in TResolverBuiltInProc do
  20803. FBuiltInProcs[bp]:=nil;
  20804. end;
  20805. procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
  20806. const TheBaseTypes: TResolveBaseTypes;
  20807. const TheBaseProcs: TResolverBuiltInProcs);
  20808. var
  20809. bt: TResolverBaseType;
  20810. begin
  20811. for bt in TheBaseTypes do
  20812. AddBaseType(BaseTypeNames[bt],bt);
  20813. if bfLength in TheBaseProcs then
  20814. AddBuiltInProc('Length','function Length(const String or Array): sizeint',
  20815. @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
  20816. @BI_Length_OnEval,nil,bfLength);
  20817. if bfSetLength in TheBaseProcs then
  20818. AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
  20819. @BI_SetLength_OnGetCallCompatibility,nil,nil,
  20820. @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
  20821. if bfInclude in TheBaseProcs then
  20822. AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
  20823. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20824. @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
  20825. if bfExclude in TheBaseProcs then
  20826. AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
  20827. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20828. @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
  20829. if bfBreak in TheBaseProcs then
  20830. AddBuiltInProc('Break','procedure Break',
  20831. @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
  20832. if bfContinue in TheBaseProcs then
  20833. AddBuiltInProc('Continue','procedure Continue',
  20834. @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
  20835. if bfExit in TheBaseProcs then
  20836. AddBuiltInProc('Exit','procedure Exit(result)',
  20837. @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
  20838. if bfInc in TheBaseProcs then
  20839. AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
  20840. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20841. @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
  20842. if bfDec in TheBaseProcs then
  20843. AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
  20844. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20845. @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
  20846. if bfAssigned in TheBaseProcs then
  20847. AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
  20848. @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
  20849. nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
  20850. if bfChr in TheBaseProcs then
  20851. AddBuiltInProc('Chr','function Chr(const Integer): char',
  20852. @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,
  20853. @BI_Chr_OnEval,nil,bfChr);
  20854. if bfOrd in TheBaseProcs then
  20855. AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
  20856. @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
  20857. @BI_Ord_OnEval,nil,bfOrd);
  20858. if bfLow in TheBaseProcs then
  20859. AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
  20860. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20861. @BI_LowHigh_OnEval,nil,bfLow);
  20862. if bfHigh in TheBaseProcs then
  20863. AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
  20864. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20865. @BI_LowHigh_OnEval,nil,bfHigh);
  20866. if bfPred in TheBaseProcs then
  20867. AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
  20868. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20869. @BI_PredSucc_OnEval,nil,bfPred);
  20870. if bfSucc in TheBaseProcs then
  20871. AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
  20872. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20873. @BI_PredSucc_OnEval,nil,bfSucc);
  20874. if bfStrProc in TheBaseProcs then
  20875. AddBuiltInProc('Str','procedure Str(const var; var String)',
  20876. @BI_StrProc_OnGetCallCompatibility,nil,nil,
  20877. @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
  20878. if bfStrFunc in TheBaseProcs then
  20879. AddBuiltInProc('Str','function Str(const var): String',
  20880. @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
  20881. @BI_StrFunc_OnEval,nil,bfStrFunc);
  20882. if bfWriteStr in TheBaseProcs then
  20883. AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
  20884. @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
  20885. @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
  20886. if bfVal in TheBaseProcs then
  20887. AddBuiltInProc('Val','procedure Val(const String; var Value: bool|int|float|enum; out Int)',
  20888. @BI_Val_OnGetCallCompatibility,nil,nil,
  20889. @BI_Val_OnFinishParamsExpr,bfVal,[bipfCanBeStatement]);
  20890. if bfLo in TheBaseProcs then
  20891. AddBuiltInProc('Lo','function Lo(X: any integer type): Byte|Word)',
  20892. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20893. @BI_LoHi_OnEval,nil,bfLo);
  20894. if bfHi in TheBaseProcs then
  20895. AddBuiltInProc('Hi','function Hi(X: any integer type): Byte|Word)',
  20896. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20897. @BI_LoHi_OnEval,nil,bfHi);
  20898. if bfConcatArray in TheBaseProcs then
  20899. AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
  20900. @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
  20901. nil,nil,bfConcatArray);
  20902. if bfConcatString in TheBaseProcs then
  20903. AddBuiltInProc('Concat','function Concat(const String1, String2, ...): String',
  20904. @BI_ConcatString_OnGetCallCompatibility,@BI_ConcatString_OnGetCallResult,
  20905. @BI_ConcatString_OnEval,nil,bfConcatString);
  20906. if bfCopyArray in TheBaseProcs then
  20907. AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
  20908. @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
  20909. nil,nil,bfCopyArray);
  20910. if bfInsertArray in TheBaseProcs then
  20911. AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
  20912. @BI_InsertArray_OnGetCallCompatibility,nil,nil,
  20913. @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
  20914. if bfDeleteArray in TheBaseProcs then
  20915. AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
  20916. @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
  20917. @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
  20918. if bfTypeInfo in TheBaseProcs then
  20919. AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
  20920. @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
  20921. nil,nil,bfTypeInfo);
  20922. if bfGetTypeKind in TheBaseProcs then
  20923. AddBuiltInProc('GetTypeKind','function GetTypeKind(type or var identifier): System.TTypeKind',
  20924. @BI_GetTypeKind_OnGetCallCompatibility,@BI_GetTypeKind_OnGetCallResult,
  20925. @BI_GetTypeKind_OnEval,nil,bfGetTypeKind);
  20926. if bfAssert in TheBaseProcs then
  20927. AddBuiltInProc('Assert','procedure Assert(bool[,string])',
  20928. @BI_Assert_OnGetCallCompatibility,nil,nil,
  20929. @BI_Assert_OnFinishParamsExpr,bfAssert,[bipfCanBeStatement]);
  20930. if bfNew in TheBaseProcs then
  20931. AddBuiltInProc('New','procedure New(out ^record)',
  20932. @BI_New_OnGetCallCompatibility,nil,nil,
  20933. @BI_New_OnFinishParamsExpr,bfNew,[bipfCanBeStatement]);
  20934. if bfDispose in TheBaseProcs then
  20935. AddBuiltInProc('Dispose','procedure Dispose(var ^record)',
  20936. @BI_Dispose_OnGetCallCompatibility,nil,nil,
  20937. @BI_Dispose_OnFinishParamsExpr,bfDispose,[bipfCanBeStatement]);
  20938. if bfDefault in TheBaseProcs then
  20939. AddBuiltInProc('Default','function Default(T): T',
  20940. @BI_Default_OnGetCallCompatibility,@BI_Default_OnGetCallResult,
  20941. @BI_Default_OnEval,nil,bfDefault,[]);
  20942. end;
  20943. function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
  20944. ): TResElDataBaseType;
  20945. var
  20946. El: TPasUnresolvedSymbolRef;
  20947. begin
  20948. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20949. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TPasResolver.AddBaseType');{$ENDIF}
  20950. if not (Typ in [btNone,btCustom]) then
  20951. FBaseTypes[Typ]:=El;
  20952. Result:=TResElDataBaseType.Create;
  20953. Result.BaseType:=Typ;
  20954. AddResolveData(El,Result,lkBuiltIn);
  20955. FDefaultScope.AddIdentifier(aName,El,pikBaseType);
  20956. end;
  20957. function TPasResolver.AddCustomBaseType(const aName: string;
  20958. aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  20959. var
  20960. CustomData: TResElDataBaseType;
  20961. begin
  20962. Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20963. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('TPasResolver.AddCustomBaseType');{$ENDIF}
  20964. CustomData:=aClass.Create;
  20965. CustomData.BaseType:=btCustom;
  20966. AddResolveData(Result,CustomData,lkBuiltIn);
  20967. FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
  20968. end;
  20969. function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
  20970. ResolveAlias: boolean): boolean;
  20971. begin
  20972. Result:=false;
  20973. if aType=nil then exit;
  20974. if ResolveAlias then
  20975. aType:=ResolveAliasType(aType);
  20976. if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
  20977. Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
  20978. end;
  20979. function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
  20980. const GetCallCompatibility: TOnGetCallCompatibility;
  20981. const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
  20982. const FinishParamsExpr: TOnFinishParamsExpr;
  20983. const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
  20984. ): TResElDataBuiltInProc;
  20985. var
  20986. El: TPasUnresolvedSymbolRef;
  20987. begin
  20988. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20989. Result:=TResElDataBuiltInProc.Create;
  20990. Result.Proc:=El;
  20991. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TResElDataBuiltInProc.Proc');{$ENDIF}
  20992. Result.Signature:=Signature;
  20993. Result.BuiltIn:=BuiltIn;
  20994. Result.GetCallCompatibility:=GetCallCompatibility;
  20995. Result.GetCallResult:=GetCallResult;
  20996. Result.Eval:=EvalConst;
  20997. Result.FinishParamsExpression:=FinishParamsExpr;
  20998. Result.Flags:=Flags;
  20999. AddResolveData(El,Result,lkBuiltIn);
  21000. FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
  21001. if BuiltIn<>bfCustom then
  21002. FBuiltInProcs[BuiltIn]:=Result;
  21003. end;
  21004. procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
  21005. Kind: TResolveDataListKind);
  21006. begin
  21007. if Data.Element<>nil then
  21008. RaiseInternalError(20171111162227);
  21009. if El.CustomData<>nil then
  21010. RaiseInternalError(20171111162236);
  21011. Data.Element:=El;
  21012. Data.Owner:=Self;
  21013. Data.Next:=FLastCreatedData[Kind];
  21014. FLastCreatedData[Kind]:=Data;
  21015. El.CustomData:=Data;
  21016. end;
  21017. function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
  21018. Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
  21019. procedure RaiseAlreadySet;
  21020. var
  21021. FormerDeclEl: TPasElement;
  21022. begin
  21023. {AllowWriteln}
  21024. writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  21025. writeln(' RefEl at ',GetElementSourcePosStr(RefEl));
  21026. writeln(' RefEl.CustomData=',GetObjName(RefEl.CustomData));
  21027. if RefEl.CustomData is TResolvedReference then
  21028. begin
  21029. FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
  21030. writeln(' TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
  21031. ' IsSame=',FormerDeclEl=DeclEl);
  21032. end;
  21033. {AllowWriteln-}
  21034. RaiseInternalError(20160922163554,'customdata<>nil');
  21035. end;
  21036. begin
  21037. if RefEl.CustomData<>nil then
  21038. RaiseAlreadySet;
  21039. {$IFDEF VerbosePasResolver}
  21040. writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  21041. {$ENDIF}
  21042. Result:=TResolvedReference.Create;
  21043. if FindData<>nil then
  21044. begin
  21045. if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
  21046. Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
  21047. end;
  21048. AddResolveData(RefEl,Result,lkModule);
  21049. Result.Declaration:=DeclEl;
  21050. if RefEl is TPasExpr then
  21051. SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
  21052. EmitElementHints(RefEl,DeclEl);
  21053. end;
  21054. procedure TPasResolver.WriteScopesShort(Title: string);
  21055. var
  21056. i: Integer;
  21057. begin
  21058. {AllowWriteln}
  21059. writeln(Title,' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  21060. for i:=0 to FScopeCount-1 do
  21061. writeln(' ',i,'/',FScopeCount,' ',GetObjName(FScopes[i]));
  21062. {AllowWriteln-}
  21063. end;
  21064. function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
  21065. ): TPasScope;
  21066. begin
  21067. if not ScopeClass.IsStoredInElement then
  21068. RaiseInternalError(20160923121858);
  21069. if El.CustomData<>nil then
  21070. RaiseInternalError(20160923121849);
  21071. {$IFDEF VerbosePasResolver}
  21072. writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
  21073. {$ENDIF}
  21074. Result:=ScopeClass.Create;
  21075. if Result.FreeOnPop then
  21076. begin
  21077. Result.Element:=El;
  21078. El.CustomData:=Result;
  21079. Result.Owner:=Self;
  21080. end
  21081. else
  21082. // add to free list
  21083. AddResolveData(El,Result,lkModule);
  21084. end;
  21085. function TPasResolver.CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean
  21086. ): TPasGroupScope;
  21087. begin
  21088. Result:=TPasGroupScope.Create;
  21089. Result.Element:=HiType;
  21090. GroupScope_AddTypeAndAncestors(Result,HiType,WithTopHelpers);
  21091. end;
  21092. procedure TPasResolver.GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope;
  21093. HiType: TPasType; WithTopHelpers: boolean);
  21094. var
  21095. IsClass: Boolean;
  21096. i: Integer;
  21097. Entry: TPRHelperEntry;
  21098. HelperForType, LoType: TPasType;
  21099. AncestorScope, HelperScope: TPasClassScope;
  21100. C: TClass;
  21101. begin
  21102. HiType:=ResolveAliasType(HiType,false);
  21103. LoType:=ResolveAliasType(HiType);
  21104. IsClass:=LoType.ClassType=TPasClassType;
  21105. if IsClass and (TPasClassType(LoType).HelperForType<>nil) then
  21106. begin
  21107. // start in a helper
  21108. WithTopHelpers:=false;
  21109. // first add helper and its ancestors
  21110. HelperScope:=TPasClassScope(LoType.CustomData);
  21111. while HelperScope<>nil do
  21112. begin
  21113. Scope.Add(HelperScope);
  21114. HelperScope:=HelperScope.AncestorScope;
  21115. end;
  21116. // then add the HelperForType and its ancestors
  21117. HiType:=ResolveAliasType(TPasClassType(HiType).HelperForType,false);
  21118. LoType:=ResolveAliasType(HiType);
  21119. IsClass:=LoType.ClassType=TPasClassType;
  21120. end;
  21121. repeat
  21122. // first add helper(s)
  21123. if WithTopHelpers then
  21124. begin
  21125. for i:=length(FActiveHelpers)-1 downto 0 do
  21126. begin
  21127. Entry:=FActiveHelpers[i];
  21128. HelperForType:=Entry.HelperForType;
  21129. if IsSameType(HelperForType,HiType,prraNone) then
  21130. begin
  21131. // add Helper and its ancestors
  21132. HelperScope:=TPasClassScope(Entry.Helper.CustomData);
  21133. while HelperScope<>nil do
  21134. begin
  21135. Scope.Add(HelperScope);
  21136. HelperScope:=HelperScope.AncestorScope;
  21137. end;
  21138. if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
  21139. break;
  21140. end;
  21141. end;
  21142. end
  21143. else
  21144. WithTopHelpers:=true;
  21145. // then add scope of LoType
  21146. C:=LoType.ClassType;
  21147. if (C=TPasClassType) or (C=TPasRecordType) then
  21148. Scope.Add(LoType.CustomData as TPasIdentifierScope);
  21149. // continue with ancestor
  21150. if not IsClass then break;
  21151. AncestorScope:=(LoType.CustomData as TPasClassScope).AncestorScope;
  21152. if AncestorScope=nil then break;
  21153. HiType:=TPasClassType(AncestorScope.Element);
  21154. LoType:=HiType;
  21155. until LoType=nil;
  21156. end;
  21157. procedure TPasResolver.PopScope;
  21158. var
  21159. Scope: TPasScope;
  21160. begin
  21161. if FScopeCount=0 then
  21162. RaiseInternalError(20160922163557);
  21163. {$IFDEF VerbosePasResolver}
  21164. {AllowWriteln}
  21165. //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
  21166. writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
  21167. {AllowWriteln-}
  21168. {$ENDIF}
  21169. dec(FScopeCount);
  21170. if FTopScope.FreeOnPop then
  21171. begin
  21172. Scope:=FScopes[FScopeCount];
  21173. if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
  21174. Scope.Element.CustomData:=nil;
  21175. if Scope=FDefaultScope then
  21176. FDefaultScope:=nil;
  21177. FScopes[FScopeCount]:=nil;
  21178. Scope.Free;
  21179. end;
  21180. if FScopeCount>0 then
  21181. FTopScope:=FScopes[FScopeCount-1]
  21182. else
  21183. FTopScope:=nil;
  21184. end;
  21185. procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
  21186. var
  21187. WithScope: TPasWithScope;
  21188. i: Integer;
  21189. begin
  21190. WithScope:=El.CustomData as TPasWithScope;
  21191. for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
  21192. begin
  21193. CheckTopScope(ScopeClass_WithExpr);
  21194. if TopScope<>WithScope.ExpressionScopes[i] then
  21195. RaiseInternalError(20160923102846);
  21196. PopScope;
  21197. end;
  21198. CheckTopScope(TPasWithScope);
  21199. PopScope;
  21200. end;
  21201. procedure TPasResolver.PopGenericParamScope(El: TPasGenericType);
  21202. var
  21203. TemplType: TPasGenericTemplateType;
  21204. begin
  21205. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  21206. begin
  21207. TemplType:=TPasGenericTemplateType(El.GenericTemplateTypes[0]);
  21208. if not (TopScope is TPasGenericParamsScope) then
  21209. RaiseNotYetImplemented(20190831204109,El,GetObjName(TopScope));
  21210. if TopScope.Element<>TemplType then
  21211. RaiseNotYetImplemented(20190831204134,El,GetObjName(TopScope.Element));
  21212. PopScope;
  21213. end
  21214. else
  21215. begin
  21216. if TopScope is TPasGenericParamsScope then
  21217. RaiseNotYetImplemented(20190831204213,El,GetObjName(TopScope.Element));
  21218. end;
  21219. end;
  21220. procedure TPasResolver.PushScope(Scope: TPasScope);
  21221. begin
  21222. if Scope=nil then
  21223. RaiseInternalError(20160922163601);
  21224. if length(FScopes)=FScopeCount then
  21225. SetLength(FScopes,FScopeCount*2+10);
  21226. FScopes[FScopeCount]:=Scope;
  21227. inc(FScopeCount);
  21228. FTopScope:=Scope;
  21229. {$IFDEF VerbosePasResolver}
  21230. writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
  21231. {$ENDIF}
  21232. end;
  21233. function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
  21234. ): TPasScope;
  21235. begin
  21236. Result:=CreateScope(El,ScopeClass);
  21237. PushScope(Result);
  21238. end;
  21239. function TPasResolver.PushGroupScope(HiType: TPasType): TPasGroupScope;
  21240. begin
  21241. Result:=CreateGroupScope(HiType);
  21242. PushScope(Result);
  21243. end;
  21244. function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  21245. begin
  21246. Result:=TPasModuleDotScope.Create;
  21247. Result.Owner:=Self;
  21248. Result.Module:=aModule;
  21249. if aModule is TPasProgram then
  21250. begin // program
  21251. if TPasProgram(aModule).ProgramSection<>nil then
  21252. Result.InterfaceScope:=
  21253. NoNil(TPasProgram(aModule).ProgramSection.CustomData) as TPasSectionScope;
  21254. end
  21255. else if aModule is TPasLibrary then
  21256. begin // library
  21257. if TPasLibrary(aModule).LibrarySection<>nil then
  21258. Result.InterfaceScope:=
  21259. NoNil(TPasLibrary(aModule).LibrarySection.CustomData) as TPasSectionScope;
  21260. end
  21261. else
  21262. begin // unit
  21263. if aModule.InterfaceSection<>nil then
  21264. Result.InterfaceScope:=
  21265. NoNil(aModule.InterfaceSection.CustomData) as TPasSectionScope;
  21266. if (aModule=RootElement)
  21267. and (aModule.ImplementationSection<>nil)
  21268. and (aModule.ImplementationSection.CustomData<>nil)
  21269. then
  21270. Result.ImplementationScope:=NoNil(aModule.ImplementationSection.CustomData) as TPasSectionScope;
  21271. if CompareText(aModule.Name,'system')=0 then
  21272. Result.SystemScope:=DefaultScope;
  21273. end;
  21274. PushScope(Result);
  21275. end;
  21276. function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType;
  21277. WithTopHelpers: boolean): TPasDotClassScope;
  21278. var
  21279. ClassScope: TPasClassScope;
  21280. Ref: TResolvedReference;
  21281. begin
  21282. if CurClassType.IsForward then
  21283. begin
  21284. Ref:=CurClassType.CustomData as TResolvedReference;
  21285. CurClassType:=Ref.Declaration as TPasClassType;
  21286. end;
  21287. if CurClassType.CustomData=nil then
  21288. RaiseInternalError(20160922163611);
  21289. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  21290. Result:=TPasDotClassScope.Create;
  21291. Result.Owner:=Self;
  21292. Result.ClassRecScope:=ClassScope;
  21293. Result.GroupScope:=CreateGroupScope(CurClassType,WithTopHelpers);
  21294. PushScope(Result);
  21295. end;
  21296. function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  21297. var
  21298. RecScope: TPasRecordScope;
  21299. begin
  21300. RecScope:=NoNil(CurRecordType.CustomData) as TPasRecordScope;
  21301. Result:=TPasDotClassOrRecordScope.Create;
  21302. Result.Owner:=Self;
  21303. Result.ClassRecScope:=RecScope;
  21304. Result.GroupScope:=CreateGroupScope(CurRecordType);
  21305. PushScope(Result);
  21306. end;
  21307. function TPasResolver.PushInheritedScope(ClassOrRec: TPasMembersType;
  21308. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  21309. begin
  21310. Result:=TPasInheritedScope.Create;
  21311. Result.Owner:=Self;
  21312. Result.ClassRecScope:=NoNil(ClassOrRec.CustomData) as TPasClassOrRecordScope;
  21313. Result.AncestorScope:=AncestorScope;
  21314. Result.GroupScope:=CreateGroupScope(ClassOrRec,WithTopHelpers);
  21315. PushScope(Result);
  21316. end;
  21317. function TPasResolver.PushEnumDotScope(HiType: TPasType;
  21318. EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  21319. begin
  21320. Result:=TPasDotEnumTypeScope.Create;
  21321. Result.Owner:=Self;
  21322. Result.EnumScope:=NoNil(EnumLoType.CustomData) as TPasEnumTypeScope;
  21323. Result.GroupScope:=CreateGroupScope(HiType);
  21324. PushScope(Result);
  21325. end;
  21326. function TPasResolver.PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  21327. var
  21328. Group: TPasGroupScope;
  21329. begin
  21330. Group:=CreateGroupScope(HiType);
  21331. if Group.Count=0 then
  21332. begin
  21333. Group.Free;
  21334. exit(nil);
  21335. end;
  21336. Result:=TPasDotHelperScope.Create;
  21337. Result.Element:=HiType;
  21338. Result.Owner:=Self;
  21339. Result.GroupScope:=Group;
  21340. PushScope(Result);
  21341. end;
  21342. function TPasResolver.PushTemplateDotScope(TemplType: TPasGenericTemplateType;
  21343. ErrorEl: TPasElement): TPasDotBaseScope;
  21344. procedure PushConstraintScope(ConEl: TPasElement);
  21345. var
  21346. ConToken: TToken;
  21347. DotClassScope: TPasDotClassScope;
  21348. MemberType: TPasMembersType;
  21349. GenTempl: TPasGenericTemplateType;
  21350. aClass: TPasClassType;
  21351. aConstructor: TPasConstructor;
  21352. i: Integer;
  21353. ResolvedEl: TPasResolverResult;
  21354. begin
  21355. ConToken:=GetGenericConstraintKeyword(ConEl);
  21356. case ConToken of
  21357. tkrecord: ;
  21358. tkclass, tkconstructor:
  21359. begin
  21360. if Result<>nil then
  21361. RaiseNotYetImplemented(20190831005217,TemplType);
  21362. if not FindSystemClassTypeAndConstructor('system','tobject',aClass,aConstructor,ErrorEl) then
  21363. RaiseIdentifierNotFound(20190831002421,'system.TObject.Create()',ErrorEl);
  21364. DotClassScope:=TPasDotClassScope.Create;
  21365. Result:=DotClassScope;
  21366. PushScope(Result);
  21367. DotClassScope.Owner:=Self;
  21368. DotClassScope.ClassRecScope:=aClass.CustomData as TPasClassScope;
  21369. Result.GroupScope:=CreateGroupScope(aClass,false);
  21370. end;
  21371. else
  21372. if not (ConEl is TPasType) then
  21373. RaiseNotYetImplemented(20190914070842,TemplType,GetObjName(ConEl));
  21374. ComputeElement(ConEl,ResolvedEl,[rcType]);
  21375. if ResolvedEl.BaseType<>btContext then
  21376. RaiseNotYetImplemented(20190915183241,ConEl);
  21377. if ResolvedEl.IdentEl=nil then
  21378. RaiseNotYetImplemented(20190831214135,ConEl);
  21379. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  21380. begin
  21381. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  21382. if ConEl.HasParent(GenTempl) then
  21383. RaiseNotYetImplemented(20190831214258,ConEl);
  21384. for i:=0 to length(GenTempl.Constraints)-1 do
  21385. PushConstraintScope(GenTempl.Constraints[i]);
  21386. end
  21387. else if ResolvedEl.LoTypeEl is TPasMembersType then
  21388. begin
  21389. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  21390. if Result=nil then
  21391. begin
  21392. DotClassScope:=TPasDotClassScope.Create;
  21393. Result:=DotClassScope;
  21394. PushScope(Result);
  21395. DotClassScope.Owner:=Self;
  21396. DotClassScope.ClassRecScope:=MemberType.CustomData as TPasClassScope;
  21397. Result.GroupScope:=CreateGroupScope(ResolvedEl.HiTypeEl,false);
  21398. end
  21399. else
  21400. GroupScope_AddTypeAndAncestors(Result.GroupScope,MemberType,false);
  21401. end
  21402. else
  21403. RaiseNotYetImplemented(20190831001450, ConEl);
  21404. end;
  21405. end;
  21406. var
  21407. i: Integer;
  21408. begin
  21409. Result:=nil;
  21410. for i:=0 to length(TemplType.Constraints)-1 do
  21411. PushConstraintScope(TemplType.Constraints[i]);
  21412. end;
  21413. function TPasResolver.PushDotScope(HiType: TPasType): TPasDotBaseScope;
  21414. var
  21415. C: TClass;
  21416. LoType: TPasType;
  21417. begin
  21418. LoType:=ResolveAliasType(HiType);
  21419. C:=LoType.ClassType;
  21420. if C=TPasClassType then
  21421. Result:=PushClassDotScope(TPasClassType(LoType))
  21422. else if C=TPasRecordType then
  21423. Result:=PushRecordDotScope(TPasRecordType(LoType))
  21424. else if C=TPasEnumType then
  21425. Result:=PushEnumDotScope(HiType,TPasEnumType(LoType))
  21426. else if C=TPasGenericTemplateType then
  21427. Result:=PushTemplateDotScope(TPasGenericTemplateType(LoType),HiType)
  21428. else
  21429. Result:=PushHelperDotScope(HiType);
  21430. end;
  21431. function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  21432. var
  21433. WithEl: TPasImplWithDo;
  21434. WithScope: TPasWithScope;
  21435. ExprResolved: TPasResolverResult;
  21436. ErrorEl: TPasExpr;
  21437. LoType, HiType, DestType: TPasType;
  21438. ExprScope: TPasGroupScope;
  21439. ClassEl: TPasClassType;
  21440. WithExprScope: TPasWithExprScope;
  21441. Flags: TPasWithExprScopeFlags;
  21442. ClassRecScope: TPasClassOrRecordScope;
  21443. begin
  21444. if not (Expr.Parent is TPasImplWithDo) then
  21445. RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
  21446. WithEl:=TPasImplWithDo(Expr.Parent);
  21447. if not (WithEl.CustomData is TPasWithScope) then
  21448. RaiseInternalError(20181210175526);
  21449. WithScope:=TPasWithScope(WithEl.CustomData);
  21450. ResolveExpr(Expr,rraRead);
  21451. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  21452. {$IFDEF VerbosePasResolver}
  21453. writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
  21454. {$ENDIF}
  21455. ErrorEl:=Expr;
  21456. HiType:=ExprResolved.HiTypeEl;
  21457. LoType:=ExprResolved.LoTypeEl;
  21458. // ToDo: use last element in Expr for error position
  21459. if LoType=nil then
  21460. RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21461. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  21462. if (ExprResolved.BaseType in btAllIntrinsicTypes) then
  21463. // ok
  21464. else if (ExprResolved.BaseType=btContext) then
  21465. // ok
  21466. else
  21467. RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21468. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  21469. Flags:=[];
  21470. CheckUseAsType(LoType,20190123113957,Expr);
  21471. ClassRecScope:=nil;
  21472. ExprScope:=nil;
  21473. if LoType.ClassType=TPasClassOfType then
  21474. begin
  21475. // e.g. with ImageClass do FindHandlerFromExtension()
  21476. DestType:=TPasClassOfType(LoType).DestType;
  21477. ClassEl:=ResolveAliasType(DestType) as TPasClassType;
  21478. ExprScope:=CreateGroupScope(DestType);
  21479. ClassRecScope:=TPasClassOrRecordScope(ClassEl.CustomData);
  21480. Include(Flags,wesfOnlyTypeMembers);
  21481. Include(Flags,wesfIsClassOf);
  21482. end
  21483. else if LoType is TPasMembersType then
  21484. ClassRecScope:=TPasClassOrRecordScope(LoType.CustomData);
  21485. if ExprScope=nil then
  21486. begin
  21487. ExprScope:=CreateGroupScope(HiType);
  21488. if ExprScope.Count=0 then
  21489. begin
  21490. ExprScope.Free;
  21491. RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21492. [GetElementTypeName(LoType)],ErrorEl);
  21493. end;
  21494. if ExprResolved.IdentEl is TPasType then
  21495. // e.g. with TPoint do PointInCircle
  21496. Include(Flags,wesfOnlyTypeMembers);
  21497. end;
  21498. WithExprScope:=ScopeClass_WithExpr.Create;
  21499. WithExprScope.WithScope:=WithScope;
  21500. WithExprScope.Index:=WithEl.Expressions.Count;
  21501. WithExprScope.Expr:=Expr;
  21502. WithExprScope.Scope:=ExprScope;
  21503. WithExprScope.ClassRecScope:=ClassRecScope;
  21504. if not (ExprResolved.IdentEl is TPasType) then
  21505. Include(Flags,wesfNeedTmpVar);
  21506. if (not (rrfWritable in ExprResolved.Flags))
  21507. and (ExprResolved.BaseType=btContext)
  21508. and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
  21509. Include(Flags,wesfConstParent);
  21510. WithExprScope.Flags:=Flags;
  21511. WithScope.ExpressionScopes.Add(WithExprScope);
  21512. PushScope(WithExprScope);
  21513. Result:=WithExprScope;
  21514. end;
  21515. function TPasResolver.StashScopes(NewScopeCnt: integer): integer;
  21516. begin
  21517. Result:=FStashScopeCount;
  21518. if NewScopeCnt>ScopeCount then
  21519. RaiseInternalError(20190728125505);
  21520. while ScopeCount>NewScopeCnt do
  21521. begin
  21522. {$IFDEF VerbosePasResolver}
  21523. writeln('TPasResolver.StashScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  21524. {$ENDIF}
  21525. if FStashScopeCount=length(FStashScopes) then
  21526. SetLength(FStashScopes,FStashScopeCount+4);
  21527. FStashScopes[FStashScopeCount]:=TopScope;
  21528. inc(FStashScopeCount);
  21529. dec(FScopeCount);
  21530. FScopes[FScopeCount]:=nil;
  21531. if FScopeCount>0 then
  21532. FTopScope:=FScopes[FScopeCount-1]
  21533. else
  21534. FTopScope:=nil;
  21535. end;
  21536. end;
  21537. function TPasResolver.StashSubExprScopes: integer;
  21538. // move all subexpr scopes from Scopes to StashScopes
  21539. var
  21540. NewScopeCnt: Integer;
  21541. begin
  21542. NewScopeCnt:=FScopeCount;
  21543. while (NewScopeCnt>0) and (FScopes[NewScopeCnt-1] is TPasSubExprScope) do
  21544. dec(NewScopeCnt);
  21545. Result:=StashScopes(NewScopeCnt);
  21546. end;
  21547. procedure TPasResolver.RestoreStashedScopes(StashDepth: integer);
  21548. // restore sub scopes
  21549. begin
  21550. while FStashScopeCount>StashDepth do
  21551. begin
  21552. {$IFDEF VerbosePasResolver}
  21553. writeln('TPasResolver.RestoreStashScopes moving ',FStashScopes[FStashScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  21554. {$ENDIF}
  21555. if FScopeCount=length(FScopes) then
  21556. SetLength(FScopes,FScopeCount+4);
  21557. dec(FStashScopeCount);
  21558. FScopes[FScopeCount]:=FStashScopes[FStashScopeCount];
  21559. FTopScope:=FScopes[FScopeCount];
  21560. FStashScopes[FStashScopeCount]:=nil;
  21561. inc(FScopeCount);
  21562. end;
  21563. end;
  21564. procedure TPasResolver.DeleteScope(Index: integer);
  21565. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  21566. procedure Delete(var A: TPasScopeArray; Index, Count: integer); overload;
  21567. var
  21568. i: Integer;
  21569. begin
  21570. if Index<0 then
  21571. raise Exception.Create('20191014232344');
  21572. if Index+Count>length(A) then
  21573. raise Exception.Create('20191014232345');
  21574. for i:=Index+Count to length(A)-1 do
  21575. A[i-Count]:=A[i];
  21576. SetLength(A,length(A)-Count);
  21577. end;
  21578. {$ENDIF}
  21579. begin
  21580. Delete(FScopes,Index,1);
  21581. dec(FScopeCount);
  21582. end;
  21583. procedure TPasResolver.InsertScope(Scope: TPasScope; Index: integer);
  21584. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  21585. procedure Insert(Item: TPasScope; var A: TPasScopeArray; Index: integer); overload;
  21586. var
  21587. i: Integer;
  21588. begin
  21589. if Index<0 then
  21590. raise Exception.Create('20191014232355');
  21591. if Index>length(A) then
  21592. raise Exception.Create('20191014232356');
  21593. SetLength(A,length(A)+1);
  21594. for i:=length(A)-1 downto Index+1 do
  21595. A[i]:=A[i-1];
  21596. A[Index]:=Item;
  21597. end;
  21598. {$ENDIF}
  21599. begin
  21600. Insert(Scope,FScopes,Index);
  21601. inc(FScopeCount);
  21602. end;
  21603. function TPasResolver.GetCurrentProcScope(ErrorEl: TPasElement
  21604. ): TPasProcedureScope;
  21605. var
  21606. Scope: TPasScope;
  21607. i: Integer;
  21608. begin
  21609. i:=ScopeCount;
  21610. repeat
  21611. dec(i);
  21612. if i<0 then
  21613. RaiseMsg(20171006001229,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  21614. Scope:=Scopes[i];
  21615. if Scope is TPasProcedureScope then
  21616. exit(TPasProcedureScope(Scope));
  21617. until false;
  21618. Result:=nil;
  21619. end;
  21620. function TPasResolver.GetProcScope(El: TPasElement): TPasProcedureScope;
  21621. var
  21622. CurEl: TPasElement;
  21623. begin
  21624. CurEl:=El;
  21625. while CurEl<>nil do
  21626. begin
  21627. if CurEl is TPasProcedure then
  21628. exit(TPasProcedureScope(CurEl.CustomData));
  21629. CurEl:=CurEl.Parent;
  21630. end;
  21631. Result:=nil;
  21632. end;
  21633. function TPasResolver.GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  21634. begin
  21635. Result:=GetCurrentProcScope(ErrorEl);
  21636. Result:=Result.GetSelfScope;
  21637. end;
  21638. function TPasResolver.GetSelfScope(El: TPasElement): TPasProcedureScope;
  21639. begin
  21640. Result:=GetProcScope(El);
  21641. if Result<>nil then
  21642. Result:=Result.GetSelfScope;
  21643. end;
  21644. procedure TPasResolver.AddHelper(Helper: TPasClassType;
  21645. var List: TPRHelperEntryArray);
  21646. var
  21647. NewEntry: TPRHelperEntry;
  21648. Added: Integer;
  21649. HelperForType: TPasType;
  21650. begin
  21651. HelperForType:=ResolveAliasType(Helper.HelperForType,false);
  21652. NewEntry:=TPRHelperEntry.Create;
  21653. NewEntry.Helper:=Helper;
  21654. NewEntry.HelperForType:=HelperForType;
  21655. Added:=length(List);
  21656. NewEntry.Added:=Added;
  21657. SetLength(List,Added+1);
  21658. List[Added]:=NewEntry;
  21659. end;
  21660. procedure TPasResolver.AddActiveHelper(Helper: TPasClassType);
  21661. begin
  21662. AddHelper(Helper,FActiveHelpers);
  21663. end;
  21664. class function TPasResolver.MangleSourceLineNumber(Line, Column: integer
  21665. ): integer;
  21666. begin
  21667. if (Column<ParserMaxEmbeddedColumn)
  21668. and (Line<ParserMaxEmbeddedRow) then
  21669. Result:=-(Line*ParserMaxEmbeddedColumn+integer(Column))
  21670. else
  21671. Result:=Line;
  21672. end;
  21673. procedure TPasResolver.SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  21674. MsgNumber: integer; const Fmt: String;
  21675. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21676. PosEl: TPasElement);
  21677. var
  21678. {$IFDEF VerbosePasResolver}
  21679. s: string;
  21680. {$ENDIF}
  21681. Column, Row: integer;
  21682. begin
  21683. FLastMsgId := id;
  21684. FLastMsgType := MsgType;
  21685. FLastMsgNumber := MsgNumber;
  21686. FLastMsgPattern := Fmt;
  21687. FLastMsg := SafeFormat(Fmt,Args);
  21688. FLastElement := PosEl;
  21689. if PosEl=nil then
  21690. FLastSourcePos:=CurrentParser.CurSourcePos
  21691. else
  21692. begin
  21693. FLastSourcePos.FileName:=PosEl.SourceFilename;
  21694. UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
  21695. if Row>=0 then
  21696. FLastSourcePos.Row:=Row
  21697. else
  21698. FLastSourcePos.Row:=0;
  21699. if Column>=0 then
  21700. FLastSourcePos.Column:=Column
  21701. else
  21702. FLastSourcePos.Column:=0;
  21703. end;
  21704. CreateMsgArgs(FLastMsgArgs,Args);
  21705. {$IFDEF VerbosePasResolver}
  21706. {AllowWriteln}
  21707. write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
  21708. s:='';
  21709. str(MsgType,s);
  21710. write(s);
  21711. writeln(': [',MsgNumber,'] ',FLastMsg);
  21712. {AllowWriteln-}
  21713. {$ENDIF}
  21714. end;
  21715. procedure TPasResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
  21716. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21717. ErrorPosEl: TPasElement);
  21718. var
  21719. E: EPasResolve;
  21720. begin
  21721. SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  21722. E:=EPasResolve.Create(FLastMsg);
  21723. E.Id:=Id;
  21724. E.MsgType:=mtError;
  21725. E.MsgNumber:=MsgNumber;
  21726. E.MsgPattern:=Fmt;
  21727. E.PasElement:=ErrorPosEl;
  21728. E.Args:=FLastMsgArgs;
  21729. E.SourcePos:=FLastSourcePos;
  21730. raise E;
  21731. end;
  21732. procedure TPasResolver.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
  21733. Msg: string);
  21734. var
  21735. s: String;
  21736. begin
  21737. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  21738. if Msg<>'' then
  21739. s:=s+' "'+Msg+'"';
  21740. {$IFDEF VerbosePasResolver}
  21741. writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  21742. {$ENDIF}
  21743. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  21744. end;
  21745. procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
  21746. begin
  21747. {$IFDEF VerbosePasResolver}
  21748. writeln('TPasResolver.RaiseInternalError [',id,'] ',Msg);
  21749. {$ENDIF}
  21750. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  21751. end;
  21752. procedure TPasResolver.RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement;
  21753. const Msg: string);
  21754. var
  21755. i: Integer;
  21756. s: String;
  21757. begin
  21758. s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
  21759. for i:=0 to ScopeCount-1 do
  21760. begin
  21761. if i>0 then s:=s+',';
  21762. s:=s+Scopes[i].ClassName;
  21763. end;
  21764. if Msg<>'' then
  21765. s:=s+': '+Msg;
  21766. RaiseInternalError(id,s);
  21767. end;
  21768. procedure TPasResolver.RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string;
  21769. El: TPasElement);
  21770. begin
  21771. {$IFDEF VerbosePasResolver}
  21772. writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
  21773. WriteScopes;
  21774. {$ENDIF}
  21775. RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
  21776. end;
  21777. procedure TPasResolver.RaiseXExpectedButYFound(id: TMaxPrecInt; const X, Y: string;
  21778. El: TPasElement);
  21779. begin
  21780. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
  21781. end;
  21782. procedure TPasResolver.RaiseXExpectedButTypeYFound(id: TMaxPrecInt;
  21783. const X: string; Y: TPasType; El: TPasElement);
  21784. begin
  21785. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,
  21786. [x,GetTypeDescription(Y)],El);
  21787. end;
  21788. procedure TPasResolver.RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C, X,
  21789. Y: string; El: TPasElement);
  21790. begin
  21791. RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
  21792. end;
  21793. procedure TPasResolver.RaiseContextXInvalidY(id: TMaxPrecInt; const X, Y: string;
  21794. El: TPasElement);
  21795. begin
  21796. RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
  21797. end;
  21798. procedure TPasResolver.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  21799. begin
  21800. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  21801. end;
  21802. procedure TPasResolver.RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement;
  21803. IdentEl: TPasElement);
  21804. begin
  21805. if IdentEl is TPasProperty then
  21806. RaiseMsg(id,nNoMemberIsProvidedToAccessProperty,
  21807. sNoMemberIsProvidedToAccessProperty,[],ErrorEl)
  21808. else
  21809. RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  21810. end;
  21811. procedure TPasResolver.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  21812. begin
  21813. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  21814. end;
  21815. procedure TPasResolver.RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  21816. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21817. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  21818. function GetString(ArgNo: integer): string;
  21819. begin
  21820. if ArgNo>High(Args) then
  21821. exit('invalid param '+IntToStr(ArgNo));
  21822. {$ifdef pas2js}
  21823. if isString(Args[ArgNo]) then
  21824. Result:=String(Args[ArgNo])
  21825. else
  21826. Result:='invalid param '+jsTypeOf(Args[ArgNo]);
  21827. {$else}
  21828. case Args[ArgNo].VType of
  21829. vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
  21830. else
  21831. Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
  21832. end;
  21833. {$endif}
  21834. end;
  21835. begin
  21836. case MsgNumber of
  21837. nIllegalTypeConversionTo:
  21838. RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
  21839. nIncompatibleTypesGotExpected:
  21840. RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
  21841. nIncompatibleTypeArgNo:
  21842. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
  21843. nIncompatibleTypeArgNoVarParamMustMatchExactly:
  21844. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
  21845. [GetString(0),GotDesc,ExpDesc],ErrorEl);
  21846. nResultTypeMismatchExpectedButFound:
  21847. RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
  21848. nXExpectedButYFound:
  21849. RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
  21850. nOperatorIsNotOverloadedAOpB:
  21851. RaiseMsg(id,MsgNumber,sOperatorIsNotOverloadedAOpB,[GotDesc,GetString(0),ExpDesc],ErrorEl);
  21852. nTypesAreNotRelatedXY:
  21853. RaiseMsg(id,MsgNumber,sTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  21854. else
  21855. RaiseInternalError(20170329112911);
  21856. end;
  21857. end;
  21858. procedure TPasResolver.RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  21859. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21860. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  21861. var
  21862. GotDesc, ExpDesc: String;
  21863. begin
  21864. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  21865. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  21866. end;
  21867. procedure TPasResolver.RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  21868. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21869. const GotType, ExpType: TPasResolverResult;
  21870. ErrorEl: TPasElement);
  21871. var
  21872. GotDesc, ExpDesc: String;
  21873. begin
  21874. {$IFDEF VerbosePasResolver}
  21875. writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  21876. {$ENDIF}
  21877. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  21878. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  21879. end;
  21880. procedure TPasResolver.RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt;
  21881. ErrorEl: TPasElement);
  21882. begin
  21883. RaiseMsg(id,nHelpersCannotBeUsedAsTypes,sHelpersCannotBeUsedAsTypes,[],ErrorEl);
  21884. end;
  21885. procedure TPasResolver.RaiseInvalidProcTypeModifier(id: TMaxPrecInt;
  21886. ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
  21887. begin
  21888. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
  21889. ProcTypeModifiers[ptm]],ErrorEl);
  21890. end;
  21891. procedure TPasResolver.RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  21892. pm: TProcedureModifier; ErrorEl: TPasElement);
  21893. begin
  21894. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
  21895. ModifierNames[pm]],ErrorEl);
  21896. end;
  21897. procedure TPasResolver.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  21898. MsgNumber: integer; const Fmt: String;
  21899. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21900. PosEl: TPasElement);
  21901. var
  21902. Scanner: TPascalScanner;
  21903. State: TWarnMsgState;
  21904. {$IFDEF VerbosePasResolver}
  21905. s: String;
  21906. {$ENDIF}
  21907. begin
  21908. Scanner:=CurrentParser.Scanner;
  21909. if (Scanner<>nil) then
  21910. begin
  21911. if (FStep<prsFinishingModule)
  21912. and (Scanner.IgnoreMsgType(MsgType)) then
  21913. exit; // during parsing consider directives like $Hints on|off
  21914. if MsgType>=mtWarning then
  21915. begin
  21916. State:=Scanner.WarnMsgState[MsgNumber];
  21917. case State of
  21918. wmsOff:
  21919. begin
  21920. {$IFDEF VerbosePasResolver}
  21921. {AllowWriteln}
  21922. write('TPasResolver.LogMsg ignoring ',id,' ',GetElementSourcePosStr(PosEl),' ');
  21923. s:='';
  21924. str(MsgType,s);
  21925. write(s);
  21926. writeln(': [',MsgNumber,'] ',SafeFormat(Fmt,Args));
  21927. {AllowWriteln-}
  21928. {$ENDIF}
  21929. exit; // ignore
  21930. end;
  21931. wmsError:
  21932. begin
  21933. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl);
  21934. exit;
  21935. end;
  21936. end;
  21937. end;
  21938. end;
  21939. SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  21940. if Assigned(OnLog) then
  21941. OnLog(Self,FLastMsg)
  21942. else if Assigned(CurrentParser.OnLog) then
  21943. CurrentParser.OnLog(Self,FLastMsg);
  21944. end;
  21945. class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
  21946. MsgNumbers: TIntegerDynArray): boolean;
  21947. procedure SetNumber(Number: integer);
  21948. begin
  21949. {$IF FPC_FULLVERSION>=30101}
  21950. MsgNumbers:=[Number];
  21951. {$ELSE}
  21952. Setlength(MsgNumbers,1);
  21953. MsgNumbers[0]:=Number;
  21954. {$ENDIF}
  21955. end;
  21956. procedure SetNumbers(Numbers: array of integer);
  21957. var
  21958. i: Integer;
  21959. begin
  21960. Setlength(MsgNumbers,length(Numbers));
  21961. for i:=0 to high(Numbers) do
  21962. MsgNumbers[i]:=Numbers[i];
  21963. end;
  21964. begin
  21965. if Identifier='' then exit(false);
  21966. if Identifier[1] in ['0'..'9'] then exit(false);
  21967. Result:=true;
  21968. case UpperCase(Identifier) of
  21969. // FPC:
  21970. 'CONSTRUCTING_ABSTRACT': SetNumber(nConstructingClassXWithAbstractMethodY); // Constructing an instance of a class with abstract methods.
  21971. //'IMPLICIT_VARIANTS': ; // Implicit use of the variants unit.
  21972. // useanalyzer: 'NO_RETVAL': ; // Function result is not set.
  21973. 'SYMBOL_DEPRECATED': SetNumber(nSymbolXIsDeprecated); // Deprecated symbol.
  21974. 'SYMBOL_EXPERIMENTAL': SetNumber(nSymbolXIsExperimental); // Experimental symbol
  21975. 'SYMBOL_LIBRARY': SetNumber(nSymbolXBelongsToALibrary); // Not used.
  21976. 'SYMBOL_PLATFORM': SetNumber(nSymbolXIsNotPortable); // Platform-dependent symbol.
  21977. 'SYMBOL_UNIMPLEMENTED': SetNumber(nSymbolXIsNotImplemented); // Unimplemented symbol.
  21978. //'UNIT_DEPRECATED': ; // Deprecated unit.
  21979. //'UNIT_EXPERIMENTAL': ; // Experimental unit.
  21980. //'UNIT_LIBRARY': ; //
  21981. //'UNIT_PLATFORM': ; // Platform dependent unit.
  21982. //'UNIT_UNIMPLEMENTED': ; // Unimplemented unit.
  21983. //'ZERO_NIL_COMPAT': ; // Converting 0 to NIL
  21984. //'IMPLICIT_STRING_CAST': ; // Implicit string type conversion
  21985. //'IMPLICIT_STRING_CAST_LOSS': ; // Implicit string typecast with potential data loss from ”$1” to ”$2”
  21986. //'EXPLICIT_STRING_CAST': ; // Explicit string type conversion
  21987. //'EXPLICIT_STRING_CAST_LOSS': ; // Explicit string typecast with potential data loss from ”$1” to ”$2”
  21988. //'CVT_NARROWING_STRING_LOST': ; // Unicode constant cast with potential data loss
  21989. // Delphi:
  21990. 'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
  21991. 'GARBAGE': SetNumber(nTextAfterFinalIgnored); // text after final end.
  21992. 'BOUNDS_ERROR': SetNumbers([nRangeCheckError,
  21993. nHighRangeLimitLTLowRangeLimit,
  21994. nRangeCheckEvaluatingConstantsVMinMax,
  21995. nRangeCheckInSetConstructor]);
  21996. 'MESSAGE_DIRECTIVE': SetNumber(nUserDefined); // $message directive
  21997. else
  21998. Result:=false;
  21999. end;
  22000. end;
  22001. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  22002. ExpType: TPasResolverResult; out GotDesc, ExpDesc: String);
  22003. var
  22004. NeedProcSignature: Boolean;
  22005. begin
  22006. {$IFDEF VerbosePasResolver}
  22007. writeln('TPasResolver.GetIncompatibleTypeDesc Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  22008. {$ENDIF}
  22009. if (GotType.BaseType<>ExpType.BaseType)
  22010. and (GotType.BaseType<>btContext) and (ExpType.BaseType<>btContext) then
  22011. begin
  22012. GotDesc:=GetBaseDescription(GotType);
  22013. if ExpType.BaseType=btNil then
  22014. ExpDesc:=BaseTypeNames[btPointer]
  22015. else
  22016. ExpDesc:=GetBaseDescription(ExpType);
  22017. if GotDesc<>ExpDesc then
  22018. exit;
  22019. GotDesc:=GetBaseDescription(GotType,true);
  22020. ExpDesc:=GetBaseDescription(ExpType,true);
  22021. end
  22022. else if (GotType.LoTypeEl<>nil) and (ExpType.LoTypeEl<>nil) then
  22023. begin
  22024. NeedProcSignature:=(GotType.LoTypeEl is TPasProcedureType)
  22025. and (ExpType.LoTypeEl is TPasProcedureType);
  22026. if NeedProcSignature then
  22027. begin
  22028. // procedural types
  22029. GetIncompatibleProcParamsDesc(TPasProcedureType(GotType.LoTypeEl),
  22030. TPasProcedureType(ExpType.LoTypeEl),GotDesc,ExpDesc);
  22031. if GotDesc<>ExpDesc then
  22032. exit;
  22033. end;
  22034. GotDesc:=GetTypeDescription(GotType);
  22035. ExpDesc:=GetTypeDescription(ExpType);
  22036. if GotDesc<>ExpDesc then
  22037. exit;
  22038. if GotType.HiTypeEl<>ExpType.HiTypeEl then
  22039. begin
  22040. GotDesc:=GetTypeDescription(GotType.HiTypeEl);
  22041. ExpDesc:=GetTypeDescription(ExpType.HiTypeEl);
  22042. if GotDesc<>ExpDesc then
  22043. exit;
  22044. end;
  22045. GotDesc:=GetTypeDescription(GotType,true);
  22046. ExpDesc:=GetTypeDescription(ExpType,true);
  22047. end
  22048. else
  22049. begin
  22050. GotDesc:=GetResolverResultDescription(GotType,true);
  22051. ExpDesc:=GetResolverResultDescription(ExpType,true);
  22052. if GotDesc<>ExpDesc then
  22053. exit;
  22054. GotDesc:=GetResolverResultDescription(GotType,false);
  22055. ExpDesc:=GetResolverResultDescription(ExpType,false);
  22056. end;
  22057. end;
  22058. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  22059. ExpType: TPasType; out GotDesc, ExpDesc: String);
  22060. var
  22061. GotLoType, ExpLoType: TPasType;
  22062. begin
  22063. GotLoType:=ResolveAliasType(GotType);
  22064. ExpLoType:=ResolveAliasType(ExpType);
  22065. if (GotLoType<>nil) and (ExpLoType<>nil) then
  22066. begin
  22067. if (GotLoType.ClassType=ExpLoType.ClassType)
  22068. and (GotLoType is TPasProcedureType) then
  22069. begin
  22070. // procedural types
  22071. GetIncompatibleProcParamsDesc(TPasProcedureType(GotLoType),
  22072. TPasProcedureType(ExpLoType),GotDesc,ExpDesc);
  22073. if GotDesc<>ExpDesc then
  22074. exit;
  22075. end;
  22076. end;
  22077. GotDesc:=GetTypeDescription(GotType);
  22078. ExpDesc:=GetTypeDescription(ExpType);
  22079. if GotDesc<>ExpDesc then exit;
  22080. GotDesc:=GetTypeDescription(GotType,true);
  22081. ExpDesc:=GetTypeDescription(ExpType,true);
  22082. end;
  22083. procedure TPasResolver.GetIncompatibleProcParamsDesc(GotType,
  22084. ExpType: TPasProcedureType; out GotDesc, ExpDesc: string);
  22085. procedure AppendClass(ProcType: TPasProcedureType; var Desc: string);
  22086. var
  22087. C: TClass;
  22088. begin
  22089. C:=ProcType.ClassType;
  22090. if C=TPasProcedureType then
  22091. Desc:=Desc+'procedure'
  22092. else if C=TPasFunctionType then
  22093. Desc:=Desc+'function'
  22094. else
  22095. RaiseNotYetImplemented(20200216114419,ProcType,ProcType.ClassName);
  22096. end;
  22097. var
  22098. i: Integer;
  22099. GotArg, ExpArg: TPasArgument;
  22100. GotArgs, ExpArgs: TFPList;
  22101. GotArgDesc, ExpArgDesc: String;
  22102. GotArgType, ExpArgType: TPasType;
  22103. begin
  22104. GotDesc:='';
  22105. ExpDesc:='';
  22106. // reference to
  22107. if (ptmReferenceTo in GotType.Modifiers) and not (ptmReferenceTo in ExpType.Modifiers) then
  22108. GotDesc:='reference to '
  22109. else if not (ptmReferenceTo in GotType.Modifiers) and (ptmReferenceTo in ExpType.Modifiers) then
  22110. ExpDesc:='reference to ';
  22111. // type
  22112. AppendClass(GotType,GotDesc);
  22113. AppendClass(ExpType,ExpDesc);
  22114. // Args
  22115. GotDesc:=GotDesc+'(';
  22116. ExpDesc:=ExpDesc+'(';
  22117. GotArgs:=GotType.Args;
  22118. ExpArgs:=ExpType.Args;
  22119. for i:=0 to GotArgs.Count-1 do
  22120. begin
  22121. if i>0 then
  22122. GotDesc:=GotDesc+';';
  22123. GotArg:=TPasArgument(GotArgs[i]);
  22124. GotArgType:=ResolveAliasType(GotArg.ArgType);
  22125. if i<ExpArgs.Count then
  22126. begin
  22127. if i>0 then
  22128. ExpDesc:=ExpDesc+';';
  22129. ExpArg:=TPasArgument(ExpArgs[i]);
  22130. ExpArgType:=ResolveAliasType(ExpArg.ArgType);
  22131. if GotArgType=ExpArgType then
  22132. begin
  22133. GotDesc:=GotDesc+GetTypeDescription(GotArgType);
  22134. ExpDesc:=ExpDesc+GetTypeDescription(ExpArgType);
  22135. end
  22136. else
  22137. begin
  22138. GetIncompatibleTypeDesc(GotArgType,ExpArgType,GotArgDesc,ExpArgDesc);
  22139. GotDesc:=GotDesc+GotArgDesc;
  22140. ExpDesc:=ExpDesc+ExpArgDesc;
  22141. end;
  22142. end
  22143. else
  22144. begin
  22145. // GotType has more args than ExpType
  22146. GotDesc:=GotDesc+GetTypeDescription(GotArgType);
  22147. end;
  22148. end;
  22149. for i:=GotArgs.Count to ExpArgs.Count-1 do
  22150. begin
  22151. // ExpType has more args then GotType
  22152. if i>0 then
  22153. ExpDesc:=ExpDesc+';';
  22154. ExpArg:=TPasArgument(ExpArgs[i]);
  22155. ExpArgType:=ResolveAliasType(ExpArg.ArgType);
  22156. ExpDesc:=ExpDesc+GetTypeDescription(ExpArgType);
  22157. end;
  22158. GotDesc:=GotDesc+')';
  22159. ExpDesc:=ExpDesc+')';
  22160. // function result
  22161. if GotType is TPasFunctionType then
  22162. GotDesc:=GotDesc+': '+GetTypeDescription(ResolveAliasType(TPasFunctionType(GotType).ResultEl.ResultType));
  22163. if ExpType is TPasFunctionType then
  22164. ExpDesc:=ExpDesc+': '+GetTypeDescription(ResolveAliasType(TPasFunctionType(ExpType).ResultEl.ResultType));
  22165. // modifiers
  22166. if (ptmOfObject in GotType.Modifiers) and not (ptmOfObject in ExpType.Modifiers) then
  22167. GotDesc:=GotDesc+' of Object'
  22168. else if not (ptmOfObject in GotType.Modifiers) and (ptmOfObject in ExpType.Modifiers) then
  22169. ExpDesc:=ExpDesc+' of Object';
  22170. if (ptmIsNested in GotType.Modifiers) and not (ptmIsNested in ExpType.Modifiers) then
  22171. GotDesc:=GotDesc+' is nested'
  22172. else if not (ptmIsNested in GotType.Modifiers) and (ptmIsNested in ExpType.Modifiers) then
  22173. ExpDesc:=ExpDesc+' is nested';
  22174. if (ptmStatic in GotType.Modifiers) and not (ptmStatic in ExpType.Modifiers) then
  22175. GotDesc:=GotDesc+'; static'
  22176. else if not (ptmStatic in GotType.Modifiers) and (ptmStatic in ExpType.Modifiers) then
  22177. ExpDesc:=ExpDesc+'; static';
  22178. if (ptmAsync in GotType.Modifiers) and not (ptmAsync in ExpType.Modifiers) then
  22179. GotDesc:=GotDesc+'; async'
  22180. else if not (ptmAsync in GotType.Modifiers) and (ptmAsync in ExpType.Modifiers) then
  22181. ExpDesc:=ExpDesc+'; async';
  22182. if (ptmVarargs in GotType.Modifiers) and not (ptmVarargs in ExpType.Modifiers) then
  22183. GotDesc:=GotDesc+'; varargs'
  22184. else if not (ptmVarargs in GotType.Modifiers) and (ptmVarargs in ExpType.Modifiers) then
  22185. ExpDesc:=ExpDesc+'; varargs'
  22186. else
  22187. begin
  22188. if GotType.VarArgsType<>nil then
  22189. GotDesc:=GotDesc+'; varargs of '+GetTypeDescription(ResolveAliasType(GotType.VarArgsType));
  22190. if ExpType.VarArgsType<>nil then
  22191. ExpDesc:=ExpDesc+'; varargs of '+GetTypeDescription(ResolveAliasType(ExpType.VarArgsType));
  22192. end;
  22193. // calling convention
  22194. if GotType.CallingConvention<>ExpType.CallingConvention then
  22195. begin
  22196. GotDesc:=GotDesc+';'+cCallingConventions[GotType.CallingConvention];
  22197. ExpDesc:=ExpDesc+';'+cCallingConventions[ExpType.CallingConvention];
  22198. end;
  22199. if GotDesc=ExpDesc then
  22200. begin
  22201. if GotType.Parent is TPasAnonymousProcedure then
  22202. GotDesc:='anonymous '+GotDesc;
  22203. if ExpType.Parent is TPasAnonymousProcedure then
  22204. ExpDesc:='anonymous '+ExpDesc;
  22205. end;
  22206. end;
  22207. function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
  22208. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
  22209. ): integer;
  22210. var
  22211. ProcArgs: TFPList;
  22212. i, ParamCnt, ParamCompatibility: Integer;
  22213. Param, Value: TPasExpr;
  22214. ParamResolved, ArgResolved: TPasResolverResult;
  22215. Flags: TPasResolverComputeFlags;
  22216. begin
  22217. Result:=cExact;
  22218. ProcArgs:=ProcType.Args;
  22219. Value:=Params.Value;
  22220. if Value is TBinaryExpr then
  22221. Value:=TBinaryExpr(Value).right; // Note: parser guarantees that this is the rightmost
  22222. // check args
  22223. ParamCnt:=length(Params.Params);
  22224. ArgResolved.BaseType:=btNone;
  22225. i:=0;
  22226. while i<ParamCnt do
  22227. begin
  22228. Param:=Params.Params[i];
  22229. {$IFDEF VerbosePasResolver}
  22230. writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
  22231. {$ENDIF}
  22232. if i<ProcArgs.Count then
  22233. begin
  22234. ParamCompatibility:=CheckParamCompatibility(Param,
  22235. TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
  22236. if ParamCompatibility=cIncompatible then
  22237. exit(cIncompatible);
  22238. end
  22239. else
  22240. begin
  22241. if ptmVarargs in ProcType.Modifiers then
  22242. begin
  22243. if ProcType.VarArgsType<>nil then
  22244. begin
  22245. if ArgResolved.BaseType=btNone then
  22246. ComputeElement(ProcType.VarArgsType,ArgResolved,[rcType]);
  22247. ComputeArgumentExpr(ArgResolved,argConst,
  22248. Param,ParamResolved,SetReferenceFlags);
  22249. ParamCompatibility:=CheckParamResCompatibility(Param,ParamResolved,
  22250. ArgResolved,i,RaiseOnError,SetReferenceFlags);
  22251. if ParamCompatibility=cIncompatible then
  22252. exit(cIncompatible);
  22253. end
  22254. else
  22255. begin
  22256. if SetReferenceFlags then
  22257. Flags:=[rcNoImplicitProcType,rcSetReferenceFlags]
  22258. else
  22259. Flags:=[rcNoImplicitProcType];
  22260. ComputeElement(Param,ParamResolved,Flags,Param);
  22261. if not (rrfReadable in ParamResolved.Flags) then
  22262. begin
  22263. if RaiseOnError then
  22264. RaiseVarExpected(20180712001415,Param,ParamResolved.IdentEl);
  22265. exit(cIncompatible);
  22266. end;
  22267. ParamCompatibility:=cExact;
  22268. end;
  22269. end
  22270. else
  22271. begin
  22272. // too many arguments
  22273. if RaiseOnError then
  22274. RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
  22275. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
  22276. exit(cIncompatible);
  22277. end;
  22278. end;
  22279. if Result<cTypeConversion then
  22280. inc(Result,ParamCompatibility)
  22281. else
  22282. Result:=Max(Result,ParamCompatibility);
  22283. inc(i);
  22284. end;
  22285. if (i<ProcArgs.Count) then
  22286. if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
  22287. begin
  22288. // not enough arguments
  22289. if RaiseOnError then
  22290. // ToDo: position cursor on identifier
  22291. RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
  22292. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
  22293. exit(cIncompatible);
  22294. end
  22295. else
  22296. begin
  22297. // the rest are default params
  22298. end;
  22299. end;
  22300. function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
  22301. Params: TParamsExpr; RaiseOnError: boolean): integer;
  22302. var
  22303. PropArg: TPasArgument;
  22304. ArgNo, ParamComp: Integer;
  22305. Param: TPasExpr;
  22306. PropArgs: TFPList;
  22307. begin
  22308. Result:=cExact;
  22309. PropArgs:=GetPasPropertyArgs(PropEl);
  22310. if PropArgs.Count<length(Params.Params) then
  22311. begin
  22312. if not RaiseOnError then exit(cIncompatible);
  22313. RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  22314. [PropEl.Name],Params)
  22315. end
  22316. else if PropArgs.Count>length(Params.Params) then
  22317. begin
  22318. if not RaiseOnError then exit(cIncompatible);
  22319. RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
  22320. [TPasArgument(PropArgs[length(Params.Params)]).Name],Params);
  22321. end;
  22322. for ArgNo:=0 to PropArgs.Count-1 do
  22323. begin
  22324. PropArg:=TPasArgument(PropArgs[ArgNo]);
  22325. Param:=Params.Params[ArgNo];
  22326. ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
  22327. if ParamComp=cIncompatible then
  22328. exit(cIncompatible);
  22329. inc(Result,ParamComp);
  22330. end;
  22331. end;
  22332. function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  22333. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
  22334. var
  22335. ArgNo: Integer;
  22336. Param: TPasExpr;
  22337. ParamResolved: TPasResolverResult;
  22338. procedure GetNextParam;
  22339. begin
  22340. if ArgNo>=length(Params.Params) then
  22341. RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  22342. [],Params);
  22343. Param:=Params.Params[ArgNo];
  22344. ComputeElement(Param,ParamResolved,[]);
  22345. inc(ArgNo);
  22346. end;
  22347. var
  22348. DimNo: integer;
  22349. RangeResolved, OrigRangeResolved, OrigParamResolved: TPasResolverResult;
  22350. bt: TResolverBaseType;
  22351. NextType, TypeEl: TPasType;
  22352. RangeExpr: TPasExpr;
  22353. TypeFits: Boolean;
  22354. ParamValue: TResEvalValue;
  22355. begin
  22356. ArgNo:=0;
  22357. repeat
  22358. if length(ArrayEl.Ranges)=0 then
  22359. begin
  22360. // dynamic/open array -> needs exactly one integer
  22361. GetNextParam;
  22362. if (not (rrfReadable in ParamResolved.Flags))
  22363. or not (ParamResolved.BaseType in btAllInteger) then
  22364. exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
  22365. if EmitHints then
  22366. begin
  22367. ParamValue:=Eval(Param,[refAutoConstExt]);
  22368. if ParamValue<>nil then
  22369. try // has const value -> check range
  22370. if ParamValue.Kind=revkExternal then
  22371. // ignore
  22372. else if (ParamValue.Kind<>revkInt)
  22373. or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
  22374. or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
  22375. fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
  22376. DynArrayMinIndex,DynArrayMaxIndex,Param);
  22377. finally
  22378. ReleaseEvalValue(ParamValue);
  22379. end;
  22380. end;
  22381. end
  22382. else
  22383. begin
  22384. // static array
  22385. for DimNo:=0 to length(ArrayEl.Ranges)-1 do
  22386. begin
  22387. GetNextParam;
  22388. RangeExpr:=ArrayEl.Ranges[DimNo];
  22389. ComputeElement(RangeExpr,RangeResolved,[]);
  22390. bt:=RangeResolved.BaseType;
  22391. if not (rrfReadable in ParamResolved.Flags) then
  22392. begin
  22393. if not RaiseOnError then exit(cIncompatible);
  22394. RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
  22395. [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
  22396. end;
  22397. TypeFits:=false;
  22398. OrigRangeResolved:=RangeResolved;
  22399. OrigParamResolved:=ParamResolved;
  22400. if bt=btRange then
  22401. begin
  22402. ConvertRangeToElement(RangeResolved);
  22403. bt:=RangeResolved.BaseType;
  22404. end;
  22405. if ParamResolved.BaseType=btRange then
  22406. begin
  22407. ConvertRangeToElement(ParamResolved);
  22408. end;
  22409. if (bt in btAllBooleans) then
  22410. begin
  22411. if (ParamResolved.BaseType in btAllBooleans) then
  22412. TypeFits:=true;
  22413. end
  22414. else if (bt in btAllInteger) then
  22415. begin
  22416. if (ParamResolved.BaseType in btAllInteger) then
  22417. TypeFits:=true;
  22418. end
  22419. else if (bt in btAllChars) then
  22420. begin
  22421. if (ParamResolved.BaseType in btAllChars) then
  22422. TypeFits:=true;
  22423. end
  22424. else if (bt=btContext) then
  22425. begin
  22426. TypeEl:=RangeResolved.LoTypeEl;
  22427. if ParamResolved.BaseType=btContext then
  22428. begin
  22429. if (TypeEl.ClassType=TPasEnumType)
  22430. and IsSameType(TypeEl,ParamResolved.LoTypeEl,prraNone) then
  22431. TypeFits:=true;
  22432. end;
  22433. end;
  22434. if not TypeFits then
  22435. begin
  22436. // incompatible
  22437. if not RaiseOnError then exit(cIncompatible);
  22438. RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
  22439. [IntToStr(ArgNo)],OrigParamResolved,OrigRangeResolved,Param);
  22440. end;
  22441. if EmitHints then
  22442. fExprEvaluator.IsInRange(Param,RangeExpr,true);
  22443. end;
  22444. end;
  22445. if ArgNo=length(Params.Params) then exit(cExact);
  22446. // there are more parameters -> continue in sub array
  22447. NextType:=ResolveAliasType(ArrayEl.ElType);
  22448. if NextType.ClassType<>TPasArrayType then
  22449. RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  22450. [],Params);
  22451. ArrayEl:=TPasArrayType(NextType);
  22452. until false;
  22453. Result:=cIncompatible;
  22454. end;
  22455. function TPasResolver.CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  22456. // returns if number and type of arguments fit
  22457. // does not check calling convention
  22458. var
  22459. ProcArgs1, ProcArgs2, TemplTypes1, TemplTypes2: TFPList;
  22460. i, Comp: Integer;
  22461. begin
  22462. Result:=false;
  22463. if (Proc1.NameParts<>nil) or (Proc2.NameParts<>nil) then
  22464. begin
  22465. TemplTypes1:=GetProcTemplateTypes(Proc1);
  22466. TemplTypes2:=GetProcTemplateTypes(Proc2);
  22467. if TemplTypes1=nil then
  22468. begin
  22469. if TemplTypes2<>nil then
  22470. exit;
  22471. end
  22472. else if TemplTypes2=nil then
  22473. exit
  22474. else if TemplTypes1.Count<>TemplTypes2.Count then
  22475. exit;
  22476. end;
  22477. ProcArgs1:=Proc1.ProcType.Args;
  22478. ProcArgs2:=Proc2.ProcType.Args;
  22479. {$IFDEF VerbosePasResolver}
  22480. writeln('TPasResolver.CheckProcOverloadCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
  22481. {$ENDIF}
  22482. // check args
  22483. if ProcArgs1.Count<>ProcArgs2.Count then
  22484. exit;
  22485. for i:=0 to ProcArgs1.Count-1 do
  22486. begin
  22487. {$IFDEF VerbosePasResolver}
  22488. writeln('TPasResolver.CheckProcOverloadCompatibility ',i,'/',ProcArgs1.Count);
  22489. {$ENDIF}
  22490. Comp:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
  22491. if Comp>cExact then
  22492. exit;
  22493. end;
  22494. Result:=true;
  22495. end;
  22496. function TPasResolver.CheckProcTypeCompatibility(Proc1,
  22497. Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
  22498. RaiseOnIncompatible: boolean): boolean;
  22499. // if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
  22500. function ModifierError(Modifier: TProcTypeModifier): boolean;
  22501. begin
  22502. Result:=false;
  22503. if not RaiseOnIncompatible then exit;
  22504. RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
  22505. [GetElementTypeName(Proc1),ProcTypeModifiers[Modifier]],ErrorEl);
  22506. end;
  22507. var
  22508. ProcArgs1, ProcArgs2: TFPList;
  22509. i: Integer;
  22510. Result1Resolved, Result2Resolved: TPasResolverResult;
  22511. ExpectedArg, ActualArg: TPasArgument;
  22512. begin
  22513. Result:=false;
  22514. if Proc1.ClassType<>Proc2.ClassType then
  22515. begin
  22516. if RaiseOnIncompatible then
  22517. RaiseXExpectedButYFound(20170402112353,GetElementTypeName(Proc1),GetElementTypeName(Proc2),ErrorEl);
  22518. exit;
  22519. end;
  22520. if Proc1.IsReferenceTo then
  22521. begin
  22522. if IsAssign then
  22523. // aRefTo:=aproc -> any IsNested/OfObject is allowed
  22524. else
  22525. ; // aRefTo = AnyProc -> ok
  22526. end
  22527. else if Proc2.IsReferenceTo then
  22528. begin
  22529. if IsAssign then
  22530. // NonRefTo := aRefTo -> not possible
  22531. exit(ModifierError(ptmReferenceTo))
  22532. else
  22533. ; // AnyProc = aRefTo -> ok
  22534. end
  22535. else if Proc2.Parent is TPasAnonymousProcedure then
  22536. begin
  22537. if IsAssign then
  22538. // NonRefTo := AnonymousProc -> not possible
  22539. exit(ModifierError(ptmReferenceTo))
  22540. else
  22541. ; // AnyProc = AnonymousProc -> ok
  22542. end
  22543. else
  22544. begin
  22545. // neither Proc1 nor Proc2 is a reference-to -> check isNested and OfObject
  22546. if Proc1.IsNested<>Proc2.IsNested then
  22547. exit(ModifierError(ptmIsNested));
  22548. if Proc1.IsOfObject<>Proc2.IsOfObject then
  22549. begin
  22550. if (proProcTypeWithoutIsNested in Options) then
  22551. exit(ModifierError(ptmOfObject))
  22552. else if Proc1.IsNested then
  22553. // "is nested" can handle both, proc and method.
  22554. else
  22555. exit(ModifierError(ptmOfObject))
  22556. end;
  22557. end;
  22558. if Proc1.CallingConvention<>Proc2.CallingConvention then
  22559. begin
  22560. if (proSafecallAllowsDefault in Options)
  22561. and (Proc1.CallingConvention=ccSafeCall)
  22562. and (Proc2.CallingConvention=ccDefault) then
  22563. // ok
  22564. else
  22565. begin
  22566. if RaiseOnIncompatible then
  22567. RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
  22568. [],ErrorEl);
  22569. exit;
  22570. end;
  22571. end;
  22572. ProcArgs1:=Proc1.Args;
  22573. ProcArgs2:=Proc2.Args;
  22574. if ProcArgs1.Count<>ProcArgs2.Count then
  22575. begin
  22576. if RaiseOnIncompatible then
  22577. RaiseMsg(20170902142829,nIncompatibleTypesGotParametersExpected,
  22578. sIncompatibleTypesGotParametersExpected,
  22579. [IntToStr(ProcArgs1.Count),IntToStr(ProcArgs2.Count)],ErrorEl);
  22580. exit;
  22581. end;
  22582. for i:=0 to ProcArgs1.Count-1 do
  22583. begin
  22584. {$IFDEF VerbosePasResolver}
  22585. writeln('TPasResolver.CheckProcTypeCompatibility ',i,'/',ProcArgs1.Count);
  22586. {$ENDIF}
  22587. ExpectedArg:=TPasArgument(ProcArgs1[i]);
  22588. ActualArg:=TPasArgument(ProcArgs2[i]);
  22589. if CheckProcArgCompatibility(ExpectedArg,ActualArg)>cGenericExact then
  22590. begin
  22591. if RaiseOnIncompatible then
  22592. begin
  22593. if ExpectedArg.Access<>ActualArg.Access then
  22594. RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  22595. [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
  22596. AccessDescriptions[ExpectedArg.Access]],
  22597. ErrorEl);
  22598. RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
  22599. [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
  22600. end;
  22601. exit;
  22602. end;
  22603. end;
  22604. if Proc1 is TPasFunctionType then
  22605. begin
  22606. ComputeResultElement(TPasFunctionType(Proc1).ResultEl,Result1Resolved,[]);
  22607. ComputeResultElement(TPasFunctionType(Proc2).ResultEl,Result2Resolved,[]);
  22608. if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
  22609. or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
  22610. begin
  22611. if RaiseOnIncompatible then
  22612. RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
  22613. [],Result1Resolved,Result2Resolved,ErrorEl);
  22614. exit;
  22615. end;
  22616. if Proc1.IsAsync<>Proc2.IsAsync then
  22617. RaiseMsg(20200524112519,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ErrorEl);
  22618. end;
  22619. Result:=true;
  22620. end;
  22621. function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument
  22622. ): integer;
  22623. begin
  22624. // check access: var, const, ...
  22625. if Arg1.Access<>Arg2.Access then exit(cIncompatible);
  22626. Result:=CheckElTypeCompatibility(Arg1.ArgType,Arg2.ArgType,prraSimple);
  22627. end;
  22628. function TPasResolver.CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  22629. ResolveAlias: TPRResolveAlias): integer;
  22630. var
  22631. Arg1Resolved, Arg2Resolved: TPasResolverResult;
  22632. C: TClass;
  22633. Arr1, Arr2: TPasArrayType;
  22634. TemplType1, TemplType2: TPasGenericTemplateType;
  22635. Templates1, Templates2, ProcArgs1, ProcArgs2: TFPList;
  22636. i: Integer;
  22637. Proc1, Proc2: TPasProcedureType;
  22638. begin
  22639. if Arg1=Arg2 then exit(cExact);
  22640. ComputeElement(Arg1,Arg1Resolved,[rcType]);
  22641. ComputeElement(Arg2,Arg2Resolved,[rcType]);
  22642. {$IFDEF VerbosePasResolver}
  22643. writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
  22644. {$ENDIF}
  22645. if IsGenericTemplType(Arg1Resolved) then
  22646. begin
  22647. Result:=cGenericExact;
  22648. if Arg1Resolved.LoTypeEl=Arg2Resolved.LoTypeEl then
  22649. exit(cExact)
  22650. else if IsGenericTemplType(Arg2Resolved) then
  22651. begin
  22652. TemplType1:=TPasGenericTemplateType(Arg1Resolved.LoTypeEl);
  22653. TemplType2:=TPasGenericTemplateType(Arg2Resolved.LoTypeEl);
  22654. if (TemplType1.Parent is TPasProcedure)
  22655. and (TemplType2.Parent is TPasProcedure) then
  22656. begin
  22657. Templates1:=GetProcTemplateTypes(TPasProcedure(TemplType1.Parent));
  22658. Templates2:=GetProcTemplateTypes(TPasProcedure(TemplType2.Parent));
  22659. i:=Templates1.IndexOf(TemplType1);
  22660. if (i>=0) and (i=Templates2.IndexOf(TemplType2)) then
  22661. exit(cExact);
  22662. end;
  22663. end;
  22664. exit;
  22665. end
  22666. else if IsGenericTemplType(Arg2Resolved) then
  22667. exit(cGenericExact);
  22668. if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
  22669. or (Arg1Resolved.LoTypeEl=nil)
  22670. or (Arg2Resolved.LoTypeEl=nil) then
  22671. exit(cIncompatible);
  22672. if ResolveAlias=prraSimple then
  22673. begin
  22674. if IsSameType(Arg1Resolved.HiTypeEl,Arg2Resolved.HiTypeEl,prraSimple) then
  22675. exit(cExact);
  22676. end
  22677. else
  22678. begin
  22679. if IsSameType(Arg1Resolved.LoTypeEl,Arg2Resolved.LoTypeEl,prraNone) then
  22680. exit(cExact);
  22681. end;
  22682. if Arg1Resolved.BaseType=btContext then
  22683. begin
  22684. C:=Arg1Resolved.LoTypeEl.ClassType;
  22685. if C<>Arg2Resolved.LoTypeEl.ClassType then
  22686. exit(cIncompatible);
  22687. if C=TPasArrayType then
  22688. begin
  22689. Arr1:=TPasArrayType(Arg1Resolved.LoTypeEl);
  22690. Arr2:=TPasArrayType(Arg2Resolved.LoTypeEl);
  22691. if length(Arr1.Ranges)<>length(Arr2.Ranges) then
  22692. exit(cIncompatible);
  22693. if length(Arr1.Ranges)>0 then
  22694. RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
  22695. Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
  22696. exit;
  22697. end
  22698. else if (C.InheritsFrom(TPasProcedureType))
  22699. and not (msDelphi in CurrentParser.CurrentModeswitches) then
  22700. begin
  22701. // FPC checks proc types arguments by signature, Delphi checks by type
  22702. Proc1:=TPasProcedureType(Arg1Resolved.LoTypeEl);
  22703. Proc2:=TPasProcedureType(Arg2Resolved.LoTypeEl);
  22704. if Proc1.CallingConvention<>Proc2.CallingConvention then
  22705. exit(cIncompatible);
  22706. if Proc1.Modifiers<>Proc2.Modifiers then
  22707. exit(cIncompatible);
  22708. if Proc1.VarArgsType<>Proc2.VarArgsType then
  22709. begin
  22710. Result:=CheckElTypeCompatibility(Proc1.VarArgsType,Proc2.VarArgsType,ResolveAlias);
  22711. if Result=cIncompatible then exit;
  22712. end;
  22713. ProcArgs1:=Proc1.Args;
  22714. ProcArgs2:=Proc2.Args;
  22715. if ProcArgs1.Count<>ProcArgs2.Count then
  22716. exit(cIncompatible);
  22717. for i:=0 to ProcArgs1.Count-1 do
  22718. begin
  22719. Result:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
  22720. if Result>cGenericExact then
  22721. exit(cIncompatible);
  22722. end;
  22723. exit(cExact);
  22724. end;
  22725. end;
  22726. Result:=cIncompatible;
  22727. end;
  22728. function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  22729. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  22730. var
  22731. El: TPasElement;
  22732. begin
  22733. Result:=false;
  22734. El:=ResolvedEl.IdentEl;
  22735. if El=nil then
  22736. begin
  22737. if (ResolvedEl.ExprEl is TUnaryExpr)
  22738. and (TUnaryExpr(ResolvedEl.ExprEl).OpCode=eopDeref) then
  22739. begin
  22740. // e.g. p^:=
  22741. end
  22742. else
  22743. begin
  22744. if ErrorOnFalse then
  22745. begin
  22746. {$IFDEF VerbosePasResolver}
  22747. writeln('TPasResolver.CheckCanBeLHS no identifier: ',GetResolverResultDbg(ResolvedEl));
  22748. {$ENDIF}
  22749. if (ResolvedEl.LoTypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
  22750. RaiseXExpectedButYFound(20170216152727,'identifier',GetElementTypeName(ResolvedEl.LoTypeEl),ResolvedEl.ExprEl)
  22751. else
  22752. RaiseVarExpected(20170216152426,ErrorEl,ResolvedEl.IdentEl);
  22753. end;
  22754. exit;
  22755. end;
  22756. end;
  22757. if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
  22758. exit(not IsVariableConst(El,ErrorEl,ErrorOnFalse));
  22759. // not writable
  22760. if not ErrorOnFalse then exit;
  22761. {$IFDEF VerbosePasResolver}
  22762. writeln('TPasResolver.CheckCanBeLHS not writable: ',GetResolverResultDbg(ResolvedEl));
  22763. {$ENDIF}
  22764. if ResolvedEl.IdentEl is TPasProperty then
  22765. RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
  22766. else if ResolvedEl.IdentEl is TPasConst then
  22767. RaiseMsg(20180430012042,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],ErrorEl)
  22768. else
  22769. RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  22770. end;
  22771. function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
  22772. RaiseOnIncompatible: boolean; ErrorEl: TPasElement): integer;
  22773. var
  22774. LeftResolved, RightResolved: TPasResolverResult;
  22775. Flags: TPasResolverComputeFlags;
  22776. IsProcType: Boolean;
  22777. begin
  22778. if ErrorEl=nil then
  22779. ErrorEl:=RHS;
  22780. ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
  22781. Flags:=[];
  22782. IsProcType:=IsProcedureType(LeftResolved,true);
  22783. if IsProcType then
  22784. if msDelphi in CurrentParser.CurrentModeswitches then
  22785. Include(Flags,rcNoImplicitProc)
  22786. else
  22787. Include(Flags,rcNoImplicitProcType);
  22788. ComputeElement(RHS,RightResolved,Flags);
  22789. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  22790. if RHS is TPasExpr then
  22791. CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
  22792. end;
  22793. procedure TPasResolver.CheckAssignExprRange(
  22794. const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  22795. // if RHS is a constant check if it fits into range LeftResolved
  22796. var
  22797. LRangeValue, RValue: TResEvalValue;
  22798. Int, MinVal, MaxVal: TMaxPrecInt;
  22799. RangeExpr: TBinaryExpr;
  22800. C: TClass;
  22801. EnumType: TPasEnumType;
  22802. bt: TResolverBaseType;
  22803. LTypeEl: TPasType;
  22804. begin
  22805. LTypeEl:=LeftResolved.LoTypeEl;
  22806. if (LTypeEl<>nil)
  22807. and ((LTypeEl.ClassType=TPasArrayType)
  22808. or (LTypeEl.ClassType=TPasRecordType)) then
  22809. exit; // arrays and records are checked by element, not by the whole value
  22810. if LTypeEl is TPasClassOfType then
  22811. exit; // class-of are checked only by type, not by value
  22812. RValue:=Eval(RHS,[refAutoConstExt]);
  22813. if RValue=nil then
  22814. exit; // not a const expression
  22815. {$IFDEF VerbosePasResEval}
  22816. writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
  22817. {$ENDIF}
  22818. LRangeValue:=nil;
  22819. try
  22820. if RValue.Kind=revkExternal then
  22821. // skip
  22822. else if LeftResolved.BaseType=btCustom then
  22823. CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
  22824. else if LeftResolved.BaseType=btSet then
  22825. begin
  22826. // assign to a set
  22827. C:=LTypeEl.ClassType;
  22828. if C=TPasRangeType then
  22829. begin
  22830. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  22831. LRangeValue:=Eval(RangeExpr,[refConst],false);
  22832. end
  22833. else if C=TPasEnumType then
  22834. begin
  22835. EnumType:=TPasEnumType(LTypeEl);
  22836. LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
  22837. 0,TMaxPrecInt(EnumType.Values.Count)-1);
  22838. end
  22839. else if C=TPasUnresolvedSymbolRef then
  22840. begin
  22841. // set of basetype
  22842. if LTypeEl.CustomData is TResElDataBaseType then
  22843. begin
  22844. bt:=GetActualBaseType(TResElDataBaseType(LTypeEl.CustomData).BaseType);
  22845. if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinVal,MaxVal) then
  22846. LRangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
  22847. else if bt=btBoolean then
  22848. LRangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
  22849. {$ifdef FPC_HAS_CPSTRING}
  22850. else if bt=btAnsiChar then
  22851. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  22852. {$endif}
  22853. else if bt=btWideChar then
  22854. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
  22855. else
  22856. RaiseNotYetImplemented(20170714205110,RHS);
  22857. end
  22858. else
  22859. RaiseNotYetImplemented(20170714204803,RHS);
  22860. end
  22861. else
  22862. RaiseNotYetImplemented(20170714193100,RHS);
  22863. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true);
  22864. end
  22865. else if LTypeEl is TPasRangeType then
  22866. begin
  22867. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  22868. LRangeValue:=Eval(RangeExpr,[refConst]);
  22869. if LeftResolved.BaseType=btSet then
  22870. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true)
  22871. else
  22872. fExprEvaluator.IsInRange(RValue,RHS,LRangeValue,RangeExpr,true);
  22873. end
  22874. else if (LeftResolved.BaseType in btAllIntegerNoQWord)
  22875. and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
  22876. case RValue.Kind of
  22877. revkInt:
  22878. if (MinVal>TResEvalInt(RValue).Int)
  22879. or (MaxVal<TResEvalInt(RValue).Int) then
  22880. fExprEvaluator.EmitRangeCheckConst(20170530093126,
  22881. IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
  22882. revkUInt:
  22883. if (TResEvalUInt(RValue).UInt>High(TMaxPrecInt))
  22884. or (MinVal>TMaxPrecInt(TResEvalUInt(RValue).UInt))
  22885. or (MaxVal<TMaxPrecInt(TResEvalUInt(RValue).UInt)) then
  22886. fExprEvaluator.EmitRangeCheckConst(20170530093616,
  22887. IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
  22888. revkFloat:
  22889. if TResEvalFloat(RValue).IsInt(Int) then
  22890. begin
  22891. if (MinVal>Int) or (MaxVal<Int) then
  22892. fExprEvaluator.EmitRangeCheckConst(20170802133307,
  22893. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  22894. end
  22895. else
  22896. begin
  22897. {$IFDEF VerbosePasResEval}
  22898. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<TMaxPrecFloat(low(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>TMaxPrecFloat(high(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(TMaxPrecInt));
  22899. {$ENDIF}
  22900. RaiseRangeCheck(20170802133750,RHS);
  22901. end;
  22902. revkCurrency:
  22903. if TResEvalCurrency(RValue).IsInt(Int) then
  22904. begin
  22905. if (MinVal>Int) or (MaxVal<Int) then
  22906. fExprEvaluator.EmitRangeCheckConst(20180421171325,
  22907. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  22908. end
  22909. else
  22910. begin
  22911. {$IFDEF VerbosePasResEval}
  22912. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalCurrency(RValue).Value),' ',TResEvalCurrency(RValue).Value,' ',high(TMaxPrecInt));
  22913. {$ENDIF}
  22914. RaiseRangeCheck(20180421171438,RHS);
  22915. end;
  22916. else
  22917. {$IFDEF VerbosePasResEval}
  22918. writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
  22919. {$ENDIF}
  22920. RaiseNotYetImplemented(20170530092731,RHS);
  22921. end
  22922. {$ifdef HasInt64}
  22923. else if LeftResolved.BaseType=btQWord then
  22924. case RValue.Kind of
  22925. revkInt:
  22926. if (TResEvalInt(RValue).Int<0) then
  22927. fExprEvaluator.EmitRangeCheckConst(20170530094316,
  22928. IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
  22929. revkUInt: ;
  22930. else
  22931. RaiseNotYetImplemented(20170530094311,RHS);
  22932. end
  22933. {$endif}
  22934. else if RValue.Kind in [revkNil,revkBool] then
  22935. // simple type check is enough
  22936. else if LeftResolved.BaseType in [btSingle,btDouble,btCurrency] then
  22937. // simple type check is enough
  22938. // ToDo: warn if precision loss
  22939. else if LeftResolved.BaseType in btAllChars then
  22940. begin
  22941. case RValue.Kind of
  22942. {$ifdef FPC_HAS_CPSTRING}
  22943. revkString,
  22944. {$endif}
  22945. revkUnicodeString:
  22946. Int:=fExprEvaluator.StringToOrd(RValue,RHS);
  22947. else
  22948. RaiseNotYetImplemented(20170714171218,RHS);
  22949. end;
  22950. case GetActualBaseType(LeftResolved.BaseType) of
  22951. {$ifdef FPC_HAS_CPSTRING}
  22952. btAnsiChar: MaxVal:=$ff;
  22953. {$endif}
  22954. btWideChar: MaxVal:=$ffff;
  22955. end;
  22956. if (Int>MaxVal) then
  22957. fExprEvaluator.EmitRangeCheckConst(20170714171911,
  22958. '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
  22959. end
  22960. else if LeftResolved.BaseType in btAllStrings then
  22961. // simple type check is enough
  22962. // ToDo: warn if unicode to non-utf8
  22963. else if LeftResolved.BaseType=btContext then
  22964. // simple type check is enough
  22965. else if LeftResolved.BaseType=btRange then
  22966. begin
  22967. if (LeftResolved.ExprEl is TBinaryExpr)
  22968. and (TBinaryExpr(LeftResolved.ExprEl).Kind=pekRange) then
  22969. begin
  22970. LRangeValue:=Eval(LeftResolved.ExprEl,[refConst]);
  22971. try
  22972. case LRangeValue.Kind of
  22973. revkRangeInt:
  22974. case TResEvalRangeInt(LRangeValue).ElKind of
  22975. revskEnum:
  22976. if (RValue.Kind<>revkEnum) then
  22977. RaiseNotYetImplemented(20171009171251,RHS)
  22978. else if (TResEvalEnum(RValue).Index<TResEvalRangeInt(LRangeValue).RangeStart)
  22979. or (TResEvalEnum(RValue).Index>TResEvalRangeInt(LRangeValue).RangeEnd) then
  22980. fExprEvaluator.EmitRangeCheckConst(20171009171442,
  22981. TResEvalEnum(RValue).AsString,
  22982. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeStart),
  22983. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeEnd),
  22984. RHS);
  22985. else
  22986. RaiseNotYetImplemented(20171009165348,LeftResolved.ExprEl);
  22987. end;
  22988. else
  22989. RaiseNotYetImplemented(20171009165326,LeftResolved.ExprEl);
  22990. end;
  22991. finally
  22992. ReleaseEvalValue(LRangeValue);
  22993. end;
  22994. end
  22995. else
  22996. RaiseNotYetImplemented(20171009171005,RHS);
  22997. end
  22998. else
  22999. begin
  23000. {$IFDEF VerbosePasResolver}
  23001. writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
  23002. {$ENDIF}
  23003. RaiseNotYetImplemented(20170530095243,RHS);
  23004. end;
  23005. finally
  23006. ReleaseEvalValue(RValue);
  23007. ReleaseEvalValue(LRangeValue);
  23008. end;
  23009. end;
  23010. procedure TPasResolver.CheckAssignExprRangeToCustom(
  23011. const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
  23012. begin
  23013. if LeftResolved.BaseType<>btCustom then exit;
  23014. if RValue=nil then exit;
  23015. if RHS=nil then ;
  23016. end;
  23017. function TPasResolver.CheckAssignResCompatibility(const LHS,
  23018. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  23019. ): integer;
  23020. var
  23021. LTypeEl, RTypeEl: TPasType;
  23022. Handled: Boolean;
  23023. C: TClass;
  23024. LBT, RBT: TResolverBaseType;
  23025. LRange, RValue, Value: TResEvalValue;
  23026. RightSubResolved: TPasResolverResult;
  23027. wc: WideChar;
  23028. begin
  23029. // check if the RHS can be converted to LHS
  23030. {$IFDEF VerbosePasResolver}
  23031. writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  23032. {$ENDIF}
  23033. Result:=-1;
  23034. Handled:=false;
  23035. Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
  23036. if Handled and (Result>=cExact) and (Result<cIncompatible) then
  23037. exit;
  23038. if not Handled then
  23039. begin
  23040. LBT:=GetActualBaseType(LHS.BaseType);
  23041. RBT:=GetActualBaseType(RHS.BaseType);
  23042. if IsGenericTemplType(LHS) then
  23043. begin
  23044. // Template := RHS
  23045. if not RaiseOnIncompatible then
  23046. ErrorEl:=nil;
  23047. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),
  23048. RHS,prtcoAssignToTempl,ErrorEl);
  23049. exit;
  23050. end
  23051. else if IsGenericTemplType(RHS) then
  23052. begin
  23053. // LHS := Template
  23054. if not RaiseOnIncompatible then
  23055. ErrorEl:=nil;
  23056. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),
  23057. LHS,prtcoAssignFromTempl,ErrorEl);
  23058. exit;
  23059. end;
  23060. if LHS.LoTypeEl=nil then
  23061. begin
  23062. if LBT=btUntyped then
  23063. begin
  23064. // untyped parameter
  23065. Result:=cTypeConversion;
  23066. end
  23067. else
  23068. RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
  23069. end
  23070. else if LBT=RBT then
  23071. begin
  23072. if LBT=btContext then
  23073. exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
  23074. else
  23075. begin
  23076. // same base type, maybe not same type (e.g. longint and integer)
  23077. if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  23078. and HasExactType(RHS) then
  23079. Result:=cExact
  23080. else
  23081. Result:=cAliasExact;
  23082. end;
  23083. end
  23084. else if (LBT in btAllBooleans)
  23085. and (RBT in btAllBooleans) then
  23086. Result:=cCompatible
  23087. else if (LBT in btAllChars) then
  23088. begin
  23089. if (RBT in btAllChars) then
  23090. case LBT of
  23091. {$ifdef FPC_HAS_CPSTRING}
  23092. btAnsiChar:
  23093. Result:=cLossyConversion;
  23094. {$endif}
  23095. btWideChar:
  23096. {$ifdef FPC_HAS_CPSTRING}
  23097. if RBT=btAnsiChar then
  23098. Result:=cCompatible
  23099. else
  23100. {$endif}
  23101. Result:=cLossyConversion;
  23102. else
  23103. RaiseNotYetImplemented(20170728132440,ErrorEl,BaseTypeNames[LBT]);
  23104. end
  23105. else if (RBT=btRange) and (RHS.SubType in btAllChars) then
  23106. begin
  23107. if LBT=btWideChar then
  23108. exit(cCompatible);
  23109. {$ifdef FPC_HAS_CPSTRING}
  23110. // LHS is ansichar
  23111. if GetActualBaseType(RHS.SubType)=btAnsiChar then
  23112. exit(cExact);
  23113. RValue:=Eval(RHS,[refAutoConstExt]);
  23114. if RValue<>nil then
  23115. try
  23116. // ansichar:=constvalue
  23117. case RValue.Kind of
  23118. revkString:
  23119. if not ExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  23120. exit(cIncompatible);
  23121. revkUnicodeString:
  23122. begin
  23123. if length(TResEvalUTF16(RValue).S)<>1 then
  23124. exit(cIncompatible);
  23125. wc:=TResEvalUTF16(RValue).S[1];
  23126. end;
  23127. revkExternal:
  23128. exit(cCompatible);
  23129. else
  23130. RaiseNotYetImplemented(20171108194650,ErrorEl);
  23131. end;
  23132. if ord(wc)>255 then
  23133. exit(cIncompatible);
  23134. exit(cCompatible);
  23135. finally
  23136. ReleaseEvalValue(RValue);
  23137. end;
  23138. // LHS is ansichar, RHS is not a const
  23139. if (RHS.ExprEl is TBinaryExpr) and (TBinaryExpr(RHS.ExprEl).Kind=pekRange) then
  23140. begin
  23141. RValue:=Eval(RHS.ExprEl,[refConst]);
  23142. try
  23143. if RValue.Kind<>revkRangeInt then
  23144. RaiseNotYetImplemented(20171108195035,ErrorEl);
  23145. if TResEvalRangeInt(RValue).RangeStart>255 then
  23146. exit(cIncompatible);
  23147. if TResEvalRangeInt(RValue).RangeEnd>255 then
  23148. exit(cLossyConversion);
  23149. exit(cCompatible);
  23150. finally
  23151. ReleaseEvalValue(RValue);
  23152. end;
  23153. end;
  23154. {$endif}
  23155. RaiseNotYetImplemented(20171108195216,ErrorEl);
  23156. end;
  23157. end
  23158. else if (LBT in btAllStrings) then
  23159. begin
  23160. if (RBT in btAllStringAndChars) then
  23161. case LBT of
  23162. {$ifdef FPC_HAS_CPSTRING}
  23163. btAnsiString:
  23164. if RBT in [btAnsiChar,btShortString,btRawByteString] then
  23165. Result:=cCompatible
  23166. else
  23167. Result:=cLossyConversion;
  23168. btShortString:
  23169. if RBT=btAnsiChar then
  23170. Result:=cCompatible
  23171. else
  23172. Result:=cLossyConversion;
  23173. btRawByteString:
  23174. if RBT in [btAnsiChar,btAnsiString,btShortString] then
  23175. Result:=cCompatible
  23176. else
  23177. Result:=cLossyConversion;
  23178. {$endif}
  23179. btWideString,btUnicodeString:
  23180. Result:=cCompatible;
  23181. else
  23182. {$IFDEF VerbosePasResolver}
  23183. writeln('TPasResolver.CheckAssignResCompatibility ',{$ifdef pas2js}str(LBT){$else}LBT{$ENDIF});
  23184. {$ENDIF}
  23185. RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
  23186. end
  23187. else if RBT=btContext then
  23188. begin
  23189. RTypeEl:=RHS.LoTypeEl;
  23190. if RTypeEl.ClassType=TPasClassType then
  23191. begin
  23192. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  23193. and IsTGUIDString(LHS) then
  23194. // aGUIDString:=IntfTypeOrVar
  23195. exit(cInterfaceToString); // no check for rrfReadable
  23196. end
  23197. else if RTypeEl.ClassType=TPasRecordType then
  23198. begin
  23199. if IsTGUID(TPasRecordType(RTypeEl)) then
  23200. // aString:=GUID
  23201. Result:=cTGUIDToString;
  23202. end;
  23203. end;
  23204. end
  23205. else if (LBT in btAllInteger)
  23206. and (RBT in btAllInteger) then
  23207. begin
  23208. Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
  23209. case LBT of
  23210. btByte,
  23211. btShortInt: inc(Result,cLossyConversion);
  23212. btWord,
  23213. btSmallInt:
  23214. if not (RBT in [btByte,btShortInt]) then
  23215. inc(Result,cLossyConversion);
  23216. btUIntSingle:
  23217. if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
  23218. inc(Result,cLossyConversion);
  23219. btIntSingle:
  23220. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
  23221. inc(Result,cLossyConversion);
  23222. btLongWord,
  23223. btLongint:
  23224. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
  23225. inc(Result,cLossyConversion);
  23226. btUIntDouble:
  23227. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
  23228. inc(Result,cLossyConversion);
  23229. btIntDouble:
  23230. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
  23231. inc(Result,cLossyConversion);
  23232. {$ifdef HasInt64}
  23233. btQWord,
  23234. btInt64,btComp:
  23235. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
  23236. btLongWord,btLongint,btUIntDouble,btIntDouble]) then
  23237. inc(Result,cLossyConversion);
  23238. {$endif}
  23239. else
  23240. RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
  23241. end;
  23242. end
  23243. else if (LBT in btAllFloats)
  23244. and (RBT in btAllFloats) then
  23245. begin
  23246. Result:=cFloatToFloatConversion+ord(LBT)-ord(RBT);
  23247. case LBT of
  23248. btSingle:
  23249. if RBT>btSingle then
  23250. inc(Result,cLossyConversion);
  23251. btDouble:
  23252. if RBT>btDouble then
  23253. inc(Result,cLossyConversion);
  23254. btExtended,btCExtended:
  23255. if RBT>btCExtended then
  23256. inc(Result,cLossyConversion);
  23257. btCurrency:
  23258. inc(Result,cLossyConversion);
  23259. else
  23260. RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
  23261. end;
  23262. end
  23263. else if (LBT in btAllFloats)
  23264. and (RBT in btAllInteger) then
  23265. begin
  23266. Result:=cIntToFloatConversion+ord(LBT)-ord(RBT);
  23267. case LBT of
  23268. btSingle:
  23269. if RBT>btUIntSingle then
  23270. inc(Result,cLossyConversion);
  23271. btDouble:
  23272. if RBT>btUIntDouble then
  23273. inc(Result,cLossyConversion);
  23274. btExtended,btCExtended:
  23275. if RBT>btCExtended then
  23276. inc(Result,cLossyConversion);
  23277. btCurrency:
  23278. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  23279. btIntSingle,btUIntSingle,
  23280. btLongWord,btLongint]) then
  23281. inc(Result,cLossyConversion);
  23282. else
  23283. RaiseNotYetImplemented(20170417205911,ErrorEl,BaseTypeNames[LBT]);
  23284. end;
  23285. end
  23286. else if LBT=btNil then
  23287. begin
  23288. if RaiseOnIncompatible then
  23289. RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
  23290. [],ErrorEl);
  23291. exit(cIncompatible);
  23292. end
  23293. else if LBT=btRange then
  23294. begin
  23295. if (LHS.ExprEl is TBinaryExpr) and (TBinaryExpr(LHS.ExprEl).Kind=pekRange) then
  23296. begin
  23297. LRange:=Eval(LHS.ExprEl,[refConst]);
  23298. RValue:=nil;
  23299. try
  23300. {$IFDEF VerbosePasResolver}
  23301. //writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString);
  23302. {$ENDIF}
  23303. case LRange.Kind of
  23304. revkRangeInt:
  23305. case TResEvalRangeInt(LRange).ElKind of
  23306. revskEnum:
  23307. if RHS.BaseType=btContext then
  23308. begin
  23309. if IsSameType(TResEvalRangeInt(LRange).ElType,RHS.LoTypeEl,prraAlias) then
  23310. begin
  23311. // same enum type
  23312. {$IFDEF VerbosePasResolver}
  23313. writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString,' Left.ElType=',GetObjName(TResEvalRangeInt(LRange).ElType),' RHS.TypeEl=',GetObjName(RHS.LoTypeEl));
  23314. {$ENDIF}
  23315. // ToDo: check if LRange is smaller than Range of RHS (cLossyConversion)
  23316. exit(cExact);
  23317. end;
  23318. end;
  23319. revskInt:
  23320. if RHS.BaseType in btAllInteger then
  23321. begin
  23322. RValue:=Eval(RHS,[refAutoConstExt]);
  23323. if RValue<>nil then
  23324. begin
  23325. // ToDo: check range
  23326. end;
  23327. exit(cCompatible);
  23328. end;
  23329. revskChar:
  23330. if RHS.BaseType in btAllStringAndChars then
  23331. begin
  23332. RValue:=Eval(RHS,[refAutoConstExt]);
  23333. if RValue<>nil then
  23334. begin
  23335. case RValue.Kind of
  23336. {$ifdef FPC_HAS_CPSTRING}
  23337. revkString:
  23338. if not fExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  23339. exit(cIncompatible);
  23340. {$endif}
  23341. revkUnicodeString:
  23342. begin
  23343. if length(TResEvalUTF16(RValue).S)<>1 then
  23344. exit(cIncompatible);
  23345. wc:=TResEvalUTF16(RValue).S[1];
  23346. end;
  23347. revkExternal:
  23348. exit(cCompatible);
  23349. else
  23350. RaiseNotYetImplemented(20171108192232,ErrorEl);
  23351. end;
  23352. if (ord(wc)<TResEvalRangeInt(LRange).RangeStart)
  23353. or (ord(wc)>TResEvalRangeInt(LRange).RangeEnd) then
  23354. exit(cIncompatible);
  23355. end;
  23356. exit(cCompatible);
  23357. end;
  23358. revskBool:
  23359. if RHS.BaseType=btBoolean then
  23360. begin
  23361. RValue:=Eval(RHS,[refAutoConstExt]);
  23362. if RValue<>nil then
  23363. begin
  23364. // ToDo: check range
  23365. end;
  23366. exit(cCompatible);
  23367. end;
  23368. end;
  23369. end;
  23370. finally
  23371. ReleaseEvalValue(LRange);
  23372. ReleaseEvalValue(RValue);
  23373. end;
  23374. end;
  23375. end
  23376. else if LBT=btSet then
  23377. begin
  23378. if RBT=btArrayOrSet then
  23379. begin
  23380. if RHS.SubType=btNone then
  23381. // a:=[]
  23382. Result:=cExact
  23383. else if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  23384. and HasExactType(RHS) then
  23385. Result:=cExact
  23386. else if LHS.SubType=RHS.SubType then
  23387. Result:=cAliasExact
  23388. else if (LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans) then
  23389. Result:=cCompatible
  23390. else if (LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger) then
  23391. begin
  23392. // ToDo: range check
  23393. Result:=cCompatible;
  23394. end
  23395. else if (LHS.SubType in btAllChars) and (RHS.SubType in btAllChars) then
  23396. begin
  23397. // ToDo: range check
  23398. Result:=cCompatible;
  23399. end;
  23400. end;
  23401. end
  23402. else if LBT in [btArrayLit,btArrayOrSet,btModule,btProc] then
  23403. begin
  23404. if RaiseOnIncompatible then
  23405. RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  23406. exit(cIncompatible);
  23407. end
  23408. else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
  23409. begin
  23410. if RaiseOnIncompatible then
  23411. RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  23412. exit(cIncompatible);
  23413. end
  23414. else if RBT=btNil then
  23415. begin
  23416. if LBT=btPointer then
  23417. Result:=cExact
  23418. else if LBT=btContext then
  23419. begin
  23420. LTypeEl:=LHS.LoTypeEl;
  23421. C:=LTypeEl.ClassType;
  23422. if (C=TPasClassType)
  23423. or (C=TPasClassOfType)
  23424. or (C=TPasPointerType)
  23425. or C.InheritsFrom(TPasProcedureType)
  23426. or IsDynArray(LTypeEl) then
  23427. Result:=cExact;
  23428. end;
  23429. end
  23430. else if RBT=btProc then
  23431. begin
  23432. if (msDelphi in CurrentParser.CurrentModeswitches)
  23433. and (LHS.LoTypeEl is TPasProcedureType)
  23434. and (RHS.IdentEl is TPasProcedure) then
  23435. begin
  23436. // for example ProcVar:=Proc
  23437. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  23438. TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
  23439. exit(cExact);
  23440. end
  23441. else if (LHS.LoTypeEl is TPasProcedureType)
  23442. and (RHS.ExprEl is TProcedureExpr) then
  23443. begin
  23444. // for example ProcVar:=anonymous-procedure...
  23445. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  23446. TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
  23447. exit(cExact);
  23448. end
  23449. end
  23450. else if LBT=btPointer then
  23451. begin
  23452. if RBT=btPointer then
  23453. begin
  23454. LTypeEl:=LHS.LoTypeEl;
  23455. RTypeEl:=RHS.LoTypeEl;
  23456. if IsBaseType(LTypeEl,btPointer) then
  23457. Result:=cExact // btPointer can take any pointer
  23458. else if IsBaseType(RTypeEl,btPointer) then
  23459. Result:=cTypeConversion // any pointer can take a btPointer
  23460. else if IsSameType(LTypeEl,RTypeEl,prraAlias) then
  23461. Result:=cExact // pointer of same type
  23462. else if (LTypeEl.ClassType=TPasPointerType)
  23463. and (RTypeEl.ClassType=TPasPointerType) then
  23464. Result:=CheckAssignCompatibility(TPasPointerType(LTypeEl).DestType,
  23465. TPasPointerType(RTypeEl).DestType,RaiseOnIncompatible);
  23466. end
  23467. else if IsBaseType(LHS.LoTypeEl,btPointer) then
  23468. begin
  23469. // UntypedPointer:=...
  23470. if RBT=btContext then
  23471. begin
  23472. RTypeEl:=RHS.LoTypeEl;
  23473. C:=RTypeEl.ClassType;
  23474. if C=TPasClassType then
  23475. // UntypedPointer:=ClassTypeOrInstance
  23476. exit(cTypeConversion)
  23477. else if C=TPasClassOfType then
  23478. // UntypedPointer:=ClassOfVar
  23479. Result:=cTypeConversion
  23480. else if C=TPasArrayType then
  23481. begin
  23482. if IsDynArray(RTypeEl) then
  23483. // UntypedPointer:=DynArray
  23484. Result:=cTypeConversion;
  23485. end
  23486. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  23487. // UntypedPointer:=procvar
  23488. Result:=cLossyConversion
  23489. else if C=TPasPointerType then
  23490. // UntypedPointer:=TypedPointer
  23491. Result:=cExact;
  23492. end;
  23493. end;
  23494. end
  23495. else if (LBT=btContext) then
  23496. begin
  23497. LTypeEl:=LHS.LoTypeEl;
  23498. if (LTypeEl.ClassType=TPasArrayType) then
  23499. Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
  23500. else if LTypeEl.ClassType=TPasEnumType then
  23501. begin
  23502. if (RHS.BaseType=btRange) and (RHS.SubType=btContext) then
  23503. begin
  23504. RTypeEl:=RHS.LoTypeEl;
  23505. if RTypeEl.ClassType=TPasRangeType then
  23506. begin
  23507. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,RightSubResolved,[rcConstant]);
  23508. if (RightSubResolved.BaseType=btContext)
  23509. and IsSameType(LTypeEl,RightSubResolved.LoTypeEl,prraAlias) then
  23510. begin
  23511. // enumtype := enumrange
  23512. Result:=cExact;
  23513. end;
  23514. end;
  23515. end;
  23516. end
  23517. else if LTypeEl.ClassType=TPasRecordType then
  23518. begin
  23519. if (RBT in btAllStrings) and IsTGUID(TPasRecordType(LTypeEl))
  23520. and (rrfReadable in RHS.Flags) then
  23521. begin
  23522. // GUIDVar := string, e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
  23523. Value:=Eval(RHS,[refConstExt]);
  23524. try
  23525. if Value=nil then
  23526. if RaiseOnIncompatible then
  23527. RaiseXExpectedButYFound(20180414105916,'string literal','string', ErrorEl)
  23528. else
  23529. exit(cIncompatible);
  23530. finally
  23531. ReleaseEvalValue(Value);
  23532. end;
  23533. Result:=cStringToTGUID;
  23534. end;
  23535. end
  23536. else if LTypeEl.ClassType=TPasPointerType then
  23537. begin
  23538. // TypedPointer:=
  23539. if RHS.BaseType=btPointer then
  23540. begin
  23541. RTypeEl:=RHS.LoTypeEl;
  23542. if IsBaseType(RTypeEl,btPointer) then
  23543. // TypedPointer:=UntypedPointer
  23544. Result:=cTypeConversion
  23545. else
  23546. begin
  23547. // TypedPointer:=@Var
  23548. Result:=CheckAssignCompatibilityPointerType(
  23549. TPasPointerType(LTypeEl).DestType,RTypeEl,ErrorEl,false);
  23550. end;
  23551. end;
  23552. end;
  23553. end;
  23554. end;
  23555. if (Result>=0) and (Result<cIncompatible) then
  23556. begin
  23557. // type fits -> check readable
  23558. if not (rrfReadable in RHS.Flags) then
  23559. begin
  23560. if RaiseOnIncompatible then
  23561. begin
  23562. {$IFDEF VerbosePasResolver}
  23563. writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  23564. {$ENDIF}
  23565. RaiseVarExpected(20170318235637,ErrorEl,RHS.IdentEl);
  23566. end;
  23567. exit(cIncompatible);
  23568. end;
  23569. exit;
  23570. end;
  23571. // incompatible
  23572. {$IFDEF VerbosePasResolver}
  23573. writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  23574. {$ENDIF}
  23575. if not RaiseOnIncompatible then
  23576. exit(cIncompatible);
  23577. // create error messages
  23578. RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
  23579. [],RHS,LHS,ErrorEl);
  23580. end;
  23581. function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
  23582. ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
  23583. ): integer;
  23584. // check if the RightResolved is type compatible to LeftResolved
  23585. var
  23586. LFlags, RFlags: TPasResolverComputeFlags;
  23587. LeftResolved, RightResolved: TPasResolverResult;
  23588. LeftErrorEl, RightErrorEl: TPasElement;
  23589. begin
  23590. Result:=cIncompatible;
  23591. // Delphi resolves both sides, so it forbids "if procvar=procvar then"
  23592. // FPC is more clever. It supports "if procvar=@proc then", "function=value"
  23593. if msDelphi in CurrentParser.CurrentModeswitches then
  23594. LFlags:=[]
  23595. else
  23596. LFlags:=[rcNoImplicitProcType];
  23597. if SetReferenceFlags then
  23598. Include(LFlags,rcSetReferenceFlags);
  23599. ComputeElement(Left,LeftResolved,LFlags);
  23600. if (msDelphi in CurrentParser.CurrentModeswitches) then
  23601. RFlags:=LFlags
  23602. else
  23603. begin
  23604. if LeftResolved.BaseType=btNil then
  23605. RFlags:=[rcNoImplicitProcType]
  23606. else if IsProcedureType(LeftResolved,true) then
  23607. RFlags:=[rcNoImplicitProcType]
  23608. else
  23609. RFlags:=[];
  23610. end;
  23611. if SetReferenceFlags then
  23612. Include(RFlags,rcSetReferenceFlags);
  23613. {$IFDEF VerbosePasResolver}
  23614. writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
  23615. {$ENDIF}
  23616. ComputeElement(Right,RightResolved,RFlags);
  23617. if ErrorEl=nil then
  23618. begin
  23619. LeftErrorEl:=Left;
  23620. RightErrorEl:=Right;
  23621. end
  23622. else
  23623. begin
  23624. LeftErrorEl:=ErrorEl;
  23625. RightErrorEl:=ErrorEl;
  23626. end;
  23627. Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
  23628. RaiseOnIncompatible,RightErrorEl);
  23629. end;
  23630. function TPasResolver.CheckEqualResCompatibility(const LHS,
  23631. RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  23632. RErrorEl: TPasElement): integer;
  23633. var
  23634. LTypeEl, RTypeEl: TPasType;
  23635. ResolvedEl: TPasResolverResult;
  23636. begin
  23637. Result:=cIncompatible;
  23638. if RErrorEl=nil then RErrorEl:=LErrorEl;
  23639. // check if the RHS is type compatible to LHS
  23640. {$IFDEF VerbosePasResolver}
  23641. writeln('TPasResolver.CheckEqualResCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  23642. {$ENDIF}
  23643. if not (rrfReadable in LHS.Flags) then
  23644. begin
  23645. if (LHS.BaseType=btContext) then
  23646. begin
  23647. LTypeEl:=LHS.LoTypeEl;
  23648. if (LTypeEl.ClassType=TPasClassType)
  23649. and (ResolveAliasTypeEl(LHS.IdentEl)=LTypeEl) then
  23650. begin
  23651. // LHS is class type, e.g. TObject or IInterface
  23652. if RHS.BaseType=btNil then
  23653. exit(cExact)
  23654. else if RHS.BaseType in btAllStrings then
  23655. begin
  23656. if (rrfReadable in RHS.Flags)
  23657. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  23658. and IsTGUIDString(RHS) then
  23659. // e.g. IUnknown=aGUIDString
  23660. exit(cInterfaceToString);
  23661. end
  23662. else if (RHS.BaseType=btContext) then
  23663. begin
  23664. RTypeEl:=RHS.LoTypeEl;
  23665. if (RTypeEl.ClassType=TPasClassOfType)
  23666. and (rrfReadable in RHS.Flags)
  23667. and (TPasClassType(LTypeEl).ObjKind=okClass) then
  23668. // for example if TImage=ImageClass then
  23669. exit(cExact)
  23670. else if (RTypeEl.ClassType=TPasRecordType)
  23671. and (rrfReadable in RHS.Flags)
  23672. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  23673. and IsTGUID(TPasRecordType(RTypeEl)) then
  23674. // e.g. if IUnknown=TGuidVar then
  23675. exit(cInterfaceToTGUID);
  23676. end;
  23677. end;
  23678. end;
  23679. RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
  23680. end;
  23681. if not (rrfReadable in RHS.Flags) then
  23682. begin
  23683. if (RHS.BaseType=btContext) then
  23684. begin
  23685. RTypeEl:=RHS.LoTypeEl;
  23686. if (RTypeEl.ClassType=TPasClassType)
  23687. and (ResolveAliasTypeEl(RHS.IdentEl)=RTypeEl) then
  23688. begin
  23689. // RHS is class type, e.g. TObject or IInterface
  23690. if LHS.BaseType=btNil then
  23691. exit(cExact)
  23692. else if LHS.BaseType in btAllStrings then
  23693. begin
  23694. if (rrfReadable in LHS.Flags)
  23695. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  23696. and IsTGUIDString(LHS) then
  23697. // e.g. aGUIDString=IUnknown
  23698. exit(cInterfaceToString);
  23699. end
  23700. else if (LHS.BaseType=btContext) then
  23701. begin
  23702. LTypeEl:=LHS.LoTypeEl;
  23703. if (LTypeEl.ClassType=TPasClassOfType)
  23704. and (rrfReadable in LHS.Flags)
  23705. and (TPasClassType(RTypeEl).ObjKind=okClass) then
  23706. // for example if ImageClass=TImage then
  23707. exit(cExact)
  23708. else if (LTypeEl.ClassType=TPasRecordType)
  23709. and (rrfReadable in LHS.Flags)
  23710. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  23711. and IsTGUID(TPasRecordType(LTypeEl)) then
  23712. // e.g. if TGuidVar=IUnknown then
  23713. exit(cInterfaceToTGUID);
  23714. end;
  23715. end;
  23716. end;
  23717. RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
  23718. end;
  23719. if IsGenericTemplType(LHS) then
  23720. begin
  23721. // TemplateVar = x
  23722. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),RHS,prtcoEqual,nil);
  23723. if Result<>cIncompatible then exit;
  23724. end
  23725. else if IsGenericTemplType(RHS) then
  23726. begin
  23727. // x = TemplateVar
  23728. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),LHS,prtcoEqual,nil);
  23729. if Result<>cIncompatible then exit;
  23730. end;
  23731. if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
  23732. begin
  23733. Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
  23734. if (Result=cIncompatible) and RaiseOnIncompatible then
  23735. RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
  23736. [],RHS,LHS,LErrorEl);
  23737. exit;
  23738. end
  23739. else if LHS.BaseType=RHS.BaseType then
  23740. begin
  23741. if LHS.BaseType=btContext then
  23742. exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
  23743. else
  23744. exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
  23745. end
  23746. else if LHS.BaseType in btAllInteger then
  23747. begin
  23748. if RHS.BaseType in btAllInteger+btAllFloats then
  23749. exit(cCompatible)
  23750. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  23751. exit(cCompatible);
  23752. end
  23753. else if LHS.BaseType in btAllFloats then
  23754. begin
  23755. if RHS.BaseType in btAllInteger+btAllFloats then
  23756. exit(cCompatible);
  23757. end
  23758. else if LHS.BaseType in btAllBooleans then
  23759. begin
  23760. if RHS.BaseType in btAllBooleans then
  23761. exit(cCompatible)
  23762. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  23763. exit(cCompatible);
  23764. end
  23765. else if LHS.BaseType in btAllStringAndChars then
  23766. begin
  23767. if RHS.BaseType in btAllStringAndChars then
  23768. exit(cCompatible)
  23769. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  23770. exit(cCompatible)
  23771. else if RHS.BaseType=btContext then
  23772. begin
  23773. RTypeEl:=RHS.LoTypeEl;
  23774. if (RTypeEl.ClassType=TPasClassType) then
  23775. begin
  23776. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  23777. and IsTGUIDString(LHS) then
  23778. // e.g. aGUIDString=IntfVar
  23779. exit(cInterfaceToString);
  23780. end
  23781. else if (RTypeEl.ClassType=TPasRecordType)
  23782. and IsTGUID(TPasRecordType(RTypeEl)) then
  23783. // e.g. aString=GuidVar
  23784. exit(cTGUIDToString);
  23785. end;
  23786. end
  23787. else if LHS.BaseType=btNil then
  23788. begin
  23789. if RHS.BaseType in [btPointer,btNil] then
  23790. exit(cExact)
  23791. else if RHS.BaseType=btContext then
  23792. begin
  23793. LTypeEl:=RHS.LoTypeEl;
  23794. if (LTypeEl.ClassType=TPasClassType)
  23795. or (LTypeEl.ClassType=TPasClassOfType)
  23796. or (LTypeEl.ClassType=TPasPointerType)
  23797. or (LTypeEl is TPasProcedureType)
  23798. or IsDynArray(LTypeEl) then
  23799. exit(cExact);
  23800. end;
  23801. if RaiseOnIncompatible then
  23802. RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
  23803. [],RHS,LHS,RErrorEl)
  23804. else
  23805. exit(cIncompatible);
  23806. end
  23807. else if RHS.BaseType=btNil then
  23808. begin
  23809. if LHS.BaseType=btPointer then
  23810. exit(cExact)
  23811. else if LHS.BaseType=btContext then
  23812. begin
  23813. LTypeEl:=LHS.LoTypeEl;
  23814. if (LTypeEl.ClassType=TPasClassType)
  23815. or (LTypeEl.ClassType=TPasClassOfType)
  23816. or (LTypeEl.ClassType=TPasPointerType)
  23817. or (LTypeEl is TPasProcedureType)
  23818. or IsDynArray(LTypeEl) then
  23819. exit(cExact);
  23820. end;
  23821. if RaiseOnIncompatible then
  23822. RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
  23823. [],RHS,LHS,LErrorEl)
  23824. else
  23825. exit(cIncompatible);
  23826. end
  23827. else if LHS.BaseType=btPointer then
  23828. begin
  23829. if RHS.BaseType=btContext then
  23830. begin
  23831. RTypeEl:=RHS.LoTypeEl;
  23832. if RTypeEl.ClassType=TPasPointerType then
  23833. // @Something=TypedPointer
  23834. exit(cExact)
  23835. else if RTypeEl.ClassType=TPasClassType then
  23836. // @Something=ClassOrInterface
  23837. exit(cCompatible)
  23838. else if RTypeEl.ClassType=TPasClassOfType then
  23839. // @Something=ClassOf
  23840. exit(cCompatible);
  23841. end;
  23842. end
  23843. else if LHS.BaseType in [btSet,btArrayOrSet] then
  23844. begin
  23845. if RHS.BaseType in [btSet,btArrayOrSet] then
  23846. begin
  23847. if LHS.LoTypeEl=nil then
  23848. exit(cExact); // empty set
  23849. if RHS.LoTypeEl=nil then
  23850. exit(cExact); // empty set
  23851. if IsSameType(LHS.LoTypeEl,RHS.LoTypeEl,prraAlias) then
  23852. exit(cExact);
  23853. if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+btAllChars)) then
  23854. exit(cExact);
  23855. if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
  23856. or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
  23857. exit(cCompatible);
  23858. if RaiseOnIncompatible then
  23859. RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23860. ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
  23861. else
  23862. exit(cIncompatible);
  23863. end;
  23864. end
  23865. else if LHS.BaseType=btRange then
  23866. begin
  23867. if LHS.SubType in btAllInteger then
  23868. begin
  23869. // e.g. 2..4
  23870. if RHS.BaseType in btAllInteger then
  23871. exit(cCompatible)
  23872. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  23873. exit(cCompatible);
  23874. end
  23875. else if LHS.SubType in btAllBooleans then
  23876. begin
  23877. if RHS.BaseType in btAllBooleans then
  23878. exit(cCompatible)
  23879. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  23880. exit(cCompatible);
  23881. end
  23882. else if LHS.SubType in btAllChars then
  23883. begin
  23884. if RHS.BaseType in btAllStringAndChars then
  23885. exit(cCompatible)
  23886. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  23887. exit(cCompatible);
  23888. end
  23889. else if LHS.SubType=btContext then
  23890. begin
  23891. LTypeEl:=LHS.LoTypeEl;
  23892. if LTypeEl.ClassType=TPasRangeType then
  23893. begin
  23894. ComputeElement(TPasRangeType(LTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  23895. if ResolvedEl.BaseType=btContext then
  23896. begin
  23897. LTypeEl:=ResolvedEl.LoTypeEl;
  23898. if LTypeEl.ClassType=TPasEnumType then
  23899. begin
  23900. if RHS.BaseType=btContext then
  23901. begin
  23902. RTypeEl:=RHS.LoTypeEl;
  23903. if (LTypeEl=RTypeEl) then
  23904. exit(cCompatible);
  23905. end;
  23906. end;
  23907. end;
  23908. end;
  23909. end;
  23910. end
  23911. else if LHS.BaseType=btContext then
  23912. begin
  23913. LTypeEl:=LHS.LoTypeEl;
  23914. if LTypeEl.ClassType=TPasEnumType then
  23915. begin
  23916. if RHS.BaseType=btRange then
  23917. begin
  23918. RTypeEl:=RHS.LoTypeEl;
  23919. if RTypeEl.ClassType=TPasRangeType then
  23920. begin
  23921. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  23922. if ResolvedEl.BaseType=btContext then
  23923. begin
  23924. RTypeEl:=ResolvedEl.LoTypeEl;
  23925. if LTypeEl=RTypeEl then
  23926. exit(cCompatible);
  23927. end;
  23928. end;
  23929. end;
  23930. end
  23931. else if LTypeEl.ClassType=TPasClassType then
  23932. begin
  23933. if RHS.BaseType=btPointer then
  23934. exit(cCompatible)
  23935. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  23936. begin
  23937. if RHS.BaseType in btAllStrings then
  23938. begin
  23939. if IsTGUIDString(RHS) then
  23940. // e.g. IntfVar=aGUIDString
  23941. exit(cInterfaceToString);
  23942. end
  23943. else if RHS.BaseType=btContext then
  23944. begin
  23945. RTypeEl:=RHS.LoTypeEl;
  23946. if (RTypeEl.ClassType=TPasRecordType)
  23947. and IsTGUID(TPasRecordType(RTypeEl)) then
  23948. // e.g. IntfVar=GuidVar
  23949. exit(cInterfaceToTGUID);
  23950. end;
  23951. end;
  23952. end
  23953. else if LTypeEl.ClassType=TPasClassOfType then
  23954. begin
  23955. if RHS.BaseType=btPointer then
  23956. exit(cCompatible);
  23957. end
  23958. else if LTypeEl.ClassType=TPasRecordType then
  23959. begin
  23960. if IsTGUID(TPasRecordType(LTypeEl)) then
  23961. begin
  23962. // LHS is TGUID
  23963. if (RHS.BaseType in btAllStrings) then
  23964. // GuidVar=aString
  23965. exit(cTGUIDToString)
  23966. else if RHS.BaseType=btContext then
  23967. begin
  23968. RTypeEl:=RHS.LoTypeEl;
  23969. if (RTypeEl.ClassType=TPasClassType)
  23970. and (TPasClassType(RTypeEl).ObjKind=okInterface) then
  23971. // GUIDVar=IntfVar
  23972. exit(cInterfaceToTGUID);
  23973. end;
  23974. end;
  23975. end
  23976. else if LTypeEl.ClassType=TPasPointerType then
  23977. begin
  23978. if RHS.BaseType=btPointer then
  23979. // TypedPointer=@Something
  23980. exit(cExact);
  23981. end;
  23982. end;
  23983. if RaiseOnIncompatible then
  23984. RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
  23985. [],RHS,LHS,RErrorEl)
  23986. else
  23987. exit(cIncompatible);
  23988. end;
  23989. function TPasResolver.IsVariableConst(El, PosEl: TPasElement;
  23990. RaiseIfConst: boolean): boolean;
  23991. var
  23992. CurEl: TPasElement;
  23993. VarResolved: TPasResolverResult;
  23994. Loop: TPasImplForLoop;
  23995. begin
  23996. Result:=false;
  23997. CurEl:=PosEl;
  23998. while CurEl<>nil do
  23999. begin
  24000. if (CurEl.ClassType=TPasImplForLoop) then
  24001. begin
  24002. Loop:=TPasImplForLoop(CurEl);
  24003. if (Loop.VariableName<>PosEl) then
  24004. begin
  24005. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
  24006. if VarResolved.IdentEl=El then
  24007. begin
  24008. if RaiseIfConst then
  24009. RaiseMsg(20180430100719,nIllegalAssignmentToForLoopVar,
  24010. sIllegalAssignmentToForLoopVar,[El.Name],PosEl);
  24011. exit(true);
  24012. end;
  24013. end;
  24014. end;
  24015. CurEl:=CurEl.Parent;
  24016. end;
  24017. end;
  24018. function TPasResolver.ResolvedElCanBeVarParam(
  24019. const ResolvedEl: TPasResolverResult; PosEl: TPasElement;
  24020. RaiseIfConst: boolean): boolean;
  24021. function NotLocked(El: TPasElement): boolean;
  24022. begin
  24023. Result:=not IsVariableConst(El,PosEl,RaiseIfConst);
  24024. end;
  24025. var
  24026. IdentEl: TPasElement;
  24027. begin
  24028. Result:=false;
  24029. if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
  24030. exit;
  24031. if ResolvedEl.IdentEl=nil then
  24032. exit(true);
  24033. IdentEl:=ResolvedEl.IdentEl;
  24034. if IdentEl.ClassType=TPasVariable then
  24035. exit(NotLocked(IdentEl));
  24036. if (IdentEl.ClassType=TPasConst) then
  24037. begin
  24038. if TPasConst(IdentEl).IsConst then
  24039. begin
  24040. if RaiseIfConst then
  24041. RaiseMsg(20180430100719,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  24042. exit(false);
  24043. end;
  24044. exit(NotLocked(IdentEl));
  24045. end;
  24046. if (IdentEl.ClassType=TPasArgument) then
  24047. begin
  24048. if TPasArgument(IdentEl).Access in [argConst,argConstRef] then
  24049. begin
  24050. if RaiseIfConst then
  24051. RaiseMsg(20180430100843,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  24052. exit(false);
  24053. end;
  24054. Result:=(TPasArgument(IdentEl).Access in [argDefault, argVar, argOut]);
  24055. exit(Result and NotLocked(IdentEl));
  24056. end;
  24057. if IdentEl.ClassType=TPasResultElement then
  24058. exit(NotLocked(IdentEl));
  24059. if (proPropertyAsVarParam in Options)
  24060. and (IdentEl.ClassType=TPasProperty) then
  24061. exit(NotLocked(IdentEl));
  24062. end;
  24063. function TPasResolver.ResolvedElIsClassOrRecordInstance(
  24064. const ResolvedEl: TPasResolverResult): boolean;
  24065. var
  24066. TypeEl: TPasType;
  24067. begin
  24068. Result:=false;
  24069. if ResolvedEl.BaseType<>btContext then exit;
  24070. TypeEl:=ResolvedEl.LoTypeEl;
  24071. if TypeEl=nil then exit;
  24072. if TypeEl.ClassType=TPasClassType then
  24073. begin
  24074. if TPasClassType(TypeEl).ObjKind<>okClass then exit;
  24075. end
  24076. else if TypeEl.ClassType=TPasRecordType then
  24077. else
  24078. exit;
  24079. if (ResolvedEl.IdentEl is TPasVariable)
  24080. or (ResolvedEl.IdentEl.ClassType=TPasArgument)
  24081. or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
  24082. exit(true);
  24083. end;
  24084. function TPasResolver.GetResolver(El: TPasElement): TPasResolver;
  24085. var
  24086. Module: TPasModule;
  24087. Scope: TPasModuleScope;
  24088. begin
  24089. Result:=nil;
  24090. if El=nil then exit;
  24091. Module:=El.GetModule;
  24092. if Module=nil then exit;
  24093. Scope:=Module.CustomData as TPasModuleScope;
  24094. if Scope=nil then exit;
  24095. Result:=Scope.Owner as TPasResolver;
  24096. end;
  24097. function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
  24098. ): boolean;
  24099. begin
  24100. Result:=ms in GetElModeSwitches(El);
  24101. end;
  24102. function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
  24103. var
  24104. C: TClass;
  24105. begin
  24106. while El<>nil do
  24107. begin
  24108. if El.CustomData<>nil then
  24109. begin
  24110. C:=El.CustomData.ClassType;
  24111. if C.InheritsFrom(TPasProcedureScope) then
  24112. exit(TPasProcedureScope(El.CustomData).ModeSwitches)
  24113. else if C.InheritsFrom(TPasSectionScope) then
  24114. exit(TPasSectionScope(El.CustomData).ModeSwitches);
  24115. end;
  24116. El:=El.Parent;
  24117. end;
  24118. Result:=CurrentParser.CurrentModeswitches;
  24119. end;
  24120. function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
  24121. ): boolean;
  24122. begin
  24123. Result:=bs in GetElBoolSwitches(El);
  24124. end;
  24125. function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  24126. var
  24127. C: TClass;
  24128. begin
  24129. Result:=CurrentParser.Scanner.CurrentBoolSwitches;
  24130. while El<>nil do
  24131. begin
  24132. if El.CustomData<>nil then
  24133. begin
  24134. C:=El.CustomData.ClassType;
  24135. if C.InheritsFrom(TPasProcedureScope) then
  24136. exit(TPasProcedureScope(El.CustomData).BoolSwitches)
  24137. else if C.InheritsFrom(TPasSectionScope) then
  24138. exit(TPasSectionScope(El.CustomData).BoolSwitches)
  24139. else if C.InheritsFrom(TPasModuleScope) then
  24140. exit(TPasModuleScope(El.CustomData).BoolSwitches);
  24141. end;
  24142. El:=El.Parent;
  24143. end;
  24144. end;
  24145. function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
  24146. Flags: TPRProcTypeDescFlags): string;
  24147. var
  24148. Args, Templates: TFPList;
  24149. i: Integer;
  24150. Arg: TPasArgument;
  24151. ArgType: TPasType;
  24152. Proc: TPasProcedure;
  24153. begin
  24154. if ProcType=nil then exit('nil');
  24155. Result:=ProcType.TypeName;
  24156. if ProcType.IsReferenceTo then
  24157. Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
  24158. if ProcType.Parent is TPasProcedure then
  24159. begin
  24160. Proc:=TPasProcedure(ProcType.Parent);
  24161. if (prptdUseName in Flags) then
  24162. begin
  24163. if prptdAddPaths in Flags then
  24164. Result:=Result+' '+Proc.FullName
  24165. else
  24166. Result:=Result+' '+Proc.Name;
  24167. end;
  24168. Templates:=GetProcTemplateTypes(Proc);
  24169. if Templates<>nil then
  24170. Result:=Result+GetGenericParamCommas(Templates.Count);
  24171. end;
  24172. Args:=ProcType.Args;
  24173. if Args.Count>0 then
  24174. begin
  24175. Result:=Result+'(';
  24176. for i:=0 to Args.Count-1 do
  24177. begin
  24178. if i>0 then Result:=Result+';';
  24179. Arg:=TPasArgument(Args[i]);
  24180. if AccessNames[Arg.Access]<>'' then
  24181. Result:=Result+AccessNames[Arg.Access];
  24182. if Arg.ArgType=nil then
  24183. Result:=Result+'untyped'
  24184. else
  24185. begin
  24186. ArgType:=Arg.ArgType;
  24187. if prptdResolveSimpleAlias in Flags then
  24188. ArgType:=ResolveSimpleAliasType(ArgType);
  24189. Result:=Result+GetTypeDescription(ArgType,prptdAddPaths in Flags);
  24190. end;
  24191. end;
  24192. Result:=Result+')';
  24193. end;
  24194. if ProcType.IsOfObject then
  24195. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  24196. if ProcType.IsNested then
  24197. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  24198. if cCallingConventions[ProcType.CallingConvention]<>'' then
  24199. Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
  24200. end;
  24201. function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
  24202. OnlyType: boolean): string;
  24203. function GetSubTypeName: string;
  24204. begin
  24205. if (T.LoTypeEl<>nil) and (T.LoTypeEl.Name<>'') then
  24206. Result:=T.LoTypeEl.Name
  24207. else
  24208. Result:=BaseTypeNames[T.SubType];
  24209. end;
  24210. var
  24211. ArrayEl: TPasArrayType;
  24212. begin
  24213. case T.BaseType of
  24214. btModule: exit(GetElementTypeName(T.IdentEl)+' '+T.IdentEl.Name);
  24215. btNil: exit('nil');
  24216. btRange:
  24217. Result:='range of '+GetSubTypeName;
  24218. btSet:
  24219. Result:='set of '+GetSubTypeName;
  24220. btArrayLit:
  24221. Result:='array of '+GetSubTypeName;
  24222. btArrayOrSet:
  24223. Result:='set/array literal of '+GetSubTypeName;
  24224. btContext:
  24225. begin
  24226. if T.LoTypeEl.ClassType=TPasClassOfType then
  24227. Result:='class of '+TPasClassOfType(T.LoTypeEl).DestType.Name
  24228. else if T.LoTypeEl.ClassType=TPasAliasType then
  24229. Result:=TPasAliasType(T.LoTypeEl).DestType.Name
  24230. else if T.LoTypeEl.ClassType=TPasTypeAliasType then
  24231. Result:='type '+TPasAliasType(T.LoTypeEl).DestType.Name
  24232. else if T.LoTypeEl.ClassType=TPasArrayType then
  24233. begin
  24234. ArrayEl:=TPasArrayType(T.LoTypeEl);
  24235. if length(ArrayEl.Ranges)=0 then
  24236. begin
  24237. if ArrayEl.ElType=nil then
  24238. Result:='array of const'
  24239. else
  24240. begin
  24241. Result:='array of '+ArrayEl.ElType.Name;
  24242. if IsOpenArray(ArrayEl) then
  24243. Result:='open '+Result;
  24244. end;
  24245. end
  24246. else
  24247. Result:='static array[] of '+ArrayEl.ElType.Name;
  24248. end
  24249. else if T.LoTypeEl is TPasProcedureType then
  24250. Result:=GetProcTypeDescription(TPasProcedureType(T.LoTypeEl),[])
  24251. else if T.LoTypeEl.Name<>'' then
  24252. Result:=T.LoTypeEl.Name
  24253. else
  24254. Result:=T.LoTypeEl.ElementTypeName;
  24255. end;
  24256. btCustom:
  24257. Result:=T.LoTypeEl.Name;
  24258. else
  24259. Result:=BaseTypeNames[T.BaseType];
  24260. end;
  24261. if (not OnlyType) and (T.LoTypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
  24262. Result:=T.IdentEl.Name+':'+Result;
  24263. end;
  24264. function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
  24265. function GetName: string;
  24266. var
  24267. s: String;
  24268. Spec: TPasSpecializeType;
  24269. P: TPasElement;
  24270. i: Integer;
  24271. GenScope: TPasGenericScope;
  24272. Params: TPasTypeArray;
  24273. begin
  24274. Result:=aType.Name;
  24275. if Result='' then
  24276. begin
  24277. if aType is TPasArrayType then
  24278. begin
  24279. if length(TPasArrayType(aType).Ranges)>0 then
  24280. Result:='static array'
  24281. else if TPasArrayType(aType).ElType=nil then
  24282. Result:='array of const'
  24283. else if IsOpenArray(aType) then
  24284. Result:='open array'
  24285. else
  24286. Result:='dynamic array';
  24287. end
  24288. else if aType is TPasSpecializeType then
  24289. begin
  24290. Spec:=TPasSpecializeType(aType);
  24291. if Spec.CustomData is TPasSpecializeTypeData then
  24292. exit(GetTypeDescription(TPasSpecializeTypeData(Spec.CustomData).SpecializedType));
  24293. Result:=GetTypeDescription(Spec.DestType,true)+'<';
  24294. for i:=0 to Spec.Params.Count-1 do
  24295. begin
  24296. P:=TPasElement(Spec.Params[i]);
  24297. if P is TPasType then
  24298. Result:=Result+GetTypeDescription(TPasType(P));
  24299. if i>0 then
  24300. Result:=Result+',';
  24301. end;
  24302. Result:=Result+'>';
  24303. end
  24304. else
  24305. Result:=GetElementTypeName(aType);
  24306. end
  24307. else if aType is TPasGenericType then
  24308. begin
  24309. i:=GetTypeParameterCount(TPasGenericType(aType));
  24310. if i>0 then
  24311. // generic, not specialized
  24312. Result:=Result+GetGenericParamCommas(GetTypeParameterCount(TPasGenericType(aType)))
  24313. else if aType.CustomData is TPasGenericScope then
  24314. begin
  24315. GenScope:=TPasGenericScope(aType.CustomData);
  24316. if (GenScope.SpecializedFromItem<>nil) and IsValidIdent(aType.Name) then
  24317. begin
  24318. // specialized without params in name -> append params
  24319. Params:=GenScope.SpecializedFromItem.Params;
  24320. Result:=Result+'<';
  24321. for i:=0 to length(Params)-1 do
  24322. begin
  24323. Result:=Result+GetTypeDescription(Params[i],AddPath);
  24324. if i>0 then
  24325. Result:=Result+',';
  24326. end;
  24327. Result:=Result+'>';
  24328. end
  24329. end;
  24330. end;
  24331. if AddPath then
  24332. begin
  24333. s:=aType.ParentPath;
  24334. if (s<>'') and (s<>'.') then
  24335. Result:=s+'.'+Result;
  24336. end;
  24337. end;
  24338. begin
  24339. if aType=nil then exit('untyped');
  24340. Result:=GetName;
  24341. if (aType.ClassType=TPasUnresolvedSymbolRef) then
  24342. begin
  24343. if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
  24344. Result:=Result+'()';
  24345. exit;
  24346. end;
  24347. end;
  24348. function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
  24349. AddPath: boolean): string;
  24350. var
  24351. s: String;
  24352. begin
  24353. Result:=GetTypeDescription(R.LoTypeEl,AddPath);
  24354. if R.BaseType in [btSet,btArrayLit,btArrayOrSet] then
  24355. Result:=BaseTypeNames[R.BaseType]+' of '+Result;
  24356. if (R.LoTypeEl<>nil) and (R.IdentEl=R.LoTypeEl) then
  24357. begin
  24358. s:=GetElementTypeName(R.LoTypeEl);
  24359. if s<>'' then
  24360. Result:=s+' '+Result
  24361. else
  24362. Result:='type '+Result;
  24363. end;
  24364. end;
  24365. function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
  24366. AddPath: boolean): string;
  24367. begin
  24368. if R.BaseType=btContext then
  24369. Result:=GetTypeDescription(R,AddPath)
  24370. else if (R.BaseType=btPointer) and not IsBaseType(R.LoTypeEl,btPointer) then
  24371. Result:='^'+GetTypeDescription(R,AddPath)
  24372. else
  24373. Result:=BaseTypeNames[R.BaseType];
  24374. end;
  24375. function TPasResolver.GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  24376. var
  24377. Scope: TPasProcedureScope;
  24378. Body: TPasImplBlock;
  24379. begin
  24380. Result:=nil;
  24381. if Proc=nil then exit;
  24382. if Proc.Body<>nil then
  24383. Body:=Proc.Body.Body
  24384. else
  24385. Body:=nil;
  24386. if Body=nil then
  24387. begin
  24388. if Proc.CustomData=nil then exit;
  24389. Scope:=Proc.CustomData as TPasProcedureScope;
  24390. Proc:=Scope.ImplProc;
  24391. if Proc=nil then exit;
  24392. if Proc.Body=nil then exit;
  24393. Body:=Proc.Body.Body;
  24394. if Body=nil then exit;
  24395. end;
  24396. if Body.Elements=nil then exit;
  24397. if Body.Elements.Count=0 then exit;
  24398. Result:=TPasImplElement(Body.Elements[0]);
  24399. end;
  24400. function TPasResolver.GetProcTemplateTypes(Proc: TPasProcedure): TFPList;
  24401. var
  24402. NameParts: TProcedureNamePart;
  24403. begin
  24404. if Proc.NameParts=nil then
  24405. exit(nil);
  24406. NameParts:=TProcedureNamePart(Proc.NameParts[Proc.NameParts.Count-1]);
  24407. Result:=NameParts.Templates;
  24408. if (Result<>nil) and (Result.Count=0) then
  24409. exit(nil);
  24410. end;
  24411. function TPasResolver.GetProcName(Proc: TPasProcedure; WithTemplates: boolean
  24412. ): string;
  24413. var
  24414. NameParts: TProcedureNameParts;
  24415. i, j: Integer;
  24416. NamePart: TProcedureNamePart;
  24417. TemplType: TPasGenericTemplateType;
  24418. Templates: TFPList;
  24419. begin
  24420. if Proc=nil then exit('(nil)');
  24421. Result:=Proc.Name;
  24422. if WithTemplates then
  24423. begin
  24424. NameParts:=Proc.NameParts;
  24425. if NameParts=nil then exit;
  24426. Result:='';
  24427. for i:=0 to NameParts.Count-1 do
  24428. begin
  24429. NamePart:=TProcedureNamePart(NameParts[i]);
  24430. if i>0 then
  24431. Result:=Result+'.';
  24432. Result:=Result+NamePart.Name;
  24433. Templates:=NamePart.Templates;
  24434. if (Templates<>nil) and (Templates.Count>0) then
  24435. begin
  24436. for j:=0 to Templates.Count-1 do
  24437. begin
  24438. TemplType:=TPasGenericTemplateType(NamePart.Templates[j]);
  24439. if j=0 then
  24440. Result:=Result+'<'
  24441. else
  24442. Result:=Result+',';
  24443. Result:=Result+TemplType.Name;
  24444. end;
  24445. Result:=Result+'>';
  24446. end;
  24447. end;
  24448. end;
  24449. end;
  24450. function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
  24451. WithRedeclarations: boolean): TPasProperty;
  24452. begin
  24453. Result:=nil;
  24454. if El=nil then exit;
  24455. if (not WithRedeclarations) and (El.VarType<>nil) then exit;
  24456. if El.CustomData=nil then exit;
  24457. Result:=TPasPropertyScope(El.CustomData).AncestorProp;
  24458. end;
  24459. function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
  24460. begin
  24461. Result:=nil;
  24462. while El<>nil do
  24463. begin
  24464. if El.VarType<>nil then
  24465. exit(El.VarType);
  24466. El:=GetPasPropertyAncestor(El);
  24467. end;
  24468. end;
  24469. function TPasResolver.GetPasPropertyArgs(El: TPasProperty): TFPList;
  24470. begin
  24471. while El<>nil do
  24472. begin
  24473. if El.VarType<>nil then
  24474. exit(El.Args);
  24475. El:=GetPasPropertyAncestor(El);
  24476. end;
  24477. Result:=nil;
  24478. end;
  24479. function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
  24480. // search the member variable or getter function of a property
  24481. var
  24482. DeclEl: TPasElement;
  24483. begin
  24484. Result:=nil;
  24485. while El<>nil do
  24486. begin
  24487. if El.ReadAccessor<>nil then
  24488. begin
  24489. DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
  24490. Result:=DeclEl;
  24491. exit;
  24492. end;
  24493. El:=GetPasPropertyAncestor(El);
  24494. end;
  24495. end;
  24496. function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
  24497. // search the member variable or setter procedure of a property
  24498. var
  24499. DeclEl: TPasElement;
  24500. begin
  24501. Result:=nil;
  24502. while El<>nil do
  24503. begin
  24504. if El.WriteAccessor<>nil then
  24505. begin
  24506. DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
  24507. Result:=DeclEl;
  24508. exit;
  24509. end;
  24510. El:=GetPasPropertyAncestor(El);
  24511. end;
  24512. end;
  24513. function TPasResolver.GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  24514. // search the index expression of a property
  24515. begin
  24516. Result:=nil;
  24517. while El<>nil do
  24518. begin
  24519. if El.IndexExpr<>nil then
  24520. begin
  24521. Result:=El.IndexExpr;
  24522. exit;
  24523. end;
  24524. El:=GetPasPropertyAncestor(El);
  24525. end;
  24526. end;
  24527. function TPasResolver.GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  24528. // search the stored expression of a property
  24529. begin
  24530. Result:=nil;
  24531. while El<>nil do
  24532. begin
  24533. if El.StoredAccessor<>nil then
  24534. begin
  24535. Result:=El.StoredAccessor;
  24536. exit;
  24537. end;
  24538. El:=GetPasPropertyAncestor(El);
  24539. end;
  24540. end;
  24541. function TPasResolver.GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  24542. // search the stored expression of a property
  24543. begin
  24544. Result:=nil;
  24545. while El<>nil do
  24546. begin
  24547. if El.DefaultExpr<>nil then
  24548. begin
  24549. Result:=El.DefaultExpr;
  24550. exit;
  24551. end
  24552. else if El.IsNodefault then
  24553. exit(nil);
  24554. El:=GetPasPropertyAncestor(El);
  24555. end;
  24556. end;
  24557. function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
  24558. Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
  24559. SetReferenceFlags: boolean): integer;
  24560. var
  24561. ExprResolved, ParamResolved: TPasResolverResult;
  24562. NeedVar: Boolean;
  24563. begin
  24564. Result:=cIncompatible;
  24565. ComputeArgumentAndExpr(Param,ParamResolved,Expr,ExprResolved,SetReferenceFlags);
  24566. NeedVar:=Param.Access in [argVar, argOut];
  24567. if NeedVar then
  24568. begin
  24569. // Expr must be a variable
  24570. if not ResolvedElCanBeVarParam(ExprResolved,Expr) then
  24571. begin
  24572. {$IFDEF VerbosePasResolver}
  24573. writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
  24574. {$ENDIF}
  24575. if RaiseOnError then
  24576. begin
  24577. if ExprResolved.IdentEl is TPasConst then
  24578. RaiseMsg(20180430012609,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],Expr)
  24579. else
  24580. RaiseVarExpected(20180430012457,Expr,ExprResolved.IdentEl);
  24581. end;
  24582. exit;
  24583. end;
  24584. if (Param.ArgType=nil) then
  24585. exit(cExact); // untyped argument
  24586. if GetActualBaseType(ParamResolved.BaseType)=GetActualBaseType(ExprResolved.BaseType) then
  24587. begin
  24588. if msDelphi in CurrentParser.CurrentModeswitches then
  24589. begin
  24590. // Delphi allows passing alias, but not type alias to a var arg
  24591. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  24592. exit(cExact);
  24593. end
  24594. else if IsSameType(ParamResolved.LoTypeEl,ExprResolved.LoTypeEl,prraNone) then
  24595. begin
  24596. // ObjFPC allows passing type alias to a var arg, but simple alias wins
  24597. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  24598. exit(cExact)
  24599. else
  24600. exit(cAliasExact);
  24601. end;
  24602. if (ParamResolved.BaseType=btContext)
  24603. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  24604. and (ExprResolved.LoTypeEl.ClassType=TPasArrayType) then
  24605. begin
  24606. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
  24607. if Result<>cIncompatible then exit;
  24608. end;
  24609. end;
  24610. if IsGenericTemplType(ParamResolved) then
  24611. exit(cGenericExact);
  24612. //writeln('TPasResolver.CheckParamCompatibility NeedVar ParamResolved=',GetResolverResultDbg(ParamResolved),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  24613. if RaiseOnError then
  24614. RaiseIncompatibleTypeRes(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
  24615. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,
  24616. Expr);
  24617. exit(cIncompatible);
  24618. end;
  24619. Result:=CheckParamResCompatibility(Expr,ExprResolved,ParamResolved,ParamNo,
  24620. RaiseOnError,SetReferenceFlags);
  24621. end;
  24622. function TPasResolver.CheckParamResCompatibility(Expr: TPasExpr;
  24623. const ExprResolved, ParamResolved: TPasResolverResult; ParamNo: integer;
  24624. RaiseOnError: boolean; SetReferenceFlags: boolean): integer;
  24625. var
  24626. UseAssignError: Boolean;
  24627. begin
  24628. UseAssignError:=false;
  24629. if RaiseOnError and (ExprResolved.BaseType in [btArrayLit,btArrayOrSet]) then
  24630. // e.g. Call([1,2]) -> on mismatch jump to the wrong param expression
  24631. UseAssignError:=true;
  24632. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,UseAssignError);
  24633. if (Result=cIncompatible) and RaiseOnError then
  24634. RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
  24635. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
  24636. if SetReferenceFlags and (ParamResolved.BaseType=btContext)
  24637. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  24638. MarkArrayExprRecursive(Expr,TPasArrayType(ParamResolved.LoTypeEl));
  24639. end;
  24640. function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
  24641. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24642. ): integer;
  24643. var
  24644. RTypeEl, LTypeEl: TPasType;
  24645. SrcResolved, DstResolved: TPasResolverResult;
  24646. LArray, RArray: TPasArrayType;
  24647. GotDesc, ExpDesc: String;
  24648. CurTVarRec: TPasRecordType;
  24649. LeftClass, RightClass: TPasClassType;
  24650. function RaiseIncompatType(Id: TMaxPrecInt): integer;
  24651. begin
  24652. Result:=cIncompatible;
  24653. if not RaiseOnIncompatible then exit;
  24654. RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
  24655. [],RHS,LHS,ErrorEl);
  24656. end;
  24657. begin
  24658. if (RHS.LoTypeEl=nil) then
  24659. RaiseInternalError(20160922163645);
  24660. if (LHS.LoTypeEl=nil) then
  24661. RaiseInternalError(20160922163648);
  24662. LTypeEl:=LHS.LoTypeEl;
  24663. RTypeEl:=RHS.LoTypeEl;
  24664. // Note: do not check if LHS is writable, because this method is used for 'const' too.
  24665. if (LTypeEl=RTypeEl) and (rrfReadable in RHS.Flags) then
  24666. exit(cExact);
  24667. {$IFDEF VerbosePasResolver}
  24668. writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
  24669. {$ENDIF}
  24670. Result:=-1;
  24671. if LTypeEl.ClassType=TPasClassType then
  24672. begin
  24673. if RHS.BaseType=btNil then
  24674. Result:=cExact
  24675. else if RTypeEl.ClassType=TPasClassType then
  24676. begin
  24677. Result:=cIncompatible;
  24678. if not (rrfReadable in RHS.Flags) then
  24679. exit(RaiseIncompatType(20190215112914));
  24680. LeftClass:=TPasClassType(LTypeEl);
  24681. RightClass:=TPasClassType(RTypeEl);
  24682. if LeftClass.ObjKind=RightClass.ObjKind then
  24683. Result:=CheckSrcIsADstType(RHS,LHS)
  24684. else if LeftClass.ObjKind=okInterface then
  24685. begin
  24686. if (RightClass.ObjKind=okClass)
  24687. and (not RightClass.IsExternal) then
  24688. begin
  24689. // IntfVar:=ClassInstVar
  24690. if GetClassImplementsIntf(RightClass,LeftClass)<>nil then
  24691. exit(cTypeConversion);
  24692. end;
  24693. end;
  24694. if Result=cIncompatible then
  24695. Result:=CheckAssignCompatibilityClasses(LeftClass,RightClass);
  24696. if (Result=cIncompatible) and RaiseOnIncompatible then
  24697. RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
  24698. [],RTypeEl,LTypeEl,ErrorEl);
  24699. end
  24700. else
  24701. exit(RaiseIncompatType(20190215112919));
  24702. end
  24703. else if LTypeEl.ClassType=TPasClassOfType then
  24704. begin
  24705. if RHS.BaseType=btNil then
  24706. Result:=cExact
  24707. else if (RTypeEl.ClassType=TPasClassOfType) then
  24708. begin
  24709. if RHS.IdentEl is TPasType then
  24710. begin
  24711. Result:=cIncompatible;
  24712. if RaiseOnIncompatible then
  24713. begin
  24714. if ResolveAliasType(TPasType(RHS.IdentEl)) is TPasClassOfType then
  24715. RaiseMsg(20180317103206,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24716. ['type class-of','class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  24717. else
  24718. RaiseMsg(20180511123859,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24719. [GetResolverResultDescription(RHS),'class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  24720. end;
  24721. end
  24722. else
  24723. begin
  24724. // e.g. ImageClass:=AnotherImageClass;
  24725. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  24726. TPasClassOfType(LTypeEl).DestType);
  24727. if (Result=cIncompatible) and RaiseOnIncompatible then
  24728. RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24729. ['class of '+TPasClassOfType(RTypeEl).DestType.PathName,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  24730. end;
  24731. end
  24732. else if (RHS.IdentEl is TPasType)
  24733. and (ResolveAliasType(TPasType(RHS.IdentEl)).ClassType=TPasClassType) then
  24734. begin
  24735. // e.g. ImageClass:=TFPMemoryImage;
  24736. Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType);
  24737. if (Result=cIncompatible) and RaiseOnIncompatible then
  24738. RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24739. [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  24740. // do not check rrfReadable -> exit
  24741. exit;
  24742. end;
  24743. end
  24744. else if LTypeEl is TPasProcedureType then
  24745. begin
  24746. if RHS.BaseType=btNil then
  24747. exit(cExact);
  24748. //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);
  24749. if (LTypeEl.ClassType=RTypeEl.ClassType)
  24750. and (rrfReadable in RHS.Flags) then
  24751. begin
  24752. // e.g. ProcVar1:=ProcVar2
  24753. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  24754. true,ErrorEl,RaiseOnIncompatible) then
  24755. exit(cExact);
  24756. end;
  24757. if RaiseOnIncompatible then
  24758. begin
  24759. if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
  24760. RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24761. [GetElementTypeName(RTypeEl),GetElementTypeName(LTypeEl)],ErrorEl);
  24762. end;
  24763. end
  24764. else if LTypeEl.ClassType=TPasArrayType then
  24765. begin
  24766. LArray:=TPasArrayType(LTypeEl);
  24767. if (length(LArray.Ranges)=0) and (RTypeEl.ClassType=TPasArrayType) then
  24768. begin
  24769. // DynOrOpenArr:=array
  24770. RArray:=TPasArrayType(RTypeEl);
  24771. if length(RArray.Ranges)=1 then
  24772. begin
  24773. // DynOrOpenArr:=SingleDimStaticArr
  24774. if (msDelphi in CurrentParser.CurrentModeswitches)
  24775. and not IsOpenArray(LArray) then
  24776. begin
  24777. // DynArr:=SingleDimStaticArr forbidden in Delphi
  24778. // Note: OpenArr:=StaticArr is allowed in Delphi
  24779. if RaiseOnIncompatible then
  24780. RaiseIncompatibleTypeDesc(20180620115341,nIncompatibleTypesGotExpected,
  24781. [],'static array','dynamic array',ErrorEl);
  24782. exit(cIncompatible);
  24783. end;
  24784. end
  24785. else if length(RArray.Ranges)>1 then
  24786. begin
  24787. // DynOrOpenArr:=MultiDimStaticArr -> no
  24788. if RaiseOnIncompatible then
  24789. RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
  24790. [],'multi dimensional static array','dynamic array',ErrorEl);
  24791. exit(cIncompatible);
  24792. end
  24793. else if not (proOpenAsDynArrays in Options) then
  24794. begin
  24795. if IsOpenArray(LArray) then
  24796. // OpenArray:=OpenOrDynArr -> ok
  24797. else if IsOpenArray(RArray) then
  24798. begin
  24799. // DynArray:=OpenArray
  24800. if RaiseOnIncompatible then
  24801. RaiseIncompatibleTypeDesc(20180620115515,nIncompatibleTypesGotExpected,
  24802. [],'open array','dynamic array',ErrorEl);
  24803. exit(cIncompatible)
  24804. end
  24805. else
  24806. begin
  24807. // DynArray:=DynArr
  24808. if (msDelphi in CurrentParser.CurrentModeswitches)
  24809. and (LArray<>RArray) then
  24810. begin
  24811. // Delphi does not allow assigning arrays with same element types
  24812. exit(RaiseIncompatType(20190215112626));
  24813. end;
  24814. end;
  24815. end;
  24816. // check element type
  24817. if LArray.ElType=nil then
  24818. begin
  24819. // ArrayOfConst:=SingleDimArr
  24820. if RArray.ElType=nil then
  24821. // ArrayOfConst:=ArrayOfConst
  24822. Result:=cExact
  24823. else
  24824. begin
  24825. CurTVarRec:=GetTVarRec(LArray);
  24826. if ResolveAliasType(RArray.ElType)=CurTVarRec then
  24827. // ArrayOfConst:=ArrayOfTVarRec
  24828. Result:=cExact
  24829. else
  24830. // ArrayOfConst:=SingleDimArr
  24831. exit(RaiseIncompatType(20190215112715));
  24832. end;
  24833. end
  24834. else if RArray.ElType=nil then
  24835. // ArrayOfNonConst:=ArrayOfConst
  24836. exit(RaiseIncompatType(20190215112907))
  24837. else
  24838. begin
  24839. Result:=CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias);
  24840. if Result=cIncompatible then
  24841. if RaiseOnIncompatible then
  24842. begin
  24843. GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
  24844. RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24845. ['array of '+GotDesc,
  24846. 'array of '+ExpDesc],ErrorEl)
  24847. end
  24848. else
  24849. exit(cIncompatible);
  24850. end;
  24851. end;
  24852. end
  24853. else if LTypeEl.ClassType=TPasRecordType then
  24854. begin
  24855. if (RTypeEl is TPasClassType) and (TPasClassType(RTypeEl).ObjKind=okInterface)
  24856. and IsTGUID(TPasRecordType(LTypeEl)) then
  24857. begin
  24858. // GUIDVar := IntfTypeOrVar
  24859. exit(cInterfaceToTGUID);
  24860. end;
  24861. // records of different type
  24862. end
  24863. else if LTypeEl.ClassType=TPasEnumType then
  24864. begin
  24865. // enums of different type
  24866. end
  24867. else if RTypeEl.ClassType=TPasSetType then
  24868. begin
  24869. // sets of different type are compatible if enum types are compatible
  24870. if LTypeEl.ClassType=TPasSetType then
  24871. begin
  24872. ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
  24873. ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
  24874. if (SrcResolved.LoTypeEl<>nil)
  24875. and (SrcResolved.LoTypeEl=DstResolved.LoTypeEl) then
  24876. Result:=cExact
  24877. else if (SrcResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24878. and (DstResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24879. and (CompareText(SrcResolved.LoTypeEl.Name,DstResolved.LoTypeEl.Name)=0) then
  24880. Result:=cExact
  24881. else if RaiseOnIncompatible then
  24882. RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
  24883. [],SrcResolved,DstResolved,ErrorEl)
  24884. else
  24885. exit(cIncompatible);
  24886. end
  24887. else
  24888. exit(RaiseIncompatType(20190215112924));
  24889. end
  24890. else if LTypeEl.ClassType=TPasPointerType then
  24891. begin
  24892. if RTypeEl.ClassType=TPasPointerType then
  24893. begin
  24894. // TypedPointer:=TypedPointer
  24895. Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
  24896. TPasPointerType(RTypeEl).DestType,ErrorEl,false);
  24897. if Result=cIncompatible then
  24898. exit(RaiseIncompatType(20190215112927));
  24899. end;
  24900. end
  24901. else
  24902. {$IFDEF VerbosePasResolver}
  24903. RaiseNotYetImplemented(20160922163654,ErrorEl);
  24904. {$ELSE}
  24905. ;
  24906. {$ENDIF}
  24907. if Result=-1 then
  24908. exit(RaiseIncompatType(20190215112931));
  24909. if not (rrfReadable in RHS.Flags) then
  24910. exit(RaiseIncompatType(20190215112934));
  24911. end;
  24912. function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
  24913. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24914. ): integer;
  24915. procedure Check_ArrayOfChar_String(ArrType: TPasArrayType;
  24916. ArrLength: integer; const ElTypeResolved: TPasResolverResult;
  24917. Expr: TPasExpr; ErrorEl: TPasElement);
  24918. // check if assigning a string to an array of char fits
  24919. var
  24920. Value: TResEvalValue;
  24921. ElBT: TResolverBaseType;
  24922. l: Integer;
  24923. S: String;
  24924. {$ifdef FPC_HAS_CPSTRING}
  24925. US: UnicodeString;
  24926. {$endif}
  24927. begin
  24928. if Expr=nil then exit;
  24929. ElBT:=GetActualBaseType(ElTypeResolved.BaseType);
  24930. if length(ArrType.Ranges)=0 then
  24931. begin
  24932. // dynamic array of char can hold any string
  24933. // ToDo: check if value can be converted without loss
  24934. Result:=cExact;
  24935. exit;
  24936. end;
  24937. // static array -> check length of string
  24938. Value:=Eval(Expr,[refAutoConst]); // no external const allowed
  24939. try
  24940. case Value.Kind of
  24941. {$ifdef FPC_HAS_CPSTRING}
  24942. revkString:
  24943. if ElBT=btAnsiChar then
  24944. l:=length(TResEvalString(Value).S)
  24945. else
  24946. begin
  24947. US:=fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,ErrorEl);
  24948. l:=length(US);
  24949. end;
  24950. {$endif}
  24951. revkUnicodeString:
  24952. begin
  24953. if ElBT=btWideChar then
  24954. l:=length(TResEvalUTF16(Value).S)
  24955. else
  24956. begin
  24957. S:=String(TResEvalUTF16(Value).S);
  24958. l:=length(S);
  24959. end;
  24960. end;
  24961. else
  24962. {$IFDEF VerbosePasResolver}
  24963. writeln('Check_ArrayOfChar_String Value=',Value.AsDebugString);
  24964. {$ENDIF}
  24965. exit; // incompatible
  24966. end;
  24967. if ArrLength<>l then
  24968. begin
  24969. {$IFDEF VerbosePasResolver}
  24970. writeln('Check_ArrayOfChar_String ElType=',ElBT,'=',GetResolverResultDbg(ElTypeResolved),' Value=',Value.AsDebugString);
  24971. {$ENDIF}
  24972. RaiseMsg(20170913113216,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24973. [IntToStr(ArrLength),IntToStr(l)],ErrorEl);
  24974. end;
  24975. Result:=cExact;
  24976. finally
  24977. ReleaseEvalValue(Value);
  24978. end;
  24979. end;
  24980. procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
  24981. Values: TPasResolverResult; ErrorEl: TPasElement);
  24982. var
  24983. ElTypeResolved: TPasResolverResult;
  24984. procedure CheckArrOfCharAssignString;
  24985. begin
  24986. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  24987. if ElTypeResolved.BaseType in btAllChars then
  24988. Result:=cTypeConversion; // ArrOfChar:=aString
  24989. end;
  24990. var
  24991. Range, Value, Expr: TPasExpr;
  24992. RangeResolved, ValueResolved: TPasResolverResult;
  24993. i, ExpectedCount, ValCnt: Integer;
  24994. IsLastRange, IsConstExpr: Boolean;
  24995. ArrayValues: TPasExprArray;
  24996. LeftResult: integer;
  24997. ExprCompFlags: TPasResolverComputeFlags;
  24998. BuiltInProc: TResElDataBuiltInProc;
  24999. Ref: TResolvedReference;
  25000. RArrayType: TPasArrayType;
  25001. begin
  25002. {$IFDEF VerbosePasResolver}
  25003. writeln('TPasResolver.CheckAssignCompatibilityArrayType.CheckRange ArrType=',GetObjName(ArrType),' RgIndex=',RangeIndex,' Values=',GetResolverResultDbg(Values));
  25004. {$ENDIF}
  25005. if not (rrfReadable in RHS.Flags) then
  25006. exit;
  25007. if (Values.BaseType=btContext) and (RangeIndex=0) and (Values.LoTypeEl=ArrType) then
  25008. begin
  25009. Result:=cExact;
  25010. exit;
  25011. end;
  25012. Expr:=Values.ExprEl;
  25013. if (Expr=nil) and (Values.IdentEl is TPasConst)
  25014. and (TPasConst(Values.IdentEl).VarType=nil) then
  25015. Expr:=TPasVariable(Values.IdentEl).Expr;
  25016. IsConstExpr:=(Expr<>nil) and ExprEvaluator.IsConst(Expr);
  25017. if IsConstExpr then
  25018. ExprCompFlags:=[rcConstant]
  25019. else
  25020. ExprCompFlags:=[];
  25021. if Expr<>nil then
  25022. begin
  25023. if IsEmptyArrayExpr(Values) then
  25024. begin
  25025. if length(ArrType.Ranges)=0 then
  25026. begin
  25027. if RaiseOnIncompatible then
  25028. MarkArrayExprRecursive(Values.ExprEl,ArrType);
  25029. Result:=cExact; // empty set fits open and dyn array
  25030. exit;
  25031. end;
  25032. end
  25033. else if IsArrayOperatorAdd(Expr) and not (Values.BaseType in btAllStrings) then
  25034. begin
  25035. // a:=left+right
  25036. if length(ArrType.Ranges)>0 then
  25037. exit; // ToDo: StaticArray:=A+B
  25038. // check a:=left
  25039. ComputeElement(TBinaryExpr(Expr).left,ValueResolved,ExprCompFlags);
  25040. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  25041. if Result=cIncompatible then exit;
  25042. LeftResult:=Result;
  25043. // check a:=right
  25044. Result:=cIncompatible;
  25045. ComputeElement(TBinaryExpr(Expr).right,ValueResolved,ExprCompFlags);
  25046. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  25047. if Result=cIncompatible then exit;
  25048. if Result<LeftResult then
  25049. Result:=LeftResult;
  25050. exit;
  25051. end
  25052. else if (Expr<>nil) and (Expr.ClassType=TParamsExpr)
  25053. and (TParamsExpr(Expr).Kind=pekFuncParams) then
  25054. begin
  25055. if TParamsExpr(Expr).Value.CustomData is TResolvedReference then
  25056. begin
  25057. Ref:=TResolvedReference(TParamsExpr(Expr).Value.CustomData);
  25058. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  25059. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  25060. begin
  25061. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  25062. ArrayValues:=TParamsExpr(Expr).Params;
  25063. if BuiltInProc.BuiltIn=bfConcatArray then
  25064. begin
  25065. // check Concat(array1,array2,...)
  25066. Result:=cExact;
  25067. for i:=0 to length(ArrayValues)-1 do
  25068. begin
  25069. LeftResult:=Result;
  25070. Result:=cIncompatible;
  25071. ComputeElement(ArrayValues[i],ValueResolved,ExprCompFlags);
  25072. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  25073. if Result=cIncompatible then exit;
  25074. if Result<LeftResult then
  25075. Result:=LeftResult;
  25076. end;
  25077. exit;
  25078. end
  25079. else if BuiltInProc.BuiltIn=bfCopyArray then
  25080. begin
  25081. // check Copy(A...)
  25082. ComputeElement(ArrayValues[0],ValueResolved,ExprCompFlags);
  25083. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  25084. exit;
  25085. end;
  25086. end;
  25087. end;
  25088. end;
  25089. end;
  25090. ExpectedCount:=-1;
  25091. if length(ArrType.Ranges)=0 then
  25092. begin
  25093. // dynamic or open array
  25094. if (Expr<>nil) then
  25095. begin
  25096. if Expr.ClassType=TArrayValues then
  25097. ExpectedCount:=length(TArrayValues(Expr).Values)
  25098. else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  25099. ExpectedCount:=length(TParamsExpr(Expr).Params)
  25100. else if (Values.BaseType in btAllStringAndChars) then
  25101. begin
  25102. // e.g. const a: dynarray = string
  25103. // or e.g. pass a string literal to an open array
  25104. CheckArrOfCharAssignString;
  25105. exit;
  25106. end
  25107. else
  25108. begin
  25109. // invalid
  25110. exit;
  25111. end;
  25112. end
  25113. else
  25114. begin
  25115. // type check
  25116. if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
  25117. begin
  25118. // RHS is not an array
  25119. if (Values.BaseType in btAllStringAndChars) then
  25120. begin
  25121. // e.g. pass a string literal to an open array
  25122. CheckArrOfCharAssignString;
  25123. end;
  25124. exit;
  25125. end;
  25126. RArrayType:=TPasArrayType(Values.LoTypeEl);
  25127. if length(RArrayType.Ranges)>0 then
  25128. begin
  25129. if RaiseOnIncompatible then
  25130. RaiseXExpectedButYFound(20180622104834,'dynamic array','static array',ErrorEl);
  25131. exit;
  25132. end;
  25133. // dynarr:=dynarr -> check element type
  25134. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  25135. Include(ElTypeResolved.Flags,rrfWritable);
  25136. ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
  25137. Include(ValueResolved.Flags,rrfReadable);
  25138. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
  25139. exit;
  25140. end;
  25141. Range:=nil;
  25142. IsLastRange:=true;
  25143. end
  25144. else
  25145. begin
  25146. // static array
  25147. Range:=ArrType.Ranges[RangeIndex];
  25148. ExpectedCount:=GetRangeLength(Range);
  25149. if ExpectedCount=0 then
  25150. begin
  25151. ComputeElement(Range,RangeResolved,[rcConstant]);
  25152. RaiseNotYetImplemented(20170222232409,Expr,'range '+GetResolverResultDbg(RangeResolved));
  25153. end;
  25154. IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
  25155. if Expr=nil then
  25156. begin
  25157. if (ValueResolved.BaseType=btContext) and (ValueResolved.LoTypeEl.ClassType=TPasArrayType) then
  25158. begin
  25159. {$IFDEF VerbosePasResolver}
  25160. writeln('CheckRange TODO StaticArr:=Arr');
  25161. {$ENDIF}
  25162. end;
  25163. exit;
  25164. end;
  25165. end;
  25166. if IsLastRange then
  25167. begin
  25168. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  25169. ElTypeResolved.ExprEl:=Range;
  25170. Include(ElTypeResolved.Flags,rrfWritable);
  25171. end
  25172. else
  25173. ElTypeResolved.BaseType:=btNone;
  25174. if (Expr<>nil)
  25175. and ((Expr.ClassType=TArrayValues)
  25176. or ((Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet))) then
  25177. begin
  25178. // array literal
  25179. if (ErrorEl.Parent is TPasVariable) then
  25180. begin
  25181. // array initialization e.g. var a: tarray = []
  25182. if msDelphi in CurrentParser.CurrentModeswitches then
  25183. begin
  25184. // Delphi expects square brackets for dynamic arrays
  25185. // and round brackets for static arrays
  25186. if length(ArrType.Ranges)>0 then
  25187. begin
  25188. // static array
  25189. if Expr.ClassType<>TArrayValues then
  25190. begin
  25191. if RaiseOnIncompatible then
  25192. RaiseXExpectedButYFound(20180615121203,'(','[',ErrorEl);
  25193. exit;
  25194. end;
  25195. end
  25196. else
  25197. begin
  25198. // dyn array
  25199. if Expr.ClassType=TArrayValues then
  25200. begin
  25201. if RaiseOnIncompatible then
  25202. RaiseXExpectedButYFound(20180615122953,'[','(',ErrorEl);
  25203. exit;
  25204. end;
  25205. end;
  25206. end
  25207. else
  25208. begin
  25209. // ObjFPC always expects round brackets in initialization
  25210. if Expr.ClassType<>TArrayValues then
  25211. begin
  25212. if RaiseOnIncompatible then
  25213. RaiseXExpectedButYFound(20170913181208,'(','[',ErrorEl);
  25214. exit;
  25215. end;
  25216. end;
  25217. end;
  25218. // check each value
  25219. if Expr.ClassType=TArrayValues then
  25220. ArrayValues:=TArrayValues(Expr).Values
  25221. else
  25222. ArrayValues:=TParamsExpr(Expr).Params;
  25223. ValCnt:=length(ArrayValues);
  25224. Include(ExprCompFlags,rcNoImplicitProcType);
  25225. for i:=0 to ExpectedCount-1 do
  25226. begin
  25227. if i=ValCnt then
  25228. begin
  25229. // not enough values
  25230. if ValCnt>0 then
  25231. ErrorEl:=ArrayValues[ValCnt-1];
  25232. RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25233. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  25234. end;
  25235. Value:=ArrayValues[i];
  25236. ComputeElement(Value,ValueResolved,ExprCompFlags);
  25237. if IsLastRange then
  25238. begin
  25239. // last dimension -> check element type
  25240. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
  25241. if Result=cIncompatible then
  25242. exit;
  25243. CheckAssignExprRange(ElTypeResolved,Value);
  25244. end
  25245. else
  25246. begin
  25247. // multi dimensional array -> check next range
  25248. CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
  25249. end;
  25250. end;
  25251. if ExpectedCount<ValCnt then
  25252. begin
  25253. // too many values
  25254. ErrorEl:=ArrayValues[ExpectedCount];
  25255. if RaiseOnIncompatible then
  25256. RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25257. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  25258. exit;
  25259. end;
  25260. if RaiseOnIncompatible and (Expr.ClassType=TParamsExpr) then
  25261. // mark [] expression as an array
  25262. MarkArrayExpr(TParamsExpr(Expr),ArrType);
  25263. end
  25264. else
  25265. begin
  25266. // single value
  25267. // Note: the parser does not store the difference between (1) and 1
  25268. if not IsLastRange then
  25269. begin
  25270. if RaiseOnIncompatible then
  25271. RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25272. [IntToStr(ExpectedCount),'1'],ErrorEl);
  25273. exit;
  25274. end;
  25275. if (Values.BaseType in btAllStrings) and (ElTypeResolved.BaseType in btAllChars) then
  25276. begin
  25277. // e.g. array of char = ''
  25278. Check_ArrayOfChar_String(ArrType,ExpectedCount,ElTypeResolved,Expr,ErrorEl);
  25279. exit;
  25280. end;
  25281. if (ExpectedCount>1) then
  25282. begin
  25283. if RaiseOnIncompatible then
  25284. begin
  25285. {$IFDEF VerbosePasResolver}
  25286. writeln('CheckRange Values=',GetResolverResultDbg(Values),' ElTypeResolved=',GetResolverResultDbg(ElTypeResolved));
  25287. {$ENDIF}
  25288. RaiseMsg(20170913103143,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25289. [IntToStr(ExpectedCount),'1'],ErrorEl);
  25290. end;
  25291. exit;
  25292. end;
  25293. // check element type
  25294. Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
  25295. if Result=cIncompatible then
  25296. exit;
  25297. if Expr<>nil then
  25298. CheckAssignExprRange(ElTypeResolved,Expr);
  25299. end;
  25300. end;
  25301. var
  25302. LArrType: TPasArrayType;
  25303. begin
  25304. Result:=cIncompatible;
  25305. {$IFDEF VerbosePasResolver}
  25306. writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  25307. {$ENDIF}
  25308. if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
  25309. RaiseInternalError(20170222230012);
  25310. LArrType:=TPasArrayType(LHS.LoTypeEl);
  25311. if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
  25312. and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
  25313. begin
  25314. // ArrayOfConst:=[]
  25315. exit(cExact);
  25316. end;
  25317. CheckRange(LArrType,0,RHS,ErrorEl);
  25318. if (Result=cIncompatible) and RaiseOnIncompatible then
  25319. RaiseIncompatibleTypeRes(20180622104721,nIncompatibleTypesGotExpected,[],RHS,LHS,ErrorEl);
  25320. end;
  25321. function TPasResolver.CheckAssignCompatibilityPointerType(LTypeEl,
  25322. RTypeEl: TPasType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  25323. ): integer;
  25324. var
  25325. LeftResolved, RightResolved: TPasResolverResult;
  25326. begin
  25327. ComputeElement(LTypeEl,LeftResolved,[rcNoImplicitProc]);
  25328. ComputeElement(RTypeEl,RightResolved,[rcNoImplicitProc]);
  25329. Include(LeftResolved.Flags,rrfWritable);
  25330. Include(RightResolved.Flags,rrfReadable);
  25331. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  25332. end;
  25333. function TPasResolver.CheckEqualCompatibilityUserType(const LHS,
  25334. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  25335. ): integer;
  25336. // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  25337. var
  25338. LTypeEl, RTypeEl: TPasType;
  25339. AResolved, BResolved: TPasResolverResult;
  25340. function IncompatibleElements: integer;
  25341. begin
  25342. Result:=cIncompatible;
  25343. if not RaiseOnIncompatible then exit;
  25344. RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
  25345. [],LTypeEl,RTypeEl,ErrorEl);
  25346. end;
  25347. begin
  25348. if (LHS.LoTypeEl=nil) then
  25349. RaiseInternalError(20161007223118);
  25350. if (RHS.LoTypeEl=nil) then
  25351. RaiseInternalError(20161007223119);
  25352. LTypeEl:=LHS.LoTypeEl;
  25353. RTypeEl:=RHS.LoTypeEl;
  25354. if LTypeEl=RTypeEl then
  25355. exit(cExact);
  25356. if LTypeEl.ClassType=TPasClassType then
  25357. begin
  25358. if RTypeEl.ClassType=TPasClassType then
  25359. begin
  25360. // e.g. if Sender=Button1 then
  25361. Result:=CheckSrcIsADstType(LHS,RHS);
  25362. if Result=cIncompatible then
  25363. Result:=CheckSrcIsADstType(RHS,LHS);
  25364. if (Result=cIncompatible) and RaiseOnIncompatible then
  25365. RaiseIncompatibleTypeRes(20180324190757,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  25366. exit;
  25367. end
  25368. else if RTypeEl.ClassType=TPasRecordType then
  25369. begin
  25370. if (TPasClassType(LTypeEl).ObjKind=okInterface)
  25371. and IsTGUID(TPasRecordType(RTypeEl)) then
  25372. // IntfVar=GuidVar
  25373. exit(cInterfaceToTGUID);
  25374. end;
  25375. exit(IncompatibleElements);
  25376. end
  25377. else if LTypeEl.ClassType=TPasClassOfType then
  25378. begin
  25379. if RTypeEl.ClassType=TPasClassOfType then
  25380. begin
  25381. // for example: if ImageClass=ImageClass then
  25382. Result:=CheckClassIsClass(TPasClassOfType(LTypeEl).DestType,
  25383. TPasClassOfType(RTypeEl).DestType);
  25384. if Result=cIncompatible then
  25385. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  25386. TPasClassOfType(LTypeEl).DestType);
  25387. if (Result=cIncompatible) and RaiseOnIncompatible then
  25388. RaiseIncompatibleTypeRes(20180324190804,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  25389. exit;
  25390. end;
  25391. exit(IncompatibleElements);
  25392. end
  25393. else if LTypeEl.ClassType=TPasEnumType then
  25394. begin
  25395. // enums of different type
  25396. if not RaiseOnIncompatible then
  25397. exit(cIncompatible);
  25398. if RTypeEl.ClassType=TPasEnumValue then
  25399. RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
  25400. [],TPasEnumType(LTypeEl),TPasEnumType(RTypeEl),ErrorEl)
  25401. else
  25402. exit(IncompatibleElements);
  25403. end
  25404. else if LTypeEl.ClassType=TPasRecordType then
  25405. begin
  25406. if RTypeEl.ClassType=TPasClassType then
  25407. begin
  25408. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  25409. and IsTGUID(TPasRecordType(LTypeEl)) then
  25410. // GuidVar=IntfVar
  25411. exit(cInterfaceToTGUID);
  25412. end;
  25413. end
  25414. else if LTypeEl.ClassType=TPasSetType then
  25415. begin
  25416. if RTypeEl.ClassType=TPasSetType then
  25417. begin
  25418. ComputeElement(TPasSetType(LTypeEl).EnumType,AResolved,[]);
  25419. ComputeElement(TPasSetType(RTypeEl).EnumType,BResolved,[]);
  25420. if (AResolved.LoTypeEl<>nil)
  25421. and (AResolved.LoTypeEl=BResolved.LoTypeEl) then
  25422. exit(cExact);
  25423. if (AResolved.LoTypeEl.CustomData is TResElDataBaseType)
  25424. and (BResolved.LoTypeEl.CustomData is TResElDataBaseType)
  25425. and (CompareText(AResolved.LoTypeEl.Name,BResolved.LoTypeEl.Name)=0) then
  25426. exit(cExact);
  25427. if RaiseOnIncompatible then
  25428. RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
  25429. [],AResolved,BResolved,ErrorEl)
  25430. else
  25431. exit(cIncompatible);
  25432. end
  25433. else
  25434. exit(IncompatibleElements);
  25435. end
  25436. else if LTypeEl is TPasProcedureType then
  25437. begin
  25438. if RTypeEl is TPasProcedureType then
  25439. begin
  25440. // e.g. ProcVar1 = ProcVar2
  25441. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  25442. false,nil,false) then
  25443. exit(cExact);
  25444. end
  25445. else
  25446. exit(IncompatibleElements);
  25447. end
  25448. else if LTypeEl.ClassType=TPasPointerType then
  25449. begin
  25450. if RTypeEl.ClassType=TPasPointerType then
  25451. // TypedPointer=TypedPointer
  25452. exit(cExact);
  25453. end;
  25454. exit(IncompatibleElements);
  25455. end;
  25456. function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
  25457. RaiseOnError: boolean): integer;
  25458. // for example if TClassA(AnObject)=nil then ;
  25459. var
  25460. Param: TPasExpr;
  25461. ParamResolved, ResolvedEl: TPasResolverResult;
  25462. begin
  25463. if length(Params.Params)<>1 then
  25464. begin
  25465. if RaiseOnError then
  25466. RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
  25467. sWrongNumberOfParametersForTypeCast,[El.Name],Params);
  25468. exit(cIncompatible);
  25469. end;
  25470. Param:=Params.Params[0];
  25471. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  25472. ComputeElement(El,ResolvedEl,[rcType]);
  25473. Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
  25474. end;
  25475. function TPasResolver.CheckTypeCastRes(const FromResolved,
  25476. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  25477. ): integer;
  25478. procedure WarnClassTypesAreNotRelated(GotType, ExpType: TPasClassType);
  25479. var
  25480. GotDesc, ExpDesc: String;
  25481. begin
  25482. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  25483. LogMsg(20200209140450,mtWarning,nClassTypesAreNotRelatedXY,
  25484. sClassTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  25485. end;
  25486. var
  25487. ToTypeEl, FromTypeEl: TPasType;
  25488. ToTypeBaseType: TResolverBaseType;
  25489. C: TClass;
  25490. ToProcType, FromProcType: TPasProcedureType;
  25491. TemplType: TPasGenericTemplateType;
  25492. i: Integer;
  25493. ConToken: TToken;
  25494. ConEl: TPasElement;
  25495. ToClassType, FromClassType: TPasClassType;
  25496. begin
  25497. Result:=cIncompatible;
  25498. ToTypeEl:=ToResolved.LoTypeEl;
  25499. if (ToTypeEl<>nil)
  25500. and (rrfReadable in FromResolved.Flags) then
  25501. begin
  25502. C:=ToTypeEl.ClassType;
  25503. if FromResolved.BaseType=btUntyped then
  25504. begin
  25505. // typecast an untyped parameter
  25506. Result:=cCompatible;
  25507. end
  25508. else if C=TPasUnresolvedSymbolRef then
  25509. begin
  25510. if ToTypeEl.CustomData is TResElDataBaseType then
  25511. begin
  25512. // type cast to base type, e.g. double(aninteger)
  25513. if ToTypeEl=FromResolved.LoTypeEl then
  25514. exit(cExact);
  25515. if (FromResolved.BaseType=btContext)
  25516. and (FromResolved.LoTypeEl.ClassType=TPasGenericTemplateType) then
  25517. exit(cExact); // e.g. double(T) -> will be checked when specialized
  25518. ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
  25519. if ToTypeBaseType=FromResolved.BaseType then
  25520. Result:=cExact
  25521. else if ToTypeBaseType in btAllInteger then
  25522. begin
  25523. if FromResolved.BaseType in (btArrayRangeTypes+[btRange,btCurrency]) then
  25524. Result:=cCompatible
  25525. else if FromResolved.BaseType=btContext then
  25526. begin
  25527. FromTypeEl:=FromResolved.LoTypeEl;
  25528. if FromTypeEl.ClassType=TPasEnumType then
  25529. // e.g. longint(TEnum)
  25530. Result:=cCompatible;
  25531. end;
  25532. end
  25533. else if ToTypeBaseType in btAllFloats then
  25534. begin
  25535. if FromResolved.BaseType in btAllFloats then
  25536. Result:=cCompatible
  25537. else if FromResolved.BaseType in btAllInteger then
  25538. Result:=cCompatible;
  25539. end
  25540. else if ToTypeBaseType in btAllBooleans then
  25541. begin
  25542. if FromResolved.BaseType in btAllBooleans then
  25543. Result:=cCompatible
  25544. else if FromResolved.BaseType in btAllInteger then
  25545. Result:=cCompatible;
  25546. end
  25547. else if ToTypeBaseType in btAllChars then
  25548. begin
  25549. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  25550. Result:=cCompatible
  25551. else if FromResolved.BaseType=btContext then
  25552. begin
  25553. FromTypeEl:=FromResolved.LoTypeEl;
  25554. if FromTypeEl.ClassType=TPasEnumType then
  25555. // e.g. char(TEnum)
  25556. Result:=cCompatible;
  25557. end;
  25558. end
  25559. else if ToTypeBaseType in btAllStrings then
  25560. begin
  25561. if FromResolved.BaseType in btAllStringAndChars then
  25562. Result:=cCompatible
  25563. else if (FromResolved.BaseType=btPointer)
  25564. and (ToTypeBaseType in btAllStringPointer) then
  25565. Result:=cExact;
  25566. end
  25567. else if ToTypeBaseType=btPointer then
  25568. begin
  25569. if FromResolved.BaseType in ([btPointer]+btAllStringPointer) then
  25570. Result:=cExact
  25571. else if FromResolved.BaseType=btContext then
  25572. begin
  25573. FromTypeEl:=FromResolved.LoTypeEl;
  25574. C:=FromTypeEl.ClassType;
  25575. if (C=TPasClassType)
  25576. or (C=TPasClassOfType)
  25577. or (C=TPasPointerType)
  25578. or ((C=TPasArrayType) and IsDynArray(FromTypeEl)) then
  25579. Result:=cExact
  25580. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  25581. begin
  25582. // from procvar to pointer
  25583. FromProcType:=TPasProcedureType(FromTypeEl);
  25584. if FromProcType.IsOfObject then
  25585. begin
  25586. if proMethodAddrAsPointer in Options then
  25587. Result:=cCompatible
  25588. else if RaiseOnError then
  25589. RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25590. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmOfObject],
  25591. BaseTypeNames[btPointer]],ErrorEl);
  25592. end
  25593. else if FromProcType.IsNested then
  25594. begin
  25595. if RaiseOnError then
  25596. RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25597. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmIsNested],
  25598. BaseTypeNames[btPointer]],ErrorEl);
  25599. end
  25600. else if FromProcType.IsReferenceTo then
  25601. begin
  25602. if proProcTypeWithoutIsNested in Options then
  25603. Result:=cCompatible
  25604. else if RaiseOnError then
  25605. RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25606. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmReferenceTo],
  25607. BaseTypeNames[btPointer]],ErrorEl);
  25608. end
  25609. else
  25610. Result:=cCompatible;
  25611. end;
  25612. end;
  25613. end;
  25614. end;
  25615. end
  25616. else if C=TPasClassType then
  25617. begin
  25618. ToClassType:=TPasClassType(ToTypeEl);
  25619. // to class
  25620. if FromResolved.BaseType=btContext then
  25621. begin
  25622. FromTypeEl:=FromResolved.LoTypeEl;
  25623. if FromTypeEl.ClassType=TPasClassType then
  25624. begin
  25625. FromClassType:=TPasClassType(FromTypeEl);
  25626. if FromResolved.IdentEl is TPasType then
  25627. RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25628. if FromClassType.ObjKind=ToClassType.ObjKind then
  25629. begin
  25630. // type cast upwards or downwards
  25631. Result:=CheckSrcIsADstType(FromResolved,ToResolved);
  25632. if Result=cIncompatible then
  25633. Result:=CheckSrcIsADstType(ToResolved,FromResolved);
  25634. end
  25635. else if ToClassType.ObjKind=okInterface then
  25636. begin
  25637. if (FromClassType.ObjKind=okClass)
  25638. and (not FromClassType.IsExternal) then
  25639. begin
  25640. // e.g. intftype(classinstvar)
  25641. Result:=cCompatible;
  25642. end;
  25643. end
  25644. else if FromClassType.ObjKind=okInterface then
  25645. begin
  25646. if (ToClassType.ObjKind=okClass)
  25647. and (not ToClassType.IsExternal) then
  25648. begin
  25649. // e.g. classtype(intfvar)
  25650. Result:=cCompatible;
  25651. end;
  25652. end;
  25653. if Result=cIncompatible then
  25654. Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
  25655. if (Result=cIncompatible) and (FromClassType.ObjKind=ToClassType.ObjKind) then
  25656. begin
  25657. if RaiseOnError then
  25658. WarnClassTypesAreNotRelated(FromClassType,ToClassType);
  25659. Result:=cTypeConversion;
  25660. end;
  25661. end
  25662. else if FromTypeEl.ClassType=TPasGenericTemplateType then
  25663. begin
  25664. // e.g. aClassType(T)
  25665. TemplType:=TPasGenericTemplateType(FromTypeEl);
  25666. if length(TemplType.Constraints)=0 then
  25667. begin
  25668. // typecast unconstrained template to a classtype
  25669. // -> check when specialize
  25670. Result:=cExact;
  25671. end
  25672. else
  25673. for i:=0 to length(TemplType.Constraints)-1 do
  25674. begin
  25675. ConEl:=TemplType.Constraints[i];
  25676. ConToken:=GetGenericConstraintKeyword(ConEl);
  25677. case ConToken of
  25678. tkrecord: ; // invalid type cast
  25679. tkClass, tkconstructor:
  25680. Result:=cExact;
  25681. else
  25682. // identifier constraint: class or interface -> allow
  25683. Result:=cExact;
  25684. break;
  25685. end;
  25686. end;
  25687. end;
  25688. end
  25689. else if FromResolved.BaseType=btPointer then
  25690. begin
  25691. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25692. Result:=cExact; // untyped pointer to class instance
  25693. end
  25694. else if FromResolved.BaseType=btNil then
  25695. Result:=cExact; // nil to class or interface
  25696. end
  25697. else if C=TPasGenericTemplateType then
  25698. begin
  25699. // e.g. T(var)
  25700. TemplType:=TPasGenericTemplateType(ToTypeEl);
  25701. FromTypeEl:=FromResolved.LoTypeEl;
  25702. if (FromTypeEl<>nil)
  25703. and (FromTypeEl.ClassType=TPasGenericTemplateType) then
  25704. exit(cExact); // e.g. T(S) -> will be checked when specialized
  25705. for i:=0 to length(TemplType.Constraints)-1 do
  25706. begin
  25707. ConEl:=TemplType.Constraints[i];
  25708. ConToken:=GetGenericConstraintKeyword(ConEl);
  25709. case ConToken of
  25710. tkrecord:
  25711. if FromResolved.BaseType=btContext then
  25712. begin
  25713. if FromTypeEl.ClassType=TPasRecordType then
  25714. // typecast record to template record
  25715. Result:=cExact
  25716. else if FromTypeEl.ClassType=TPasGenericType then
  25717. // typecast template to template record
  25718. Result:=cExact;
  25719. end;
  25720. tkClass, tkconstructor:
  25721. Result:=cExact;
  25722. else
  25723. // identifier constraint: class or interface -> allow
  25724. Result:=cExact;
  25725. break;
  25726. end;
  25727. end;
  25728. end
  25729. else if C=TPasClassOfType then
  25730. begin
  25731. //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.LoTypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
  25732. if FromResolved.BaseType=btContext then
  25733. begin
  25734. if FromResolved.LoTypeEl.ClassType=TPasClassOfType then
  25735. begin
  25736. if (FromResolved.IdentEl is TPasType) then
  25737. RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25738. // type cast classof(classof-var) upwards or downwards
  25739. ToTypeEl:=TPasClassOfType(ToTypeEl).DestType;
  25740. FromTypeEl:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
  25741. Result:=CheckClassesAreRelated(ToTypeEl,FromTypeEl);
  25742. end;
  25743. end
  25744. else if FromResolved.BaseType=btPointer then
  25745. begin
  25746. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25747. Result:=cExact; // untyped pointer to class-of
  25748. end
  25749. else if FromResolved.BaseType=btNil then
  25750. Result:=cExact; // nil to class-of
  25751. end
  25752. else if C=TPasRecordType then
  25753. begin
  25754. if FromResolved.BaseType=btContext then
  25755. begin
  25756. if FromResolved.LoTypeEl.ClassType=TPasRecordType then
  25757. begin
  25758. // typecast record to record
  25759. Result:=cExact;
  25760. end;
  25761. end;
  25762. end
  25763. else if (C=TPasEnumType)
  25764. or (C=TPasRangeType) then
  25765. begin
  25766. if CheckIsOrdinal(FromResolved,ErrorEl,true) then
  25767. Result:=cExact;
  25768. end
  25769. else if C=TPasArrayType then
  25770. begin
  25771. if FromResolved.BaseType=btContext then
  25772. begin
  25773. if FromResolved.LoTypeEl.ClassType=TPasArrayType then
  25774. Result:=CheckTypeCastArray(TPasArrayType(FromResolved.LoTypeEl),
  25775. TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
  25776. end
  25777. else if FromResolved.BaseType=btPointer then
  25778. begin
  25779. if IsDynArray(ToResolved.LoTypeEl)
  25780. and IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25781. Result:=cExact; // untyped pointer to dynamic array
  25782. end
  25783. else if FromResolved.BaseType=btNil then
  25784. begin
  25785. if IsDynArray(ToResolved.LoTypeEl) then
  25786. Result:=cExact; // nil to dynamic array
  25787. end;
  25788. end
  25789. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  25790. begin
  25791. ToProcType:=TPasProcedureType(ToTypeEl);
  25792. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25793. begin
  25794. // type cast untyped pointer value to proctype
  25795. if ToProcType.IsOfObject then
  25796. begin
  25797. if proMethodAddrAsPointer in Options then
  25798. Result:=cCompatible
  25799. else if RaiseOnError then
  25800. RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25801. [BaseTypeNames[btPointer],
  25802. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
  25803. end
  25804. else if ToProcType.IsNested then
  25805. begin
  25806. if RaiseOnError then
  25807. RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25808. [BaseTypeNames[btPointer],
  25809. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
  25810. end
  25811. else if ToProcType.IsReferenceTo then
  25812. begin
  25813. if proMethodAddrAsPointer in Options then
  25814. Result:=cCompatible
  25815. else if RaiseOnError then
  25816. RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25817. [BaseTypeNames[btPointer],
  25818. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
  25819. end
  25820. else
  25821. Result:=cCompatible;
  25822. end
  25823. else if FromResolved.BaseType=btContext then
  25824. begin
  25825. FromTypeEl:=FromResolved.LoTypeEl;
  25826. if FromTypeEl is TPasProcedureType then
  25827. begin
  25828. // type cast procvar to proctype
  25829. FromProcType:=TPasProcedureType(FromTypeEl);
  25830. if ToProcType.IsReferenceTo then
  25831. Result:=cCompatible
  25832. else if FromProcType.IsReferenceTo then
  25833. Result:=cCompatible
  25834. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  25835. and not (proMethodAddrAsPointer in Options) then
  25836. begin
  25837. if RaiseOnError then
  25838. RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25839. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  25840. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  25841. end
  25842. else if FromProcType.IsNested<>ToProcType.IsNested then
  25843. begin
  25844. if RaiseOnError then
  25845. RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25846. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  25847. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  25848. end
  25849. else
  25850. Result:=cCompatible;
  25851. end
  25852. end
  25853. else if FromResolved.BaseType=btProc then
  25854. begin
  25855. FromTypeEl:=FromResolved.LoTypeEl;
  25856. if FromTypeEl is TPasProcedureType then
  25857. begin
  25858. // typecast procedure (or anonymous procedure) to proctype
  25859. FromProcType:=TPasProcedureType(FromTypeEl);
  25860. if (msDelphi in CurrentParser.CurrentModeswitches)
  25861. and (FromResolved.IdentEl=nil)
  25862. and (FromResolved.LoTypeEl.Name<>'') then
  25863. // Delphi forbids typecast (non anonymous) procedure to proctype
  25864. else if ToProcType.IsReferenceTo then
  25865. Result:=cCompatible
  25866. else if FromResolved.IdentEl=nil then
  25867. // anonymous proc to proctype
  25868. Result:=cCompatible
  25869. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  25870. and not (proMethodAddrAsPointer in Options) then
  25871. begin
  25872. // e.g. TProcedure(Obj.DoIt)
  25873. if RaiseOnError then
  25874. RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25875. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  25876. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  25877. end
  25878. else if FromProcType.IsNested<>ToProcType.IsNested then
  25879. begin
  25880. if RaiseOnError then
  25881. RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25882. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  25883. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  25884. end
  25885. else
  25886. Result:=cCompatible;
  25887. end;
  25888. end
  25889. else if FromResolved.BaseType=btNil then
  25890. // typecast nil to procedure type
  25891. Result:=cExact;
  25892. end
  25893. else if C=TPasPointerType then
  25894. begin
  25895. // typecast to typedpointer
  25896. if FromResolved.BaseType in [btPointer,btNil] then
  25897. Result:=cExact
  25898. else if FromResolved.BaseType=btContext then
  25899. begin
  25900. FromTypeEl:=FromResolved.LoTypeEl;
  25901. C:=FromTypeEl.ClassType;
  25902. if (C=TPasPointerType)
  25903. or (C=TPasClassOfType)
  25904. or (C=TPasClassType)
  25905. or (C.InheritsFrom(TPasProcedureType))
  25906. or IsDynArray(FromTypeEl) then
  25907. Result:=cCompatible;
  25908. end;
  25909. end
  25910. end
  25911. else if ToTypeEl<>nil then
  25912. begin
  25913. // FromResolved is not readable
  25914. if FromResolved.BaseType=btContext then
  25915. begin
  25916. FromTypeEl:=FromResolved.LoTypeEl;
  25917. if (FromTypeEl.ClassType=TPasClassType)
  25918. and (FromTypeEl=FromResolved.IdentEl)
  25919. and (ToResolved.BaseType=btContext) then
  25920. begin
  25921. ToTypeEl:=ToResolved.LoTypeEl;
  25922. if (ToTypeEl.ClassType=TPasClassOfType)
  25923. and (ToTypeEl=ToResolved.IdentEl) then
  25924. begin
  25925. // for example class-of(Self) in a class function
  25926. ToTypeEl:=TPasClassOfType(ToTypeEl).DestType;
  25927. Result:=CheckClassesAreRelated(ToTypeEl,FromTypeEl);
  25928. end;
  25929. end;
  25930. end;
  25931. if (Result=cIncompatible) and RaiseOnError then
  25932. begin
  25933. if FromResolved.IdentEl is TPasType then
  25934. RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25935. end;
  25936. end;
  25937. if Result=cIncompatible then
  25938. begin
  25939. {$IFDEF VerbosePasResolver}
  25940. writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
  25941. {$ENDIF}
  25942. if RaiseOnError then
  25943. RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
  25944. [],FromResolved,ToResolved,ErrorEl);
  25945. exit;
  25946. end;
  25947. end;
  25948. function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
  25949. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  25950. function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
  25951. out ElTypeResolved: TPasResolverResult): boolean;
  25952. begin
  25953. inc(NextIndex);
  25954. if NextIndex<length(ArrType.Ranges) then
  25955. begin
  25956. ElTypeResolved.BaseType:=btNone;
  25957. exit(true);
  25958. end;
  25959. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  25960. if (ElTypeResolved.BaseType<>btContext)
  25961. or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
  25962. exit(false);
  25963. ArrType:=TPasArrayType(ElTypeResolved.LoTypeEl);
  25964. NextIndex:=0;
  25965. Result:=true;
  25966. end;
  25967. var
  25968. FromIndex, ToIndex: Integer;
  25969. FromElTypeRes, ToElTypeRes: TPasResolverResult;
  25970. StartFromType, StartToType: TPasArrayType;
  25971. begin
  25972. {$IFDEF VerbosePasResolver}
  25973. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
  25974. {$ENDIF}
  25975. if not RaiseOnError then
  25976. begin
  25977. if (ToType.GenericTemplateTypes<>nil) and (ToType.GenericTemplateTypes.Count>0) then
  25978. exit(cCompatible); // is later checked when specialized
  25979. end;
  25980. StartFromType:=FromType;
  25981. StartToType:=ToType;
  25982. Result:=cIncompatible;
  25983. // check dimensions
  25984. FromIndex:=0;
  25985. ToIndex:=0;
  25986. repeat
  25987. {$IFDEF VerbosePasResolver}
  25988. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  25989. {$ENDIF}
  25990. if length(ToType.Ranges)=0 then
  25991. // ToType is dynamic/open array -> fits any size
  25992. else
  25993. begin
  25994. // ToType is ranged
  25995. // ToDo: check size of dimension
  25996. end;
  25997. // check next dimension
  25998. if not NextDim(FromType,FromIndex,FromElTypeRes) then
  25999. begin
  26000. // at end of FromType
  26001. if NextDim(ToType,ToIndex,ToElTypeRes) then
  26002. begin
  26003. {$IFDEF VerbosePasResolver}
  26004. writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  26005. {$ENDIF}
  26006. break; // ToType has more dimensions
  26007. end;
  26008. // have same dimension -> check ElType
  26009. Include(FromElTypeRes.Flags,rrfReadable);
  26010. FromElTypeRes.IdentEl:=nil;
  26011. {$IFDEF VerbosePasResolver}
  26012. writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
  26013. {$ENDIF}
  26014. Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
  26015. break;
  26016. end
  26017. else
  26018. begin
  26019. // FromType has more dimensions
  26020. if not NextDim(ToType,ToIndex,ToElTypeRes) then
  26021. begin
  26022. {$IFDEF VerbosePasResolver}
  26023. writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  26024. {$ENDIF}
  26025. break; // ToType has less dimensions
  26026. end;
  26027. end;
  26028. until false;
  26029. if (Result=cIncompatible) and RaiseOnError then
  26030. RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
  26031. [],StartFromType,StartToType,ErrorEl);
  26032. end;
  26033. procedure TPasResolver.ComputeElement(El: TPasElement; out
  26034. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  26035. StartEl: TPasElement);
  26036. procedure ComputeIdentifier(Expr: TPasExpr);
  26037. var
  26038. Ref: TResolvedReference;
  26039. Proc: TPasProcedure;
  26040. ProcType: TPasProcedureType;
  26041. begin
  26042. Ref:=TResolvedReference(Expr.CustomData);
  26043. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  26044. if rrfConstInherited in Ref.Flags then
  26045. Exclude(ResolvedEl.Flags,rrfWritable);
  26046. {$IFDEF VerbosePasResolver}
  26047. {AllowWriteln}
  26048. if Expr is TPrimitiveExpr then
  26049. writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
  26050. else
  26051. writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
  26052. {AllowWriteln-}
  26053. {$ENDIF}
  26054. //if (Expr is TPrimitiveExpr) and (Expr.Parent is TParamsExpr) and (TPrimitiveExpr(Expr).Value='FA') then
  26055. // RaiseNotYetImplemented(20180621235200,Expr);
  26056. if not (rcSetReferenceFlags in Flags)
  26057. and (rrfNoImplicitCallWithoutParams in Ref.Flags) then
  26058. exit;
  26059. if (ResolvedEl.BaseType=btProc) then
  26060. begin
  26061. // proc
  26062. if rcNoImplicitProc in Flags then
  26063. begin
  26064. if rcSetReferenceFlags in Flags then
  26065. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  26066. end
  26067. else if [rcConstant,rcType]*Flags=[] then
  26068. begin
  26069. // implicit call without params is allowed -> check if possible
  26070. Proc:=ResolvedEl.IdentEl as TPasProcedure;
  26071. if not ProcNeedsParams(Proc.ProcType) then
  26072. begin
  26073. // parameter less proc -> implicit call possible
  26074. if ResolvedEl.IdentEl is TPasFunction then
  26075. begin
  26076. // function => return result
  26077. ComputeResultElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
  26078. ResolvedEl,Flags+[rcCall],StartEl);
  26079. end
  26080. else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
  26081. begin
  26082. // constructor -> return value of type class
  26083. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  26084. end
  26085. else if ParentNeedsExprResult(Expr) then
  26086. begin
  26087. // a procedure address
  26088. exit;
  26089. end;
  26090. if rcSetReferenceFlags in Flags then
  26091. begin
  26092. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  26093. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  26094. end;
  26095. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26096. end;
  26097. end;
  26098. end
  26099. else if IsProcedureType(ResolvedEl,true) then
  26100. begin
  26101. // proc type
  26102. if [rcNoImplicitProc,rcNoImplicitProcType]*Flags<>[] then
  26103. begin
  26104. if rcSetReferenceFlags in Flags then
  26105. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  26106. end
  26107. else if [rcConstant,rcType]*Flags=[] then
  26108. begin
  26109. // implicit call without params is allowed -> check if possible
  26110. ProcType:=TPasProcedureType(ResolvedEl.LoTypeEl);
  26111. if not ProcNeedsParams(ProcType) then
  26112. begin
  26113. // parameter less proc type -> implicit call possible
  26114. if ResolvedEl.LoTypeEl is TPasFunctionType then
  26115. // function => return result
  26116. ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  26117. ResolvedEl,Flags+[rcCall],StartEl)
  26118. else if ParentNeedsExprResult(Expr) then
  26119. begin
  26120. // a procedure has no result
  26121. exit;
  26122. end;
  26123. if rcSetReferenceFlags in Flags then
  26124. begin
  26125. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  26126. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  26127. end;
  26128. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26129. end;
  26130. end;
  26131. end;
  26132. end;
  26133. procedure ComputeInherited(Expr: TInheritedExpr);
  26134. var
  26135. Ref: TResolvedReference;
  26136. Proc: TPasProcedure;
  26137. TypeEl: TPasProcedureType;
  26138. HasName: Boolean;
  26139. begin
  26140. // "inherited;"
  26141. Ref:=TResolvedReference(El.CustomData);
  26142. Proc:=NoNil(Ref.Declaration) as TPasProcedure;
  26143. TypeEl:=TPasProcedure(Proc).ProcType;
  26144. SetResolverIdentifier(ResolvedEl,btProc,Proc,
  26145. TypeEl,TypeEl,[rrfCanBeStatement]);
  26146. HasName:=(El.Parent.ClassType=TBinaryExpr)
  26147. and (TBinaryExpr(El.Parent).OpCode=eopNone); // true if 'inherited Proc;'
  26148. if HasName or (rcNoImplicitProc in Flags) then
  26149. exit;
  26150. // inherited; -> implicit call possible
  26151. if Proc is TPasFunction then
  26152. begin
  26153. // function => return result
  26154. ComputeResultElement(TPasFunction(Proc).FuncType.ResultEl,
  26155. ResolvedEl,Flags+[rcCall],StartEl);
  26156. Exclude(ResolvedEl.Flags,rrfWritable);
  26157. end
  26158. else if (Proc.ClassType=TPasConstructor)
  26159. and (rrfNewInstance in Ref.Flags) then
  26160. begin
  26161. // new instance constructor -> return value of type class
  26162. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  26163. end
  26164. else if ParentNeedsExprResult(Expr) then
  26165. begin
  26166. // a procedure
  26167. exit;
  26168. end;
  26169. if rcSetReferenceFlags in Flags then
  26170. begin
  26171. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  26172. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  26173. end;
  26174. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26175. end;
  26176. procedure ComputeSpecializeType(SpecType: TPasSpecializeType);
  26177. var
  26178. TypeEl: TPasType;
  26179. begin
  26180. if SpecType.CustomData is TPasSpecializeTypeData then
  26181. begin
  26182. TypeEl:=TPasSpecializeTypeData(SpecType.CustomData).SpecializedType;
  26183. if TypeEl=nil then
  26184. RaiseNotYetImplemented(20190908153503,El);
  26185. SetResolverIdentifier(ResolvedEl,btContext,TypeEl,TypeEl,TypeEl,[]);
  26186. end
  26187. else
  26188. begin
  26189. TypeEl:=SpecType.DestType;
  26190. if TypeEl=nil then
  26191. RaiseNotYetImplemented(20190908153434,El);
  26192. SetResolverIdentifier(ResolvedEl,btContext,SpecType,TypeEl,SpecType,[]);
  26193. end;
  26194. end;
  26195. procedure ComputeExportSymbol(ExpSymbol: TPasExportSymbol);
  26196. var
  26197. Ref: TResolvedReference;
  26198. begin
  26199. if ExpSymbol.CustomData is TResolvedReference then
  26200. begin
  26201. Ref:=TResolvedReference(El.CustomData);
  26202. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  26203. end
  26204. else if ExpSymbol.NameExpr<>nil then
  26205. ComputeElement(ExpSymbol.NameExpr,ResolvedEl,Flags,StartEl)
  26206. else
  26207. RaiseNotYetImplemented(20210106225512,ExpSymbol);
  26208. end;
  26209. var
  26210. DeclEl: TPasElement;
  26211. ElClass: TClass;
  26212. bt: TResolverBaseType;
  26213. TypeEl: TPasType;
  26214. Value: TResEvalValue;
  26215. Int: TMaxPrecInt;
  26216. begin
  26217. if StartEl=nil then StartEl:=El;
  26218. ResolvedEl:=Default(TPasResolverResult);
  26219. {$IFDEF VerbosePasResolver}
  26220. writeln('TPasResolver.ComputeElement El=',GetObjName(El));
  26221. {$ENDIF}
  26222. if El=nil then
  26223. exit;
  26224. ElClass:=El.ClassType;
  26225. if ElClass=TPrimitiveExpr then
  26226. begin
  26227. case TPrimitiveExpr(El).Kind of
  26228. pekIdent,pekSelf:
  26229. begin
  26230. if not (El.CustomData is TResolvedReference) then
  26231. RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  26232. ComputeIdentifier(TPrimitiveExpr(El));
  26233. end;
  26234. pekNumber:
  26235. begin
  26236. if NumberIsFloat(TPrimitiveExpr(El).Value) then
  26237. bt:=BaseTypeExtended
  26238. else if length(TPrimitiveExpr(El).Value)<9 then
  26239. bt:=btLongint
  26240. else
  26241. begin
  26242. // with 9+ it could be longword: e.g. $87654321
  26243. Value:=Eval(TPrimitiveExpr(El),[]);
  26244. if Value=nil then
  26245. RaiseNotYetImplemented(20190130162601,El);
  26246. try
  26247. case Value.Kind of
  26248. revkInt:
  26249. begin
  26250. Int:=TResEvalInt(Value).Int;
  26251. bt:=GetSmallestIntegerBaseType(Int,Int);
  26252. end;
  26253. {$IFDEF HasInt64}
  26254. revkUInt:
  26255. bt:=btQWord;
  26256. {$ENDIF}
  26257. else
  26258. bt:=BaseTypeExtended;
  26259. end;
  26260. finally
  26261. ReleaseEvalValue(Value);
  26262. end;
  26263. end;
  26264. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  26265. TPrimitiveExpr(El),[rrfReadable])
  26266. end;
  26267. pekString:
  26268. begin
  26269. {$IFDEF VerbosePasResolver}
  26270. writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
  26271. {$ENDIF}
  26272. bt:=IsCharLiteral(TPrimitiveExpr(El).Value,El);
  26273. if bt in btAllChars then
  26274. begin
  26275. if bt=BaseTypeChar then
  26276. bt:=btChar;
  26277. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  26278. TPrimitiveExpr(El),[rrfReadable]);
  26279. end
  26280. else
  26281. SetResolverValueExpr(ResolvedEl,btString,
  26282. FBaseTypes[btString],FBaseTypes[btString],
  26283. TPrimitiveExpr(El),[rrfReadable]);
  26284. end;
  26285. pekNil:
  26286. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  26287. TPrimitiveExpr(El),[rrfReadable]);
  26288. pekBoolConst:
  26289. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  26290. TPrimitiveExpr(El),[rrfReadable]);
  26291. else
  26292. RaiseNotYetImplemented(20160922163701,El);
  26293. end;
  26294. end
  26295. else if ElClass=TPasUnresolvedSymbolRef then
  26296. begin
  26297. // built-in type
  26298. if El.CustomData is TResElDataBaseType then
  26299. SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
  26300. El,TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[])
  26301. else if El.CustomData is TResElDataBuiltInProc then
  26302. begin
  26303. SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,
  26304. TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[]);
  26305. if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
  26306. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26307. end
  26308. else
  26309. RaiseNotYetImplemented(20160926194756,El);
  26310. end
  26311. else if ElClass=TBoolConstExpr then
  26312. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  26313. TBoolConstExpr(El),[rrfReadable])
  26314. else if ElClass=TBinaryExpr then
  26315. ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
  26316. else if ElClass=TUnaryExpr then
  26317. begin
  26318. if TUnaryExpr(El).OpCode in [eopAddress,eopMemAddress] then
  26319. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  26320. else
  26321. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
  26322. {$IFDEF VerbosePasResolver}
  26323. writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
  26324. {$ENDIF}
  26325. case TUnaryExpr(El).OpCode of
  26326. eopAdd, eopSubtract:
  26327. if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
  26328. exit
  26329. else if IsGenericTemplType(ResolvedEl) then
  26330. exit
  26331. else
  26332. RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26333. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26334. eopNot:
  26335. begin
  26336. if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
  26337. else
  26338. ComputeUnaryNot(TUnaryExpr(El),ResolvedEl,Flags);
  26339. exit;
  26340. end;
  26341. eopAddress:
  26342. if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
  26343. begin
  26344. SetResolverValueExpr(ResolvedEl,btContext,
  26345. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  26346. exit;
  26347. end
  26348. else if (rrfReadable in ResolvedEl.Flags) and (ResolvedEl.BaseType<>btPointer) then
  26349. begin
  26350. SetResolverValueExpr(ResolvedEl,btPointer,
  26351. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  26352. exit;
  26353. end
  26354. else
  26355. RaiseMsg(20180208121541,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26356. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26357. eopDeref:
  26358. begin
  26359. ComputeDereference(TUnaryExpr(El),ResolvedEl);
  26360. exit;
  26361. end;
  26362. eopMemAddress:
  26363. if (ResolvedEl.BaseType=btContext)
  26364. and ((ResolvedEl.LoTypeEl is TPasProcedureType)
  26365. or IsGenericTemplType(ResolvedEl)) then
  26366. // @@ProcVar
  26367. exit
  26368. else
  26369. RaiseMsg(20180208121549,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26370. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26371. end;
  26372. {$IFDEF VerbosePasResolver}
  26373. writeln('TPasResolver.ComputeElement OpCode=',TUnaryExpr(El).OpCode);
  26374. {$ENDIF}
  26375. RaiseNotYetImplemented(20160926142426,El);
  26376. end
  26377. else if ElClass=TParamsExpr then
  26378. case TParamsExpr(El).Kind of
  26379. pekArrayParams: // a[]
  26380. ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26381. pekFuncParams: // a()
  26382. ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26383. pekSet: // []
  26384. ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26385. else
  26386. RaiseNotYetImplemented(20161010184559,El);
  26387. end
  26388. else if ElClass=TInheritedExpr then
  26389. begin
  26390. // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
  26391. if El.CustomData is TResolvedReference then
  26392. ComputeInherited(TInheritedExpr(El))
  26393. else
  26394. // no ancestor proc
  26395. SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,nil,[rrfCanBeStatement]);
  26396. end
  26397. else if (ElClass=TPasAliasType) or (ElClass=TPasTypeAliasType) then
  26398. begin
  26399. // e.g. 'type a = b' -> compute b
  26400. ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  26401. ResolvedEl.IdentEl:=El;
  26402. ResolvedEl.HiTypeEl:=TPasAliasType(El);
  26403. end
  26404. else if (ElClass=TPasVariable) then
  26405. begin
  26406. // e.g. 'var a:b' -> compute b, use a as IdentEl
  26407. if rcConstant in Flags then
  26408. RaiseConstantExprExp(20170216152737,StartEl);
  26409. ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  26410. ResolvedEl.IdentEl:=El;
  26411. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26412. end
  26413. else if (ElClass=TPasConst) then
  26414. begin
  26415. // e.g. 'var a:b' -> compute b, use a as IdentEl
  26416. if TPasConst(El).VarType<>nil then
  26417. begin
  26418. // typed const
  26419. if (not TPasConst(El).IsConst) and ([rcConstant,rcType]*Flags<>[]) then
  26420. RaiseConstantExprExp(20170216152739,StartEl);
  26421. ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  26422. ResolvedEl.IdentEl:=El;
  26423. if TPasConst(El).IsConst then
  26424. ResolvedEl.Flags:=[rrfReadable]
  26425. else
  26426. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26427. end
  26428. else
  26429. begin
  26430. // untyped const
  26431. ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
  26432. ResolvedEl.IdentEl:=El;
  26433. ResolvedEl.Flags:=[rrfReadable];
  26434. end;
  26435. end
  26436. else if (ElClass=TPasEnumValue) then
  26437. begin
  26438. TypeEl:=NoNil(El.Parent) as TPasEnumType;
  26439. SetResolverIdentifier(ResolvedEl,btContext,El,TypeEl,TypeEl,[rrfReadable])
  26440. end
  26441. else if (ElClass=TPasEnumType) then
  26442. SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),TPasEnumType(El),[])
  26443. else if (ElClass=TPasProperty) then
  26444. begin
  26445. if rcConstant in Flags then
  26446. RaiseConstantExprExp(20170216152741,StartEl);
  26447. if GetPasPropertyArgs(TPasProperty(El)).Count=0 then
  26448. begin
  26449. ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
  26450. Flags+[rcType],StartEl);
  26451. ResolvedEl.IdentEl:=El;
  26452. ResolvedEl.Flags:=[];
  26453. if GetPasPropertyGetter(TPasProperty(El))<>nil then
  26454. Include(ResolvedEl.Flags,rrfReadable);
  26455. if GetPasPropertySetter(TPasProperty(El))<>nil then
  26456. Include(ResolvedEl.Flags,rrfWritable);
  26457. if IsProcedureType(ResolvedEl,true) then
  26458. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26459. end
  26460. else
  26461. begin
  26462. // index property without name
  26463. // Note: computing the pekArrayParams TParamsExpr will convert this to the type
  26464. SetResolverIdentifier(ResolvedEl,btArrayProperty,El,nil,nil,[]);
  26465. end;
  26466. end
  26467. else if ElClass=TPasArgument then
  26468. begin
  26469. if rcConstant in Flags then
  26470. RaiseConstantExprExp(20170216152744,StartEl);
  26471. if TPasArgument(El).ArgType=nil then
  26472. // untyped parameter
  26473. SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,nil,[])
  26474. else
  26475. begin
  26476. // typed parameter -> use param as IdentEl, compute type
  26477. ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
  26478. ResolvedEl.IdentEl:=El;
  26479. end;
  26480. ResolvedEl.Flags:=[rrfReadable];
  26481. if TPasArgument(El).Access in [argDefault, argVar, argOut] then
  26482. Include(ResolvedEl.Flags,rrfWritable);
  26483. if IsProcedureType(ResolvedEl,true) then
  26484. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26485. end
  26486. else if ElClass=TPasClassType then
  26487. begin
  26488. if TPasClassType(El).IsForward and (El.CustomData<>nil) then
  26489. begin
  26490. DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
  26491. TypeEl:=NoNil(DeclEl) as TPasClassType;
  26492. end
  26493. else
  26494. TypeEl:=TPasClassType(El);
  26495. SetResolverIdentifier(ResolvedEl,btContext,
  26496. TypeEl,TypeEl,TypeEl,[]);
  26497. end
  26498. else if ElClass=TPasClassOfType then
  26499. SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),TPasClassOfType(El),[])
  26500. else if ElClass=TPasPointerType then
  26501. SetResolverIdentifier(ResolvedEl,btContext,El,TPasPointerType(El),TPasPointerType(El),[])
  26502. else if ElClass=TPasRecordType then
  26503. SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),TPasRecordType(El),[])
  26504. else if ElClass=TPasRangeType then
  26505. begin
  26506. ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
  26507. ResolvedEl.IdentEl:=El;
  26508. ResolvedEl.LoTypeEl:=TPasRangeType(El);
  26509. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  26510. if ResolvedEl.ExprEl=nil then
  26511. ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
  26512. ResolvedEl.Flags:=[];
  26513. end
  26514. else if ElClass=TPasSetType then
  26515. begin
  26516. ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
  26517. if ResolvedEl.BaseType=btRange then
  26518. begin
  26519. ConvertRangeToElement(ResolvedEl);
  26520. ResolvedEl.LoTypeEl:=TPasSetType(El).EnumType;
  26521. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  26522. end;
  26523. ResolvedEl.SubType:=ResolvedEl.BaseType;
  26524. ResolvedEl.BaseType:=btSet;
  26525. ResolvedEl.IdentEl:=El;
  26526. ResolvedEl.Flags:=[];
  26527. end
  26528. else if ElClass=TPasResultElement then
  26529. begin
  26530. if rcConstant in Flags then
  26531. RaiseConstantExprExp(20170216152746,StartEl);
  26532. ComputeResultElement(TPasResultElement(El),ResolvedEl,Flags,StartEl);
  26533. end
  26534. else if ElClass=TPasUsesUnit then
  26535. begin
  26536. if TPasUsesUnit(El).Module is TPasModule then
  26537. SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,nil,[])
  26538. else
  26539. RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
  26540. end
  26541. else if El.InheritsFrom(TPasModule) then
  26542. SetResolverIdentifier(ResolvedEl,btModule,El,nil,nil,[])
  26543. else if ElClass=TNilExpr then
  26544. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  26545. TNilExpr(El),[rrfReadable])
  26546. else if El.InheritsFrom(TPasProcedure) then
  26547. begin
  26548. TypeEl:=TPasProcedure(El).ProcType;
  26549. SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
  26550. if (TPasProcedure(El).ProcType is TPasFunctionType)
  26551. or (ElClass=TPasConstructor) then
  26552. Include(ResolvedEl.Flags,rrfReadable);
  26553. // Note: implicit calls are handled in TPrimitiveExpr
  26554. end
  26555. else if El.InheritsFrom(TPasProcedureType) then
  26556. begin
  26557. SetResolverIdentifier(ResolvedEl,btContext,El,
  26558. TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
  26559. // Note: implicit calls are handled in TPrimitiveExpr
  26560. end
  26561. else if ElClass=TProcedureExpr then
  26562. begin
  26563. TypeEl:=TProcedureExpr(El).Proc.ProcType;
  26564. SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
  26565. end
  26566. else if ElClass=TPasArrayType then
  26567. SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
  26568. else if ElClass=TArrayValues then
  26569. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable])
  26570. else if ElClass=TRecordValues then
  26571. ComputeRecordValues(TRecordValues(El),ResolvedEl,Flags,StartEl)
  26572. else if ElClass=TPasStringType then
  26573. begin
  26574. {$ifdef FPC_HAS_CPSTRING}
  26575. SetResolverTypeExpr(ResolvedEl,btShortString,
  26576. BaseTypes[btShortString],BaseTypes[btShortString],[rrfReadable]);
  26577. if BaseTypes[btShortString]=nil then
  26578. {$endif}
  26579. RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
  26580. end
  26581. else if ElClass=TPasResString then
  26582. SetResolverIdentifier(ResolvedEl,btString,El,
  26583. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
  26584. else if ElClass=TPasGenericTemplateType then
  26585. SetResolverIdentifier(ResolvedEl,btContext,El,TPasGenericTemplateType(El),
  26586. TPasGenericTemplateType(El),[])
  26587. else if ElClass=TPasSpecializeType then
  26588. ComputeSpecializeType(TPasSpecializeType(El))
  26589. else if ElClass=TInlineSpecializeExpr then
  26590. ComputeElement(TInlineSpecializeExpr(El).NameExpr,ResolvedEl,Flags,StartEl)
  26591. else if ElClass=TPasExportSymbol then
  26592. ComputeExportSymbol(TPasExportSymbol(El))
  26593. else
  26594. RaiseNotYetImplemented(20160922163705,El);
  26595. {$IF defined(nodejs) and defined(VerbosePasResolver)}
  26596. if not isNumber(ResolvedEl.BaseType) then
  26597. begin
  26598. {AllowWriteln}
  26599. writeln('TPasResolver.ComputeElement ',GetObjName(El),' typeof ResolvedEl.BaseType=',jsTypeOf(ResolvedEl.BaseType),' ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  26600. RaiseInternalError(20181101123527,jsTypeOf(ResolvedEl.LoTypeEl));
  26601. {AllowWriteln-}
  26602. end;
  26603. {$ENDIF}
  26604. end;
  26605. procedure TPasResolver.ComputeResultElement(El: TPasResultElement; out
  26606. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  26607. StartEl: TPasElement);
  26608. begin
  26609. if El.ResultType=nil then
  26610. RaiseNotYetImplemented(20200524214458,El);
  26611. ComputeElement(El.ResultType,ResolvedEl,Flags+[rcType,rcNoImplicitProc],StartEl);
  26612. ResolvedEl.IdentEl:=El;
  26613. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26614. end;
  26615. function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
  26616. Store: boolean): TResEvalValue;
  26617. // Important: Caller must free result with ReleaseEvalValue(Result)
  26618. begin
  26619. Result:=fExprEvaluator.Eval(Expr,Flags);
  26620. if Result=nil then exit;
  26621. {$IFDEF VerbosePasResEval}
  26622. writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  26623. {$ENDIF}
  26624. if Store
  26625. and (Expr.CustomData=nil)
  26626. and (Result.Element=nil)
  26627. and (not fExprEvaluator.IsSimpleExpr(Expr))
  26628. and (Expr.GetModule=RootElement) then
  26629. begin
  26630. //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  26631. AddResolveData(Expr,Result,lkModule);
  26632. end;
  26633. end;
  26634. function TPasResolver.Eval(const Value: TPasResolverResult;
  26635. Flags: TResEvalFlags; Store: boolean): TResEvalValue;
  26636. var
  26637. Expr: TPasExpr;
  26638. begin
  26639. Result:=nil;
  26640. if Value.ExprEl<>nil then
  26641. Result:=Eval(Value.ExprEl,Flags,Store)
  26642. else if Value.IdentEl is TPasConst then
  26643. begin
  26644. Expr:=TPasVariable(Value.IdentEl).Expr;
  26645. if Expr=nil then exit;
  26646. Result:=Eval(Expr,Flags,Store)
  26647. end;
  26648. end;
  26649. function TPasResolver.IsSameType(TypeA, TypeB: TPasType;
  26650. ResolveAlias: TPRResolveAlias): boolean;
  26651. var
  26652. btA, btB: TResolverBaseType;
  26653. begin
  26654. if (TypeA=nil) or (TypeB=nil) then exit(false);
  26655. case ResolveAlias of
  26656. prraSimple:
  26657. begin
  26658. TypeA:=ResolveSimpleAliasType(TypeA);
  26659. TypeB:=ResolveSimpleAliasType(TypeB);
  26660. end;
  26661. prraAlias:
  26662. begin
  26663. TypeA:=ResolveAliasType(TypeA);
  26664. TypeB:=ResolveAliasType(TypeB);
  26665. end;
  26666. end;
  26667. if TypeA=TypeB then exit(true);
  26668. if (TypeA.ClassType=TPasUnresolvedSymbolRef)
  26669. and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
  26670. begin
  26671. if CompareText(TypeA.Name,TypeB.Name)=0 then
  26672. exit(true);
  26673. btA:=TResElDataBaseType(TypeA.CustomData).BaseType;
  26674. btB:=TResElDataBaseType(TypeB.CustomData).BaseType;
  26675. Result:=GetActualBaseType(btA)=GetActualBaseType(btB);
  26676. exit;
  26677. end;
  26678. Result:=false;
  26679. end;
  26680. function TPasResolver.HasExactType(const ResolvedEl: TPasResolverResult
  26681. ): boolean;
  26682. var
  26683. IdentEl: TPasElement;
  26684. Expr: TPasExpr;
  26685. begin
  26686. IdentEl:=ResolvedEl.IdentEl;
  26687. if IdentEl<>nil then
  26688. begin
  26689. if IdentEl is TPasVariable then
  26690. exit(TPasVariable(IdentEl).VarType<>nil)
  26691. else if IdentEl.ClassType=TPasArgument then
  26692. exit(TPasArgument(IdentEl).ArgType<>nil)
  26693. else if IdentEl.ClassType=TPasResultElement then
  26694. exit(TPasResultElement(IdentEl).ResultType<>nil)
  26695. else if IdentEl is TPasType then
  26696. exit(true)
  26697. else
  26698. exit(false);
  26699. end;
  26700. Expr:=ResolvedEl.ExprEl;
  26701. if Expr<>nil then
  26702. begin
  26703. if Expr.Kind in [pekNumber,pekString,pekNil,pekBoolConst] then
  26704. exit(true)
  26705. else
  26706. exit(false);
  26707. end;
  26708. Result:=false;
  26709. end;
  26710. function TPasResolver.IndexOfGenericParam(Params: TPasExprArray): integer;
  26711. var
  26712. i: Integer;
  26713. ParamResolved: TPasResolverResult;
  26714. begin
  26715. for i:=0 to length(Params)-1 do
  26716. begin
  26717. ComputeElement(Params[i],ParamResolved,[]);
  26718. if ParamResolved.LoTypeEl is TPasGenericTemplateType then
  26719. exit(i);
  26720. end;
  26721. Result:=-1;
  26722. end;
  26723. procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  26724. ErrorEl: TPasElement);
  26725. begin
  26726. if aType=nil then exit;
  26727. if aType is TPasGenericType then
  26728. begin
  26729. if aType.ClassType=TPasClassType then
  26730. begin
  26731. if TPasClassType(aType).HelperForType<>nil then
  26732. RaiseHelpersCannotBeUsedAsType(id,ErrorEl);
  26733. end;
  26734. if (TPasGenericType(aType).GenericTemplateTypes<>nil)
  26735. and (TPasGenericType(aType).GenericTemplateTypes.Count>0) then
  26736. begin
  26737. // ref to generic type without specialization
  26738. if not (msDelphi in CurrentParser.CurrentModeswitches)
  26739. and (ErrorEl.HasParent(aType)) then
  26740. // ObjFPC allows referring to parent without type params
  26741. else
  26742. RaiseMsg(id,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,
  26743. [ErrorEl.ElementTypeName],ErrorEl);
  26744. end;
  26745. end;
  26746. end;
  26747. function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
  26748. SkipAlias: boolean): TPasType;
  26749. var
  26750. DeclEl: TPasElement;
  26751. ClassScope: TPasClassScope;
  26752. begin
  26753. Result:=nil;
  26754. if ClassEl=nil then
  26755. exit;
  26756. if ClassEl.CustomData=nil then
  26757. exit;
  26758. if ClassEl.IsForward then
  26759. begin
  26760. DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
  26761. ClassEl:=NoNil(DeclEl) as TPasClassType;
  26762. Result:=ClassEl;
  26763. end
  26764. else
  26765. begin
  26766. ClassScope:=ClassEl.CustomData as TPasClassScope;
  26767. if not (pcsfAncestorResolved in ClassScope.Flags) then
  26768. exit;
  26769. if SkipAlias then
  26770. begin
  26771. if ClassScope.AncestorScope=nil then
  26772. exit;
  26773. Result:=TPasClassType(ClassScope.AncestorScope.Element);
  26774. end
  26775. else
  26776. Result:=ClassScope.DirectAncestor;
  26777. end;
  26778. end;
  26779. function TPasResolver.GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
  26780. var
  26781. Parent: TPasElement;
  26782. i: Integer;
  26783. CurClass: TPasClassType;
  26784. Ref: TResolvedReference;
  26785. Decls: TFPList;
  26786. begin
  26787. Result:=nil;
  26788. if ClassEl=nil then exit;
  26789. Parent:=ClassEl.Parent;
  26790. if not (Parent is TPasDeclarations) then
  26791. RaiseNotYetImplemented(20200926214106,ClassEl);
  26792. Decls:=TPasDeclarations(Parent).Classes;
  26793. for i:=0 to Decls.Count-1 do
  26794. begin
  26795. CurClass:=TPasClassType(Decls[i]);
  26796. if CurClass=ClassEl then exit;
  26797. if not CurClass.IsForward then continue;
  26798. Ref:=TResolvedReference(CurClass.CustomData);
  26799. if Ref.Declaration=ClassEl then
  26800. exit(TPasClassType(Ref.Declaration));
  26801. end;
  26802. end;
  26803. function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
  26804. begin
  26805. while El<>nil do
  26806. begin
  26807. if El is TProcedureBody then
  26808. exit(TProcedureBody(El));
  26809. El:=El.Parent;
  26810. end;
  26811. Result:=nil;
  26812. end;
  26813. function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
  26814. begin
  26815. Result:=GetProcFirstImplEl(Proc)<>nil;
  26816. end;
  26817. function TPasResolver.IndexOfImplementedInterface(ClassEl: TPasClassType;
  26818. aType: TPasType): integer;
  26819. var
  26820. List: TFPList;
  26821. i: Integer;
  26822. begin
  26823. if aType=nil then exit(-1);
  26824. aType:=ResolveAliasType(aType);
  26825. List:=ClassEl.Interfaces;
  26826. for i:=0 to List.Count-1 do
  26827. if ResolveAliasType(TPasType(List[i]))=aType then
  26828. exit(i);
  26829. Result:=-1;
  26830. end;
  26831. function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
  26832. begin
  26833. while El<>nil do
  26834. begin
  26835. if (El.ClassType=TPasImplRepeatUntil)
  26836. or (El.ClassType=TPasImplWhileDo)
  26837. or (El.ClassType=TPasImplForLoop) then
  26838. exit(TPasImplElement(El));
  26839. El:=El.Parent;
  26840. end;
  26841. Result:=nil;
  26842. end;
  26843. function TPasResolver.ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean
  26844. ): TPasType;
  26845. var
  26846. C: TClass;
  26847. begin
  26848. while aType<>nil do
  26849. begin
  26850. C:=aType.ClassType;
  26851. if C=TPasAliasType then
  26852. aType:=TPasAliasType(aType).DestType
  26853. else if (C=TPasTypeAliasType) and SkipTypeAlias then
  26854. aType:=TPasAliasType(aType).DestType
  26855. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  26856. and (aType.CustomData is TResolvedReference) then
  26857. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  26858. else if C=TPasSpecializeType then
  26859. begin
  26860. if aType.CustomData is TPasSpecializeTypeData then
  26861. exit(TPasSpecializeTypeData(aType.CustomData).SpecializedType);
  26862. aType:=TPasSpecializeType(aType).DestType;
  26863. end
  26864. else
  26865. exit(aType);
  26866. end;
  26867. Result:=nil;
  26868. end;
  26869. function TPasResolver.ResolveAliasTypeEl(El: TPasElement): TPasType;
  26870. begin
  26871. if (El is TPasType) then
  26872. Result:=ResolveAliasType(TPasType(El))
  26873. else
  26874. Result:=nil;
  26875. end;
  26876. function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
  26877. { returns true if El is
  26878. a) the last element of an @ operator expression
  26879. e.g. '@p().o[].El' or '@El[]'
  26880. b) mode delphi: the last element of a right side of an assignment
  26881. c) an accessor function, e.g. property P read El;
  26882. d) an export
  26883. }
  26884. var
  26885. Parent: TPasElement;
  26886. Prop: TPasProperty;
  26887. C: TClass;
  26888. begin
  26889. Result:=false;
  26890. if El=nil then exit;
  26891. if not IsNameExpr(El) then
  26892. exit;
  26893. repeat
  26894. Parent:=El.Parent;
  26895. //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
  26896. C:=Parent.ClassType;
  26897. if C=TUnaryExpr then
  26898. begin
  26899. if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
  26900. end
  26901. else if C=TBinaryExpr then
  26902. begin
  26903. if TBinaryExpr(Parent).right<>El then exit;
  26904. if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
  26905. end
  26906. else if C=TParamsExpr then
  26907. begin
  26908. if TParamsExpr(Parent).Value<>El then exit;
  26909. end
  26910. else if C=TPasProperty then
  26911. begin
  26912. Prop:=TPasProperty(Parent);
  26913. Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
  26914. exit;
  26915. end
  26916. else if C=TPasImplAssign then
  26917. begin
  26918. if TPasImplAssign(Parent).right<>El then exit;
  26919. if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
  26920. exit;
  26921. end
  26922. else if C=TPasExportSymbol then
  26923. exit(true)
  26924. else
  26925. exit;
  26926. El:=TPasExpr(Parent);
  26927. until false;
  26928. end;
  26929. function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
  26930. var
  26931. C: TClass;
  26932. P: TPasElement;
  26933. begin
  26934. if (El=nil) or (El.Parent=nil) then exit(false);
  26935. Result:=false;
  26936. P:=El.Parent;
  26937. C:=P.ClassType;
  26938. if C=TBinaryExpr then
  26939. begin
  26940. if TBinaryExpr(P).right=El then
  26941. begin
  26942. if (TBinaryExpr(P).OpCode=eopSubIdent)
  26943. or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
  26944. Result:=ParentNeedsExprResult(TBinaryExpr(P))
  26945. else
  26946. Result:=true;
  26947. end
  26948. else
  26949. Result:=true;
  26950. end
  26951. else if C=TInlineSpecializeExpr then
  26952. Result:=ParentNeedsExprResult(TInlineSpecializeExpr(P))
  26953. else if C.InheritsFrom(TPasExpr) then
  26954. Result:=true
  26955. else if (C=TPasEnumValue)
  26956. or (C=TPasArgument)
  26957. or (C=TPasVariable)
  26958. or (C=TPasExportSymbol) then
  26959. Result:=true
  26960. else if C=TPasClassType then
  26961. Result:=TPasClassType(P).GUIDExpr=El
  26962. else if C=TPasProperty then
  26963. Result:=(TPasProperty(P).IndexExpr=El)
  26964. or (TPasProperty(P).DispIDExpr=El)
  26965. or (TPasProperty(P).DefaultExpr=El)
  26966. else if C=TPasProcedure then
  26967. Result:=(TPasProcedure(P).LibraryExpr=El)
  26968. or (TPasProcedure(P).DispIDExpr=El)
  26969. else if C=TPasImplRepeatUntil then
  26970. Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
  26971. else if C=TPasImplIfElse then
  26972. Result:=(TPasImplIfElse(P).ConditionExpr=El)
  26973. else if C=TPasImplWhileDo then
  26974. Result:=(TPasImplWhileDo(P).ConditionExpr=El)
  26975. else if C=TPasImplWithDo then
  26976. Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
  26977. else if C=TPasImplCaseOf then
  26978. Result:=(TPasImplCaseOf(P).CaseExpr=El)
  26979. else if C=TPasImplCaseStatement then
  26980. Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
  26981. else if C=TPasImplForLoop then
  26982. Result:=(TPasImplForLoop(P).StartExpr=El)
  26983. or (TPasImplForLoop(P).EndExpr=El)
  26984. else if C=TPasImplAssign then
  26985. Result:=(TPasImplAssign(P).right=El)
  26986. else if C=TPasImplRaise then
  26987. Result:=(TPasImplRaise(P).ExceptAddr=El);
  26988. end;
  26989. function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference;
  26990. Expr: TPasExpr): TPasResolverResult;
  26991. var
  26992. TypeEl: TPasType;
  26993. begin
  26994. TypeEl:=(Ref.Context as TResolvedRefCtxConstructor).Typ;
  26995. if TypeEl=nil then
  26996. RaiseNotYetImplemented(20190125205339,Expr)
  26997. else if TypeEl is TPasMembersType then
  26998. SetResolverValueExpr(Result,btContext,TypeEl,TypeEl,Expr,[rrfReadable])
  26999. else
  27000. begin
  27001. ComputeElement(TypeEl,Result,[rcType]);
  27002. Result.ExprEl:=Expr;
  27003. Result.Flags:=[rrfReadable];
  27004. end;
  27005. end;
  27006. function TPasResolver.GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  27007. var
  27008. El: TPasExpr;
  27009. begin
  27010. Result:=nil;
  27011. if Params=nil then exit;
  27012. El:=Params.Value;
  27013. while El<>nil do
  27014. begin
  27015. if El.CustomData is TResolvedReference then
  27016. exit(TResolvedReference(El.CustomData));
  27017. if El.ClassType=TInlineSpecializeExpr then
  27018. El:=TInlineSpecializeExpr(El).NameExpr
  27019. else if (El.ClassType=TBinaryExpr)
  27020. and (TBinaryExpr(El).OpCode=eopSubIdent) then
  27021. El:=TBinaryExpr(El).right
  27022. else
  27023. exit;
  27024. end;
  27025. end;
  27026. function TPasResolver.GetSetType(const ResolvedSet: TPasResolverResult
  27027. ): TPasSetType;
  27028. var
  27029. IdentEl: TPasElement;
  27030. aType: TPasType;
  27031. C: TClass;
  27032. begin
  27033. Result:=nil;
  27034. if ResolvedSet.BaseType=btSet then
  27035. begin
  27036. IdentEl:=ResolvedSet.IdentEl;
  27037. if IdentEl=nil then exit;
  27038. C:=IdentEl.ClassType;
  27039. if (C=TPasVariable)
  27040. or (C=TPasConst) then
  27041. aType:=TPasVariable(IdentEl).VarType
  27042. else if C=TPasProperty then
  27043. aType:=GetPasPropertyType(TPasProperty(IdentEl))
  27044. else if C=TPasArgument then
  27045. aType:=TPasArgument(IdentEl).ArgType
  27046. else if C.InheritsFrom(TPasProcedure)
  27047. and (TPasProcedure(IdentEl).ProcType is TPasFunctionType) then
  27048. aType:=TPasFunctionType(TPasProcedure(IdentEl).ProcType).ResultEl.ResultType
  27049. else if C=TPasSetType then
  27050. exit(TPasSetType(IdentEl))
  27051. else
  27052. exit;
  27053. if aType.ClassType=TPasSetType then
  27054. Result:=TPasSetType(aType);
  27055. end
  27056. else if ResolvedSet.BaseType=btContext then
  27057. begin
  27058. if ResolvedSet.LoTypeEl.ClassType=TPasSetType then
  27059. if ResolvedSet.HiTypeEl.ClassType=TPasSetType then
  27060. Result:=TPasSetType(ResolvedSet.HiTypeEl)
  27061. else
  27062. Result:=TPasSetType(ResolvedSet.LoTypeEl);
  27063. end;
  27064. end;
  27065. function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
  27066. ): boolean;
  27067. begin
  27068. TypeEl:=ResolveAliasType(TypeEl);
  27069. if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType) then
  27070. exit(false);
  27071. if length(TPasArrayType(TypeEl).Ranges)<>0 then
  27072. exit(false);
  27073. // Note: Array of Const is an open array of TVarRec
  27074. if OptionalOpenArray and (proOpenAsDynArrays in Options) then
  27075. Result:=true
  27076. else
  27077. Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
  27078. end;
  27079. function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
  27080. begin
  27081. Result:=(TypeEl<>nil)
  27082. and (TypeEl.ClassType=TPasArrayType)
  27083. and (length(TPasArrayType(TypeEl).Ranges)=0)
  27084. and (TypeEl.Parent<>nil)
  27085. and (TypeEl.Parent.ClassType=TPasArgument);
  27086. end;
  27087. function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
  27088. begin
  27089. TypeEl:=ResolveAliasType(TypeEl);
  27090. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  27091. and (length(TPasArrayType(TypeEl).Ranges)=0);
  27092. end;
  27093. function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
  27094. begin
  27095. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  27096. and (TPasArrayType(TypeEl).ElType=nil);
  27097. end;
  27098. function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
  27099. begin
  27100. Result:=ArrType.ElType;
  27101. if Result=nil then
  27102. Result:=GetTVarRec(ArrType);
  27103. end;
  27104. function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
  27105. var
  27106. C: TClass;
  27107. begin
  27108. Result:=false;
  27109. if Expr=nil then exit;
  27110. if Expr.Parent=nil then exit;
  27111. C:=Expr.Parent.ClassType;
  27112. if C.InheritsFrom(TPasVariable) then
  27113. Result:=(TPasVariable(Expr.Parent).Expr=Expr)
  27114. else if C=TPasArgument then
  27115. Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
  27116. end;
  27117. function TPasResolver.IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  27118. begin
  27119. Result:=(ResolvedEl.BaseType in [btSet,btArrayOrSet,btArrayLit])
  27120. and (ResolvedEl.SubType=btNone);
  27121. end;
  27122. function TPasResolver.IsClassMethod(El: TPasElement): boolean;
  27123. var
  27124. C: TClass;
  27125. begin
  27126. if El=nil then exit(false);
  27127. C:=El.ClassType;;
  27128. Result:=(C=TPasClassConstructor)
  27129. or (C=TPasClassDestructor)
  27130. or (C=TPasClassProcedure)
  27131. or (C=TPasClassFunction)
  27132. or (C=TPasClassOperator);
  27133. end;
  27134. function TPasResolver.IsClassField(El: TPasElement): boolean;
  27135. var
  27136. C: TClass;
  27137. begin
  27138. if ((El.ClassType=TPasVariable) or (El.ClassType=TPasConst))
  27139. and ([vmClass,vmStatic]*TPasVariable(El).VarModifiers<>[]) then
  27140. begin
  27141. C:=El.Parent.ClassType;
  27142. Result:=(C=TPasClassType) or (C=TPasRecordType);
  27143. end
  27144. else
  27145. Result:=false;
  27146. end;
  27147. function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
  27148. var
  27149. ProcType: TPasProcedureType;
  27150. begin
  27151. if not (El is TPasProcedure) then exit(nil);
  27152. ProcType:=TPasProcedure(El).ProcType;
  27153. if ProcType is TPasFunctionType then
  27154. Result:=TPasFunctionType(ProcType)
  27155. else
  27156. Result:=nil;
  27157. end;
  27158. function TPasResolver.MethodIsStatic(El: TPasProcedure): boolean;
  27159. begin
  27160. Result:=El.IsStatic
  27161. or (El.ClassType=TPasClassConstructor)
  27162. or (El.ClassType=TPasClassDestructor);
  27163. end;
  27164. function TPasResolver.IsMethod(El: TPasProcedure): boolean;
  27165. var
  27166. ProcScope: TPasProcedureScope;
  27167. begin
  27168. Result:=false;
  27169. if El=nil then exit;
  27170. if El.Parent is TPasMembersType then exit(true);
  27171. if not (El.CustomData is TPasProcedureScope) then exit;
  27172. ProcScope:=TPasProcedureScope(El.CustomData);
  27173. Result:=IsMethod(ProcScope.DeclarationProc);
  27174. end;
  27175. function TPasResolver.IsMethod_SelfIsClass(El: TPasElement): boolean;
  27176. var
  27177. C: TClass;
  27178. begin
  27179. if (El=nil) then exit(false);
  27180. C:=El.ClassType;
  27181. Result:=((C=TPasClassProcedure) or (C=TPasClassFunction) or (C=TPasClassOperator))
  27182. and not TPasProcedure(El).IsStatic;
  27183. end;
  27184. function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
  27185. begin
  27186. Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
  27187. and (TPasClassType(El.Parent).HelperForType<>nil);
  27188. end;
  27189. function TPasResolver.IsHelper(El: TPasElement): boolean;
  27190. begin
  27191. Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil);
  27192. end;
  27193. function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
  27194. const ExtName: string): boolean;
  27195. var
  27196. AncestorScope: TPasClassScope;
  27197. begin
  27198. Result:=false;
  27199. if aClass=nil then exit;
  27200. while aClass<>nil do
  27201. begin
  27202. if aClass.ExternalName=ExtName then exit(true);
  27203. AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
  27204. if AncestorScope=nil then exit;
  27205. aClass:=NoNil(AncestorScope.Element) as TPasClassType;
  27206. end;
  27207. end;
  27208. function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
  27209. HasValue: boolean): boolean;
  27210. var
  27211. TypeEl: TPasType;
  27212. begin
  27213. if (ResolvedEl.BaseType<>btContext) then
  27214. exit(false);
  27215. TypeEl:=ResolvedEl.LoTypeEl;
  27216. if not (TypeEl is TPasProcedureType) then
  27217. exit(false);
  27218. if HasValue and not (rrfReadable in ResolvedEl.Flags) then
  27219. exit(false);
  27220. Result:=true;
  27221. end;
  27222. function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
  27223. ): boolean;
  27224. begin
  27225. Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasArrayType);
  27226. end;
  27227. function TPasResolver.IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  27228. var
  27229. Ref: TResolvedReference;
  27230. begin
  27231. Result:=nil;
  27232. if Expr=nil then exit;
  27233. if Expr.Kind<>pekSet then exit;
  27234. if not (Expr.CustomData is TResolvedReference) then exit;
  27235. Ref:=TResolvedReference(Expr.CustomData);
  27236. if Ref.Declaration is TPasArrayType then
  27237. Result:=TPasArrayType(Ref.Declaration);
  27238. end;
  27239. function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  27240. begin
  27241. Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
  27242. and ElHasModeSwitch(Expr,msArrayOperators);
  27243. end;
  27244. function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
  27245. var
  27246. Value: TPasExpr;
  27247. Ref: TResolvedReference;
  27248. Decl: TPasElement;
  27249. C: TClass;
  27250. begin
  27251. Result:=false;
  27252. if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
  27253. Value:=Params.Value;
  27254. if not IsNameExpr(Value) then
  27255. exit;
  27256. if not (Value.CustomData is TResolvedReference) then exit;
  27257. Ref:=TResolvedReference(Value.CustomData);
  27258. Decl:=Ref.Declaration;
  27259. C:=Decl.ClassType;
  27260. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  27261. begin
  27262. Decl:=ResolveAliasType(TPasAliasType(Decl));
  27263. C:=Decl.ClassType;
  27264. end;
  27265. if (C=TPasProcedureType)
  27266. or (C=TPasFunctionType) then
  27267. exit(true)
  27268. else if (C=TPasClassType)
  27269. or (C=TPasClassOfType)
  27270. or (C=TPasEnumType)
  27271. or (C=TPasRecordType)
  27272. or (C=TPasArrayType)
  27273. or (C=TPasSpecializeType)
  27274. or (C=TPasGenericTemplateType) then
  27275. exit(true)
  27276. else if (C=TPasUnresolvedSymbolRef)
  27277. and (Decl.CustomData is TResElDataBaseType) then
  27278. exit(true);
  27279. end;
  27280. function TPasResolver.GetTypeParameterCount(aType: TPasGenericType): integer;
  27281. begin
  27282. if aType=nil then exit(0);
  27283. if aType.GenericTemplateTypes=nil then exit(0);
  27284. Result:=aType.GenericTemplateTypes.Count;
  27285. end;
  27286. function TPasResolver.GetGenericConstraintKeyword(El: TPasElement): TToken;
  27287. var
  27288. Prim: TPrimitiveExpr;
  27289. begin
  27290. if (El=nil) or (El.ClassType<>TPrimitiveExpr) then
  27291. exit(tkEOF);
  27292. Prim:=TPrimitiveExpr(El);
  27293. if Prim.Kind<>pekIdent then
  27294. exit(tkEOF);
  27295. case lowercase(Prim.Value) of
  27296. 'record': Result:=tkrecord;
  27297. 'class': Result:=tkclass;
  27298. 'constructor': Result:=tkconstructor;
  27299. else Result:=tkEOF;
  27300. end;
  27301. end;
  27302. function TPasResolver.GetGenericConstraintErrorEl(ConstraintEl,
  27303. TemplType: TPasElement): TPasElement;
  27304. begin
  27305. if (ConstraintEl is TPasExpr) or (ConstraintEl.Parent=TemplType) then
  27306. Result:=ConstraintEl
  27307. else
  27308. Result:=TemplType;
  27309. end;
  27310. function TPasResolver.GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  27311. Params: TFPList): TPasElement;
  27312. var
  27313. Data: TPasSpecializeTypeData;
  27314. GenScope: TPasGenericScope;
  27315. GenericTemplateList: TFPList;
  27316. i, j: Integer;
  27317. Param: TPasElement;
  27318. ParamsResolved: TPasTypeArray;
  27319. ResolvedEl: TPasResolverResult;
  27320. SpecializedElList: TObjectList;
  27321. Item: TPRSpecializedItem;
  27322. SrcModule: TPasModule;
  27323. SrcModuleScope: TPasModuleScope;
  27324. SrcResolver: TPasResolver;
  27325. IsSelf: Boolean;
  27326. GenericType: TPasGenericType;
  27327. GenericProc: TPasProcedure;
  27328. ProcScope: TPasProcedureScope;
  27329. begin
  27330. Result:=nil;
  27331. if (El.ClassType=TPasSpecializeType) and (El.CustomData<>nil) then
  27332. RaiseNotYetImplemented(20190726142522,El);
  27333. // check if there is already such a specialization
  27334. GenScope:=nil;
  27335. GenericType:=nil;
  27336. GenericProc:=nil;
  27337. if GenericEl is TPasGenericType then
  27338. begin
  27339. GenericType:=TPasGenericType(GenericEl);
  27340. if not (GenericEl.CustomData is TPasGenericScope) then
  27341. RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27342. [GetTypeDescription(GenericType)],El);
  27343. GenScope:=TPasGenericScope(GenericEl.CustomData);
  27344. if (not (GenericType is TPasClassType))
  27345. and (GenScope.GenericStep<psgsInterfaceParsed) then
  27346. RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27347. [GetTypeDescription(GenericType)],El);
  27348. GenericTemplateList:=GenericType.GenericTemplateTypes;
  27349. end
  27350. else if GenericEl is TPasProcedure then
  27351. begin
  27352. GenericProc:=TPasProcedure(GenericEl);
  27353. if not (GenericProc.CustomData is TPasProcedureScope) then
  27354. RaiseMsg(20190919132733,nIdentifierNotFound,sIdentifierNotFound,
  27355. [GenericProc.Name],El);
  27356. ProcScope:=TPasProcedureScope(GenericProc.CustomData);
  27357. if ProcScope.DeclarationProc<>nil then
  27358. RaiseNotYetImplemented(20190920182602,El);
  27359. GenScope:=ProcScope;
  27360. if GenScope.GenericStep<psgsInterfaceParsed then
  27361. RaiseMsg(20190920120649,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27362. [GetElementDbgPath(GenericProc)],El);
  27363. GenericTemplateList:=GetProcTemplateTypes(GenericProc);
  27364. end
  27365. else
  27366. RaiseNotYetImplemented(20190919132603,GenericEl);
  27367. SpecializedElList:=GenScope.SpecializedItems;
  27368. if GenericTemplateList=nil then
  27369. RaiseMsg(20190905111703,nXExpectedButYFound,sXExpectedButYFound,
  27370. ['generic templates',GenericEl.Name],El);
  27371. if GenericTemplateList.Count<>Params.Count then
  27372. RaiseMsg(20190905111704,nXExpectedButYFound,sXExpectedButYFound,
  27373. ['type with '+IntToStr(Params.Count)+' generic template(s)',
  27374. GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
  27375. SetLength(ParamsResolved{%H-},Params.Count);
  27376. IsSelf:=true;
  27377. for i:=0 to Params.Count-1 do
  27378. begin
  27379. Param:=TPasElement(Params[i]);
  27380. ComputeElement(Param,ResolvedEl,[rcType]);
  27381. ParamsResolved[i]:=ResolvedEl.LoTypeEl;
  27382. if ResolvedEl.LoTypeEl<>TPasType(GenericTemplateList[i]) then
  27383. IsSelf:=false;
  27384. end;
  27385. if IsSelf then
  27386. exit(GenericEl);
  27387. if SpecializedElList=nil then
  27388. begin
  27389. SpecializedElList:=TObjectList.Create(true);
  27390. if GenScope<>nil then
  27391. GenScope.SpecializedItems:=SpecializedElList
  27392. else
  27393. RaiseNotYetImplemented(20190919133159,El);
  27394. end;
  27395. i:=SpecializedElList.Count-1;
  27396. Item:=nil;
  27397. while i>=0 do
  27398. begin
  27399. Item:=TPRSpecializedItem(SpecializedElList[i]);
  27400. j:=length(Item.Params)-1;
  27401. while j>=0 do
  27402. begin
  27403. if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
  27404. and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
  27405. break;
  27406. dec(j);
  27407. end;
  27408. if j<0 then
  27409. break;
  27410. Item:=nil;
  27411. dec(i);
  27412. end;
  27413. if Item=nil then
  27414. begin
  27415. // new specialization
  27416. SrcModule:=GenericEl.GetModule;
  27417. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  27418. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  27419. Item:=SrcResolver.CreateSpecializedItem(El,GenericEl,ParamsResolved)
  27420. end;
  27421. Result:=Item.SpecializedEl;
  27422. if El.ClassType=TPasSpecializeType then
  27423. begin
  27424. Data:=TPasSpecializeTypeData.Create;
  27425. // add to free list
  27426. AddResolveData(El,Data,lkModule);
  27427. Data.SpecializedType:=Result as TPasGenericType; // no AddRef
  27428. end;
  27429. end;
  27430. procedure TPasResolver.FinishGenericClassOrRecIntf(Scope: TPasGenericScope);
  27431. var
  27432. El: TPasGenericType;
  27433. SpecializedItems: TObjectList;
  27434. i: Integer;
  27435. SpecializedItem: TPRSpecializedTypeItem;
  27436. OldScopeState: TScopeStashState;
  27437. begin
  27438. El:=Scope.Element as TPasGenericType;
  27439. if Scope.GenericStep<>psgsNone then
  27440. RaiseNotYetImplemented(20200219124544,El);
  27441. Scope.GenericStep:=psgsInterfaceParsed;
  27442. SpecializedItems:=Scope.SpecializedItems;
  27443. if SpecializedItems<>nil then
  27444. // finish interfaces of started specializations
  27445. for i:=0 to SpecializedItems.Count-1 do
  27446. begin
  27447. SpecializedItem:=TPRSpecializedTypeItem(SpecializedItems[i]);
  27448. SpecializedItem.GenericEl:=El;
  27449. if SpecializedItem.Step<>prssNone then continue;
  27450. InitSpecializeScopes(El,OldScopeState);
  27451. {$IFDEF VerbosePasResolver}
  27452. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finishing specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  27453. {$ENDIF}
  27454. SpecializeGenericIntf(SpecializedItem);
  27455. {$IFDEF VerbosePasResolver}
  27456. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finished specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  27457. {$ENDIF}
  27458. RestoreSpecializeScopes(OldScopeState);
  27459. {$IFDEF VerbosePasResolver}
  27460. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf RestoreStashedScopes '+GetObjName(SpecializedItem.SpecializedType));
  27461. {$ENDIF}
  27462. end;
  27463. end;
  27464. procedure TPasResolver.FinishSpecializations(Scope: TPasGenericScope);
  27465. var
  27466. SpecializedItems: TObjectList;
  27467. i: Integer;
  27468. begin
  27469. SpecializedItems:=Scope.SpecializedItems;
  27470. if SpecializedItems=nil then exit;
  27471. for i:=0 to SpecializedItems.Count-1 do
  27472. SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
  27473. end;
  27474. procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
  27475. var
  27476. i: Integer;
  27477. DeclEl: TPasElement;
  27478. Proc: TPasProcedure;
  27479. aClassOrRec: TPasMembersType;
  27480. ClassOrRecScope: TPasClassOrRecordScope;
  27481. begin
  27482. if IsElementSkipped(El) then exit;
  27483. if El is TPasDeclarations then
  27484. begin
  27485. for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
  27486. begin
  27487. DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
  27488. if DeclEl is TPasProcedure then
  27489. begin
  27490. Proc:=TPasProcedure(DeclEl);
  27491. if ProcNeedsImplProc(Proc)
  27492. and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
  27493. RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
  27494. [GetElementTypeName(Proc),Proc.Name],Proc);
  27495. end;
  27496. end;
  27497. end
  27498. else if El is TPasMembersType then
  27499. begin
  27500. aClassOrRec:=TPasMembersType(El);
  27501. if (aClassOrRec is TPasClassType) then
  27502. begin
  27503. if (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface]) then
  27504. exit;
  27505. if TPasClassType(aClassOrRec).IsForward then
  27506. exit;
  27507. if TPasClassType(aClassOrRec).IsExternal then
  27508. exit;
  27509. end;
  27510. ClassOrRecScope:=aClassOrRec.CustomData as TPasClassOrRecordScope;
  27511. if ClassOrRecScope.SpecializedFromItem<>nil then
  27512. exit;
  27513. // finish implementation of (generic) class/record
  27514. if ClassOrRecScope.GenericStep<>psgsInterfaceParsed then
  27515. RaiseNotYetImplemented(20190804115324,El);
  27516. for i:=0 to aClassOrRec.Members.Count-1 do
  27517. begin
  27518. DeclEl:=TPasElement(aClassOrRec.Members[i]);
  27519. if DeclEl is TPasProcedure then
  27520. begin
  27521. Proc:=TPasProcedure(DeclEl);
  27522. if Proc.IsAbstract or Proc.IsExternal then continue;
  27523. if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
  27524. begin
  27525. {$IFDEF VerbosePasResolver}
  27526. writeln('TPasResolver.CheckPendingForwardProcs Proc.ParentPath=',Proc.PathName);
  27527. {$ENDIF}
  27528. RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
  27529. [GetElementTypeName(Proc),Proc.Name],Proc);
  27530. end;
  27531. end;
  27532. end;
  27533. ClassOrRecScope.GenericStep:=psgsImplementationParsed;
  27534. if ClassOrRecScope.SpecializedItems<>nil then
  27535. FinishSpecializations(ClassOrRecScope);
  27536. end;
  27537. end;
  27538. function TPasResolver.IsSpecialized(El: TPasGenericType): boolean;
  27539. begin
  27540. Result:=(El<>nil) and (El.CustomData is TPasGenericScope)
  27541. and (TPasGenericScope(El.CustomData).SpecializedFromItem<>nil);
  27542. end;
  27543. function TPasResolver.IsFullySpecialized(El: TPasGenericType): boolean;
  27544. var
  27545. GenScope: TPasGenericScope;
  27546. Params: TPasTypeArray;
  27547. i: Integer;
  27548. begin
  27549. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  27550. exit(false);
  27551. if not (El.CustomData is TPasGenericScope) then exit(true);
  27552. GenScope:=TPasGenericScope(El.CustomData);
  27553. if GenScope.SpecializedFromItem=nil then exit(true);
  27554. Params:=GenScope.SpecializedFromItem.Params;
  27555. for i:=0 to length(Params)-1 do
  27556. if Params[i] is TPasGenericTemplateType then exit(false);
  27557. Result:=true;
  27558. end;
  27559. function TPasResolver.IsFullySpecialized(Proc: TPasProcedure): boolean;
  27560. var
  27561. Templates: TFPList;
  27562. ProcScope: TPasProcedureScope;
  27563. Params: TPasTypeArray;
  27564. i: Integer;
  27565. begin
  27566. if Proc.CustomData=nil then exit(false);
  27567. ProcScope:=TPasProcedureScope(Proc.CustomData);
  27568. if ProcScope.DeclarationProc<>nil then
  27569. begin
  27570. Proc:=ProcScope.DeclarationProc;
  27571. ProcScope:=TPasProcedureScope(Proc.CustomData);
  27572. end;
  27573. Templates:=GetProcTemplateTypes(Proc);
  27574. if (Templates<>nil) and (Templates.Count>0) then
  27575. exit(false);
  27576. if ProcScope.SpecializedFromItem=nil then
  27577. exit(true);
  27578. Params:=ProcScope.SpecializedFromItem.Params;
  27579. for i:=0 to length(Params)-1 do
  27580. if Params[i] is TPasGenericTemplateType then exit(false);
  27581. Result:=true;
  27582. end;
  27583. function TPasResolver.IsInterfaceType(const ResolvedEl: TPasResolverResult;
  27584. IntfType: TPasClassInterfaceType): boolean;
  27585. begin
  27586. if ResolvedEl.BaseType<>btContext then exit(false);
  27587. Result:=IsInterfaceType(ResolvedEl.LoTypeEl,IntfType);
  27588. end;
  27589. function TPasResolver.IsInterfaceType(TypeEl: TPasType;
  27590. IntfType: TPasClassInterfaceType): boolean;
  27591. begin
  27592. if TypeEl=nil then exit(false);
  27593. TypeEl:=ResolveAliasType(TypeEl);
  27594. Result:=(TypeEl.ClassType=TPasClassType)
  27595. and (TPasClassType(TypeEl).ObjKind=okInterface)
  27596. and (TPasClassType(TypeEl).InterfaceType=IntfType);
  27597. end;
  27598. function TPasResolver.IsTGUID(RecTypeEl: TPasRecordType): boolean;
  27599. var
  27600. Members: TFPList;
  27601. El: TPasElement;
  27602. i, MemberIndex: Integer;
  27603. begin
  27604. Result:=false;
  27605. if not SameText(RecTypeEl.Name,'TGUID') then exit;
  27606. if SameText(RecTypeEl.GetModule.Name,'system') then exit(true);
  27607. Members:=RecTypeEl.Members;
  27608. i:=1;
  27609. for MemberIndex:=0 to Members.Count-1 do
  27610. begin
  27611. El:=TPasElement(Members[MemberIndex]);
  27612. if (El.ClassType<>TPasVariable) then continue;
  27613. if SameText(El.Name,'D'+IntToStr(i)) then
  27614. begin
  27615. if i=4 then exit(true);
  27616. inc(i);
  27617. end;
  27618. end;
  27619. Result:=true;
  27620. end;
  27621. function TPasResolver.IsTGUIDString(const ResolvedEl: TPasResolverResult
  27622. ): boolean;
  27623. var
  27624. TypeEl: TPasType;
  27625. C: TClass;
  27626. IdentEl: TPasElement;
  27627. begin
  27628. if not (ResolvedEl.BaseType in btAllStrings) then
  27629. exit(false);
  27630. if (ResolvedEl.ExprEl<>nil) and (ResolvedEl.LoTypeEl<>nil) then
  27631. exit(true); // untyped string literal
  27632. IdentEl:=ResolvedEl.IdentEl;
  27633. if IdentEl<>nil then
  27634. begin
  27635. C:=IdentEl.ClassType;
  27636. if C.InheritsFrom(TPasVariable) then
  27637. TypeEl:=TPasVariable(IdentEl).VarType
  27638. else if C=TPasArgument then
  27639. TypeEl:=TPasArgument(IdentEl).ArgType
  27640. else if C=TPasResultElement then
  27641. TypeEl:=TPasResultElement(IdentEl).ResultType
  27642. else
  27643. TypeEl:=nil;
  27644. while TypeEl<>nil do
  27645. begin
  27646. if (TypeEl.ClassType=TPasAliasType)
  27647. or (TypeEl.ClassType=TPasTypeAliasType) then
  27648. begin
  27649. if SameText(TypeEl.Name,'TGUIDString') then
  27650. exit(true);
  27651. TypeEl:=TPasAliasType(TypeEl).DestType;
  27652. end
  27653. else
  27654. break;
  27655. end;
  27656. end;
  27657. Result:=false;
  27658. end;
  27659. function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
  27660. var
  27661. ClassEl: TPasClassType;
  27662. ClassScope: TPasClassScope;
  27663. aModule: TPasModule;
  27664. begin
  27665. Result:=false;
  27666. if (El=nil)
  27667. or (El.ClassType<>TPasClassType) then exit;
  27668. ClassEl:=TPasClassType(El);
  27669. if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
  27670. while not SameText(ClassEl.Name,'TCustomAttribute') do
  27671. begin
  27672. ClassScope:=ClassEl.CustomData as TPasClassScope;
  27673. if ClassScope.AncestorScope=nil then exit;
  27674. ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
  27675. end;
  27676. if not (ClassEl.Parent is TPasSection) then
  27677. exit; // this TCustomAttribute is not top level
  27678. aModule:=ClassEl.GetModule;
  27679. Result:=IsSystemUnit(aModule);
  27680. end;
  27681. function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
  27682. var
  27683. Section: TPasSection;
  27684. begin
  27685. Result:=false;
  27686. if El=nil then exit;
  27687. if SameText(El.Name,'system') then exit(true);
  27688. // tests and scripts are their own system unit: check if this is the root module
  27689. if El.ClassType=TPasProgram then
  27690. Section:=TPasProgram(El).ProgramSection
  27691. else if El.ClassType=TPasLibrary then
  27692. Section:=TPasLibrary(El).LibrarySection
  27693. else
  27694. Section:=El.InterfaceSection;
  27695. Result:=length(Section.UsesClause)=0;
  27696. end;
  27697. function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
  27698. var
  27699. Parent: TPasElement;
  27700. C: TClass;
  27701. Members: TFPList;
  27702. i: Integer;
  27703. begin
  27704. Result:=nil;
  27705. if El=nil then exit;
  27706. // find El in El.Parent members
  27707. Parent:=El.Parent;
  27708. if Parent=nil then exit;
  27709. C:=Parent.ClassType;
  27710. if C.InheritsFrom(TPasDeclarations) then
  27711. Members:=TPasDeclarations(Parent).Declarations
  27712. else if C.InheritsFrom(TPasMembersType) then
  27713. Members:=TPasMembersType(Parent).Members
  27714. else
  27715. exit;
  27716. i:=Members.IndexOf(El);
  27717. if i<0 then exit;
  27718. Result:=GetAttributeCalls(Members,i);
  27719. end;
  27720. function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
  27721. ): TPasExprArray;
  27722. procedure AddAttributesInFront(Members: TFPList; i: integer);
  27723. var
  27724. j, l, k: Integer;
  27725. Calls: TPasExprArray;
  27726. begin
  27727. // find attributes in front
  27728. j:=i;
  27729. while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
  27730. dec(j);
  27731. // collect all attribute calls
  27732. l:=0;
  27733. while j<i do
  27734. begin
  27735. Calls:=TPasAttributes(Members[j]).Calls;
  27736. SetLength(Result,l+length(Calls));
  27737. for k:=0 to length(Calls)-1 do
  27738. begin
  27739. Result[l]:=Calls[k];
  27740. inc(l);
  27741. end;
  27742. inc(j);
  27743. end;
  27744. end;
  27745. var
  27746. El, CurEl: TPasElement;
  27747. begin
  27748. Result:=nil;
  27749. El:=TPasElement(Members[Index]);
  27750. AddAttributesInFront(Members,Index);
  27751. if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
  27752. repeat
  27753. dec(Index);
  27754. if Index<1 then break;
  27755. CurEl:=TPasElement(Members[Index]);
  27756. if (CurEl.ClassType=TPasClassType)
  27757. and TPasClassType(CurEl).IsForward
  27758. and (TPasClassType(CurEl).CustomData is TResolvedReference)
  27759. and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
  27760. then
  27761. begin
  27762. // class has a forward declaration -> add attributes
  27763. AddAttributesInFront(Members,Index);
  27764. break;
  27765. end;
  27766. until false;
  27767. end;
  27768. function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
  27769. begin
  27770. Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
  27771. end;
  27772. function TPasResolver.ProcHasSelf(El: TPasProcedure): boolean;
  27773. var
  27774. C: TClass;
  27775. begin
  27776. if El.IsStatic then
  27777. exit(false);
  27778. C:=El.Parent.ClassType;
  27779. if C.InheritsFrom(TPasSection) or (C=TProcedureBody) then
  27780. exit(false);
  27781. C:=El.ClassType;
  27782. if (C=TPasClassConstructor) or (C=TPasClassDestructor) then
  27783. exit(false);
  27784. Result:=true;
  27785. end;
  27786. procedure TPasResolver.CreateProcSelfArg(Proc: TPasProcedure);
  27787. var
  27788. SelfArg: TPasArgument;
  27789. SelfType, LoSelfType: TPasType;
  27790. ProcScope: TPasProcedureScope;
  27791. ClassOrRecScope: TPasClassOrRecordScope;
  27792. ClassRecType: TPasMembersType;
  27793. begin
  27794. if Proc.IsStatic or Proc.IsExternal then exit;
  27795. // add 'Self'
  27796. if (Proc.ClassType=TPasClassConstructor)
  27797. or (Proc.ClassType=TPasClassDestructor) then
  27798. // actually class constructor/destructor are static
  27799. exit;
  27800. ProcScope:=TPasProcedureScope(Proc.CustomData);
  27801. ClassOrRecScope:=ProcScope.ClassRecScope;
  27802. if ClassOrRecScope=nil then exit;
  27803. ClassRecType:=TPasMembersType(ClassOrRecScope.Element);
  27804. if (Proc.ClassType=TPasClassProcedure)
  27805. or (Proc.ClassType=TPasClassFunction) then
  27806. begin
  27807. if (ClassOrRecScope is TPasClassScope)
  27808. and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
  27809. begin
  27810. // 'Self' in a class method is the hidden classtype argument
  27811. // Note: this is true in classes, adv records and helpers
  27812. SelfArg:=TPasArgument.Create('Self',Proc);
  27813. ProcScope.SelfArg:=SelfArg;
  27814. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  27815. SelfArg.Access:=argConst;
  27816. SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
  27817. SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  27818. end
  27819. else
  27820. RaiseInternalError(20190106121745);
  27821. end
  27822. else
  27823. begin
  27824. // 'Self' in a method is the hidden instance argument
  27825. SelfArg:=TPasArgument.Create('Self',Proc);
  27826. ProcScope.SelfArg:=SelfArg;
  27827. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  27828. SelfType:=ClassRecType;
  27829. if (SelfType.ClassType=TPasClassType)
  27830. and (TPasClassType(SelfType).HelperForType<>nil) then
  27831. begin
  27832. // in a helper Self is a var argument of the helped variable
  27833. SelfType:=TPasClassType(SelfType).HelperForType;
  27834. end;
  27835. LoSelfType:=ResolveAliasType(SelfType);
  27836. if (LoSelfType is TPasClassType)
  27837. and (TPasClassType(LoSelfType).ObjKind=okClass) then
  27838. SelfArg.Access:=argConst
  27839. else
  27840. SelfArg.Access:=argVar;
  27841. SelfArg.ArgType:=SelfType;
  27842. SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  27843. end;
  27844. end;
  27845. function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
  27846. ): boolean;
  27847. var
  27848. Proc, OverriddenProc: TPasProcedure;
  27849. begin
  27850. Result:=false;
  27851. Proc:=DescendantProc;
  27852. if not Proc.IsOverride then exit;
  27853. if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
  27854. repeat
  27855. OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
  27856. if AncestorProc=OverriddenProc then exit(true);
  27857. Proc:=OverriddenProc;
  27858. until Proc=nil;
  27859. end;
  27860. function TPasResolver.GetTopLvlProc(El: TPasElement): TPasProcedure;
  27861. begin
  27862. Result:=nil;
  27863. while El<>nil do
  27864. begin
  27865. if El is TPasProcedure then
  27866. Result:=TPasProcedure(El);
  27867. El:=El.Parent;
  27868. end;
  27869. end;
  27870. function TPasResolver.GetParentProc(El: TPasElement; GetDeclProc: boolean
  27871. ): TPasProcedure;
  27872. var
  27873. ProcScope: TPasProcedureScope;
  27874. begin
  27875. Result:=nil;
  27876. while El<>nil do
  27877. begin
  27878. if El is TPasProcedure then
  27879. begin
  27880. Result:=TPasProcedure(El);
  27881. if GetDeclProc and (El.CustomData is TPasProcedureScope) then
  27882. begin
  27883. ProcScope:=TPasProcedureScope(El.CustomData);
  27884. if ProcScope.DeclarationProc<>nil then
  27885. Result:=ProcScope.DeclarationProc;
  27886. end;
  27887. exit;
  27888. end;
  27889. El:=El.Parent;
  27890. end;
  27891. end;
  27892. function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  27893. var
  27894. Range: TResEvalValue;
  27895. begin
  27896. Result:=0;
  27897. Range:=Eval(RangeExpr,[refConst]);
  27898. if Range=nil then
  27899. RaiseNotYetImplemented(20170910210416,RangeExpr);
  27900. try
  27901. case Range.Kind of
  27902. revkRangeInt:
  27903. Result:=TResEvalRangeInt(Range).RangeEnd-TResEvalRangeInt(Range).RangeStart+1;
  27904. revkRangeUInt:
  27905. Result:=TResEvalRangeUInt(Range).RangeEnd-TResEvalRangeUInt(Range).RangeStart+1;
  27906. else
  27907. RaiseNotYetImplemented(20170910210554,RangeExpr);
  27908. end;
  27909. finally
  27910. ReleaseEvalValue(Range);
  27911. end;
  27912. {$IFDEF VerbosePasResolver}
  27913. {AllowWriteln}
  27914. //if Result=0 then
  27915. writeln('TPasResolver.GetRangeLength Result=',Result);
  27916. {AllowWriteln-}
  27917. {$ENDIF}
  27918. end;
  27919. function TPasResolver.EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  27920. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue;
  27921. var
  27922. Range: TResEvalValue;
  27923. EnumType: TPasEnumType;
  27924. begin
  27925. Result:=nil;
  27926. Range:=Eval(RangeExpr,Flags+[refConst]);
  27927. if Range=nil then
  27928. RaiseNotYetImplemented(20170601191258,RangeExpr);
  27929. case Range.Kind of
  27930. revkRangeInt:
  27931. case TResEvalRangeInt(Range).ElKind of
  27932. revskEnum:
  27933. begin
  27934. EnumType:=NoNil(TResEvalRangeInt(Range).ElType) as TPasEnumType;
  27935. if EvalLow then
  27936. Result:=TResEvalEnum.CreateValue(
  27937. TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
  27938. else
  27939. Result:=TResEvalEnum.CreateValue(
  27940. TResEvalRangeInt(Range).RangeEnd,
  27941. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  27942. end;
  27943. revskInt:
  27944. if EvalLow then
  27945. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
  27946. else
  27947. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
  27948. revskChar:
  27949. {$ifdef FPC_HAS_CPSTRING}
  27950. if TResEvalRangeInt(Range).RangeEnd<256 then
  27951. begin
  27952. if EvalLow then
  27953. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
  27954. else
  27955. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd));
  27956. end
  27957. else
  27958. {$endif}
  27959. begin
  27960. if EvalLow then
  27961. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeStart))
  27962. else
  27963. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
  27964. end;
  27965. revskBool:
  27966. if EvalLow then
  27967. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
  27968. else
  27969. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
  27970. else
  27971. ReleaseEvalValue(Range);
  27972. RaiseNotYetImplemented(20170601195240,ErrorEl);
  27973. end;
  27974. revkRangeUInt:
  27975. if EvalLow then
  27976. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
  27977. else
  27978. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
  27979. else
  27980. ReleaseEvalValue(Range);
  27981. RaiseNotYetImplemented(20170601195336,ErrorEl);
  27982. end;
  27983. ReleaseEvalValue(Range);
  27984. end;
  27985. function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags
  27986. ): TResEvalValue;
  27987. var
  27988. C: TClass;
  27989. BaseTypeData: TResElDataBaseType;
  27990. begin
  27991. Result:=nil;
  27992. Decl:=ResolveAliasType(Decl);
  27993. C:=Decl.ClassType;
  27994. if C=TPasRangeType then
  27995. begin
  27996. Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
  27997. if (Result<>nil) and (Result.IdentEl=nil) then
  27998. begin
  27999. Result.IdentEl:=Decl;
  28000. exit;
  28001. end;
  28002. end
  28003. else if C=TPasEnumType then
  28004. begin
  28005. Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
  28006. 0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
  28007. Result.IdentEl:=Decl;
  28008. exit;
  28009. end
  28010. else if C=TPasUnresolvedSymbolRef then
  28011. begin
  28012. if (Decl.CustomData is TResElDataBaseType) then
  28013. begin
  28014. BaseTypeData:=TResElDataBaseType(Decl.CustomData);
  28015. case BaseTypeData.BaseType of
  28016. btChar:
  28017. begin
  28018. Result:=TResEvalRangeInt.Create;
  28019. TResEvalRangeInt(Result).ElKind:=revskChar;
  28020. TResEvalRangeInt(Result).RangeStart:=0;
  28021. {$ifdef FPC_HAS_CPSTRING}
  28022. if BaseTypeChar in [btChar,btAnsiChar] then
  28023. TResEvalRangeInt(Result).RangeEnd:=$ff
  28024. else
  28025. {$endif}
  28026. TResEvalRangeInt(Result).RangeEnd:=$ffff;
  28027. end;
  28028. {$ifdef FPC_HAS_CPSTRING}
  28029. btAnsiChar:
  28030. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  28031. {$endif}
  28032. btWideChar:
  28033. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  28034. btBoolean,btByteBool,btWordBool{$ifdef HasInt64},btQWordBool{$endif}:
  28035. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
  28036. btByte,
  28037. btShortInt,
  28038. btWord,
  28039. btSmallInt,
  28040. btLongWord,
  28041. btLongint,
  28042. {$ifdef HasInt64}
  28043. btInt64,
  28044. btComp,
  28045. {$endif}
  28046. btIntSingle,
  28047. btUIntSingle,
  28048. btIntDouble,
  28049. btUIntDouble:
  28050. begin
  28051. Result:=TResEvalRangeInt.Create;
  28052. TResEvalRangeInt(Result).ElKind:=revskInt;
  28053. GetIntegerRange(BaseTypeData.BaseType,
  28054. TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
  28055. end;
  28056. end;
  28057. end;
  28058. end;
  28059. end;
  28060. function TPasResolver.HasTypeInfo(El: TPasType): boolean;
  28061. begin
  28062. Result:=false;
  28063. if El=nil then exit;
  28064. if El.CustomData is TResElDataBaseType then
  28065. exit(true); // base type
  28066. if El.Parent=nil then exit;
  28067. if El.Parent is TPasType then
  28068. begin
  28069. if not HasTypeInfo(TPasType(El.Parent)) then
  28070. exit;
  28071. end
  28072. else if ElHasModeSwitch(El,msOmitRTTI) then
  28073. exit
  28074. else if El.Parent is TPasAnonymousProcedure then
  28075. exit;
  28076. Result:=true;
  28077. end;
  28078. function TPasResolver.GetActualBaseType(bt: TResolverBaseType
  28079. ): TResolverBaseType;
  28080. begin
  28081. case bt of
  28082. btChar: Result:=BaseTypeChar;
  28083. btString: Result:=BaseTypeString;
  28084. btExtended: Result:=BaseTypeExtended;
  28085. else Result:=bt;
  28086. end;
  28087. end;
  28088. function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
  28089. ErrorEl: TPasElement): TResolverBaseType;
  28090. begin
  28091. if Bool1=Bool2 then exit(Bool1);
  28092. case Bool1 of
  28093. btBoolean: Result:=Bool2;
  28094. btByteBool: if Bool2<>btBoolean then Result:=Bool2;
  28095. btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
  28096. btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
  28097. {$ifdef HasInt64}
  28098. btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
  28099. {$endif}
  28100. else
  28101. RaiseNotYetImplemented(20170420093805,ErrorEl);
  28102. end;
  28103. end;
  28104. function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
  28105. ErrorEl: TPasElement): TResolverBaseType;
  28106. var
  28107. Precision1, Precision2: word;
  28108. Signed1, Signed2: boolean;
  28109. begin
  28110. if Int1.BaseType=Int2.BaseType then exit;
  28111. GetIntegerProps(Int1.BaseType,Precision1,Signed1);
  28112. GetIntegerProps(Int2.BaseType,Precision2,Signed2);
  28113. if Precision1=Precision2 then
  28114. begin
  28115. if Signed1<>Signed2 then
  28116. Precision1:=Max(Precision1,Precision2)+1;
  28117. end;
  28118. Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
  28119. end;
  28120. procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
  28121. Precision: word; out Signed: boolean);
  28122. begin
  28123. case bt of
  28124. btByte: begin Precision:=8; Signed:=false; end;
  28125. btShortInt: begin Precision:=8; Signed:=true; end;
  28126. btWord: begin Precision:=16; Signed:=false; end;
  28127. btSmallInt: begin Precision:=16; Signed:=true; end;
  28128. btIntSingle: begin Precision:=23; Signed:=true; end;
  28129. btUIntSingle: begin Precision:=22; Signed:=false; end;
  28130. btLongWord: begin Precision:=32; Signed:=false; end;
  28131. btLongint: begin Precision:=32; Signed:=true; end;
  28132. btIntDouble: begin Precision:=53; Signed:=true; end;
  28133. btUIntDouble: begin Precision:=52; Signed:=false; end;
  28134. {$ifdef HasInt64}
  28135. btQWord: begin Precision:=64; Signed:=false; end;
  28136. btInt64,btComp: begin Precision:=64; Signed:=true; end;
  28137. {$endif}
  28138. else
  28139. RaiseInternalError(20170420095727);
  28140. end;
  28141. end;
  28142. function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
  28143. MaxVal: TMaxPrecInt): boolean;
  28144. begin
  28145. Result:=true;
  28146. if bt=btExtended then bt:=BaseTypeExtended;
  28147. case bt of
  28148. btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
  28149. btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
  28150. btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
  28151. btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
  28152. btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
  28153. btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
  28154. {$ifdef HasInt64}
  28155. btInt64,
  28156. btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
  28157. {$endif}
  28158. btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
  28159. btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
  28160. btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
  28161. btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
  28162. btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
  28163. else
  28164. Result:=false;
  28165. end;
  28166. end;
  28167. function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
  28168. ErrorEl: TPasElement): TResolverBaseType;
  28169. begin
  28170. if Precision<=8 then
  28171. begin
  28172. if Signed then
  28173. Result:=btShortInt
  28174. else
  28175. Result:=btByte;
  28176. if BaseTypes[Result]<>nil then exit;
  28177. end;
  28178. if Precision<=16 then
  28179. begin
  28180. if Signed then
  28181. Result:=btSmallInt
  28182. else
  28183. Result:=btWord;
  28184. if BaseTypes[Result]<>nil then exit;
  28185. end;
  28186. if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
  28187. exit(btUIntSingle);
  28188. if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
  28189. exit(btIntSingle);
  28190. if Precision<=32 then
  28191. begin
  28192. if Signed then
  28193. Result:=btLongint
  28194. else
  28195. Result:=btLongWord;
  28196. if BaseTypes[Result]<>nil then exit;
  28197. end;
  28198. if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
  28199. exit(btUIntDouble);
  28200. if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
  28201. exit(btIntDouble);
  28202. {$ifdef HasInt64}
  28203. if Precision<=64 then
  28204. begin
  28205. if Signed then
  28206. Result:=btInt64
  28207. else
  28208. Result:=btQWord;
  28209. if BaseTypes[Result]<>nil then exit;
  28210. end;
  28211. {$endif}
  28212. if ErrorEl<>nil then
  28213. RaiseRangeCheck(20170420100336,ErrorEl)
  28214. else
  28215. Result:=btNone;
  28216. end;
  28217. function TPasResolver.GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt
  28218. ): TResolverBaseType;
  28219. // returns BaseTypeExtended if too big
  28220. var
  28221. V: TMaxPrecInt;
  28222. begin
  28223. if MinVal>MaxVal then
  28224. MinVal:=MaxVal;
  28225. if MinVal<0 then
  28226. begin
  28227. if MaxVal>-(MinVal+1) then
  28228. V:=MaxVal
  28229. else
  28230. V:=-(MinVal+1);
  28231. if V<=high(ShortInt) then
  28232. Result:=btShortInt
  28233. else if V<=high(SmallInt) then
  28234. Result:=btSmallInt
  28235. else if (BaseTypes[btIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  28236. Result:=btIntSingle
  28237. else if V<=High(Longint) then
  28238. Result:=btLongint
  28239. else if (BaseTypes[btIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  28240. Result:=btIntDouble
  28241. else
  28242. begin
  28243. Result:=btIntMax;
  28244. if BaseTypes[Result]=nil then
  28245. Result:=BaseTypeExtended;
  28246. end;
  28247. end
  28248. else
  28249. begin
  28250. V:=MaxVal;
  28251. if V<=high(Byte) then
  28252. Result:=btByte
  28253. else if V<=high(Word) then
  28254. Result:=btWord
  28255. else if (BaseTypes[btUIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  28256. Result:=btUIntSingle
  28257. else if V<=High(LongWord) then
  28258. Result:=btLongWord
  28259. else if (BaseTypes[btUIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  28260. Result:=btUIntDouble
  28261. else
  28262. begin
  28263. Result:=btIntMax;
  28264. if BaseTypes[Result]=nil then
  28265. Result:=BaseTypeExtended;
  28266. end;
  28267. end;
  28268. end;
  28269. function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
  28270. ErrorEl: TPasElement): TResolverBaseType;
  28271. var
  28272. bt1, bt2: TResolverBaseType;
  28273. begin
  28274. bt1:=GetActualBaseType(Char1.BaseType);
  28275. bt2:=GetActualBaseType(Char2.BaseType);
  28276. if bt1=bt2 then exit(bt1);
  28277. if not (bt1 in btAllChars) then
  28278. RaiseInternalError(20170420103128);
  28279. Result:=btWideChar;
  28280. if Result=BaseTypeChar then
  28281. Result:=btChar;
  28282. if ErrorEl=nil then ;
  28283. end;
  28284. function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
  28285. ErrorEl: TPasElement): TResolverBaseType;
  28286. var
  28287. bt1, bt2: TResolverBaseType;
  28288. begin
  28289. bt1:=GetActualBaseType(Str1.BaseType);
  28290. bt2:=GetActualBaseType(Str2.BaseType);
  28291. if bt1=bt2 then exit(bt1);
  28292. case bt1 of
  28293. {$ifdef FPC_HAS_CPSTRING}
  28294. btAnsiChar:
  28295. case bt2 of
  28296. btChar: Result:=btChar;
  28297. btWideChar: Result:=btWideChar;
  28298. else Result:=bt2;
  28299. end;
  28300. {$endif}
  28301. btWideChar:
  28302. case bt2 of
  28303. {$ifdef FPC_HAS_CPSTRING}
  28304. btAnsiChar: Result:=btWideChar;
  28305. {$endif}
  28306. btWideString: Result:=btWideString;
  28307. btString,btUnicodeString
  28308. {$ifdef FPC_HAS_CPSTRING},btShortString,btAnsiString,btRawByteString{$endif}:
  28309. Result:=btUnicodeString;
  28310. else RaiseNotYetImplemented(20170420103808,ErrorEl);
  28311. end;
  28312. {$ifdef FPC_HAS_CPSTRING}
  28313. btShortString:
  28314. case bt2 of
  28315. btChar,btAnsiChar: Result:=btShortString;
  28316. btString,btAnsiString: Result:=btAnsiString;
  28317. btRawByteString: Result:=btRawByteString;
  28318. btWideChar,btUnicodeString: Result:=btUnicodeString;
  28319. btWideString: Result:=btWideString;
  28320. else RaiseNotYetImplemented(20170420120937,ErrorEl);
  28321. end;
  28322. {$endif}
  28323. btString{$ifdef FPC_HAS_CPSTRING},btAnsiString{$endif}:
  28324. case bt2 of
  28325. {$ifdef FPC_HAS_CPSTRING}
  28326. btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
  28327. {$endif}
  28328. btWideChar,btUnicodeString: Result:=btUnicodeString;
  28329. btWideString: Result:=btWideString;
  28330. else RaiseNotYetImplemented(20170420121201,ErrorEl);
  28331. end;
  28332. {$ifdef FPC_HAS_CPSTRING}
  28333. btRawByteString:
  28334. case bt2 of
  28335. btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
  28336. btString,btAnsiString: Result:=btAnsiString;
  28337. btWideChar,btUnicodeString: Result:=btUnicodeString;
  28338. btWideString: Result:=btWideString;
  28339. else RaiseNotYetImplemented(20170420121352,ErrorEl);
  28340. end;
  28341. {$endif}
  28342. btWideString:
  28343. case bt2 of
  28344. btChar,btWideChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,btShortString,{$endif}btWideString:
  28345. Result:=btWideString;
  28346. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  28347. Result:=btUnicodeString;
  28348. else RaiseNotYetImplemented(20170420121532,ErrorEl);
  28349. end;
  28350. btUnicodeString:
  28351. Result:=btUnicodeString;
  28352. else
  28353. RaiseNotYetImplemented(20170420103153,ErrorEl);
  28354. end;
  28355. if Result=BaseTypeChar then
  28356. Result:=btChar
  28357. else if Result=BaseTypeString then
  28358. Result:=btString;
  28359. end;
  28360. function TPasResolver.GetCombinedBaseType(const A, B: TPasResolverResult;
  28361. ErrorEl: TPasElement): TResolverBaseType;
  28362. begin
  28363. Result:=btNone;
  28364. if A.BaseType in btAllBooleans then
  28365. begin
  28366. if B.BaseType in btAllBooleans then
  28367. Result:=GetCombinedBoolean(A.BaseType,B.BaseType,ErrorEl);
  28368. end
  28369. else if A.BaseType in btAllInteger then
  28370. begin
  28371. if B.BaseType in btAllInteger then
  28372. Result:=GetCombinedInt(A,B,ErrorEl);
  28373. end
  28374. else if A.BaseType in btAllChars then
  28375. begin
  28376. if B.BaseType in btAllChars then
  28377. Result:=GetCombinedChar(A,B,ErrorEl)
  28378. else if B.BaseType in btAllStrings then
  28379. Result:=GetCombinedString(A,B,ErrorEl);
  28380. end
  28381. else if A.BaseType in btAllStrings then
  28382. begin
  28383. if B.BaseType in btAllStringAndChars then
  28384. Result:=GetCombinedString(A,B,ErrorEl);
  28385. end;
  28386. end;
  28387. function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
  28388. begin
  28389. Result:=El=nil;
  28390. end;
  28391. function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
  28392. var
  28393. Data: TObject;
  28394. begin
  28395. Data:=El.CustomData;
  28396. if Data=nil then
  28397. RaiseInternalError(20180215185302,GetObjName(El));
  28398. if Data.ClassType=TResElDataBaseType then
  28399. Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
  28400. else if (Data.ClassType=TResElDataBuiltInProc)
  28401. and (TResElDataBuiltInProc(Data).BuiltIn<>bfCustom) then
  28402. Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
  28403. else
  28404. Result:=nil;
  28405. end;
  28406. function TPasResolver.GetFirstSection(WithUnitImpl: boolean): TPasSection;
  28407. var
  28408. Module: TPasModule;
  28409. begin
  28410. Result:=nil;
  28411. Module:=RootElement;
  28412. if Module=nil then exit;
  28413. if Module is TPasProgram then
  28414. Result:=TPasProgram(Module).ProgramSection
  28415. else if Module is TPasLibrary then
  28416. Result:=TPasLibrary(Module).LibrarySection
  28417. else
  28418. begin
  28419. Result:=Module.InterfaceSection;
  28420. if WithUnitImpl and (Result=nil) then
  28421. Result:=Module.ImplementationSection;
  28422. end;
  28423. end;
  28424. function TPasResolver.GetLastSection: TPasSection;
  28425. var
  28426. Module: TPasModule;
  28427. begin
  28428. Result:=nil;
  28429. Module:=RootElement;
  28430. if Module=nil then exit;
  28431. if Module is TPasProgram then
  28432. Result:=TPasProgram(Module).ProgramSection
  28433. else if Module is TPasLibrary then
  28434. Result:=TPasLibrary(Module).LibrarySection
  28435. else if Module.ImplementationSection<>nil then
  28436. Result:=Module.ImplementationSection
  28437. else
  28438. Result:=Module.InterfaceSection;
  28439. end;
  28440. function TPasResolver.GetParentSection(El: TPasElement): TPasSection;
  28441. begin
  28442. while El<>nil do
  28443. begin
  28444. if El is TPasSection then exit(TPasSection(El));
  28445. El:=El.Parent;
  28446. end;
  28447. Result:=nil;
  28448. end;
  28449. function TPasResolver.FindUsedUnitInSection(aMod: TPasModule;
  28450. Section: TPasSection): TPasUsesUnit;
  28451. var
  28452. Clause: TPasUsesClause;
  28453. i: Integer;
  28454. begin
  28455. Result:=nil;
  28456. if Section=nil then exit;
  28457. Clause:=Section.UsesClause;
  28458. for i:=0 to length(Clause)-1 do
  28459. if Clause[i].Module=aMod then exit(Clause[i]);
  28460. end;
  28461. function TPasResolver.FirstSectionUsesUnit(aModule: TPasModule): boolean;
  28462. var
  28463. aSection: TPasSection;
  28464. begin
  28465. Result:=false;
  28466. aSection:=GetFirstSection(false);
  28467. if aSection=nil then
  28468. exit;
  28469. Result:=FindUsedUnitInSection(aModule,aSection)<>nil;
  28470. end;
  28471. function TPasResolver.ImplementationUsesUnit(aModule: TPasModule;
  28472. NotInIntf: boolean): boolean;
  28473. var
  28474. MyModule: TPasModule;
  28475. begin
  28476. Result:=false;
  28477. MyModule:=RootElement;
  28478. if MyModule=nil then exit;
  28479. if FindUsedUnitInSection(aModule,MyModule.ImplementationSection)=nil then
  28480. exit;
  28481. if NotInIntf then
  28482. Result:=not FirstSectionUsesUnit(aModule);
  28483. end;
  28484. function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  28485. isLoFunc: Boolean; out Mask: LongWord): Integer;
  28486. const
  28487. SHIFT_SIZE: array[btByte..{$IFDEF HasInt64}btComp{$ELSE}btIntDouble{$ENDIF}] of Integer = (
  28488. 4, // btByte
  28489. 8, // btShortInt FPC lo/hi(shortint) works like SmallInt
  28490. 8, 8, // btWord, btSmallInt
  28491. 16, 16, 16, 16, // btUIntSingle, btIntSingle, btLongWord, btLongint
  28492. 32, 32 // btUIntDouble, btIntDouble
  28493. {$IFDEF HasInt64}
  28494. , 32, 32, 32 // btQWord, btInt64, btComp
  28495. {$endif}
  28496. );
  28497. begin
  28498. if (BaseType >= Low(SHIFT_SIZE)) and (BaseType <= High(SHIFT_SIZE)) then
  28499. begin
  28500. if msDelphi in CurrentParser.CurrentModeswitches then
  28501. Result := 8
  28502. else
  28503. Result := SHIFT_SIZE[BaseType];
  28504. case Result of
  28505. 8: Mask := $FF;
  28506. 16: Mask := $FFFF;
  28507. 32: Mask := $FFFFFFFF;
  28508. else
  28509. {4} Mask := $F;
  28510. end;
  28511. if isLoFunc then
  28512. Result := 0;
  28513. end
  28514. else
  28515. begin
  28516. RaiseInternalError(20190130122300);
  28517. Result := -1;
  28518. end;
  28519. end;
  28520. function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
  28521. ResolvedDestType: TPasResolverResult): integer;
  28522. // finds distance between classes SrcType and DestType
  28523. begin
  28524. Result:=CheckClassIsClass(ResolvedSrcType.LoTypeEl,ResolvedDestType.LoTypeEl);
  28525. end;
  28526. function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
  28527. // check if Src is equal or descends from Dest
  28528. // Generics: TBird<T> is both directions a TBird<word>
  28529. // and TBird<TMap<T>> is both directions a TBird<TMap<word>>
  28530. // but a TBird<word> is not a TBird<char>
  28531. function CheckSpecialized(SrcScope, DestScope: TPasGenericScope): boolean;
  28532. var
  28533. SrcParams, DestParams: TPasTypeArray;
  28534. i: Integer;
  28535. SrcParam, DestParam: TPasType;
  28536. SrcParamScope, DestParamScope: TPasGenericScope;
  28537. SrcSpecializedFromItem, DestSpecializedFromItem: TPRSpecializedItem;
  28538. begin
  28539. SrcSpecializedFromItem:=SrcScope.SpecializedFromItem;
  28540. DestSpecializedFromItem:=DestScope.SpecializedFromItem;
  28541. if SrcSpecializedFromItem=nil then
  28542. exit(false);
  28543. if DestSpecializedFromItem=nil then
  28544. exit(false);
  28545. if SrcSpecializedFromItem.GenericEl<>DestSpecializedFromItem.GenericEl then
  28546. exit(false);
  28547. // specialized from same generic -> check params
  28548. SrcParams:=SrcSpecializedFromItem.Params;
  28549. DestParams:=DestSpecializedFromItem.Params;
  28550. for i:=0 to length(SrcParams)-1 do
  28551. begin
  28552. SrcParam:=ResolveAliasType(SrcParams[i]);
  28553. DestParam:=ResolveAliasType(DestParams[i]);
  28554. if (SrcParam is TPasGenericTemplateType)
  28555. or (DestParam is TPasGenericTemplateType)
  28556. or (SrcParam=DestParam)
  28557. then
  28558. // ok
  28559. else if (SrcParam is TPasGenericType) and (DestParam is TPasGenericType) then
  28560. begin
  28561. // e.g. TList<Src<...>> and TList<Dest<...>>
  28562. SrcParamScope:=SrcParam.CustomData as TPasGenericScope;
  28563. DestParamScope:=DestParam.CustomData as TPasGenericScope;
  28564. if not CheckSpecialized(SrcParamScope,DestParamScope) then
  28565. exit(false);
  28566. end
  28567. else
  28568. exit(false); // specialized with different params -> incompatible
  28569. end;
  28570. Result:=true;
  28571. end;
  28572. var
  28573. SrcClassEl: TPasClassType;
  28574. SrcScope, DestScope: TPasClassScope;
  28575. GenericType: TPasGenericType;
  28576. begin
  28577. {$IFDEF VerbosePasResolver}
  28578. writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  28579. {$ENDIF}
  28580. if DestType=nil then exit(cIncompatible);
  28581. DestType:=ResolveAliasType(DestType);
  28582. if DestType.ClassType<>TPasClassType then
  28583. exit(cIncompatible);
  28584. DestScope:=DestType.CustomData as TPasClassScope;
  28585. Result:=cExact;
  28586. while SrcType<>nil do
  28587. begin
  28588. {$IFDEF VerbosePasResolver}
  28589. writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  28590. {$ENDIF}
  28591. if SrcType=DestType then
  28592. exit
  28593. else if SrcType.ClassType=TPasAliasType then
  28594. // alias -> skip
  28595. SrcType:=TPasAliasType(SrcType).DestType
  28596. else if SrcType.ClassType=TPasTypeAliasType then
  28597. begin
  28598. // type alias -> increase distance
  28599. SrcType:=TPasAliasType(SrcType).DestType;
  28600. inc(Result);
  28601. end
  28602. else if SrcType.ClassType=TPasSpecializeType then
  28603. begin
  28604. // specialize -> skip
  28605. if SrcType.CustomData is TPasSpecializeTypeData then
  28606. SrcType:=TPasSpecializeTypeData(SrcType.CustomData).SpecializedType
  28607. else
  28608. SrcType:=TPasSpecializeType(SrcType).DestType;
  28609. end
  28610. else if SrcType.ClassType=TPasClassType then
  28611. begin
  28612. SrcClassEl:=TPasClassType(SrcType);
  28613. if SrcClassEl.IsForward then
  28614. // class forward -> skip
  28615. SrcType:=(SrcClassEl.CustomData as TResolvedReference).Declaration as TPasType
  28616. else
  28617. begin
  28618. if (SrcClassEl.GenericTemplateTypes<>nil) and (SrcClassEl.GenericTemplateTypes.Count>0) then
  28619. begin
  28620. // SrcType is a generic
  28621. if DestScope.SpecializedFromItem<>nil then
  28622. begin
  28623. // DestType is specialized
  28624. GenericType:=TPasGenericType(DestScope.SpecializedFromItem.GenericEl);
  28625. {$IFDEF VerbosePasResolver}
  28626. writeln(' DestType is specialized from ',GetObjName(GenericType));
  28627. {$ENDIF}
  28628. if SrcType=GenericType then
  28629. exit; // DestType is a specialized SrcType
  28630. end;
  28631. end;
  28632. SrcScope:=SrcClassEl.CustomData as TPasClassScope;
  28633. if (SrcScope.SpecializedFromItem<>nil)
  28634. and (DestScope.SpecializedFromItem<>nil)
  28635. and CheckSpecialized(SrcScope,DestScope) then
  28636. exit;
  28637. // class ancestor -> increase distance
  28638. SrcType:=SrcScope.DirectAncestor;
  28639. inc(Result);
  28640. end;
  28641. end
  28642. else
  28643. exit(cIncompatible);
  28644. end;
  28645. Result:=cIncompatible;
  28646. end;
  28647. function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  28648. begin
  28649. Result:=CheckClassIsClass(TypeA,TypeB);
  28650. if Result<>cIncompatible then exit;
  28651. Result:=CheckClassIsClass(TypeB,TypeA);
  28652. end;
  28653. function TPasResolver.CheckAssignCompatibilityClasses(LType,
  28654. RType: TPasClassType): integer;
  28655. begin
  28656. Result:=cIncompatible;
  28657. if LType=nil then ;
  28658. if RType=nil then ;
  28659. end;
  28660. function TPasResolver.GetClassImplementsIntf(ClassEl, Intf: TPasClassType
  28661. ): TPasClassType;
  28662. begin
  28663. Result:=nil;
  28664. while ClassEl<>nil do
  28665. begin
  28666. if (ClassEl=Intf) or (IndexOfImplementedInterface(ClassEl,Intf)>=0) then
  28667. exit(ClassEl);
  28668. ClassEl:=GetPasClassAncestor(ClassEl,true) as TPasClassType;
  28669. end;
  28670. end;
  28671. end.