pasresolver.pp 802 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907109081090910910109111091210913109141091510916109171091810919109201092110922109231092410925109261092710928109291093010931109321093310934109351093610937109381093910940109411094210943109441094510946109471094810949109501095110952109531095410955109561095710958109591096010961109621096310964109651096610967109681096910970109711097210973109741097510976109771097810979109801098110982109831098410985109861098710988109891099010991109921099310994109951099610997109981099911000110011100211003110041100511006110071100811009110101101111012110131101411015110161101711018110191102011021110221102311024110251102611027110281102911030110311103211033110341103511036110371103811039110401104111042110431104411045110461104711048110491105011051110521105311054110551105611057110581105911060110611106211063110641106511066110671106811069110701107111072110731107411075110761107711078110791108011081110821108311084110851108611087110881108911090110911109211093110941109511096110971109811099111001110111102111031110411105111061110711108111091111011111111121111311114111151111611117111181111911120111211112211123111241112511126111271112811129111301113111132111331113411135111361113711138111391114011141111421114311144111451114611147111481114911150111511115211153111541115511156111571115811159111601116111162111631116411165111661116711168111691117011171111721117311174111751117611177111781117911180111811118211183111841118511186111871118811189111901119111192111931119411195111961119711198111991120011201112021120311204112051120611207112081120911210112111121211213112141121511216112171121811219112201122111222112231122411225112261122711228112291123011231112321123311234112351123611237112381123911240112411124211243112441124511246112471124811249112501125111252112531125411255112561125711258112591126011261112621126311264112651126611267112681126911270112711127211273112741127511276112771127811279112801128111282112831128411285112861128711288112891129011291112921129311294112951129611297112981129911300113011130211303113041130511306113071130811309113101131111312113131131411315113161131711318113191132011321113221132311324113251132611327113281132911330113311133211333113341133511336113371133811339113401134111342113431134411345113461134711348113491135011351113521135311354113551135611357113581135911360113611136211363113641136511366113671136811369113701137111372113731137411375113761137711378113791138011381113821138311384113851138611387113881138911390113911139211393113941139511396113971139811399114001140111402114031140411405114061140711408114091141011411114121141311414114151141611417114181141911420114211142211423114241142511426114271142811429114301143111432114331143411435114361143711438114391144011441114421144311444114451144611447114481144911450114511145211453114541145511456114571145811459114601146111462114631146411465114661146711468114691147011471114721147311474114751147611477114781147911480114811148211483114841148511486114871148811489114901149111492114931149411495114961149711498114991150011501115021150311504115051150611507115081150911510115111151211513115141151511516115171151811519115201152111522115231152411525115261152711528115291153011531115321153311534115351153611537115381153911540115411154211543115441154511546115471154811549115501155111552115531155411555115561155711558115591156011561115621156311564115651156611567115681156911570115711157211573115741157511576115771157811579115801158111582115831158411585115861158711588115891159011591115921159311594115951159611597115981159911600116011160211603116041160511606116071160811609116101161111612116131161411615116161161711618116191162011621116221162311624116251162611627116281162911630116311163211633116341163511636116371163811639116401164111642116431164411645116461164711648116491165011651116521165311654116551165611657116581165911660116611166211663116641166511666116671166811669116701167111672116731167411675116761167711678116791168011681116821168311684116851168611687116881168911690116911169211693116941169511696116971169811699117001170111702117031170411705117061170711708117091171011711117121171311714117151171611717117181171911720117211172211723117241172511726117271172811729117301173111732117331173411735117361173711738117391174011741117421174311744117451174611747117481174911750117511175211753117541175511756117571175811759117601176111762117631176411765117661176711768117691177011771117721177311774117751177611777117781177911780117811178211783117841178511786117871178811789117901179111792117931179411795117961179711798117991180011801118021180311804118051180611807118081180911810118111181211813118141181511816118171181811819118201182111822118231182411825118261182711828118291183011831118321183311834118351183611837118381183911840118411184211843118441184511846118471184811849118501185111852118531185411855118561185711858118591186011861118621186311864118651186611867118681186911870118711187211873118741187511876118771187811879118801188111882118831188411885118861188711888118891189011891118921189311894118951189611897118981189911900119011190211903119041190511906119071190811909119101191111912119131191411915119161191711918119191192011921119221192311924119251192611927119281192911930119311193211933119341193511936119371193811939119401194111942119431194411945119461194711948119491195011951119521195311954119551195611957119581195911960119611196211963119641196511966119671196811969119701197111972119731197411975119761197711978119791198011981119821198311984119851198611987119881198911990119911199211993119941199511996119971199811999120001200112002120031200412005120061200712008120091201012011120121201312014120151201612017120181201912020120211202212023120241202512026120271202812029120301203112032120331203412035120361203712038120391204012041120421204312044120451204612047120481204912050120511205212053120541205512056120571205812059120601206112062120631206412065120661206712068120691207012071120721207312074120751207612077120781207912080120811208212083120841208512086120871208812089120901209112092120931209412095120961209712098120991210012101121021210312104121051210612107121081210912110121111211212113121141211512116121171211812119121201212112122121231212412125121261212712128121291213012131121321213312134121351213612137121381213912140121411214212143121441214512146121471214812149121501215112152121531215412155121561215712158121591216012161121621216312164121651216612167121681216912170121711217212173121741217512176121771217812179121801218112182121831218412185121861218712188121891219012191121921219312194121951219612197121981219912200122011220212203122041220512206122071220812209122101221112212122131221412215122161221712218122191222012221122221222312224122251222612227122281222912230122311223212233122341223512236122371223812239122401224112242122431224412245122461224712248122491225012251122521225312254122551225612257122581225912260122611226212263122641226512266122671226812269122701227112272122731227412275122761227712278122791228012281122821228312284122851228612287122881228912290122911229212293122941229512296122971229812299123001230112302123031230412305123061230712308123091231012311123121231312314123151231612317123181231912320123211232212323123241232512326123271232812329123301233112332123331233412335123361233712338123391234012341123421234312344123451234612347123481234912350123511235212353123541235512356123571235812359123601236112362123631236412365123661236712368123691237012371123721237312374123751237612377123781237912380123811238212383123841238512386123871238812389123901239112392123931239412395123961239712398123991240012401124021240312404124051240612407124081240912410124111241212413124141241512416124171241812419124201242112422124231242412425124261242712428124291243012431124321243312434124351243612437124381243912440124411244212443124441244512446124471244812449124501245112452124531245412455124561245712458124591246012461124621246312464124651246612467124681246912470124711247212473124741247512476124771247812479124801248112482124831248412485124861248712488124891249012491124921249312494124951249612497124981249912500125011250212503125041250512506125071250812509125101251112512125131251412515125161251712518125191252012521125221252312524125251252612527125281252912530125311253212533125341253512536125371253812539125401254112542125431254412545125461254712548125491255012551125521255312554125551255612557125581255912560125611256212563125641256512566125671256812569125701257112572125731257412575125761257712578125791258012581125821258312584125851258612587125881258912590125911259212593125941259512596125971259812599126001260112602126031260412605126061260712608126091261012611126121261312614126151261612617126181261912620126211262212623126241262512626126271262812629126301263112632126331263412635126361263712638126391264012641126421264312644126451264612647126481264912650126511265212653126541265512656126571265812659126601266112662126631266412665126661266712668126691267012671126721267312674126751267612677126781267912680126811268212683126841268512686126871268812689126901269112692126931269412695126961269712698126991270012701127021270312704127051270612707127081270912710127111271212713127141271512716127171271812719127201272112722127231272412725127261272712728127291273012731127321273312734127351273612737127381273912740127411274212743127441274512746127471274812749127501275112752127531275412755127561275712758127591276012761127621276312764127651276612767127681276912770127711277212773127741277512776127771277812779127801278112782127831278412785127861278712788127891279012791127921279312794127951279612797127981279912800128011280212803128041280512806128071280812809128101281112812128131281412815128161281712818128191282012821128221282312824128251282612827128281282912830128311283212833128341283512836128371283812839128401284112842128431284412845128461284712848128491285012851128521285312854128551285612857128581285912860128611286212863128641286512866128671286812869128701287112872128731287412875128761287712878128791288012881128821288312884128851288612887128881288912890128911289212893128941289512896128971289812899129001290112902129031290412905129061290712908129091291012911129121291312914129151291612917129181291912920129211292212923129241292512926129271292812929129301293112932129331293412935129361293712938129391294012941129421294312944129451294612947129481294912950129511295212953129541295512956129571295812959129601296112962129631296412965129661296712968129691297012971129721297312974129751297612977129781297912980129811298212983129841298512986129871298812989129901299112992129931299412995129961299712998129991300013001130021300313004130051300613007130081300913010130111301213013130141301513016130171301813019130201302113022130231302413025130261302713028130291303013031130321303313034130351303613037130381303913040130411304213043130441304513046130471304813049130501305113052130531305413055130561305713058130591306013061130621306313064130651306613067130681306913070130711307213073130741307513076130771307813079130801308113082130831308413085130861308713088130891309013091130921309313094130951309613097130981309913100131011310213103131041310513106131071310813109131101311113112131131311413115131161311713118131191312013121131221312313124131251312613127131281312913130131311313213133131341313513136131371313813139131401314113142131431314413145131461314713148131491315013151131521315313154131551315613157131581315913160131611316213163131641316513166131671316813169131701317113172131731317413175131761317713178131791318013181131821318313184131851318613187131881318913190131911319213193131941319513196131971319813199132001320113202132031320413205132061320713208132091321013211132121321313214132151321613217132181321913220132211322213223132241322513226132271322813229132301323113232132331323413235132361323713238132391324013241132421324313244132451324613247132481324913250132511325213253132541325513256132571325813259132601326113262132631326413265132661326713268132691327013271132721327313274132751327613277132781327913280132811328213283132841328513286132871328813289132901329113292132931329413295132961329713298132991330013301133021330313304133051330613307133081330913310133111331213313133141331513316133171331813319133201332113322133231332413325133261332713328133291333013331133321333313334133351333613337133381333913340133411334213343133441334513346133471334813349133501335113352133531335413355133561335713358133591336013361133621336313364133651336613367133681336913370133711337213373133741337513376133771337813379133801338113382133831338413385133861338713388133891339013391133921339313394133951339613397133981339913400134011340213403134041340513406134071340813409134101341113412134131341413415134161341713418134191342013421134221342313424134251342613427134281342913430134311343213433134341343513436134371343813439134401344113442134431344413445134461344713448134491345013451134521345313454134551345613457134581345913460134611346213463134641346513466134671346813469134701347113472134731347413475134761347713478134791348013481134821348313484134851348613487134881348913490134911349213493134941349513496134971349813499135001350113502135031350413505135061350713508135091351013511135121351313514135151351613517135181351913520135211352213523135241352513526135271352813529135301353113532135331353413535135361353713538135391354013541135421354313544135451354613547135481354913550135511355213553135541355513556135571355813559135601356113562135631356413565135661356713568135691357013571135721357313574135751357613577135781357913580135811358213583135841358513586135871358813589135901359113592135931359413595135961359713598135991360013601136021360313604136051360613607136081360913610136111361213613136141361513616136171361813619136201362113622136231362413625136261362713628136291363013631136321363313634136351363613637136381363913640136411364213643136441364513646136471364813649136501365113652136531365413655136561365713658136591366013661136621366313664136651366613667136681366913670136711367213673136741367513676136771367813679136801368113682136831368413685136861368713688136891369013691136921369313694136951369613697136981369913700137011370213703137041370513706137071370813709137101371113712137131371413715137161371713718137191372013721137221372313724137251372613727137281372913730137311373213733137341373513736137371373813739137401374113742137431374413745137461374713748137491375013751137521375313754137551375613757137581375913760137611376213763137641376513766137671376813769137701377113772137731377413775137761377713778137791378013781137821378313784137851378613787137881378913790137911379213793137941379513796137971379813799138001380113802138031380413805138061380713808138091381013811138121381313814138151381613817138181381913820138211382213823138241382513826138271382813829138301383113832138331383413835138361383713838138391384013841138421384313844138451384613847138481384913850138511385213853138541385513856138571385813859138601386113862138631386413865138661386713868138691387013871138721387313874138751387613877138781387913880138811388213883138841388513886138871388813889138901389113892138931389413895138961389713898138991390013901139021390313904139051390613907139081390913910139111391213913139141391513916139171391813919139201392113922139231392413925139261392713928139291393013931139321393313934139351393613937139381393913940139411394213943139441394513946139471394813949139501395113952139531395413955139561395713958139591396013961139621396313964139651396613967139681396913970139711397213973139741397513976139771397813979139801398113982139831398413985139861398713988139891399013991139921399313994139951399613997139981399914000140011400214003140041400514006140071400814009140101401114012140131401414015140161401714018140191402014021140221402314024140251402614027140281402914030140311403214033140341403514036140371403814039140401404114042140431404414045140461404714048140491405014051140521405314054140551405614057140581405914060140611406214063140641406514066140671406814069140701407114072140731407414075140761407714078140791408014081140821408314084140851408614087140881408914090140911409214093140941409514096140971409814099141001410114102141031410414105141061410714108141091411014111141121411314114141151411614117141181411914120141211412214123141241412514126141271412814129141301413114132141331413414135141361413714138141391414014141141421414314144141451414614147141481414914150141511415214153141541415514156141571415814159141601416114162141631416414165141661416714168141691417014171141721417314174141751417614177141781417914180141811418214183141841418514186141871418814189141901419114192141931419414195141961419714198141991420014201142021420314204142051420614207142081420914210142111421214213142141421514216142171421814219142201422114222142231422414225142261422714228142291423014231142321423314234142351423614237142381423914240142411424214243142441424514246142471424814249142501425114252142531425414255142561425714258142591426014261142621426314264142651426614267142681426914270142711427214273142741427514276142771427814279142801428114282142831428414285142861428714288142891429014291142921429314294142951429614297142981429914300143011430214303143041430514306143071430814309143101431114312143131431414315143161431714318143191432014321143221432314324143251432614327143281432914330143311433214333143341433514336143371433814339143401434114342143431434414345143461434714348143491435014351143521435314354143551435614357143581435914360143611436214363143641436514366143671436814369143701437114372143731437414375143761437714378143791438014381143821438314384143851438614387143881438914390143911439214393143941439514396143971439814399144001440114402144031440414405144061440714408144091441014411144121441314414144151441614417144181441914420144211442214423144241442514426144271442814429144301443114432144331443414435144361443714438144391444014441144421444314444144451444614447144481444914450144511445214453144541445514456144571445814459144601446114462144631446414465144661446714468144691447014471144721447314474144751447614477144781447914480144811448214483144841448514486144871448814489144901449114492144931449414495144961449714498144991450014501145021450314504145051450614507145081450914510145111451214513145141451514516145171451814519145201452114522145231452414525145261452714528145291453014531145321453314534145351453614537145381453914540145411454214543145441454514546145471454814549145501455114552145531455414555145561455714558145591456014561145621456314564145651456614567145681456914570145711457214573145741457514576145771457814579145801458114582145831458414585145861458714588145891459014591145921459314594145951459614597145981459914600146011460214603146041460514606146071460814609146101461114612146131461414615146161461714618146191462014621146221462314624146251462614627146281462914630146311463214633146341463514636146371463814639146401464114642146431464414645146461464714648146491465014651146521465314654146551465614657146581465914660146611466214663146641466514666146671466814669146701467114672146731467414675146761467714678146791468014681146821468314684146851468614687146881468914690146911469214693146941469514696146971469814699147001470114702147031470414705147061470714708147091471014711147121471314714147151471614717147181471914720147211472214723147241472514726147271472814729147301473114732147331473414735147361473714738147391474014741147421474314744147451474614747147481474914750147511475214753147541475514756147571475814759147601476114762147631476414765147661476714768147691477014771147721477314774147751477614777147781477914780147811478214783147841478514786147871478814789147901479114792147931479414795147961479714798147991480014801148021480314804148051480614807148081480914810148111481214813148141481514816148171481814819148201482114822148231482414825148261482714828148291483014831148321483314834148351483614837148381483914840148411484214843148441484514846148471484814849148501485114852148531485414855148561485714858148591486014861148621486314864148651486614867148681486914870148711487214873148741487514876148771487814879148801488114882148831488414885148861488714888148891489014891148921489314894148951489614897148981489914900149011490214903149041490514906149071490814909149101491114912149131491414915149161491714918149191492014921149221492314924149251492614927149281492914930149311493214933149341493514936149371493814939149401494114942149431494414945149461494714948149491495014951149521495314954149551495614957149581495914960149611496214963149641496514966149671496814969149701497114972149731497414975149761497714978149791498014981149821498314984149851498614987149881498914990149911499214993149941499514996149971499814999150001500115002150031500415005150061500715008150091501015011150121501315014150151501615017150181501915020150211502215023150241502515026150271502815029150301503115032150331503415035150361503715038150391504015041150421504315044150451504615047150481504915050150511505215053150541505515056150571505815059150601506115062150631506415065150661506715068150691507015071150721507315074150751507615077150781507915080150811508215083150841508515086150871508815089150901509115092150931509415095150961509715098150991510015101151021510315104151051510615107151081510915110151111511215113151141511515116151171511815119151201512115122151231512415125151261512715128151291513015131151321513315134151351513615137151381513915140151411514215143151441514515146151471514815149151501515115152151531515415155151561515715158151591516015161151621516315164151651516615167151681516915170151711517215173151741517515176151771517815179151801518115182151831518415185151861518715188151891519015191151921519315194151951519615197151981519915200152011520215203152041520515206152071520815209152101521115212152131521415215152161521715218152191522015221152221522315224152251522615227152281522915230152311523215233152341523515236152371523815239152401524115242152431524415245152461524715248152491525015251152521525315254152551525615257152581525915260152611526215263152641526515266152671526815269152701527115272152731527415275152761527715278152791528015281152821528315284152851528615287152881528915290152911529215293152941529515296152971529815299153001530115302153031530415305153061530715308153091531015311153121531315314153151531615317153181531915320153211532215323153241532515326153271532815329153301533115332153331533415335153361533715338153391534015341153421534315344153451534615347153481534915350153511535215353153541535515356153571535815359153601536115362153631536415365153661536715368153691537015371153721537315374153751537615377153781537915380153811538215383153841538515386153871538815389153901539115392153931539415395153961539715398153991540015401154021540315404154051540615407154081540915410154111541215413154141541515416154171541815419154201542115422154231542415425154261542715428154291543015431154321543315434154351543615437154381543915440154411544215443154441544515446154471544815449154501545115452154531545415455154561545715458154591546015461154621546315464154651546615467154681546915470154711547215473154741547515476154771547815479154801548115482154831548415485154861548715488154891549015491154921549315494154951549615497154981549915500155011550215503155041550515506155071550815509155101551115512155131551415515155161551715518155191552015521155221552315524155251552615527155281552915530155311553215533155341553515536155371553815539155401554115542155431554415545155461554715548155491555015551155521555315554155551555615557155581555915560155611556215563155641556515566155671556815569155701557115572155731557415575155761557715578155791558015581155821558315584155851558615587155881558915590155911559215593155941559515596155971559815599156001560115602156031560415605156061560715608156091561015611156121561315614156151561615617156181561915620156211562215623156241562515626156271562815629156301563115632156331563415635156361563715638156391564015641156421564315644156451564615647156481564915650156511565215653156541565515656156571565815659156601566115662156631566415665156661566715668156691567015671156721567315674156751567615677156781567915680156811568215683156841568515686156871568815689156901569115692156931569415695156961569715698156991570015701157021570315704157051570615707157081570915710157111571215713157141571515716157171571815719157201572115722157231572415725157261572715728157291573015731157321573315734157351573615737157381573915740157411574215743157441574515746157471574815749157501575115752157531575415755157561575715758157591576015761157621576315764157651576615767157681576915770157711577215773157741577515776157771577815779157801578115782157831578415785157861578715788157891579015791157921579315794157951579615797157981579915800158011580215803158041580515806158071580815809158101581115812158131581415815158161581715818158191582015821158221582315824158251582615827158281582915830158311583215833158341583515836158371583815839158401584115842158431584415845158461584715848158491585015851158521585315854158551585615857158581585915860158611586215863158641586515866158671586815869158701587115872158731587415875158761587715878158791588015881158821588315884158851588615887158881588915890158911589215893158941589515896158971589815899159001590115902159031590415905159061590715908159091591015911159121591315914159151591615917159181591915920159211592215923159241592515926159271592815929159301593115932159331593415935159361593715938159391594015941159421594315944159451594615947159481594915950159511595215953159541595515956159571595815959159601596115962159631596415965159661596715968159691597015971159721597315974159751597615977159781597915980159811598215983159841598515986159871598815989159901599115992159931599415995159961599715998159991600016001160021600316004160051600616007160081600916010160111601216013160141601516016160171601816019160201602116022160231602416025160261602716028160291603016031160321603316034160351603616037160381603916040160411604216043160441604516046160471604816049160501605116052160531605416055160561605716058160591606016061160621606316064160651606616067160681606916070160711607216073160741607516076160771607816079160801608116082160831608416085160861608716088160891609016091160921609316094160951609616097160981609916100161011610216103161041610516106161071610816109161101611116112161131611416115161161611716118161191612016121161221612316124161251612616127161281612916130161311613216133161341613516136161371613816139161401614116142161431614416145161461614716148161491615016151161521615316154161551615616157161581615916160161611616216163161641616516166161671616816169161701617116172161731617416175161761617716178161791618016181161821618316184161851618616187161881618916190161911619216193161941619516196161971619816199162001620116202162031620416205162061620716208162091621016211162121621316214162151621616217162181621916220162211622216223162241622516226162271622816229162301623116232162331623416235162361623716238162391624016241162421624316244162451624616247162481624916250162511625216253162541625516256162571625816259162601626116262162631626416265162661626716268162691627016271162721627316274162751627616277162781627916280162811628216283162841628516286162871628816289162901629116292162931629416295162961629716298162991630016301163021630316304163051630616307163081630916310163111631216313163141631516316163171631816319163201632116322163231632416325163261632716328163291633016331163321633316334163351633616337163381633916340163411634216343163441634516346163471634816349163501635116352163531635416355163561635716358163591636016361163621636316364163651636616367163681636916370163711637216373163741637516376163771637816379163801638116382163831638416385163861638716388163891639016391163921639316394163951639616397163981639916400164011640216403164041640516406164071640816409164101641116412164131641416415164161641716418164191642016421164221642316424164251642616427164281642916430164311643216433164341643516436164371643816439164401644116442164431644416445164461644716448164491645016451164521645316454164551645616457164581645916460164611646216463164641646516466164671646816469164701647116472164731647416475164761647716478164791648016481164821648316484164851648616487164881648916490164911649216493164941649516496164971649816499165001650116502165031650416505165061650716508165091651016511165121651316514165151651616517165181651916520165211652216523165241652516526165271652816529165301653116532165331653416535165361653716538165391654016541165421654316544165451654616547165481654916550165511655216553165541655516556165571655816559165601656116562165631656416565165661656716568165691657016571165721657316574165751657616577165781657916580165811658216583165841658516586165871658816589165901659116592165931659416595165961659716598165991660016601166021660316604166051660616607166081660916610166111661216613166141661516616166171661816619166201662116622166231662416625166261662716628166291663016631166321663316634166351663616637166381663916640166411664216643166441664516646166471664816649166501665116652166531665416655166561665716658166591666016661166621666316664166651666616667166681666916670166711667216673166741667516676166771667816679166801668116682166831668416685166861668716688166891669016691166921669316694166951669616697166981669916700167011670216703167041670516706167071670816709167101671116712167131671416715167161671716718167191672016721167221672316724167251672616727167281672916730167311673216733167341673516736167371673816739167401674116742167431674416745167461674716748167491675016751167521675316754167551675616757167581675916760167611676216763167641676516766167671676816769167701677116772167731677416775167761677716778167791678016781167821678316784167851678616787167881678916790167911679216793167941679516796167971679816799168001680116802168031680416805168061680716808168091681016811168121681316814168151681616817168181681916820168211682216823168241682516826168271682816829168301683116832168331683416835168361683716838168391684016841168421684316844168451684616847168481684916850168511685216853168541685516856168571685816859168601686116862168631686416865168661686716868168691687016871168721687316874168751687616877168781687916880168811688216883168841688516886168871688816889168901689116892168931689416895168961689716898168991690016901169021690316904169051690616907169081690916910169111691216913169141691516916169171691816919169201692116922169231692416925169261692716928169291693016931169321693316934169351693616937169381693916940169411694216943169441694516946169471694816949169501695116952169531695416955169561695716958169591696016961169621696316964169651696616967169681696916970169711697216973169741697516976169771697816979169801698116982169831698416985169861698716988169891699016991169921699316994169951699616997169981699917000170011700217003170041700517006170071700817009170101701117012170131701417015170161701717018170191702017021170221702317024170251702617027170281702917030170311703217033170341703517036170371703817039170401704117042170431704417045170461704717048170491705017051170521705317054170551705617057170581705917060170611706217063170641706517066170671706817069170701707117072170731707417075170761707717078170791708017081170821708317084170851708617087170881708917090170911709217093170941709517096170971709817099171001710117102171031710417105171061710717108171091711017111171121711317114171151711617117171181711917120171211712217123171241712517126171271712817129171301713117132171331713417135171361713717138171391714017141171421714317144171451714617147171481714917150171511715217153171541715517156171571715817159171601716117162171631716417165171661716717168171691717017171171721717317174171751717617177171781717917180171811718217183171841718517186171871718817189171901719117192171931719417195171961719717198171991720017201172021720317204172051720617207172081720917210172111721217213172141721517216172171721817219172201722117222172231722417225172261722717228172291723017231172321723317234172351723617237172381723917240172411724217243172441724517246172471724817249172501725117252172531725417255172561725717258172591726017261172621726317264172651726617267172681726917270172711727217273172741727517276172771727817279172801728117282172831728417285172861728717288172891729017291172921729317294172951729617297172981729917300173011730217303173041730517306173071730817309173101731117312173131731417315173161731717318173191732017321173221732317324173251732617327173281732917330173311733217333173341733517336173371733817339173401734117342173431734417345173461734717348173491735017351173521735317354173551735617357173581735917360173611736217363173641736517366173671736817369173701737117372173731737417375173761737717378173791738017381173821738317384173851738617387173881738917390173911739217393173941739517396173971739817399174001740117402174031740417405174061740717408174091741017411174121741317414174151741617417174181741917420174211742217423174241742517426174271742817429174301743117432174331743417435174361743717438174391744017441174421744317444174451744617447174481744917450174511745217453174541745517456174571745817459174601746117462174631746417465174661746717468174691747017471174721747317474174751747617477174781747917480174811748217483174841748517486174871748817489174901749117492174931749417495174961749717498174991750017501175021750317504175051750617507175081750917510175111751217513175141751517516175171751817519175201752117522175231752417525175261752717528175291753017531175321753317534175351753617537175381753917540175411754217543175441754517546175471754817549175501755117552175531755417555175561755717558175591756017561175621756317564175651756617567175681756917570175711757217573175741757517576175771757817579175801758117582175831758417585175861758717588175891759017591175921759317594175951759617597175981759917600176011760217603176041760517606176071760817609176101761117612176131761417615176161761717618176191762017621176221762317624176251762617627176281762917630176311763217633176341763517636176371763817639176401764117642176431764417645176461764717648176491765017651176521765317654176551765617657176581765917660176611766217663176641766517666176671766817669176701767117672176731767417675176761767717678176791768017681176821768317684176851768617687176881768917690176911769217693176941769517696176971769817699177001770117702177031770417705177061770717708177091771017711177121771317714177151771617717177181771917720177211772217723177241772517726177271772817729177301773117732177331773417735177361773717738177391774017741177421774317744177451774617747177481774917750177511775217753177541775517756177571775817759177601776117762177631776417765177661776717768177691777017771177721777317774177751777617777177781777917780177811778217783177841778517786177871778817789177901779117792177931779417795177961779717798177991780017801178021780317804178051780617807178081780917810178111781217813178141781517816178171781817819178201782117822178231782417825178261782717828178291783017831178321783317834178351783617837178381783917840178411784217843178441784517846178471784817849178501785117852178531785417855178561785717858178591786017861178621786317864178651786617867178681786917870178711787217873178741787517876178771787817879178801788117882178831788417885178861788717888178891789017891178921789317894178951789617897178981789917900179011790217903179041790517906179071790817909179101791117912179131791417915179161791717918179191792017921179221792317924179251792617927179281792917930179311793217933179341793517936179371793817939179401794117942179431794417945179461794717948179491795017951179521795317954179551795617957179581795917960179611796217963179641796517966179671796817969179701797117972179731797417975179761797717978179791798017981179821798317984179851798617987179881798917990179911799217993179941799517996179971799817999180001800118002180031800418005180061800718008180091801018011180121801318014180151801618017180181801918020180211802218023180241802518026180271802818029180301803118032180331803418035180361803718038180391804018041180421804318044180451804618047180481804918050180511805218053180541805518056180571805818059180601806118062180631806418065180661806718068180691807018071180721807318074180751807618077180781807918080180811808218083180841808518086180871808818089180901809118092180931809418095180961809718098180991810018101181021810318104181051810618107181081810918110181111811218113181141811518116181171811818119181201812118122181231812418125181261812718128181291813018131181321813318134181351813618137181381813918140181411814218143181441814518146181471814818149181501815118152181531815418155181561815718158181591816018161181621816318164181651816618167181681816918170181711817218173181741817518176181771817818179181801818118182181831818418185181861818718188181891819018191181921819318194181951819618197181981819918200182011820218203182041820518206182071820818209182101821118212182131821418215182161821718218182191822018221182221822318224182251822618227182281822918230182311823218233182341823518236182371823818239182401824118242182431824418245182461824718248182491825018251182521825318254182551825618257182581825918260182611826218263182641826518266182671826818269182701827118272182731827418275182761827718278182791828018281182821828318284182851828618287182881828918290182911829218293182941829518296182971829818299183001830118302183031830418305183061830718308183091831018311183121831318314183151831618317183181831918320183211832218323183241832518326183271832818329183301833118332183331833418335183361833718338183391834018341183421834318344183451834618347183481834918350183511835218353183541835518356183571835818359183601836118362183631836418365183661836718368183691837018371183721837318374183751837618377183781837918380183811838218383183841838518386183871838818389183901839118392183931839418395183961839718398183991840018401184021840318404184051840618407184081840918410184111841218413184141841518416184171841818419184201842118422184231842418425184261842718428184291843018431184321843318434184351843618437184381843918440184411844218443184441844518446184471844818449184501845118452184531845418455184561845718458184591846018461184621846318464184651846618467184681846918470184711847218473184741847518476184771847818479184801848118482184831848418485184861848718488184891849018491184921849318494184951849618497184981849918500185011850218503185041850518506185071850818509185101851118512185131851418515185161851718518185191852018521185221852318524185251852618527185281852918530185311853218533185341853518536185371853818539185401854118542185431854418545185461854718548185491855018551185521855318554185551855618557185581855918560185611856218563185641856518566185671856818569185701857118572185731857418575185761857718578185791858018581185821858318584185851858618587185881858918590185911859218593185941859518596185971859818599186001860118602186031860418605186061860718608186091861018611186121861318614186151861618617186181861918620186211862218623186241862518626186271862818629186301863118632186331863418635186361863718638186391864018641186421864318644186451864618647186481864918650186511865218653186541865518656186571865818659186601866118662186631866418665186661866718668186691867018671186721867318674186751867618677186781867918680186811868218683186841868518686186871868818689186901869118692186931869418695186961869718698186991870018701187021870318704187051870618707187081870918710187111871218713187141871518716187171871818719187201872118722187231872418725187261872718728187291873018731187321873318734187351873618737187381873918740187411874218743187441874518746187471874818749187501875118752187531875418755187561875718758187591876018761187621876318764187651876618767187681876918770187711877218773187741877518776187771877818779187801878118782187831878418785187861878718788187891879018791187921879318794187951879618797187981879918800188011880218803188041880518806188071880818809188101881118812188131881418815188161881718818188191882018821188221882318824188251882618827188281882918830188311883218833188341883518836188371883818839188401884118842188431884418845188461884718848188491885018851188521885318854188551885618857188581885918860188611886218863188641886518866188671886818869188701887118872188731887418875188761887718878188791888018881188821888318884188851888618887188881888918890188911889218893188941889518896188971889818899189001890118902189031890418905189061890718908189091891018911189121891318914189151891618917189181891918920189211892218923189241892518926189271892818929189301893118932189331893418935189361893718938189391894018941189421894318944189451894618947189481894918950189511895218953189541895518956189571895818959189601896118962189631896418965189661896718968189691897018971189721897318974189751897618977189781897918980189811898218983189841898518986189871898818989189901899118992189931899418995189961899718998189991900019001190021900319004190051900619007190081900919010190111901219013190141901519016190171901819019190201902119022190231902419025190261902719028190291903019031190321903319034190351903619037190381903919040190411904219043190441904519046190471904819049190501905119052190531905419055190561905719058190591906019061190621906319064190651906619067190681906919070190711907219073190741907519076190771907819079190801908119082190831908419085190861908719088190891909019091190921909319094190951909619097190981909919100191011910219103191041910519106191071910819109191101911119112191131911419115191161911719118191191912019121191221912319124191251912619127191281912919130191311913219133191341913519136191371913819139191401914119142191431914419145191461914719148191491915019151191521915319154191551915619157191581915919160191611916219163191641916519166191671916819169191701917119172191731917419175191761917719178191791918019181191821918319184191851918619187191881918919190191911919219193191941919519196191971919819199192001920119202192031920419205192061920719208192091921019211192121921319214192151921619217192181921919220192211922219223192241922519226192271922819229192301923119232192331923419235192361923719238192391924019241192421924319244192451924619247192481924919250192511925219253192541925519256192571925819259192601926119262192631926419265192661926719268192691927019271192721927319274192751927619277192781927919280192811928219283192841928519286192871928819289192901929119292192931929419295192961929719298192991930019301193021930319304193051930619307193081930919310193111931219313193141931519316193171931819319193201932119322193231932419325193261932719328193291933019331193321933319334193351933619337193381933919340193411934219343193441934519346193471934819349193501935119352193531935419355193561935719358193591936019361193621936319364193651936619367193681936919370193711937219373193741937519376193771937819379193801938119382193831938419385193861938719388193891939019391193921939319394193951939619397193981939919400194011940219403194041940519406194071940819409194101941119412194131941419415194161941719418194191942019421194221942319424194251942619427194281942919430194311943219433194341943519436194371943819439194401944119442194431944419445194461944719448194491945019451194521945319454194551945619457194581945919460194611946219463194641946519466194671946819469194701947119472194731947419475194761947719478194791948019481194821948319484194851948619487194881948919490194911949219493194941949519496194971949819499195001950119502195031950419505195061950719508195091951019511195121951319514195151951619517195181951919520195211952219523195241952519526195271952819529195301953119532195331953419535195361953719538195391954019541195421954319544195451954619547195481954919550195511955219553195541955519556195571955819559195601956119562195631956419565195661956719568195691957019571195721957319574195751957619577195781957919580195811958219583195841958519586195871958819589195901959119592195931959419595195961959719598195991960019601196021960319604196051960619607196081960919610196111961219613196141961519616196171961819619196201962119622196231962419625196261962719628196291963019631196321963319634196351963619637196381963919640196411964219643196441964519646196471964819649196501965119652196531965419655196561965719658196591966019661196621966319664196651966619667196681966919670196711967219673196741967519676196771967819679196801968119682196831968419685196861968719688196891969019691196921969319694196951969619697196981969919700197011970219703197041970519706197071970819709197101971119712197131971419715197161971719718197191972019721197221972319724197251972619727197281972919730197311973219733197341973519736197371973819739197401974119742197431974419745197461974719748197491975019751197521975319754197551975619757197581975919760197611976219763197641976519766197671976819769197701977119772197731977419775197761977719778197791978019781197821978319784197851978619787197881978919790197911979219793197941979519796197971979819799198001980119802198031980419805198061980719808198091981019811198121981319814198151981619817198181981919820198211982219823198241982519826198271982819829198301983119832198331983419835198361983719838198391984019841198421984319844198451984619847198481984919850198511985219853198541985519856198571985819859198601986119862198631986419865198661986719868198691987019871198721987319874198751987619877198781987919880198811988219883198841988519886198871988819889198901989119892198931989419895198961989719898198991990019901199021990319904199051990619907199081990919910199111991219913199141991519916199171991819919199201992119922199231992419925199261992719928199291993019931199321993319934199351993619937199381993919940199411994219943199441994519946199471994819949199501995119952199531995419955199561995719958199591996019961199621996319964199651996619967199681996919970199711997219973199741997519976199771997819979199801998119982199831998419985199861998719988199891999019991199921999319994199951999619997199981999920000200012000220003200042000520006200072000820009200102001120012200132001420015200162001720018200192002020021200222002320024200252002620027200282002920030200312003220033200342003520036200372003820039200402004120042200432004420045200462004720048200492005020051200522005320054200552005620057200582005920060200612006220063200642006520066200672006820069200702007120072200732007420075200762007720078200792008020081200822008320084200852008620087200882008920090200912009220093200942009520096200972009820099201002010120102201032010420105201062010720108201092011020111201122011320114201152011620117201182011920120201212012220123201242012520126201272012820129201302013120132201332013420135201362013720138201392014020141201422014320144201452014620147201482014920150201512015220153201542015520156201572015820159201602016120162201632016420165201662016720168201692017020171201722017320174201752017620177201782017920180201812018220183201842018520186201872018820189201902019120192201932019420195201962019720198201992020020201202022020320204202052020620207202082020920210202112021220213202142021520216202172021820219202202022120222202232022420225202262022720228202292023020231202322023320234202352023620237202382023920240202412024220243202442024520246202472024820249202502025120252202532025420255202562025720258202592026020261202622026320264202652026620267202682026920270202712027220273202742027520276202772027820279202802028120282202832028420285202862028720288202892029020291202922029320294202952029620297202982029920300203012030220303203042030520306203072030820309203102031120312203132031420315203162031720318203192032020321203222032320324203252032620327203282032920330203312033220333203342033520336203372033820339203402034120342203432034420345203462034720348203492035020351203522035320354203552035620357203582035920360203612036220363203642036520366203672036820369203702037120372203732037420375203762037720378203792038020381203822038320384203852038620387203882038920390203912039220393203942039520396203972039820399204002040120402204032040420405204062040720408204092041020411204122041320414204152041620417204182041920420204212042220423204242042520426204272042820429204302043120432204332043420435204362043720438204392044020441204422044320444204452044620447204482044920450204512045220453204542045520456204572045820459204602046120462204632046420465204662046720468204692047020471204722047320474204752047620477204782047920480204812048220483204842048520486204872048820489204902049120492204932049420495204962049720498204992050020501205022050320504205052050620507205082050920510205112051220513205142051520516205172051820519205202052120522205232052420525205262052720528205292053020531205322053320534205352053620537205382053920540205412054220543205442054520546205472054820549205502055120552205532055420555205562055720558205592056020561205622056320564205652056620567205682056920570205712057220573205742057520576205772057820579205802058120582205832058420585205862058720588205892059020591205922059320594205952059620597205982059920600206012060220603206042060520606206072060820609206102061120612206132061420615206162061720618206192062020621206222062320624206252062620627206282062920630206312063220633206342063520636206372063820639206402064120642206432064420645206462064720648206492065020651206522065320654206552065620657206582065920660206612066220663206642066520666206672066820669206702067120672206732067420675206762067720678206792068020681206822068320684206852068620687206882068920690206912069220693206942069520696206972069820699207002070120702207032070420705207062070720708207092071020711207122071320714207152071620717207182071920720207212072220723207242072520726207272072820729207302073120732207332073420735207362073720738207392074020741207422074320744207452074620747207482074920750207512075220753207542075520756207572075820759207602076120762207632076420765207662076720768207692077020771207722077320774207752077620777207782077920780207812078220783207842078520786207872078820789207902079120792207932079420795207962079720798207992080020801208022080320804208052080620807208082080920810208112081220813208142081520816208172081820819208202082120822208232082420825208262082720828208292083020831208322083320834208352083620837208382083920840208412084220843208442084520846208472084820849208502085120852208532085420855208562085720858208592086020861208622086320864208652086620867208682086920870208712087220873208742087520876208772087820879208802088120882208832088420885208862088720888208892089020891208922089320894208952089620897208982089920900209012090220903209042090520906209072090820909209102091120912209132091420915209162091720918209192092020921209222092320924209252092620927209282092920930209312093220933209342093520936209372093820939209402094120942209432094420945209462094720948209492095020951209522095320954209552095620957209582095920960209612096220963209642096520966209672096820969209702097120972209732097420975209762097720978209792098020981209822098320984209852098620987209882098920990209912099220993209942099520996209972099820999210002100121002210032100421005210062100721008210092101021011210122101321014210152101621017210182101921020210212102221023210242102521026210272102821029210302103121032210332103421035210362103721038210392104021041210422104321044210452104621047210482104921050210512105221053210542105521056210572105821059210602106121062210632106421065210662106721068210692107021071210722107321074210752107621077210782107921080210812108221083210842108521086210872108821089210902109121092210932109421095210962109721098210992110021101211022110321104211052110621107211082110921110211112111221113211142111521116211172111821119211202112121122211232112421125211262112721128211292113021131211322113321134211352113621137211382113921140211412114221143211442114521146211472114821149211502115121152211532115421155211562115721158211592116021161211622116321164211652116621167211682116921170211712117221173211742117521176211772117821179211802118121182211832118421185211862118721188211892119021191211922119321194211952119621197211982119921200212012120221203212042120521206212072120821209212102121121212212132121421215212162121721218212192122021221212222122321224212252122621227212282122921230212312123221233212342123521236212372123821239212402124121242212432124421245212462124721248212492125021251212522125321254212552125621257212582125921260212612126221263212642126521266212672126821269212702127121272212732127421275212762127721278212792128021281212822128321284212852128621287212882128921290212912129221293212942129521296212972129821299213002130121302213032130421305213062130721308213092131021311213122131321314213152131621317213182131921320213212132221323213242132521326213272132821329213302133121332213332133421335213362133721338213392134021341213422134321344213452134621347213482134921350213512135221353213542135521356213572135821359213602136121362213632136421365213662136721368213692137021371213722137321374213752137621377213782137921380213812138221383213842138521386213872138821389213902139121392213932139421395213962139721398213992140021401214022140321404214052140621407214082140921410214112141221413214142141521416214172141821419214202142121422214232142421425214262142721428214292143021431214322143321434214352143621437214382143921440214412144221443214442144521446214472144821449214502145121452214532145421455214562145721458214592146021461214622146321464214652146621467214682146921470214712147221473214742147521476214772147821479214802148121482214832148421485214862148721488214892149021491214922149321494214952149621497214982149921500215012150221503215042150521506215072150821509215102151121512215132151421515215162151721518215192152021521215222152321524215252152621527215282152921530215312153221533215342153521536215372153821539215402154121542215432154421545215462154721548215492155021551215522155321554215552155621557215582155921560215612156221563215642156521566215672156821569215702157121572215732157421575215762157721578215792158021581215822158321584215852158621587215882158921590215912159221593215942159521596215972159821599216002160121602216032160421605216062160721608216092161021611216122161321614216152161621617216182161921620216212162221623216242162521626216272162821629216302163121632216332163421635216362163721638216392164021641216422164321644216452164621647216482164921650216512165221653216542165521656216572165821659216602166121662216632166421665216662166721668216692167021671216722167321674216752167621677216782167921680216812168221683216842168521686216872168821689216902169121692216932169421695216962169721698216992170021701217022170321704217052170621707217082170921710217112171221713217142171521716217172171821719217202172121722217232172421725217262172721728217292173021731217322173321734217352173621737217382173921740217412174221743217442174521746217472174821749217502175121752217532175421755217562175721758217592176021761217622176321764217652176621767217682176921770217712177221773217742177521776217772177821779217802178121782217832178421785217862178721788217892179021791217922179321794217952179621797217982179921800218012180221803218042180521806218072180821809218102181121812218132181421815218162181721818218192182021821218222182321824218252182621827218282182921830218312183221833218342183521836218372183821839218402184121842218432184421845218462184721848218492185021851218522185321854218552185621857218582185921860218612186221863218642186521866218672186821869218702187121872218732187421875218762187721878218792188021881218822188321884218852188621887218882188921890218912189221893218942189521896218972189821899219002190121902219032190421905219062190721908219092191021911219122191321914219152191621917219182191921920219212192221923219242192521926219272192821929219302193121932219332193421935219362193721938219392194021941219422194321944219452194621947219482194921950219512195221953219542195521956219572195821959219602196121962219632196421965219662196721968219692197021971219722197321974219752197621977219782197921980219812198221983219842198521986219872198821989219902199121992219932199421995219962199721998219992200022001220022200322004220052200622007220082200922010220112201222013220142201522016220172201822019220202202122022220232202422025220262202722028220292203022031220322203322034220352203622037220382203922040220412204222043220442204522046220472204822049220502205122052220532205422055220562205722058220592206022061220622206322064220652206622067220682206922070220712207222073220742207522076220772207822079220802208122082220832208422085220862208722088220892209022091220922209322094220952209622097220982209922100221012210222103221042210522106221072210822109221102211122112221132211422115221162211722118221192212022121221222212322124221252212622127221282212922130221312213222133221342213522136221372213822139221402214122142221432214422145221462214722148221492215022151221522215322154221552215622157221582215922160221612216222163221642216522166221672216822169221702217122172221732217422175221762217722178221792218022181221822218322184221852218622187221882218922190221912219222193221942219522196221972219822199222002220122202222032220422205222062220722208222092221022211222122221322214222152221622217222182221922220222212222222223222242222522226222272222822229222302223122232222332223422235222362223722238222392224022241222422224322244222452224622247222482224922250222512225222253222542225522256222572225822259222602226122262222632226422265222662226722268222692227022271222722227322274222752227622277222782227922280222812228222283222842228522286222872228822289222902229122292222932229422295222962229722298222992230022301223022230322304223052230622307223082230922310223112231222313223142231522316223172231822319223202232122322223232232422325223262232722328223292233022331223322233322334223352233622337223382233922340223412234222343223442234522346223472234822349223502235122352223532235422355223562235722358223592236022361223622236322364223652236622367223682236922370223712237222373223742237522376223772237822379223802238122382223832238422385223862238722388223892239022391223922239322394223952239622397223982239922400224012240222403224042240522406224072240822409224102241122412224132241422415224162241722418224192242022421224222242322424224252242622427224282242922430224312243222433224342243522436224372243822439224402244122442224432244422445224462244722448224492245022451224522245322454224552245622457224582245922460224612246222463224642246522466224672246822469224702247122472224732247422475224762247722478224792248022481224822248322484224852248622487224882248922490224912249222493224942249522496224972249822499225002250122502225032250422505225062250722508225092251022511225122251322514225152251622517225182251922520225212252222523225242252522526225272252822529225302253122532225332253422535225362253722538225392254022541225422254322544225452254622547225482254922550225512255222553225542255522556225572255822559225602256122562225632256422565225662256722568225692257022571225722257322574225752257622577225782257922580225812258222583225842258522586225872258822589225902259122592225932259422595225962259722598225992260022601226022260322604226052260622607226082260922610226112261222613226142261522616226172261822619226202262122622226232262422625226262262722628226292263022631226322263322634226352263622637226382263922640226412264222643226442264522646226472264822649226502265122652226532265422655226562265722658226592266022661226622266322664226652266622667226682266922670226712267222673226742267522676226772267822679226802268122682226832268422685226862268722688226892269022691226922269322694226952269622697226982269922700227012270222703227042270522706227072270822709227102271122712227132271422715227162271722718227192272022721227222272322724227252272622727227282272922730227312273222733227342273522736227372273822739227402274122742227432274422745227462274722748227492275022751227522275322754227552275622757227582275922760227612276222763227642276522766227672276822769227702277122772227732277422775227762277722778227792278022781227822278322784227852278622787227882278922790227912279222793227942279522796227972279822799228002280122802228032280422805228062280722808228092281022811228122281322814228152281622817228182281922820228212282222823228242282522826228272282822829228302283122832228332283422835228362283722838228392284022841228422284322844228452284622847228482284922850228512285222853228542285522856228572285822859228602286122862228632286422865228662286722868228692287022871228722287322874228752287622877228782287922880228812288222883228842288522886228872288822889228902289122892228932289422895228962289722898228992290022901229022290322904229052290622907229082290922910229112291222913229142291522916229172291822919229202292122922229232292422925229262292722928229292293022931229322293322934229352293622937229382293922940229412294222943229442294522946229472294822949229502295122952229532295422955229562295722958229592296022961229622296322964229652296622967229682296922970229712297222973229742297522976229772297822979229802298122982229832298422985229862298722988229892299022991229922299322994229952299622997229982299923000230012300223003230042300523006230072300823009230102301123012230132301423015230162301723018230192302023021230222302323024230252302623027230282302923030230312303223033230342303523036230372303823039230402304123042230432304423045230462304723048230492305023051230522305323054230552305623057230582305923060230612306223063230642306523066230672306823069230702307123072230732307423075230762307723078230792308023081230822308323084230852308623087230882308923090230912309223093230942309523096230972309823099231002310123102231032310423105231062310723108231092311023111231122311323114231152311623117231182311923120231212312223123231242312523126231272312823129231302313123132231332313423135231362313723138231392314023141231422314323144231452314623147231482314923150231512315223153231542315523156231572315823159231602316123162231632316423165231662316723168231692317023171231722317323174231752317623177231782317923180231812318223183231842318523186231872318823189231902319123192231932319423195231962319723198231992320023201232022320323204232052320623207232082320923210232112321223213232142321523216232172321823219232202322123222232232322423225232262322723228232292323023231232322323323234232352323623237232382323923240232412324223243232442324523246232472324823249232502325123252232532325423255232562325723258232592326023261232622326323264232652326623267232682326923270232712327223273232742327523276232772327823279232802328123282232832328423285232862328723288232892329023291232922329323294232952329623297232982329923300233012330223303233042330523306233072330823309233102331123312233132331423315233162331723318233192332023321233222332323324233252332623327233282332923330233312333223333233342333523336233372333823339233402334123342233432334423345233462334723348233492335023351233522335323354233552335623357233582335923360233612336223363233642336523366233672336823369233702337123372233732337423375233762337723378233792338023381233822338323384233852338623387233882338923390233912339223393233942339523396233972339823399234002340123402234032340423405234062340723408234092341023411234122341323414234152341623417234182341923420234212342223423234242342523426234272342823429234302343123432234332343423435234362343723438234392344023441234422344323444234452344623447234482344923450234512345223453234542345523456234572345823459234602346123462234632346423465234662346723468234692347023471234722347323474234752347623477234782347923480234812348223483234842348523486234872348823489234902349123492234932349423495234962349723498234992350023501235022350323504235052350623507235082350923510235112351223513235142351523516235172351823519235202352123522235232352423525235262352723528235292353023531235322353323534235352353623537235382353923540235412354223543235442354523546235472354823549235502355123552235532355423555235562355723558235592356023561235622356323564235652356623567235682356923570235712357223573235742357523576235772357823579235802358123582235832358423585235862358723588235892359023591235922359323594235952359623597235982359923600236012360223603236042360523606236072360823609236102361123612236132361423615236162361723618236192362023621
  1. {
  2. This file is part of the Free Component Library
  3. Pascal resolver
  4. Copyright (c) 2019 Mattias Gaertner [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Abstract:
  12. Resolves references by setting TPasElement.CustomData as TResolvedReference.
  13. Creates search scopes for elements with sub identifiers by setting
  14. TPasElement.CustomData as TPasScope: unit, program, library, interface,
  15. implementation, procs
  16. Works:
  17. - built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
  18. - references in statements, error if not found
  19. - interface and implementation types, vars, const
  20. - params, local types, vars, const
  21. - nested procedures
  22. - nested forward procs, nested must be resolved before proc body
  23. - program/library/implementation forward procs
  24. - search in used units
  25. - unitname.identifier
  26. - alias types, 'type a=b'
  27. - type alias type 'type a=type b'
  28. - choose the most compatible overloaded procedure
  29. - while..do
  30. - repeat..until
  31. - if..then..else
  32. - binary operators
  33. - case..of
  34. - check duplicate values
  35. - try..finally..except, on, else, raise
  36. - for loop
  37. - fail to write a loop var inside the loop
  38. - spot duplicates
  39. - type cast base types
  40. - char
  41. - ord(), chr()
  42. - record
  43. - variants
  44. - const param makes children const too
  45. - const TRecordValues
  46. - function default(record type): record
  47. - advanced records:
  48. - $modeswitch AdvancedRecords
  49. - visibility public, private, strict private
  50. - sub type
  51. - const, var, class var
  52. - function/procedure/class function/class procedure
  53. - property, class property, default property
  54. - constructor
  55. - RTTI
  56. - class:
  57. - forward declaration
  58. - instance.a
  59. - find ancestor, search in ancestors
  60. - virtual, abstract, override
  61. - method body
  62. - Self
  63. - inherited
  64. - property
  65. - read var, read function
  66. - write var, write function
  67. - stored function
  68. - defaultexpr
  69. - is and as operator
  70. - nil
  71. - constructor result type, rrfNewInstance
  72. - destructor call type: rrfFreeInstance
  73. - type cast
  74. - class of
  75. - class method, property, var, const
  76. - class-of.constructor
  77. - class-of typecast upwards/downwards
  78. - class-of option to allow is-operator
  79. - typecast Self in class method upwards/downwards
  80. - property with params
  81. - default property
  82. - visibility, override: warn and fix if lower
  83. - events, proc type of object
  84. - sealed
  85. - $M+ / $TYPEINFO use visPublished as default visibility
  86. - note: constructing class with abstract method
  87. - with..do
  88. - enums - TPasEnumType, TPasEnumValue
  89. - propagate to parent scopes
  90. - function ord(): integer
  91. - function low(ordinal): ordinal
  92. - function high(ordinal): ordinal
  93. - function pred(ordinal): ordinal
  94. - function high(ordinal): ordinal
  95. - cast integer to enum, enum to integer
  96. - $ScopedEnums
  97. - sets - TPasSetType
  98. - set of char
  99. - set of integer
  100. - set of boolean
  101. - set of enum
  102. - ranges 'a'..'z' 2..5
  103. - operators: +, -, *, ><, <=, >=
  104. - in-operator
  105. - assign operators: +=, -=, *=
  106. - include(), exclude()
  107. - typed const: check expr type
  108. - function length(const array or string): integer
  109. - procedure setlength(var array or string; newlength: integer)
  110. - ranges TPasRangeType
  111. - procedure exit, procedure exit(const function result)
  112. - check if types only refer types+const
  113. - check const expression types, e.g. bark on "const c:string=3;"
  114. - procedure inc/dec(var ordinal; decr: ordinal = 1)
  115. - function Assigned(Pointer or Class or Class-Of): boolean
  116. - arrays TPasArrayType
  117. - TPasEnumType, char, integer, range
  118. - low, high, length, setlength, assigned
  119. - function concat(array1,array2,...): array
  120. - function copy(array): array, copy(a,start), copy(a,start,end)
  121. - insert(item; var array; index: integer)
  122. - delete(var array; start, count: integer)
  123. - element
  124. - multi dimensional
  125. - const
  126. - open array, override, pass array literal, pass var
  127. - type cast array to arrays with same dimensions and compatible element type
  128. - static array range checking
  129. - const array of char = string
  130. - a:=[...] // assignation using constant array
  131. - a:=[[...],[...]]
  132. - a:=[...]+[...] a+[] []+a modeswitch arrayoperators
  133. - delphi: var a: dynarray = []; // square bracket initialization
  134. - check if var initexpr fits vartype: var a: type = expr;
  135. - built-in functions high, low for range types
  136. - procedure type
  137. - call
  138. - as function result
  139. - as parameter
  140. - Delphi without @
  141. - @@ operator
  142. - FPC equal and not equal
  143. - "is nested"
  144. - bark on arguments access mismatch
  145. - function without params: mark if call or address, rrfImplicitCallWithoutParams
  146. - procedure break, procedure continue
  147. - built-in functions pred, succ for range type and enums
  148. - untyped parameters
  149. - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
  150. - built-in procedure writestr(var s: string; Args: arguments...); varargs
  151. - pointer TPasPointerType
  152. - nil, assigned(), typecast, class, classref, dynarray, procvar
  153. - forward declaration
  154. - cycle detection
  155. - TypedPointer^, (@Some)^
  156. - = operator: TypedPointer, @Some, UntypedPointer
  157. - TypedPointer:=TypedPointer
  158. - TypedPointer:=@Some
  159. - pointer[index], (@i)[index]
  160. - dispose(pointerofrecord), new(pointerofrecord)
  161. - $PointerMath on|off
  162. - emit hints
  163. - platform, deprecated, experimental, library, unimplemented
  164. - hiding ancestor method
  165. - hiding other unit identifier
  166. - dotted unitnames
  167. - eval:
  168. - nil, true, false
  169. - range checking:
  170. - integer ranges
  171. - boolean ranges
  172. - enum ranges
  173. - char ranges
  174. - +, -, *, div, mod, /, shl, shr, or, and, xor, in, ^^, ><
  175. - =, <>, <, <=, >, >=
  176. - ord(), low(), high(), pred(), succ(), length()
  177. - string[index]
  178. - call(param)
  179. - a:=value
  180. - arr[index]
  181. - resourcestrings
  182. - custom ranges
  183. - enum: low(), high(), pred(), succ(), ord(), rg(int), int(rg), enum:=rg,
  184. rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
  185. array[rg], low(array), high(array)
  186. - for..in..do :
  187. - type boolean, char, byte, shortint, word, smallint, longword, longint
  188. - type enum range, char range, integer range
  189. - type/var set of: enum, enum range, integer, integer range, char, char range
  190. - array var
  191. - function: enumerator
  192. - class
  193. - var modifier 'absolute'
  194. - Assert(bool[,string])
  195. - interfaces
  196. - $interfaces com|corba|default
  197. - root interface for com: delphi: IInterface, objfpc: IUnknown
  198. - method resolution
  199. - delegation via property implements: intftype, classtype
  200. - IntfVar as IntfType, intfvar as classtype, ObjVar as IntfType
  201. - IntfVar is IntfType, intfvar is classtype, ObjVar is IntfType
  202. - intftype(ObjVar), classtype(IntfVar)
  203. - default property
  204. - visibility public
  205. - $M+
  206. - class interfaces, check duplicates
  207. - assigned()
  208. - IntfVar:=nil, IntfVar:=IntfVar, IntfVar:=ObjVar, ObjVar:=IntfVar
  209. - IntfVar=IntfVar2
  210. - currency
  211. - eval type TResEvalCurrency
  212. - eval +, -, *, /, ^^
  213. - float*currency and currency*float computes to currency
  214. - type alias type overloads
  215. - $writeableconst off $J-
  216. - $warn identifier ON|off|error|default
  217. - anonymous methods:
  218. - assign in proc and program begin and initialization p:=procedure begin end
  219. - pass as arg doit(procedure begin end)
  220. - modifiers assembler varargs cdecl
  221. - typecast
  222. - with
  223. - self
  224. - built-in procedure Val(const s: string; var e: enumtype; out Code: integertype);
  225. - intrinsic functions Lo and Hi, depending on $mode (ObjFPC or Delphi):
  226. - In $MODE DELPHI:
  227. function Lo/Hi(i: <any integer type>): Byte
  228. - In $MODE OBJFPC:
  229. function Lo/Hi(i: Byte/ShortInt/Word/SmallInt): Byte
  230. function Lo/Hi(i: LongWord/LongInt/UIntSingle/IntSingle): Word
  231. function Lo/Hi(i: QWord/Int64/UIntDouble/IntDouble): LongWord
  232. - helpers:
  233. - class
  234. - record
  235. - type helper for simple type variables
  236. - InterfaceHelpers for fast gathering of helpers from uses sections
  237. - "inherited" and "inherited name" for Delphi and ObjFPC
  238. - for i in typehelped
  239. - nested: type, const, class var
  240. - visibility
  241. - property
  242. - helper method, Self as var argument
  243. ToDo:
  244. - operator overload
  245. - operator enumerator
  246. - binaryexpr
  247. - advanced records
  248. - Include/Exclude for set of int/char/bool
  249. - error if property method resolution is not used
  250. - $H-hintpos$H+
  251. - $pop, $push
  252. - $RTTI inherited|explicit
  253. - range checking:
  254. - property defaultvalue
  255. - IntSet:=[-1]
  256. - CharSet:=[#13]
  257. - proc: check if forward and impl default values match
  258. - call array of proc without ()
  259. - attributes
  260. - type helpers
  261. - record/class helpers
  262. - array of const
  263. - generics, nested param lists
  264. - object
  265. - futures
  266. - TPasFileType
  267. - labels
  268. - $zerobasedstrings on|off
  269. - FOR_LOOP_VAR_VARPAR passing a loop var to a var parameter gives a warning
  270. - FOR_VARIABLE warning if using a global var as loop var
  271. - COMPARISON_FALSE COMPARISON_TRUE Comparison always evaluates to False
  272. - USE_BEFORE_DEF Variable '%s' might not have been initialized
  273. - FOR_LOOP_VAR_UNDEF FOR-Loop variable '%s' may be undefined after loop
  274. - TYPEINFO_IMPLICITLY_ADDED Published caused RTTI ($M+) to be added to type '%s'
  275. - IMPLICIT_STRING_CAST Implicit string cast from '%s' to '%s'
  276. - IMPLICIT_STRING_CAST_LOSS Implicit string cast with potential data loss from '%s' to '%s'
  277. - off by default: EXPLICIT_STRING_CAST Explicit string cast from '%s' to '%s'
  278. - off by default: EXPLICIT_STRING_CAST_LOSS Explicit string cast with potential data loss from '%s' to '%s'
  279. - IMPLICIT_INTEGER_CAST_LOSS Implicit integer cast with potential data loss from '%s' to '%s'
  280. - IMPLICIT_CONVERSION_LOSS Implicit conversion may lose significant digits from '%s' to '%s'
  281. - COMBINING_SIGNED_UNSIGNED64 Combining signed type and unsigned 64-bit type - treated as an unsigned type
  282. -
  283. Debug flags: -d<x>
  284. VerbosePasResolver
  285. Notes:
  286. Functions and function types without parameters:
  287. property P read f; // use function f, not its result
  288. f. // implicit resolve f once if param less function or function type
  289. f[] // implicit resolve f once if a param less function or function type
  290. @f; use function f, not its result
  291. @p.f; @ operator applies to f, not p
  292. @f(); @ operator applies to result of f
  293. f(); use f's result
  294. FuncVar:=Func; if mode=objfpc: incompatible
  295. if mode=delphi: implicit addr of function f
  296. if f=g then : can implicit resolve each side once
  297. p(f), f as var parameter: can implicit
  298. }
  299. unit PasResolver;
  300. {$mode objfpc}{$H+}
  301. {$inline on}
  302. {$ifdef fpc}
  303. {$define UsePChar}
  304. {$define HasInt64}
  305. {$endif}
  306. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  307. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  308. interface
  309. uses
  310. {$ifdef pas2js}
  311. js,
  312. {$IFDEF NODEJS}
  313. NodeJSFS,
  314. {$ENDIF}
  315. {$endif}
  316. Classes, SysUtils, Math, Types, contnrs,
  317. PasTree, PScanner, PParser, PasResolveEval;
  318. const
  319. ParserMaxEmbeddedColumn = 2048;
  320. ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
  321. po_Resolver = [
  322. po_ResolveStandardTypes,
  323. po_NoOverloadedProcs,
  324. po_KeepClassForward,
  325. po_ArrayRangeExpr,
  326. po_CheckModeswitches,
  327. po_CheckCondFunction];
  328. type
  329. TResolverBaseType = (
  330. btNone, // undefined
  331. btCustom, // provided by descendant resolver
  332. btContext, // any source declared type with LoTypeEl/HiTypeEl
  333. btModule,
  334. btUntyped, // TPasArgument without ArgType
  335. btChar, // char
  336. {$ifdef FPC_HAS_CPSTRING}
  337. btAnsiChar, // ansichar
  338. {$endif}
  339. btWideChar, // widechar
  340. btString, // string
  341. {$ifdef FPC_HAS_CPSTRING}
  342. btAnsiString, // ansistring
  343. btShortString, // shortstring
  344. btRawByteString, // rawbytestring
  345. {$endif}
  346. btWideString, // widestring
  347. btUnicodeString,// unicodestring
  348. btSingle, // single 1.5E-45..3.4E38, digits 7-8, bytes 4
  349. btDouble, // double 5.0E-324..1.7E308, digits 15-16, bytes 8
  350. btExtended, // extended platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
  351. btCExtended, // cextended
  352. btCurrency, // as int64 div 10000, float, not ordinal
  353. btBoolean, // boolean
  354. btByteBool, // bytebool true=not zero
  355. btWordBool, // wordbool true=not zero
  356. btLongBool, // longbool true=not zero
  357. {$ifdef HasInt64}
  358. btQWordBool, // qwordbool true=not zero
  359. {$endif}
  360. btByte, // byte 0..255
  361. btShortInt, // shortint -128..127
  362. btWord, // word unsigned 2 bytes
  363. btSmallInt, // smallint signed 2 bytes
  364. btUIntSingle, // unsigned integer range of single 22bit
  365. btIntSingle, // integer range of single 23bit
  366. btLongWord, // longword unsigned 4 bytes
  367. btLongint, // longint signed 4 bytes
  368. btUIntDouble, // unsigned integer range of double 52bit
  369. btIntDouble, // integer range of double 53bit
  370. {$ifdef HasInt64}
  371. btQWord, // qword 0..18446744073709551615, bytes 8
  372. btInt64, // int64 -9223372036854775808..9223372036854775807, bytes 8
  373. btComp, // as Int64, not ordinal
  374. {$endif}
  375. btPointer, // pointer or canonical pointer (e.g. @something)
  376. {$ifdef fpc}
  377. btFile, // file
  378. btText, // text
  379. btVariant, // variant
  380. {$endif}
  381. btNil, // nil = pointer, class, procedure, method, ...
  382. btProc, // TPasProcedure
  383. btBuiltInProc, // TPasUnresolvedSymbolRef with CustomData is TResElDataBuiltInProc
  384. btArrayProperty,// IdentEl is TPasProperty with Args.Count>0, LoTypeEl=nil
  385. btSet, // set of '', see SubType
  386. btArrayLit, // [] array literal (TParamsExpr, TArrayValues, TBinaryExpr), see SubType
  387. btArrayOrSet, // [] can be set or array literal, see SubType
  388. btRange // a..b see SubType
  389. );
  390. TResolveBaseTypes = set of TResolverBaseType;
  391. const
  392. btIntMax = {$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  393. btUIntMax = {$ifdef HasInt64}btQWord{$else}btUIntDouble{$endif};
  394. btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
  395. btLongWord,btLongint,btIntDouble,btUIntDouble
  396. {$ifdef HasInt64}
  397. ,btQWord,btInt64,btComp
  398. {$endif}];
  399. btAllIntegerNoQWord = btAllInteger{$ifdef HasInt64}-[btQWord]{$endif};
  400. btAllChars = [btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar];
  401. btAllStrings = [btString,
  402. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btShortString,btRawByteString,{$endif}
  403. btWideString,btUnicodeString];
  404. btAllStringAndChars = btAllStrings+btAllChars;
  405. btAllStringPointer = [btString,
  406. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btRawByteString,{$endif}
  407. btWideString,btUnicodeString];
  408. btAllFloats = [btSingle,btDouble,
  409. btExtended,btCExtended,btCurrency];
  410. btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool
  411. {$ifdef HasInt64},btQWordBool{$endif}];
  412. btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
  413. btAllRanges = btArrayRangeTypes+[btRange];
  414. btAllStandardTypes = [
  415. btChar,
  416. {$ifdef FPC_HAS_CPSTRING}
  417. btAnsiChar,
  418. {$endif}
  419. btWideChar,
  420. btString,
  421. {$ifdef FPC_HAS_CPSTRING}
  422. btAnsiString,
  423. btShortString,
  424. btRawByteString,
  425. {$endif}
  426. btWideString,
  427. btUnicodeString,
  428. btSingle,
  429. btDouble,
  430. btExtended,
  431. btCExtended,
  432. btCurrency,
  433. btBoolean,
  434. btByteBool,
  435. btWordBool,
  436. btLongBool,
  437. {$ifdef HasInt64}
  438. btQWordBool,
  439. {$endif}
  440. btByte,
  441. btShortInt,
  442. btWord,
  443. btSmallInt,
  444. btLongWord,
  445. btLongint,
  446. {$ifdef HasInt64}
  447. btQWord,
  448. btInt64,
  449. btComp,
  450. {$endif}
  451. btPointer
  452. {$ifdef fpc}
  453. ,btFile,
  454. btText,
  455. btVariant
  456. {$endif}
  457. ];
  458. ResBaseTypeNames: array[TResolverBaseType] of string =(
  459. 'None',
  460. 'Custom',
  461. 'Context',
  462. 'Module',
  463. 'Untyped',
  464. 'Char',
  465. {$ifdef FPC_HAS_CPSTRING}
  466. 'AnsiChar',
  467. {$endif}
  468. 'WideChar',
  469. 'String',
  470. {$ifdef FPC_HAS_CPSTRING}
  471. 'AnsiString',
  472. 'ShortString',
  473. 'RawByteString',
  474. {$endif}
  475. 'WideString',
  476. 'UnicodeString',
  477. 'Single',
  478. 'Double',
  479. 'Extended',
  480. 'CExtended',
  481. 'Currency',
  482. 'Boolean',
  483. 'ByteBool',
  484. 'WordBool',
  485. 'LongBool',
  486. {$ifdef HasInt64}
  487. 'QWordBool',
  488. {$endif}
  489. 'Byte',
  490. 'ShortInt',
  491. 'Word',
  492. 'SmallInt',
  493. 'UIntSingle',
  494. 'IntSingle',
  495. 'LongWord',
  496. 'Longint',
  497. 'UIntDouble',
  498. 'IntDouble',
  499. {$ifdef HasInt64}
  500. 'QWord',
  501. 'Int64',
  502. 'Comp',
  503. {$endif}
  504. 'Pointer',
  505. {$ifdef fpc}
  506. 'File',
  507. 'Text',
  508. 'Variant',
  509. {$endif}
  510. 'Nil',
  511. 'Procedure/Function',
  512. 'BuiltInProc',
  513. 'array property',
  514. 'set',
  515. 'array',
  516. 'set or array literal',
  517. 'range..'
  518. );
  519. type
  520. TResolverBuiltInProc = (
  521. bfCustom,
  522. bfLength,
  523. bfSetLength,
  524. bfInclude,
  525. bfExclude,
  526. bfBreak,
  527. bfContinue,
  528. bfExit,
  529. bfInc,
  530. bfDec,
  531. bfAssigned,
  532. bfChr,
  533. bfOrd,
  534. bfLow,
  535. bfHigh,
  536. bfPred,
  537. bfSucc,
  538. bfStrProc,
  539. bfStrFunc,
  540. bfWriteStr,
  541. bfVal,
  542. bfLo,
  543. bfHi,
  544. bfConcatArray,
  545. bfConcatString,
  546. bfCopyArray,
  547. bfInsertArray,
  548. bfDeleteArray,
  549. bfTypeInfo,
  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. 'Assert',
  588. 'New',
  589. 'Dispose',
  590. 'Default'
  591. );
  592. bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
  593. const
  594. ResolverResultVar = 'Result';
  595. type
  596. {$ifdef pas2js}
  597. TPasResIterate = procedure(Item, Arg: pointer) of object;
  598. { TPasResHashList }
  599. TPasResHashList = class
  600. private
  601. FItems: TJSObject;
  602. public
  603. constructor Create; reintroduce;
  604. procedure Add(const aName: string; Item: Pointer);
  605. function Find(const aName: string): Pointer;
  606. procedure ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  607. procedure Clear;
  608. procedure Remove(const aName: string);
  609. end;
  610. {$else}
  611. TPasResHashList = TFPHashList;
  612. {$endif}
  613. type
  614. { EPasResolve }
  615. EPasResolve = class(Exception)
  616. private
  617. FPasElement: TPasElement;
  618. procedure SetPasElement(AValue: TPasElement);
  619. public
  620. Id: TMaxPrecInt;
  621. MsgType: TMessageType;
  622. MsgNumber: integer;
  623. MsgPattern: String;
  624. Args: TMessageArgs;
  625. SourcePos: TPasSourcePos;
  626. destructor Destroy; override;
  627. property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
  628. end;
  629. type
  630. { TUnresolvedPendingRef }
  631. TUnresolvedPendingRef = class(TPasUnresolvedSymbolRef)
  632. public
  633. Element: TPasType; // TPasClassOfType or TPasPointerType
  634. end;
  635. TPSRefAccess = (
  636. psraNone,
  637. psraRead,
  638. psraWrite,
  639. psraReadWrite,
  640. psraWriteRead,
  641. psraTypeInfo
  642. );
  643. { TPasScopeReference }
  644. TPasScopeReference = class
  645. private
  646. FElement: TPasElement;
  647. procedure SetElement(const AValue: TPasElement);
  648. public
  649. {$IFDEF VerbosePasResolver}
  650. Owner: TObject;
  651. {$ENDIF}
  652. Access: TPSRefAccess;
  653. NextSameName: TPasScopeReference;
  654. destructor Destroy; override;
  655. property Element: TPasElement read FElement write SetElement;
  656. end;
  657. TPasScope = class;
  658. { TPasScopeReferences - used by TPasAnalyzer to store references of a proc or initialization section }
  659. TPasScopeReferences = class
  660. private
  661. FScope: TPasScope;
  662. procedure OnClearItem(Item, Dummy: pointer);
  663. procedure OnCollectItem(Item, aList: pointer);
  664. public
  665. References: TPasResHashList; // hash list of TPasScopeReference
  666. constructor Create(aScope: TPasScope);
  667. destructor Destroy; override;
  668. procedure Clear;
  669. function Add(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  670. function Find(const aName: string): TPasScopeReference;
  671. function GetList: TFPList;
  672. property Scope: TPasScope read FScope;
  673. end;
  674. TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
  675. Data: Pointer; var Abort: boolean) of object;
  676. { TPasScope -
  677. Elements like TPasClassType use TPasScope descendants as CustomData for
  678. their sub identifiers.
  679. TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
  680. }
  681. TPasScope = Class(TResolveData)
  682. public
  683. VisibilityContext: TPasElement; // used to check if the current context
  684. // is allowed to access a private/protected element
  685. class function IsStoredInElement: boolean; virtual;
  686. class function FreeOnPop: boolean; virtual;
  687. procedure IterateElements(const aName: string; StartScope: TPasScope;
  688. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  689. var Abort: boolean); virtual;
  690. procedure WriteIdentifiers(Prefix: string); virtual;
  691. end;
  692. TPasScopeClass = class of TPasScope;
  693. TPasScopeArray = array of TPasScope;
  694. TPasModuleScopeFlag = (
  695. pmsfAssertSearched, // assert constructors searched
  696. pmsfRangeErrorNeeded, // somewhere is range checking on
  697. pmsfRangeErrorSearched // ERangeError constructor searched
  698. );
  699. TPasModuleScopeFlags = set of TPasModuleScopeFlag;
  700. { TPasModuleScope }
  701. TPasModuleScope = class(TPasScope)
  702. private
  703. FAssertClass: TPasClassType;
  704. FAssertDefConstructor: TPasConstructor;
  705. FAssertMsgConstructor: TPasConstructor;
  706. FRangeErrorClass: TPasClassType;
  707. FRangeErrorConstructor: TPasConstructor;
  708. FSystemTVarRec: TPasRecordType;
  709. procedure SetAssertClass(const AValue: TPasClassType);
  710. procedure SetAssertDefConstructor(const AValue: TPasConstructor);
  711. procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
  712. procedure SetRangeErrorClass(const AValue: TPasClassType);
  713. procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
  714. procedure SetSystemTVarRec(const AValue: TPasRecordType);
  715. public
  716. FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
  717. PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
  718. Flags: TPasModuleScopeFlags;
  719. BoolSwitches: TBoolSwitches;
  720. constructor Create; override;
  721. destructor Destroy; override;
  722. procedure IterateElements(const aName: string; StartScope: TPasScope;
  723. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  724. var Abort: boolean); override;
  725. property AssertClass: TPasClassType read FAssertClass write SetAssertClass;
  726. property AssertDefConstructor: TPasConstructor read FAssertDefConstructor write SetAssertDefConstructor;
  727. property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
  728. property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
  729. property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
  730. property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
  731. end;
  732. TPasModuleScopeClass = class of TPasModuleScope;
  733. TPasIdentifierKind = (
  734. pikNone, // not yet initialized
  735. pikBaseType, // e.g. longint
  736. pikBuiltInProc, // e.g. High(), SetLength()
  737. pikSimple, // simple vars, consts, types, enums
  738. pikProc, // may need parameter list with round brackets
  739. pikNamespace
  740. );
  741. TPasIdentifierKinds = set of TPasIdentifierKind;
  742. { TPasIdentifier }
  743. TPasIdentifier = Class(TObject)
  744. private
  745. FElement: TPasElement;
  746. procedure SetElement(AValue: TPasElement);
  747. public
  748. {$IFDEF VerbosePasResolver}
  749. Owner: TObject;
  750. {$ENDIF}
  751. Identifier: String;
  752. NextSameIdentifier: TPasIdentifier; // next identifier with same name
  753. Kind: TPasIdentifierKind;
  754. destructor Destroy; override;
  755. property Element: TPasElement read FElement write SetElement;
  756. end;
  757. TPasIdentifierArray = array of TPasIdentifier;
  758. { TPasIdentifierScope - elements with a list of sub identifiers }
  759. TPasIdentifierScope = Class(TPasScope)
  760. private
  761. FItems: TPasResHashList; // hashlist of TPasIdentifier
  762. procedure InternalAdd(Item: TPasIdentifier);
  763. procedure OnClearItem(Item, Dummy: pointer);
  764. procedure OnCollectItem(Item, List: pointer);
  765. protected
  766. procedure OnWriteItem(Item, Dummy: pointer);
  767. public
  768. constructor Create; override;
  769. destructor Destroy; override;
  770. function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
  771. function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
  772. function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
  773. function AddIdentifier(const Identifier: String; El: TPasElement;
  774. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  775. function FindElement(const aName: string): TPasElement;
  776. procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
  777. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  778. var Abort: boolean);
  779. procedure IterateElements(const aName: string; StartScope: TPasScope;
  780. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  781. var Abort: boolean); override;
  782. procedure WriteIdentifiers(Prefix: string); override;
  783. procedure WriteLocalIdentifiers(Prefix: string); virtual;
  784. function GetLocalIdentifiers: TFPList; virtual;
  785. end;
  786. TPasIdentifierScopeArray = array of TPasIdentifierScope;
  787. { TPasDefaultScope - root scope }
  788. TPasDefaultScope = class(TPasIdentifierScope)
  789. public
  790. class function IsStoredInElement: boolean; override;
  791. end;
  792. { TPasIterateFilterData }
  793. TPasIterateFilterData = record
  794. OnIterate: TIterateScopeElement;
  795. Data: Pointer;
  796. end;
  797. PPasIterateFilterData = ^TPasIterateFilterData;
  798. { TPRHelperEntry }
  799. TPRHelperEntry = class
  800. public
  801. Added: integer; // Added is bigger when it was added later to the list
  802. HelperForType: TPasType; // alias resolved
  803. Helper: TPasClassType;
  804. end;
  805. TPRHelperEntryArray = array of TPRHelperEntry;
  806. { TPasSectionScope - e.g. interface, implementation, program, library }
  807. TPasSectionScope = Class(TPasIdentifierScope)
  808. private
  809. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  810. Data: Pointer; var Abort: boolean);
  811. public
  812. UsesScopes: TFPList; // list of TPasSectionScope
  813. UsesFinished: boolean;
  814. Finished: boolean;
  815. BoolSwitches: TBoolSwitches;
  816. ModeSwitches: TModeSwitches;
  817. Helpers: TPRHelperEntryArray; // only created for interface. Sorted ascending ComparePRHelperEntries
  818. constructor Create; override;
  819. destructor Destroy; override;
  820. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  821. procedure IterateElements(const aName: string; StartScope: TPasScope;
  822. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  823. var Abort: boolean); override;
  824. procedure WriteIdentifiers(Prefix: string); override;
  825. end;
  826. TPasSectionScopeClass = class of TPasSectionScope;
  827. { TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
  828. TPasInitialFinalizationScope = Class(TPasScope)
  829. public
  830. References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
  831. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  832. destructor Destroy; override;
  833. end;
  834. TPasInitialFinalizationScopeClass = class of TPasInitialFinalizationScope;
  835. { TPasEnumTypeScope }
  836. TPasEnumTypeScope = Class(TPasIdentifierScope)
  837. public
  838. CanonicalSet: TPasSetType;
  839. destructor Destroy; override;
  840. end;
  841. { TPasClassOrRecordScope }
  842. TPasClassOrRecordScope = Class(TPasIdentifierScope)
  843. public
  844. DefaultProperty: TPasProperty;
  845. ClassConstructor: TPasClassConstructor;
  846. ClassDestructor: TPasClassDestructor;
  847. end;
  848. { TPasRecordScope }
  849. TPasRecordScope = Class(TPasClassOrRecordScope)
  850. end;
  851. TPasClassScopeFlag = (
  852. pcsfAncestorResolved,
  853. pcsfSealed,
  854. pcsfPublished // default visibility is published due to $M directive
  855. );
  856. TPasClassScopeFlags = set of TPasClassScopeFlag;
  857. { TPasClassIntfMap }
  858. TPasClassIntfMap = class
  859. public
  860. Element: TPasElement;
  861. Intf: TPasClassType;
  862. Procs: TFPList;// maps Interface-member-index to TPasProcedure
  863. AncestorMap: TPasClassIntfMap;// AncestorMap.Element=Element, AncestorMap.Intf=DirectAncestor
  864. destructor Destroy; override;
  865. end;
  866. { TPasClassScope }
  867. TPasClassScope = Class(TPasClassOrRecordScope)
  868. public
  869. AncestorScope: TPasClassScope;
  870. CanonicalClassOf: TPasClassOfType;
  871. DirectAncestor: TPasType; // TPasClassType or TPasAliasType, see GetPasClassAncestor
  872. // Note: TPasClassType.AncestorType might be nil and DirectAncestor is "TObject"
  873. Flags: TPasClassScopeFlags;
  874. AbstractProcs: TArrayOfPasProcedure;
  875. Interfaces: TFPList; // list corresponds to TPasClassType(Element).Interfaces,
  876. // elements: TPasProperty for 'implements', or TPasClassIntfMap
  877. destructor Destroy; override;
  878. end;
  879. TPasClassScopeClass = class of TPasClassScope;
  880. { TPasGroupScope }
  881. TPasGroupScope = Class(TPasIdentifierScope)
  882. public
  883. Scopes: TPasIdentifierScopeArray;
  884. Count: integer;
  885. procedure Add(Scope: TPasIdentifierScope);
  886. destructor Destroy; override;
  887. function GetFirstNonHelperScope: TPasIdentifierScope;
  888. class function IsStoredInElement: boolean; override;
  889. function FindAncestorIdentifier(const Identifier: String): TPasIdentifier;
  890. function FindAncestorElement(const Identifier: String): TPasElement;
  891. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  892. procedure IterateElements(const aName: string; StartScope: TPasScope;
  893. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  894. var Abort: boolean); override;
  895. procedure WriteIdentifiers(Prefix: string); override;
  896. end;
  897. TPasProcedureScopeFlag = (
  898. ppsfIsGroupOverload // mode objfpc: one overload is enough for all procs in same scope
  899. );
  900. TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
  901. { TPasProcedureScope }
  902. TPasProcedureScope = Class(TPasIdentifierScope)
  903. public
  904. DeclarationProc: TPasProcedure; // the corresponding forward declaration
  905. ImplProc: TPasProcedure; // the corresponding proc with Body
  906. OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
  907. ClassRecScope: TPasClassOrRecordScope;
  908. GroupScope: TPasGroupScope; // set during parsing a method body
  909. SelfArg: TPasArgument;
  910. Flags: TPasProcedureScopeFlags;
  911. BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
  912. ModeSwitches: TModeSwitches; // at proc start
  913. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  914. procedure IterateElements(const aName: string; StartScope: TPasScope;
  915. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  916. var Abort: boolean); override;
  917. function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
  918. procedure WriteIdentifiers(Prefix: string); override;
  919. destructor Destroy; override;
  920. public
  921. References: TPasScopeReferences; // created by TPasAnalyzer in DeclrationProc
  922. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  923. function GetReferences: TFPList;
  924. end;
  925. TPasProcedureScopeClass = class of TPasProcedureScope;
  926. { TPasPropertyScope }
  927. TPasPropertyScope = Class(TPasIdentifierScope)
  928. public
  929. AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
  930. otherwise it is a redeclaration }
  931. destructor Destroy; override;
  932. end;
  933. { TPasExceptOnScope }
  934. TPasExceptOnScope = Class(TPasIdentifierScope)
  935. end;
  936. TPasWithScope = class;
  937. TPasWithExprScopeFlag = (
  938. wesfNeedTmpVar,
  939. wesfOnlyTypeMembers,
  940. wesfIsClassOf,
  941. wesfConstParent // not writable
  942. );
  943. TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
  944. { TPasWithExprScope }
  945. TPasWithExprScope = Class(TPasScope)
  946. public
  947. WithScope: TPasWithScope; // owner
  948. Index: integer;
  949. Expr: TPasExpr;
  950. Scope: TPasGroupScope;
  951. ClassRecScope: TPasClassOrRecordScope;
  952. Flags: TPasWithExprScopeFlags;
  953. class function IsStoredInElement: boolean; override;
  954. class function FreeOnPop: boolean; override;
  955. procedure IterateElements(const aName: string; StartScope: TPasScope;
  956. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  957. var Abort: boolean); override;
  958. procedure WriteIdentifiers(Prefix: string); override;
  959. destructor Destroy; override;
  960. end;
  961. TPasWithExprScopeClass = class of TPasWithExprScope;
  962. { TPasWithScope }
  963. TPasWithScope = Class(TPasScope)
  964. public
  965. // Element is the TPasImplWithDo
  966. ExpressionScopes: TObjectList; // list of TPasWithExprScope
  967. constructor Create; override;
  968. destructor Destroy; override;
  969. end;
  970. { TPasForLoopScope }
  971. TPasForLoopScope = Class(TPasScope)
  972. public
  973. GetEnumerator: TPasFunction;
  974. MoveNext: TPasFunction;
  975. Current: TPasProperty;
  976. end;
  977. { TPasSubExprScope - base class for sub scopes aka dotted scopes }
  978. TPasSubExprScope = Class(TPasIdentifierScope)
  979. public
  980. class function IsStoredInElement: boolean; override;
  981. end;
  982. { TPasDotBaseScope }
  983. TPasDotBaseScope = Class(TPasSubExprScope)
  984. public
  985. GroupScope: TPasGroupScope;
  986. OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
  987. ConstParent: boolean;
  988. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  989. procedure IterateElements(const aName: string; StartScope: TPasScope;
  990. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  991. var Abort: boolean); override;
  992. procedure WriteIdentifiers(Prefix: string); override;
  993. destructor Destroy; override;
  994. end;
  995. { TPasModuleDotScope - scope for searching unitname.<identifier> }
  996. TPasModuleDotScope = Class(TPasDotBaseScope)
  997. private
  998. FModule: TPasModule;
  999. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  1000. Data: Pointer; var Abort: boolean);
  1001. procedure SetModule(AValue: TPasModule);
  1002. public
  1003. ImplementationScope: TPasSectionScope;
  1004. InterfaceScope: TPasSectionScope;
  1005. SystemScope: TPasDefaultScope;
  1006. destructor Destroy; override;
  1007. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1008. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1009. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1010. var Abort: boolean); override;
  1011. procedure WriteIdentifiers(Prefix: string); override;
  1012. property Module: TPasModule read FModule write SetModule;
  1013. end;
  1014. { TPasDotEnumTypeScope - used for EnumType.EnumValue }
  1015. TPasDotEnumTypeScope = Class(TPasDotBaseScope)
  1016. public
  1017. EnumScope: TPasEnumTypeScope;
  1018. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1019. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1020. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1021. var Abort: boolean); override;
  1022. procedure WriteIdentifiers(Prefix: string); override;
  1023. end;
  1024. { TPasDotClassOrRecordScope }
  1025. TPasDotClassOrRecordScope = Class(TPasDotBaseScope)
  1026. public
  1027. ClassRecScope: TPasClassOrRecordScope;
  1028. end;
  1029. { TPasDotClassScope - used for aClass.subidentifier }
  1030. TPasDotClassScope = Class(TPasDotClassOrRecordScope)
  1031. public
  1032. IsClassOf: boolean; // true if aClassOf.
  1033. end;
  1034. { TPasInheritedScope - used for inherited; and inherited Name() }
  1035. TPasInheritedScope = Class(TPasDotClassOrRecordScope)
  1036. public
  1037. AncestorScope: TPasClassScope;
  1038. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1039. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1040. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1041. var Abort: boolean); override;
  1042. procedure WriteIdentifiers(Prefix: string); override;
  1043. end;
  1044. { TPasDotHelperScope }
  1045. TPasDotHelperScope = class(TPasDotBaseScope)
  1046. end;
  1047. TResolvedReferenceFlag = (
  1048. rrfDotScope, // found reference via a dot scope (TPasDotBaseScope)
  1049. rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
  1050. rrfNoImplicitCallWithoutParams, // a TPrimitiveExpr is not an implicit call
  1051. rrfNewInstance, // constructor call (without it call constructor as normal method)
  1052. rrfFreeInstance, // destructor call (without it call destructor as normal method)
  1053. rrfVMT, // use VMT for call
  1054. rrfConstInherited // parent is const and this child is too
  1055. );
  1056. TResolvedReferenceFlags = set of TResolvedReferenceFlag;
  1057. type
  1058. { TResolvedRefContext }
  1059. TResolvedRefContext = Class
  1060. end;
  1061. TResolvedRefAccess = (
  1062. rraNone,
  1063. rraRead, // expression is read
  1064. rraAssign, // expression is LHS assign
  1065. rraReadAndAssign, // expression is LHS +=, -=, *=, /=
  1066. rraVarParam, // expression is passed to a var parameter
  1067. rraOutParam, // expression is passed to an out parameter
  1068. rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
  1069. // will later be changed to rraRead, rraVarParam, rraOutParam
  1070. );
  1071. TPRResolveVarAccesses = set of TResolvedRefAccess;
  1072. const
  1073. rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
  1074. ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
  1075. psraNone, // rraNone
  1076. psraRead, // rraRead
  1077. psraWrite, // rraAssign
  1078. psraReadWrite, // rraReadAndAssign
  1079. psraReadWrite, // rraVarParam
  1080. psraWrite, // rraOutParam
  1081. psraNone // rraParamToUnknownProc
  1082. );
  1083. type
  1084. { TResolvedReference - CustomData for normal references }
  1085. TResolvedReference = Class(TResolveData)
  1086. private
  1087. FDeclaration: TPasElement;
  1088. procedure SetDeclaration(AValue: TPasElement);
  1089. public
  1090. Flags: TResolvedReferenceFlags;
  1091. Access: TResolvedRefAccess;
  1092. Context: TResolvedRefContext;
  1093. WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
  1094. destructor Destroy; override;
  1095. property Declaration: TPasElement read FDeclaration write SetDeclaration;
  1096. end;
  1097. { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
  1098. TResolvedRefCtxConstructor = Class(TResolvedRefContext)
  1099. public
  1100. Typ: TPasType;
  1101. end;
  1102. { TResolvedRefCtxAttrProc - constructor of an attribute }
  1103. TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
  1104. public
  1105. Proc: TPasConstructor;
  1106. end;
  1107. TPasResolverResultFlag = (
  1108. rrfReadable,
  1109. rrfWritable,
  1110. rrfAssignable, // not writable in general, e.g. aString[1]:=
  1111. rrfCanBeStatement
  1112. );
  1113. TPasResolverResultFlags = set of TPasResolverResultFlag;
  1114. type
  1115. { TPasResolverResult }
  1116. TPasResolverResult = record
  1117. BaseType: TResolverBaseType;
  1118. SubType: TResolverBaseType; // for btSet, btArrayLit, btArrayOrSet, btRange
  1119. IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
  1120. LoTypeEl: TPasType; // can be nil for const expression, all alias resolved
  1121. HiTypeEl: TPasType; // same as LoTypeEl, except alias types are not resolved
  1122. ExprEl: TPasExpr;
  1123. Flags: TPasResolverResultFlags;
  1124. end;
  1125. PPasResolverResult = ^TPasResolverResult;
  1126. type
  1127. TPasResolverComputeFlag = (
  1128. rcSetReferenceFlags, // set flags of references while computing type, used by Resolve* methods
  1129. rcNoImplicitProc, // do not call a function without params, includes rcNoImplicitProcType
  1130. rcNoImplicitProcType, // do not call a proc type without params
  1131. rcConstant, // resolve a constant expression, error if not computable
  1132. rcType // resolve a type expression
  1133. );
  1134. TPasResolverComputeFlags = set of TPasResolverComputeFlag;
  1135. TResElDataBuiltInSymbol = Class(TResolveData)
  1136. public
  1137. end;
  1138. { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
  1139. TResElDataBaseType = Class(TResElDataBuiltInSymbol)
  1140. public
  1141. BaseType: TResolverBaseType;
  1142. end;
  1143. TResElDataBaseTypeClass = class of TResElDataBaseType;
  1144. TResElDataBuiltInProc = Class;
  1145. TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
  1146. Exp: TPasExpr; RaiseOnError: boolean): integer of object;
  1147. TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1148. out ResolvedEl: TPasResolverResult) of object;
  1149. TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1150. Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
  1151. TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
  1152. Params: TParamsExpr) of object;
  1153. TBuiltInProcFlag = (
  1154. bipfCanBeStatement // a call is enough for a simple statement
  1155. );
  1156. TBuiltInProcFlags = set of TBuiltInProcFlag;
  1157. { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
  1158. TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
  1159. public
  1160. Proc: TPasUnresolvedSymbolRef;
  1161. Signature: string;
  1162. BuiltIn: TResolverBuiltInProc;
  1163. GetCallCompatibility: TOnGetCallCompatibility;
  1164. GetCallResult: TOnGetCallResult;
  1165. Eval: TOnEvalBIFunction;
  1166. FinishParamsExpression: TOnFinishParamsExpr;
  1167. Flags: TBuiltInProcFlags;
  1168. destructor Destroy; override;
  1169. end;
  1170. { TPRFindData }
  1171. TPRFindData = record
  1172. ErrorPosEl: TPasElement;
  1173. Found: TPasElement;
  1174. ElScope: TPasScope; // Where Found was found
  1175. StartScope: TPasScope; // where the search started
  1176. end;
  1177. PPRFindData = ^TPRFindData;
  1178. TPasResolverOption = (
  1179. proFixCaseOfOverrides, // fix Name of overriding proc/property to the overriden proc/property
  1180. proClassPropertyNonStatic, // class property accessors can be non static
  1181. proPropertyAsVarParam, // allows to pass a property as a var/out argument
  1182. proClassOfIs, // class-of supports is and as operator
  1183. proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
  1184. proOpenAsDynArrays, // open arrays work like dynamic arrays
  1185. //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
  1186. //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
  1187. proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
  1188. proMethodAddrAsPointer // can assign @method to a pointer
  1189. );
  1190. TPasResolverOptions = set of TPasResolverOption;
  1191. TPasResolverStep = (
  1192. prsInit,
  1193. prsParsing,
  1194. prsFinishingModule,
  1195. prsFinishedModule
  1196. );
  1197. TPasResolverSteps = set of TPasResolverStep;
  1198. TPRResolveAlias = (
  1199. prraNone, // do not resolve alias
  1200. prraSimple, // resolve alias, but not type alias
  1201. prraAlias // resolve alias and type alias
  1202. );
  1203. TPRProcTypeDescFlag = (
  1204. prptdUseName, // add name if available
  1205. prptdAddPaths, // add full paths to types
  1206. prptdResolveSimpleAlias
  1207. );
  1208. TPRProcTypeDescFlags = set of TPRProcTypeDescFlag;
  1209. { TPasResolver }
  1210. TPasResolver = Class(TPasTreeContainer)
  1211. private
  1212. type
  1213. TResolveDataListKind = (lkBuiltIn,lkModule);
  1214. function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
  1215. function GetScopes(Index: integer): TPasScope; inline;
  1216. private
  1217. FActiveHelpers: TPRHelperEntryArray; // sorted ascending ComparePRHelperEntries
  1218. FAnonymousElTypePostfix: String;
  1219. FBaseTypeChar: TResolverBaseType;
  1220. FBaseTypeExtended: TResolverBaseType;
  1221. FBaseTypeLength: TResolverBaseType;
  1222. FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
  1223. FBaseTypeString: TResolverBaseType;
  1224. FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
  1225. FDefaultNameSpace: String;
  1226. FDefaultScope: TPasDefaultScope;
  1227. FDynArrayMaxIndex: TMaxPrecInt;
  1228. FDynArrayMinIndex: TMaxPrecInt;
  1229. FLastCreatedData: array[TResolveDataListKind] of TResolveData;
  1230. FLastElement: TPasElement;
  1231. FLastMsg: string;
  1232. FLastMsgArgs: TMessageArgs;
  1233. FLastMsgElement: TPasElement;
  1234. FLastMsgId: TMaxPrecInt;
  1235. FLastMsgNumber: integer;
  1236. FLastMsgPattern: string;
  1237. FLastMsgType: TMessageType;
  1238. FLastSourcePos: TPasSourcePos;
  1239. FOptions: TPasResolverOptions;
  1240. FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
  1241. FRootElement: TPasModule;
  1242. FScopeClass_Class: TPasClassScopeClass;
  1243. FScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass;
  1244. FScopeClass_Module: TPasModuleScopeClass;
  1245. FScopeClass_Proc: TPasProcedureScopeClass;
  1246. FScopeClass_Section: TPasSectionScopeClass;
  1247. FScopeClass_WithExpr: TPasWithExprScopeClass;
  1248. FScopeCount: integer;
  1249. FScopes: TPasScopeArray; // stack of scopes
  1250. FStep: TPasResolverStep;
  1251. FStoreSrcColumns: boolean;
  1252. FSubScopeCount: integer;
  1253. FSubScopes: TPasScopeArray; // stack of scopes
  1254. FTopScope: TPasScope;
  1255. procedure ClearResolveDataList(Kind: TResolveDataListKind);
  1256. function GetBaseTypeNames(bt: TResolverBaseType): string;
  1257. function GetBuiltInProcs(bp: TResolverBuiltInProc): TResElDataBuiltInProc;
  1258. protected
  1259. const
  1260. cExact = 0;
  1261. cAliasExact = cExact+1;
  1262. cCompatible = cAliasExact+1;
  1263. cIntToIntConversion = ord(High(TResolverBaseType));
  1264. cFloatToFloatConversion = 2*cIntToIntConversion;
  1265. cTypeConversion = cExact+10000; // e.g. TObject to Pointer
  1266. cLossyConversion = cExact+100000;
  1267. cIntToFloatConversion = cExact+400000; // int to float is worse than bigint to smallint
  1268. cIncompatible = High(integer);
  1269. var
  1270. cTGUIDToString: integer;
  1271. cStringToTGUID: integer;
  1272. cInterfaceToTGUID: integer;
  1273. cInterfaceToString: integer;
  1274. type
  1275. TFindCallElData = record
  1276. Params: TParamsExpr;
  1277. Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
  1278. LastProc: TPasProcedure;
  1279. ElScope, StartScope: TPasScope;
  1280. Distance: integer; // compatibility distance
  1281. Count: integer;
  1282. List: TFPList; // if not nil then collect all found elements here
  1283. end;
  1284. PFindCallElData = ^TFindCallElData;
  1285. TFindProcKind = (
  1286. fpkSameSignature, // search method declaration for a body
  1287. fpkProc, // check overloads for a proc
  1288. fpkMethod // check overloads for a method
  1289. );
  1290. TFindProcData = record
  1291. Proc: TPasProcedure;
  1292. Args: TFPList; // List of TPasArgument objects
  1293. Kind: TFindProcKind;
  1294. FoundOverloadModifier: boolean;
  1295. FoundInSameScope: integer;
  1296. Found: TPasProcedure;
  1297. ElScope, StartScope: TPasScope;
  1298. FoundNonProc: TPasElement;
  1299. end;
  1300. PFindProcData = ^TFindProcData;
  1301. procedure OnFindFirst_PreferNoParams(El: TPasElement; ElScope, StartScope: TPasScope;
  1302. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1303. procedure OnFindFirst(El: TPasElement; ElScope, StartScope: TPasScope;
  1304. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1305. procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
  1306. FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
  1307. procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
  1308. FindProcData: Pointer; var Abort: boolean); virtual;
  1309. function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
  1310. function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
  1311. Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
  1312. protected
  1313. procedure SetCurrentParser(AValue: TPasParser); override;
  1314. procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
  1315. State: TWarnMsgState; var Handled: boolean); virtual;
  1316. procedure SetRootElement(const AValue: TPasModule); virtual;
  1317. procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
  1318. function AddIdentifier(Scope: TPasIdentifierScope;
  1319. const aName: String; El: TPasElement;
  1320. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  1321. procedure AddModule(El: TPasModule); virtual;
  1322. procedure AddSection(El: TPasSection); virtual;
  1323. procedure AddInitialFinalizationSection(El: TPasImplBlock); virtual;
  1324. procedure AddType(El: TPasType); virtual;
  1325. procedure AddRecordType(El: TPasRecordType); virtual;
  1326. procedure AddClassType(El: TPasClassType); virtual;
  1327. procedure AddVariable(El: TPasVariable); virtual;
  1328. procedure AddResourceString(El: TPasResString); virtual;
  1329. procedure AddEnumType(El: TPasEnumType); virtual;
  1330. procedure AddEnumValue(El: TPasEnumValue); virtual;
  1331. procedure AddProperty(El: TPasProperty); virtual;
  1332. procedure AddProcedure(El: TPasProcedure); virtual;
  1333. procedure AddProcedureBody(El: TProcedureBody); virtual;
  1334. procedure AddArgument(El: TPasArgument); virtual;
  1335. procedure AddFunctionResult(El: TPasResultElement); virtual;
  1336. procedure AddExceptOn(El: TPasImplExceptOn); virtual;
  1337. procedure AddWithDo(El: TPasImplWithDo); virtual;
  1338. procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
  1339. procedure ResolveImplElement(El: TPasImplElement); virtual;
  1340. procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
  1341. procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
  1342. procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
  1343. procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
  1344. procedure ResolveImplAssign(El: TPasImplAssign); virtual;
  1345. procedure ResolveImplSimple(El: TPasImplSimple); virtual;
  1346. procedure ResolveImplRaise(El: TPasImplRaise); virtual;
  1347. procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
  1348. procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
  1349. procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
  1350. procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
  1351. procedure ResolveInheritedCall(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1352. procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1353. procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1354. procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1355. procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
  1356. procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1357. procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr;
  1358. Access: TResolvedRefAccess; CallName: string = ''); virtual;
  1359. procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1360. procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1361. procedure ResolveArrayParamsArgs(Params: TParamsExpr;
  1362. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
  1363. function ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  1364. const ResolvedValue: TPasResolverResult;
  1365. Access: TResolvedRefAccess): boolean; virtual;
  1366. procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
  1367. procedure ResolveArrayValues(El: TArrayValues); virtual;
  1368. procedure ResolveRecordValues(El: TRecordValues); virtual;
  1369. function ResolveAccessor(Expr: TPasExpr): TPasElement;
  1370. procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
  1371. Access: TResolvedRefAccess); virtual;
  1372. procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
  1373. function MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType): boolean; virtual;
  1374. procedure MarkArrayExprRecursive(Expr: TPasExpr; ArrType: TPasArrayType); virtual;
  1375. procedure FinishModule(CurModule: TPasModule); virtual;
  1376. procedure FinishUsesClause; virtual;
  1377. procedure FinishSection(Section: TPasSection); virtual;
  1378. procedure FinishInterfaceSection(Section: TPasSection); virtual;
  1379. procedure FinishTypeSection(El: TPasElement); virtual;
  1380. procedure FinishTypeSectionEl(El: TPasType); virtual;
  1381. procedure FinishTypeDef(El: TPasType); virtual;
  1382. procedure FinishEnumType(El: TPasEnumType); virtual;
  1383. procedure FinishSetType(El: TPasSetType); virtual;
  1384. procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
  1385. procedure FinishRangeType(El: TPasRangeType); virtual;
  1386. procedure FinishConstRangeExpr(RangeExpr: TBinaryExpr;
  1387. out LeftResolved, RightResolved: TPasResolverResult);
  1388. procedure FinishRecordType(El: TPasRecordType); virtual;
  1389. procedure FinishClassType(El: TPasClassType); virtual;
  1390. procedure FinishClassOfType(El: TPasClassOfType); virtual;
  1391. procedure FinishPointerType(El: TPasPointerType); virtual;
  1392. procedure FinishArrayType(El: TPasArrayType); virtual;
  1393. procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1394. procedure FinishResourcestring(El: TPasResString); virtual;
  1395. procedure FinishProcedure(aProc: TPasProcedure); virtual;
  1396. procedure FinishProcedureType(El: TPasProcedureType); virtual;
  1397. procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
  1398. procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
  1399. procedure FinishExceptOnExpr; virtual;
  1400. procedure FinishExceptOnStatement; virtual;
  1401. procedure FinishWithDo(El: TPasImplWithDo); virtual;
  1402. procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual;
  1403. procedure FinishDeclaration(El: TPasElement); virtual;
  1404. procedure FinishVariable(El: TPasVariable); virtual;
  1405. procedure FinishProperty(PropEl: TPasProperty); virtual;
  1406. procedure FinishArgument(El: TPasArgument); virtual;
  1407. procedure FinishAncestors(aClass: TPasClassType); virtual;
  1408. procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
  1409. procedure FinishAttributes(El: TPasAttributes); virtual;
  1410. procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
  1411. procedure FinishPropertyParamAccess(Params: TParamsExpr;
  1412. Prop: TPasProperty); virtual;
  1413. procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
  1414. procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
  1415. procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
  1416. function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
  1417. procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  1418. procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
  1419. function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
  1420. procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
  1421. procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure; CheckNames: boolean);
  1422. procedure CheckPendingForwardProcs(El: TPasElement);
  1423. procedure CheckPointerCycle(El: TPasPointerType);
  1424. procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
  1425. Flags: TPasResolverComputeFlags); virtual;
  1426. procedure ComputeBinaryExpr(Bin: TBinaryExpr;
  1427. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1428. StartEl: TPasElement);
  1429. procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
  1430. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1431. var LeftResolved, RightResolved: TPasResolverResult); virtual;
  1432. function ComputeAddStringRes(
  1433. const LeftResolved, RightResolved: TPasResolverResult; ExprEl: TPasExpr;
  1434. out ResolvedEl: TPasResolverResult): boolean; virtual;
  1435. procedure ComputeArrayParams(Params: TParamsExpr;
  1436. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1437. StartEl: TPasElement);
  1438. procedure ComputeArrayParams_Class(Params: TParamsExpr;
  1439. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  1440. Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
  1441. procedure ComputeFuncParams(Params: TParamsExpr;
  1442. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1443. StartEl: TPasElement);
  1444. procedure ComputeTypeCast(ToLoType, ToHiType: TPasType;
  1445. Param: TPasExpr; const ParamResolved: TPasResolverResult;
  1446. out ResolvedEl: TPasResolverResult;
  1447. Flags: TPasResolverComputeFlags); virtual;
  1448. procedure ComputeSetParams(Params: TParamsExpr;
  1449. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1450. StartEl: TPasElement);
  1451. procedure ComputeDereference(El: TUnaryExpr; var ResolvedEl: TPasResolverResult);
  1452. procedure ComputeArrayValuesExpectedType(El: TArrayValues; out ResolvedEl: TPasResolverResult;
  1453. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1454. procedure ComputeRecordValues(El: TRecordValues; out ResolvedEl: TPasResolverResult;
  1455. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1456. procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
  1457. function CheckTypeCastClassInstanceToClass(
  1458. const FromClassRes, ToClassRes: TPasResolverResult;
  1459. ErrorEl: TPasElement): integer; virtual;
  1460. procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
  1461. const LHS, RHS: TPasResolverResult);
  1462. function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
  1463. ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
  1464. procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
  1465. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  1466. procedure ConvertRangeToElement(var ResolvedEl: TPasResolverResult);
  1467. function IsCharLiteral(const Value: string; ErrorPos: TPasElement): TResolverBaseType; virtual;
  1468. function CheckForIn(Loop: TPasImplForLoop;
  1469. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1470. function CheckForInClassOrRec(Loop: TPasImplForLoop;
  1471. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1472. function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
  1473. MinCount: integer; RaiseOnError: boolean): boolean;
  1474. function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1475. MaxCount: integer; RaiseOnError: boolean): integer;
  1476. function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
  1477. const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
  1478. function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  1479. function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  1480. procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
  1481. Params: TParamsExpr); virtual;
  1482. function FindExceptionConstructor(const aUnitName, aClassName: string;
  1483. out aClass: TPasClassType; out aConstructor: TPasConstructor;
  1484. ErrorEl: TPasElement): boolean; virtual;
  1485. procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
  1486. procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
  1487. function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
  1488. function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
  1489. protected
  1490. fExprEvaluator: TResExprEvaluator;
  1491. procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
  1492. MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
  1493. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); virtual;
  1494. function OnExprEvalIdentifier(Sender: TResExprEvaluator;
  1495. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1496. function OnExprEvalParams(Sender: TResExprEvaluator;
  1497. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1498. procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
  1499. var MsgType: TMessageType); virtual;
  1500. function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
  1501. protected
  1502. // custom types (added by descendant resolvers)
  1503. function CheckAssignCompatibilityCustom(
  1504. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1505. RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
  1506. function CheckEqualCompatibilityCustomType(
  1507. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1508. RaiseOnIncompatible: boolean): integer; virtual;
  1509. protected
  1510. // built-in functions
  1511. function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1512. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1513. procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1514. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1515. procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  1516. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1517. function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1518. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1519. procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1520. Params: TParamsExpr); virtual;
  1521. function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1522. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1523. procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1524. Params: TParamsExpr); virtual;
  1525. function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1526. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1527. function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1528. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1529. function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1530. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1531. function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1532. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1533. procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1534. Params: TParamsExpr); virtual;
  1535. function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1536. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1537. procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1538. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1539. procedure BI_Assigned_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1540. Params: TParamsExpr); virtual;
  1541. function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1542. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1543. procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1544. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1545. procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  1546. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1547. function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1548. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1549. procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1550. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1551. procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  1552. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1553. function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1554. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1555. procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1556. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1557. procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  1558. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1559. function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1560. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1561. procedure BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1562. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1563. procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  1564. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1565. function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  1566. const ParamResolved: TPasResolverResult; ArgNo: integer;
  1567. RaiseOnError: boolean): integer;
  1568. function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1569. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1570. procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1571. Params: TParamsExpr); virtual;
  1572. function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1573. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1574. procedure BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1575. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1576. procedure BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  1577. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1578. function BI_WriteStrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1579. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1580. procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1581. Params: TParamsExpr); virtual;
  1582. function BI_Val_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1583. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1584. procedure BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1585. Params: TParamsExpr); virtual;
  1586. function BI_LoHi_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1587. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1588. procedure BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1589. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1590. procedure BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  1591. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1592. function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1593. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1594. procedure BI_ConcatArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1595. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1596. function BI_ConcatString_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1597. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1598. procedure BI_ConcatString_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1599. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1600. procedure BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  1601. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1602. function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1603. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1604. procedure BI_CopyArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1605. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1606. function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1607. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1608. procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1609. Params: TParamsExpr); virtual;
  1610. function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1611. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1612. procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1613. Params: TParamsExpr); virtual;
  1614. function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1615. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1616. procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1617. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1618. function BI_Assert_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1619. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1620. procedure BI_Assert_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1621. Params: TParamsExpr); virtual;
  1622. function BI_New_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1623. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1624. procedure BI_New_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1625. Params: TParamsExpr); virtual;
  1626. function BI_Dispose_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1627. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1628. procedure BI_Dispose_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1629. Params: TParamsExpr); virtual;
  1630. function BI_Default_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1631. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1632. procedure BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1633. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1634. procedure BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  1635. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1636. public
  1637. constructor Create;
  1638. destructor Destroy; override;
  1639. procedure Clear; virtual; // does not free built-in identifiers
  1640. // overrides of TPasTreeContainer
  1641. function CreateElement(AClass: TPTreeElement; const AName: String;
  1642. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1643. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1644. overload; override;
  1645. function CreateElement(AClass: TPTreeElement; const AName: String;
  1646. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1647. const ASrcPos: TPasSourcePos): TPasElement;
  1648. overload; override;
  1649. function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; override;
  1650. function FindUnit(const AName, InFilename: String;
  1651. NameExpr, InFileExpr: TPasExpr): TPasModule; virtual; abstract;
  1652. function FindElement(const aName: String): TPasElement; override; // used by TPasParser
  1653. function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
  1654. NoProcsWithArgs: boolean): TPasElement;
  1655. function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
  1656. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  1657. function FindFirstEl(const AName: String; out Data: TPRFindData;
  1658. ErrorPosEl: TPasElement): TPasElement;
  1659. procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  1660. procedure IterateElements(const aName: string;
  1661. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1662. var Abort: boolean); virtual;
  1663. procedure CheckFoundElement(const FindData: TPRFindData;
  1664. Ref: TResolvedReference); virtual;
  1665. procedure CheckFoundElementVisibility(const FindData: TPRFindData;
  1666. Ref: TResolvedReference); virtual;
  1667. function GetVisibilityContext: TPasElement;
  1668. procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1669. procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1670. procedure FinishTypeAlias(var NewType: TPasType); override;
  1671. function IsUnitIntfFinished(AModule: TPasModule): boolean;
  1672. procedure NotifyPendingUsedInterfaces; virtual;
  1673. function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
  1674. function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
  1675. procedure UsedInterfacesFinished(Section: TPasSection); virtual;
  1676. function NeedArrayValues(El: TPasElement): boolean; override;
  1677. function GetDefaultClassVisibility(AClass: TPasClassType
  1678. ): TPasMemberVisibility; override;
  1679. procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  1680. Before: boolean; var Handled: boolean); override;
  1681. // built in types and functions
  1682. procedure ClearBuiltInIdentifiers; virtual;
  1683. procedure AddObjFPCBuiltInIdentifiers(
  1684. const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
  1685. const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
  1686. function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
  1687. function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  1688. function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
  1689. function AddBuiltInProc(const aName: string; Signature: string;
  1690. const GetCallCompatibility: TOnGetCallCompatibility;
  1691. const GetCallResult: TOnGetCallResult;
  1692. const EvalConst: TOnEvalBIFunction = nil;
  1693. const FinishParamsExpr: TOnFinishParamsExpr = nil;
  1694. const BuiltIn: TResolverBuiltInProc = bfCustom;
  1695. const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
  1696. // add extra TResolveData (E.CustomData) to free list
  1697. procedure AddResolveData(El: TPasElement; Data: TResolveData;
  1698. Kind: TResolveDataListKind);
  1699. function CreateReference(DeclEl, RefEl: TPasElement;
  1700. Access: TResolvedRefAccess;
  1701. FindData: PPRFindData = nil): TResolvedReference; virtual;
  1702. // scopes
  1703. function GetLocalScope: TPasScope; inline;
  1704. function GetParentLocalScope: TPasScope; inline;
  1705. function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
  1706. function CreateGroupScope(aType: TPasType; WithTopHelpers: boolean = true): TPasGroupScope; virtual;
  1707. procedure GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope; TypeEl: TPasType; WithTopHelpers: boolean = true);
  1708. procedure PopScope;
  1709. procedure PopWithScope(El: TPasImplWithDo);
  1710. procedure PushScope(Scope: TPasScope); overload;
  1711. function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
  1712. function PushGroupScope(aType: TPasType): TPasGroupScope;
  1713. function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  1714. function PushClassDotScope(var CurClassType: TPasClassType; WithTopHelpers: boolean = true): TPasDotClassScope;
  1715. function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  1716. function PushInheritedScope(ClassOrRec: TPasMembersType;
  1717. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  1718. function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
  1719. function PushHelperDotScope(TypeEl: TPasType): TPasDotBaseScope;
  1720. function PushDotScope(TypeEl: TPasType): TPasDotBaseScope;
  1721. function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  1722. procedure ResetSubExprScopes(out Depth: integer);
  1723. procedure RestoreSubExprScopes(Depth: integer);
  1724. function GetCurrentProcScope(ErrorEl: TPasElement): TPasProcedureScope;
  1725. function GetProcScope(El: TPasElement): TPasProcedureScope;
  1726. function GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  1727. function GetSelfScope(El: TPasElement): TPasProcedureScope;
  1728. procedure AddHelper(Helper: TPasClassType; var List: TPRHelperEntryArray);
  1729. procedure AddActiveHelper(Helper: TPasClassType); virtual;
  1730. // log and messages
  1731. class function MangleSourceLineNumber(Line, Column: integer): integer;
  1732. class procedure UnmangleSourceLineNumber(LineNumber: integer;
  1733. out Line, Column: integer);
  1734. class function GetDbgSourcePosStr(El: TPasElement): string;
  1735. function GetElementSourcePosStr(El: TPasElement): string;
  1736. procedure SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  1737. Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1738. PosEl: TPasElement);
  1739. procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  1740. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1741. PosEl: TPasElement); overload;
  1742. class function GetWarnIdentifierNumbers(Identifier: string;
  1743. out MsgNumbers: TIntegerDynArray): boolean; virtual;
  1744. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasResolverResult;
  1745. out GotDesc, ExpDesc: String); overload;
  1746. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
  1747. out GotDesc, ExpDesc: String); overload;
  1748. procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
  1749. Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1750. ErrorPosEl: TPasElement); virtual;
  1751. procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
  1752. procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
  1753. procedure RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
  1754. procedure RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string; El: TPasElement);
  1755. procedure RaiseXExpectedButYFound(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  1756. procedure RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C,X,Y: string; El: TPasElement);
  1757. procedure RaiseContextXInvalidY(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  1758. procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  1759. procedure RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement; IdentEl: TPasElement);
  1760. procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  1761. procedure RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  1762. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1763. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  1764. procedure RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  1765. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1766. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  1767. procedure RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  1768. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  1769. const GotType, ExpType: TPasResolverResult;
  1770. ErrorEl: TPasElement);
  1771. procedure RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt; ErrorEl: TPasElement);
  1772. procedure RaiseInvalidProcTypeModifier(id: TMaxPrecInt; ProcType: TPasProcedureType;
  1773. ptm: TProcTypeModifier; ErrorEl: TPasElement);
  1774. procedure RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  1775. pm: TProcedureModifier; ErrorEl: TPasElement);
  1776. procedure WriteScopes;
  1777. // find value and type of an element
  1778. procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
  1779. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1780. function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  1781. function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  1782. // checking compatibilility
  1783. function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same
  1784. function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
  1785. procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt; ErrorEl: TPasElement);
  1786. function CheckCallProcCompatibility(ProcType: TPasProcedureType;
  1787. Params: TParamsExpr; RaiseOnError: boolean;
  1788. SetReferenceFlags: boolean = false): integer;
  1789. function CheckCallPropertyCompatibility(PropEl: TPasProperty;
  1790. Params: TParamsExpr; RaiseOnError: boolean): integer;
  1791. function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  1792. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
  1793. function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
  1794. ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  1795. function CheckAssignCompatibilityUserType(
  1796. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1797. RaiseOnIncompatible: boolean): integer;
  1798. function CheckAssignCompatibilityArrayType(
  1799. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1800. RaiseOnIncompatible: boolean): integer;
  1801. function CheckAssignCompatibilityPointerType(LTypeEl, RTypeEl: TPasType;
  1802. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  1803. function CheckEqualCompatibilityUserType(
  1804. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1805. RaiseOnIncompatible: boolean): integer; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  1806. function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
  1807. function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
  1808. ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
  1809. function CheckTypeCastArray(FromType, ToType: TPasArrayType;
  1810. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  1811. function CheckSrcIsADstType(
  1812. const ResolvedSrcType, ResolvedDestType: TPasResolverResult): integer;
  1813. function CheckClassIsClass(SrcType, DestType: TPasType): integer; virtual;
  1814. function CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  1815. function GetClassImplementsIntf(ClassEl, Intf: TPasClassType): TPasClassType;
  1816. function CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  1817. function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
  1818. IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
  1819. function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
  1820. function CheckElTypeCompatibility(Arg1, Arg2: TPasType; ResolveAlias: TPRResolveAlias): boolean;
  1821. function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  1822. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  1823. function CheckAssignCompatibility(const LHS, RHS: TPasElement;
  1824. RaiseOnIncompatible: boolean = true; ErrorEl: TPasElement = nil): integer;
  1825. procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  1826. procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
  1827. RValue: TResEvalValue; RHS: TPasExpr); virtual;
  1828. function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
  1829. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  1830. function CheckEqualElCompatibility(Left, Right: TPasElement;
  1831. ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  1832. SetReferenceFlags: boolean = false): integer;
  1833. function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
  1834. LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  1835. RErrorEl: TPasElement = nil): integer;
  1836. function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
  1837. function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
  1838. PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
  1839. function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
  1840. // utility functions
  1841. function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
  1842. function GetElModeSwitches(El: TPasElement): TModeSwitches;
  1843. function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
  1844. function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  1845. function GetProcTypeDescription(ProcType: TPasProcedureType;
  1846. Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
  1847. function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
  1848. function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
  1849. function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  1850. function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  1851. function GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  1852. function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
  1853. function GetPasPropertyType(El: TPasProperty): TPasType;
  1854. function GetPasPropertyArgs(El: TPasProperty): TFPList;
  1855. function GetPasPropertyGetter(El: TPasProperty): TPasElement;
  1856. function GetPasPropertySetter(El: TPasProperty): TPasElement;
  1857. function GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  1858. function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  1859. function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  1860. function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
  1861. function GetParentProcBody(El: TPasElement): TProcedureBody;
  1862. function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
  1863. function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
  1864. function GetLoop(El: TPasElement): TPasImplElement;
  1865. function ResolveAliasType(aType: TPasType): TPasType;
  1866. function ResolveAliasTypeEl(El: TPasElement): TPasType; inline;
  1867. function ExprIsAddrTarget(El: TPasExpr): boolean;
  1868. function IsNameExpr(El: TPasExpr): boolean; inline; // TPrimitiveExpr with Kind=pekIdent
  1869. function GetNameExprValue(El: TPasExpr): string; // TPrimitiveExpr with Kind=pekIdent
  1870. function GetNextDottedExpr(El: TPasExpr): TPasExpr;
  1871. function GetLeftMostExpr(El: TPasExpr): TPasExpr;
  1872. function GetRightMostExpr(El: TPasExpr): TPasExpr;
  1873. function GetParamsOfNameExpr(El: TPasExpr): TParamsExpr;
  1874. function GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  1875. function GetPathStart(El: TPasExpr): TPasExpr;
  1876. function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  1877. function ParentNeedsExprResult(El: TPasExpr): boolean;
  1878. function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
  1879. function GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  1880. function GetSetType(const ResolvedSet: TPasResolverResult): TPasSetType;
  1881. function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
  1882. function IsOpenArray(TypeEl: TPasType): boolean;
  1883. function IsDynOrOpenArray(TypeEl: TPasType): boolean;
  1884. function IsArrayOfConst(TypeEl: TPasType): boolean;
  1885. function GetArrayElType(ArrType: TPasArrayType): TPasType;
  1886. function IsVarInit(Expr: TPasExpr): boolean;
  1887. function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  1888. function IsClassMethod(El: TPasElement): boolean;
  1889. function IsClassField(El: TPasElement): boolean;
  1890. function GetFunctionType(El: TPasElement): TPasFunctionType;
  1891. function MethodIsStatic(El: TPasProcedure): boolean;
  1892. function IsMethod(El: TPasProcedure): boolean;
  1893. function IsHelperMethod(El: TPasElement): boolean; virtual;
  1894. function IsHelper(El: TPasElement): boolean;
  1895. function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
  1896. function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
  1897. function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
  1898. function IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  1899. function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  1900. function IsTypeCast(Params: TParamsExpr): boolean;
  1901. function IsInterfaceType(const ResolvedEl: TPasResolverResult;
  1902. IntfType: TPasClassInterfaceType): boolean; overload;
  1903. function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
  1904. function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
  1905. function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
  1906. function IsCustomAttribute(El: TPasElement): boolean; virtual;
  1907. function IsSystemUnit(El: TPasModule): boolean; virtual;
  1908. function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
  1909. function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
  1910. function ProcNeedsParams(El: TPasProcedureType): boolean;
  1911. function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
  1912. function GetTopLvlProc(El: TPasElement): TPasProcedure;
  1913. function GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  1914. function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  1915. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
  1916. function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
  1917. function HasTypeInfo(El: TPasType): boolean; virtual;
  1918. function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
  1919. function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1920. function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1921. procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
  1922. function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: TMaxPrecInt): boolean;
  1923. function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
  1924. function GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt): TResolverBaseType; // returns BaseTypeExtended if too big
  1925. function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1926. function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1927. function IsElementSkipped(El: TPasElement): boolean; virtual;
  1928. function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
  1929. function GetLastSection: TPasSection;
  1930. function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  1931. isLoFunc: Boolean; out Mask: LongWord): Integer;
  1932. public
  1933. // options
  1934. property Options: TPasResolverOptions read FOptions write FOptions;
  1935. property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
  1936. write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
  1937. property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
  1938. property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
  1939. property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
  1940. property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
  1941. property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
  1942. property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
  1943. property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
  1944. property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
  1945. property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
  1946. property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
  1947. // parsed values
  1948. property DefaultNameSpace: String read FDefaultNameSpace;
  1949. property RootElement: TPasModule read FRootElement write SetRootElement;
  1950. property Step: TPasResolverStep read FStep;
  1951. property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers;
  1952. // scopes
  1953. property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
  1954. If true Line and Column is mangled together in TPasElement.SourceLineNumber.
  1955. Use method UnmangleSourceLineNumber to extract. }
  1956. property Scopes[Index: integer]: TPasScope read GetScopes;
  1957. property ScopeCount: integer read FScopeCount;
  1958. property TopScope: TPasScope read FTopScope;
  1959. property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
  1960. property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
  1961. property ScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass read FScopeClass_InitialFinalization write FScopeClass_InitialFinalization;
  1962. property ScopeClass_Module: TPasModuleScopeClass read FScopeClass_Module write FScopeClass_Module;
  1963. property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
  1964. property ScopeClass_Section: TPasSectionScopeClass read FScopeClass_Section write FScopeClass_Section;
  1965. property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
  1966. // last element
  1967. property LastElement: TPasElement read FLastElement;
  1968. property LastMsg: string read FLastMsg write FLastMsg;
  1969. property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
  1970. property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
  1971. property LastMsgId: TMaxPrecInt read FLastMsgId write FLastMsgId;
  1972. property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
  1973. property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
  1974. property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
  1975. property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
  1976. end;
  1977. function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
  1978. function GetResolverResultDbg(const T: TPasResolverResult): string;
  1979. function GetClassAncestorsDbg(El: TPasClassType): string;
  1980. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  1981. function GetElementTypeName(El: TPasElement): string; overload;
  1982. function GetElementTypeName(C: TPasElementBaseClass): string; overload;
  1983. function GetElementDbgPath(El: TPasElement): string; overload;
  1984. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  1985. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  1986. BaseType: TResolverBaseType; IdentEl: TPasElement;
  1987. LoTypeEl, HiTypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
  1988. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  1989. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  1990. Flags: TPasResolverResultFlags); overload;
  1991. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  1992. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  1993. Flags: TPasResolverResultFlags); overload;
  1994. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  1995. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  1996. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  1997. procedure ClearHelperList(var List: TPRHelperEntryArray);
  1998. function ChompDottedIdentifier(const Identifier: string): string;
  1999. function FirstDottedIdentifier(const Identifier: string): string;
  2000. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2001. {$IF FPC_FULLVERSION<30101}
  2002. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2003. {$ENDIF}
  2004. function DotExprToName(Expr: TPasExpr): string;
  2005. function NoNil(o: TObject): TObject;
  2006. function ComparePRHelperEntries(Entry1, Entry2: TPRHelperEntry): integer;
  2007. function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
  2008. function dbgs(const a: TResolvedRefAccess): string; overload;
  2009. function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
  2010. function dbgs(const a: TPSRefAccess): string; overload;
  2011. implementation
  2012. function GetTreeDbg(El: TPasElement; Indent: integer): string;
  2013. procedure LineBreak(SubIndent: integer);
  2014. begin
  2015. Inc(Indent,SubIndent);
  2016. Result:=Result+LineEnding+StringOfChar(' ',Indent);
  2017. end;
  2018. var
  2019. i, l: Integer;
  2020. begin
  2021. if El=nil then exit('nil');
  2022. Result:=El.Name+':'+El.ClassName+'=';
  2023. if El is TPasExpr then
  2024. begin
  2025. if El.ClassType<>TBinaryExpr then
  2026. Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
  2027. if El.ClassType=TUnaryExpr then
  2028. Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
  2029. else if El.ClassType=TBinaryExpr then
  2030. Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
  2031. +OpcodeStrings[TPasExpr(El).OpCode]
  2032. +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
  2033. else if El.ClassType=TPrimitiveExpr then
  2034. Result:=Result+TPrimitiveExpr(El).Value
  2035. else if El.ClassType=TBoolConstExpr then
  2036. Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
  2037. else if El.ClassType=TNilExpr then
  2038. Result:=Result+'nil'
  2039. else if El.ClassType=TInheritedExpr then
  2040. Result:=Result+'inherited'
  2041. else if El.ClassType=TSelfExpr then
  2042. Result:=Result+'Self'
  2043. else if El.ClassType=TParamsExpr then
  2044. begin
  2045. LineBreak(2);
  2046. Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
  2047. l:=length(TParamsExpr(El).Params);
  2048. if l>0 then
  2049. begin
  2050. inc(Indent,2);
  2051. for i:=0 to l-1 do
  2052. begin
  2053. LineBreak(0);
  2054. Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
  2055. if i<l-1 then
  2056. Result:=Result+','
  2057. end;
  2058. dec(Indent,2);
  2059. end;
  2060. Result:=Result+')';
  2061. end
  2062. else if El.ClassType=TRecordValues then
  2063. begin
  2064. Result:=Result+'(';
  2065. l:=length(TRecordValues(El).Fields);
  2066. if l>0 then
  2067. begin
  2068. inc(Indent,2);
  2069. for i:=0 to l-1 do
  2070. begin
  2071. LineBreak(0);
  2072. Result:=Result+TRecordValues(El).Fields[i].Name+':'
  2073. +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
  2074. if i<l-1 then
  2075. Result:=Result+','
  2076. end;
  2077. dec(Indent,2);
  2078. end;
  2079. Result:=Result+')';
  2080. end
  2081. else if El.ClassType=TArrayValues then
  2082. begin
  2083. Result:=Result+'[';
  2084. l:=length(TArrayValues(El).Values);
  2085. if l>0 then
  2086. begin
  2087. inc(Indent,2);
  2088. for i:=0 to l-1 do
  2089. begin
  2090. LineBreak(0);
  2091. Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
  2092. if i<l-1 then
  2093. Result:=Result+','
  2094. end;
  2095. dec(Indent,2);
  2096. end;
  2097. Result:=Result+']';
  2098. end;
  2099. end
  2100. else if El is TPasProcedure then
  2101. begin
  2102. Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
  2103. end
  2104. else if El is TPasProcedureType then
  2105. begin
  2106. if TPasProcedureType(El).IsReferenceTo then
  2107. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2108. Result:=Result+'(';
  2109. l:=TPasProcedureType(El).Args.Count;
  2110. if l>0 then
  2111. begin
  2112. inc(Indent,2);
  2113. for i:=0 to l-1 do
  2114. begin
  2115. LineBreak(0);
  2116. Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
  2117. if i<l-1 then
  2118. Result:=Result+';'
  2119. end;
  2120. dec(Indent,2);
  2121. end;
  2122. Result:=Result+')';
  2123. if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
  2124. Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
  2125. if TPasProcedureType(El).IsOfObject then
  2126. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  2127. if TPasProcedureType(El).IsNested then
  2128. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2129. if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
  2130. Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
  2131. end
  2132. else if El.ClassType=TPasResultElement then
  2133. Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
  2134. else if El.ClassType=TPasArgument then
  2135. begin
  2136. if AccessNames[TPasArgument(El).Access]<>'' then
  2137. Result:=Result+AccessNames[TPasArgument(El).Access];
  2138. if TPasArgument(El).ArgType=nil then
  2139. Result:=Result+'untyped'
  2140. else
  2141. Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
  2142. end
  2143. else if El.ClassType=TPasUnresolvedSymbolRef then
  2144. begin
  2145. if El.CustomData is TResElDataBuiltInProc then
  2146. Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
  2147. end;
  2148. end;
  2149. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2150. var
  2151. HiTypeEl: TPasType;
  2152. begin
  2153. Result:='[bt='+ResBaseTypeNames[T.BaseType];
  2154. if T.SubType<>btNone then
  2155. Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
  2156. Result:=Result
  2157. +' Ident='+GetObjName(T.IdentEl);
  2158. HiTypeEl:=ResolveSimpleAliasType(T.HiTypeEl);
  2159. if HiTypeEl<>T.LoTypeEl then
  2160. Result:=Result+' LoType='+GetObjName(T.LoTypeEl)+' HiTypeEl='+GetObjName(HiTypeEl)
  2161. else
  2162. Result:=Result+' Type='+GetObjName(T.LoTypeEl);
  2163. Result:=Result
  2164. +' Expr='+GetObjName(T.ExprEl)
  2165. +' Flags='+ResolverResultFlagsToStr(T.Flags)
  2166. +']';
  2167. end;
  2168. function GetClassAncestorsDbg(El: TPasClassType): string;
  2169. function GetClassDesc(C: TPasClassType): string;
  2170. var
  2171. Module: TPasModule;
  2172. begin
  2173. if C.IsExternal then
  2174. Result:='class external '
  2175. else
  2176. Result:='class ';
  2177. Module:=C.GetModule;
  2178. if Module<>nil then
  2179. Result:=Result+Module.Name+'.';
  2180. Result:=Result+GetElementDbgPath(C);
  2181. end;
  2182. var
  2183. Scope, AncestorScope: TPasClassScope;
  2184. AncestorEl: TPasClassType;
  2185. begin
  2186. if El=nil then exit('nil');
  2187. Result:=GetClassDesc(El);
  2188. if El.CustomData is TPasClassScope then
  2189. begin
  2190. Scope:=TPasClassScope(El.CustomData);
  2191. AncestorScope:=Scope.AncestorScope;
  2192. while AncestorScope<>nil do
  2193. begin
  2194. Result:=Result+LineEnding+' ';
  2195. AncestorEl:=NoNil(AncestorScope.Element) as TPasClassType;
  2196. Result:=Result+GetClassDesc(AncestorEl);
  2197. AncestorScope:=AncestorScope.AncestorScope;
  2198. end;
  2199. end;
  2200. end;
  2201. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2202. var
  2203. f: TPasResolverResultFlag;
  2204. s: string;
  2205. begin
  2206. Result:='';
  2207. for f in Flags do
  2208. begin
  2209. if Result<>'' then Result:=Result+',';
  2210. str(f,s);
  2211. Result:=Result+s;
  2212. end;
  2213. Result:='['+Result+']';
  2214. end;
  2215. function GetElementTypeName(El: TPasElement): string;
  2216. var
  2217. C: TClass;
  2218. begin
  2219. if El=nil then
  2220. exit('?');
  2221. C:=El.ClassType;
  2222. if C=TPrimitiveExpr then
  2223. Result:=ExprKindNames[TPrimitiveExpr(El).Kind]
  2224. else if C=TUnaryExpr then
  2225. Result:='unary '+OpcodeStrings[TUnaryExpr(El).OpCode]
  2226. else if C=TBinaryExpr then
  2227. Result:=ExprKindNames[TBinaryExpr(El).Kind]
  2228. else if C=TPasClassType then
  2229. Result:=ObjKindNames[TPasClassType(El).ObjKind]
  2230. else if C=TPasUnresolvedSymbolRef then
  2231. Result:=El.Name
  2232. else
  2233. begin
  2234. Result:=GetElementTypeName(TPasElementBaseClass(C));
  2235. if Result='' then
  2236. Result:=El.ElementTypeName;
  2237. end;
  2238. end;
  2239. function GetElementTypeName(C: TPasElementBaseClass): string;
  2240. begin
  2241. if C=nil then
  2242. exit('nil');
  2243. if C=TPrimitiveExpr then
  2244. Result:='primitive expression'
  2245. else if C=TUnaryExpr then
  2246. Result:='unary expression'
  2247. else if C=TBinaryExpr then
  2248. Result:='binary expression'
  2249. else if C=TBoolConstExpr then
  2250. Result:='boolean const'
  2251. else if C=TNilExpr then
  2252. Result:='nil'
  2253. else if C=TPasAliasType then
  2254. Result:='alias'
  2255. else if C=TPasPointerType then
  2256. Result:='pointer'
  2257. else if C=TPasTypeAliasType then
  2258. Result:='type alias'
  2259. else if C=TPasClassOfType then
  2260. Result:='class of'
  2261. else if C=TPasSpecializeType then
  2262. Result:='specialize'
  2263. else if C=TInlineSpecializeExpr then
  2264. Result:='inline-specialize'
  2265. else if C=TPasRangeType then
  2266. Result:='range'
  2267. else if C=TPasArrayType then
  2268. Result:='array'
  2269. else if C=TPasFileType then
  2270. Result:='file'
  2271. else if C=TPasEnumValue then
  2272. Result:='enum value'
  2273. else if C=TPasEnumType then
  2274. Result:='enum type'
  2275. else if C=TPasSetType then
  2276. Result:='set'
  2277. else if C=TPasRecordType then
  2278. Result:='record'
  2279. else if C=TPasClassType then
  2280. Result:='class'
  2281. else if C=TPasArgument then
  2282. Result:='parameter'
  2283. else if C=TPasProcedureType then
  2284. Result:='procedural type'
  2285. else if C=TPasResultElement then
  2286. Result:='function result'
  2287. else if C=TPasFunctionType then
  2288. Result:='functional type'
  2289. else if C=TPasStringType then
  2290. Result:='string[]'
  2291. else if C=TPasVariable then
  2292. Result:='var'
  2293. else if C=TPasExportSymbol then
  2294. Result:='export'
  2295. else if C=TPasConst then
  2296. Result:='const'
  2297. else if C=TPasProperty then
  2298. Result:='property'
  2299. else if C=TPasProcedure then
  2300. Result:='procedure'
  2301. else if C=TPasFunction then
  2302. Result:='function'
  2303. else if C=TPasOperator then
  2304. Result:='operator'
  2305. else if C=TPasClassOperator then
  2306. Result:='class operator'
  2307. else if C=TPasConstructor then
  2308. Result:='constructor'
  2309. else if C=TPasClassConstructor then
  2310. Result:='class constructor'
  2311. else if C=TPasDestructor then
  2312. Result:='destructor'
  2313. else if C=TPasClassDestructor then
  2314. Result:='class destructor'
  2315. else if C=TPasClassProcedure then
  2316. Result:='class procedure'
  2317. else if C=TPasClassFunction then
  2318. Result:='class function'
  2319. else if C=TPasAnonymousProcedure then
  2320. Result:='anonymous procedure'
  2321. else if C=TPasAnonymousFunction then
  2322. Result:='anonymous function'
  2323. else if C=TPasMethodResolution then
  2324. Result:='method resolution'
  2325. else if C=TInterfaceSection then
  2326. Result:='interfacesection'
  2327. else if C=TImplementationSection then
  2328. Result:='implementation'
  2329. else if C=TProgramSection then
  2330. Result:='program section'
  2331. else if C=TLibrarySection then
  2332. Result:='library section'
  2333. else
  2334. Result:=C.ClassName;
  2335. end;
  2336. function GetElementDbgPath(El: TPasElement): string;
  2337. begin
  2338. if El=nil then exit('nil');
  2339. Result:='';
  2340. while El<>nil do
  2341. begin
  2342. if Result<>'' then Result:='.'+Result;
  2343. if El.Name<>'' then
  2344. Result:=El.Name+Result
  2345. else
  2346. Result:=GetElementTypeName(El)+Result;
  2347. El:=El.Parent;
  2348. end;
  2349. end;
  2350. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2351. var
  2352. C: TClass;
  2353. begin
  2354. while aType<>nil do
  2355. begin
  2356. C:=aType.ClassType;
  2357. if (C=TPasAliasType) then
  2358. aType:=TPasAliasType(aType).DestType
  2359. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  2360. and (aType.CustomData is TResolvedReference) then
  2361. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  2362. else
  2363. exit(aType);
  2364. end;
  2365. Result:=nil;
  2366. end;
  2367. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2368. BaseType: TResolverBaseType; IdentEl: TPasElement; LoTypeEl,
  2369. HiTypeEl: TPasType; Flags: TPasResolverResultFlags);
  2370. begin
  2371. if IdentEl is TPasExpr then
  2372. raise Exception.Create('20170729101017');
  2373. ResolvedType.BaseType:=BaseType;
  2374. ResolvedType.SubType:=btNone;
  2375. ResolvedType.IdentEl:=IdentEl;
  2376. ResolvedType.HiTypeEl:=HiTypeEl;
  2377. ResolvedType.LoTypeEl:=LoTypeEl;
  2378. ResolvedType.ExprEl:=nil;
  2379. ResolvedType.Flags:=Flags;
  2380. end;
  2381. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2382. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2383. Flags: TPasResolverResultFlags);
  2384. begin
  2385. ResolvedType.BaseType:=BaseType;
  2386. ResolvedType.SubType:=btNone;
  2387. ResolvedType.IdentEl:=nil;
  2388. ResolvedType.HiTypeEl:=HiTypeEl;
  2389. ResolvedType.LoTypeEl:=LoTypeEl;
  2390. ResolvedType.ExprEl:=nil;
  2391. ResolvedType.Flags:=Flags;
  2392. end;
  2393. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2394. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2395. Flags: TPasResolverResultFlags);
  2396. begin
  2397. ResolvedType.BaseType:=BaseType;
  2398. ResolvedType.SubType:=btNone;
  2399. ResolvedType.IdentEl:=nil;
  2400. ResolvedType.HiTypeEl:=HiTypeEl;
  2401. ResolvedType.LoTypeEl:=LoTypeEl;
  2402. ResolvedType.ExprEl:=ExprEl;
  2403. ResolvedType.Flags:=Flags;
  2404. end;
  2405. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2406. begin
  2407. Result:=true;
  2408. if Proc.IsExternal then exit(false);
  2409. if Proc.IsForward then exit;
  2410. if Proc.Parent.ClassType=TInterfaceSection then exit;
  2411. if Proc.Parent.ClassType=TPasClassType then
  2412. begin
  2413. // a method declaration
  2414. if not Proc.IsAbstract then exit;
  2415. end;
  2416. Result:=false;
  2417. end;
  2418. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2419. var
  2420. C: TClass;
  2421. begin
  2422. if Proc.IsForward or Proc.IsExternal then exit(false);
  2423. C:=Proc.Parent.ClassType;
  2424. if (C=TInterfaceSection) or C.InheritsFrom(TPasClassType) then exit(false);
  2425. Result:=true;
  2426. end;
  2427. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2428. var
  2429. Data: TObject;
  2430. begin
  2431. if Proc.IsOverload then
  2432. exit(true);
  2433. Data:=Proc.CustomData;
  2434. Result:=(Data is TPasProcedureScope)
  2435. and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
  2436. end;
  2437. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2438. var
  2439. i: Integer;
  2440. begin
  2441. if length(List)=0 then exit;
  2442. for i:=0 to length(List)-1 do
  2443. TPRHelperEntry(List[i]).Free;
  2444. List:=nil;
  2445. end;
  2446. function ChompDottedIdentifier(const Identifier: string): string;
  2447. var
  2448. p: Integer;
  2449. begin
  2450. Result:=Identifier;
  2451. p:=length(Identifier);
  2452. while (p>0) do
  2453. begin
  2454. if Identifier[p]='.' then
  2455. break;
  2456. dec(p);
  2457. end;
  2458. Result:=LeftStr(Identifier,p-1);
  2459. end;
  2460. function FirstDottedIdentifier(const Identifier: string): string;
  2461. var
  2462. p: SizeInt;
  2463. begin
  2464. p:=Pos('.',Identifier);
  2465. if p<1 then
  2466. Result:=Identifier
  2467. else
  2468. Result:=LeftStr(Identifier,p-1);
  2469. end;
  2470. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2471. var
  2472. l: Integer;
  2473. begin
  2474. l:=length(Prefix);
  2475. if (l>length(Identifier))
  2476. or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
  2477. exit(false);
  2478. Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
  2479. end;
  2480. function DotExprToName(Expr: TPasExpr): string;
  2481. var
  2482. C: TClass;
  2483. Prim: TPrimitiveExpr;
  2484. Bin: TBinaryExpr;
  2485. s: String;
  2486. begin
  2487. Result:='';
  2488. if Expr=nil then exit;
  2489. C:=Expr.ClassType;
  2490. if C=TPrimitiveExpr then
  2491. begin
  2492. Prim:=TPrimitiveExpr(Expr);
  2493. case Prim.Kind of
  2494. pekIdent,pekString: Result:=Prim.Value;
  2495. pekSelf: Result:='Self';
  2496. else
  2497. EPasResolve.Create('[20180309155400] DotExprToName '+GetObjName(Prim)+' '+ExprKindNames[Prim.Kind]);
  2498. end;
  2499. end
  2500. else if C=TBinaryExpr then
  2501. begin
  2502. Bin:=TBinaryExpr(Expr);
  2503. if Bin.OpCode=eopSubIdent then
  2504. begin
  2505. Result:=DotExprToName(Bin.left);
  2506. if Result='' then exit;
  2507. s:=DotExprToName(Bin.right);
  2508. if s='' then exit('');
  2509. Result:=Result+'.'+s;
  2510. end;
  2511. end;
  2512. end;
  2513. function NoNil(o: TObject): TObject;
  2514. begin
  2515. if o=nil then
  2516. raise Exception.Create('');
  2517. Result:=o;
  2518. end;
  2519. {$IF FPC_FULLVERSION<30101}
  2520. function IsValidIdent(const Ident: string; AllowDots: Boolean;
  2521. StrictDots: Boolean): Boolean;
  2522. const
  2523. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2524. AlphaNum = Alpha + ['0'..'9'];
  2525. Dot = '.';
  2526. var
  2527. First: Boolean;
  2528. I, Len: Integer;
  2529. begin
  2530. Len := Length(Ident);
  2531. if Len < 1 then
  2532. Exit(False);
  2533. First := True;
  2534. for I := 1 to Len do
  2535. begin
  2536. if First then
  2537. begin
  2538. Result := Ident[I] in Alpha;
  2539. First := False;
  2540. end
  2541. else if AllowDots and (Ident[I] = Dot) then
  2542. begin
  2543. if StrictDots then
  2544. begin
  2545. Result := I < Len;
  2546. First := True;
  2547. end;
  2548. end
  2549. else
  2550. Result := Ident[I] in AlphaNum;
  2551. if not Result then
  2552. Break;
  2553. end;
  2554. end;
  2555. {$ENDIF}
  2556. function ComparePRHelperEntries(Entry1, Entry2: TPRHelperEntry): integer;
  2557. var
  2558. HelperForType1, HelperForType2: TPasType;
  2559. begin
  2560. HelperForType1:=Entry1.HelperForType;
  2561. HelperForType2:=Entry2.HelperForType;
  2562. {$IFDEF Pas2js}
  2563. if HelperForType1.PasElementId<HelperForType2.PasElementId then
  2564. exit(1)
  2565. else if HelperForType1.PasElementId>HelperForType2.PasElementId then
  2566. exit(-1)
  2567. {$ELSE}
  2568. if Pointer(HelperForType1)>Pointer(HelperForType2) then
  2569. exit(1)
  2570. else if Pointer(HelperForType1)<Pointer(HelperForType2) then
  2571. exit(-1)
  2572. {$ENDIF}
  2573. else
  2574. Result:=Entry1.Added-Entry2.Added;
  2575. end;
  2576. function dbgs(const Flags: TPasResolverComputeFlags): string;
  2577. var
  2578. s: string;
  2579. f: TPasResolverComputeFlag;
  2580. begin
  2581. Result:='';
  2582. for f in Flags do
  2583. if f in Flags then
  2584. begin
  2585. if Result<>'' then Result:=Result+',';
  2586. str(f,s);
  2587. Result:=Result+s;
  2588. end;
  2589. Result:='['+Result+']';
  2590. end;
  2591. function dbgs(const a: TResolvedRefAccess): string;
  2592. begin
  2593. str(a,Result);
  2594. end;
  2595. function dbgs(const Flags: TResolvedReferenceFlags): string;
  2596. var
  2597. s: string;
  2598. f: TResolvedReferenceFlag;
  2599. begin
  2600. Result:='';
  2601. for f in Flags do
  2602. if f in Flags then
  2603. begin
  2604. if Result<>'' then Result:=Result+',';
  2605. str(f,s);
  2606. Result:=Result+s;
  2607. end;
  2608. Result:='['+Result+']';
  2609. end;
  2610. function dbgs(const a: TPSRefAccess): string;
  2611. begin
  2612. str(a,Result);
  2613. end;
  2614. { TPasInheritedScope }
  2615. function TPasInheritedScope.FindIdentifier(const Identifier: String
  2616. ): TPasIdentifier;
  2617. var
  2618. aClassScope: TPasClassScope;
  2619. begin
  2620. Result:=inherited FindIdentifier(Identifier);
  2621. if Result<>nil then exit;
  2622. aClassScope:=AncestorScope;
  2623. while aClassScope<>nil do
  2624. begin
  2625. Result:=aClassScope.FindIdentifier(Identifier);
  2626. if Result<>nil then exit;
  2627. aClassScope:=aClassScope.AncestorScope;
  2628. end;
  2629. end;
  2630. procedure TPasInheritedScope.IterateElements(const aName: string;
  2631. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2632. Data: Pointer; var Abort: boolean);
  2633. var
  2634. aClassScope: TPasClassScope;
  2635. begin
  2636. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2637. if Abort then exit;
  2638. aClassScope:=AncestorScope;
  2639. while aClassScope<>nil do
  2640. begin
  2641. aClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2642. if Abort then exit;
  2643. aClassScope:=aClassScope.AncestorScope;
  2644. end;
  2645. end;
  2646. procedure TPasInheritedScope.WriteIdentifiers(Prefix: string);
  2647. var
  2648. aClassScope: TPasClassScope;
  2649. begin
  2650. inherited WriteIdentifiers(Prefix);
  2651. aClassScope:=AncestorScope;
  2652. while aClassScope<>nil do
  2653. begin
  2654. aClassScope.WriteIdentifiers(Prefix);
  2655. aClassScope:=aClassScope.AncestorScope;
  2656. end;
  2657. end;
  2658. { TPasDotEnumTypeScope }
  2659. function TPasDotEnumTypeScope.FindIdentifier(const Identifier: String
  2660. ): TPasIdentifier;
  2661. begin
  2662. Result:=EnumScope.FindLocalIdentifier(Identifier);
  2663. if Result<>nil then exit;
  2664. Result:=inherited FindIdentifier(Identifier);
  2665. end;
  2666. procedure TPasDotEnumTypeScope.IterateElements(const aName: string;
  2667. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2668. Data: Pointer; var Abort: boolean);
  2669. begin
  2670. EnumScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2671. if Abort then exit;
  2672. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2673. end;
  2674. procedure TPasDotEnumTypeScope.WriteIdentifiers(Prefix: string);
  2675. begin
  2676. EnumScope.WriteIdentifiers(Prefix);
  2677. inherited WriteIdentifiers(Prefix);
  2678. end;
  2679. { TPasGroupScope }
  2680. procedure TPasGroupScope.Add(Scope: TPasIdentifierScope);
  2681. var
  2682. i: Integer;
  2683. begin
  2684. for i:=0 to Count-1 do
  2685. if Scopes[i]=Scope then exit; // already added
  2686. if Scope.FreeOnPop then
  2687. raise Exception.Create('TPasGroupScope.Add '+GetObjName(Scope)+' '+GetObjName(Scope.Element));
  2688. if Count=length(Scopes) then
  2689. SetLength(Scopes,Count*2+4);
  2690. Scopes[Count]:=Scope;
  2691. inc(Count);
  2692. end;
  2693. destructor TPasGroupScope.Destroy;
  2694. begin
  2695. Scopes:=nil;
  2696. Count:=0;
  2697. inherited Destroy;
  2698. end;
  2699. function TPasGroupScope.GetFirstNonHelperScope: TPasIdentifierScope;
  2700. var
  2701. i: Integer;
  2702. Scope: TPasIdentifierScope;
  2703. begin
  2704. for i:=0 to Count-1 do
  2705. begin
  2706. Scope:=Scopes[i];
  2707. if (Scope.ClassType<>TPasClassScope)
  2708. or (TPasClassType(Scope.Element).HelperForType=nil) then
  2709. exit(Scope);
  2710. end;
  2711. Result:=nil;
  2712. end;
  2713. class function TPasGroupScope.IsStoredInElement: boolean;
  2714. begin
  2715. Result:=false;
  2716. end;
  2717. function TPasGroupScope.FindAncestorIdentifier(const Identifier: String
  2718. ): TPasIdentifier;
  2719. var
  2720. i: Integer;
  2721. begin
  2722. for i:=1 to Count-1 do
  2723. begin
  2724. Result:=Scopes[i].FindIdentifier(Identifier);
  2725. if Result<>nil then exit;
  2726. end;
  2727. Result:=nil;
  2728. end;
  2729. function TPasGroupScope.FindAncestorElement(const Identifier: String
  2730. ): TPasElement;
  2731. var
  2732. Item: TPasIdentifier;
  2733. begin
  2734. Item:=FindAncestorIdentifier(Identifier);
  2735. if Item<>nil then
  2736. Result:=Item.Element
  2737. else
  2738. Result:=nil;
  2739. end;
  2740. function TPasGroupScope.FindIdentifier(const Identifier: String
  2741. ): TPasIdentifier;
  2742. var
  2743. i: Integer;
  2744. begin
  2745. for i:=0 to Count-1 do
  2746. begin
  2747. Result:=Scopes[i].FindIdentifier(Identifier);
  2748. if Result<>nil then exit;
  2749. end;
  2750. Result:=nil;
  2751. end;
  2752. procedure TPasGroupScope.IterateElements(const aName: string;
  2753. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2754. Data: Pointer; var Abort: boolean);
  2755. var
  2756. i: Integer;
  2757. begin
  2758. for i:=0 to Count-1 do
  2759. begin
  2760. Scopes[i].IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
  2761. if Abort then exit;
  2762. end;
  2763. end;
  2764. procedure TPasGroupScope.WriteIdentifiers(Prefix: string);
  2765. var
  2766. i: Integer;
  2767. begin
  2768. for i:=0 to Count-1 do
  2769. Scopes[i].WriteIdentifiers(Prefix+'Group['+IntToStr(i)+'/'+IntToStr(Count)+']');
  2770. end;
  2771. {$ifdef pas2js}
  2772. { TPasResHashList }
  2773. constructor TPasResHashList.Create;
  2774. begin
  2775. FItems:=TJSObject.new;
  2776. end;
  2777. procedure TPasResHashList.Add(const aName: string; Item: Pointer);
  2778. begin
  2779. FItems['%'+aName]:=Item;
  2780. end;
  2781. function TPasResHashList.Find(const aName: string): Pointer;
  2782. begin
  2783. if FItems.hasOwnProperty('%'+aName) then
  2784. Result:=Pointer(FItems['%'+aName])
  2785. else
  2786. Result:=nil;
  2787. end;
  2788. procedure TPasResHashList.ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  2789. var
  2790. key: string;
  2791. begin
  2792. for key in FItems do
  2793. if FItems.hasOwnProperty(key) then
  2794. Proc(Pointer(FItems[key]),Arg);
  2795. end;
  2796. procedure TPasResHashList.Clear;
  2797. begin
  2798. FItems:=TJSObject.new;
  2799. end;
  2800. procedure TPasResHashList.Remove(const aName: string);
  2801. begin
  2802. if FItems.hasOwnProperty('%'+aName) then
  2803. JSDelete(FItems,'%'+aName);
  2804. end;
  2805. {$endif}
  2806. { TResElDataBuiltInProc }
  2807. destructor TResElDataBuiltInProc.Destroy;
  2808. begin
  2809. ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TResElDataBuiltInProc.Proc'{$ENDIF});
  2810. inherited Destroy;
  2811. end;
  2812. { TPasClassIntfMap }
  2813. destructor TPasClassIntfMap.Destroy;
  2814. begin
  2815. Element:=nil;
  2816. Intf:=nil;
  2817. FreeAndNil(Procs);
  2818. FreeAndNil(AncestorMap);
  2819. inherited Destroy;
  2820. end;
  2821. { TPasInitialFinalizationScope }
  2822. function TPasInitialFinalizationScope.AddReference(El: TPasElement;
  2823. Access: TPSRefAccess): TPasScopeReference;
  2824. begin
  2825. if References=nil then
  2826. References:=TPasScopeReferences.Create(Self);
  2827. Result:=References.Add(El,Access);
  2828. end;
  2829. destructor TPasInitialFinalizationScope.Destroy;
  2830. begin
  2831. FreeAndNil(References);
  2832. inherited Destroy;
  2833. end;
  2834. { TPasScopeReference }
  2835. procedure TPasScopeReference.SetElement(const AValue: TPasElement);
  2836. begin
  2837. if FElement=AValue then Exit;
  2838. if FElement<>nil then
  2839. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  2840. FElement:=AValue;
  2841. if FElement<>nil then
  2842. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  2843. end;
  2844. destructor TPasScopeReference.Destroy;
  2845. begin
  2846. {$IFDEF VerbosePasResolverMem}
  2847. writeln('TPasProcScopeReference.Destroy START ',ClassName,' "',GetObjName(Element),'"');
  2848. {$ENDIF}
  2849. Element:=nil;
  2850. inherited Destroy;
  2851. {$IFDEF VerbosePasResolverMem}
  2852. writeln('TPasProcScopeReference.Destroy END ',ClassName);
  2853. {$ENDIF}
  2854. end;
  2855. { TPasScopeReferences }
  2856. procedure TPasScopeReferences.OnClearItem(Item, Dummy: pointer);
  2857. var
  2858. Ref: TPasScopeReference absolute Item;
  2859. Ref2: TPasScopeReference;
  2860. begin
  2861. if Dummy=nil then ;
  2862. //writeln('TPasProcedureScope.OnClearReferenceItem ',GetObjName(Ref.Element));
  2863. while Ref<>nil do
  2864. begin
  2865. Ref2:=Ref;
  2866. Ref:=Ref.NextSameName;
  2867. Ref2.Free;
  2868. end;
  2869. end;
  2870. procedure TPasScopeReferences.OnCollectItem(Item, aList: pointer);
  2871. var
  2872. Ref: TPasScopeReference absolute Item;
  2873. List: TFPList absolute aList;
  2874. begin
  2875. while Ref<>nil do
  2876. begin
  2877. List.Add(Ref);
  2878. Ref:=Ref.NextSameName;
  2879. end;
  2880. end;
  2881. constructor TPasScopeReferences.Create(aScope: TPasScope);
  2882. begin
  2883. References:=TPasResHashList.Create;
  2884. FScope:=aScope;
  2885. end;
  2886. destructor TPasScopeReferences.Destroy;
  2887. begin
  2888. Clear;
  2889. {$ifdef pas2js}
  2890. References:=nil;
  2891. {$else}
  2892. FreeAndNil(References);
  2893. {$endif}
  2894. inherited Destroy;
  2895. end;
  2896. procedure TPasScopeReferences.Clear;
  2897. begin
  2898. if References=nil then exit;
  2899. References.ForEachCall(@OnClearItem,nil);
  2900. References.Clear;
  2901. end;
  2902. function TPasScopeReferences.Add(El: TPasElement; Access: TPSRefAccess
  2903. ): TPasScopeReference;
  2904. var
  2905. LoName: String;
  2906. OldItem, Item, LastItem: TPasScopeReference;
  2907. begin
  2908. LoName:=lowercase(El.Name);
  2909. OldItem:=TPasScopeReference(References.Find(LoName));
  2910. Item:=OldItem;
  2911. LastItem:=nil;
  2912. while Item<>nil do
  2913. begin
  2914. if Item.Element=El then
  2915. begin
  2916. // already marked as used -> combine access
  2917. case Access of
  2918. psraNone: ;
  2919. psraRead:
  2920. case Item.Access of
  2921. psraNone: Item.Access:=Access;
  2922. //psraRead: ;
  2923. psraWrite: Item.Access:=psraWriteRead;
  2924. //psraReadWrite: ;
  2925. //psraWriteRead: ;
  2926. //psraTypeInfo: ;
  2927. end;
  2928. psraWrite:
  2929. case Item.Access of
  2930. psraNone: Item.Access:=Access;
  2931. psraRead: Item.Access:=psraReadWrite;
  2932. //psraWrite: ;
  2933. //psraReadWrite: ;
  2934. //psraWriteRead: ;
  2935. //psraTypeInfo: ;
  2936. end;
  2937. psraReadWrite:
  2938. case Item.Access of
  2939. psraNone: Item.Access:=Access;
  2940. psraRead: Item.Access:=psraReadWrite;
  2941. psraWrite: Item.Access:=psraWriteRead;
  2942. //psraReadWrite: ;
  2943. //psraWriteRead: ;
  2944. //psraTypeInfo: ;
  2945. end;
  2946. psraWriteRead:
  2947. case Item.Access of
  2948. psraNone: Item.Access:=Access;
  2949. psraRead: Item.Access:=psraReadWrite;
  2950. psraWrite: Item.Access:=psraWriteRead;
  2951. //psraReadWrite: ;
  2952. //psraWriteRead: ;
  2953. //psraTypeInfo: ;
  2954. end;
  2955. psraTypeInfo: Item.Access:=psraTypeInfo;
  2956. else
  2957. raise EPasResolve.Create(GetObjName(El)+' unknown Access');
  2958. end;
  2959. exit(Item);
  2960. end;
  2961. LastItem:=Item;
  2962. Item:=Item.NextSameName;
  2963. end;
  2964. // new reference
  2965. Item:=TPasScopeReference.Create;
  2966. Item.Element:=El;
  2967. Item.Access:=Access;
  2968. if LastItem=nil then
  2969. begin
  2970. References.Add(LoName,Item);
  2971. {$IFDEF VerbosePCUFiler}
  2972. if TPasScopeReference(References.Find(LoName))<>Item then
  2973. raise EPasResolve.Create('20180219230028');
  2974. {$ENDIF}
  2975. end
  2976. else
  2977. LastItem.NextSameName:=Item;
  2978. Result:=Item;
  2979. end;
  2980. function TPasScopeReferences.Find(const aName: string): TPasScopeReference;
  2981. var
  2982. LoName: String;
  2983. begin
  2984. if References=nil then exit(nil);
  2985. LoName:=lowercase(aName);
  2986. Result:=TPasScopeReference(References.Find(LoName));
  2987. end;
  2988. function TPasScopeReferences.GetList: TFPList;
  2989. begin
  2990. Result:=TFPList.Create;
  2991. if References=nil then exit;
  2992. References.ForEachCall(@OnCollectItem,Result);
  2993. end;
  2994. { TPasPropertyScope }
  2995. destructor TPasPropertyScope.Destroy;
  2996. begin
  2997. {$IFDEF VerbosePasResolverMem}
  2998. writeln('TPasPropertyScope.Destroy START ',ClassName);
  2999. {$ENDIF}
  3000. AncestorProp:=nil;
  3001. inherited Destroy;
  3002. {$IFDEF VerbosePasResolverMem}
  3003. writeln('TPasPropertyScope.Destroy END',ClassName);
  3004. {$ENDIF}
  3005. end;
  3006. { TPasEnumTypeScope }
  3007. destructor TPasEnumTypeScope.Destroy;
  3008. begin
  3009. {$IFDEF VerbosePasResolverMem}
  3010. writeln('TPasEnumTypeScope.Destroy START ',ClassName);
  3011. {$ENDIF}
  3012. ReleaseAndNil(TPasElement(CanonicalSet){$IFDEF CheckPasTreeRefCount},'TPasEnumTypeScope.CanonicalSet'{$ENDIF});
  3013. inherited Destroy;
  3014. {$IFDEF VerbosePasResolverMem}
  3015. writeln('TPasEnumTypeScope.Destroy END ',ClassName);
  3016. {$ENDIF}
  3017. end;
  3018. { TPasDotBaseScope }
  3019. function TPasDotBaseScope.FindIdentifier(const Identifier: String
  3020. ): TPasIdentifier;
  3021. begin
  3022. Result:=GroupScope.FindIdentifier(Identifier);
  3023. end;
  3024. procedure TPasDotBaseScope.IterateElements(const aName: string;
  3025. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3026. Data: Pointer; var Abort: boolean);
  3027. begin
  3028. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3029. end;
  3030. procedure TPasDotBaseScope.WriteIdentifiers(Prefix: string);
  3031. begin
  3032. GroupScope.WriteIdentifiers(Prefix);
  3033. end;
  3034. destructor TPasDotBaseScope.Destroy;
  3035. begin
  3036. FreeAndNil(GroupScope);
  3037. inherited Destroy;
  3038. end;
  3039. { TPasWithExprScope }
  3040. class function TPasWithExprScope.IsStoredInElement: boolean;
  3041. begin
  3042. Result:=false;
  3043. end;
  3044. class function TPasWithExprScope.FreeOnPop: boolean;
  3045. begin
  3046. Result:=false;
  3047. end;
  3048. procedure TPasWithExprScope.IterateElements(const aName: string;
  3049. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3050. Data: Pointer; var Abort: boolean);
  3051. begin
  3052. Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3053. end;
  3054. procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
  3055. begin
  3056. {AllowWriteln}
  3057. writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
  3058. Scope.WriteIdentifiers(Prefix);
  3059. {AllowWriteln-}
  3060. end;
  3061. destructor TPasWithExprScope.Destroy;
  3062. begin
  3063. FreeAndNil(Scope);
  3064. inherited Destroy;
  3065. end;
  3066. { TPasWithScope }
  3067. constructor TPasWithScope.Create;
  3068. begin
  3069. inherited Create;
  3070. ExpressionScopes:=TObjectList.Create(true);
  3071. end;
  3072. destructor TPasWithScope.Destroy;
  3073. begin
  3074. {$IFDEF VerbosePasResolverMem}
  3075. writeln('TPasWithScope.Destroy START ',ClassName);
  3076. {$ENDIF}
  3077. FreeAndNil(ExpressionScopes);
  3078. inherited Destroy;
  3079. {$IFDEF VerbosePasResolverMem}
  3080. writeln('TPasWithScope.Destroy END ',ClassName);
  3081. {$ENDIF}
  3082. end;
  3083. { TPasProcedureScope }
  3084. function TPasProcedureScope.FindIdentifier(const Identifier: String
  3085. ): TPasIdentifier;
  3086. begin
  3087. Result:=inherited FindIdentifier(Identifier);
  3088. if (Result<>nil) or (GroupScope=nil) then exit;
  3089. Result:=GroupScope.FindIdentifier(Identifier);
  3090. end;
  3091. procedure TPasProcedureScope.IterateElements(const aName: string;
  3092. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3093. Data: Pointer; var Abort: boolean);
  3094. begin
  3095. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3096. if Abort then exit;
  3097. if GroupScope=nil then exit;
  3098. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3099. end;
  3100. function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
  3101. var
  3102. Proc: TPasProcedure;
  3103. El: TPasElement;
  3104. begin
  3105. Result:=Self;
  3106. repeat
  3107. if Result.ClassRecScope<>nil then exit;
  3108. Proc:=TPasProcedure(Result.Element);
  3109. El:=Proc.Parent;
  3110. repeat
  3111. if El=nil then exit(nil);
  3112. if El is TProcedureBody then break;
  3113. El:=El.Parent;
  3114. until false;
  3115. Proc:=El.Parent as TPasProcedure;
  3116. Result:=TPasProcedureScope(Proc.CustomData);
  3117. until false;
  3118. end;
  3119. procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
  3120. begin
  3121. inherited WriteIdentifiers(Prefix);
  3122. if GroupScope<>nil then
  3123. GroupScope.WriteIdentifiers(Prefix+'GS ');
  3124. end;
  3125. destructor TPasProcedureScope.Destroy;
  3126. begin
  3127. {$IFDEF VerbosePasResolverMem}
  3128. writeln('TPasProcedureScope.Destroy START ',ClassName);
  3129. {$ENDIF}
  3130. FreeAndNil(References);
  3131. FreeAndNil(GroupScope);
  3132. inherited Destroy;
  3133. ReleaseAndNil(TPasElement(SelfArg){$IFDEF CheckPasTreeRefCount},'TPasProcedureScope.SelfArg'{$ENDIF});
  3134. {$IFDEF VerbosePasResolverMem}
  3135. writeln('TPasProcedureScope.Destroy END ',ClassName);
  3136. {$ENDIF}
  3137. end;
  3138. function TPasProcedureScope.AddReference(El: TPasElement; Access: TPSRefAccess
  3139. ): TPasScopeReference;
  3140. begin
  3141. if References=nil then
  3142. References:=TPasScopeReferences.Create(Self);
  3143. Result:=References.Add(El,Access);
  3144. end;
  3145. function TPasProcedureScope.GetReferences: TFPList;
  3146. begin
  3147. if References=nil then
  3148. Result:=TFPList.Create
  3149. else
  3150. Result:=References.GetList;
  3151. end;
  3152. { TPasClassScope }
  3153. destructor TPasClassScope.Destroy;
  3154. var
  3155. i: Integer;
  3156. o: TObject;
  3157. begin
  3158. if Interfaces<>nil then
  3159. begin
  3160. for i:=0 to Interfaces.Count-1 do
  3161. begin
  3162. o:=TObject(Interfaces[i]);
  3163. if o=nil then
  3164. else if o is TPasProperty then
  3165. else if o is TPasClassIntfMap then
  3166. o.Free
  3167. else
  3168. raise Exception.Create('[20180322132757] '+GetElementDbgPath(Element)+' i='+IntToStr(i)+' '+GetObjName(o));
  3169. end;
  3170. FreeAndNil(Interfaces);
  3171. end;
  3172. if CanonicalClassOf<>nil then
  3173. begin
  3174. CanonicalClassOf.Parent:=nil;
  3175. ReleaseAndNil(TPasElement(CanonicalClassOf){$IFDEF CheckPasTreeRefCount},'TPasClassScope.CanonicalClassOf'{$ENDIF});
  3176. end;
  3177. inherited Destroy;
  3178. end;
  3179. { TPasIdentifier }
  3180. procedure TPasIdentifier.SetElement(AValue: TPasElement);
  3181. begin
  3182. if FElement=AValue then Exit;
  3183. if Element<>nil then
  3184. Element.Release{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3185. FElement:=AValue;
  3186. if Element<>nil then
  3187. Element.AddRef{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3188. end;
  3189. destructor TPasIdentifier.Destroy;
  3190. begin
  3191. {$IFDEF VerbosePasResolverMem}
  3192. writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
  3193. {$ENDIF}
  3194. Element:=nil;
  3195. inherited Destroy;
  3196. {$IFDEF VerbosePasResolverMem}
  3197. writeln('TPasIdentifier.Destroy END ',ClassName);
  3198. {$ENDIF}
  3199. end;
  3200. { EPasResolve }
  3201. procedure EPasResolve.SetPasElement(AValue: TPasElement);
  3202. begin
  3203. if FPasElement=AValue then Exit;
  3204. if PasElement<>nil then
  3205. PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3206. FPasElement:=AValue;
  3207. if PasElement<>nil then
  3208. PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3209. end;
  3210. destructor EPasResolve.Destroy;
  3211. begin
  3212. {$IFDEF VerbosePasResolverMem}
  3213. writeln('EPasResolve.Destroy START ',ClassName);
  3214. {$ENDIF}
  3215. PasElement:=nil;
  3216. inherited Destroy;
  3217. {$IFDEF VerbosePasResolverMem}
  3218. writeln('EPasResolve.Destroy END ',ClassName);
  3219. {$ENDIF}
  3220. end;
  3221. { TResolvedReference }
  3222. procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
  3223. begin
  3224. if FDeclaration=AValue then Exit;
  3225. if Declaration<>nil then
  3226. Declaration.Release{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3227. FDeclaration:=AValue;
  3228. if Declaration<>nil then
  3229. Declaration.AddRef{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3230. end;
  3231. destructor TResolvedReference.Destroy;
  3232. begin
  3233. {$IFDEF VerbosePasResolverMem}
  3234. writeln('TResolvedReference.Destroy START ',ClassName);
  3235. {$ENDIF}
  3236. Declaration:=nil;
  3237. FreeAndNil(Context);
  3238. inherited Destroy;
  3239. {$IFDEF VerbosePasResolverMem}
  3240. writeln('TResolvedReference.Destroy END ',ClassName);
  3241. {$ENDIF}
  3242. end;
  3243. { TPasSubExprScope }
  3244. class function TPasSubExprScope.IsStoredInElement: boolean;
  3245. begin
  3246. Result:=false;
  3247. end;
  3248. { TPasModuleDotScope }
  3249. procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
  3250. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3251. var
  3252. FilterData: PPasIterateFilterData absolute Data;
  3253. begin
  3254. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3255. exit; // skip used units
  3256. // call the original iterator
  3257. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3258. end;
  3259. procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
  3260. begin
  3261. if FModule=AValue then Exit;
  3262. if Module<>nil then
  3263. Module.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3264. FModule:=AValue;
  3265. if Module<>nil then
  3266. Module.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3267. end;
  3268. destructor TPasModuleDotScope.Destroy;
  3269. begin
  3270. {$IFDEF VerbosePasResolverMem}
  3271. writeln('TPasSubModuleScope.Destroy START ',ClassName);
  3272. {$ENDIF}
  3273. Module:=nil;
  3274. inherited Destroy;
  3275. {$IFDEF VerbosePasResolverMem}
  3276. writeln('TPasSubModuleScope.Destroy END ',ClassName);
  3277. {$ENDIF}
  3278. end;
  3279. function TPasModuleDotScope.FindIdentifier(const Identifier: String
  3280. ): TPasIdentifier;
  3281. function Find(Scope: TPasIdentifierScope): boolean;
  3282. var
  3283. Found: TPasIdentifier;
  3284. C: TClass;
  3285. begin
  3286. if Scope=nil then exit(false);
  3287. Found:=Scope.FindLocalIdentifier(Identifier);
  3288. FindIdentifier:=Found;
  3289. if Found=nil then exit(false);
  3290. C:=Found.Element.ClassType;
  3291. Result:=(C<>TPasModule) and (C<>TPasUsesUnit);
  3292. end;
  3293. begin
  3294. Result:=nil;
  3295. if Find(ImplementationScope) then exit;
  3296. if Find(InterfaceScope) then exit;
  3297. Find(SystemScope);
  3298. end;
  3299. procedure TPasModuleDotScope.IterateElements(const aName: string;
  3300. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3301. Data: Pointer; var Abort: boolean);
  3302. var
  3303. FilterData: TPasIterateFilterData;
  3304. function Iterate(Scope: TPasIdentifierScope): boolean;
  3305. begin
  3306. if Scope=nil then exit(false);
  3307. Scope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3308. Result:=Abort;
  3309. end;
  3310. begin
  3311. FilterData.OnIterate:=OnIterateElement;
  3312. FilterData.Data:=Data;
  3313. if Iterate(ImplementationScope) then exit;
  3314. if Iterate(InterfaceScope) then exit;
  3315. Iterate(SystemScope);
  3316. end;
  3317. procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
  3318. begin
  3319. if ImplementationScope<>nil then
  3320. ImplementationScope.WriteIdentifiers(Prefix+' ');
  3321. if InterfaceScope<>nil then
  3322. InterfaceScope.WriteIdentifiers(Prefix+' ');
  3323. if SystemScope<>nil then
  3324. SystemScope.WriteIdentifiers(Prefix+' ');
  3325. end;
  3326. { TPasSectionScope }
  3327. procedure TPasSectionScope.OnInternalIterate(El: TPasElement; ElScope,
  3328. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3329. var
  3330. FilterData: PPasIterateFilterData absolute Data;
  3331. begin
  3332. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3333. exit; // skip used units
  3334. // call the original iterator
  3335. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3336. end;
  3337. constructor TPasSectionScope.Create;
  3338. begin
  3339. inherited Create;
  3340. UsesScopes:=TFPList.Create;
  3341. end;
  3342. destructor TPasSectionScope.Destroy;
  3343. begin
  3344. {$IFDEF VerbosePasResolverMem}
  3345. writeln('TPasSectionScope.Destroy START ',ClassName);
  3346. {$ENDIF}
  3347. ClearHelperList(Helpers);
  3348. FreeAndNil(UsesScopes);
  3349. inherited Destroy;
  3350. {$IFDEF VerbosePasResolverMem}
  3351. writeln('TPasSectionScope.Destroy END ',ClassName);
  3352. {$ENDIF}
  3353. end;
  3354. function TPasSectionScope.FindIdentifier(const Identifier: String
  3355. ): TPasIdentifier;
  3356. var
  3357. i: Integer;
  3358. UsesScope: TPasIdentifierScope;
  3359. C: TClass;
  3360. begin
  3361. Result:=inherited FindIdentifier(Identifier);
  3362. if Result<>nil then
  3363. exit;
  3364. for i:=UsesScopes.Count-1 downto 0 do
  3365. begin
  3366. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3367. {$IFDEF VerbosePasResolver}
  3368. writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
  3369. {$ENDIF}
  3370. Result:=UsesScope.FindLocalIdentifier(Identifier);
  3371. if Result<>nil then
  3372. begin
  3373. C:=Result.Element.ClassType;
  3374. if (C<>TPasModule) and (C<>TPasUsesUnit) then
  3375. exit;
  3376. end;
  3377. end;
  3378. end;
  3379. procedure TPasSectionScope.IterateElements(const aName: string;
  3380. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3381. Data: Pointer; var Abort: boolean);
  3382. var
  3383. i: Integer;
  3384. UsesScope: TPasSectionScope;
  3385. FilterData: TPasIterateFilterData;
  3386. begin
  3387. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3388. if Abort then exit;
  3389. FilterData.OnIterate:=OnIterateElement;
  3390. FilterData.Data:=Data;
  3391. for i:=UsesScopes.Count-1 downto 0 do
  3392. begin
  3393. UsesScope:=TPasSectionScope(UsesScopes[i]);
  3394. {$IFDEF VerbosePasResolver}
  3395. writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',UsesScope.Element.ParentPath,':',GetObjName(UsesScope.Element));
  3396. {$ENDIF}
  3397. UsesScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3398. if Abort then exit;
  3399. end;
  3400. end;
  3401. procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
  3402. var
  3403. i: Integer;
  3404. UsesScope: TPasIdentifierScope;
  3405. SubPrefix: String;
  3406. begin
  3407. {AllowWriteln}
  3408. inherited WriteIdentifiers(Prefix);
  3409. SubPrefix:=Prefix+' ';
  3410. for i:=UsesScopes.Count-1 downto 0 do
  3411. begin
  3412. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3413. writeln(Prefix+' Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
  3414. UsesScope.FItems.ForEachCall(@OnWriteItem,Pointer(SubPrefix));
  3415. end;
  3416. {AllowWriteln-}
  3417. end;
  3418. { TPasModuleScope }
  3419. procedure TPasModuleScope.SetAssertClass(const AValue: TPasClassType);
  3420. begin
  3421. if FAssertClass=AValue then Exit;
  3422. if FAssertClass<>nil then
  3423. FAssertClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3424. FAssertClass:=AValue;
  3425. if FAssertClass<>nil then
  3426. FAssertClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3427. end;
  3428. procedure TPasModuleScope.SetAssertDefConstructor(const AValue: TPasConstructor
  3429. );
  3430. begin
  3431. if FAssertDefConstructor=AValue then Exit;
  3432. if FAssertDefConstructor<>nil then
  3433. FAssertDefConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3434. FAssertDefConstructor:=AValue;
  3435. if FAssertDefConstructor<>nil then
  3436. FAssertDefConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3437. end;
  3438. procedure TPasModuleScope.SetAssertMsgConstructor(const AValue: TPasConstructor
  3439. );
  3440. begin
  3441. if FAssertMsgConstructor=AValue then Exit;
  3442. if FAssertMsgConstructor<>nil then
  3443. FAssertMsgConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3444. FAssertMsgConstructor:=AValue;
  3445. if FAssertMsgConstructor<>nil then
  3446. FAssertMsgConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3447. end;
  3448. procedure TPasModuleScope.SetRangeErrorClass(const AValue: TPasClassType);
  3449. begin
  3450. if FRangeErrorClass=AValue then Exit;
  3451. if FRangeErrorClass<>nil then
  3452. FRangeErrorClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3453. FRangeErrorClass:=AValue;
  3454. if FRangeErrorClass<>nil then
  3455. FRangeErrorClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3456. end;
  3457. procedure TPasModuleScope.SetRangeErrorConstructor(const AValue: TPasConstructor
  3458. );
  3459. begin
  3460. if FRangeErrorConstructor=AValue then Exit;
  3461. if FRangeErrorConstructor<>nil then
  3462. FRangeErrorConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3463. FRangeErrorConstructor:=AValue;
  3464. if FRangeErrorConstructor<>nil then
  3465. FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3466. end;
  3467. procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
  3468. begin
  3469. if FSystemTVarRec=AValue then Exit;
  3470. if FSystemTVarRec<>nil then
  3471. FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3472. FSystemTVarRec:=AValue;
  3473. if FSystemTVarRec<>nil then
  3474. FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3475. end;
  3476. constructor TPasModuleScope.Create;
  3477. begin
  3478. inherited Create;
  3479. PendingResolvers:=TFPList.Create;
  3480. end;
  3481. destructor TPasModuleScope.Destroy;
  3482. begin
  3483. AssertClass:=nil;
  3484. AssertDefConstructor:=nil;
  3485. AssertMsgConstructor:=nil;
  3486. RangeErrorClass:=nil;
  3487. RangeErrorConstructor:=nil;
  3488. SystemTVarRec:=nil;
  3489. FreeAndNil(PendingResolvers);
  3490. inherited Destroy;
  3491. end;
  3492. procedure TPasModuleScope.IterateElements(const aName: string;
  3493. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3494. Data: Pointer; var Abort: boolean);
  3495. begin
  3496. if CompareText(aName,FirstName)<>0 then exit;
  3497. OnIterateElement(Element,Self,StartScope,Data,Abort);
  3498. end;
  3499. { TPasDefaultScope }
  3500. class function TPasDefaultScope.IsStoredInElement: boolean;
  3501. begin
  3502. Result:=false;
  3503. end;
  3504. { TPasScope }
  3505. class function TPasScope.IsStoredInElement: boolean;
  3506. begin
  3507. Result:=true;
  3508. end;
  3509. class function TPasScope.FreeOnPop: boolean;
  3510. begin
  3511. Result:=not IsStoredInElement;
  3512. end;
  3513. procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
  3514. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  3515. var Abort: boolean);
  3516. begin
  3517. if aName='' then ;
  3518. if StartScope=nil then ;
  3519. if Data=nil then ;
  3520. if OnIterateElement=nil then ;
  3521. if Abort then ;
  3522. end;
  3523. procedure TPasScope.WriteIdentifiers(Prefix: string);
  3524. begin
  3525. {AllowWriteln}
  3526. writeln(Prefix,'(',ClassName,') Element: ',GetObjName(Element));
  3527. {AllowWriteln-}
  3528. end;
  3529. { TPasIdentifierScope }
  3530. // inline
  3531. function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
  3532. ): TPasIdentifier;
  3533. begin
  3534. Result:=TPasIdentifier(FItems.Find(lowercase(Identifier)));
  3535. end;
  3536. procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
  3537. var
  3538. PasIdentifier: TPasIdentifier absolute Item;
  3539. Ident: TPasIdentifier;
  3540. begin
  3541. if Dummy=nil then ;
  3542. //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  3543. while PasIdentifier<>nil do
  3544. begin
  3545. Ident:=PasIdentifier;
  3546. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  3547. Ident.Free;
  3548. end;
  3549. end;
  3550. procedure TPasIdentifierScope.OnCollectItem(Item, List: pointer);
  3551. var
  3552. PasIdentifier: TPasIdentifier absolute Item;
  3553. FPList: TFPList absolute List;
  3554. begin
  3555. FPList.Add(PasIdentifier);
  3556. end;
  3557. procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
  3558. var
  3559. PasIdentifier: TPasIdentifier absolute Item;
  3560. Prefix: String;
  3561. begin
  3562. {AllowWriteln}
  3563. Prefix:=String(Dummy);
  3564. while PasIdentifier<>nil do
  3565. begin
  3566. writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
  3567. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  3568. end;
  3569. {AllowWriteln-}
  3570. end;
  3571. procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
  3572. var
  3573. OldItem: TPasIdentifier;
  3574. LoName: string;
  3575. {$ifdef pas2js}
  3576. {$ELSE}
  3577. Index: Integer;
  3578. {$ENDIF}
  3579. begin
  3580. LoName:=lowercase(Item.Identifier);
  3581. {$ifdef pas2js}
  3582. OldItem:=TPasIdentifier(FItems.Find(LoName));
  3583. if OldItem<>nil then
  3584. begin
  3585. // insert LIFO - last in, first out
  3586. Item.NextSameIdentifier:=OldItem;
  3587. end;
  3588. FItems.Add(LoName,Item);
  3589. {$IFDEF VerbosePasResolver}
  3590. if Item.Owner<>nil then
  3591. raise Exception.Create('20160925184110');
  3592. Item.Owner:=Self;
  3593. {$ENDIF}
  3594. {$IFDEF VerbosePasResolver}
  3595. if FindIdentifier(Item.Identifier)<>Item then
  3596. raise Exception.Create('20181018173201');
  3597. {$ENDIF}
  3598. {$else}
  3599. Index:=FItems.FindIndexOf(LoName);
  3600. {$IFDEF VerbosePasResolver}
  3601. if Item.Owner<>nil then
  3602. raise Exception.Create('20160925184110');
  3603. Item.Owner:=Self;
  3604. {$ENDIF}
  3605. //writeln(' Index=',Index);
  3606. if Index>=0 then
  3607. begin
  3608. // insert LIFO - last in, first out
  3609. OldItem:=TPasIdentifier(FItems.List^[Index].Data);
  3610. {$IFDEF VerbosePasResolver}
  3611. if lowercase(OldItem.Identifier)<>LoName then
  3612. raise Exception.Create('20160925183438');
  3613. {$ENDIF}
  3614. Item.NextSameIdentifier:=OldItem;
  3615. FItems.List^[Index].Data:=Item;
  3616. end
  3617. else
  3618. begin
  3619. FItems.Add(LoName, Item);
  3620. {$IFDEF VerbosePasResolver}
  3621. if FindIdentifier(Item.Identifier)<>Item then
  3622. raise Exception.Create('20160925183849');
  3623. {$ENDIF}
  3624. end;
  3625. {$endif}
  3626. end;
  3627. constructor TPasIdentifierScope.Create;
  3628. begin
  3629. FItems:=TPasResHashList.Create;
  3630. end;
  3631. destructor TPasIdentifierScope.Destroy;
  3632. begin
  3633. {$IFDEF VerbosePasResolverMem}
  3634. writeln('TPasIdentifierScope.Destroy START ',ClassName);
  3635. {$ENDIF}
  3636. FItems.ForEachCall(@OnClearItem,nil);
  3637. {$ifdef pas2js}
  3638. FItems:=nil;
  3639. {$else}
  3640. FItems.Clear;
  3641. FreeAndNil(FItems);
  3642. {$endif}
  3643. inherited Destroy;
  3644. {$IFDEF VerbosePasResolverMem}
  3645. writeln('TPasIdentifierScope.Destroy END ',ClassName);
  3646. {$ENDIF}
  3647. end;
  3648. function TPasIdentifierScope.FindIdentifier(const Identifier: String
  3649. ): TPasIdentifier;
  3650. begin
  3651. Result:=FindLocalIdentifier(Identifier);
  3652. {$IFDEF VerbosePasResolver}
  3653. {AllowWriteln}
  3654. if (Result<>nil) and (Result.Owner<>Self) then
  3655. begin
  3656. writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  3657. raise Exception.Create('20160925184159');
  3658. end;
  3659. {AllowWriteln-}
  3660. {$ENDIF}
  3661. end;
  3662. function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
  3663. var
  3664. Identifier, PrevIdentifier: TPasIdentifier;
  3665. LoName: string;
  3666. begin
  3667. LoName:=lowercase(El.Name);
  3668. Identifier:=TPasIdentifier(FItems.Find(LoName));
  3669. FindLocalIdentifier(El.Name);
  3670. PrevIdentifier:=nil;
  3671. Result:=false;
  3672. while Identifier<>nil do
  3673. begin
  3674. {$IFDEF VerbosePasResolver}
  3675. if (Identifier.Owner<>Self) then
  3676. raise Exception.Create('20160925184159');
  3677. {$ENDIF}
  3678. if Identifier.Element=El then
  3679. begin
  3680. if PrevIdentifier<>nil then
  3681. begin
  3682. PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
  3683. Identifier.Free;
  3684. Identifier:=PrevIdentifier.NextSameIdentifier;
  3685. end
  3686. else
  3687. begin
  3688. FItems.Remove({$ifdef pas2js}LoName{$else}Identifier{$endif});
  3689. PrevIdentifier:=Identifier;
  3690. Identifier:=Identifier.NextSameIdentifier;
  3691. PrevIdentifier.Free;
  3692. PrevIdentifier:=nil;
  3693. if Identifier<>nil then
  3694. FItems.Add(LoName,Identifier);
  3695. end;
  3696. Result:=true;
  3697. continue;
  3698. end;
  3699. PrevIdentifier:=Identifier;
  3700. Identifier:=Identifier.NextSameIdentifier;
  3701. end;
  3702. end;
  3703. function TPasIdentifierScope.AddIdentifier(const Identifier: String;
  3704. El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
  3705. var
  3706. Item: TPasIdentifier;
  3707. begin
  3708. //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
  3709. Item:=TPasIdentifier.Create;
  3710. Item.Identifier:=Identifier;
  3711. Item.Element:=El;
  3712. Item.Kind:=Kind;
  3713. InternalAdd(Item);
  3714. //writeln('TPasIdentifierScope.AddIdentifier END');
  3715. Result:=Item;
  3716. end;
  3717. function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
  3718. var
  3719. Item: TPasIdentifier;
  3720. begin
  3721. //writeln('TPasIdentifierScope.FindElement "',aName,'"');
  3722. Item:=FindIdentifier(aName);
  3723. if Item=nil then
  3724. Result:=nil
  3725. else
  3726. Result:=Item.Element;
  3727. //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
  3728. end;
  3729. procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
  3730. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3731. Data: Pointer; var Abort: boolean);
  3732. var
  3733. Item: TPasIdentifier;
  3734. {$IFDEF VerbosePasResolver}
  3735. OldElement: TPasElement;
  3736. {$ENDIF}
  3737. begin
  3738. Item:=FindLocalIdentifier(aName);
  3739. while Item<>nil do
  3740. begin
  3741. //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
  3742. {$IFDEF VerbosePasResolver}
  3743. OldElement:=Item.Element;
  3744. {$ENDIF}
  3745. OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
  3746. {$IFDEF VerbosePasResolver}
  3747. if OldElement<>Item.Element then
  3748. raise Exception.Create('20160925183503');
  3749. {$ENDIF}
  3750. if Abort then exit;
  3751. Item:=Item.NextSameIdentifier;
  3752. end;
  3753. end;
  3754. procedure TPasIdentifierScope.IterateElements(const aName: string;
  3755. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3756. Data: Pointer; var Abort: boolean);
  3757. begin
  3758. IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
  3759. end;
  3760. procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
  3761. begin
  3762. inherited WriteIdentifiers(Prefix);
  3763. WriteLocalIdentifiers(Prefix+' ');
  3764. end;
  3765. procedure TPasIdentifierScope.WriteLocalIdentifiers(Prefix: string);
  3766. begin
  3767. FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
  3768. end;
  3769. function TPasIdentifierScope.GetLocalIdentifiers: TFPList;
  3770. begin
  3771. Result:=TFPList.Create;
  3772. FItems.ForEachCall(@OnCollectItem,Result);
  3773. end;
  3774. { TPasResolver }
  3775. // inline
  3776. function TPasResolver.GetBaseTypes(bt: TResolverBaseType
  3777. ): TPasUnresolvedSymbolRef;
  3778. begin
  3779. Result:=FBaseTypes[bt];
  3780. end;
  3781. // inline
  3782. function TPasResolver.GetScopes(Index: integer): TPasScope;
  3783. begin
  3784. Result:=FScopes[Index];
  3785. end;
  3786. // inline
  3787. function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
  3788. begin
  3789. Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
  3790. end;
  3791. function TPasResolver.GetNameExprValue(El: TPasExpr): string;
  3792. begin
  3793. if El=nil then
  3794. Result:=''
  3795. else if El.ClassType=TPrimitiveExpr then
  3796. begin
  3797. if TPrimitiveExpr(El).Kind=pekIdent then
  3798. Result:=TPrimitiveExpr(El).Value
  3799. else
  3800. Result:='';
  3801. end
  3802. else
  3803. Result:='';
  3804. end;
  3805. function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
  3806. // returns TPrimitiveExpr (Kind=pekIdent)
  3807. var
  3808. Bin: TBinaryExpr;
  3809. C: TClass;
  3810. begin
  3811. Result:=nil;
  3812. if El=nil then exit;
  3813. repeat
  3814. if not (El.Parent is TBinaryExpr) then exit;
  3815. Bin:=TBinaryExpr(El.Parent);
  3816. if Bin.OpCode<>eopSubIdent then exit;
  3817. if El=Bin.right then
  3818. El:=Bin
  3819. else
  3820. begin
  3821. El:=Bin.right;
  3822. // find left most
  3823. repeat
  3824. C:=El.ClassType;
  3825. if C=TPrimitiveExpr then
  3826. begin
  3827. if TPrimitiveExpr(El).Kind<>pekIdent then
  3828. RaiseNotYetImplemented(20170502163825,El);
  3829. exit(El);
  3830. end
  3831. else if C=TBinaryExpr then
  3832. begin
  3833. if TBinaryExpr(El).OpCode<>eopSubIdent then
  3834. RaiseNotYetImplemented(20170502163718,El);
  3835. El:=TBinaryExpr(El).left;
  3836. end
  3837. else if C=TParamsExpr then
  3838. begin
  3839. if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
  3840. RaiseNotYetImplemented(20170502163908,El);
  3841. El:=TParamsExpr(El).Value;
  3842. end;
  3843. until El=nil;
  3844. RaiseNotYetImplemented(20170502163953,Bin);
  3845. end;
  3846. until false;
  3847. end;
  3848. function TPasResolver.GetLeftMostExpr(El: TPasExpr): TPasExpr;
  3849. var
  3850. C: TClass;
  3851. begin
  3852. Result:=El;
  3853. while Result<>nil do
  3854. begin
  3855. El:=Result;
  3856. C:=Result.ClassType;
  3857. if C=TBinaryExpr then
  3858. begin
  3859. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  3860. exit;
  3861. Result:=TBinaryExpr(Result).left;
  3862. end
  3863. else if C=TParamsExpr then
  3864. begin
  3865. if not (TParamsExpr(Result).Kind in [pekFuncParams,pekArrayParams]) then
  3866. exit;
  3867. Result:=TParamsExpr(Result).Value;
  3868. end
  3869. else
  3870. exit;
  3871. end;
  3872. end;
  3873. function TPasResolver.GetRightMostExpr(El: TPasExpr): TPasExpr;
  3874. var
  3875. C: TClass;
  3876. begin
  3877. Result:=El;
  3878. while Result<>nil do
  3879. begin
  3880. El:=Result;
  3881. C:=Result.ClassType;
  3882. if C=TBinaryExpr then
  3883. begin
  3884. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  3885. exit;
  3886. Result:=TBinaryExpr(Result).right;
  3887. end
  3888. else
  3889. exit;
  3890. end;
  3891. end;
  3892. function TPasResolver.GetParamsOfNameExpr(El: TPasExpr): TParamsExpr;
  3893. // Checks is El is the name expression of a call or array access
  3894. // For example: a.b.El() a.El[]
  3895. // Note: TPasParser guarantees that there is at most one TBinaryExpr between
  3896. // El and TParamsExpr
  3897. var
  3898. Parent: TPasElement;
  3899. begin
  3900. Result:=nil;
  3901. if not IsNameExpr(El) then exit;
  3902. Parent:=El.Parent;
  3903. if Parent is TBinaryExpr then
  3904. begin
  3905. if (TBinaryExpr(Parent).OpCode<>eopSubIdent)
  3906. or (TBinaryExpr(Parent).right<>El) then
  3907. exit;
  3908. El:=TBinaryExpr(Parent); // continue
  3909. Parent:=El.Parent;
  3910. end;
  3911. if (Parent is TParamsExpr) and (TParamsExpr(Parent).Value=El) then
  3912. exit(TParamsExpr(Parent)); // params found
  3913. end;
  3914. function TPasResolver.GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  3915. var
  3916. Value: TResEvalValue;
  3917. begin
  3918. if not (InFileExpr is TPrimitiveExpr) then
  3919. RaiseXExpectedButYFound(20180221234828,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  3920. Value:=ExprEvaluator.Eval(TPrimitiveExpr(InFileExpr),[refConst]);
  3921. try
  3922. if (Value=nil) then
  3923. RaiseXExpectedButYFound(20180222000004,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  3924. case Value.Kind of
  3925. {$ifdef FPC_HAS_CPSTRING}
  3926. revkString:
  3927. Result:=ExprEvaluator.GetUTF8Str(TResEvalString(Value).S,InFileExpr);
  3928. revkUnicodeString:
  3929. Result:=UTF8Encode(TResEvalUTF16(Value).S);
  3930. {$else}
  3931. revkUnicodeString:
  3932. Result:=TResEvalUTF16(Value).S;
  3933. {$endif}
  3934. else
  3935. RaiseXExpectedButYFound(20180222000122,'string literal',Value.AsDebugString,InFileExpr);
  3936. end;
  3937. finally
  3938. ReleaseEvalValue(Value);
  3939. end;
  3940. end;
  3941. function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
  3942. // get leftmost name element (e.g. TPrimitiveExpr)
  3943. // nil if not found
  3944. var
  3945. C: TClass;
  3946. begin
  3947. Result:=nil;
  3948. while El<>nil do
  3949. begin
  3950. C:=El.ClassType;
  3951. if C=TPrimitiveExpr then
  3952. exit(El)
  3953. else if C=TBinaryExpr then
  3954. begin
  3955. if TBinaryExpr(El).OpCode=eopSubIdent then
  3956. El:=TBinaryExpr(El).left
  3957. else
  3958. exit;
  3959. end
  3960. else if C=TParamsExpr then
  3961. El:=TParamsExpr(El).Value
  3962. else
  3963. exit;
  3964. end;
  3965. end;
  3966. function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  3967. // if the expression is a constructor newinstance call,
  3968. // return the element referring the constructor
  3969. // else nil
  3970. var
  3971. C: TClass;
  3972. begin
  3973. Result:=nil;
  3974. while El<>nil do
  3975. begin
  3976. if (El.CustomData is TResolvedReference)
  3977. and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
  3978. exit(El);
  3979. C:=El.ClassType;
  3980. if C=TBinaryExpr then
  3981. begin
  3982. if TBinaryExpr(El).OpCode=eopSubIdent then
  3983. El:=TBinaryExpr(El).right
  3984. else
  3985. exit;
  3986. end
  3987. else if C=TParamsExpr then
  3988. El:=TParamsExpr(El).Value
  3989. else
  3990. exit;
  3991. end;
  3992. end;
  3993. procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
  3994. var
  3995. El: TPasElement;
  3996. RData: TResolveData;
  3997. begin
  3998. // clear CustomData
  3999. while FLastCreatedData[Kind]<>nil do
  4000. begin
  4001. RData:=FLastCreatedData[Kind];
  4002. El:=RData.Element;
  4003. El.CustomData:=nil;
  4004. FLastCreatedData[Kind]:=RData.Next;
  4005. RData.Free;
  4006. end;
  4007. end;
  4008. function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
  4009. begin
  4010. if FBaseTypes[bt]<>nil then
  4011. Result:=FBaseTypes[bt].Name
  4012. else
  4013. Result:=ResBaseTypeNames[bt];
  4014. end;
  4015. function TPasResolver.GetBuiltInProcs(bp: TResolverBuiltInProc
  4016. ): TResElDataBuiltInProc;
  4017. begin
  4018. Result:=FBuiltInProcs[bp];
  4019. end;
  4020. procedure TPasResolver.SetRootElement(const AValue: TPasModule);
  4021. begin
  4022. if FRootElement=AValue then Exit;
  4023. FRootElement:=AValue;
  4024. end;
  4025. procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope,
  4026. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4027. var
  4028. Data: PPRFindData absolute FindFirstElementData;
  4029. ok: Boolean;
  4030. begin
  4031. ok:=true;
  4032. //writeln('TPasResolver.OnFindFirstElement ',El.PathName);
  4033. if (El is TPasProcedure)
  4034. and ProcNeedsParams(TPasProcedure(El).ProcType) then
  4035. // found a proc, but it needs parameters -> remember the first and continue
  4036. ok:=false;
  4037. if ok or (Data^.Found=nil) then
  4038. begin
  4039. Data^.Found:=El;
  4040. Data^.ElScope:=ElScope;
  4041. Data^.StartScope:=StartScope;
  4042. end;
  4043. if ok then
  4044. Abort:=true;
  4045. end;
  4046. procedure TPasResolver.OnFindFirst(El: TPasElement; ElScope,
  4047. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4048. var
  4049. Data: PPRFindData absolute FindFirstElementData;
  4050. begin
  4051. Data^.Found:=El;
  4052. Data^.ElScope:=ElScope;
  4053. Data^.StartScope:=StartScope;
  4054. Abort:=true;
  4055. end;
  4056. procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
  4057. StartScope: TPasScope; FindCallElData: Pointer; var Abort: boolean);
  4058. var
  4059. Data: PFindCallElData absolute FindCallElData;
  4060. Proc, PrevProc: TPasProcedure;
  4061. Distance: integer;
  4062. BuiltInProc: TResElDataBuiltInProc;
  4063. CandidateFound: Boolean;
  4064. VarType, TypeEl: TPasType;
  4065. C: TClass;
  4066. ProcScope: TPasProcedureScope;
  4067. begin
  4068. {$IFDEF VerbosePasResolver}
  4069. writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
  4070. {$ENDIF}
  4071. CandidateFound:=false;
  4072. if (El is TPasProcedure) then
  4073. begin
  4074. // identifier is a proc
  4075. Proc:=TPasProcedure(El);
  4076. PrevProc:=nil;
  4077. if Data^.Found=Proc then
  4078. begin
  4079. // this proc was already found. This happens when this is the forward
  4080. // declaration or a previously found implementation.
  4081. Data^.ElScope:=ElScope;
  4082. Data^.StartScope:=StartScope;
  4083. exit;
  4084. end;
  4085. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4086. if ProcScope.DeclarationProc<>nil then
  4087. begin
  4088. // this proc has a forward declaration -> use that instead
  4089. Proc:=ProcScope.DeclarationProc;
  4090. El:=Proc;
  4091. end;
  4092. if Data^.Found is TPasProcedure then
  4093. begin
  4094. // there is already a previous proc
  4095. PrevProc:=TPasProcedure(Data^.Found);
  4096. if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
  4097. begin
  4098. if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
  4099. begin
  4100. Abort:=true;
  4101. exit;
  4102. end;
  4103. end
  4104. else
  4105. begin
  4106. // mode objfpc
  4107. if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
  4108. // mode objfpc: procs in same context have implicit overload
  4109. else
  4110. begin
  4111. // mode objfpc, different context
  4112. if not ProcHasGroupOverload(Data^.LastProc) then
  4113. begin
  4114. Abort:=true;
  4115. exit;
  4116. end;
  4117. end;
  4118. end;
  4119. if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
  4120. and (PrevProc.Parent.ClassType=TPasClassType) then
  4121. begin
  4122. // there was already a perfect proc in a descendant
  4123. Abort:=true;
  4124. exit;
  4125. end;
  4126. // check if previous found proc is override of found proc
  4127. if IsProcOverride(Proc,PrevProc) then
  4128. begin
  4129. // previous found proc is override of found proc -> skip
  4130. exit;
  4131. end;
  4132. end;
  4133. if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
  4134. Abort:=true; // stop searching after this proc
  4135. CandidateFound:=true;
  4136. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4137. {$IFDEF VerbosePasResolver}
  4138. writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
  4139. ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',Data^.Distance,
  4140. ' Signature={',GetProcTypeDescription(Proc.ProcType,[prptdUseName,prptdAddPaths]),'}',
  4141. ' Abort=',Abort);
  4142. {$ENDIF}
  4143. Data^.LastProc:=Proc;
  4144. end
  4145. else if El is TPasType then
  4146. begin
  4147. TypeEl:=ResolveAliasType(TPasType(El));
  4148. C:=TypeEl.ClassType;
  4149. if C=TPasUnresolvedSymbolRef then
  4150. begin
  4151. if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
  4152. begin
  4153. // call of built-in proc
  4154. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  4155. if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
  4156. and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
  4157. begin
  4158. // str function can only be used within an expression
  4159. // str procedure can only be used outside an expression
  4160. {$IFDEF VerbosePasResolver}
  4161. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
  4162. {$ENDIF}
  4163. exit;
  4164. end;
  4165. Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
  4166. {$IFDEF VerbosePasResolver}
  4167. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
  4168. {$ENDIF}
  4169. CandidateFound:=true;
  4170. end
  4171. else if TypeEl.CustomData is TResElDataBaseType then
  4172. begin
  4173. // type cast to base type
  4174. Abort:=true; // can't be overloaded
  4175. if Data^.Found<>nil then exit;
  4176. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4177. {$IFDEF VerbosePasResolver}
  4178. writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
  4179. {$ENDIF}
  4180. CandidateFound:=true;
  4181. end;
  4182. end
  4183. else if (C=TPasClassType)
  4184. or (C=TPasClassOfType)
  4185. or (C=TPasPointerType)
  4186. or (C=TPasRecordType)
  4187. or (C=TPasEnumType)
  4188. or (C=TPasProcedureType)
  4189. or (C=TPasFunctionType)
  4190. or (C=TPasArrayType)
  4191. or (C=TPasRangeType) then
  4192. begin
  4193. // type cast to user type
  4194. Abort:=true; // can't be overloaded
  4195. if Data^.Found<>nil then exit;
  4196. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4197. {$IFDEF VerbosePasResolver}
  4198. writeln('TPasResolver.OnFindCallElements type cast to =',GetObjName(El),' Distance=',Distance);
  4199. {$ENDIF}
  4200. CandidateFound:=true;
  4201. end;
  4202. end
  4203. else if El is TPasVariable then
  4204. begin
  4205. Abort:=true; // can't be overloaded
  4206. if Data^.Found<>nil then exit;
  4207. if El.ClassType=TPasProperty then
  4208. VarType:=GetPasPropertyType(TPasProperty(El))
  4209. else
  4210. VarType:=TPasVariable(El).VarType;
  4211. VarType:=ResolveAliasType(VarType);
  4212. if VarType is TPasProcedureType then
  4213. begin
  4214. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4215. {$IFDEF VerbosePasResolver}
  4216. writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
  4217. {$ENDIF}
  4218. CandidateFound:=true;
  4219. end;
  4220. end
  4221. else if El.ClassType=TPasArgument then
  4222. begin
  4223. Abort:=true; // can't be overloaded
  4224. if Data^.Found<>nil then exit;
  4225. VarType:=ResolveAliasType(TPasArgument(El).ArgType);
  4226. if VarType is TPasProcedureType then
  4227. begin
  4228. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4229. {$IFDEF VerbosePasResolver}
  4230. writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
  4231. {$ENDIF}
  4232. CandidateFound:=true;
  4233. end;
  4234. end;
  4235. if not CandidateFound then
  4236. begin
  4237. // El does not support the () operator
  4238. Abort:=true;
  4239. if Data^.Found=nil then
  4240. begin
  4241. // El is the first element found -> raise error
  4242. // ToDo: use the ( as error position
  4243. RaiseMsg(20170216151525,nIllegalQualifierAfter,sIllegalQualifierAfter,
  4244. ['(',El.ElementTypeName],Data^.Params);
  4245. end;
  4246. exit;
  4247. end;
  4248. // El is a candidate (might be incompatible)
  4249. if (Data^.Found=nil)
  4250. or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
  4251. begin
  4252. {$IFDEF VerbosePasResolver}
  4253. writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
  4254. {$ENDIF}
  4255. Data^.Found:=El;
  4256. Data^.ElScope:=ElScope;
  4257. Data^.StartScope:=StartScope;
  4258. Data^.Distance:=Distance;
  4259. Data^.Count:=1;
  4260. if Data^.List<>nil then
  4261. begin
  4262. Data^.List.Clear;
  4263. Data^.List.Add(El);
  4264. end;
  4265. end
  4266. else if Distance=cIncompatible then
  4267. // another candidate, but it is incompatible -> ignore
  4268. {$IFDEF VerbosePasResolver}
  4269. writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
  4270. {$ENDIF}
  4271. else if (Data^.Distance=Distance)
  4272. or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)
  4273. and ((Distance>=cIntToFloatConversion)=(Data^.Distance>=cIntToFloatConversion))) then
  4274. begin
  4275. // found another similar compatible one -> collect
  4276. // Note: cLossyConversion is better than cIntToFloatConversion, not similar
  4277. {$IFDEF VerbosePasResolver}
  4278. writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
  4279. {$ENDIF}
  4280. inc(Data^.Count);
  4281. if (Data^.List<>nil) then
  4282. begin
  4283. if (Data^.List.IndexOf(El)>=0) then
  4284. begin
  4285. {$IFDEF VerbosePasResolver}
  4286. writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
  4287. ' ',GetElementSourcePosStr(El),
  4288. ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
  4289. ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
  4290. );
  4291. {$ENDIF}
  4292. RaiseInternalError(20160924230805);
  4293. end;
  4294. Data^.List.Add(El);
  4295. end;
  4296. end
  4297. else if (Distance<Data^.Distance) then
  4298. begin
  4299. // found a better one
  4300. {$IFDEF VerbosePasResolver}
  4301. writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4302. {$ENDIF}
  4303. if (Distance<cLossyConversion)
  4304. or ((Distance>=cIntToFloatConversion)<>(Data^.Distance>=cIntToFloatConversion)) then
  4305. begin
  4306. // found a good one
  4307. {$IFDEF VerbosePasResolver}
  4308. writeln('TPasResolver.OnFindCallElements Found a good candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4309. {$ENDIF}
  4310. Data^.Count:=1;
  4311. if Data^.List<>nil then
  4312. Data^.List.Clear;
  4313. end
  4314. else
  4315. begin
  4316. // found another lossy one
  4317. // -> collect them
  4318. {$IFDEF VerbosePasResolver}
  4319. writeln('TPasResolver.OnFindCallElements Found another lossy candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4320. {$ENDIF}
  4321. inc(Data^.Count);
  4322. end;
  4323. Data^.Found:=El;
  4324. Data^.ElScope:=ElScope;
  4325. Data^.StartScope:=StartScope;
  4326. Data^.Distance:=Distance;
  4327. if Data^.List<>nil then
  4328. Data^.List.Add(El);
  4329. end
  4330. else
  4331. begin
  4332. // found a worse one
  4333. end;
  4334. end;
  4335. procedure TPasResolver.OnFindProc(El: TPasElement; ElScope,
  4336. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  4337. var
  4338. Data: PFindProcData absolute FindProcData;
  4339. Proc: TPasProcedure;
  4340. Store, SameScope: Boolean;
  4341. ProcScope: TPasProcedureScope;
  4342. procedure CountProcInSameModule;
  4343. begin
  4344. inc(Data^.FoundInSameScope);
  4345. if Proc.IsOverload then
  4346. Data^.FoundOverloadModifier:=true;
  4347. end;
  4348. begin
  4349. //writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  4350. if not (El is TPasProcedure) then
  4351. begin
  4352. // identifier is not a proc
  4353. if (El is TPasVariable) then
  4354. begin
  4355. if TPasVariable(El).Visibility=visStrictPrivate then
  4356. exit; // not visible
  4357. if (TPasVariable(El).Visibility=visPrivate)
  4358. and (El.GetModule<>StartScope.Element.GetModule) then
  4359. exit; // not visible
  4360. end;
  4361. Data^.FoundNonProc:=El;
  4362. Abort:=true;
  4363. if (El.CustomData is TResElDataBuiltInProc) then
  4364. begin
  4365. if Data^.FoundOverloadModifier or Data^.Proc.IsOverload then
  4366. exit; // no hint
  4367. end;
  4368. case Data^.Kind of
  4369. fpkProc:
  4370. // proc hides a non proc
  4371. if (Data^.Proc.GetModule=El.GetModule) then
  4372. // forbidden within same module
  4373. RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
  4374. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
  4375. else
  4376. begin
  4377. // give a hint
  4378. if Data^.Proc.Parent is TPasMembersType then
  4379. begin
  4380. if El.Visibility=visStrictPrivate then
  4381. else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
  4382. else
  4383. LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
  4384. [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4385. end;
  4386. end;
  4387. fpkMethod:
  4388. // method hides a non proc
  4389. RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
  4390. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4391. end;
  4392. exit;
  4393. end;
  4394. // identifier is a proc
  4395. Proc:=TPasProcedure(El);
  4396. if El=Data^.Proc then
  4397. begin
  4398. // found itself -> this is normal when searching for overloads
  4399. CountProcInSameModule;
  4400. exit;
  4401. end;
  4402. {$IFDEF VerbosePasResolver}
  4403. writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
  4404. {$ENDIF}
  4405. Store:=CheckOverloadProcCompatibility(Data^.Proc,Proc);
  4406. if Data^.Kind=fpkSameSignature then
  4407. // finding a proc with same signature is enough, see above Data^.OnlyScope
  4408. else
  4409. begin
  4410. if Data^.Kind=fpkProc then
  4411. SameScope:=Data^.Proc.GetModule=Proc.GetModule
  4412. else
  4413. SameScope:=Data^.Proc.Parent=Proc.Parent;
  4414. if SameScope then
  4415. begin
  4416. // same scope
  4417. if (msObjfpc in CurrentParser.CurrentModeswitches) then
  4418. begin
  4419. if ProcHasGroupOverload(Data^.Proc) then
  4420. Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
  4421. else if ProcHasGroupOverload(Proc) then
  4422. Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
  4423. end;
  4424. if Store then
  4425. begin
  4426. // same scope, same signature
  4427. // Note: forward declaration was already handled in FinishProcedureHeader
  4428. RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
  4429. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4430. end
  4431. else
  4432. begin
  4433. // same scope, different signature
  4434. if (msDelphi in CurrentParser.CurrentModeswitches) then
  4435. begin
  4436. // Delphi does not allow different procs without 'overload' in a scope
  4437. if not Proc.IsOverload then
  4438. RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
  4439. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  4440. else if not Data^.Proc.IsOverload then
  4441. RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
  4442. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4443. end
  4444. else
  4445. begin
  4446. // ObjFPC allows different procs without 'overload' modifier
  4447. end;
  4448. CountProcInSameModule;
  4449. end;
  4450. end
  4451. else
  4452. begin
  4453. // different scopes
  4454. if Data^.Proc.IsOverride then
  4455. else if Data^.Proc.IsReintroduced then
  4456. else
  4457. begin
  4458. if Store
  4459. or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
  4460. and not ProcHasGroupOverload(Data^.Proc)) then
  4461. begin
  4462. if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
  4463. // give a hint, that method hides a virtual method in ancestor
  4464. LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
  4465. sMethodHidesMethodOfBaseType,
  4466. [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  4467. else
  4468. begin
  4469. // Delphi/FPC do not give a message when hiding a non virtual method
  4470. // -> emit Hint with other message id
  4471. if (Data^.Proc.Parent is TPasMembersType) then
  4472. begin
  4473. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4474. if (Proc.Visibility=visStrictPrivate)
  4475. or ((Proc.Visibility=visPrivate)
  4476. and (Proc.GetModule<>Data^.Proc.GetModule)) then
  4477. // a private private is hidden by definition -> no hint
  4478. else if (ProcScope.ImplProc<>nil) // not abstract, external
  4479. and (not ProcHasImplElements(ProcScope.ImplProc)) then
  4480. // hidden method has implementation, but no statements -> useless
  4481. // -> do not give a hint for hiding this useless method
  4482. // Note: if this happens in the same unit, the body was not yet parsed
  4483. else if (Proc is TPasConstructor)
  4484. and (Data^.Proc.ClassType=Proc.ClassType) then
  4485. // do not give a hint for hiding a constructor
  4486. else if Store then
  4487. begin
  4488. // method hides ancestor method with same signature
  4489. LogMsg(20190316152656,mtHint,
  4490. nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
  4491. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4492. end
  4493. else
  4494. begin
  4495. //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
  4496. LogMsg(20171118214523,mtHint,
  4497. nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
  4498. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  4499. end;
  4500. end;
  4501. end;
  4502. Abort:=true;
  4503. end;
  4504. end;
  4505. end;
  4506. end;
  4507. if Store then
  4508. begin
  4509. Data^.Found:=Proc;
  4510. Data^.ElScope:=ElScope;
  4511. Data^.StartScope:=StartScope;
  4512. Abort:=true;
  4513. end;
  4514. end;
  4515. function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
  4516. ): boolean;
  4517. begin
  4518. if ProcParentA=ProcParentB then exit(true);
  4519. if (ProcParentA.ClassType=TInterfaceSection) then
  4520. begin
  4521. if (ProcParentB.ClassType=TImplementationSection)
  4522. and (ProcParentB.Parent=ProcParentA.Parent) then
  4523. exit(true);
  4524. end
  4525. else if (ProcParentB.ClassType=TInterfaceSection) then
  4526. begin
  4527. if (ProcParentA.ClassType=TImplementationSection)
  4528. and (ProcParentA.Parent=ProcParentB.Parent) then
  4529. exit(true);
  4530. end;
  4531. Result:=false;
  4532. end;
  4533. function TPasResolver.FindProcSameSignature(const ProcName: string;
  4534. Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
  4535. ): TPasProcedure;
  4536. var
  4537. FindData: TFindProcData;
  4538. Abort: boolean;
  4539. begin
  4540. FindData:=Default(TFindProcData);
  4541. FindData.Proc:=Proc;
  4542. FindData.Args:=Proc.ProcType.Args;
  4543. FindData.Kind:=fpkSameSignature;
  4544. Abort:=false;
  4545. if OnlyLocal then
  4546. Scope.IterateLocalElements(ProcName,Scope,@OnFindProc,@FindData,Abort)
  4547. else
  4548. Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort);
  4549. Result:=FindData.Found;
  4550. end;
  4551. procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
  4552. var
  4553. Scanner: TPascalScanner;
  4554. begin
  4555. //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
  4556. if AValue=CurrentParser then exit;
  4557. Clear;
  4558. inherited SetCurrentParser(AValue);
  4559. if CurrentParser<>nil then
  4560. begin
  4561. CurrentParser.Options:=CurrentParser.Options+po_Resolver;
  4562. if CurrentParser.Scanner<>nil then
  4563. begin
  4564. Scanner:=CurrentParser.Scanner;
  4565. if (Scanner.OnWarnDirective=nil) then
  4566. Scanner.OnWarnDirective:=@ScannerWarnDirective;
  4567. Scanner.SetNonToken(tkself);
  4568. end;
  4569. end;
  4570. end;
  4571. procedure TPasResolver.ScannerWarnDirective(Sender: TObject;
  4572. Identifier: string; State: TWarnMsgState; var Handled: boolean);
  4573. var
  4574. MsgNumbers: TIntegerDynArray;
  4575. i: Integer;
  4576. begin
  4577. if not GetWarnIdentifierNumbers(Identifier,MsgNumbers) then exit;
  4578. Handled:=true;
  4579. for i:=0 to length(MsgNumbers)-1 do
  4580. TPascalScanner(Sender).WarnMsgState[MsgNumbers[i]]:=State;
  4581. end;
  4582. procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
  4583. AllowDescendants: boolean);
  4584. var
  4585. Scope: TPasScope;
  4586. begin
  4587. Scope:=TopScope;
  4588. if Scope=nil then
  4589. RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
  4590. if Scope.ClassType<>ExpectedClass then
  4591. if (not AllowDescendants) or (not Scope.InheritsFrom(ExpectedClass)) then
  4592. RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+Scope.ClassName);
  4593. end;
  4594. function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
  4595. const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
  4596. ): TPasIdentifier;
  4597. var
  4598. Group: TPasGroupScope;
  4599. Identifier, OlderIdentifier: TPasIdentifier;
  4600. OlderEl: TPasElement;
  4601. C: TClass;
  4602. i: Integer;
  4603. OtherScope: TPasIdentifierScope;
  4604. begin
  4605. if aName='' then exit(nil);
  4606. if Scope is TPasGroupScope then
  4607. begin
  4608. Group:=TPasGroupScope(Scope);
  4609. Scope:=Group.Scopes[0];
  4610. end
  4611. else
  4612. Group:=nil;
  4613. if (El.Visibility=visPublished) then
  4614. begin
  4615. C:=El.ClassType;
  4616. if (C=TPasProperty) or (C=TPasVariable) then
  4617. // Note: VarModifiers are not yet set
  4618. else if (C=TPasProcedure) or (C=TPasFunction) then
  4619. // ok
  4620. else
  4621. RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  4622. end;
  4623. if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty) then
  4624. begin
  4625. // check duplicate in ancestors and helpers
  4626. for i:=1 to Group.Count-1 do
  4627. begin
  4628. OtherScope:=Group.Scopes[i];
  4629. OlderIdentifier:=OtherScope.FindLocalIdentifier(aName);
  4630. while OlderIdentifier<>nil do
  4631. begin
  4632. OlderEl:=OlderIdentifier.Element;
  4633. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  4634. if OlderEl is TPasVariable then
  4635. begin
  4636. if TPasVariable(OlderEl).Visibility=visStrictPrivate then
  4637. continue; // OlderEl is hidden
  4638. if (TPasVariable(OlderEl).Visibility=visPrivate)
  4639. and (OlderEl.GetModule<>El.GetModule) then
  4640. continue; // OlderEl is hidden
  4641. end;
  4642. RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
  4643. [aName,GetElementSourcePosStr(OlderEl)],El);
  4644. end;
  4645. end;
  4646. end;
  4647. Identifier:=Scope.AddIdentifier(aName,El,Kind);
  4648. // check duplicate in current scope
  4649. OlderIdentifier:=Identifier.NextSameIdentifier;
  4650. if (OlderIdentifier<>nil) then
  4651. if (Identifier.Kind=pikSimple)
  4652. or (OlderIdentifier.Kind=pikSimple)
  4653. or (El.Visibility=visPublished) then
  4654. begin
  4655. if (OlderIdentifier.Element.ClassType=TPasEnumValue)
  4656. and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
  4657. // this enum was propagated from a sub type -> remove enum
  4658. Scope.RemoveLocalIdentifier(OlderIdentifier.Element);
  4659. if (El.Visibility=visPublished) and (El is TPasProcedure)
  4660. and (OlderIdentifier.Element is TPasProcedure) then
  4661. RaiseMsg(20190626175432,nDuplicatePublishedMethodXAtY,
  4662. sDuplicatePublishedMethodXAtY,
  4663. [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El)
  4664. else
  4665. RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
  4666. [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El);
  4667. end;
  4668. Result:=Identifier;
  4669. end;
  4670. procedure TPasResolver.FinishModule(CurModule: TPasModule);
  4671. var
  4672. CurModuleClass: TClass;
  4673. i: Integer;
  4674. ModScope: TPasModuleScope;
  4675. begin
  4676. {$IFDEF VerbosePasResolver}
  4677. writeln('TPasResolver.FinishModule START ',CurModule.Name);
  4678. {$ENDIF}
  4679. FStep:=prsFinishingModule;
  4680. CurModuleClass:=CurModule.ClassType;
  4681. ModScope:=CurModule.CustomData as TPasModuleScope;
  4682. if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
  4683. begin
  4684. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  4685. FindRangeErrorConstructors(CurModule);
  4686. end;
  4687. if (CurModuleClass=TPasProgram) then
  4688. begin
  4689. FinishSection(TPasProgram(CurModule).ProgramSection);
  4690. // resolve begin..end block
  4691. ResolveImplBlock(CurModule.InitializationSection);
  4692. end
  4693. else if (CurModuleClass=TPasLibrary) then
  4694. begin
  4695. FinishSection(TPasLibrary(CurModule).LibrarySection);
  4696. // resolve begin..end block
  4697. ResolveImplBlock(CurModule.InitializationSection);
  4698. end
  4699. else if (CurModuleClass=TPasModule) then
  4700. begin
  4701. // unit
  4702. FinishSection(CurModule.InterfaceSection);
  4703. FinishSection(CurModule.ImplementationSection);
  4704. if CurModule.FinalizationSection<>nil then
  4705. // finalization section finished -> resolve
  4706. ResolveImplBlock(CurModule.FinalizationSection);
  4707. if CurModule.InitializationSection<>nil then
  4708. // initialization section finished -> resolve
  4709. ResolveImplBlock(CurModule.InitializationSection);
  4710. end
  4711. else
  4712. RaiseInternalError(20160922163327); // unknown module
  4713. // check all methods have bodies
  4714. // and all forward classes and pointers are resolved
  4715. for i:=0 to FPendingForwardProcs.Count-1 do
  4716. CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
  4717. FPendingForwardProcs.Clear;
  4718. // close all sections
  4719. while (TopScope<>nil) and (TopScope.ClassType=ScopeClass_Section) do
  4720. PopScope;
  4721. CheckTopScope(FScopeClass_Module);
  4722. PopScope;
  4723. FStep:=prsFinishedModule;
  4724. if (CurrentParser<>nil) and (CurrentParser.Scanner<>nil) then
  4725. begin
  4726. CurrentParser.NextToken;
  4727. if CurrentParser.Scanner.CurToken<>tkEOF then
  4728. LogMsg(20180628131456,mtHint,nTextAfterFinalIgnored,sTextAfterFinalIgnored,
  4729. [],nil);
  4730. end;
  4731. {$IFDEF VerbosePasResolver}
  4732. writeln('TPasResolver.FinishModule END ',CurModule.Name);
  4733. {$ENDIF}
  4734. end;
  4735. procedure TPasResolver.FinishUsesClause;
  4736. var
  4737. Section, CurSection: TPasSection;
  4738. i, j: Integer;
  4739. PublicEl, UseModule: TPasElement;
  4740. Scope: TPasSectionScope;
  4741. UsesScope: TPasSectionScope;
  4742. UseUnit: TPasUsesUnit;
  4743. FirstName: String;
  4744. p: SizeInt;
  4745. OldIdentifier: TPasIdentifier;
  4746. IntfHelpers: TPRHelperEntryArray;
  4747. begin
  4748. CheckTopScope(ScopeClass_Section);
  4749. Scope:=TPasSectionScope(TopScope);
  4750. Section:=TPasSection(Scope.Element);
  4751. {$IFDEF VerbosePasResolver}
  4752. writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
  4753. {$ENDIF}
  4754. if Scope.UsesFinished then
  4755. RaiseInternalError(20180305145220);
  4756. Scope.UsesFinished:=true;
  4757. for i:=0 to Section.UsesList.Count-1 do
  4758. begin
  4759. UseUnit:=Section.UsesClause[i];
  4760. {$IFDEF VerbosePasResolver}
  4761. writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
  4762. {$ENDIF}
  4763. UseModule:=UseUnit.Module;
  4764. // check used unit
  4765. PublicEl:=nil;
  4766. if (UseModule.ClassType=TPasLibrary) then
  4767. PublicEl:=TPasLibrary(UseModule).LibrarySection
  4768. else if (UseModule.ClassType=TPasModule) then
  4769. PublicEl:=TPasModule(UseModule).InterfaceSection
  4770. else
  4771. RaiseXExpectedButYFound(20170503004803,'unit',GetElementTypeName(UseModule),UseUnit);
  4772. if PublicEl=nil then
  4773. RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
  4774. if PublicEl.CustomData=nil then
  4775. RaiseInternalError(20160922163358,'uses element has no resolver data: '
  4776. +UseUnit.Name+'->'+GetObjName(PublicEl));
  4777. if not (PublicEl.CustomData is TPasSectionScope) then
  4778. RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
  4779. +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
  4780. UsesScope:=TPasSectionScope(PublicEl.CustomData);
  4781. // check if module was already used by a different name
  4782. j:=i;
  4783. CurSection:=Section;
  4784. repeat
  4785. dec(j);
  4786. if j<0 then
  4787. begin
  4788. if CurSection.ClassType<>TImplementationSection then
  4789. break;
  4790. CurSection:=CurSection.GetModule.InterfaceSection;
  4791. if CurSection=nil then break;
  4792. j:=length(CurSection.UsesClause)-1;
  4793. if j<0 then break;
  4794. end;
  4795. if CurSection.UsesClause[j].Module=UseModule then
  4796. RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
  4797. [UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
  4798. until false;
  4799. // add full uses name
  4800. AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
  4801. // add scope
  4802. {$IFDEF VerbosePasResolver}
  4803. writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
  4804. {$ENDIF}
  4805. Scope.UsesScopes.Add(UsesScope);
  4806. // add helpers
  4807. IntfHelpers:=UsesScope.Helpers;
  4808. for j:=0 to length(IntfHelpers)-1 do
  4809. AddActiveHelper(TPRHelperEntry(IntfHelpers[j]).Helper);
  4810. EmitElementHints(Section,UseUnit);
  4811. end;
  4812. // Add first name of dotted unitname (top level subnamespace) as identifier
  4813. for i:=Section.UsesList.Count-1 downto 0 do
  4814. begin
  4815. UseUnit:=Section.UsesClause[i];
  4816. FirstName:=UseUnit.Name;
  4817. p:=Pos('.',FirstName);
  4818. if p<1 then continue;
  4819. FirstName:=LeftStr(FirstName,p-1);
  4820. OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
  4821. if (OldIdentifier=nil) then
  4822. AddIdentifier(Scope,FirstName,UseUnit,pikNamespace);
  4823. end;
  4824. // Note: a sub identifier (e.g. a class member) hides all unitnames starting
  4825. // with this identifier
  4826. end;
  4827. procedure TPasResolver.FinishSection(Section: TPasSection);
  4828. // Note: can be called multiple times for a section
  4829. var
  4830. Scope: TPasSectionScope;
  4831. begin
  4832. Scope:=Section.CustomData as TPasSectionScope;
  4833. if Scope.Finished then exit;
  4834. Scope.Finished:=true;
  4835. if Section is TInterfaceSection then
  4836. FinishInterfaceSection(Section);
  4837. end;
  4838. procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
  4839. begin
  4840. {$IFDEF VerboseUnitQueue}
  4841. writeln('TPasResolver.FinishInterfaceSection ',GetObjName(RootElement));
  4842. {$ENDIF}
  4843. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  4844. if not IsUnitIntfFinished(Section.GetModule) then
  4845. RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+RootElement.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
  4846. {$ENDIF}
  4847. NotifyPendingUsedInterfaces;
  4848. if Section=nil then ;
  4849. end;
  4850. procedure TPasResolver.FinishTypeSection(El: TPasElement);
  4851. procedure FinishDeclarations(El: TPasDeclarations);
  4852. var
  4853. i: Integer;
  4854. Decl: TPasElement;
  4855. begin
  4856. for i:=0 to El.Declarations.Count-1 do
  4857. begin
  4858. Decl:=TPasElement(El.Declarations[i]);
  4859. if Decl is TPasType then
  4860. FinishTypeSectionEl(TPasType(Decl));
  4861. end;
  4862. end;
  4863. procedure FinishMembersType(El: TPasMembersType);
  4864. var
  4865. i: Integer;
  4866. Decl: TPasElement;
  4867. begin
  4868. for i:=0 to El.Members.Count-1 do
  4869. begin
  4870. Decl:=TPasElement(El.Members[i]);
  4871. if Decl is TPasType then
  4872. FinishTypeSectionEl(TPasType(Decl));
  4873. end;
  4874. end;
  4875. begin
  4876. // resolve pending forwards
  4877. if El is TPasDeclarations then
  4878. FinishDeclarations(TPasDeclarations(El))
  4879. else if El is TPasMembersType then
  4880. FinishMembersType(TPasMembersType(El))
  4881. else
  4882. RaiseNotYetImplemented(20181226105933,El);
  4883. end;
  4884. procedure TPasResolver.FinishTypeSectionEl(El: TPasType);
  4885. function ReplaceDestType(Decl: TPasType; var DestType: TPasType;
  4886. const DestName: string; MustExist: boolean; ErrorEl: TPasElement
  4887. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF}): boolean;
  4888. // returns true if replaces
  4889. var
  4890. Abort: boolean;
  4891. Data: TPRFindData;
  4892. OldDestType: TPasType;
  4893. begin
  4894. Abort:=false;
  4895. Data:=Default(TPRFindData);
  4896. Data.ErrorPosEl:=ErrorEl;
  4897. (TopScope as TPasIdentifierScope).IterateElements(DestName,
  4898. TopScope,@OnFindFirst,@Data,Abort);
  4899. //writeln('ReplaceDestType ',GetObjName(El),' DestType=',GetObjName(DestType),' DestType.Parent=',GetObjName(DestType.Parent),' RefCount=',DestType.RefCount);
  4900. if Data.Found=nil then
  4901. if MustExist then
  4902. begin
  4903. RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl);
  4904. end
  4905. else
  4906. exit(false);
  4907. if Data.Found=DestType then exit;
  4908. if Decl is TPasClassOfType then
  4909. begin
  4910. if (Data.Found.ClassType<>TPasClassType)
  4911. or (TPasClassType(Data.Found).ObjKind<>okClass) then
  4912. RaiseXExpectedButYFound(20170216151548,'class',GetElementTypeName(Data.Found),ErrorEl);
  4913. end;
  4914. // replace unresolved
  4915. OldDestType:=DestType;
  4916. DestType:=TPasType(Data.Found);
  4917. DestType.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  4918. OldDestType.Release{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  4919. CheckUseAsType(DestType,20190123100649,El);
  4920. // check cycles
  4921. if Decl is TPasPointerType then
  4922. CheckPointerCycle(TPasPointerType(Decl));
  4923. Result:=true;
  4924. end;
  4925. var
  4926. C: TClass;
  4927. ClassOfEl: TPasClassOfType;
  4928. TypeEl: TPasType;
  4929. UnresolvedEl: TUnresolvedPendingRef;
  4930. OldClassType: TPasClassType;
  4931. PtrType: TPasPointerType;
  4932. begin
  4933. C:=El.ClassType;
  4934. if C=TPasClassType then
  4935. begin
  4936. if TPasClassType(El).IsForward and (TPasClassType(El).CustomData=nil) then
  4937. RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[El.Name],El);
  4938. end
  4939. else if (C=TPasClassOfType) then
  4940. begin
  4941. ClassOfEl:=TPasClassOfType(El);
  4942. TypeEl:=ResolveAliasType(ClassOfEl.DestType);
  4943. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  4944. begin
  4945. // forward class-of -> resolve now
  4946. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  4947. {$IFDEF VerbosePasResolver}
  4948. writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',TypeEl.Name,'"');
  4949. {$ENDIF}
  4950. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,TypeEl.Name,true,UnresolvedEl
  4951. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  4952. end
  4953. else if TypeEl.ClassType=TPasClassType then
  4954. begin
  4955. // class-of has found a type
  4956. // another later in the same type section has priority -> check
  4957. OldClassType:=TypeEl as TPasClassType;
  4958. if OldClassType.Parent=ClassOfEl.Parent then
  4959. exit; // class in same type section -> ok
  4960. // class not in same type section -> check
  4961. {$IFDEF VerbosePasResolver}
  4962. writeln('TPasResolver.FinishTypeSection improving "',ClassOfEl.Name,'" = class of resolved "',TypeEl.Name,'"');
  4963. {$ENDIF}
  4964. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,ClassOfEl.DestType.Name,false,ClassOfEl
  4965. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  4966. end;
  4967. end
  4968. else if C=TPasPointerType then
  4969. begin
  4970. PtrType:=TPasPointerType(El);
  4971. TypeEl:=ResolveAliasType(PtrType.DestType);
  4972. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  4973. begin
  4974. // forward pointer -> resolve now
  4975. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  4976. {$IFDEF VerbosePasResolver}
  4977. writeln('TPasResolver.FinishTypeSection resolving "',PtrType.Name,'" = pointer of unresolved "',TypeEl.Name,'"');
  4978. {$ENDIF}
  4979. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,true,UnresolvedEl
  4980. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  4981. end
  4982. else
  4983. begin
  4984. // pointer-of has found a type
  4985. // another later in the same type section has priority -> check
  4986. if TypeEl.Parent=PtrType.Parent then
  4987. exit; // class in same type section -> ok
  4988. // dest not in same type section -> check
  4989. {$IFDEF VerbosePasResolver}
  4990. writeln('TPasResolver.FinishTypeSection improving "',PtrType.Name,'" = pointer of resolved "',TypeEl.Name,'"');
  4991. {$ENDIF}
  4992. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,false,PtrType
  4993. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  4994. end;
  4995. end;
  4996. end;
  4997. procedure TPasResolver.FinishTypeDef(El: TPasType);
  4998. var
  4999. C: TClass;
  5000. aType: TPasType;
  5001. begin
  5002. {$IFDEF VerbosePasResolver}
  5003. writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
  5004. {$ENDIF}
  5005. C:=El.ClassType;
  5006. if C=TPasEnumType then
  5007. FinishEnumType(TPasEnumType(El))
  5008. else if C=TPasSetType then
  5009. FinishSetType(TPasSetType(El))
  5010. else if C=TPasRangeType then
  5011. FinishRangeType(TPasRangeType(El))
  5012. else if C=TPasRecordType then
  5013. FinishRecordType(TPasRecordType(El))
  5014. else if C=TPasClassType then
  5015. FinishClassType(TPasClassType(El))
  5016. else if C=TPasClassOfType then
  5017. FinishClassOfType(TPasClassOfType(El))
  5018. else if C=TPasPointerType then
  5019. FinishPointerType(TPasPointerType(El))
  5020. else if C=TPasArrayType then
  5021. FinishArrayType(TPasArrayType(El))
  5022. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  5023. begin
  5024. aType:=ResolveAliasType(El);
  5025. if (aType is TPasMembersType) and (aType.CustomData=nil) then
  5026. exit;
  5027. EmitTypeHints(El,TPasAliasType(El).DestType);
  5028. end
  5029. else if (C=TPasPointerType) then
  5030. EmitTypeHints(El,TPasPointerType(El).DestType)
  5031. else if C=TPasGenericTemplateType then
  5032. FinishGenericTemplateType(TPasGenericTemplateType(El));
  5033. end;
  5034. procedure TPasResolver.FinishEnumType(El: TPasEnumType);
  5035. begin
  5036. if TopScope.Element=El then
  5037. PopScope;
  5038. end;
  5039. procedure TPasResolver.FinishSetType(El: TPasSetType);
  5040. function GetEnumTypePosEl: TPasElement;
  5041. begin
  5042. Result:=El.EnumType;
  5043. if Result.Parent<>El then
  5044. Result:=El;
  5045. end;
  5046. var
  5047. BaseTypeData: TResElDataBaseType;
  5048. StartResolved, EndResolved: TPasResolverResult;
  5049. RangeExpr: TBinaryExpr;
  5050. C: TClass;
  5051. EnumType: TPasType;
  5052. begin
  5053. EnumType:=ResolveAliasType(El.EnumType);
  5054. C:=EnumType.ClassType;
  5055. if C=TPasEnumType then
  5056. begin
  5057. FinishSubElementType(El,EnumType);
  5058. exit;
  5059. end
  5060. else if C=TPasRangeType then
  5061. begin
  5062. RangeExpr:=TPasRangeType(EnumType).RangeExpr;
  5063. if (RangeExpr.Parent=El) and (RangeExpr.CustomData=nil) then
  5064. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5065. FinishSubElementType(El,EnumType);
  5066. exit;
  5067. end
  5068. else if C=TPasUnresolvedSymbolRef then
  5069. begin
  5070. if EnumType.CustomData is TResElDataBaseType then
  5071. begin
  5072. BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
  5073. if BaseTypeData.BaseType in (btAllChars+[btBoolean,btByte]) then
  5074. exit;
  5075. RaiseXExpectedButYFound(20170216151553,'char or boolean',
  5076. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5077. end;
  5078. end;
  5079. RaiseXExpectedButYFound(20170216151557,'enum type',
  5080. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5081. end;
  5082. procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
  5083. var
  5084. Decl: TPasDeclarations;
  5085. EnumScope: TPasEnumTypeScope;
  5086. begin
  5087. EmitTypeHints(Parent,El);
  5088. if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
  5089. if Parent.Name='' then
  5090. RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5091. if not (Parent.Parent is TPasDeclarations) then
  5092. RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5093. if El.Parent<>Parent then
  5094. RaiseNotYetImplemented(20190215085011,Parent);
  5095. // give anonymous sub type a name
  5096. El.Name:=Parent.Name+AnonymousElTypePostfix;
  5097. {$IFDEF VerbosePasResolver}
  5098. writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
  5099. {$ENDIF}
  5100. Decl:=TPasDeclarations(Parent.Parent);
  5101. Decl.Declarations.Add(El);
  5102. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
  5103. El.Parent:=Decl;
  5104. Decl.Types.Add(El);
  5105. if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
  5106. begin
  5107. // anonymous enumtype
  5108. EnumScope:=TPasEnumTypeScope(El.CustomData);
  5109. if EnumScope.CanonicalSet<>Parent then
  5110. begin
  5111. // When a TPasEnumType is created a CanonicalSet is created.
  5112. // Release the autocreated CanonicalSet and use the parent.
  5113. if EnumScope.CanonicalSet<>nil then
  5114. EnumScope.CanonicalSet.Release{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5115. EnumScope.CanonicalSet:=TPasSetType(Parent);
  5116. Parent.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5117. end;
  5118. end;
  5119. end;
  5120. procedure TPasResolver.FinishRangeType(El: TPasRangeType);
  5121. var
  5122. RangeExpr: TBinaryExpr;
  5123. StartResolved, EndResolved: TPasResolverResult;
  5124. begin
  5125. RangeExpr:=El.RangeExpr;
  5126. ResolveExpr(RangeExpr.left,rraRead);
  5127. ResolveExpr(RangeExpr.right,rraRead);
  5128. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5129. end;
  5130. procedure TPasResolver.FinishConstRangeExpr(RangeExpr: TBinaryExpr; out
  5131. LeftResolved, RightResolved: TPasResolverResult);
  5132. // for example Left..Right
  5133. var
  5134. RgValue: TResEvalValue;
  5135. Left, Right: TPasExpr;
  5136. begin
  5137. Left:=RangeExpr.left;
  5138. Right:=RangeExpr.right;
  5139. {$IFDEF VerbosePasResEval}
  5140. writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
  5141. {$ENDIF}
  5142. // check type compatibility
  5143. ComputeElement(Left,LeftResolved,[rcConstant]);
  5144. ComputeElement(Right,RightResolved,[rcConstant]);
  5145. CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
  5146. RgValue:=Eval(RangeExpr,[refConst]);
  5147. ReleaseEvalValue(RgValue);
  5148. end;
  5149. procedure TPasResolver.FinishRecordType(El: TPasRecordType);
  5150. begin
  5151. if TopScope.Element=El then
  5152. PopScope;
  5153. end;
  5154. procedure TPasResolver.FinishClassType(El: TPasClassType);
  5155. type
  5156. TMethResolution = record
  5157. InterfaceIndex: integer;
  5158. ProcClassType: TPasProcedureClass;
  5159. InterfaceName: string;
  5160. ImplementName: string;
  5161. ResolutionEl: TPasMethodResolution;
  5162. Count: integer; // needed to check if method resolution is used
  5163. end;
  5164. var
  5165. ClassScope: TPasClassScope;
  5166. i, j, k: Integer;
  5167. IntfType: TPasClassType;
  5168. Resolutions: array of TMethResolution;
  5169. Map: TPasClassIntfMap;
  5170. o: TObject;
  5171. Member, Parent: TPasElement;
  5172. IntfProc: TPasProcedure;
  5173. FindData: TFindProcData;
  5174. Abort: boolean;
  5175. MethRes: TPasMethodResolution;
  5176. ResolvedEl: TPasResolverResult;
  5177. ProcName, IntfProcName: String;
  5178. Expr: TPasExpr;
  5179. SectionScope: TPasSectionScope;
  5180. begin
  5181. Resolutions:=nil;
  5182. ClassScope:=nil;
  5183. if El.CustomData is TPasClassScope then
  5184. begin
  5185. if TopScope.Element<>El then
  5186. RaiseInternalError(20180322142534,GetObjName(El)+'<>'+GetObjName(TopScope.Element));
  5187. ClassScope:=El.CustomData as TPasClassScope;
  5188. if El.ObjKind=okClass then
  5189. begin
  5190. if (El.Interfaces.Count>0) then
  5191. begin
  5192. if (ClassScope.Interfaces=nil) then
  5193. RaiseInternalError(20180408162725,'');
  5194. if (ClassScope.Interfaces.Count<>El.Interfaces.Count) then
  5195. RaiseInternalError(20180408162746,'');
  5196. end
  5197. else if ClassScope.Interfaces<>nil then
  5198. RaiseInternalError(20180408162803,'');
  5199. // check explicit method resolutions, e.g. procedure intf.intfproc = implproc
  5200. for i:=0 to El.Members.Count-1 do
  5201. begin
  5202. Member:=TPasElement(El.Members[i]);
  5203. if not (Member is TPasMethodResolution) then continue;
  5204. MethRes:=TPasMethodResolution(Member);
  5205. // get interface
  5206. ComputeElement(MethRes.InterfaceName,ResolvedEl,[rcNoImplicitProc]);
  5207. if not (ResolvedEl.IdentEl is TPasType) then
  5208. RaiseInternalError(20180323135729,GetResolverResultDbg(ResolvedEl));
  5209. j:=El.Interfaces.IndexOf(ResolvedEl.IdentEl);
  5210. if j<0 then
  5211. RaiseInternalError(20180323135900,GetResolverResultDbg(ResolvedEl));
  5212. // get class-interface-map, check delegations
  5213. o:=TObject(ClassScope.Interfaces[j]);
  5214. if o is TPasProperty then
  5215. RaiseMsg(20180323140046,nCannotMixMethodResolutionAndDelegationAtX,
  5216. sCannotMixMethodResolutionAndDelegationAtX,
  5217. [GetElementSourcePosStr(TPasProperty(o))],MethRes.InterfaceName);
  5218. if o=nil then
  5219. o:=CreateClassIntfMap(El,j);
  5220. Map:=TPasClassIntfMap(o);
  5221. // get interface proc name
  5222. Expr:=MethRes.InterfaceProc;
  5223. if not (Expr is TPrimitiveExpr) then
  5224. RaiseXExpectedButYFound(20180327162230,'method name',GetElementTypeName(Expr),Expr);
  5225. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5226. RaiseXExpectedButYFound(20180327162236,'method name',GetElementTypeName(Expr),Expr);
  5227. IntfProcName:=TPrimitiveExpr(Expr).Value;
  5228. // get implementation proc name
  5229. Expr:=MethRes.ImplementationProc;
  5230. if not (Expr is TPrimitiveExpr) then
  5231. RaiseXExpectedButYFound(20180327152115,'method name',GetElementTypeName(Expr),Expr);
  5232. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5233. RaiseXExpectedButYFound(20180327152157,'method name',GetElementTypeName(Expr),Expr);
  5234. ProcName:=TPrimitiveExpr(Expr).Value;
  5235. for k:=0 to length(Resolutions)-1 do
  5236. with Resolutions[k] do
  5237. if (InterfaceIndex=j) and (ProcClassType=MethRes.ProcClass)
  5238. and (InterfaceName=IntfProcName) then
  5239. RaiseMsg(20180327164626,nDuplicateIdentifier,sDuplicateIdentifier,
  5240. [GetElementTypeName(ProcClassType)+' '+Map.Intf.Name+'.'+InterfaceName,
  5241. GetElementSourcePosStr(ResolutionEl)],MethRes.InterfaceProc);
  5242. // add resolution
  5243. k:=length(Resolutions);
  5244. SetLength(Resolutions,k+1);
  5245. with Resolutions[k] do
  5246. begin
  5247. InterfaceIndex:=j;
  5248. ProcClassType:=MethRes.ProcClass;
  5249. InterfaceName:=IntfProcName;
  5250. ImplementName:=ProcName;
  5251. ResolutionEl:=MethRes;
  5252. Count:=0;
  5253. end;
  5254. end;
  5255. // method resolution
  5256. for i:=0 to El.Interfaces.Count-1 do
  5257. begin
  5258. o:=TObject(ClassScope.Interfaces[i]);
  5259. //writeln('TPasResolver.FinishClassType class=',GetObjName(El),' i=',i,' Intf=',GetObjName(TObject(El.Interfaces[i])),' Map=',GetObjName(o));
  5260. if o is TPasProperty then
  5261. continue; // interface implemented via a property
  5262. if o=nil then
  5263. o:=CreateClassIntfMap(El,i);
  5264. Map:=TPasClassIntfMap(o);
  5265. while Map<>nil do
  5266. begin
  5267. IntfType:=Map.Intf;
  5268. //writeln('TPasResolver.FinishClassType ',GetObjName(Map),' ',GetObjName(IntfType),' Count=',IntfType.Members.Count);
  5269. for j:=0 to IntfType.Members.Count-1 do
  5270. begin
  5271. Member:=TPasElement(IntfType.Members[j]);
  5272. if not (Member is TPasProcedure) then continue;
  5273. IntfProc:=TPasProcedure(Member);
  5274. ProcName:=IntfProc.Name;
  5275. // check resolutions
  5276. for k:=0 to length(Resolutions)-1 do
  5277. with Resolutions[k] do
  5278. begin
  5279. if (InterfaceIndex=i) and (ProcClassType=IntfProc.ClassType)
  5280. and SameText(InterfaceName,IntfProc.Name) then
  5281. begin
  5282. ProcName:=ImplementName;
  5283. inc(Count);
  5284. end;
  5285. end;
  5286. // search interface method in class
  5287. FindData:=Default(TFindProcData);
  5288. FindData.Proc:=IntfProc;
  5289. FindData.Args:=IntfProc.ProcType.Args;
  5290. FindData.Kind:=fpkSameSignature;
  5291. Abort:=false;
  5292. IterateElements(ProcName,@OnFindProc,@FindData,Abort);
  5293. if FindData.Found=nil then
  5294. RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
  5295. sNoMatchingImplForIntfMethodXFound,
  5296. [GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
  5297. Map.Procs[j]:=FindData.Found;
  5298. end;
  5299. Map:=Map.AncestorMap;
  5300. end;
  5301. end;
  5302. // ToDo: hint if method resolution is not used
  5303. end;
  5304. if El.ObjKind in okAllHelpers then
  5305. begin
  5306. // activate helper
  5307. AddActiveHelper(El);
  5308. // cache helpers in interface, so other modules don't have to search
  5309. Parent:=El.Parent;
  5310. while Parent<>nil do
  5311. begin
  5312. if Parent.ClassType=TInterfaceSection then
  5313. begin
  5314. SectionScope:=Parent.CustomData as TPasSectionScope;
  5315. AddHelper(El,SectionScope.Helpers);
  5316. break;
  5317. end;
  5318. Parent:=Parent.Parent;
  5319. end;
  5320. end;
  5321. end;
  5322. if TopScope.Element=El then
  5323. PopScope;
  5324. end;
  5325. procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
  5326. var
  5327. TypeEl: TPasType;
  5328. begin
  5329. TypeEl:=ResolveAliasType(El.DestType);
  5330. if TypeEl is TUnresolvedPendingRef then
  5331. begin
  5332. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5333. exit;
  5334. end;
  5335. if (TypeEl is TPasClassType) and (TPasClassType(TypeEl).ObjKind=okClass) then exit;
  5336. RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5337. [El.DestType.Name,'class'],El);
  5338. end;
  5339. procedure TPasResolver.FinishPointerType(El: TPasPointerType);
  5340. var
  5341. TypeEl: TPasType;
  5342. begin
  5343. TypeEl:=ResolveAliasType(El.DestType);
  5344. if TypeEl is TUnresolvedPendingRef then
  5345. begin
  5346. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  5347. exit;
  5348. end;
  5349. if El.DestType.Parent=El then
  5350. RaiseMsg(20180429094237,nNotYetImplemented,sNotYetImplemented,['pointer of anonymous type'],El.DestType);
  5351. CheckUseAsType(El.DestType,20190123095118,El);
  5352. CheckPointerCycle(El);
  5353. end;
  5354. procedure TPasResolver.FinishArrayType(El: TPasArrayType);
  5355. var
  5356. i: Integer;
  5357. Expr: TPasExpr;
  5358. RangeResolved: TPasResolverResult;
  5359. TypeEl: TPasType;
  5360. begin
  5361. for i:=0 to length(El.Ranges)-1 do
  5362. begin
  5363. Expr:=El.Ranges[i];
  5364. ResolveExpr(Expr,rraRead);
  5365. ComputeElement(Expr,RangeResolved,[rcConstant]);
  5366. if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
  5367. begin
  5368. {$IFDEF VerbosePasResolver}
  5369. writeln('TPasResolver.FinishArrayType ',GetResolverResultDbg(RangeResolved));
  5370. {$ENDIF}
  5371. RaiseXExpectedButYFound(20170216151607,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5372. end;
  5373. if (RangeResolved.BaseType=btRange) then
  5374. begin
  5375. if (RangeResolved.SubType in btArrayRangeTypes) then
  5376. // range, e.g. 1..2
  5377. else if RangeResolved.SubType=btContext then
  5378. begin
  5379. TypeEl:=RangeResolved.LoTypeEl;
  5380. if TypeEl is TPasRangeType then
  5381. // custom range
  5382. else if TypeEl is TPasEnumType then
  5383. // anonymous enum range
  5384. else
  5385. RaiseXExpectedButYFound(20171009193629,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5386. end
  5387. else
  5388. RaiseXExpectedButYFound(20171009193514,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5389. end
  5390. else if RangeResolved.BaseType in btArrayRangeTypes then
  5391. // full range, e.g. array[char]
  5392. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasEnumType) then
  5393. // e.g. array[enumtype]
  5394. else
  5395. RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  5396. end;
  5397. if El.ElType=nil then
  5398. begin
  5399. // array of const
  5400. if length(El.Ranges)>0 then
  5401. RaiseNotYetImplemented(20190215102529,El);
  5402. FindTVarRec(El);
  5403. end
  5404. else
  5405. begin
  5406. CheckUseAsType(El.ElType,20190123095401,El);
  5407. FinishSubElementType(El,El.ElType);
  5408. end;
  5409. end;
  5410. procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
  5411. var
  5412. i: Integer;
  5413. Expr: TPasExpr;
  5414. Value: String;
  5415. begin
  5416. for i:=0 to length(El.Constraints)-1 do
  5417. begin
  5418. Expr:=El.Constraints[i];
  5419. if (Expr.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  5420. begin
  5421. Value:=TPrimitiveExpr(Expr).Value;
  5422. if SameText(Value,'class') then
  5423. ; // ToDo
  5424. end;
  5425. end;
  5426. end;
  5427. procedure TPasResolver.FinishResourcestring(El: TPasResString);
  5428. var
  5429. ResolvedEl: TPasResolverResult;
  5430. begin
  5431. ResolveExpr(El.Expr,rraRead);
  5432. ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
  5433. if not (ResolvedEl.BaseType in btAllStringAndChars) then
  5434. RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
  5435. end;
  5436. procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
  5437. var
  5438. i: Integer;
  5439. Body: TProcedureBody;
  5440. SubEl: TPasElement;
  5441. SubProcScope, ProcScope: TPasProcedureScope;
  5442. begin
  5443. {$IFDEF VerbosePasResolver}
  5444. writeln('TPasResolver.FinishProcedure START');
  5445. {$ENDIF}
  5446. CheckTopScope(FScopeClass_Proc);
  5447. ProcScope:=TPasProcedureScope(TopScope);
  5448. if ProcScope.Element<>aProc then
  5449. RaiseInternalError(20170220163043);
  5450. Body:=aProc.Body;
  5451. if Body<>nil then
  5452. begin
  5453. StoreScannerFlagsInProc(ProcScope);
  5454. if Body.Body is TPasImplAsmStatement then
  5455. aProc.Modifiers:=aProc.Modifiers+[pmAssembler];
  5456. ResolveImplBlock(Body.Body);
  5457. // check if all nested forward procs are resolved
  5458. for i:=0 to Body.Declarations.Count-1 do
  5459. begin
  5460. SubEl:=TPasElement(Body.Declarations[i]);
  5461. if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
  5462. begin
  5463. SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
  5464. if SubProcScope.ImplProc=nil then
  5465. RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
  5466. [GetElementTypeName(SubEl),SubEl.Name],SubEl);
  5467. end;
  5468. end;
  5469. if ProcScope.GroupScope<>nil then
  5470. begin
  5471. ProcScope.GroupScope.Free;
  5472. ProcScope.GroupScope:=nil;
  5473. end;
  5474. end
  5475. else if ProcScope.GroupScope<>nil then
  5476. RaiseInternalError(20190122142142,GetObjName(aProc));
  5477. PopScope;
  5478. end;
  5479. procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
  5480. var
  5481. ProcName: String;
  5482. FindData: TFindProcData;
  5483. DeclProc, Proc, ParentProc: TPasProcedure;
  5484. Abort, HasDots, IsClassConDestructor: boolean;
  5485. DeclProcScope, ProcScope: TPasProcedureScope;
  5486. ParentScope: TPasIdentifierScope;
  5487. pm: TProcedureModifier;
  5488. ptm: TProcTypeModifier;
  5489. ObjKind: TPasObjKind;
  5490. ParentBody: TProcedureBody;
  5491. HelperForType: TPasType;
  5492. Args: TFPList;
  5493. Arg: TPasArgument;
  5494. begin
  5495. if El.Parent is TPasProcedure then
  5496. Proc:=TPasProcedure(El.Parent)
  5497. else
  5498. Proc:=nil;
  5499. if (Proc<>nil) and (Proc.ProcType=El) then
  5500. begin
  5501. // finished header of a procedure declaration
  5502. // -> search the best fitting proc
  5503. CheckTopScope(FScopeClass_Proc);
  5504. {$IFDEF VerbosePasResolver}
  5505. writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
  5506. {$ENDIF}
  5507. ProcName:=Proc.Name;
  5508. if El is TPasFunctionType then
  5509. CheckUseAsType(TPasFunctionType(El).ResultEl.ResultType,20190123095743,TPasFunctionType(El).ResultEl);
  5510. if (proProcTypeWithoutIsNested in Options) and El.IsNested then
  5511. RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
  5512. ParentBody:=GetParentProcBody(Proc.Parent);
  5513. if (ParentBody<>nil) then
  5514. begin
  5515. // nested sub proc
  5516. if not (proProcTypeWithoutIsNested in Options) then
  5517. El.IsNested:=true;
  5518. // inherit 'of Object'
  5519. ParentProc:=ParentBody.Parent as TPasProcedure;
  5520. if ParentProc.ProcType.IsOfObject then
  5521. El.IsOfObject:=true;
  5522. end;
  5523. if El.IsReferenceTo then
  5524. begin
  5525. if El.IsNested then
  5526. RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
  5527. if El.IsOfObject then
  5528. RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
  5529. end;
  5530. if Proc.IsExternal then
  5531. begin
  5532. for pm in Proc.Modifiers do
  5533. if not (pm in [pmVirtual, pmDynamic, pmOverride,
  5534. pmOverload, pmMessage, pmReintroduce,
  5535. pmExternal, pmDispId,
  5536. pmfar]) then
  5537. RaiseMsg(20170216151616,nInvalidXModifierY,
  5538. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ModifierNames[pm]],Proc);
  5539. for ptm in Proc.ProcType.Modifiers do
  5540. if not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo]) then
  5541. RaiseMsg(20170411171224,nInvalidXModifierY,
  5542. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ProcTypeModifiers[ptm]],Proc);
  5543. end;
  5544. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  5545. or (Proc.ClassType=TPasClassDestructor);
  5546. if IsClassConDestructor then
  5547. begin
  5548. // class constructor/destructor
  5549. if Proc.IsVirtual then
  5550. RaiseMsg(20181231150237,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual'],Proc);
  5551. if Proc.IsOverride then
  5552. RaiseMsg(20181231150305,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'override'],Proc);
  5553. if Proc.IsDynamic then
  5554. RaiseMsg(20181231150319,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'dynamic'],Proc);
  5555. if Proc.IsStatic then
  5556. RaiseMsg(20190216214651,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  5557. if El.Args.Count>0 then
  5558. RaiseMsg(20181231150404,nXCannotHaveParameters,sXCannotHaveParameters,[GetElementTypeName(Proc)],Proc);
  5559. end;
  5560. HasDots:=Pos('.',ProcName)>1;
  5561. if Proc.Parent is TPasClassType then
  5562. begin
  5563. // method declaration
  5564. ObjKind:=TPasClassType(Proc.Parent).ObjKind;
  5565. case ObjKind of
  5566. okInterface,okDispInterface:
  5567. begin
  5568. if Proc.IsVirtual then
  5569. RaiseMsg(20180321234324,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  5570. if Proc.IsOverride then
  5571. RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  5572. end;
  5573. okClassHelper,okRecordHelper,okTypeHelper:
  5574. begin
  5575. if Proc.IsAbstract then
  5576. RaiseMsg(20190116215744,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'abstract'],Proc);
  5577. {if msDelphi in CurrentParser.CurrentModeswitches then
  5578. begin
  5579. // Delphi allows virtual/override in class helpers
  5580. // But using them crashes in Delphi 10.3
  5581. // -> do not support them
  5582. end
  5583. }
  5584. if Proc.IsVirtual then
  5585. RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  5586. if Proc.IsOverride then
  5587. RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  5588. HelperForType:=ResolveAliasType(TPasClassType(Proc.Parent).HelperForType);
  5589. if (not Proc.IsStatic) and IsClassMethod(Proc) and not IsClassConDestructor then
  5590. begin
  5591. // non static class methods require a class
  5592. if (not (HelperForType.ClassType=TPasClassType))
  5593. or (TPasClassType(HelperForType).ObjKind<>okClass) then
  5594. RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
  5595. end;
  5596. if Proc.ClassType=TPasDestructor then
  5597. RaiseMsg(20190302151019,nXIsNotSupported,sXIsNotSupported,['destructor'],Proc);
  5598. if (Proc.ClassType=TPasConstructor)
  5599. and (HelperForType.ClassType=TPasClassType)
  5600. and (TPasClassType(HelperForType).ObjKind<>okClass) then
  5601. RaiseMsg(20190302151514,nXIsNotSupported,sXIsNotSupported,['constructor'],Proc);
  5602. end;
  5603. end;
  5604. if Proc.IsAbstract then
  5605. begin
  5606. if not Proc.IsVirtual then
  5607. RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract without virtual'],Proc);
  5608. if Proc.IsOverride then
  5609. RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract, override'],Proc);
  5610. end;
  5611. if Proc.IsVirtual and Proc.IsOverride then
  5612. RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual, override'],Proc);
  5613. if Proc.IsReintroduced and Proc.IsOverride then
  5614. RaiseMsg(20171119111845,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'reintroduce, override'],Proc);
  5615. if Proc.IsForward then
  5616. RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'forward'],Proc);
  5617. if Proc.IsStatic then
  5618. if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
  5619. RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  5620. end
  5621. else if Proc.Parent is TPasRecordType then
  5622. begin
  5623. if (Proc.ClassType=TPasConstructor)
  5624. and ((El.Args.Count=0)
  5625. or (TPasArgument(El.Args[0]).ValueExpr<>nil)) then
  5626. RaiseMsg(20181226231333,nParameterlessConstructorsNotAllowedInRecords,
  5627. sParameterlessConstructorsNotAllowedInRecords,[],El);
  5628. if Proc.IsReintroduced then
  5629. RaiseMsg(20181218195735,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'reintroduce'],Proc);
  5630. if Proc.IsVirtual then
  5631. RaiseMsg(20181218195431,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'virtual'],Proc);
  5632. if Proc.IsOverride then
  5633. RaiseMsg(20181218195437,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'override'],Proc);
  5634. if Proc.IsAbstract then
  5635. RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
  5636. if Proc.IsForward then
  5637. RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
  5638. if IsClassMethod(Proc) and not IsClassConDestructor then
  5639. begin
  5640. // Note: class constructor/destructor must not be static
  5641. if not Proc.IsStatic then
  5642. RaiseMsg(20190106121503,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,['records'],Proc);
  5643. end
  5644. else if Proc.IsStatic then
  5645. RaiseMsg(20190206150922,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  5646. end
  5647. else
  5648. begin
  5649. // intf proc, forward proc, proc body, method body, anonymous proc
  5650. if Proc.IsAbstract then
  5651. RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
  5652. if Proc.IsVirtual then
  5653. RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
  5654. if Proc.IsOverride then
  5655. RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
  5656. if Proc.IsMessage then
  5657. RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
  5658. if Proc.IsStatic then
  5659. RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
  5660. if (not HasDots)
  5661. and (Proc.GetProcTypeEnum in [
  5662. ptClassOperator,
  5663. ptConstructor, ptDestructor,
  5664. ptClassProcedure, ptClassFunction,
  5665. ptClassConstructor, ptClassDestructor
  5666. ]) then
  5667. RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
  5668. end;
  5669. if HasDots then
  5670. begin
  5671. FinishMethodImplHeader(Proc);
  5672. exit;
  5673. end;
  5674. // finish interface/implementation/nested procedure/method declaration
  5675. if not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction])
  5676. and not IsValidIdent(ProcName) then
  5677. RaiseNotYetImplemented(20160922163407,El);
  5678. if El is TPasFunctionType then
  5679. EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
  5680. if Proc.PublicName<>nil then
  5681. ResolveExpr(Proc.PublicName,rraRead);
  5682. if Proc.LibraryExpr<>nil then
  5683. ResolveExpr(Proc.LibraryExpr,rraRead);
  5684. if Proc.LibrarySymbolName<>nil then
  5685. ResolveExpr(Proc.LibrarySymbolName,rraRead);
  5686. if Proc.DispIDExpr<>nil then
  5687. ResolveExpr(Proc.DispIDExpr,rraRead);
  5688. if Proc.MessageExpr<>nil then
  5689. begin
  5690. // message modifier
  5691. ResolveExpr(Proc.MessageExpr,rraRead);
  5692. Args:=Proc.ProcType.Args;
  5693. if Args.Count<>1 then
  5694. RaiseMsg(20190303223701,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  5695. Arg:=TPasArgument(Args[0]);
  5696. if not (Arg.Access in [argVar,argOut]) then
  5697. RaiseMsg(20190303223834,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  5698. if (Proc.ClassType<>TPasProcedure)
  5699. and (Proc.ClassType<>TPasFunction) then
  5700. RaiseMsg(20190303224128,nXExpectedButYFound,sXExpectedButYFound,['procedure name(var Msg);message id;',GetElementTypeName(El)],El);
  5701. end;
  5702. if Proc.Parent is TPasMembersType then
  5703. begin
  5704. FinishMethodDeclHeader(Proc);
  5705. exit;
  5706. end;
  5707. // finish interface/implementation/nested procedure
  5708. if (ProcName<>'') and ProcNeedsBody(Proc) then
  5709. begin
  5710. // check if there is a forward declaration
  5711. //writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2]));
  5712. ParentScope:=GetParentLocalScope as TPasIdentifierScope;
  5713. //writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc));
  5714. DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true);
  5715. //writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
  5716. //if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc));
  5717. if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
  5718. DeclProc:=FindProcSameSignature(ProcName,Proc,
  5719. (Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true);
  5720. //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
  5721. if (DeclProc<>nil) then
  5722. begin
  5723. if ProcNeedsImplProc(DeclProc) then
  5724. begin
  5725. // found forward declaration
  5726. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  5727. if DeclProcScope.ImplProc<>nil then
  5728. RaiseMsg(20180318222430,nDuplicateIdentifier,sDuplicateIdentifier,
  5729. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],Proc);
  5730. // connect
  5731. {$IFDEF VerbosePasResolver}
  5732. writeln('TPasResolver.FinishProcedureHeader forward found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
  5733. {$ENDIF}
  5734. CheckProcSignatureMatch(DeclProc,Proc,true);
  5735. DeclProcScope.ImplProc:=Proc;
  5736. ProcScope:=Proc.CustomData as TPasProcedureScope;
  5737. ProcScope.DeclarationProc:=DeclProc;
  5738. // remove ImplProc from scope
  5739. (ParentScope as TPasIdentifierScope).RemoveLocalIdentifier(Proc);
  5740. // replace arguments with declaration arguments
  5741. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  5742. exit;
  5743. end
  5744. else
  5745. RaiseMsg(20180318220543,nDuplicateIdentifier,sDuplicateIdentifier,
  5746. [DeclProc.Name,GetElementSourcePosStr(DeclProc)],Proc);
  5747. end;
  5748. end
  5749. else
  5750. begin
  5751. // forward declaration
  5752. ProcScope:=Proc.CustomData as TPasProcedureScope;
  5753. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  5754. StoreScannerFlagsInProc(ProcScope);
  5755. end;
  5756. if ProcName<>'' then
  5757. begin
  5758. // check for invalid overloads
  5759. FindData:=Default(TFindProcData);
  5760. FindData.Proc:=Proc;
  5761. FindData.Args:=Proc.ProcType.Args;
  5762. FindData.Kind:=fpkProc;
  5763. Abort:=false;
  5764. IterateElements(ProcName,@OnFindProc,@FindData,Abort);
  5765. end;
  5766. end
  5767. else if El.Name<>'' then
  5768. begin
  5769. // finished proc type, e.g. type TProcedure = procedure;
  5770. end
  5771. else
  5772. RaiseNotYetImplemented(20160922163411,El.Parent,'anonymous procedure type');
  5773. end;
  5774. procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
  5775. procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
  5776. begin
  5777. LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
  5778. sVirtualMethodXHasLowerVisibility,[Proc.Name,
  5779. VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
  5780. VisibilityNames[OverloadProc.Visibility]],Proc);
  5781. Proc.Visibility:=OverloadProc.Visibility;
  5782. end;
  5783. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  5784. procedure Delete(var A: TArrayOfPasProcedure; Index, Count: integer); overload;
  5785. var
  5786. i: Integer;
  5787. begin
  5788. if Index<0 then
  5789. RaiseInternalError(20171227121538);
  5790. if Index+Count>length(A) then
  5791. RaiseInternalError(20171227121156);
  5792. for i:=Index+Count to length(A)-1 do
  5793. A[i-Count]:=A[i];
  5794. SetLength(A,length(A)-Count);
  5795. end;
  5796. procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
  5797. var
  5798. i: Integer;
  5799. begin
  5800. if Index<0 then
  5801. RaiseInternalError(20171227121544);
  5802. if Index>length(A) then
  5803. RaiseInternalError(20171227121558);
  5804. SetLength(A,length(A)+1);
  5805. for i:=length(A)-1 downto Index+1 do
  5806. A[i]:=A[i-1];
  5807. A[Index]:=Item;
  5808. end;
  5809. {$ENDIF}
  5810. var
  5811. Abort, IsClassConDestructor: boolean;
  5812. ClassOrRecScope: TPasClassOrRecordScope;
  5813. FindData: TFindProcData;
  5814. OverloadProc: TPasProcedure;
  5815. ProcScope: TPasProcedureScope;
  5816. i: Integer;
  5817. ParentScope: TPasScope;
  5818. begin
  5819. if not (ptmStatic in Proc.ProcType.Modifiers) then
  5820. Proc.ProcType.IsOfObject:=true;
  5821. ProcScope:=TopScope as TPasProcedureScope;
  5822. ParentScope:=Scopes[ScopeCount-2];
  5823. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  5824. StoreScannerFlagsInProc(ProcScope);
  5825. ClassOrRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope;
  5826. ProcScope.ClassRecScope:=ClassOrRecScope;
  5827. FindData:=Default(TFindProcData);
  5828. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  5829. or (Proc.ClassType=TPasClassDestructor);
  5830. if not IsClassConDestructor then
  5831. begin
  5832. FindData.Proc:=Proc;
  5833. FindData.Args:=Proc.ProcType.Args;
  5834. FindData.Kind:=fpkMethod;
  5835. Abort:=false;
  5836. ParentScope.IterateElements(Proc.Name,ClassOrRecScope,
  5837. @OnFindProc,@FindData,Abort);
  5838. end;
  5839. if FindData.Found=nil then
  5840. begin
  5841. // no overload
  5842. if Proc.IsOverride then
  5843. RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
  5844. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  5845. end
  5846. else
  5847. begin
  5848. // overload found
  5849. OverloadProc:=FindData.Found;
  5850. // Note: 'inherited;' needs the OverriddenProc, even without 'override' modifier
  5851. ProcScope.OverriddenProc:=OverloadProc;
  5852. if Proc.IsOverride then
  5853. begin
  5854. if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
  5855. // the OverloadProc fits the signature, but is not virtual
  5856. RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
  5857. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  5858. // override a virtual method
  5859. CheckProcSignatureMatch(OverloadProc,Proc,false);
  5860. // check visibility
  5861. if Proc.Visibility<>OverloadProc.Visibility then
  5862. case Proc.Visibility of
  5863. visPrivate,visStrictPrivate:
  5864. if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
  5865. VisibilityLowered(Proc,OverloadProc);
  5866. visProtected,visStrictProtected:
  5867. if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
  5868. VisibilityLowered(Proc,OverloadProc);
  5869. visPublic:
  5870. if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
  5871. VisibilityLowered(Proc,OverloadProc);
  5872. visPublished: ;
  5873. else
  5874. RaiseNotYetImplemented(20170325003315,Proc,'visibility');
  5875. end;
  5876. // check name case
  5877. if proFixCaseOfOverrides in Options then
  5878. Proc.Name:=OverloadProc.Name;
  5879. // remove abstract
  5880. if OverloadProc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  5881. for i:=length(TPasClassScope(ClassOrRecScope).AbstractProcs)-1 downto 0 do
  5882. if TPasClassScope(ClassOrRecScope).AbstractProcs[i]=OverloadProc then
  5883. Delete(TPasClassScope(ClassOrRecScope).AbstractProcs,i,1);
  5884. end;
  5885. end;
  5886. // add abstract
  5887. if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  5888. Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
  5889. length(TPasClassScope(ClassOrRecScope).AbstractProcs));
  5890. end;
  5891. procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
  5892. var
  5893. ProcName: String;
  5894. ClassRecType: TPasMembersType;
  5895. ImplProcScope, DeclProcScope: TPasProcedureScope;
  5896. DeclProc: TPasProcedure;
  5897. ClassOrRecScope: TPasClassOrRecordScope;
  5898. SelfArg: TPasArgument;
  5899. p: Integer;
  5900. SelfType, LoSelfType: TPasType;
  5901. begin
  5902. if ImplProc.IsExternal then
  5903. RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'external'],ImplProc);
  5904. if ImplProc.IsExported then
  5905. RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'export'],ImplProc);
  5906. ProcName:=ImplProc.Name;
  5907. {$IFDEF VerbosePasResolver}
  5908. writeln('TPasResolver.FinishMethodBodyHeader searching declaration "',ProcName,'" ...');
  5909. {$ENDIF}
  5910. repeat
  5911. p:=Pos('.',ProcName);
  5912. if p<1 then break;
  5913. Delete(ProcName,1,p);
  5914. until false;
  5915. // search ImplProc in class
  5916. if not IsValidIdent(ProcName) then
  5917. RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
  5918. // search proc in class/record
  5919. ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
  5920. ClassOrRecScope:=ImplProcScope.ClassRecScope;
  5921. if ClassOrRecScope=nil then
  5922. RaiseInternalError(20161013172346);
  5923. ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
  5924. if ImplProcScope.GroupScope=nil then
  5925. RaiseInternalError(20190120135017);
  5926. if ImplProc.ClassType=TPasClassConstructor then
  5927. DeclProc:=ClassOrRecScope.ClassConstructor
  5928. else if ImplProc.ClassType=TPasClassDestructor then
  5929. DeclProc:=ClassOrRecScope.ClassDestructor
  5930. else
  5931. DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
  5932. if DeclProc=nil then
  5933. RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
  5934. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  5935. ImplProc.ProcType.IsOfObject:=DeclProc.ProcType.IsOfObject;
  5936. // connect method declaration and body
  5937. if DeclProcScope.ImplProc<>nil then
  5938. RaiseMsg(20180212094546,nDuplicateIdentifier,sDuplicateIdentifier,
  5939. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],
  5940. ImplProc);
  5941. if DeclProc.IsAbstract then
  5942. RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
  5943. if DeclProc.IsExternal then
  5944. RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
  5945. CheckProcSignatureMatch(DeclProc,ImplProc,true);
  5946. ImplProcScope.DeclarationProc:=DeclProc;
  5947. DeclProcScope.ImplProc:=ImplProc;
  5948. // replace arguments in scope with declaration arguments
  5949. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  5950. if not DeclProc.IsStatic then
  5951. begin
  5952. // add 'Self'
  5953. if (DeclProc.ClassType=TPasClassConstructor)
  5954. or (DeclProc.ClassType=TPasClassDestructor) then
  5955. // actually class constructor/destructor are static
  5956. else if (DeclProc.ClassType=TPasClassProcedure)
  5957. or (DeclProc.ClassType=TPasClassFunction) then
  5958. begin
  5959. if (ClassOrRecScope is TPasClassScope)
  5960. and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
  5961. begin
  5962. // 'Self' in a method is the hidden classtype argument
  5963. // Note: this is true in classes, adv records and helpers
  5964. SelfArg:=TPasArgument.Create('Self',DeclProc);
  5965. ImplProcScope.SelfArg:=SelfArg;
  5966. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  5967. SelfArg.Access:=argConst;
  5968. SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
  5969. SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  5970. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  5971. end
  5972. else
  5973. RaiseInternalError(20190106121745);
  5974. end
  5975. else
  5976. begin
  5977. // 'Self' in a method is the hidden instance argument
  5978. SelfArg:=TPasArgument.Create('Self',DeclProc);
  5979. ImplProcScope.SelfArg:=SelfArg;
  5980. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  5981. SelfType:=ClassRecType;
  5982. if (SelfType.ClassType=TPasClassType)
  5983. and (TPasClassType(SelfType).HelperForType<>nil) then
  5984. begin
  5985. // in a helper Self is a var argument of the helped variable
  5986. SelfType:=TPasClassType(SelfType).HelperForType;
  5987. end;
  5988. LoSelfType:=ResolveAliasType(SelfType);
  5989. if (LoSelfType is TPasClassType)
  5990. and (TPasClassType(LoSelfType).ObjKind=okClass) then
  5991. SelfArg.Access:=argConst
  5992. else
  5993. SelfArg.Access:=argVar;
  5994. SelfArg.ArgType:=SelfType;
  5995. SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  5996. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  5997. end;
  5998. end;
  5999. {$IFDEF VerbosePasResolver}
  6000. writeln('TPasResolver.FinishMethodBodyHeader END of searching proc "',ImplProc.Name,'" ...');
  6001. {$ENDIF}
  6002. end;
  6003. procedure TPasResolver.FinishExceptOnExpr;
  6004. var
  6005. El: TPasImplExceptOn;
  6006. ResolvedType: TPasResolverResult;
  6007. begin
  6008. CheckTopScope(TPasExceptOnScope);
  6009. El:=TPasImplExceptOn(FTopScope.Element);
  6010. ComputeElement(El.TypeEl,ResolvedType,[rcType]);
  6011. CheckIsClass(El.TypeEl,ResolvedType);
  6012. end;
  6013. procedure TPasResolver.FinishExceptOnStatement;
  6014. begin
  6015. //writeln('TPasResolver.FinishExceptOnStatement START');
  6016. CheckTopScope(TPasExceptOnScope);
  6017. ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
  6018. PopScope;
  6019. end;
  6020. procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
  6021. begin
  6022. PopWithScope(El);
  6023. end;
  6024. procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop);
  6025. var
  6026. VarResolved, StartResolved, EndResolved,
  6027. OrigStartResolved: TPasResolverResult;
  6028. EnumeratorFound, HasInValues: Boolean;
  6029. InRange, VarRange: TResEvalValue;
  6030. InRangeInt, VarRangeInt: TResEvalRangeInt;
  6031. bt: TResolverBaseType;
  6032. TypeEl, ElType: TPasType;
  6033. C: TClass;
  6034. begin
  6035. CreateScope(Loop,TPasForLoopScope);
  6036. // loop var
  6037. ResolveExpr(Loop.VariableName,rraReadAndAssign);
  6038. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  6039. if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
  6040. RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
  6041. // resolve start expression
  6042. ResolveExpr(Loop.StartExpr,rraRead);
  6043. ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
  6044. case Loop.LoopType of
  6045. ltNormal,ltDown:
  6046. begin
  6047. // start value
  6048. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  6049. RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
  6050. [],StartResolved,VarResolved,Loop.StartExpr);
  6051. CheckAssignExprRange(VarResolved,Loop.StartExpr);
  6052. // end value
  6053. ResolveExpr(Loop.EndExpr,rraRead);
  6054. ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
  6055. if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
  6056. RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
  6057. [],EndResolved,VarResolved,Loop.EndExpr);
  6058. CheckAssignExprRange(VarResolved,Loop.EndExpr);
  6059. end;
  6060. ltIn:
  6061. begin
  6062. // check range
  6063. EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
  6064. if (not EnumeratorFound)
  6065. and not (StartResolved.IdentEl is TPasType)
  6066. and (rrfReadable in StartResolved.Flags) then
  6067. begin
  6068. EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
  6069. end;
  6070. if not EnumeratorFound then
  6071. begin
  6072. VarRange:=nil;
  6073. InRange:=nil;
  6074. try
  6075. OrigStartResolved:=StartResolved;
  6076. if StartResolved.IdentEl is TPasType then
  6077. begin
  6078. // e.g. for e in TEnum do
  6079. TypeEl:=StartResolved.LoTypeEl;
  6080. if TypeEl is TPasArrayType then
  6081. begin
  6082. if length(TPasArrayType(TypeEl).Ranges)=1 then
  6083. InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
  6084. end;
  6085. if InRange=nil then
  6086. InRange:=EvalTypeRange(TypeEl,[]);
  6087. {$IFDEF VerbosePasResolver}
  6088. {AllowWriteln}
  6089. if InRange<>nil then
  6090. writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
  6091. else
  6092. writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
  6093. {AllowWriteln-}
  6094. {$ENDIF}
  6095. end
  6096. else if rrfReadable in StartResolved.Flags then
  6097. begin
  6098. // value (variable or expression)
  6099. bt:=StartResolved.BaseType;
  6100. if bt in [btSet,btArrayOrSet] then
  6101. begin
  6102. if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
  6103. InRange:=Eval(StartResolved.ExprEl,[]);
  6104. if InRange=nil then
  6105. InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
  6106. end
  6107. else if bt=btContext then
  6108. begin
  6109. TypeEl:=StartResolved.LoTypeEl;
  6110. C:=TypeEl.ClassType;
  6111. if C=TPasArrayType then
  6112. begin
  6113. ElType:=GetArrayElType(TPasArrayType(TypeEl));
  6114. ComputeElement(ElType,StartResolved,[rcType]);
  6115. StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
  6116. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  6117. RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
  6118. [],StartResolved,VarResolved,Loop.StartExpr);
  6119. EnumeratorFound:=true;
  6120. end;
  6121. end
  6122. else
  6123. begin
  6124. bt:=GetActualBaseType(bt);
  6125. case bt of
  6126. {$ifdef FPC_HAS_CPSTRING}
  6127. btAnsiString:
  6128. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  6129. {$endif}
  6130. btUnicodeString:
  6131. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  6132. end;
  6133. end;
  6134. end;
  6135. if (not EnumeratorFound) and (InRange<>nil) then
  6136. begin
  6137. // for v in <constant> do
  6138. // -> check if same type
  6139. VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
  6140. if VarRange=nil then
  6141. RaiseXExpectedButYFound(20171109191528,'range',
  6142. GetResolverResultDescription(VarResolved),Loop.VariableName);
  6143. //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  6144. //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
  6145. case InRange.Kind of
  6146. revkRangeInt,revkSetOfInt:
  6147. begin
  6148. InRangeInt:=TResEvalRangeInt(InRange);
  6149. case VarRange.Kind of
  6150. revkRangeInt:
  6151. begin
  6152. VarRangeInt:=TResEvalRangeInt(VarRange);
  6153. HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
  6154. case InRangeInt.ElKind of
  6155. revskEnum:
  6156. if (VarRangeInt.ElKind<>revskEnum)
  6157. or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
  6158. RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
  6159. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6160. revskInt:
  6161. if VarRangeInt.ElKind<>revskInt then
  6162. RaiseXExpectedButYFound(20171109200752,'integer',
  6163. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6164. revskChar:
  6165. if VarRangeInt.ElKind<>revskChar then
  6166. RaiseXExpectedButYFound(20171109200753,'char',
  6167. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6168. revskBool:
  6169. if VarRangeInt.ElKind<>revskBool then
  6170. RaiseXExpectedButYFound(20171109200754,'boolean',
  6171. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  6172. else
  6173. if HasInValues then
  6174. RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
  6175. end;
  6176. if HasInValues then
  6177. begin
  6178. if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
  6179. begin
  6180. {$IFDEF VerbosePasResolver}
  6181. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  6182. {$ENDIF}
  6183. fExprEvaluator.EmitRangeCheckConst(20171109201428,
  6184. InRangeInt.ElementAsString(InRangeInt.RangeStart),
  6185. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  6186. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  6187. end;
  6188. if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
  6189. begin
  6190. {$IFDEF VerbosePasResolver}
  6191. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  6192. {$ENDIF}
  6193. fExprEvaluator.EmitRangeCheckConst(20171109201429,
  6194. InRangeInt.ElementAsString(InRangeInt.RangeEnd),
  6195. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  6196. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  6197. end;
  6198. end;
  6199. EnumeratorFound:=true;
  6200. end;
  6201. else
  6202. {$IFDEF VerbosePasResolver}
  6203. writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  6204. {$ENDIF}
  6205. end;
  6206. end;
  6207. else
  6208. {$IFDEF VerbosePasResolver}
  6209. writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
  6210. {$ENDIF}
  6211. end;
  6212. end;
  6213. if not EnumeratorFound then
  6214. begin
  6215. {$IFDEF VerbosePasResolver}
  6216. {AllowWriteln}
  6217. writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
  6218. if VarRange<>nil then
  6219. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
  6220. {AllowWriteln-}
  6221. {$ENDIF}
  6222. RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  6223. [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
  6224. end;
  6225. finally
  6226. ReleaseEvalValue(VarRange);
  6227. ReleaseEvalValue(InRange);
  6228. end;
  6229. end;
  6230. end;
  6231. else
  6232. RaiseNotYetImplemented(20171108221334,Loop);
  6233. end;
  6234. end;
  6235. procedure TPasResolver.FinishDeclaration(El: TPasElement);
  6236. var
  6237. C: TClass;
  6238. begin
  6239. C:=El.ClassType;
  6240. if (C=TPasVariable) or (C=TPasConst) then
  6241. FinishVariable(TPasVariable(El))
  6242. else if C=TPasProperty then
  6243. FinishProperty(TPasProperty(El))
  6244. else if C=TPasArgument then
  6245. FinishArgument(TPasArgument(El))
  6246. else if C=TPasMethodResolution then
  6247. FinishMethodResolution(TPasMethodResolution(El))
  6248. else if C=TPasAttributes then
  6249. FinishAttributes(TPasAttributes(El))
  6250. else
  6251. begin
  6252. {$IFDEF VerbosePasResolver}
  6253. writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
  6254. {$ENDIF}
  6255. RaiseNotYetImplemented(20180127121557,El);
  6256. end;
  6257. end;
  6258. procedure TPasResolver.FinishVariable(El: TPasVariable);
  6259. var
  6260. ResolvedAbs: TPasResolverResult;
  6261. C: TClass;
  6262. Value: TResEvalValue;
  6263. begin
  6264. if (El.Visibility=visPublished) then
  6265. begin
  6266. if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
  6267. RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  6268. end;
  6269. if El.Expr<>nil then
  6270. ResolveExpr(El.Expr,rraRead);
  6271. if El.VarType<>nil then
  6272. begin
  6273. if (El.Parent is TPasRecordType) and (El.VarType=El.Parent) then
  6274. RaiseMsg(20181218173631,nTypeXIsNotYetCompletelyDefined,
  6275. sTypeXIsNotYetCompletelyDefined,[El.VarType.Name],El);
  6276. CheckUseAsType(El.VarType,20190123095916,El);
  6277. if El.Expr<>nil then
  6278. CheckAssignCompatibility(El,El.Expr,true);
  6279. end
  6280. else if El.Expr<>nil then
  6281. begin
  6282. // no VarType, has Expr, e.g. const a = Expr
  6283. Value:=Eval(El.Expr,[refConstExt]); // e.g. const Tau = 2*PI
  6284. ReleaseEvalValue(Value);
  6285. end;
  6286. if El.AbsoluteExpr<>nil then
  6287. begin
  6288. if El.ClassType=TPasConst then
  6289. RaiseMsg(20180201225530,nXModifierMismatchY,sXModifierMismatchY,
  6290. ['absolute','const'],El.AbsoluteExpr);
  6291. if El.VarType=nil then
  6292. RaiseMsg(20171225235125,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  6293. if vmExternal in El.VarModifiers then
  6294. RaiseMsg(20171226104221,nXModifierMismatchY,sXModifierMismatchY,
  6295. ['absolute','external'],El.AbsoluteExpr);
  6296. {$IFDEF VerbosePasResolver}
  6297. writeln('TPasResolver.FinishVariable El=',GetObjName(El),' Absolute="',GetObjName(El.AbsoluteExpr),'"');
  6298. {$ENDIF}
  6299. ResolveExpr(El.AbsoluteExpr,rraRead);
  6300. ComputeElement(El.AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
  6301. if (not (rrfReadable in ResolvedAbs.Flags))
  6302. or (ResolvedAbs.IdentEl=nil) then
  6303. RaiseVarExpected(20171225234734,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  6304. C:=ResolvedAbs.IdentEl.ClassType;
  6305. if (C=TPasVariable)
  6306. or (C=TPasArgument)
  6307. or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
  6308. else
  6309. RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  6310. if not (rrfReadable in ResolvedAbs.Flags) then
  6311. RaiseVarExpected(20171225235249,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  6312. // check for cycles
  6313. if ResolvedAbs.IdentEl=El then
  6314. RaiseMsg(20171226000703,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  6315. end;
  6316. if El.VarType<>nil then
  6317. EmitTypeHints(El,El.VarType);
  6318. end;
  6319. procedure TPasResolver.FinishProperty(PropEl: TPasProperty);
  6320. var
  6321. PropType: TPasType;
  6322. ClassOrRecScope: TPasClassOrRecordScope;
  6323. ClassScope: TPasClassScope;
  6324. AncestorProp: TPasProperty;
  6325. IndexExpr: TPasExpr;
  6326. procedure GetPropType;
  6327. var
  6328. AncEl: TPasElement;
  6329. GroupScope: TPasGroupScope;
  6330. begin
  6331. if PropType<>nil then exit;
  6332. AncEl:=nil;
  6333. if (ClassScope<>nil) and (ClassScope.AncestorScope<>nil) then
  6334. begin
  6335. CheckTopScope(TPasGroupScope);
  6336. GroupScope:=TPasGroupScope(TopScope);
  6337. AncEl:=GroupScope.FindAncestorElement(PropEl.Name);
  6338. end;
  6339. if AncEl is TPasProperty then
  6340. begin
  6341. // override or redeclaration property
  6342. AncestorProp:=TPasProperty(AncEl);
  6343. TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncestorProp;
  6344. if proFixCaseOfOverrides in Options then
  6345. PropEl.Name:=AncestorProp.Name;
  6346. end
  6347. else
  6348. AncestorProp:=nil;
  6349. if PropEl.VarType<>nil then
  6350. begin
  6351. // new property or redeclaration
  6352. PropType:=PropEl.VarType;
  6353. CheckUseAsType(PropEl.VarType,20190123100011,PropEl);
  6354. end
  6355. else
  6356. begin
  6357. // property override
  6358. if AncestorProp=nil then
  6359. RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
  6360. // check property versus class property
  6361. if PropEl.ClassType<>AncestorProp.ClassType then
  6362. RaiseXExpectedButYFound(20170216151744,GetElementTypeName(AncestorProp),GetElementTypeName(PropEl),PropEl);
  6363. // get inherited type
  6364. PropType:=GetPasPropertyType(AncestorProp);
  6365. // update DefaultProperty
  6366. if ClassScope=nil then
  6367. RaiseNotYetImplemented(20181231130642,PropEl);
  6368. if ClassScope.DefaultProperty=AncestorProp then
  6369. ClassScope.DefaultProperty:=PropEl;
  6370. end;
  6371. end;
  6372. function CheckClassAccessorStatic(ProcIsStatic: boolean): boolean;
  6373. begin
  6374. if ClassScope=nil then
  6375. // record: class getter/setter must be static
  6376. Result:=ProcIsStatic=true
  6377. else if proClassPropertyNonStatic in Options then
  6378. Result:=true // both allowed
  6379. else
  6380. Result:=ProcIsStatic=true;
  6381. end;
  6382. procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
  6383. ProcArg: TPasArgument; ErrorEl: TPasElement);
  6384. var
  6385. ProcArgResolved: TPasResolverResult;
  6386. begin
  6387. // check access: const, ...
  6388. if not (ProcArg.Access in [argDefault,argConst]) then
  6389. RaiseMsg(20170924202437,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6390. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  6391. AccessDescriptions[argConst]],ErrorEl);
  6392. // check argument type
  6393. if ProcArg.ArgType=nil then
  6394. RaiseMsg(20170924202531,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6395. [IntToStr(ArgNo),'untyped',GetTypeDescription(IndexResolved)],ErrorEl)
  6396. else
  6397. begin
  6398. if CheckParamCompatibility(IndexExpr,ProcArg,ArgNo,true)=cIncompatible then
  6399. begin
  6400. ComputeElement(ProcArg.ArgType,ProcArgResolved,[rcType]);
  6401. RaiseIncompatibleTypeRes(20170924203829,nIncompatibleTypeArgNo,
  6402. [IntToStr(ArgNo)],ProcArgResolved,IndexResolved,ErrorEl);
  6403. end;
  6404. end;
  6405. end;
  6406. procedure CheckArgs(Proc: TPasProcedure; const IndexVal: TResEvalValue;
  6407. const IndexResolved: TPasResolverResult; ErrorEl: TPasElement);
  6408. var
  6409. ArgNo: Integer;
  6410. PropArg, ProcArg: TPasArgument;
  6411. PropArgResolved, ProcArgResolved: TPasResolverResult;
  6412. NeedCheckingAccess: Boolean;
  6413. begin
  6414. ArgNo:=0;
  6415. while ArgNo<PropEl.Args.Count do
  6416. begin
  6417. if ArgNo>=Proc.ProcType.Args.Count then
  6418. RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
  6419. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  6420. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  6421. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  6422. inc(ArgNo);
  6423. // check access: var, const, ...
  6424. NeedCheckingAccess:=false;
  6425. if PropArg.Access<>ProcArg.Access then
  6426. begin
  6427. if (PropArg.Access in [argDefault, argConst])
  6428. and (ProcArg.Access in [argDefault, argConst]) then
  6429. begin
  6430. // passing an arg as default to const or const to default
  6431. if (PropArg.ArgType<>nil)
  6432. and (ProcArg.ArgType<>nil) then
  6433. NeedCheckingAccess:=true;
  6434. end;
  6435. if not NeedCheckingAccess then
  6436. RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6437. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  6438. AccessDescriptions[PropArg.Access]],ErrorEl);
  6439. end;
  6440. // check argument type
  6441. if PropArg.ArgType=nil then
  6442. begin
  6443. if ProcArg.ArgType<>nil then
  6444. RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6445. [IntToStr(ArgNo),GetElementTypeName(ProcArg.ArgType),'untyped'],ErrorEl);
  6446. end
  6447. else if ProcArg.ArgType=nil then
  6448. RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6449. [IntToStr(ArgNo),'untyped',GetElementTypeName(PropArg.ArgType)],ErrorEl)
  6450. else
  6451. begin
  6452. ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
  6453. ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
  6454. if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
  6455. RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6456. [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
  6457. if PropArgResolved.LoTypeEl=nil then
  6458. RaiseInternalError(20161010125255);
  6459. if ProcArgResolved.LoTypeEl=nil then
  6460. RaiseInternalError(20161010125304);
  6461. if not IsSameType(PropArgResolved.HiTypeEl,ProcArgResolved.HiTypeEl,prraSimple) then
  6462. RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
  6463. [IntToStr(ArgNo)],ProcArgResolved.HiTypeEl,PropArgResolved.HiTypeEl,ErrorEl);
  6464. end;
  6465. if NeedCheckingAccess then
  6466. begin
  6467. // passing an arg as default to const or const to default
  6468. // e.g.
  6469. // function GetItems(const i: integer): byte;
  6470. // property Items[i: integer]: byte read GetItems;
  6471. // => allowed for simple types
  6472. if not (PropArgResolved.BaseType in (btAllBooleans+btAllInteger+btAllStringAndChars+btAllFloats)) then
  6473. RaiseMsg(20181007181647,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6474. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  6475. AccessDescriptions[PropArg.Access]],ErrorEl);
  6476. end;
  6477. end;
  6478. if IndexVal<>nil then
  6479. begin
  6480. if ArgNo>=Proc.ProcType.Args.Count then
  6481. RaiseMsg(20170924202334,nWrongNumberOfParametersForCallTo,
  6482. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  6483. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  6484. CheckIndexArg(ArgNo,IndexResolved,ProcArg,ErrorEl);
  6485. end;
  6486. end;
  6487. procedure CheckImplements;
  6488. var
  6489. i, j: Integer;
  6490. Expr: TPasExpr;
  6491. ResolvedEl: TPasResolverResult;
  6492. aClass, PropClassType: TPasClassType;
  6493. IntfType, OrigIntfType, PropTypeRes: TPasType;
  6494. o: TObject;
  6495. begin
  6496. if not (PropEl.Parent is TPasClassType) then
  6497. RaiseInternalError(20180323172125,GetElementDbgPath(PropEl));
  6498. aClass:=TPasClassType(PropEl.Parent);
  6499. if PropEl.Args.Count>0 then
  6500. RaiseMsg(20180323170952,nImplementsDoesNotSupportArrayProperty,
  6501. sImplementsDoesNotSupportArrayProperty,[],PropEl.Implements[0]);
  6502. if IndexExpr<>nil then
  6503. RaiseMsg(20180323171354,nImplementsDoesNotSupportIndex,
  6504. sImplementsDoesNotSupportIndex,[],PropEl.Implements[0]);
  6505. if GetPasPropertyGetter(PropEl)=nil then
  6506. RaiseMsg(20180323221322,nImplPropMustHaveReadSpec,
  6507. sImplPropMustHaveReadSpec,[],PropEl.Implements[0]);
  6508. for i:=0 to length(PropEl.Implements)-1 do
  6509. begin
  6510. // resolve expression
  6511. Expr:=PropEl.Implements[i];
  6512. ResolveExpr(Expr,rraRead);
  6513. // check expr is an interface type
  6514. ComputeElement(Expr,ResolvedEl,[rcType,rcNoImplicitProc]);
  6515. if not (ResolvedEl.IdentEl is TPasType) then
  6516. if ResolvedEl.IdentEl=nil then
  6517. RaiseXExpectedButYFound(20180323171911,'interface',
  6518. GetElementTypeName(ResolvedEl.LoTypeEl),Expr)
  6519. else
  6520. RaiseXExpectedButYFound(20180323224846,'interface',
  6521. GetElementTypeName(ResolvedEl.IdentEl),Expr);
  6522. OrigIntfType:=TPasType(ResolvedEl.IdentEl);
  6523. IntfType:=ResolveAliasType(OrigIntfType);
  6524. if (not (IntfType is TPasClassType))
  6525. or (TPasClassType(IntfType).ObjKind<>okInterface) then
  6526. RaiseXExpectedButYFound(20180323172904,'interface',
  6527. GetElementTypeName(OrigIntfType),Expr);
  6528. // check it is one of the current implemented interfaces (not of ancestors)
  6529. j:=IndexOfImplementedInterface(aClass,IntfType);
  6530. if j<0 then
  6531. RaiseMsg(20180323172420,nImplementsUsedOnUnimplIntf,sImplementsUsedOnUnimplIntf,
  6532. [OrigIntfType.Name],Expr);
  6533. // check property type fits
  6534. PropTypeRes:=ResolveAliasType(PropType);
  6535. if not (PropTypeRes is TPasClassType) then
  6536. RaiseMsg(20180323222334,nDoesNotImplementInterface,sDoesNotImplementInterface,
  6537. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  6538. PropClassType:=TPasClassType(PropTypeRes);
  6539. case PropClassType.ObjKind of
  6540. okClass:
  6541. // e.g. property Obj: ClassType read Getter implements IntfType
  6542. // check ClassType or ancestors implements IntfType
  6543. if GetClassImplementsIntf(PropClassType,TPasClassType(IntfType))=nil then
  6544. RaiseMsg(20180323223324,nDoesNotImplementInterface,sDoesNotImplementInterface,
  6545. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  6546. okInterface:
  6547. // e.g. property IntfVar: IntfType read Getter implements IntfType2
  6548. // check that IntfType is IntfType2
  6549. if CheckClassIsClass(PropType,IntfType)=cIncompatible then
  6550. RaiseIncompatibleType(20180323173746,nIncompatibleTypesGotExpected,
  6551. [],OrigIntfType,PropType,Expr);
  6552. else
  6553. RaiseMsg(20180323222821,nDoesNotImplementInterface,sDoesNotImplementInterface,
  6554. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  6555. end;
  6556. // map
  6557. o:=TObject(ClassScope.Interfaces[j]);
  6558. if o is TPasProperty then
  6559. RaiseMsg(20180323174240,nDuplicateImplementsForIntf,sDuplicateImplementsForIntf,
  6560. [OrigIntfType.Name,GetElementSourcePosStr(TPasProperty(o))],Expr)
  6561. else if o is TPasClassIntfMap then
  6562. begin
  6563. // properties are checked before method resolutions
  6564. RaiseInternalError(20180323175919,GetElementDbgPath(PropEl));
  6565. end
  6566. else if o<>nil then
  6567. RaiseInternalError(20180323174342,GetObjName(o))
  6568. else
  6569. ClassScope.Interfaces[j]:=PropEl;
  6570. end;
  6571. end;
  6572. procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
  6573. const IndexResolved: TPasResolverResult);
  6574. var
  6575. ResolvedEl: TPasResolverResult;
  6576. Value: TResEvalValue;
  6577. Proc: TPasProcedure;
  6578. ResultType, TypeEl: TPasType;
  6579. aVar: TPasVariable;
  6580. IdentEl: TPasElement;
  6581. ExpArgCnt: Integer;
  6582. ProcArg: TPasArgument;
  6583. begin
  6584. ResolveExpr(Expr,rraRead);
  6585. ComputeElement(Expr,ResolvedEl,[rcNoImplicitProc]);
  6586. IdentEl:=ResolvedEl.IdentEl;
  6587. if IdentEl is TPasProcedure then
  6588. begin
  6589. // function
  6590. Proc:=TPasProcedure(IdentEl);
  6591. // check if member
  6592. if not (Expr is TPrimitiveExpr) then
  6593. RaiseXExpectedButYFound(20170923202002,'member function','foreign '+GetElementTypeName(Proc),Expr);
  6594. if Proc.ClassType<>TPasFunction then
  6595. RaiseXExpectedButYFound(20170216151925,'function',GetElementTypeName(Proc),Expr);
  6596. // check function result type
  6597. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  6598. if not IsBaseType(ResultType,btBoolean,true) then
  6599. RaiseXExpectedButYFound(20170923200836,'function: boolean',
  6600. 'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
  6601. // check arg count
  6602. ExpArgCnt:=0;
  6603. if IndexVal<>nil then
  6604. inc(ExpArgCnt);
  6605. if Proc.ProcType.Args.Count<>ExpArgCnt then
  6606. RaiseMsg(20170923200840,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  6607. [Proc.Name],Expr);
  6608. if IndexVal<>nil then
  6609. begin
  6610. // check arg type
  6611. ProcArg:=TPasArgument(Proc.ProcType.Args[0]);
  6612. CheckIndexArg(1,IndexResolved,ProcArg,Expr);
  6613. end;
  6614. exit;
  6615. end;
  6616. if (IdentEl<>nil)
  6617. and ((IdentEl.ClassType=TPasVariable)
  6618. or ((IdentEl.ClassType=TPasConst) and not TPasConst(IdentEl).IsConst)) then
  6619. begin
  6620. // field
  6621. aVar:=TPasVariable(IdentEl);
  6622. // check if member
  6623. if not (Expr is TPrimitiveExpr) then
  6624. RaiseXExpectedButYFound(20170923202003,'member variable','foreign '+GetElementTypeName(aVar),Expr);
  6625. // check type boolean
  6626. TypeEl:=aVar.VarType;
  6627. TypeEl:=ResolveAliasType(TypeEl);
  6628. if not IsBaseType(TypeEl,btBoolean,true) then
  6629. RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
  6630. [],TypeEl,BaseTypes[btBoolean],Expr);
  6631. // check class var
  6632. if (vmClass in PropEl.VarModifiers)<>(vmClass in aVar.VarModifiers) then
  6633. if vmClass in PropEl.VarModifiers then
  6634. RaiseXExpectedButYFound(20170409214351,'class var','var',Expr)
  6635. else
  6636. RaiseXExpectedButYFound(20170409214359,'var','class var',Expr);
  6637. exit;
  6638. end;
  6639. if (ResolvedEl.BaseType=btBoolean) and (ResolvedEl.ExprEl<>nil) then
  6640. begin
  6641. // try evaluating const boolean
  6642. Value:=Eval(Expr,[refConst]);
  6643. if Value<>nil then
  6644. try
  6645. if Value.Kind<>revkBool then
  6646. RaiseXExpectedButYFound(20170923200256,'boolean',GetResolverResultDescription(ResolvedEl),Expr);
  6647. exit;
  6648. finally
  6649. ReleaseEvalValue(Value);
  6650. end;
  6651. end;
  6652. RaiseXExpectedButYFound(20170923194234,'identifier',GetResolverResultDescription(ResolvedEl),Expr);
  6653. end;
  6654. var
  6655. ResultType, aType: TPasType;
  6656. MembersType: TPasMembersType;
  6657. AccEl: TPasElement;
  6658. Proc: TPasProcedure;
  6659. Arg: TPasArgument;
  6660. PropArgCount, NeedArgCnt: Integer;
  6661. PropTypeResolved, DefaultResolved, IndexResolved,
  6662. AncIndexResolved: TPasResolverResult;
  6663. m: TVariableModifier;
  6664. IndexVal: TResEvalValue;
  6665. AncIndexExpr: TPasExpr;
  6666. CurClass: TPasClassType;
  6667. begin
  6668. CheckTopScope(TPasPropertyScope);
  6669. PopScope;
  6670. if PropEl.Visibility=visPublished then
  6671. for m in PropEl.VarModifiers do
  6672. if not (m in [vmExternal]) then
  6673. RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
  6674. ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
  6675. PropType:=nil;
  6676. MembersType:=PropEl.Parent as TPasMembersType;
  6677. ClassOrRecScope:=NoNil(MembersType.CustomData) as TPasClassOrRecordScope;
  6678. ClassScope:=nil;
  6679. CurClass:=nil;
  6680. if ClassOrRecScope is TPasClassScope then
  6681. begin
  6682. ClassScope:=TPasClassScope(ClassOrRecScope);
  6683. CurClass:=TPasClassType(MembersType);
  6684. end;
  6685. AncestorProp:=nil;
  6686. GetPropType;
  6687. IndexVal:=nil;
  6688. try
  6689. if PropEl.IndexExpr<>nil then
  6690. begin
  6691. // index specifier
  6692. // -> check if simple value
  6693. IndexExpr:=PropEl.IndexExpr;
  6694. ResolveExpr(IndexExpr,rraRead);
  6695. end
  6696. else
  6697. IndexExpr:=GetPasPropertyIndex(PropEl);
  6698. if IndexExpr<>nil then
  6699. begin
  6700. ComputeElement(IndexExpr,IndexResolved,[rcConstant]);
  6701. IndexVal:=Eval(IndexExpr,[refConst]);
  6702. case IndexVal.Kind of
  6703. revkBool,
  6704. revkInt, revkUInt,
  6705. revkFloat,
  6706. revkCurrency,
  6707. {$ifdef FPC_HAS_CPSTRING}
  6708. revkString,
  6709. {$endif}
  6710. revkUnicodeString,
  6711. revkEnum: ; // ok
  6712. else
  6713. RaiseXExpectedButYFound(20170924202837,'ordinal',GetTypeDescription(IndexResolved),PropEl.IndexExpr);
  6714. end;
  6715. if (PropEl.IndexExpr<>nil) and (PropEl.VarType=nil) then
  6716. begin
  6717. // check if index is compatible to ancestor index specifier
  6718. AncIndexExpr:=GetPasPropertyIndex(AncestorProp);
  6719. if AncIndexExpr=nil then
  6720. begin
  6721. // ancestor had no index specifier
  6722. if PropEl.ReadAccessor=nil then
  6723. begin
  6724. AccEl:=GetPasPropertyGetter(AncestorProp);
  6725. if AccEl is TPasProcedure then
  6726. RaiseMsg(20171002144103,nAddingIndexSpecifierRequiresNewX,
  6727. sAddingIndexSpecifierRequiresNewX,['read'],IndexExpr);
  6728. end;
  6729. if PropEl.WriteAccessor=nil then
  6730. begin
  6731. AccEl:=GetPasPropertySetter(AncestorProp);
  6732. if AccEl is TPasProcedure then
  6733. RaiseMsg(20171002144419,nAddingIndexSpecifierRequiresNewX,
  6734. sAddingIndexSpecifierRequiresNewX,['write'],IndexExpr);
  6735. end;
  6736. if PropEl.StoredAccessor=nil then
  6737. begin
  6738. AccEl:=GetPasPropertyStoredExpr(AncestorProp);
  6739. if AccEl<>nil then
  6740. begin
  6741. ComputeElement(AccEl,AncIndexResolved,[rcNoImplicitProc]);
  6742. if AncIndexResolved.IdentEl is TPasProcedure then
  6743. RaiseMsg(20171002144644,nAddingIndexSpecifierRequiresNewX,
  6744. sAddingIndexSpecifierRequiresNewX,['stored'],IndexExpr);
  6745. end;
  6746. end;
  6747. end
  6748. else
  6749. // ancestor had already an index specifier -> check same type
  6750. CheckEqualElCompatibility(PropEl.IndexExpr,AncIndexExpr,PropEl.IndexExpr,true);
  6751. end;
  6752. end;
  6753. if PropEl.ReadAccessor<>nil then
  6754. begin
  6755. // check compatibility
  6756. AccEl:=ResolveAccessor(PropEl.ReadAccessor);
  6757. if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
  6758. begin
  6759. if (PropEl.Args.Count>0) then
  6760. RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),PropEl.ReadAccessor);
  6761. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  6762. RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
  6763. [],PropType,TPasVariable(AccEl).VarType,PropEl.ReadAccessor);
  6764. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  6765. if vmClass in PropEl.VarModifiers then
  6766. RaiseXExpectedButYFound(20170216151828,'class var','var',PropEl.ReadAccessor)
  6767. else
  6768. RaiseXExpectedButYFound(20170216151831,'var','class var',PropEl.ReadAccessor);
  6769. end
  6770. else if AccEl is TPasProcedure then
  6771. begin
  6772. // check function
  6773. Proc:=TPasProcedure(AccEl);
  6774. if (vmClass in PropEl.VarModifiers) then
  6775. begin
  6776. if Proc.ClassType<>TPasClassFunction then
  6777. RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),PropEl.ReadAccessor);
  6778. if not CheckClassAccessorStatic(Proc.IsStatic) then
  6779. if Proc.IsStatic then
  6780. RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
  6781. else
  6782. RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
  6783. end
  6784. else
  6785. begin
  6786. if Proc.ClassType<>TPasFunction then
  6787. RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),PropEl.ReadAccessor);
  6788. end;
  6789. // check function result type
  6790. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  6791. if not IsSameType(ResultType,PropType,prraAlias) then
  6792. RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
  6793. GetTypeDescription(ResultType,true),PropEl.ReadAccessor);
  6794. // check args
  6795. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  6796. NeedArgCnt:=PropEl.Args.Count;
  6797. if IndexVal<>nil then
  6798. inc(NeedArgCnt);
  6799. if Proc.ProcType.Args.Count<>NeedArgCnt then
  6800. RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  6801. [Proc.Name],PropEl.ReadAccessor);
  6802. end
  6803. else
  6804. RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),PropEl.ReadAccessor);
  6805. end;
  6806. if PropEl.WriteAccessor<>nil then
  6807. begin
  6808. // check compatibility
  6809. AccEl:=ResolveAccessor(PropEl.WriteAccessor);
  6810. if (AccEl.ClassType=TPasVariable)
  6811. or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
  6812. begin
  6813. if (PropEl.Args.Count>0) then
  6814. RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),PropEl.WriteAccessor);
  6815. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  6816. RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
  6817. [],PropType,TPasVariable(AccEl).VarType,PropEl.WriteAccessor);
  6818. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  6819. if vmClass in PropEl.VarModifiers then
  6820. RaiseXExpectedButYFound(20170216151858,'class var','var',PropEl.WriteAccessor)
  6821. else
  6822. RaiseXExpectedButYFound(20170216151900,'var','class var',PropEl.WriteAccessor);
  6823. end
  6824. else if AccEl is TPasProcedure then
  6825. begin
  6826. // check procedure
  6827. Proc:=TPasProcedure(AccEl);
  6828. if (vmClass in PropEl.VarModifiers) then
  6829. begin
  6830. if Proc.ClassType<>TPasClassProcedure then
  6831. RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
  6832. if not CheckClassAccessorStatic(Proc.IsStatic) then
  6833. if Proc.IsStatic then
  6834. RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
  6835. else
  6836. RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
  6837. end
  6838. else
  6839. begin
  6840. if Proc.ClassType<>TPasProcedure then
  6841. RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),PropEl.WriteAccessor);
  6842. end;
  6843. // check args
  6844. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  6845. // check write arg
  6846. PropArgCount:=PropEl.Args.Count;
  6847. if IndexVal<>nil then
  6848. inc(PropArgCount);
  6849. if Proc.ProcType.Args.Count<>PropArgCount+1 then
  6850. RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  6851. [Proc.Name],PropEl.WriteAccessor);
  6852. Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
  6853. if not (Arg.Access in [argDefault,argConst]) then
  6854. RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  6855. [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
  6856. AccessDescriptions[argConst]],PropEl.WriteAccessor);
  6857. if not IsSameType(Arg.ArgType,PropType,prraAlias) then
  6858. RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
  6859. [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
  6860. end
  6861. else
  6862. RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
  6863. end
  6864. else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
  6865. RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
  6866. if length(PropEl.Implements)>0 then
  6867. CheckImplements;
  6868. if PropEl.StoredAccessor<>nil then
  6869. begin
  6870. // check compatibility
  6871. CheckStoredAccessor(PropEl.StoredAccessor,IndexVal,IndexResolved);
  6872. end;
  6873. if PropEl.DefaultExpr<>nil then
  6874. begin
  6875. // check compatibility with type
  6876. ResolveExpr(PropEl.DefaultExpr,rraRead);
  6877. ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
  6878. ComputeElement(PropType,PropTypeResolved,[rcType]);
  6879. PropTypeResolved.IdentEl:=PropEl;
  6880. PropTypeResolved.Flags:=[rrfReadable];
  6881. CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
  6882. end;
  6883. if PropEl.IsDefault then
  6884. begin
  6885. if (CurClass<>nil) and (CurClass.HelperForType<>nil) then
  6886. begin
  6887. aType:=ResolveAliasType(CurClass.HelperForType);
  6888. if not (aType is TPasMembersType) then
  6889. RaiseMsg(20190117125004,nDefaultPropertyNotAllowedInHelperForX,
  6890. sDefaultPropertyNotAllowedInHelperForX,
  6891. [GetTypeDescription(CurClass.HelperForType)],PropEl);
  6892. end;
  6893. // set default array property
  6894. if (ClassOrRecScope.DefaultProperty<>nil)
  6895. and (ClassOrRecScope.DefaultProperty.Parent=PropEl.Parent) then
  6896. RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
  6897. ClassOrRecScope.DefaultProperty:=PropEl;
  6898. end;
  6899. EmitTypeHints(PropEl,PropEl.VarType);
  6900. finally
  6901. ReleaseEvalValue(IndexVal);
  6902. end;
  6903. end;
  6904. procedure TPasResolver.FinishArgument(El: TPasArgument);
  6905. begin
  6906. if El.ArgType<>nil then
  6907. CheckUseAsType(El.ArgType,20190123100049,El);
  6908. if El.ValueExpr<>nil then
  6909. begin
  6910. ResolveExpr(El.ValueExpr,rraRead);
  6911. if El.ArgType<>nil then
  6912. CheckAssignCompatibility(El,El.ValueExpr,true);
  6913. end;
  6914. EmitTypeHints(El,El.ArgType);
  6915. end;
  6916. procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
  6917. // called when the ancestor and interface list of a class has been parsed,
  6918. // before parsing the class elements
  6919. var
  6920. DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
  6921. AncestorClassEl: TPasClassType;
  6922. function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
  6923. begin
  6924. Result:=SameText(c.Name,DefAncestorName)
  6925. and (c.Parent is TPasSection);
  6926. end;
  6927. procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
  6928. var
  6929. CurEl: TPasElement;
  6930. begin
  6931. AncestorClassEl:=nil;
  6932. if SameText(aClass.Name,DefAncestorName) then
  6933. begin
  6934. if IsDefaultAncestor(aClass,DefAncestorName) then exit;
  6935. RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
  6936. end;
  6937. CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false);
  6938. if not (CurEl is TPasType) then
  6939. RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
  6940. DirectAncestor:=TPasType(CurEl);
  6941. CurEl:=ResolveAliasType(DirectAncestor);
  6942. if not (CurEl is TPasClassType) then
  6943. RaiseXExpectedButYFound(20170216151941,Expected,GetElementTypeName(DirectAncestor),aClass);
  6944. AncestorClassEl:=TPasClassType(CurEl);
  6945. end;
  6946. var
  6947. ClassScope, AncestorClassScope: TPasClassScope;
  6948. AncestorType, El: TPasType;
  6949. i: Integer;
  6950. aModifier, DefAncestorName: String;
  6951. IsSealed: Boolean;
  6952. CanonicalSelf: TPasClassOfType;
  6953. Decl: TPasElement;
  6954. j: integer;
  6955. IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
  6956. ResIntfList, Members: TFPList;
  6957. GroupScope: TPasGroupScope;
  6958. C: TClass;
  6959. begin
  6960. if aClass.IsForward then
  6961. begin
  6962. // check for duplicate forwards
  6963. C:=aClass.Parent.ClassType;
  6964. if C.InheritsFrom(TPasDeclarations) then
  6965. Members:=TPasDeclarations(aClass.Parent).Declarations
  6966. else if (C=TPasClassType) or (C=TPasRecordType) then
  6967. Members:=TPasMembersType(aClass.Parent).Members
  6968. else
  6969. RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
  6970. for i:=0 to Members.Count-1 do
  6971. begin
  6972. Decl:=TPasElement(Members[i]);
  6973. if (CompareText(Decl.Name,aClass.Name)=0)
  6974. and (Decl<>aClass) then
  6975. RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
  6976. [Decl.Name,GetElementSourcePosStr(Decl)],aClass);
  6977. end;
  6978. exit;
  6979. end;
  6980. case aClass.ObjKind of
  6981. okClass:
  6982. begin
  6983. AncestorType:=ResolveAliasType(aClass.AncestorType);
  6984. if (AncestorType is TPasClassType)
  6985. and (TPasClassType(AncestorType).ObjKind=okInterface)
  6986. and not (msDelphi in CurrentParser.CurrentModeswitches) then
  6987. begin
  6988. // e.g. type c = class(intf)
  6989. aClass.Interfaces.Insert(0,aClass.AncestorType);
  6990. aClass.AncestorType:=nil;
  6991. end;
  6992. end;
  6993. okInterface:
  6994. begin
  6995. if aClass.IsExternal then
  6996. RaiseMsg(20180321115831,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  6997. if not (aClass.InterfaceType in [citCom,citCorba]) then
  6998. RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
  6999. [CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
  7000. end;
  7001. okClassHelper,okRecordHelper,okTypeHelper:
  7002. begin
  7003. if aClass.IsExternal then
  7004. RaiseMsg(20190116192722,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  7005. HelperForType:=ResolveAliasType(aClass.HelperForType);
  7006. if (aClass=HelperForType) or (aClass.HasParent(HelperForType)) then
  7007. RaiseMsg(20190118190935,nTypeXIsNotYetCompletelyDefined,
  7008. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7009. case aClass.ObjKind of
  7010. okClassHelper:
  7011. begin
  7012. if not (HelperForType is TPasClassType) then
  7013. RaiseXExpectedButYFound(20190116194751,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  7014. if TPasClassType(HelperForType).ObjKind<>okClass then
  7015. RaiseXExpectedButYFound(20190116194855,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  7016. if TPasClassType(HelperForType).IsForward then
  7017. RaiseMsg(20190116194931,nTypeXIsNotYetCompletelyDefined,
  7018. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7019. end;
  7020. okRecordHelper:
  7021. if msDelphi in CurrentParser.CurrentModeswitches then
  7022. begin
  7023. if (HelperForType.ClassType=TPasRecordType)
  7024. or (HelperForType.ClassType=TPasArrayType)
  7025. or (HelperForType.ClassType=TPasSetType)
  7026. or (HelperForType.ClassType=TPasEnumType)
  7027. or (HelperForType.ClassType=TPasRangeType)
  7028. then
  7029. // ok
  7030. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  7031. and (HelperForType.CustomData is TResElDataBaseType)) then
  7032. else
  7033. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByARecordHelper,
  7034. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  7035. end
  7036. else
  7037. begin
  7038. // mode objfpc
  7039. if (HelperForType.ClassType=TPasRecordType) then
  7040. else
  7041. RaiseMsg(20190116200519,nTypeXCannotBeExtendedByARecordHelper,
  7042. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  7043. end;
  7044. okTypeHelper:
  7045. begin
  7046. if (HelperForType.ClassType=TPasRecordType)
  7047. or (HelperForType.ClassType=TPasArrayType)
  7048. or (HelperForType.ClassType=TPasSetType)
  7049. or (HelperForType.ClassType=TPasEnumType)
  7050. or (HelperForType.ClassType=TPasRangeType)
  7051. then
  7052. // ok
  7053. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  7054. and (HelperForType.CustomData is TResElDataBaseType)) then
  7055. else if (HelperForType.ClassType=TPasClassType)
  7056. and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
  7057. begin
  7058. if TPasClassType(HelperForType).IsForward then
  7059. RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
  7060. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  7061. end
  7062. else
  7063. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
  7064. sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass);
  7065. end;
  7066. end;
  7067. end
  7068. else
  7069. RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
  7070. end;
  7071. IsSealed:=false;
  7072. for i:=0 to aClass.Modifiers.Count-1 do
  7073. begin
  7074. aModifier:=lowercase(aClass.Modifiers[i]);
  7075. case aModifier of
  7076. 'sealed': IsSealed:=true;
  7077. 'abstract': ;
  7078. else
  7079. RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
  7080. end;
  7081. end;
  7082. AncestorClassEl:=nil;
  7083. DirectAncestor:=aClass.AncestorType;
  7084. AncestorType:=ResolveAliasType(DirectAncestor);
  7085. if AncestorType=nil then
  7086. begin
  7087. if DirectAncestor<>nil then
  7088. RaiseInternalError(20180321151851,GetObjName(DirectAncestor));
  7089. // use default ancestor
  7090. DefAncestorName:='';
  7091. case aClass.ObjKind of
  7092. okClass:
  7093. begin
  7094. DefAncestorName:='TObject';
  7095. if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
  7096. begin
  7097. // ok, no ancestor
  7098. AncestorClassEl:=nil;
  7099. end
  7100. else
  7101. begin
  7102. // search default ancestor TObject
  7103. FindDefaultAncestor(DefAncestorName,'class type');
  7104. if TPasClassType(AncestorClassEl).ObjKind<>okClass then
  7105. RaiseXExpectedButYFound(20180321145626,'class type',GetElementTypeName(AncestorClassEl),aClass);
  7106. end;
  7107. end;
  7108. okInterface:
  7109. begin
  7110. if aClass.InterfaceType=citCom then
  7111. begin
  7112. if msDelphi in CurrentParser.CurrentModeswitches then
  7113. DefAncestorName:='IInterface'
  7114. else
  7115. DefAncestorName:='IUnknown';
  7116. if IsDefaultAncestor(aClass,DefAncestorName) then
  7117. AncestorClassEl:=nil
  7118. else
  7119. begin
  7120. // search default ancestor interface
  7121. FindDefaultAncestor(DefAncestorName,'interface type');
  7122. if TPasClassType(AncestorClassEl).ObjKind<>okInterface then
  7123. RaiseXExpectedButYFound(20180321145725,'interface type',
  7124. GetElementTypeName(AncestorClassEl),aClass);
  7125. end;
  7126. end;
  7127. end;
  7128. okClassHelper,okRecordHelper,okTypeHelper: ; // no root ancestor
  7129. end;
  7130. end
  7131. else if AncestorType.ClassType<>TPasClassType then
  7132. RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
  7133. else if aClass=AncestorType then
  7134. RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
  7135. else
  7136. begin
  7137. AncestorClassEl:=TPasClassType(AncestorType);
  7138. if AncestorClassEl.ObjKind<>aClass.ObjKind then
  7139. RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
  7140. GetElementTypeName(AncestorClassEl)+' type',aClass);
  7141. if aClass.ObjKind in okAllHelpers then
  7142. begin
  7143. HelperForType:=ResolveAliasType(aClass.HelperForType);
  7144. AncestorHelperFor:=ResolveAliasType(AncestorClassEl.HelperForType);
  7145. if IsSameType(HelperForType,AncestorHelperFor,prraNone) then
  7146. // helper for same type as ancestor helper -> ok
  7147. else if (HelperForType is TPasClassType)
  7148. and (AncestorHelperFor is TPasClassType)
  7149. and (CheckClassIsClass(HelperForType,AncestorHelperFor)<>cIncompatible) then
  7150. // helper for descendant class of ancestor helper for -> ok
  7151. else
  7152. RaiseMsg(20190116203931,nDerivedXMustExtendASubClassY,sDerivedXMustExtendASubClassY,
  7153. [GetElementTypeName(aClass),AncestorClassEl.HelperForType.Name],aClass);
  7154. end;
  7155. EmitTypeHints(aClass,AncestorClassEl);
  7156. end;
  7157. AncestorClassScope:=nil;
  7158. if AncestorClassEl=nil then
  7159. begin
  7160. // root class e.g. TObject, IUnknown, helper
  7161. end
  7162. else
  7163. begin
  7164. // inherited class
  7165. if AncestorClassEl.IsForward then
  7166. RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
  7167. sCantUseForwardDeclarationAsAncestor,[AncestorClassEl.Name],aClass);
  7168. if aClass.IsExternal and not AncestorClassEl.IsExternal then
  7169. RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
  7170. [AncestorClassEl.Name],aClass);
  7171. AncestorClassScope:=AncestorClassEl.CustomData as TPasClassScope;
  7172. if pcsfSealed in AncestorClassScope.Flags then
  7173. RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedXY,
  7174. sCannotCreateADescendantOfTheSealedXY,
  7175. [GetElementTypeName(AncestorClassEl),AncestorClassEl.Name],aClass);
  7176. // check for cycle
  7177. El:=AncestorClassEl;
  7178. repeat
  7179. if El=aClass then
  7180. RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
  7181. if (El.ClassType=TPasAliasType)
  7182. or (El.ClassType=TPasTypeAliasType)
  7183. then
  7184. El:=TPasAliasType(El).DestType
  7185. else if El.ClassType=TPasClassType then
  7186. El:=TPasClassType(El).AncestorType;
  7187. until El=nil;
  7188. end;
  7189. // start scope for elements
  7190. {$IFDEF VerbosePasResolver}
  7191. //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
  7192. {$ENDIF}
  7193. ClassScope:=TPasClassScope(CreateScope(aClass,ScopeClass_Class));
  7194. Include(ClassScope.Flags,pcsfAncestorResolved);
  7195. if IsSealed then
  7196. Include(ClassScope.Flags,pcsfSealed);
  7197. ClassScope.DirectAncestor:=DirectAncestor;
  7198. if AncestorClassEl<>nil then
  7199. begin
  7200. ClassScope.AncestorScope:=AncestorClassScope;
  7201. ClassScope.DefaultProperty:=AncestorClassScope.DefaultProperty;
  7202. if pcsfPublished in AncestorClassScope.Flags then
  7203. Include(ClassScope.Flags,pcsfPublished);
  7204. ClassScope.AbstractProcs:=copy(AncestorClassScope.AbstractProcs);
  7205. end;
  7206. if bsTypeInfo in CurrentParser.Scanner.CurrentBoolSwitches then
  7207. Include(ClassScope.Flags,pcsfPublished);
  7208. if aClass.ObjKind in ([okClass]+okAllHelpers) then
  7209. begin
  7210. // create canonical class-of for the "Self" in non static class functions
  7211. CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
  7212. ClassScope.CanonicalClassOf:=CanonicalSelf;
  7213. {$IFDEF CheckPasTreeRefCount}CanonicalSelf.RefIds.Add('TPasClassScope.CanonicalClassOf');{$ENDIF}
  7214. CanonicalSelf.DestType:=aClass;
  7215. aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
  7216. CanonicalSelf.Visibility:=visStrictPrivate;
  7217. CanonicalSelf.SourceFilename:=aClass.SourceFilename;
  7218. CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
  7219. end;
  7220. // push scope (must be done after setting aClass.AncestorScope)
  7221. GroupScope:=PushGroupScope(aClass);
  7222. GroupScope.VisibilityContext:=aClass;
  7223. // check interfaces
  7224. if aClass.Interfaces.Count>0 then
  7225. begin
  7226. if not (aClass.ObjKind in [okClass]) then
  7227. RaiseXExpectedButYFound(20180322001341,'one ancestor',
  7228. IntToStr(1+aClass.Interfaces.Count),aClass);
  7229. if aClass.IsExternal then
  7230. RaiseMsg(20180324183641,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  7231. ResIntfList:=TFPList.Create;
  7232. try
  7233. for i:=0 to aClass.Interfaces.Count-1 do
  7234. begin
  7235. IntfType:=TPasType(aClass.Interfaces[i]);
  7236. IntfTypeRes:=ResolveAliasType(IntfType);
  7237. if IntfTypeRes=nil then
  7238. RaiseMsg(20180322140044,nCantUseForwardDeclarationAsAncestor,
  7239. sCantUseForwardDeclarationAsAncestor,[IntfType.Name],aClass);
  7240. if not (IntfTypeRes is TPasClassType) then
  7241. RaiseXExpectedButYFound(20180322001051,'interface type',
  7242. GetElementTypeName(IntfTypeRes)+' type',aClass);
  7243. if TPasClassType(IntfTypeRes).ObjKind<>okInterface then
  7244. RaiseXExpectedButYFound(20180322001143,'interface type',
  7245. GetElementTypeName(IntfTypeRes)+' type',aClass);
  7246. j:=ResIntfList.IndexOf(IntfTypeRes);
  7247. if j>=0 then
  7248. RaiseMsg(20180322001505,nDuplicateIdentifier,sDuplicateIdentifier,
  7249. [IntfType.Name,IntToStr(j+1)],aClass); // todo: jump to interface list
  7250. ResIntfList.Add(IntfTypeRes);
  7251. end;
  7252. finally
  7253. ResIntfList.Free;
  7254. end;
  7255. // create interfaces maps
  7256. ClassScope.Interfaces:=TFPList.Create;
  7257. ClassScope.Interfaces.Count:=aClass.Interfaces.Count;
  7258. end;
  7259. end;
  7260. procedure TPasResolver.FinishMethodResolution(El: TPasMethodResolution);
  7261. var
  7262. ResolvedEl: TPasResolverResult;
  7263. aClass, IntfType: TPasClassType;
  7264. i: Integer;
  7265. IntfProc: TPasProcedure;
  7266. Expr: TPasExpr;
  7267. ProcName: String;
  7268. IntfScope: TPasClassScope;
  7269. Identifier: TPasIdentifier;
  7270. begin
  7271. // procedure InterfaceName.InterfaceProc = ...
  7272. // check InterfaceName
  7273. ResolveExpr(El.InterfaceName,rraRead);
  7274. ComputeElement(El.InterfaceName,ResolvedEl,[rcType,rcNoImplicitProc]);
  7275. if not (ResolvedEl.IdentEl is TPasType) then
  7276. RaiseXExpectedButYFound(20180323132601,'interface type',
  7277. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  7278. aClass:=El.Parent as TPasClassType;
  7279. i:=IndexOfImplementedInterface(aClass,TPasType(ResolvedEl.IdentEl));
  7280. if i<0 then
  7281. RaiseXExpectedButYFound(20180323133055,'interface type',
  7282. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  7283. IntfType:=TPasClassType(ResolveAliasType(TPasClassType(aClass.Interfaces[i])));
  7284. // check InterfaceProc
  7285. Expr:=El.InterfaceProc;
  7286. if not (Expr is TPrimitiveExpr) then
  7287. RaiseXExpectedButYFound(20180327152808,'method name',GetElementTypeName(Expr),Expr);
  7288. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  7289. RaiseXExpectedButYFound(20180327152841,'method name',GetElementTypeName(Expr),Expr);
  7290. ProcName:=TPrimitiveExpr(Expr).Value;
  7291. IntfScope:=IntfType.CustomData as TPasClassScope;
  7292. IntfProc:=nil;
  7293. while IntfScope<>nil do
  7294. begin
  7295. Identifier:=IntfScope.FindLocalIdentifier(ProcName);
  7296. while Identifier<>nil do
  7297. begin
  7298. if not (Identifier.Element is TPasProcedure) then
  7299. RaiseXExpectedButYFound(20180327153110,'interface method',GetElementTypeName(Identifier.Element),Expr);
  7300. IntfProc:=TPasProcedure(Identifier.Element);
  7301. if IntfProc.ClassType=El.ProcClass then
  7302. break;
  7303. Identifier:=Identifier.NextSameIdentifier;
  7304. end;
  7305. IntfScope:=IntfScope.AncestorScope;
  7306. end;
  7307. if IntfProc=nil then
  7308. RaiseIdentifierNotFound(20180327153044,ProcName,Expr);
  7309. CreateReference(IntfProc,Expr,rraRead);
  7310. if IntfProc.ClassType<>El.ProcClass then
  7311. RaiseXExpectedButYFound(20180323144107,GetElementTypeName(El.ProcClass),GetElementTypeName(IntfProc),El.InterfaceProc);
  7312. // Note: do not create map here. CheckImplements in FinishProperty must be called before.
  7313. // El.ImplementationProc is resolved in FinishClassType
  7314. end;
  7315. procedure TPasResolver.FinishAttributes(El: TPasAttributes);
  7316. var
  7317. i, j: Integer;
  7318. NameExpr, Expr: TPasExpr;
  7319. Bin: TBinaryExpr;
  7320. LeftResolved, ParamResolved: TPasResolverResult;
  7321. aModule: TPasModule;
  7322. LTypeEl: TPasType;
  7323. AttrName: String;
  7324. Data: TPRFindData;
  7325. CurEl, DeclEl: TPasElement;
  7326. ClassEl: TPasClassType;
  7327. aConstructor: TPasConstructor;
  7328. Args: TFPList;
  7329. AttrRef, ParamRef: TResolvedReference;
  7330. DotScope: TPasDotBaseScope;
  7331. Params: TPasExprArray;
  7332. begin
  7333. for i:=0 to length(El.Calls)-1 do
  7334. begin
  7335. NameExpr:=El.Calls[i];
  7336. {$IFDEF VerbosePasResolver}
  7337. //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
  7338. {$ENDIF}
  7339. if NameExpr is TParamsExpr then
  7340. NameExpr:=TParamsExpr(NameExpr).Value;
  7341. DotScope:=nil;
  7342. if NameExpr is TBinaryExpr then
  7343. begin
  7344. Bin:=TBinaryExpr(NameExpr);
  7345. ResolveExpr(Bin.left,rraRead);
  7346. ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
  7347. if LeftResolved.BaseType=btModule then
  7348. begin
  7349. // e.g. unitname.identifier
  7350. // => search in interface and if this is our module in the implementation
  7351. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  7352. DotScope:=PushModuleDotScope(aModule);
  7353. end
  7354. else if (LeftResolved.BaseType=btContext)
  7355. and (LeftResolved.IdentEl is TPasType)
  7356. and (LeftResolved.LoTypeEl is TPasMembersType) then
  7357. begin
  7358. // classtype.identifier or recordtype.identifier
  7359. LTypeEl:=LeftResolved.LoTypeEl;
  7360. if LTypeEl.ClassType=TPasClassType then
  7361. begin
  7362. DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
  7363. DotScope.OnlyTypeMembers:=true;
  7364. end
  7365. else if LTypeEl.ClassType=TPasRecordType then
  7366. begin
  7367. DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
  7368. DotScope.OnlyTypeMembers:=true;
  7369. end
  7370. else
  7371. RaiseNotYetImplemented(20190221124930,Bin);
  7372. end
  7373. else
  7374. RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
  7375. ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
  7376. NameExpr:=Bin.right;
  7377. end;
  7378. // find attribute class
  7379. if not IsNameExpr(NameExpr) then
  7380. RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
  7381. ['identifier',GetElementTypeName(Bin)],NameExpr);
  7382. AttrName:=TPrimitiveExpr(NameExpr).Value;
  7383. CurEl:=nil;
  7384. if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
  7385. begin
  7386. // first search AttrName+'Attibute'
  7387. CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
  7388. end;
  7389. // then search the name
  7390. if CurEl=nil then
  7391. CurEl:=FindFirstEl(AttrName,Data,NameExpr);
  7392. if DotScope<>nil then
  7393. PopScope;
  7394. {$IFDEF VerbosePasResolver}
  7395. writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
  7396. {$ENDIF}
  7397. // check if found element is a TCustomAttribute
  7398. if CurEl=nil then
  7399. begin
  7400. LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
  7401. [AttrName],NameExpr);
  7402. continue;
  7403. end;
  7404. if not IsCustomAttribute(CurEl) then
  7405. RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  7406. [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
  7407. ClassEl:=TPasClassType(CurEl);
  7408. AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
  7409. if ClassEl.IsAbstract then
  7410. // Delphi silently skips attributes using abstract classes/methods
  7411. LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
  7412. sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
  7413. // search constructor "Create" using the params
  7414. DotScope:=PushClassDotScope(ClassEl);
  7415. DotScope.OnlyTypeMembers:=true;
  7416. Expr:=El.Calls[i];
  7417. if Expr is TParamsExpr then
  7418. begin
  7419. // attribute with params
  7420. if Expr.Kind<>pekFuncParams then
  7421. begin
  7422. {$IFDEF VerbosePasResolver}
  7423. writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
  7424. {$ENDIF}
  7425. RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
  7426. ['(','['],Expr);
  7427. end;
  7428. // first resolve params
  7429. ResolveParamsExprParams(TParamsExpr(Expr));
  7430. // then resolve call 'Create'
  7431. ResolveFuncParamsExprName(Expr,TParamsExpr(Expr),rraRead,'Create');
  7432. // then check that each parameter is a constant expression
  7433. Params:=TParamsExpr(Expr).Params;
  7434. for j:=0 to length(Params)-1 do
  7435. ComputeElement(Params[j],ParamResolved,[rcConstant]);
  7436. // check if call is constructor
  7437. ParamRef:=Expr.CustomData as TResolvedReference;
  7438. DeclEl:=ParamRef.Declaration;
  7439. if DeclEl.ClassType<>TPasConstructor then
  7440. RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
  7441. aConstructor:=TPasConstructor(DeclEl);
  7442. end
  7443. else
  7444. begin
  7445. // attribute without params
  7446. // -> resolve call 'Create'
  7447. DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false);
  7448. if DeclEl=nil then
  7449. RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
  7450. // check call is constructor
  7451. if DeclEl.ClassType<>TPasConstructor then
  7452. RaiseXExpectedButYFound(20190221145003,'constructor Create',
  7453. GetElementTypeName(DeclEl),NameExpr);
  7454. aConstructor:=TPasConstructor(DeclEl);
  7455. // check constructor without needed args
  7456. Args:=aConstructor.ProcType.Args;
  7457. if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
  7458. RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
  7459. sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
  7460. end;
  7461. if aConstructor.IsAbstract then
  7462. LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
  7463. sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
  7464. // store reference to constructor in NameExpr
  7465. if AttrRef.Context<>nil then
  7466. RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
  7467. AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
  7468. TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
  7469. PopScope;
  7470. end;
  7471. end;
  7472. procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
  7473. Params: TParamsExpr);
  7474. var
  7475. ParamAccess: TResolvedRefAccess;
  7476. i: Integer;
  7477. ArrParams: TPasExprArray;
  7478. begin
  7479. ArrParams:=Params.Params;
  7480. for i:=0 to length(ArrParams)-1 do
  7481. begin
  7482. ParamAccess:=rraRead;
  7483. if i<ProcType.Args.Count then
  7484. case TPasArgument(ProcType.Args[i]).Access of
  7485. argVar: ParamAccess:=rraVarParam;
  7486. argOut: ParamAccess:=rraOutParam;
  7487. end;
  7488. AccessExpr(ArrParams[i],ParamAccess);
  7489. end;
  7490. CheckCallProcCompatibility(ProcType,Params,false,true);
  7491. end;
  7492. procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
  7493. Prop: TPasProperty);
  7494. var
  7495. i: Integer;
  7496. ParamAccess: TResolvedRefAccess;
  7497. begin
  7498. for i:=0 to length(Params.Params)-1 do
  7499. begin
  7500. ParamAccess:=rraRead;
  7501. if i<Prop.Args.Count then
  7502. case TPasArgument(Prop.Args[i]).Access of
  7503. argVar: ParamAccess:=rraVarParam;
  7504. argOut: ParamAccess:=rraOutParam;
  7505. end;
  7506. AccessExpr(Params.Params[i],ParamAccess);
  7507. end;
  7508. end;
  7509. procedure TPasResolver.FinishCallArgAccess(Expr: TPasExpr;
  7510. Access: TResolvedRefAccess);
  7511. var
  7512. ResolvedEl: TPasResolverResult;
  7513. Flags: TPasResolverComputeFlags;
  7514. begin
  7515. AccessExpr(Expr,Access);
  7516. Flags:=[rcSetReferenceFlags];
  7517. if Access<>rraRead then
  7518. Include(Flags,rcNoImplicitProc);
  7519. ComputeElement(Expr,ResolvedEl,Flags);
  7520. end;
  7521. procedure TPasResolver.FinishInitialFinalization(El: TPasImplBlock);
  7522. begin
  7523. if El=nil then ;
  7524. CheckTopScope(ScopeClass_InitialFinalization);
  7525. PopScope;
  7526. end;
  7527. procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
  7528. begin
  7529. while aType<>nil do
  7530. begin
  7531. if EmitElementHints(PosEl,aType) then
  7532. exit; // give only hints for the nearest
  7533. if aType.InheritsFrom(TPasAliasType) then
  7534. aType:=TPasAliasType(aType).DestType
  7535. else if aType.ClassType=TPasPointerType then
  7536. aType:=TPasPointerType(aType).DestType
  7537. else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
  7538. and (aType.CustomData<>nil) then
  7539. aType:=TPasType((aType.CustomData as TResolvedReference).Declaration)
  7540. else
  7541. exit;
  7542. end;
  7543. end;
  7544. function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
  7545. begin
  7546. if IsElementSkipped(El) then
  7547. RaiseMsg(20170927160030,nNotYetImplemented,sNotYetImplemented,[GetObjName(El)],PosEl);
  7548. if El.Hints=[] then exit(false);
  7549. Result:=true;
  7550. if hDeprecated in El.Hints then
  7551. begin
  7552. if El.HintMessage<>'' then
  7553. LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
  7554. [El.Name,El.HintMessage],PosEl)
  7555. else
  7556. LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
  7557. [El.Name],PosEl);
  7558. end;
  7559. if hLibrary in El.Hints then
  7560. LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
  7561. [El.Name],PosEl);
  7562. if hPlatform in El.Hints then
  7563. LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
  7564. [El.Name],PosEl);
  7565. if hExperimental in El.Hints then
  7566. LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
  7567. [El.Name],PosEl);
  7568. if hUnimplemented in El.Hints then
  7569. LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
  7570. [El.Name],PosEl);
  7571. end;
  7572. procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  7573. var
  7574. ModScope: TPasModuleScope;
  7575. begin
  7576. ProcScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  7577. if bsRangeChecks in ProcScope.BoolSwitches then
  7578. begin
  7579. ModScope:=RootElement.CustomData as TPasModuleScope;
  7580. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  7581. end;
  7582. end;
  7583. procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
  7584. ImplProcScope: TPasProcedureScope);
  7585. var
  7586. DeclProc, ImplProc: TPasProcedure;
  7587. DeclArgs, ImplArgs: TFPList;
  7588. i: Integer;
  7589. DeclArg, ImplArg: TPasArgument;
  7590. Identifier: TPasIdentifier;
  7591. begin
  7592. ImplProc:=ImplProcScope.Element as TPasProcedure;
  7593. ImplArgs:=ImplProc.ProcType.Args;
  7594. DeclProc:=ImplProcScope.DeclarationProc;
  7595. DeclArgs:=DeclProc.ProcType.Args;
  7596. for i:=0 to DeclArgs.Count-1 do
  7597. begin
  7598. DeclArg:=TPasArgument(DeclArgs[i]);
  7599. if i<ImplArgs.Count then
  7600. begin
  7601. ImplArg:=TPasArgument(ImplArgs[i]);
  7602. Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
  7603. //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
  7604. if Identifier.Element<>ImplArg then
  7605. RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
  7606. Identifier.Element:=DeclArg;
  7607. Identifier.Identifier:=DeclArg.Name;
  7608. end
  7609. else
  7610. RaiseNotYetImplemented(20170203161826,ImplProc);
  7611. end;
  7612. if DeclProc.ProcType is TPasFunctionType then
  7613. begin
  7614. // redirect implementation 'Result' to declaration FuncType.ResultEl
  7615. Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
  7616. if Identifier.Element is TPasResultElement then
  7617. Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
  7618. end;
  7619. end;
  7620. function TPasResolver.CreateClassIntfMap(El: TPasClassType; Index: integer
  7621. ): TPasClassIntfMap;
  7622. var
  7623. IntfType: TPasClassType;
  7624. Map: TPasClassIntfMap;
  7625. ClassScope: TPasClassScope;
  7626. begin
  7627. ClassScope:=El.CustomData as TPasClassScope;
  7628. if ClassScope.Interfaces[Index]<>nil then
  7629. RaiseInternalError(20180322141916,GetElementDbgPath(El)+' '+IntToStr(Index)+' '+GetObjName(TObject(ClassScope.Interfaces[Index])));
  7630. IntfType:=TPasClassType(ResolveAliasType(TPasType(El.Interfaces[Index])));
  7631. Map:=nil;
  7632. while IntfType<>nil do
  7633. begin
  7634. if Map=nil then
  7635. begin
  7636. Map:=TPasClassIntfMap.Create;
  7637. Map.Element:=El;
  7638. Result:=Map;
  7639. ClassScope.Interfaces[Index]:=Map;
  7640. end
  7641. else
  7642. begin
  7643. Map.AncestorMap:=TPasClassIntfMap.Create;
  7644. Map:=Map.AncestorMap;
  7645. Map.Element:=El;
  7646. end;
  7647. Map.Intf:=IntfType;
  7648. Map.Procs:=TFPList.Create;
  7649. Map.Procs.Count:=IntfType.Members.Count;
  7650. IntfType:=GetPasClassAncestor(IntfType,true) as TPasClassType;
  7651. end;
  7652. end;
  7653. procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
  7654. const ResolvedEl: TPasResolverResult);
  7655. begin
  7656. if ResolvedEl.BaseType<>btBoolean then
  7657. RaiseXExpectedButYFound(20170216152135,
  7658. BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
  7659. end;
  7660. procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
  7661. ImplProc: TPasProcedure; CheckNames: boolean);
  7662. var
  7663. i: Integer;
  7664. DeclArgs, ImplArgs: TFPList;
  7665. DeclName, ImplName: String;
  7666. ImplResult, DeclResult: TPasType;
  7667. begin
  7668. if ImplProc.ClassType<>DeclProc.ClassType then
  7669. RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
  7670. if ImplProc.CallingConvention<>DeclProc.CallingConvention then
  7671. RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
  7672. if ImplProc.ProcType is TPasFunctionType then
  7673. begin
  7674. // check result type
  7675. ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
  7676. DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
  7677. if not CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple) then
  7678. RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
  7679. [],DeclResult,ImplResult,ImplProc);
  7680. end;
  7681. if CheckNames then
  7682. begin
  7683. // check argument names
  7684. DeclArgs:=DeclProc.ProcType.Args;
  7685. ImplArgs:=ImplProc.ProcType.Args;
  7686. for i:=0 to DeclArgs.Count-1 do
  7687. begin
  7688. DeclName:=TPasArgument(DeclArgs[i]).Name;
  7689. ImplName:=TPasArgument(ImplArgs[i]).Name;
  7690. if CompareText(DeclName,ImplName)<>0 then
  7691. RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
  7692. sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
  7693. end;
  7694. end;
  7695. end;
  7696. procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
  7697. var
  7698. i: Integer;
  7699. begin
  7700. if Block=nil then exit;
  7701. for i:=0 to Block.Elements.Count-1 do
  7702. ResolveImplElement(TPasImplElement(Block.Elements[i]));
  7703. end;
  7704. procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
  7705. var
  7706. C: TClass;
  7707. begin
  7708. //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
  7709. if El=nil then exit;
  7710. C:=El.ClassType;
  7711. if C=TPasImplBeginBlock then
  7712. ResolveImplBlock(TPasImplBeginBlock(El))
  7713. else if C=TPasImplAssign then
  7714. ResolveImplAssign(TPasImplAssign(El))
  7715. else if C=TPasImplSimple then
  7716. ResolveImplSimple(TPasImplSimple(El))
  7717. else if C=TPasImplBlock then
  7718. ResolveImplBlock(TPasImplBlock(El))
  7719. else if C=TPasImplRepeatUntil then
  7720. begin
  7721. ResolveImplBlock(TPasImplBlock(El));
  7722. ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
  7723. end
  7724. else if C=TPasImplIfElse then
  7725. begin
  7726. ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
  7727. ResolveImplElement(TPasImplIfElse(El).IfBranch);
  7728. ResolveImplElement(TPasImplIfElse(El).ElseBranch);
  7729. end
  7730. else if C=TPasImplWhileDo then
  7731. begin
  7732. ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
  7733. ResolveImplElement(TPasImplWhileDo(El).Body);
  7734. end
  7735. else if C=TPasImplCaseOf then
  7736. ResolveImplCaseOf(TPasImplCaseOf(El))
  7737. else if C=TPasImplLabelMark then
  7738. ResolveImplLabelMark(TPasImplLabelMark(El))
  7739. else if C=TPasImplForLoop then
  7740. // the header was already resolved
  7741. ResolveImplElement(TPasImplForLoop(El).Body)
  7742. else if C=TPasImplTry then
  7743. begin
  7744. ResolveImplBlock(TPasImplTry(El));
  7745. ResolveImplBlock(TPasImplTry(El).FinallyExcept);
  7746. ResolveImplBlock(TPasImplTry(El).ElseBranch);
  7747. end
  7748. else if C=TPasImplExceptOn then
  7749. // handled in FinishExceptOnStatement
  7750. else if C=TPasImplRaise then
  7751. ResolveImplRaise(TPasImplRaise(El))
  7752. else if C=TPasImplCommand then
  7753. begin
  7754. if TPasImplCommand(El).Command<>'' then
  7755. RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
  7756. end
  7757. else if C=TPasImplAsmStatement then
  7758. ResolveImplAsm(TPasImplAsmStatement(El))
  7759. else if C=TPasImplWithDo then
  7760. ResolveImplWithDo(TPasImplWithDo(El))
  7761. else
  7762. RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
  7763. end;
  7764. procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
  7765. type
  7766. TRangeItem = record
  7767. RangeStart, RangeEnd: TMaxPrecInt;
  7768. Expr: TPasExpr;
  7769. aString: UnicodeString;
  7770. // Note: for case-of-string:
  7771. // single values are stored in aString and RangeStart=1, RangeEnd=0
  7772. // ranges are stored as aString='', RangeStart, RangeEnd
  7773. end;
  7774. PRangeItem = ^TRangeItem;
  7775. function CreateValues(const ResolvedEl: TPasResolverResult;
  7776. var ValueSet: TResEvalSet): boolean;
  7777. var
  7778. CaseExprType: TPasType;
  7779. begin
  7780. Result:=false;
  7781. if ResolvedEl.BaseType in btAllInteger then
  7782. begin
  7783. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  7784. Result:=true;
  7785. end
  7786. else if ResolvedEl.BaseType in btAllBooleans then
  7787. begin
  7788. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  7789. Result:=true;
  7790. end
  7791. else if ResolvedEl.BaseType in btAllChars then
  7792. begin
  7793. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  7794. Result:=true;
  7795. end
  7796. else if ResolvedEl.BaseType in btAllStrings then
  7797. Result:=true
  7798. else if ResolvedEl.BaseType=btContext then
  7799. begin
  7800. CaseExprType:=ResolvedEl.LoTypeEl;
  7801. if CaseExprType.ClassType=TPasEnumType then
  7802. begin
  7803. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  7804. Result:=true;
  7805. end;
  7806. end
  7807. else if ResolvedEl.BaseType=btRange then
  7808. begin
  7809. if ResolvedEl.SubType in btAllInteger then
  7810. begin
  7811. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  7812. Result:=true;
  7813. end
  7814. else if ResolvedEl.SubType in btAllBooleans then
  7815. begin
  7816. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  7817. Result:=true;
  7818. end
  7819. else if ResolvedEl.SubType in btAllChars then
  7820. begin
  7821. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  7822. Result:=true;
  7823. end
  7824. else if ResolvedEl.SubType=btContext then
  7825. begin
  7826. CaseExprType:=ResolvedEl.LoTypeEl;
  7827. if CaseExprType.ClassType=TPasEnumType then
  7828. begin
  7829. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  7830. Result:=true;
  7831. end;
  7832. end;
  7833. end;
  7834. end;
  7835. function AddRangeItem(Values: TFPList; const RangeStart, RangeEnd: TMaxPrecInt;
  7836. Expr: TPasExpr): PRangeItem;
  7837. begin
  7838. New(Result);
  7839. Result^.RangeStart:=RangeStart;
  7840. Result^.RangeEnd:=RangeEnd;
  7841. Result^.Expr:=Expr;
  7842. Values.Add(Result);
  7843. end;
  7844. function AddValue(Value: TResEvalValue; Values: TFPList; ValueSet: TResEvalSet;
  7845. Expr: TPasExpr): boolean;
  7846. function AddString(const s: UnicodeString): boolean;
  7847. var
  7848. Dupl: TPasExpr;
  7849. i, o: Integer;
  7850. Item: PRangeItem;
  7851. begin
  7852. if length(s)=1 then
  7853. o:=ord(s[1])
  7854. else
  7855. o:=-1;
  7856. for i:=0 to Values.Count-1 do
  7857. begin
  7858. Item:=PRangeItem(Values[i]);
  7859. if (Item^.aString=s)
  7860. or ((o>=Item^.RangeStart) and (o<=Item^.RangeEnd)) then
  7861. begin
  7862. Dupl:=PRangeItem(Values[i])^.Expr;
  7863. RaiseMsg(20180424220139,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  7864. ['string',GetElementSourcePosStr(Dupl)],Expr);
  7865. end;
  7866. end;
  7867. Item:=AddRangeItem(Values,1,0,Expr);
  7868. Item^.aString:=s;
  7869. Result:=true;
  7870. end;
  7871. function AddStringRange(CharStart, CharEnd: TMaxPrecInt): boolean;
  7872. var
  7873. i, o: Integer;
  7874. s: UnicodeString;
  7875. Item: PRangeItem;
  7876. Dupl: TPasExpr;
  7877. begin
  7878. if CharEnd>$ffff then
  7879. RaiseNotYetImplemented(20180501221359,Expr,Value.AsDebugString);
  7880. for i:=0 to Values.Count-1 do
  7881. begin
  7882. Item:=PRangeItem(Values[i]);
  7883. s:=Item^.aString;
  7884. if length(s)=1 then
  7885. o:=ord(s[1])
  7886. else
  7887. o:=-1;
  7888. if ((o>=CharStart) and (o<=CharEnd))
  7889. or ((Item^.RangeStart<=CharEnd) and (Item^.RangeEnd>=CharStart)) then
  7890. begin
  7891. Dupl:=PRangeItem(Values[i])^.Expr;
  7892. RaiseMsg(20180501223914,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  7893. ['string',GetElementSourcePosStr(Dupl)],Expr);
  7894. end;
  7895. end;
  7896. AddRangeItem(Values,CharStart,CharEnd,Expr);
  7897. Result:=true;
  7898. end;
  7899. var
  7900. RangeStart, RangeEnd: TMaxPrecInt;
  7901. i: Integer;
  7902. Item: PRangeItem;
  7903. begin
  7904. {$IFDEF VerbosePasResolver}
  7905. //writeln('TPasResolver.ResolveImplCaseOf.AddValue Value={',Value.AsDebugString,'} Values.Count=',Values.Count);
  7906. {$ENDIF}
  7907. Result:=true;
  7908. case Value.Kind of
  7909. revkBool:
  7910. begin
  7911. RangeStart:=ord(TResEvalBool(Value).B);
  7912. RangeEnd:=RangeStart;
  7913. end;
  7914. revkInt:
  7915. begin
  7916. RangeStart:=TResEvalInt(Value).Int;
  7917. RangeEnd:=RangeStart;
  7918. end;
  7919. revkUInt:
  7920. begin
  7921. // Note: when FPC compares int64 with qword it converts the qword to an int64
  7922. if TResEvalUInt(Value).UInt>HighIntAsUInt then
  7923. ExprEvaluator.EmitRangeCheckConst(20180424212414,Value.AsString,
  7924. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  7925. RangeStart:=TResEvalUInt(Value).UInt;
  7926. RangeEnd:=RangeStart;
  7927. end;
  7928. {$ifdef FPC_HAS_CPSTRING}
  7929. revkString:
  7930. if ValueSet=nil then
  7931. exit(AddString(ExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Expr)))
  7932. else
  7933. begin
  7934. RangeStart:=fExprEvaluator.StringToOrd(Value,nil);
  7935. if RangeStart>$ffff then
  7936. exit(false);
  7937. RangeEnd:=RangeStart;
  7938. end;
  7939. {$endif}
  7940. revkUnicodeString:
  7941. if ValueSet=nil then
  7942. exit(AddString(TResEvalUTF16(Value).S))
  7943. else
  7944. begin
  7945. if length(TResEvalUTF16(Value).S)<>1 then
  7946. exit(false);
  7947. RangeStart:=ord(TResEvalUTF16(Value).S[1]);
  7948. RangeEnd:=RangeStart;
  7949. end;
  7950. revkEnum:
  7951. begin
  7952. RangeStart:=TResEvalEnum(Value).Index;
  7953. RangeEnd:=RangeStart;
  7954. end;
  7955. revkRangeInt:
  7956. if ValueSet=nil then
  7957. exit(AddStringRange(TResEvalRangeInt(Value).RangeStart,TResEvalRangeInt(Value).RangeEnd))
  7958. else
  7959. begin
  7960. RangeStart:=TResEvalRangeInt(Value).RangeStart;
  7961. RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
  7962. end;
  7963. revkRangeUInt:
  7964. begin
  7965. // Note: when FPC compares int64 with qword it converts the qword to an int64
  7966. if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
  7967. ExprEvaluator.EmitRangeCheckConst(20180424212648,Value.AsString,
  7968. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  7969. RangeStart:=TResEvalRangeUInt(Value).RangeStart;
  7970. RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
  7971. end;
  7972. else
  7973. Result:=false;
  7974. end;
  7975. if ValueSet=nil then
  7976. RaiseNotYetImplemented(20180424215728,Expr,Value.AsDebugString);
  7977. i:=ValueSet.Intersects(RangeStart,RangeEnd);
  7978. if i<0 then
  7979. begin
  7980. ValueSet.Add(RangeStart,RangeEnd);
  7981. AddRangeItem(Values,RangeStart,RangeEnd,Expr);
  7982. exit(true);
  7983. end;
  7984. // duplicate value -> show where
  7985. for i:=0 to Values.Count-1 do
  7986. begin
  7987. Item:=PRangeItem(Values[i]);
  7988. if (Item^.RangeStart>RangeEnd) or (Item^.RangeEnd<RangeStart) then continue;
  7989. RaiseMsg(20180424214305,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  7990. [Value.AsString,GetElementSourcePosStr(Item^.Expr)],Expr);
  7991. end;
  7992. Result:=false;
  7993. end;
  7994. var
  7995. i, j: Integer;
  7996. El: TPasElement;
  7997. Stat: TPasImplCaseStatement;
  7998. CaseExprResolved, OfExprResolved: TPasResolverResult;
  7999. OfExpr: TPasExpr;
  8000. ok: Boolean;
  8001. Values: TFPList; // list of PRangeItem
  8002. ValueSet: TResEvalSet;
  8003. Value: TResEvalValue;
  8004. Item: PRangeItem;
  8005. begin
  8006. ResolveExpr(CaseOf.CaseExpr,rraRead);
  8007. ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
  8008. ok:=false;
  8009. Values:=TFPList.Create;
  8010. ValueSet:=nil;
  8011. Value:=nil;
  8012. try
  8013. if (rrfReadable in CaseExprResolved.Flags) then
  8014. ok:=CreateValues(CaseExprResolved,ValueSet);
  8015. if not ok then
  8016. RaiseXExpectedButYFound(20170216151952,'ordinal expression',
  8017. GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
  8018. for i:=0 to CaseOf.Elements.Count-1 do
  8019. begin
  8020. El:=TPasElement(CaseOf.Elements[i]);
  8021. if El.ClassType=TPasImplCaseStatement then
  8022. begin
  8023. Stat:=TPasImplCaseStatement(El);
  8024. for j:=0 to Stat.Expressions.Count-1 do
  8025. begin
  8026. //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
  8027. OfExpr:=TPasExpr(Stat.Expressions[j]);
  8028. ResolveExpr(OfExpr,rraRead);
  8029. ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
  8030. if OfExprResolved.BaseType=btRange then
  8031. ConvertRangeToElement(OfExprResolved);
  8032. CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
  8033. Value:=Eval(OfExpr,[refConstExt]);
  8034. if Value<>nil then
  8035. begin
  8036. if Value.Kind=revkExternal then
  8037. begin
  8038. // external const
  8039. end
  8040. else if not AddValue(Value,Values,ValueSet,OfExpr) then
  8041. RaiseIncompatibleTypeRes(20180424210815,nIncompatibleTypesGotExpected,
  8042. [],OfExprResolved,CaseExprResolved,OfExpr);
  8043. ReleaseEvalValue(Value);
  8044. end
  8045. else
  8046. RaiseMsg(20180518102047,nConstantExpressionExpected,sConstantExpressionExpected,[],OfExpr);
  8047. end;
  8048. ResolveImplElement(Stat.Body);
  8049. end
  8050. else if El.ClassType=TPasImplCaseElse then
  8051. ResolveImplBlock(TPasImplCaseElse(El))
  8052. else
  8053. RaiseNotYetImplemented(20160922163448,El);
  8054. end;
  8055. // Note: CaseOf.ElseBranch was already resolved via Elements
  8056. finally
  8057. ReleaseEvalValue(Value);
  8058. ValueSet.Free;
  8059. for i:=0 to Values.Count-1 do
  8060. begin
  8061. Item:=PRangeItem(Values[i]);
  8062. Dispose(Item);
  8063. end;
  8064. Values.Free;
  8065. end;
  8066. end;
  8067. procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
  8068. begin
  8069. RaiseNotYetImplemented(20161014141636,Mark);
  8070. end;
  8071. procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
  8072. // Note: the expressions were already resolved during parsing
  8073. // and the scopes were already stored in a TPasWithScope.
  8074. // -> simply push them onto the scope stack
  8075. var
  8076. i: Integer;
  8077. WithScope: TPasWithScope;
  8078. ExprScope: TPasWithExprScope;
  8079. begin
  8080. if not (El.CustomData is TPasWithScope) then
  8081. RaiseInternalError(20181210175349);
  8082. WithScope:=TPasWithScope(El.CustomData);
  8083. PushScope(WithScope);
  8084. for i:=0 to WithScope.ExpressionScopes.Count-1 do
  8085. begin
  8086. ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
  8087. PushScope(ExprScope);
  8088. end;
  8089. ResolveImplElement(El.Body);
  8090. PopWithScope(El);
  8091. end;
  8092. procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  8093. begin
  8094. if El=nil then ;
  8095. end;
  8096. procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
  8097. var
  8098. LeftResolved, RightResolved: TPasResolverResult;
  8099. Flags: TPasResolverComputeFlags;
  8100. Access: TResolvedRefAccess;
  8101. Value: TResEvalValue;
  8102. begin
  8103. if El.Kind=akDefault then
  8104. Access:=rraAssign
  8105. else
  8106. Access:=rraReadAndAssign;
  8107. ResolveExpr(El.left,Access);
  8108. {$IFDEF VerbosePasResolver}
  8109. writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
  8110. {$ENDIF}
  8111. // check LHS can be assigned
  8112. ComputeElement(El.left,LeftResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  8113. CheckCanBeLHS(LeftResolved,true,GetRightMostExpr(El.left));
  8114. // compute RHS
  8115. ResolveExpr(El.right,rraRead);
  8116. Flags:=[rcSetReferenceFlags];
  8117. if IsProcedureType(LeftResolved,true) then
  8118. begin
  8119. if (msDelphi in CurrentParser.CurrentModeswitches) then
  8120. Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
  8121. else
  8122. Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
  8123. end;
  8124. {$IFDEF VerbosePasResolver}
  8125. writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
  8126. {$ENDIF}
  8127. ComputeElement(El.right,RightResolved,Flags);
  8128. {$IFDEF VerbosePasResolver}
  8129. writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
  8130. {$ENDIF}
  8131. case El.Kind of
  8132. akDefault:
  8133. begin
  8134. CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
  8135. CheckAssignExprRange(LeftResolved,El.right);
  8136. if (LeftResolved.BaseType=btContext) and (LeftResolved.LoTypeEl.ClassType=TPasArrayType) then
  8137. MarkArrayExprRecursive(El.right,TPasArrayType(LeftResolved.LoTypeEl));
  8138. end;
  8139. akAdd, akMinus,akMul,akDivision:
  8140. begin
  8141. if (LeftResolved.BaseType in btAllInteger) and (El.Kind in [akAdd,akMinus,akMul]) then
  8142. begin
  8143. if (not (rrfReadable in RightResolved.Flags))
  8144. or not (RightResolved.BaseType in btAllInteger) then
  8145. RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8146. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  8147. end
  8148. else if (LeftResolved.BaseType in btAllStrings) and (El.Kind=akAdd) then
  8149. begin
  8150. if (not (rrfReadable in RightResolved.Flags))
  8151. or not (RightResolved.BaseType in btAllStringAndChars) then
  8152. RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8153. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  8154. end
  8155. else if (LeftResolved.BaseType in btAllFloats)
  8156. and (El.Kind in [akAdd,akMinus,akMul,akDivision]) then
  8157. begin
  8158. if (not (rrfReadable in RightResolved.Flags))
  8159. or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  8160. RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8161. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  8162. end
  8163. else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
  8164. begin
  8165. if (not (rrfReadable in RightResolved.Flags))
  8166. or not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  8167. RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8168. [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  8169. if (LeftResolved.SubType=RightResolved.SubType)
  8170. or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
  8171. or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
  8172. then
  8173. else
  8174. RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8175. ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  8176. end
  8177. else if LeftResolved.BaseType=btContext then
  8178. begin
  8179. if (LeftResolved.LoTypeEl.ClassType=TPasArrayType) and (El.Kind=akAdd)
  8180. and (rrfReadable in RightResolved.Flags)
  8181. and IsDynArray(LeftResolved.LoTypeEl) then
  8182. begin
  8183. // DynArr+=...
  8184. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,El,true);
  8185. exit;
  8186. end
  8187. else
  8188. RaiseIncompatibleTypeRes(20180615235749,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  8189. end
  8190. else
  8191. RaiseIncompatibleTypeRes(20180208115707,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  8192. // store const expression result
  8193. Value:=Eval(El.right,[]);
  8194. ReleaseEvalValue(Value);
  8195. end;
  8196. else
  8197. RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
  8198. end;
  8199. end;
  8200. procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
  8201. var
  8202. ExprResolved: TPasResolverResult;
  8203. Expr: TPasExpr;
  8204. begin
  8205. Expr:=El.expr;
  8206. ResolveExpr(Expr,rraRead);
  8207. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  8208. if (rrfCanBeStatement in ExprResolved.Flags) then
  8209. exit;
  8210. {$IFDEF VerbosePasResolver}
  8211. writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  8212. {$ENDIF}
  8213. RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
  8214. end;
  8215. procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
  8216. var
  8217. ResolvedEl: TPasResolverResult;
  8218. begin
  8219. if El.ExceptObject<>nil then
  8220. begin
  8221. ResolveExpr(El.ExceptObject,rraRead);
  8222. ComputeElement(El.ExceptObject,ResolvedEl,[rcSetReferenceFlags]);
  8223. CheckIsClass(El.ExceptObject,ResolvedEl);
  8224. if ResolvedEl.IdentEl<>nil then
  8225. begin
  8226. if (ResolvedEl.IdentEl is TPasVariable)
  8227. or (ResolvedEl.IdentEl is TPasArgument)
  8228. or (ResolvedEl.IdentEl is TPasResultElement) then
  8229. else
  8230. begin
  8231. {$IFDEF VerbosePasResolver}
  8232. writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
  8233. {$ENDIF}
  8234. RaiseXExpectedButYFound(20170216152133,
  8235. 'variable',GetElementTypeName(ResolvedEl.IdentEl),El.ExceptObject);
  8236. end;
  8237. end
  8238. else if ResolvedEl.ExprEl<>nil then
  8239. else
  8240. RaiseXExpectedButYFound(201702303145230,
  8241. 'variable',GetResolverResultDbg(ResolvedEl),El.ExceptObject);
  8242. if not (rrfReadable in ResolvedEl.Flags) then
  8243. RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
  8244. end;
  8245. if El.ExceptAddr<>nil then
  8246. ResolveExpr(El.ExceptAddr,rraRead);
  8247. end;
  8248. procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
  8249. var
  8250. Primitive: TPrimitiveExpr;
  8251. ElClass: TClass;
  8252. begin
  8253. {$IFDEF VerbosePasResolver}
  8254. writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
  8255. {$ENDIF}
  8256. if El=nil then
  8257. RaiseNotYetImplemented(20160922163453,El);
  8258. ElClass:=El.ClassType;
  8259. if ElClass=TPrimitiveExpr then
  8260. begin
  8261. Primitive:=TPrimitiveExpr(El);
  8262. case Primitive.Kind of
  8263. pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
  8264. pekNumber: ;
  8265. pekString: ;
  8266. pekNil,pekBoolConst: ;
  8267. else
  8268. RaiseNotYetImplemented(20160922163451,El);
  8269. end;
  8270. end
  8271. else if ElClass=TUnaryExpr then
  8272. ResolveExpr(TUnaryExpr(El).Operand,Access)
  8273. else if ElClass=TBinaryExpr then
  8274. ResolveBinaryExpr(TBinaryExpr(El),Access)
  8275. else if ElClass=TParamsExpr then
  8276. ResolveParamsExpr(TParamsExpr(El),Access)
  8277. else if ElClass=TBoolConstExpr then
  8278. else if ElClass=TNilExpr then
  8279. else if ElClass=TInheritedExpr then
  8280. ResolveInherited(TInheritedExpr(El),Access)
  8281. else if ElClass=TArrayValues then
  8282. begin
  8283. if Access<>rraRead then
  8284. RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
  8285. [],El);
  8286. ResolveArrayValues(TArrayValues(El));
  8287. end
  8288. else if ElClass=TRecordValues then
  8289. begin
  8290. if Access<>rraRead then
  8291. RaiseMsg(20180429103024,nVariableIdentifierExpected,sVariableIdentifierExpected,
  8292. [],El);
  8293. ResolveRecordValues(TRecordValues(El));
  8294. end
  8295. else if ElClass=TProcedureExpr then
  8296. // resolved by FinishScope(stProcedure)
  8297. else
  8298. RaiseNotYetImplemented(20170222184329,El);
  8299. if El.format1<>nil then
  8300. ResolveExpr(El.format1,rraRead);
  8301. if El.format2<>nil then
  8302. ResolveExpr(El.format2,rraRead);
  8303. end;
  8304. procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
  8305. var
  8306. ResolvedCond: TPasResolverResult;
  8307. begin
  8308. ResolveExpr(El,rraRead);
  8309. ComputeElement(El,ResolvedCond,[rcSetReferenceFlags]);
  8310. CheckConditionExpr(El,ResolvedCond);
  8311. end;
  8312. procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
  8313. Access: TResolvedRefAccess);
  8314. var
  8315. FindData: TPRFindData;
  8316. DeclEl: TPasElement;
  8317. Proc, ImplProc: TPasProcedure;
  8318. Ref: TResolvedReference;
  8319. BuiltInProc: TResElDataBuiltInProc;
  8320. p: SizeInt;
  8321. DottedName: String;
  8322. Bin: TBinaryExpr;
  8323. ProcScope: TPasProcedureScope;
  8324. Params: TParamsExpr;
  8325. begin
  8326. {$IFDEF VerbosePasResolver}
  8327. writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
  8328. {$ENDIF}
  8329. Params:=GetParamsOfNameExpr(El);
  8330. if Params<>nil then
  8331. begin
  8332. if Params.Kind=pekFuncParams then
  8333. begin
  8334. ResolveFuncParamsExprName(El,Params,Access);
  8335. exit;
  8336. end
  8337. else if Params.Kind=pekArrayParams then
  8338. begin
  8339. ResolveArrayParamsExprName(El,Params,Access);
  8340. exit;
  8341. end;
  8342. end;
  8343. DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
  8344. if DeclEl.ClassType=TPasUsesUnit then
  8345. begin
  8346. // the first name of a unit matches -> find unit with longest match
  8347. FindLongestUnitName(DeclEl,El);
  8348. FindData.Found:=DeclEl;
  8349. end;
  8350. Ref:=CreateReference(DeclEl,El,Access,@FindData);
  8351. CheckFoundElement(FindData,Ref);
  8352. if DeclEl is TPasProcedure then
  8353. begin
  8354. // identifier is a proc and args brackets are missing
  8355. if El.Parent.ClassType=TPasProperty then
  8356. // a property accessor does not need args -> ok
  8357. // Note: the detailed tests are in FinishProperty
  8358. else
  8359. begin
  8360. // examples: funca or @proca or a.funca or @a.funca ...
  8361. Proc:=TPasProcedure(DeclEl);
  8362. if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
  8363. and (El.ClassType=TPrimitiveExpr)
  8364. and (El.Parent.ClassType=TPasImplAssign)
  8365. and (TPasImplAssign(El.Parent).left=El) then
  8366. begin
  8367. // e.g. funcname:=
  8368. ProcScope:=Proc.CustomData as TPasProcedureScope;
  8369. ImplProc:=ProcScope.ImplProc;
  8370. if ImplProc=nil then
  8371. ImplProc:=Proc;
  8372. if El.HasParent(ImplProc) then
  8373. begin
  8374. // "FuncA:=" within FuncA -> redirect to ResultEl
  8375. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  8376. exit;
  8377. end;
  8378. end;
  8379. if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
  8380. begin
  8381. {$IFDEF VerbosePasResolver}
  8382. writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
  8383. {$ENDIF}
  8384. RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
  8385. sWrongNumberOfParametersForCallTo,[Proc.Name],El);
  8386. end;
  8387. end;
  8388. end
  8389. else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  8390. begin
  8391. if DeclEl.CustomData is TResElDataBuiltInProc then
  8392. begin
  8393. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  8394. BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
  8395. end;
  8396. end
  8397. else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
  8398. begin
  8399. // unit reference
  8400. // dotted unit names needs a ref for each expression identifier
  8401. // Note: El is the first TPrimitiveExpr of the dotted unit name reference
  8402. DottedName:=DeclEl.Name;
  8403. repeat
  8404. p:=Pos('.',DottedName);
  8405. if p<1 then break;
  8406. Delete(DottedName,1,p);
  8407. El:=GetNextDottedExpr(El);
  8408. if El=nil then
  8409. RaiseInternalError(20170503002012);
  8410. CreateReference(DeclEl,El,Access);
  8411. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
  8412. begin
  8413. Bin:=TBinaryExpr(El.Parent);
  8414. while Bin.OpCode=eopSubIdent do
  8415. begin
  8416. CreateReference(DeclEl,Bin,Access);
  8417. if not (Bin.Parent is TBinaryExpr) then break;
  8418. if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
  8419. Bin:=TBinaryExpr(Bin.Parent);
  8420. end;
  8421. end;
  8422. until false;
  8423. end;
  8424. end;
  8425. procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
  8426. Access: TResolvedRefAccess);
  8427. var
  8428. SelfScope: TPasProcedureScope;
  8429. AncestorScope: TPasClassScope;
  8430. ClassRecScope: TPasClassOrRecordScope;
  8431. DeclProc, AncestorProc: TPasProcedure;
  8432. aClass: TPasClassType;
  8433. HelperForType: TPasType;
  8434. InhScope: TPasInheritedScope;
  8435. begin
  8436. {$IFDEF VerbosePasResolver}
  8437. writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
  8438. {$ENDIF}
  8439. if (El.Parent.ClassType=TBinaryExpr)
  8440. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  8441. begin
  8442. // e.g. 'inherited Proc;'
  8443. ResolveInheritedCall(TBinaryExpr(El.Parent),Access);
  8444. exit;
  8445. end;
  8446. // 'inherited;' without expression
  8447. SelfScope:=GetCurrentSelfScope(El);
  8448. if SelfScope=nil then
  8449. RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  8450. DeclProc:=SelfScope.DeclarationProc;
  8451. if DeclProc=nil then
  8452. RaiseNotYetImplemented(20190121172251,El);
  8453. ClassRecScope:=SelfScope.ClassRecScope;
  8454. if not (ClassRecScope is TPasClassScope) then
  8455. begin
  8456. // inherited in record method
  8457. RaiseMsg(20181218194022,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  8458. ['inherited'],El);
  8459. end;
  8460. AncestorProc:=nil;
  8461. // inherited in class/interface/helper method
  8462. aClass:=ClassRecScope.Element as TPasClassType;
  8463. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8464. //writeln('TPasResolver.ResolveInherited aClass=',GetObjName(aClass),' HelperForType=',GetObjName(HelperForType));
  8465. if HelperForType is TPasMembersType then
  8466. begin
  8467. // inherited; inside helper -> skip helper ancestors and search in HelperForType
  8468. if msDelphi in CurrentParser.CurrentModeswitches then
  8469. begin
  8470. // Delphi skips ancestors and HelperForType
  8471. if not (HelperForType is TPasClassType) then
  8472. // 'inherited;' without ancestor class is silently ignored
  8473. exit;
  8474. AncestorScope:=TPasClassScope(HelperForType.CustomData).AncestorScope;
  8475. if AncestorScope=nil then
  8476. // 'inherited;' without ancestor class is silently ignored
  8477. exit;
  8478. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  8479. end
  8480. else
  8481. begin
  8482. // ObjFPC searches first in HelperForType and its ancestors, then in
  8483. // own ancestors
  8484. AncestorScope:=TPasClassScope(aClass.CustomData).AncestorScope;
  8485. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  8486. AncestorScope);
  8487. end;
  8488. end
  8489. else
  8490. begin
  8491. // inherited; inside class/interface method
  8492. // -> search in ancestor and its helper(s)
  8493. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  8494. if AncestorScope=nil then
  8495. // 'inherited;' without ancestor class is silently ignored
  8496. exit;
  8497. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  8498. end;
  8499. AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
  8500. PopScope;
  8501. if AncestorProc=nil then
  8502. // 'inherited;' without ancestor DeclProc is silently ignored
  8503. exit;
  8504. if not (AncestorProc.Parent is TPasMembersType) then
  8505. RaiseNotYetImplemented(20190121181234,El); // inconsistency
  8506. CreateReference(AncestorProc,El,Access);
  8507. if AncestorProc.IsAbstract then
  8508. RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
  8509. sAbstractMethodsCannotBeCalledDirectly,[],El);
  8510. end;
  8511. procedure TPasResolver.ResolveInheritedCall(El: TBinaryExpr;
  8512. Access: TResolvedRefAccess);
  8513. // El.OpCode=eopNone
  8514. // El.left is TInheritedExpr
  8515. // El.right is the identifier and parameters
  8516. var
  8517. SelfScope: TPasProcedureScope;
  8518. ClassRecScope: TPasClassOrRecordScope;
  8519. AncestorClass, aClass: TPasClassType;
  8520. HelperForType: TPasType;
  8521. OnlyTypeMembers: Boolean;
  8522. Proc: TPasProcedure;
  8523. AncestorScope: TPasClassScope;
  8524. InhScope: TPasInheritedScope;
  8525. begin
  8526. {$IFDEF VerbosePasResolver}
  8527. writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El));
  8528. {$ENDIF}
  8529. SelfScope:=GetCurrentSelfScope(El);
  8530. if SelfScope=nil then
  8531. RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  8532. ClassRecScope:=SelfScope.ClassRecScope;
  8533. if not (ClassRecScope is TPasClassScope) then
  8534. // inherited in a method of a record
  8535. RaiseMsg(20181218194436,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  8536. ['inherited'],El);
  8537. Proc:=TPasProcedure(SelfScope.Element);
  8538. OnlyTypeMembers:=IsClassMethod(Proc);
  8539. // inherited in a method of a class/interface/helper
  8540. aClass:=TPasClassType(ClassRecScope.Element);
  8541. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  8542. if aClass.ObjKind in okAllHelpers then
  8543. begin
  8544. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8545. if HelperForType is TPasMembersType then
  8546. begin
  8547. // record helper(ancestor) for aRecord
  8548. // or class helper(ancestor) for aClass
  8549. // -> search in helperfortype, then in ancestors
  8550. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  8551. AncestorScope);
  8552. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  8553. ResolveExpr(El.right,Access);
  8554. PopScope;
  8555. exit;
  8556. end
  8557. else
  8558. begin
  8559. // type helper(ancestortype) for simpletype -> search in ancestortype
  8560. end;
  8561. end
  8562. else
  8563. begin
  8564. // class or interface -> search in ancestor and its helpers
  8565. end;
  8566. // search in ancestor and its helpers
  8567. if AncestorScope=nil then
  8568. RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
  8569. // search call in ancestor
  8570. AncestorClass:=TPasClassType(AncestorScope.Element);
  8571. InhScope:=PushInheritedScope(AncestorClass,true,nil);
  8572. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  8573. ResolveExpr(El.right,Access);
  8574. PopScope;
  8575. end;
  8576. procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
  8577. Access: TResolvedRefAccess);
  8578. begin
  8579. {$IFDEF VerbosePasResolver}
  8580. //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
  8581. {$ENDIF}
  8582. ResolveExpr(El.left,rraRead);
  8583. if El.right=nil then exit;
  8584. case El.OpCode of
  8585. eopNone:
  8586. case El.Kind of
  8587. pekRange:
  8588. ResolveExpr(El.right,rraRead);
  8589. else
  8590. if El.left.ClassType=TInheritedExpr then
  8591. else
  8592. begin
  8593. {$IFDEF VerbosePasResolver}
  8594. writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
  8595. {$ENDIF}
  8596. RaiseNotYetImplemented(20160922163456,El);
  8597. end;
  8598. end;
  8599. eopAdd,
  8600. eopSubtract,
  8601. eopMultiply,
  8602. eopDivide,
  8603. eopDiv,
  8604. eopMod,
  8605. eopPower,
  8606. eopShr,
  8607. eopShl,
  8608. eopNot,
  8609. eopAnd,
  8610. eopOr,
  8611. eopXor,
  8612. eopEqual,
  8613. eopNotEqual,
  8614. eopLessThan,
  8615. eopGreaterThan,
  8616. eopLessthanEqual,
  8617. eopGreaterThanEqual,
  8618. eopIn,
  8619. eopIs,
  8620. eopAs,
  8621. eopSymmetricaldifference:
  8622. ResolveExpr(El.right,rraRead);
  8623. eopSubIdent:
  8624. ResolveSubIdent(El,Access);
  8625. else
  8626. RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
  8627. end;
  8628. end;
  8629. procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
  8630. Access: TResolvedRefAccess);
  8631. procedure ResolveRight; inline;
  8632. begin
  8633. ResolveExpr(El.right,Access);
  8634. PopScope;
  8635. end;
  8636. function SearchInTypeHelpers(aType: TPasType; IdentEl: TPasElement): boolean;
  8637. var
  8638. DotScope: TPasDotBaseScope;
  8639. begin
  8640. if aType=nil then exit(false);
  8641. DotScope:=PushHelperDotScope(aType);
  8642. if DotScope=nil then exit(false);
  8643. if IdentEl is TPasType then
  8644. // e.g. TFlag.HelperProc
  8645. DotScope.OnlyTypeMembers:=true;
  8646. ResolveRight;
  8647. Result:=true;
  8648. end;
  8649. var
  8650. aModule: TPasModule;
  8651. ClassEl: TPasClassType;
  8652. ClassScope: TPasDotClassScope;
  8653. LeftResolved: TPasResolverResult;
  8654. Left: TPasExpr;
  8655. RecordEl: TPasRecordType;
  8656. RecordScope: TPasDotClassOrRecordScope;
  8657. LTypeEl: TPasType;
  8658. DotScope: TPasDotBaseScope;
  8659. SetType: TPasSetType;
  8660. begin
  8661. if El.CustomData is TResolvedReference then
  8662. exit; // for example, when a.b has a dotted unit name
  8663. Left:=El.left;
  8664. //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
  8665. ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
  8666. if LeftResolved.BaseType=btModule then
  8667. begin
  8668. // e.g. unitname.identifier
  8669. // => search in interface and if this is our module in the implementation
  8670. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  8671. PushModuleDotScope(aModule);
  8672. ResolveRight;
  8673. exit;
  8674. end
  8675. else if LeftResolved.LoTypeEl=nil then
  8676. begin
  8677. // illegal qualifier, see below
  8678. end
  8679. else
  8680. begin
  8681. LTypeEl:=LeftResolved.LoTypeEl;
  8682. if (LTypeEl.ClassType=TPasPointerType)
  8683. and ElHasModeSwitch(El,msAutoDeref)
  8684. and (rrfReadable in LeftResolved.Flags)
  8685. then
  8686. begin
  8687. // a.b -> a^.b
  8688. LTypeEl:=ResolveAliasType(TPasPointerType(LTypeEl).DestType);
  8689. Include(LeftResolved.Flags,rrfWritable);
  8690. end;
  8691. if LTypeEl.ClassType=TPasClassType then
  8692. begin
  8693. ClassEl:=TPasClassType(LTypeEl);
  8694. if ClassEl.HelperForType<>nil then
  8695. RaiseHelpersCannotBeUsedAsType(20190123093438,El);
  8696. ClassScope:=PushClassDotScope(ClassEl);
  8697. if LeftResolved.IdentEl is TPasType then
  8698. // e.g. TFPMemoryImage.FindHandlerFromExtension()
  8699. ClassScope.OnlyTypeMembers:=true
  8700. else
  8701. // e.g. Image.Width
  8702. ClassScope.OnlyTypeMembers:=false;
  8703. ResolveRight;
  8704. exit;
  8705. end
  8706. else if LTypeEl.ClassType=TPasClassOfType then
  8707. begin
  8708. // e.g. ImageClass.FindHandlerFromExtension()
  8709. ClassEl:=ResolveAliasType(TPasClassOfType(LTypeEl).DestType) as TPasClassType;
  8710. ClassScope:=PushClassDotScope(ClassEl);
  8711. ClassScope.OnlyTypeMembers:=true;
  8712. ClassScope.IsClassOf:=true;
  8713. ResolveRight;
  8714. exit;
  8715. end
  8716. else if LTypeEl.ClassType=TPasRecordType then
  8717. begin
  8718. RecordEl:=TPasRecordType(LTypeEl);
  8719. RecordScope:=PushRecordDotScope(RecordEl);
  8720. RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
  8721. if LeftResolved.IdentEl is TPasType then
  8722. // e.g. TPoint.PointInCircle
  8723. RecordScope.OnlyTypeMembers:=true
  8724. else
  8725. begin
  8726. // e.g. aPoint.X
  8727. AccessExpr(El.left,Access);
  8728. RecordScope.OnlyTypeMembers:=false;
  8729. end;
  8730. ResolveRight;
  8731. exit;
  8732. end
  8733. else if LTypeEl.ClassType=TPasEnumType then
  8734. begin
  8735. if (LeftResolved.IdentEl is TPasType)
  8736. and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
  8737. begin
  8738. // e.g. TShiftState.ssAlt
  8739. DotScope:=PushEnumDotScope(TPasEnumType(LTypeEl));
  8740. DotScope.OnlyTypeMembers:=true;
  8741. ResolveRight;
  8742. exit;
  8743. end;
  8744. end;
  8745. // default: search for type helpers
  8746. if (LeftResolved.BaseType in btAllStandardTypes)
  8747. or (LeftResolved.BaseType=btContext) then
  8748. begin
  8749. if SearchInTypeHelpers(LeftResolved.HiTypeEl,LeftResolved.IdentEl) then exit;
  8750. end
  8751. else if LeftResolved.BaseType=btSet then
  8752. begin
  8753. SetType:=GetSetType(LeftResolved);
  8754. if SearchInTypeHelpers(SetType,LeftResolved.IdentEl) then exit;
  8755. end;
  8756. end;
  8757. {$IFDEF VerbosePasResolver}
  8758. writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
  8759. {$ENDIF}
  8760. RaiseMsg(20170216152157,nIllegalQualifierAfter,sIllegalQualifierAfter,
  8761. ['.',GetResolverResultDescription(LeftResolved)],El);
  8762. end;
  8763. procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
  8764. Access: TResolvedRefAccess);
  8765. begin
  8766. if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
  8767. begin
  8768. {$IFDEF VerbosePasResolver}
  8769. writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
  8770. {$ENDIF}
  8771. RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  8772. end;
  8773. // first resolve params
  8774. ResolveParamsExprParams(Params);
  8775. // then resolve the call, typecast, array, set
  8776. if (Params.Kind=pekFuncParams) then
  8777. ResolveFuncParamsExpr(Params,Access)
  8778. else if (Params.Kind=pekArrayParams) then
  8779. ResolveArrayParamsExpr(Params,Access)
  8780. else if (Params.Kind=pekSet) then
  8781. ResolveSetParamsExpr(Params)
  8782. else
  8783. RaiseNotYetImplemented(20160922163501,Params);
  8784. end;
  8785. procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
  8786. var
  8787. ScopeDepth, i: integer;
  8788. ParamAccess: TResolvedRefAccess;
  8789. Pars: TPasExprArray;
  8790. begin
  8791. ResetSubExprScopes(ScopeDepth);
  8792. if Params.Kind in [pekFuncParams,pekArrayParams] then
  8793. ParamAccess:=rraParamToUnknownProc
  8794. else
  8795. ParamAccess:=rraRead;
  8796. Pars:=Params.Params;
  8797. for i:=0 to length(Pars)-1 do
  8798. ResolveExpr(Pars[i],ParamAccess);
  8799. RestoreSubExprScopes(ScopeDepth);
  8800. end;
  8801. procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
  8802. Access: TResolvedRefAccess);
  8803. var
  8804. Value: TPasExpr;
  8805. SubParams: TParamsExpr;
  8806. ResolvedEl: TPasResolverResult;
  8807. begin
  8808. Value:=Params.Value;
  8809. if Value is TBinaryExpr then
  8810. begin
  8811. // Note: a.b() is the same as (a.b)()
  8812. // Note: a.b().c is stored as
  8813. // TBinaryExpr eopSubIdent
  8814. // / \
  8815. // left = TParamsExpr right = TPrimitiveExpr 'c'
  8816. // Value = TBinaryExpr
  8817. // / \
  8818. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  8819. while (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) do
  8820. Value:=TBinaryExpr(Value).right;
  8821. if IsNameExpr(Value) then
  8822. begin
  8823. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  8824. if not (Value.CustomData is TResolvedReference) then
  8825. RaiseNotYetImplemented(20190115140557,Params);
  8826. // already resolved
  8827. exit;
  8828. end;
  8829. // ToDo: (a+b)()
  8830. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  8831. RaiseNotYetImplemented(20190115140809,Params);
  8832. end
  8833. else if IsNameExpr(Value) then
  8834. begin
  8835. ResolveFuncParamsExprName(Value,Params,Access);
  8836. end
  8837. else if Value.ClassType=TParamsExpr then
  8838. begin
  8839. SubParams:=TParamsExpr(Value);
  8840. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  8841. begin
  8842. // e.g. Name()() or Name[]()
  8843. ResolveExpr(SubParams,rraRead);
  8844. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  8845. if IsProcedureType(ResolvedEl,true) then
  8846. begin
  8847. CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
  8848. FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
  8849. exit;
  8850. end
  8851. end;
  8852. RaiseMsg(20170216152202,nIllegalQualifierAfter,sIllegalQualifierAfter,
  8853. ['(',SubParams.ElementTypeName],Params);
  8854. end
  8855. else
  8856. RaiseNotYetImplemented(20161014085118,Params.Value);
  8857. end;
  8858. procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
  8859. Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string);
  8860. procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
  8861. var
  8862. i: Integer;
  8863. begin
  8864. if ParamAccess=rraParamToUnknownProc then exit;
  8865. for i:=0 to length(Params.Params)-1 do
  8866. FinishCallArgAccess(Params.Params[i],ParamAccess);
  8867. end;
  8868. var
  8869. i: Integer;
  8870. Msg: String;
  8871. FindCallData: TFindCallElData;
  8872. Abort: boolean;
  8873. El, FoundEl: TPasElement;
  8874. Ref: TResolvedReference;
  8875. FindData: TPRFindData;
  8876. BuiltInProc: TResElDataBuiltInProc;
  8877. ResolvedEl: TPasResolverResult;
  8878. TypeEl: TPasType;
  8879. C: TClass;
  8880. begin
  8881. // e.g. Name() -> find compatible
  8882. if CallName<>'' then
  8883. else if NameExpr.ClassType=TPrimitiveExpr then
  8884. CallName:=TPrimitiveExpr(NameExpr).Value
  8885. else
  8886. RaiseNotYetImplemented(20190115143539,NameExpr);
  8887. FindCallData:=Default(TFindCallElData);
  8888. FindCallData.Params:=Params;
  8889. Abort:=false;
  8890. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  8891. if FindCallData.Found=nil then
  8892. RaiseIdentifierNotFound(20170216152544,CallName,NameExpr);
  8893. if FindCallData.Distance=cIncompatible then
  8894. begin
  8895. // FoundEl one element, but it was incompatible => raise error
  8896. {$IFDEF VerbosePasResolver}
  8897. writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
  8898. WriteScopes;
  8899. {$ENDIF}
  8900. if FindCallData.Found is TPasProcedure then
  8901. CheckCallProcCompatibility(TPasProcedure(FindCallData.Found).ProcType,Params,true)
  8902. else if FindCallData.Found is TPasProcedureType then
  8903. CheckTypeCast(TPasProcedureType(FindCallData.Found),Params,true)
  8904. else if FindCallData.Found.ClassType=TPasUnresolvedSymbolRef then
  8905. begin
  8906. if FindCallData.Found.CustomData is TResElDataBuiltInProc then
  8907. begin
  8908. BuiltInProc:=TResElDataBuiltInProc(FindCallData.Found.CustomData);
  8909. BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
  8910. end
  8911. else if FindCallData.Found.CustomData is TResElDataBaseType then
  8912. CheckTypeCast(TPasUnresolvedSymbolRef(FindCallData.Found),Params,true)
  8913. else
  8914. RaiseNotYetImplemented(20161006132825,FindCallData.Found);
  8915. end
  8916. else if FindCallData.Found is TPasType then
  8917. // Note: check TPasType after TPasUnresolvedSymbolRef
  8918. CheckTypeCast(TPasType(FindCallData.Found),Params,true)
  8919. else if FindCallData.Found is TPasVariable then
  8920. begin
  8921. TypeEl:=ResolveAliasType(TPasVariable(FindCallData.Found).VarType);
  8922. if TypeEl is TPasProcedureType then
  8923. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  8924. else
  8925. RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,['(',TypeEl.ElementTypeName],Params);
  8926. end
  8927. else if FindCallData.Found is TPasArgument then
  8928. begin
  8929. TypeEl:=ResolveAliasType(TPasArgument(FindCallData.Found).ArgType);
  8930. if TypeEl is TPasProcedureType then
  8931. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  8932. else
  8933. RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,['(',TypeEl.ElementTypeName],Params);
  8934. end
  8935. else
  8936. RaiseNotYetImplemented(20161003134755,FindCallData.Found);
  8937. // missing raise exception
  8938. RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FindCallData.Found));
  8939. end;
  8940. if FindCallData.Count>1 then
  8941. begin
  8942. // multiple overloads fit => search again and list the candidates
  8943. FindCallData:=Default(TFindCallElData);
  8944. FindCallData.Params:=Params;
  8945. FindCallData.List:=TFPList.Create;
  8946. try
  8947. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  8948. Msg:='';
  8949. for i:=0 to FindCallData.List.Count-1 do
  8950. begin
  8951. El:=TPasElement(FindCallData.List[i]);
  8952. {$IFDEF VerbosePasResolver}
  8953. writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
  8954. {$ENDIF}
  8955. // emit a hint for each candidate
  8956. if El is TPasProcedure then
  8957. LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
  8958. [GetProcTypeDescription(TPasProcedure(El).ProcType,
  8959. [prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
  8960. Msg:=Msg+', '+GetElementSourcePosStr(El);
  8961. end;
  8962. RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
  8963. sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
  8964. finally
  8965. FindCallData.List.Free;
  8966. end;
  8967. end;
  8968. // FoundEl compatible element -> create reference
  8969. FoundEl:=FindCallData.Found;
  8970. Ref:=CreateReference(FoundEl,NameExpr,rraRead);
  8971. if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
  8972. Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
  8973. FindData:=Default(TPRFindData);
  8974. FindData.ErrorPosEl:=NameExpr;
  8975. FindData.StartScope:=FindCallData.StartScope;
  8976. FindData.ElScope:=FindCallData.ElScope;
  8977. FindData.Found:=FoundEl;
  8978. CheckFoundElement(FindData,Ref);
  8979. // set param expression Access flags
  8980. if FoundEl is TPasProcedure then
  8981. begin
  8982. // now it is known which overloaded proc to call
  8983. if not (Access in [rraRead,rraParamToUnknownProc]) then
  8984. begin
  8985. {$IFDEF VerbosePasResolver}
  8986. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  8987. {$ENDIF}
  8988. RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  8989. end;
  8990. FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
  8991. end
  8992. else if FoundEl is TPasType then
  8993. begin
  8994. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  8995. C:=TypeEl.ClassType;
  8996. if (C=TPasClassType)
  8997. or (C=TPasClassOfType)
  8998. or (C=TPasRecordType)
  8999. or (C=TPasEnumType)
  9000. or (C=TPasSetType)
  9001. or (C=TPasPointerType)
  9002. or (C=TPasArrayType)
  9003. or (C=TPasRangeType) then
  9004. begin
  9005. // type cast
  9006. FinishUntypedParams(Access);
  9007. end
  9008. else if (C=TPasProcedureType)
  9009. or (C=TPasFunctionType) then
  9010. begin
  9011. // type cast to proc type
  9012. AccessExpr(Params.Params[0],Access);
  9013. end
  9014. else if C=TPasUnresolvedSymbolRef then
  9015. begin
  9016. if TypeEl.CustomData is TResElDataBuiltInProc then
  9017. begin
  9018. // call built-in proc
  9019. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  9020. if Assigned(BuiltInProc.FinishParamsExpression) then
  9021. BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
  9022. else
  9023. FinishUntypedParams(rraRead);
  9024. end
  9025. else if TypeEl.CustomData is TResElDataBaseType then
  9026. begin
  9027. // type cast to base type
  9028. FinishUntypedParams(Access);
  9029. end
  9030. else
  9031. begin
  9032. {$IFDEF VerbosePasResolver}
  9033. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  9034. {$ENDIF}
  9035. RaiseNotYetImplemented(20170325145720,Params);
  9036. end;
  9037. end
  9038. else
  9039. begin
  9040. {$IFDEF VerbosePasResolver}
  9041. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  9042. {$ENDIF}
  9043. RaiseMsg(20170306121908,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9044. ['(',TypeEl.ElementTypeName],Params);
  9045. end;
  9046. end
  9047. else
  9048. begin
  9049. // FoundEl is not a type, maybe a var
  9050. ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  9051. TypeEl:=ResolvedEl.LoTypeEl;
  9052. if TypeEl is TPasProcedureType then
  9053. begin
  9054. if not (Access in [rraRead,rraParamToUnknownProc]) then
  9055. begin
  9056. {$IFDEF VerbosePasResolver}
  9057. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  9058. {$ENDIF}
  9059. RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  9060. end;
  9061. FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
  9062. exit;
  9063. end;
  9064. {$IFDEF VerbosePasResolver}
  9065. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
  9066. {$ENDIF}
  9067. RaiseMsg(20170306104301,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9068. ['(',TypeEl.ElementTypeName],Params);
  9069. end;
  9070. end;
  9071. procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
  9072. Access: TResolvedRefAccess);
  9073. var
  9074. ResolvedEl: TPasResolverResult;
  9075. Value: TPasExpr;
  9076. SubParams: TParamsExpr;
  9077. begin
  9078. Value:=Params.Value;
  9079. if Value=nil then
  9080. RaiseInternalError(20180423093120,GetObjName(Params));
  9081. if IsNameExpr(Value) then
  9082. begin
  9083. // e.g. Name[]
  9084. ResolveArrayParamsExprName(Value,Params,Access);
  9085. exit;
  9086. end
  9087. else if Value.ClassType=TParamsExpr then
  9088. begin
  9089. SubParams:=TParamsExpr(Value);
  9090. // e.g. Name()[] or Name[][] or [][]
  9091. ResolveExpr(SubParams,rraRead);
  9092. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  9093. if Value.CustomData=nil then
  9094. CreateReference(ResolvedEl.LoTypeEl,Value,Access);
  9095. ResolvedEl.IdentEl:=nil;
  9096. end
  9097. else if Value.InheritsFrom(TUnaryExpr) then
  9098. begin
  9099. ResolveExpr(TUnaryExpr(Value).Operand,Access);
  9100. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  9101. end
  9102. else if Value is TBinaryExpr then
  9103. begin
  9104. // Note: a.b[] is the same as (a.b)[]
  9105. // Note: a.b[].c is stored as
  9106. // TBinaryExpr eopSubIdent
  9107. // / \
  9108. // left = TParamsExpr right = TPrimitiveExpr 'c'
  9109. // Value = TBinaryExpr
  9110. // / \
  9111. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  9112. while (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) do
  9113. Value:=TBinaryExpr(Value).right;
  9114. if IsNameExpr(Value) then
  9115. begin
  9116. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  9117. if not (Value.CustomData is TResolvedReference) then
  9118. RaiseNotYetImplemented(20190115144534,Params);
  9119. // already resolved
  9120. exit;
  9121. end
  9122. else
  9123. begin
  9124. // ToDo: (a+b)[]
  9125. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  9126. RaiseNotYetImplemented(20190115144539,Params);
  9127. end;
  9128. end
  9129. else
  9130. RaiseNotYetImplemented(20160927212610,Value);
  9131. {$IFDEF VerbosePasResolver}
  9132. writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
  9133. {$ENDIF}
  9134. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  9135. end;
  9136. procedure TPasResolver.ResolveArrayParamsExprName(NameExpr: TPasExpr;
  9137. Params: TParamsExpr; Access: TResolvedRefAccess);
  9138. // e.g. a.NameExp[]
  9139. var
  9140. ArrayName: String;
  9141. FindData: TPRFindData;
  9142. Ref: TResolvedReference;
  9143. DeclEl: TPasElement;
  9144. Proc, ImplProc: TPasProcedure;
  9145. ProcScope: TPasProcedureScope;
  9146. ResolvedEl: TPasResolverResult;
  9147. begin
  9148. if (NameExpr.ClassType=TPrimitiveExpr)
  9149. and (TPrimitiveExpr(NameExpr).Kind=pekIdent) then
  9150. // e.g. Name[]
  9151. ArrayName:=TPrimitiveExpr(NameExpr).Value
  9152. else
  9153. RaiseNotYetImplemented(20190131154557,NameExpr);
  9154. DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true);
  9155. Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData);
  9156. CheckFoundElement(FindData,Ref);
  9157. if DeclEl is TPasProcedure then
  9158. begin
  9159. Proc:=TPasProcedure(DeclEl);
  9160. if (Access=rraAssign)
  9161. and (Proc.ProcType is TPasFunctionType)
  9162. and (Params.Parent.ClassType=TPasImplAssign)
  9163. and (TPasImplAssign(Params.Parent).left=Params) then
  9164. begin
  9165. // e.g. funcname[]:=
  9166. ProcScope:=Proc.CustomData as TPasProcedureScope;
  9167. ImplProc:=ProcScope.ImplProc;
  9168. if ImplProc=nil then
  9169. ImplProc:=Proc;
  9170. if Params.HasParent(ImplProc) then
  9171. begin
  9172. // "FuncA[]:=" within FuncA -> redirect to ResultEl
  9173. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  9174. end;
  9175. end;
  9176. end;
  9177. ComputeElement(NameExpr,ResolvedEl,[rcSetReferenceFlags]);
  9178. {$IFDEF VerbosePasResolver}
  9179. writeln('TPasResolver.ResolveArrayParamsExprName NameExp=',GetObjName(NameExpr),' ',GetResolverResultDbg(ResolvedEl));
  9180. {$ENDIF}
  9181. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  9182. end;
  9183. procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
  9184. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
  9185. procedure ReadAccessParamValue;
  9186. var
  9187. Left: TPasExpr;
  9188. Ref: TResolvedReference;
  9189. begin
  9190. if Access=rraAssign then
  9191. begin
  9192. // ArrayStringPointer[]:=
  9193. // -> writing the element needs reading the value
  9194. Left:=Params.Value;
  9195. if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode=eopSubIdent) then
  9196. Left:=TBinaryExpr(Left).right;
  9197. if Left.CustomData is TResolvedReference then
  9198. begin
  9199. Ref:=TResolvedReference(Left.CustomData);
  9200. if Ref.Access=rraAssign then
  9201. Ref.Access:=rraReadAndAssign;
  9202. end;
  9203. end;
  9204. end;
  9205. function CheckStringOrPointerIndex(IsStringIndex: boolean): boolean;
  9206. var
  9207. ArgExp: TPasExpr;
  9208. ResolvedArg: TPasResolverResult;
  9209. begin
  9210. ReadAccessParamValue;
  9211. if not IsStringIndex then
  9212. begin
  9213. // pointer
  9214. if not ElHasBoolSwitch(Params,bsPointerMath) then
  9215. exit(false);
  9216. end;
  9217. Result:=true;
  9218. if not (rrfReadable in ResolvedValue.Flags) then
  9219. RaiseXExpectedButYFound(20170216152548,'index',GetElementTypeName(ResolvedValue.LoTypeEl),Params);
  9220. // check single argument
  9221. if length(Params.Params)<1 then
  9222. RaiseMsg(20170216152204,nMissingParameterX,
  9223. sMissingParameterX,[BoolToStr(IsStringIndex,'character index','index')],Params)
  9224. else if length(Params.Params)>1 then
  9225. RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
  9226. // check argument is integer
  9227. ArgExp:=Params.Params[0];
  9228. ComputeElement(ArgExp,ResolvedArg,[rcSetReferenceFlags]);
  9229. if not (ResolvedArg.BaseType in btAllInteger) then
  9230. RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9231. [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
  9232. if not (rrfReadable in ResolvedArg.Flags) then
  9233. RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9234. ['type','value'],ArgExp);
  9235. AccessExpr(ArgExp,rraRead);
  9236. end;
  9237. var
  9238. PropEl: TPasProperty;
  9239. i: Integer;
  9240. TypeEl: TPasType;
  9241. C: TClass;
  9242. begin
  9243. if ResolvedValue.BaseType in btAllStrings then
  9244. begin
  9245. // string -> check that ResolvedValue is not merely a type, but has a value
  9246. if CheckStringOrPointerIndex(true) then
  9247. exit;
  9248. end
  9249. else if (ResolvedValue.IdentEl is TPasProperty)
  9250. and (GetPasPropertyArgs(TPasProperty(ResolvedValue.IdentEl)).Count>0) then
  9251. begin
  9252. PropEl:=TPasProperty(ResolvedValue.IdentEl);
  9253. CheckCallPropertyCompatibility(PropEl,Params,true);
  9254. FinishPropertyParamAccess(Params,PropEl);
  9255. exit;
  9256. end
  9257. else if ResolvedValue.BaseType=btPointer then
  9258. begin
  9259. if CheckStringOrPointerIndex(false) then
  9260. exit;
  9261. end
  9262. else if ResolvedValue.BaseType=btContext then
  9263. begin
  9264. TypeEl:=ResolvedValue.LoTypeEl;
  9265. C:=TypeEl.ClassType;
  9266. if (C=TPasClassType)
  9267. or (C=TPasRecordType)
  9268. or (C=TPasClassOfType) then
  9269. begin
  9270. if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,Access) then
  9271. exit;
  9272. end
  9273. else if C=TPasArrayType then
  9274. begin
  9275. if ResolvedValue.IdentEl is TPasType then
  9276. RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9277. ['[',ResolvedValue.IdentEl.ElementTypeName],Params);
  9278. ReadAccessParamValue;
  9279. CheckCallArrayCompatibility(TPasArrayType(TypeEl),Params,true,true);
  9280. for i:=0 to length(Params.Params)-1 do
  9281. AccessExpr(Params.Params[i],rraRead);
  9282. exit;
  9283. end
  9284. else if C=TPasPointerType then
  9285. begin
  9286. if CheckStringOrPointerIndex(false) then exit;
  9287. end;
  9288. end;
  9289. RaiseMsg(20170216152217,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9290. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  9291. end;
  9292. function TPasResolver.ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  9293. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess): boolean;
  9294. var
  9295. PropEl: TPasProperty;
  9296. Value: TPasExpr;
  9297. Group: TPasGroupScope;
  9298. i: Integer;
  9299. Scope: TPasIdentifierScope;
  9300. TypeEl: TPasType;
  9301. IsClassOf: Boolean;
  9302. begin
  9303. TypeEl:=ResolvedValue.LoTypeEl;
  9304. IsClassOf:=TypeEl.ClassType=TPasClassOfType;
  9305. if IsClassOf then
  9306. TypeEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType);
  9307. Group:=CreateGroupScope(TypeEl);
  9308. PropEl:=nil;
  9309. for i:=0 to Group.Count-1 do
  9310. begin
  9311. Scope:=Group.Scopes[i];
  9312. if Scope is TPasClassOrRecordScope then
  9313. begin
  9314. PropEl:=TPasClassOrRecordScope(Scope).DefaultProperty;
  9315. if PropEl<>nil then break;
  9316. end;
  9317. end;
  9318. Group.Free;
  9319. if PropEl=nil then exit(false);
  9320. // class/record/interface has default property
  9321. if (IsClassOf or (ResolvedValue.IdentEl is TPasType)) and (not PropEl.IsClass) then
  9322. RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9323. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  9324. Value:=Params.Value;
  9325. if Value.CustomData is TResolvedReference then
  9326. SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
  9327. CreateReference(PropEl,Params,Access);
  9328. CheckCallPropertyCompatibility(PropEl,Params,true);
  9329. FinishPropertyParamAccess(Params,PropEl);
  9330. Result:=true;
  9331. end;
  9332. procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
  9333. // e.g. resolving '[1,2..3]'
  9334. var
  9335. i: Integer;
  9336. Param: TPasExpr;
  9337. ParamResolved: TPasResolverResult;
  9338. begin
  9339. {$IFDEF VerbosePasResolver}
  9340. writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
  9341. {$ENDIF}
  9342. if Params.Value<>nil then
  9343. RaiseNotYetImplemented(20160930135910,Params);
  9344. for i:=0 to length(Params.Params)-1 do
  9345. begin
  9346. Param:=Params.Params[i];
  9347. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType,rcSetReferenceFlags]);
  9348. end;
  9349. end;
  9350. procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
  9351. var
  9352. i: Integer;
  9353. begin
  9354. for i:=0 to length(El.Values)-1 do
  9355. ResolveExpr(El.Values[i],rraRead);
  9356. end;
  9357. procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
  9358. function GetMember(RecType: TPasRecordType; const aName: string): TPasElement;
  9359. var
  9360. i: Integer;
  9361. begin
  9362. for i:=0 to RecType.Members.Count-1 do
  9363. begin
  9364. Result:=TPasElement(RecType.Members[i]);
  9365. if SameText(Result.Name,aName) then
  9366. exit;
  9367. end;
  9368. if RecType.VariantEl is TPasVariable then
  9369. begin
  9370. Result:=TPasVariable(RecType.VariantEl);
  9371. if SameText(Result.Name,aName) then
  9372. exit;
  9373. end;
  9374. if RecType.Variants<>nil then
  9375. for i:=0 to RecType.Variants.Count-1 do
  9376. begin
  9377. Result:=GetMember(TPasVariant(RecType.Variants[i]).Members,aName);
  9378. if Result<>nil then
  9379. exit;
  9380. end;
  9381. Result:=nil;
  9382. end;
  9383. var
  9384. i, j: Integer;
  9385. Member: TPasElement;
  9386. RecType: TPasRecordType;
  9387. Field: PRecordValuesItem;
  9388. s: String;
  9389. ResolvedEl: TPasResolverResult;
  9390. begin
  9391. {$IFDEF VerbosePasResolver}
  9392. writeln('TPasResolver.ResolveRecordValues ',El.Fields[0].Name,' ',GetObjName(El.Parent),' ',GetObjName(El.Parent.Parent));
  9393. {$ENDIF}
  9394. ComputeElement(El,ResolvedEl,[]);
  9395. if (ResolvedEl.BaseType<>btContext)
  9396. or (ResolvedEl.LoTypeEl.ClassType<>TPasRecordType) then
  9397. begin
  9398. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  9399. [],'record value',GetTypeDescription(ResolvedEl),El);
  9400. end;
  9401. RecType:=TPasRecordType(ResolvedEl.LoTypeEl);
  9402. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(El.Parent),' ',GetObjName(RecType));
  9403. for i:=0 to length(El.Fields)-1 do
  9404. begin
  9405. Field:[email protected][i];
  9406. // check member exists
  9407. Member:=GetMember(RecType,Field^.Name);
  9408. if Member=nil then
  9409. RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
  9410. if Member.ClassType<>TPasVariable then
  9411. RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  9412. [],Field^.ValueExp);
  9413. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  9414. RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  9415. ['record assignment'],Field^.ValueExp);
  9416. CreateReference(Member,Field^.NameExp,rraAssign);
  9417. // check duplicates
  9418. for j:=0 to i-1 do
  9419. if SameText(Field^.Name,El.Fields[j].Name) then
  9420. RaiseMsg(20180429104942,nDuplicateIdentifier,sDuplicateIdentifier,
  9421. [Field^.Name,GetElementSourcePosStr(El.Fields[j].NameExp)],Field^.NameExp);
  9422. // resolve expression
  9423. ResolveExpr(El.Fields[i].ValueExp,rraRead);
  9424. // check compatible
  9425. CheckAssignCompatibility(Member,Field^.ValueExp);
  9426. end;
  9427. // hint for missing fields
  9428. s:='';
  9429. for i:=0 to RecType.Members.Count-1 do
  9430. begin
  9431. Member:=TPasElement(RecType.Members[i]);
  9432. if Member.ClassType<>TPasVariable then continue;
  9433. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  9434. continue;
  9435. j:=length(El.Fields)-1;
  9436. while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
  9437. dec(j);
  9438. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(Member),' ',j);
  9439. if j<0 then
  9440. begin
  9441. if s<>'' then s:=s+', ';
  9442. if length(s)>30 then
  9443. begin
  9444. s:=s+'...';
  9445. break;
  9446. end;
  9447. s:=s+Member.Name;
  9448. end;
  9449. end;
  9450. // ToDo: hint for missing variants
  9451. if s<>'' then
  9452. LogMsg(20180429121127,mtHint,nMissingFieldsX,sMissingFieldsX,[s],El);
  9453. end;
  9454. function TPasResolver.ResolveAccessor(Expr: TPasExpr): TPasElement;
  9455. function SubResolvePrimitive(Prim: TPrimitiveExpr): TPasElement;
  9456. var
  9457. FindData: TPRFindData;
  9458. Ref: TResolvedReference;
  9459. Scope: TPasScope;
  9460. Abort: boolean;
  9461. begin
  9462. if Prim.Kind<>pekIdent then
  9463. RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
  9464. // search in class and ancestors, not in unit interface
  9465. Scope:=TopScope;
  9466. FindData:=Default(TPRFindData);
  9467. FindData.ErrorPosEl:=Expr;
  9468. Abort:=false;
  9469. Scope.IterateElements(Prim.Value,Scope,@OnFindFirst,@FindData,Abort);
  9470. Result:=FindData.Found;
  9471. if Result=nil then
  9472. RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
  9473. Ref:=CreateReference(Result,Prim,rraRead);
  9474. CheckFoundElementVisibility(FindData,Ref);
  9475. end;
  9476. var
  9477. Prim: TPrimitiveExpr;
  9478. DeclEl: TPasElement;
  9479. begin
  9480. if Expr.ClassType=TBinaryExpr then
  9481. begin
  9482. DeclEl:=nil;
  9483. if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
  9484. begin
  9485. Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
  9486. DeclEl:=SubResolvePrimitive(Prim);
  9487. if not (DeclEl is TPasMembersType) then
  9488. RaiseXExpectedButYFound(20170216151752,'class',GetElementTypeName(DeclEl),Prim);
  9489. end
  9490. else
  9491. RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  9492. if TBinaryExpr(Expr).OpCode<>eopSubIdent then
  9493. RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  9494. if DeclEl.ClassType=TPasClassType then
  9495. PushClassDotScope(TPasClassType(DeclEl))
  9496. else if DeclEl.ClassType=TPasRecordType then
  9497. PushRecordDotScope(TPasRecordType(DeclEl))
  9498. else
  9499. RaiseMsg(20190123145559,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  9500. Expr:=TBinaryExpr(Expr).right;
  9501. Result:=ResolveAccessor(Expr);
  9502. PopScope;
  9503. end
  9504. else if Expr.ClassType=TPrimitiveExpr then
  9505. begin
  9506. Prim:=TPrimitiveExpr(Expr);
  9507. Result:=SubResolvePrimitive(Prim);
  9508. end
  9509. else
  9510. RaiseNotYetImplemented(20160922163436,Expr);
  9511. end;
  9512. procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
  9513. Ref: TResolvedReference; Access: TResolvedRefAccess);
  9514. begin
  9515. if (Ref.Access=Access) then exit;
  9516. if Access in [rraNone,rraParamToUnknownProc] then
  9517. exit;
  9518. if Expr=nil then ;
  9519. case Ref.Access of
  9520. rraNone,rraParamToUnknownProc:
  9521. Ref.Access:=Access;
  9522. rraRead:
  9523. if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
  9524. Ref.Access:=rraReadAndAssign
  9525. else
  9526. exit;
  9527. rraAssign,rraOutParam:
  9528. if Access in [rraRead,rraReadAndAssign,rraVarParam] then
  9529. Ref.Access:=rraReadAndAssign
  9530. else
  9531. exit;
  9532. rraReadAndAssign: exit;
  9533. rraVarParam: exit;
  9534. else
  9535. RaiseInternalError(20170403163727);
  9536. end;
  9537. end;
  9538. procedure TPasResolver.AccessExpr(Expr: TPasExpr;
  9539. Access: TResolvedRefAccess);
  9540. // called after a call target was found, called for each element
  9541. // to change the rraParamToUnknownProc value to Access
  9542. var
  9543. Ref: TResolvedReference;
  9544. Bin: TBinaryExpr;
  9545. Params: TParamsExpr;
  9546. ValueResolved: TPasResolverResult;
  9547. C: TClass;
  9548. begin
  9549. if (Expr.CustomData is TResolvedReference) then
  9550. begin
  9551. Ref:=TResolvedReference(Expr.CustomData);
  9552. SetResolvedRefAccess(Expr,Ref,Access);
  9553. end;
  9554. C:=Expr.ClassType;
  9555. if C=TBinaryExpr then
  9556. begin
  9557. Bin:=TBinaryExpr(Expr);
  9558. if Bin.OpCode in [eopSubIdent,eopNone] then
  9559. AccessExpr(Bin.right,Access);
  9560. end
  9561. else if C=TParamsExpr then
  9562. begin
  9563. Params:=TParamsExpr(Expr);
  9564. case Params.Kind of
  9565. pekFuncParams:
  9566. if IsTypeCast(Params) then
  9567. FinishCallArgAccess(Params.Params[0],Access)
  9568. else
  9569. AccessExpr(Params.Value,Access);
  9570. pekArrayParams:
  9571. begin
  9572. ComputeElement(Params.Value,ValueResolved,[]);
  9573. if IsDynArray(ValueResolved.LoTypeEl,false)
  9574. or (ValueResolved.BaseType=btPointer) then
  9575. // when accessing an element of a dynamic array the array is read
  9576. AccessExpr(Params.Value,rraRead)
  9577. else
  9578. AccessExpr(Params.Value,Access);
  9579. // Note: an element of an open or static array or a string is connected to the variable
  9580. end;
  9581. pekSet:
  9582. if Access<>rraRead then
  9583. RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  9584. else
  9585. RaiseNotYetImplemented(20170403173831,Params);
  9586. end;
  9587. end
  9588. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  9589. // ok
  9590. else if (Access in [rraRead,rraParamToUnknownProc])
  9591. and ((C=TPrimitiveExpr)
  9592. or (C=TNilExpr)
  9593. or (C=TBoolConstExpr)
  9594. or (C=TProcedureExpr)) then
  9595. // ok
  9596. else if C=TUnaryExpr then
  9597. AccessExpr(TUnaryExpr(Expr).Operand,Access)
  9598. else
  9599. begin
  9600. {$IFDEF VerbosePasResolver}
  9601. writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  9602. {$ENDIF}
  9603. RaiseNotYetImplemented(20170306102158,Expr);
  9604. end;
  9605. end;
  9606. function TPasResolver.MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType
  9607. ): boolean;
  9608. var
  9609. Ref: TResolvedReference;
  9610. begin
  9611. if Expr.CustomData=nil then
  9612. begin
  9613. // mark set expression as array
  9614. CreateReference(ArrayType,Expr,rraRead);
  9615. Result:=true;
  9616. end
  9617. else if Expr.CustomData is TResolvedReference then
  9618. begin
  9619. // already set
  9620. Result:=false;
  9621. // check consistency
  9622. Ref:=TResolvedReference(Expr.CustomData);
  9623. if not (Ref.Declaration is TPasArrayType) then
  9624. begin
  9625. {$IFDEF VerbosePasResolver}
  9626. writeln('TPasResolver.MarkArrayExpr Expr=',GetObjName(Expr),' Ref.Declaration=',GetObjName(Ref.Declaration),' ',Ref.Declaration.ParentPath);
  9627. {$ENDIF}
  9628. RaiseNotYetImplemented(20180618102230,Expr,GetObjName(Ref.Declaration));
  9629. end;
  9630. end
  9631. else
  9632. // already set with something else
  9633. RaiseNotYetImplemented(20180618102408,Expr,GetObjName(Expr.CustomData));
  9634. end;
  9635. procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
  9636. ArrType: TPasArrayType);
  9637. procedure Traverse(CurExpr: TPasExpr; ArrayType: TPasArrayType; RgIndex: integer);
  9638. var
  9639. Params: TPasExprArray;
  9640. i: Integer;
  9641. ResolvedElType: TPasResolverResult;
  9642. ParamsExpr: TParamsExpr;
  9643. BuiltInProc: TResElDataBuiltInProc;
  9644. Ref: TResolvedReference;
  9645. begin
  9646. if IsArrayOperatorAdd(CurExpr) then
  9647. begin
  9648. Traverse(TBinaryExpr(CurExpr).left,ArrayType,RgIndex);
  9649. Traverse(TBinaryExpr(CurExpr).right,ArrayType,RgIndex);
  9650. end
  9651. else if CurExpr.ClassType=TParamsExpr then
  9652. begin
  9653. ParamsExpr:=TParamsExpr(CurExpr);
  9654. Params:=ParamsExpr.Params;
  9655. if CurExpr.Kind=pekSet then
  9656. begin
  9657. MarkArrayExpr(ParamsExpr,ArrayType);
  9658. // traverse into nested expressions, e.g. [ A, B ]
  9659. if length(Params)=0 then exit;
  9660. inc(RgIndex);
  9661. if RgIndex>length(ArrayType.Ranges) then
  9662. begin
  9663. if ArrayType.ElType=nil then
  9664. exit; // elements are not arrays
  9665. ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
  9666. if (ResolvedElType.BaseType=btContext)
  9667. and (ResolvedElType.LoTypeEl is TPasArrayType) then
  9668. begin
  9669. ArrayType:=TPasArrayType(ResolvedElType.LoTypeEl);
  9670. RgIndex:=0;
  9671. end
  9672. else
  9673. exit; // elements are not arrays
  9674. end;
  9675. for i:=0 to length(Params)-1 do
  9676. Traverse(Params[i],ArrayType,RgIndex);
  9677. end
  9678. else if CurExpr.Kind=pekFuncParams then
  9679. begin
  9680. if TParamsExpr(CurExpr).Value.CustomData is TResolvedReference then
  9681. begin
  9682. Ref:=TResolvedReference(TParamsExpr(CurExpr).Value.CustomData);
  9683. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  9684. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  9685. begin
  9686. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  9687. if BuiltInProc.BuiltIn=bfConcatArray then
  9688. begin
  9689. // concat(array1,array2,...)
  9690. for i:=0 to length(Params)-1 do
  9691. Traverse(Params[i],ArrayType,RgIndex);
  9692. end
  9693. else if BuiltInProc.BuiltIn=bfCopyArray then
  9694. // copy(array,...)
  9695. Traverse(Params[0],ArrayType,RgIndex);
  9696. end;
  9697. end;
  9698. end;
  9699. end;
  9700. end;
  9701. begin
  9702. Traverse(Expr,ArrType,0);
  9703. end;
  9704. procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
  9705. var
  9706. i: Integer;
  9707. DeclEl: TPasElement;
  9708. Proc: TPasProcedure;
  9709. aClassOrRec: TPasMembersType;
  9710. begin
  9711. if IsElementSkipped(El) then exit;
  9712. if El is TPasDeclarations then
  9713. begin
  9714. for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
  9715. begin
  9716. DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
  9717. if DeclEl is TPasProcedure then
  9718. begin
  9719. Proc:=TPasProcedure(DeclEl);
  9720. if ProcNeedsImplProc(Proc)
  9721. and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
  9722. RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
  9723. [GetElementTypeName(Proc),Proc.Name],Proc);
  9724. end;
  9725. end;
  9726. end
  9727. else if El is TPasMembersType then
  9728. begin
  9729. aClassOrRec:=TPasMembersType(El);
  9730. if (aClassOrRec is TPasClassType)
  9731. and (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface])
  9732. then exit;
  9733. for i:=0 to aClassOrRec.Members.Count-1 do
  9734. begin
  9735. DeclEl:=TPasElement(aClassOrRec.Members[i]);
  9736. if DeclEl is TPasProcedure then
  9737. begin
  9738. Proc:=TPasProcedure(DeclEl);
  9739. if Proc.IsAbstract or Proc.IsExternal then continue;
  9740. if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
  9741. RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
  9742. [GetElementTypeName(Proc),Proc.Name],Proc);
  9743. end;
  9744. end;
  9745. end;
  9746. end;
  9747. procedure TPasResolver.CheckPointerCycle(El: TPasPointerType);
  9748. var
  9749. C: TClass;
  9750. CurEl, Dest: TPasType;
  9751. begin
  9752. CurEl:=El;
  9753. while CurEl<>nil do
  9754. begin
  9755. C:=CurEl.ClassType;
  9756. if C=TPasPointerType then
  9757. Dest:=TPasPointerType(CurEl).DestType
  9758. else if C.InheritsFrom(TPasAliasType) then
  9759. Dest:=TPasAliasType(CurEl).DestType
  9760. else
  9761. exit;
  9762. if Dest=El then
  9763. RaiseMsg(20180422165758,nTypeCycleFound,sTypeCycleFound,[],El);
  9764. CurEl:=Dest;
  9765. end;
  9766. end;
  9767. procedure TPasResolver.ComputeUnaryNot(El: TUnaryExpr;
  9768. var ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  9769. begin
  9770. RaiseMsg(20180208121532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  9771. [OpcodeStrings[El.OpCode],GetResolverResultDescription(ResolvedEl)],El);
  9772. if Flags=[] then ;
  9773. end;
  9774. procedure TPasResolver.AddModule(El: TPasModule);
  9775. var
  9776. C: TClass;
  9777. ModScope: TPasModuleScope;
  9778. begin
  9779. if TopScope<>DefaultScope then
  9780. RaiseInvalidScopeForElement(20160922163504,El);
  9781. ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module));
  9782. ModScope.VisibilityContext:=El;
  9783. ModScope.FirstName:=FirstDottedIdentifier(El.Name);
  9784. C:=El.ClassType;
  9785. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  9786. FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
  9787. else
  9788. FDefaultNameSpace:='';
  9789. ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  9790. end;
  9791. procedure TPasResolver.AddSection(El: TPasSection);
  9792. // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
  9793. // Note: implementation scope is within the interface scope
  9794. var
  9795. Scope: TPasSectionScope;
  9796. begin
  9797. if TopScope is TPasSectionScope then
  9798. FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
  9799. if TopScope is TPasModuleScope then
  9800. TPasModuleScope(TopScope).BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  9801. FPendingForwardProcs.Add(El); // check forward declarations at the end
  9802. Scope:=TPasSectionScope(PushScope(El,ScopeClass_Section));
  9803. Scope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  9804. Scope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  9805. end;
  9806. procedure TPasResolver.AddInitialFinalizationSection(El: TPasImplBlock);
  9807. begin
  9808. PushScope(El,ScopeClass_InitialFinalization);
  9809. end;
  9810. procedure TPasResolver.AddType(El: TPasType);
  9811. begin
  9812. if (El.Name='') then exit; // sub type
  9813. {$IFDEF VerbosePasResolver}
  9814. writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
  9815. {$ENDIF}
  9816. if not (TopScope is TPasIdentifierScope) then
  9817. RaiseInvalidScopeForElement(20160922163506,El);
  9818. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9819. end;
  9820. procedure TPasResolver.AddRecordType(El: TPasRecordType);
  9821. var
  9822. Scope: TPasScope;
  9823. begin
  9824. {$IFDEF VerbosePasResolver}
  9825. writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  9826. {$ENDIF}
  9827. if not (TopScope is TPasIdentifierScope) then
  9828. RaiseInvalidScopeForElement(20160922163508,El);
  9829. if El.Name<>'' then begin
  9830. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9831. FPendingForwardProcs.Add(El); // check forward declarations at the end
  9832. end;
  9833. if El.Parent.ClassType<>TPasVariant then
  9834. begin
  9835. Scope:=PushScope(El,TPasRecordScope);
  9836. Scope.VisibilityContext:=El;
  9837. end;
  9838. end;
  9839. procedure TPasResolver.AddClassType(El: TPasClassType);
  9840. // Note: IsForward is not yet set!
  9841. var
  9842. Duplicate: TPasIdentifier;
  9843. ForwardDecl: TPasClassType;
  9844. CurScope, LocalScope: TPasIdentifierScope;
  9845. begin
  9846. {$IFDEF VerbosePasResolver}
  9847. //writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
  9848. {$ENDIF}
  9849. if not (TopScope is TPasIdentifierScope) then
  9850. RaiseInvalidScopeForElement(20160922163510,El);
  9851. CurScope:=TPasIdentifierScope(TopScope);
  9852. if CurScope is TPasGroupScope then
  9853. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  9854. else
  9855. LocalScope:=CurScope;
  9856. Duplicate:=LocalScope.FindLocalIdentifier(El.Name);
  9857. //if Duplicate<>nil then
  9858. //writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
  9859. if (Duplicate<>nil)
  9860. and (Duplicate.Element is TPasClassType)
  9861. and TPasClassType(Duplicate.Element).IsForward
  9862. and (Duplicate.Element.Parent=El.Parent)
  9863. then
  9864. begin
  9865. // forward declaration found
  9866. ForwardDecl:=TPasClassType(Duplicate.Element);
  9867. {$IFDEF VerbosePasResolver}
  9868. writeln(' Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
  9869. {$ENDIF}
  9870. if ForwardDecl.CustomData<>nil then
  9871. RaiseInternalError(20160922163513,'forward class has already customdata');
  9872. // create a ref from the forward to the real declaration
  9873. CreateReference(El,ForwardDecl,rraRead);
  9874. // change the cache item
  9875. Duplicate.Element:=El;
  9876. end
  9877. else
  9878. AddIdentifier(CurScope,El.Name,El,pikSimple);
  9879. FPendingForwardProcs.Add(El); // check forward declarations at the end
  9880. end;
  9881. procedure TPasResolver.AddVariable(El: TPasVariable);
  9882. begin
  9883. if (El.Name='') then exit; // anonymous var
  9884. {$IFDEF VerbosePasResolver}
  9885. writeln('TPasResolver.AddVariable ',GetObjName(El));
  9886. {$ENDIF}
  9887. if not (TopScope is TPasIdentifierScope) then
  9888. RaiseInvalidScopeForElement(20160929205730,El);
  9889. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9890. end;
  9891. procedure TPasResolver.AddResourceString(El: TPasResString);
  9892. var
  9893. C: TClass;
  9894. begin
  9895. {$IFDEF VerbosePasResolver}
  9896. writeln('TPasResolver.AddResourceString ',GetObjName(El));
  9897. {$ENDIF}
  9898. if not (TopScope is TPasIdentifierScope) then
  9899. RaiseInvalidScopeForElement(20171004092114,El);
  9900. C:=El.Parent.ClassType;
  9901. if not C.InheritsFrom(TPasSection) then
  9902. RaiseNotYetImplemented(20171004092518,El);
  9903. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9904. end;
  9905. procedure TPasResolver.AddEnumType(El: TPasEnumType);
  9906. var
  9907. CanonicalSet: TPasSetType;
  9908. EnumScope: TPasEnumTypeScope;
  9909. begin
  9910. {$IFDEF VerbosePasResolver}
  9911. writeln('TPasResolver.AddEnumType ',GetObjName(El));
  9912. {$ENDIF}
  9913. if not (TopScope is TPasIdentifierScope) then
  9914. RaiseInvalidScopeForElement(20160929205732,El);
  9915. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9916. EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
  9917. // add canonical set
  9918. if El.Parent is TPasSetType then
  9919. begin
  9920. // anonymous enumtype, e.g. "set of ()"
  9921. CanonicalSet:=TPasSetType(El.Parent);
  9922. CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  9923. end
  9924. else
  9925. begin
  9926. CanonicalSet:=TPasSetType.Create('',El);
  9927. {$IFDEF CheckPasTreeRefCount}CanonicalSet.RefIds.Add('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  9928. CanonicalSet.EnumType:=El;
  9929. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSetType.EnumType'){$ENDIF};
  9930. end;
  9931. EnumScope.CanonicalSet:=CanonicalSet;
  9932. end;
  9933. procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
  9934. var
  9935. i: Integer;
  9936. Scope: TPasScope;
  9937. Old: TPasIdentifier;
  9938. begin
  9939. {$IFDEF VerbosePasResolver}
  9940. writeln('TPasResolver.AddEnumValue ',GetObjName(El));
  9941. {$ENDIF}
  9942. if not (TopScope is TPasEnumTypeScope) then
  9943. RaiseInvalidScopeForElement(20160929205736,El);
  9944. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9945. // propagate enum to parent scopes
  9946. // TEnum = (red, green); -> dot not propagate
  9947. // TFlags = set of (red,blue); -> propagate
  9948. if (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches)
  9949. and not (El.Parent.Parent is TPasSetType) then
  9950. exit;
  9951. for i:=ScopeCount-2 downto 0 do
  9952. begin
  9953. Scope:=Scopes[i];
  9954. if Scope is TPasGroupScope then
  9955. Scope:=TPasGroupScope(Scope).Scopes[0];
  9956. if Scope is TPasClassOrRecordScope then
  9957. begin
  9958. // class or record: add if not duplicate
  9959. Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
  9960. if Old=nil then
  9961. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  9962. end
  9963. else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
  9964. begin
  9965. // procedure or section: check for duplicate and add
  9966. Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
  9967. if Old<>nil then
  9968. RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
  9969. [El.Name,GetElementSourcePosStr(Old.Element)],El);
  9970. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  9971. break;
  9972. end
  9973. else
  9974. break;
  9975. end;
  9976. end;
  9977. procedure TPasResolver.AddProperty(El: TPasProperty);
  9978. begin
  9979. if (El.Name='') then
  9980. RaiseNotYetImplemented(20160922163518,El);
  9981. {$IFDEF VerbosePasResolver}
  9982. writeln('TPasResolver.AddProperty ',GetObjName(El));
  9983. {$ENDIF}
  9984. if not (GetLocalScope is TPasClassOrRecordScope) then
  9985. RaiseInvalidScopeForElement(20160922163520,El);
  9986. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  9987. PushScope(El,TPasPropertyScope);
  9988. end;
  9989. procedure TPasResolver.AddProcedure(El: TPasProcedure);
  9990. procedure AddClassConDestructor(ClassOrRecordScope: TPasClassOrRecordScope;
  9991. var Field: TPasProcedure);
  9992. begin
  9993. if Field<>nil then
  9994. RaiseMsg(20181231144353,nMultipleXinTypeYNameZCAandB,
  9995. sMultipleXinTypeYNameZCAandB,[GetElementTypeName(El),
  9996. GetElementTypeName(ClassOrRecordScope.Element),
  9997. ClassOrRecordScope.Element.Name,Field.Name,El.Name],El);
  9998. Field:=El;
  9999. end;
  10000. var
  10001. ProcName, aClassName: String;
  10002. p: SizeInt;
  10003. ClassOrRecType: TPasMembersType;
  10004. ProcScope: TPasProcedureScope;
  10005. HasDot, IsClassConDestructor: Boolean;
  10006. CurEl: TPasElement;
  10007. Identifier: TPasIdentifier;
  10008. ClassOrRecScope: TPasClassOrRecordScope;
  10009. C: TClass;
  10010. CurScope: TPasScope;
  10011. LocalScope: TPasScope;
  10012. begin
  10013. {$IFDEF VerbosePasResolver}
  10014. writeln('TPasResolver.AddProcedure ',GetObjName(El));
  10015. {$ENDIF}
  10016. CurScope:=TopScope;
  10017. if CurScope.ClassType=TPasGroupScope then
  10018. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  10019. else
  10020. LocalScope:=CurScope;
  10021. ProcName:=El.Name;
  10022. if El.Name<>'' then
  10023. begin
  10024. // named proc
  10025. if not (LocalScope is TPasIdentifierScope) then
  10026. RaiseInvalidScopeForElement(20160922163522,El);
  10027. end
  10028. else
  10029. begin
  10030. // anonymous proc
  10031. C:=LocalScope.ClassType;
  10032. if (C=ScopeClass_InitialFinalization)
  10033. or C.InheritsFrom(TPasProcedureScope)
  10034. or (C=TPasWithScope)
  10035. or (C=ScopeClass_WithExpr)
  10036. or (C=TPasExceptOnScope)
  10037. or (C=TPasForLoopScope) then
  10038. // ok
  10039. else
  10040. RaiseInvalidScopeForElement(20181210173134,El);
  10041. end;
  10042. // Note: El.ProcType is nil ! It is parsed later.
  10043. HasDot:=Pos('.',ProcName)>1;
  10044. IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
  10045. or (El.ClassType=TPasClassDestructor);
  10046. if (not HasDot) and IsClassConDestructor then
  10047. begin
  10048. if ProcName='' then
  10049. RaiseNotYetImplemented(20181231145302,El);
  10050. if not (LocalScope is TPasClassOrRecordScope) then
  10051. RaiseInvalidScopeForElement(20181231143831,El);
  10052. ClassOrRecScope:=TPasClassOrRecordScope(LocalScope);
  10053. if El.ClassType=TPasClassConstructor then
  10054. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  10055. else
  10056. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  10057. end;
  10058. if (not HasDot) and (ProcName<>'')
  10059. and not IsClassConDestructor // the name of a class con/destructor is irrelevant
  10060. then
  10061. begin
  10062. // add proc name to scope
  10063. AddIdentifier(TPasIdentifierScope(CurScope),ProcName,El,pikProc);
  10064. end;
  10065. ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
  10066. ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
  10067. if HasDot then
  10068. begin
  10069. // method implementation -> search class
  10070. {$IFDEF VerbosePasResolver}
  10071. writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
  10072. {$ENDIF}
  10073. ClassOrRecType:=nil;
  10074. repeat
  10075. p:=Pos('.',ProcName);
  10076. if p<1 then
  10077. begin
  10078. if ClassOrRecType=nil then
  10079. RaiseInternalError(20161013170829);
  10080. break;
  10081. end;
  10082. aClassName:=LeftStr(ProcName,p-1);
  10083. Delete(ProcName,1,p);
  10084. {$IFDEF VerbosePasResolver}
  10085. writeln('TPasResolver.AddProcedure searching class "',aClassName,'" ProcName="',ProcName,'" ...');
  10086. {$ENDIF}
  10087. if not IsValidIdent(aClassName) then
  10088. RaiseNotYetImplemented(20161013170844,El);
  10089. if ClassOrRecType<>nil then
  10090. begin
  10091. ClassOrRecScope:=TPasClassOrRecordScope(ClassOrRecType.CustomData);
  10092. Identifier:=ClassOrRecScope.FindLocalIdentifier(aClassName);
  10093. if Identifier=nil then
  10094. RaiseIdentifierNotFound(20180430130635,aClassName,El)
  10095. else
  10096. CurEl:=Identifier.Element;
  10097. end
  10098. else
  10099. CurEl:=FindElementWithoutParams(aClassName,El,false);
  10100. if not (CurEl is TPasMembersType) then
  10101. begin
  10102. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  10103. {$IFDEF VerbosePasResolver}
  10104. writeln('TPasResolver.AddProcedure searching class "',aClassName,'" ProcName="',ProcName,'" found: '+GetObjName(CurEl));
  10105. {$ENDIF}
  10106. RaiseXExpectedButYFound(20170216152557,
  10107. 'class',aClassname+':'+GetElementTypeName(CurEl),El);
  10108. end;
  10109. ClassOrRecType:=TPasMembersType(CurEl);
  10110. if ClassOrRecType is TPasClassType then
  10111. begin
  10112. if not (TPasClassType(ClassOrRecType).ObjKind in
  10113. ([okClass]+okAllHelpers)) then
  10114. begin
  10115. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  10116. RaiseXExpectedButYFound(20180321161722,
  10117. 'class',aClassname+':'+GetElementTypeName(CurEl),El);
  10118. end
  10119. end;
  10120. if ClassOrRecType.GetModule<>El.GetModule then
  10121. begin
  10122. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  10123. RaiseMsg(20180211230432,nMethodClassXInOtherUnitY,sMethodClassXInOtherUnitY,
  10124. [aClassName,ClassOrRecType.GetModule.Name],El);
  10125. end;
  10126. until false;
  10127. if not IsValidIdent(ProcName) then
  10128. RaiseNotYetImplemented(20161013170956,El);
  10129. ProcScope.VisibilityContext:=ClassOrRecType;
  10130. ProcScope.ClassRecScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
  10131. ProcScope.GroupScope:=CreateGroupScope(ClassOrRecType);
  10132. while ClassOrRecType.Parent is TPasMembersType do
  10133. begin
  10134. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  10135. GroupScope_AddTypeAndAncestors(ProcScope.GroupScope,ClassOrRecType);
  10136. end;
  10137. end;// HasDot=true
  10138. end;
  10139. procedure TPasResolver.AddArgument(El: TPasArgument);
  10140. var
  10141. ProcType: TPasProcedureType;
  10142. i: Integer;
  10143. Arg: TPasArgument;
  10144. CurScope: TPasScope;
  10145. begin
  10146. if (El.Name='') then
  10147. RaiseInternalError(20160922163526,GetObjName(El));
  10148. {$IFDEF VerbosePasResolver}
  10149. writeln('TPasResolver.AddArgument ',GetObjName(El));
  10150. {$ENDIF}
  10151. CurScope:=TopScope;
  10152. if (CurScope=nil) then
  10153. RaiseInvalidScopeForElement(20160922163529,El);
  10154. if El.Parent.ClassType=TPasProperty then
  10155. begin
  10156. if CurScope.ClassType<>TPasPropertyScope then
  10157. RaiseInvalidScopeForElement(20161014124530,El);
  10158. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  10159. end
  10160. else if El.Parent is TPasProcedureType then
  10161. begin
  10162. ProcType:=TPasProcedureType(El.Parent);
  10163. if ProcType.Parent is TPasProcedure then
  10164. begin
  10165. if CurScope.ClassType<>FScopeClass_Proc then
  10166. RaiseInvalidScopeForElement(20160922163529,El,GetObjName(TopScope));
  10167. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  10168. end
  10169. else
  10170. begin
  10171. for i:=0 to ProcType.Args.Count-1 do
  10172. begin
  10173. Arg:=TPasArgument(ProcType.Args[i]);
  10174. if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
  10175. RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
  10176. end;
  10177. end;
  10178. end
  10179. else
  10180. RaiseNotYetImplemented(20161014124937,El);
  10181. end;
  10182. procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
  10183. var
  10184. CurScope: TPasScope;
  10185. begin
  10186. CurScope:=TopScope;
  10187. if CurScope.ClassType<>FScopeClass_Proc then exit;
  10188. if El.Parent is TPasProcedureType then
  10189. begin
  10190. if not (El.Parent.Parent is TPasProcedure) then
  10191. exit;
  10192. end
  10193. else if not (El.Parent is TPasProcedure) then
  10194. exit;
  10195. AddIdentifier(TPasProcedureScope(CurScope),ResolverResultVar,El,pikSimple);
  10196. end;
  10197. procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
  10198. begin
  10199. PushScope(El,TPasExceptOnScope);
  10200. end;
  10201. procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
  10202. begin
  10203. if TPasWithScope.FreeOnPop then
  10204. RaiseInternalError(20181210162344);
  10205. PushScope(El,TPasWithScope);
  10206. end;
  10207. procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
  10208. begin
  10209. if El=nil then ;
  10210. CheckTopScope(FScopeClass_Proc);
  10211. end;
  10212. procedure TPasResolver.WriteScopes;
  10213. {AllowWriteln}
  10214. var
  10215. i: Integer;
  10216. Scope: TPasScope;
  10217. begin
  10218. writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
  10219. for i:=ScopeCount-1 downto 0 do
  10220. begin
  10221. Scope:=Scopes[i];
  10222. writeln(' ',i,'/',ScopeCount,' ',GetObjName(Scope));
  10223. Scope.WriteIdentifiers(' ');
  10224. end;
  10225. {AllowWriteln-}
  10226. end;
  10227. procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
  10228. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  10229. StartEl: TPasElement);
  10230. var
  10231. LeftResolved, RightResolved: TPasResolverResult;
  10232. begin
  10233. if (Bin.OpCode=eopSubIdent)
  10234. or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
  10235. begin
  10236. // Note: bin.left was already resolved via ResolveSubIdent
  10237. ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
  10238. exit;
  10239. end;
  10240. if Bin.OpCode in [eopEqual,eopNotEqual] then
  10241. begin
  10242. if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
  10243. rcSetReferenceFlags in Flags)=cIncompatible then
  10244. RaiseInternalError(20161007215912);
  10245. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  10246. Bin,[rrfReadable]);
  10247. exit;
  10248. end;
  10249. ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
  10250. ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
  10251. // ToDo: check operator overloading
  10252. ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
  10253. end;
  10254. procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
  10255. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  10256. var LeftResolved, RightResolved: TPasResolverResult);
  10257. procedure SetBaseType(BaseType: TResolverBaseType);
  10258. begin
  10259. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  10260. Bin,[rrfReadable]);
  10261. end;
  10262. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  10263. begin
  10264. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  10265. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,Flags);
  10266. end;
  10267. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  10268. begin
  10269. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  10270. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,Flags);
  10271. end;
  10272. var
  10273. ElTypeResolved: TPasResolverResult;
  10274. LeftTypeEl, RightTypeEl: TPasType;
  10275. begin
  10276. if LeftResolved.BaseType=btRange then
  10277. ConvertRangeToElement(LeftResolved);
  10278. if RightResolved.BaseType=btRange then
  10279. ConvertRangeToElement(RightResolved);
  10280. //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  10281. if LeftResolved.BaseType in btAllInteger then
  10282. begin
  10283. if (rrfReadable in LeftResolved.Flags)
  10284. and (rrfReadable in RightResolved.Flags) then
  10285. begin
  10286. if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  10287. case Bin.OpCode of
  10288. eopNone:
  10289. if (Bin.Kind=pekRange) then
  10290. begin
  10291. if not (RightResolved.BaseType in btAllInteger) then
  10292. RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
  10293. // use left type for result
  10294. SetLeftValueExpr([rrfReadable]);
  10295. if Bin.Parent is TPasRangeType then
  10296. begin
  10297. ResolvedEl.LoTypeEl:=TPasRangeType(Bin.Parent);
  10298. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  10299. end;
  10300. exit;
  10301. end;
  10302. eopAdd, eopSubtract,
  10303. eopMultiply, eopDiv, eopMod,
  10304. eopPower,
  10305. eopShl, eopShr,
  10306. eopAnd, eopOr, eopXor:
  10307. begin
  10308. if RightResolved.BaseType in btAllFloats then
  10309. // use right type for result
  10310. SetRightValueExpr([rrfReadable])
  10311. else
  10312. // use left type for result
  10313. SetLeftValueExpr([rrfReadable]);
  10314. exit;
  10315. end;
  10316. eopLessThan,
  10317. eopGreaterThan,
  10318. eopLessthanEqual,
  10319. eopGreaterThanEqual:
  10320. begin
  10321. SetBaseType(btBoolean);
  10322. exit;
  10323. end;
  10324. eopDivide:
  10325. begin
  10326. SetBaseType(BaseTypeExtended);
  10327. exit;
  10328. end;
  10329. end
  10330. else if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  10331. begin
  10332. if (Bin.OpCode=eopIn) and (RightResolved.SubType in btAllInteger) then
  10333. begin
  10334. SetBaseType(btBoolean);
  10335. exit;
  10336. end;
  10337. end
  10338. else if RightResolved.BaseType=btPointer then
  10339. begin
  10340. if (Bin.OpCode in [eopAdd,eopSubtract])
  10341. and ElHasBoolSwitch(Bin,bsPointerMath) then
  10342. begin
  10343. // integer+CanonicalPointer
  10344. SetResolverValueExpr(ResolvedEl,btPointer,
  10345. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,[rrfReadable]);
  10346. exit;
  10347. end;
  10348. end
  10349. else if RightResolved.BaseType=btContext then
  10350. begin
  10351. RightTypeEl:=RightResolved.LoTypeEl;
  10352. if RightTypeEl.ClassType=TPasPointerType then
  10353. begin
  10354. if (Bin.OpCode in [eopAdd,eopSubtract])
  10355. and ElHasBoolSwitch(Bin,bsPointerMath) then
  10356. begin
  10357. // integer+TypedPointer
  10358. RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
  10359. SetResolverValueExpr(ResolvedEl,btPointer,
  10360. ResolveAliasType(RightTypeEl),RightTypeEl,Bin,[rrfReadable]);
  10361. exit;
  10362. end;
  10363. end;
  10364. end;
  10365. end;
  10366. end
  10367. else if LeftResolved.BaseType in btAllBooleans then
  10368. begin
  10369. if (rrfReadable in LeftResolved.Flags)
  10370. and (RightResolved.BaseType in btAllBooleans)
  10371. and (rrfReadable in RightResolved.Flags) then
  10372. case Bin.OpCode of
  10373. eopNone:
  10374. if Bin.Kind=pekRange then
  10375. begin
  10376. SetResolverValueExpr(ResolvedEl,btRange,
  10377. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  10378. Bin,[rrfReadable]);
  10379. ResolvedEl.SubType:=LeftResolved.BaseType;
  10380. exit;
  10381. end;
  10382. eopAnd, eopOr, eopXor:
  10383. begin
  10384. // use left type for result
  10385. SetLeftValueExpr([rrfReadable]);
  10386. exit;
  10387. end;
  10388. end;
  10389. end
  10390. else if LeftResolved.BaseType in btAllStringAndChars then
  10391. begin
  10392. if (rrfReadable in LeftResolved.Flags)
  10393. and (rrfReadable in RightResolved.Flags) then
  10394. begin
  10395. if (RightResolved.BaseType in btAllStringAndChars) then
  10396. case Bin.OpCode of
  10397. eopNone:
  10398. if (Bin.Kind=pekRange) and (LeftResolved.BaseType in btAllChars) then
  10399. begin
  10400. if not (RightResolved.BaseType in btAllChars) then
  10401. RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
  10402. SetResolverValueExpr(ResolvedEl,btRange,
  10403. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  10404. Bin,[rrfReadable]);
  10405. ResolvedEl.SubType:=LeftResolved.BaseType;
  10406. exit;
  10407. end;
  10408. eopAdd:
  10409. if RightResolved.BaseType in btAllStringAndChars then
  10410. if ComputeAddStringRes(LeftResolved,RightResolved,Bin,ResolvedEl) then
  10411. exit;
  10412. eopLessThan,
  10413. eopGreaterThan,
  10414. eopLessthanEqual,
  10415. eopGreaterThanEqual:
  10416. begin
  10417. SetBaseType(btBoolean);
  10418. exit;
  10419. end;
  10420. end
  10421. else if (RightResolved.BaseType in [btSet,btArrayOrSet])
  10422. and (RightResolved.SubType in btAllChars)
  10423. and (LeftResolved.BaseType in btAllChars) then
  10424. begin
  10425. case Bin.OpCode of
  10426. eopIn:
  10427. begin
  10428. SetBaseType(btBoolean);
  10429. exit;
  10430. end;
  10431. end;
  10432. end
  10433. end
  10434. end
  10435. else if LeftResolved.BaseType in btAllFloats then
  10436. begin
  10437. if (rrfReadable in LeftResolved.Flags)
  10438. and (RightResolved.BaseType in (btAllInteger+btAllFloats))
  10439. and (rrfReadable in RightResolved.Flags) then
  10440. case Bin.OpCode of
  10441. eopAdd, eopSubtract,
  10442. eopMultiply, eopDivide, eopMod,
  10443. eopPower:
  10444. begin
  10445. if (RightResolved.BaseType=btCurrency)
  10446. or ((RightResolved.BaseType in btAllFloats)
  10447. and (RightResolved.BaseType>LeftResolved.BaseType)) then
  10448. // use right side as result
  10449. SetRightValueExpr([rrfReadable])
  10450. else
  10451. // use left side as result
  10452. SetLeftValueExpr([rrfReadable]);
  10453. exit;
  10454. end;
  10455. eopLessThan,
  10456. eopGreaterThan,
  10457. eopLessthanEqual,
  10458. eopGreaterThanEqual:
  10459. begin
  10460. SetBaseType(btBoolean);
  10461. exit;
  10462. end;
  10463. end;
  10464. end
  10465. else if LeftResolved.BaseType=btPointer then
  10466. begin
  10467. if (rrfReadable in LeftResolved.Flags)
  10468. and (rrfReadable in RightResolved.Flags) then
  10469. begin
  10470. if (RightResolved.BaseType in btAllInteger) then
  10471. case Bin.OpCode of
  10472. eopAdd,eopSubtract:
  10473. if ElHasBoolSwitch(Bin,bsPointerMath) then
  10474. begin
  10475. // pointer+integer -> pointer
  10476. SetResolverValueExpr(ResolvedEl,btPointer,
  10477. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,[rrfReadable]);
  10478. exit;
  10479. end;
  10480. end
  10481. else if RightResolved.BaseType=btPointer then
  10482. case Bin.OpCode of
  10483. eopLessThan,
  10484. eopGreaterThan,
  10485. eopLessthanEqual,
  10486. eopGreaterThanEqual:
  10487. begin
  10488. SetBaseType(btBoolean);
  10489. exit;
  10490. end;
  10491. end;
  10492. end;
  10493. end
  10494. else if LeftResolved.BaseType=btContext then
  10495. begin
  10496. LeftTypeEl:=LeftResolved.LoTypeEl;
  10497. case Bin.OpCode of
  10498. eopNone:
  10499. if Bin.Kind=pekRange then
  10500. begin
  10501. if (rrfReadable in LeftResolved.Flags)
  10502. and (rrfReadable in RightResolved.Flags) then
  10503. begin
  10504. CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
  10505. ResolvedEl:=LeftResolved;
  10506. ResolvedEl.IdentEl:=nil;
  10507. ResolvedEl.SubType:=ResolvedEl.BaseType;
  10508. ResolvedEl.BaseType:=btRange;
  10509. ResolvedEl.ExprEl:=Bin;
  10510. exit;
  10511. end;
  10512. end;
  10513. eopIn:
  10514. if (rrfReadable in LeftResolved.Flags)
  10515. and (rrfReadable in RightResolved.Flags) then
  10516. begin
  10517. if LeftResolved.BaseType in btArrayRangeTypes then
  10518. begin
  10519. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  10520. RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  10521. if LeftResolved.BaseType in btAllBooleans then
  10522. begin
  10523. if not (RightResolved.SubType in btAllBooleans) then
  10524. RaiseXExpectedButYFound(20170216152610,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  10525. end
  10526. else if LeftResolved.BaseType in btAllChars then
  10527. begin
  10528. if not (RightResolved.SubType in btAllChars) then
  10529. RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  10530. end
  10531. else if not (RightResolved.SubType in btAllInteger) then
  10532. RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  10533. SetBaseType(btBoolean);
  10534. exit;
  10535. end
  10536. else if (LeftResolved.BaseType=btContext)
  10537. and (LeftTypeEl.ClassType=TPasEnumType) then
  10538. begin
  10539. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  10540. RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.LoTypeEl.Name,GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  10541. RightTypeEl:=RightResolved.LoTypeEl;
  10542. if LeftTypeEl=RightTypeEl then
  10543. // enum in setofenum
  10544. else if RightResolved.LoTypeEl.ClassType=TPasRangeType then
  10545. begin
  10546. ComputeElement(TPasRangeType(RightTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
  10547. if LeftTypeEl<>ElTypeResolved.LoTypeEl then
  10548. RaiseXExpectedButYFound(20171109215833,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  10549. end
  10550. else
  10551. RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  10552. SetBaseType(btBoolean);
  10553. exit;
  10554. end
  10555. else
  10556. RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
  10557. sInOperatorExpectsSetElementButGot,[GetElementTypeName(LeftResolved.LoTypeEl)],Bin);
  10558. end;
  10559. eopIs:
  10560. begin
  10561. RightTypeEl:=RightResolved.LoTypeEl;
  10562. if (LeftTypeEl is TPasClassType) then
  10563. begin
  10564. if not (rrfReadable in LeftResolved.Flags) then
  10565. RaiseIncompatibleTypeRes(20180204124637,nOperatorIsNotOverloadedAOpB,
  10566. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  10567. if (LeftResolved.IdentEl is TPasType) then
  10568. RaiseIncompatibleTypeRes(20180204124638,nOperatorIsNotOverloadedAOpB,
  10569. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  10570. // left side is a class instance
  10571. if (RightResolved.IdentEl is TPasType)
  10572. and (RightTypeEl is TPasClassType) then
  10573. begin
  10574. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  10575. begin
  10576. if CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible then
  10577. begin
  10578. // e.g. if obj is TFPMemoryImage then ;
  10579. // Note: at compile time the check is reversed: right must inherit from left
  10580. SetBaseType(btBoolean);
  10581. exit;
  10582. end
  10583. else if CheckSrcIsADstType(LeftResolved,RightResolved)<>cIncompatible then
  10584. begin
  10585. // e.g. if Image is TObject then ;
  10586. // This is useful after some unchecked typecast -> allow
  10587. SetBaseType(btBoolean);
  10588. exit;
  10589. end;
  10590. end
  10591. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  10592. begin
  10593. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  10594. and (not TPasClassType(LeftTypeEl).IsExternal) then
  10595. begin
  10596. // e.g. if classintvar is intftype then ;
  10597. SetBaseType(btBoolean);
  10598. exit;
  10599. end;
  10600. end
  10601. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  10602. begin
  10603. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  10604. and (not TPasClassType(RightTypeEl).IsExternal) then
  10605. begin
  10606. // e.g. if intfvar is classtype then ;
  10607. SetBaseType(btBoolean);
  10608. exit;
  10609. end;
  10610. end;
  10611. {$IFDEF VerbosePasResolver}
  10612. writeln('TPasResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)));
  10613. writeln('TPasResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
  10614. {$ENDIF}
  10615. end
  10616. else if (RightTypeEl is TPasClassOfType)
  10617. and (rrfReadable in RightResolved.Flags) then
  10618. begin
  10619. // e.g. if Image is ImageClass then ;
  10620. if (CheckClassesAreRelated(LeftResolved.LoTypeEl,
  10621. TPasClassOfType(RightTypeEl).DestType)<>cIncompatible) then
  10622. begin
  10623. SetBaseType(btBoolean);
  10624. exit;
  10625. end;
  10626. end
  10627. else
  10628. RaiseXExpectedButYFound(20170216152625,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  10629. end
  10630. else if (proClassOfIs in Options) and (LeftTypeEl is TPasClassOfType)
  10631. and (rrfReadable in LeftResolved.Flags) then
  10632. begin
  10633. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  10634. RaiseIncompatibleTypeRes(20180204124657,nOperatorIsNotOverloadedAOpB,
  10635. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  10636. // left side is class-of variable
  10637. LeftTypeEl:=ResolveAliasType(TPasClassOfType(LeftTypeEl).DestType);
  10638. if (RightResolved.IdentEl is TPasType)
  10639. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  10640. begin
  10641. // e.g. if ImageClass is TFPMemoryImage then ;
  10642. // Note: at compile time the check is reversed: right must inherit from left
  10643. if CheckClassIsClass(RightResolved.LoTypeEl,LeftTypeEl)<>cIncompatible then
  10644. begin
  10645. SetBaseType(btBoolean);
  10646. exit;
  10647. end
  10648. end
  10649. else if (RightTypeEl is TPasClassOfType) then
  10650. begin
  10651. // e.g. if ImageClassA is ImageClassB then ;
  10652. // or if ImageClassA is TFPImageClass then ;
  10653. RightTypeEl:=ResolveAliasType(TPasClassOfType(RightTypeEl).DestType);
  10654. if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl)<>cIncompatible) then
  10655. begin
  10656. SetBaseType(btBoolean);
  10657. exit;
  10658. end
  10659. end
  10660. else
  10661. RaiseXExpectedButYFound(20170322105252,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  10662. end
  10663. else if LeftResolved.LoTypeEl=nil then
  10664. RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  10665. [BaseTypeNames[LeftResolved.BaseType]],Bin.left)
  10666. else
  10667. RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  10668. [GetElementTypeName(LeftResolved.LoTypeEl)],Bin.left);
  10669. {$IFDEF VerbosePasResolver}
  10670. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  10671. {$ENDIF}
  10672. RaiseIncompatibleTypeRes(20170216152236,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  10673. end;
  10674. eopAs:
  10675. begin
  10676. if (LeftTypeEl.ClassType=TPasClassType) then
  10677. begin
  10678. if (LeftResolved.IdentEl is TPasType)
  10679. or (not (rrfReadable in LeftResolved.Flags)) then
  10680. RaiseIncompatibleTypeRes(20180204124711,nOperatorIsNotOverloadedAOpB,
  10681. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  10682. if RightResolved.IdentEl=nil then
  10683. RaiseXExpectedButYFound(20170216152630,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  10684. if not (RightResolved.IdentEl is TPasType) then
  10685. RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
  10686. if not (RightResolved.BaseType=btContext) then
  10687. RaiseXExpectedButYFound(20180426195816,'class',RightResolved.IdentEl.Name,Bin.right);
  10688. RightTypeEl:=RightResolved.LoTypeEl;
  10689. if RightTypeEl is TPasClassType then
  10690. begin
  10691. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  10692. begin
  10693. // e.g. classinst as classtype
  10694. if (CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible) then
  10695. begin
  10696. SetRightValueExpr([rrfReadable]);
  10697. exit;
  10698. end;
  10699. end
  10700. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  10701. begin
  10702. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  10703. and (not TPasClassType(RightTypeEl).IsExternal) then
  10704. begin
  10705. // e.g. intfvar as classtype
  10706. SetRightValueExpr([rrfReadable]);
  10707. exit;
  10708. end;
  10709. end
  10710. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  10711. begin
  10712. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  10713. and (not TPasClassType(LeftTypeEl).IsExternal) then
  10714. begin
  10715. // e.g. classinst as intftype
  10716. SetRightValueExpr([rrfReadable]);
  10717. exit;
  10718. end;
  10719. end;
  10720. end;
  10721. RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  10722. end;
  10723. end;
  10724. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  10725. if (rrfReadable in LeftResolved.Flags)
  10726. and (rrfReadable in RightResolved.Flags) then
  10727. begin
  10728. RightTypeEl:=RightResolved.LoTypeEl;
  10729. if (LeftTypeEl.ClassType=TPasEnumType) and (LeftTypeEl=RightTypeEl) then
  10730. begin
  10731. SetBaseType(btBoolean);
  10732. exit;
  10733. end
  10734. else if (LeftTypeEl.ClassType=TPasPointerType)
  10735. and (RightResolved.BaseType in btAllInteger) then
  10736. begin
  10737. SetBaseType(btBoolean);
  10738. exit;
  10739. end;
  10740. end;
  10741. eopSubIdent:
  10742. begin
  10743. ResolvedEl:=RightResolved;
  10744. exit;
  10745. end;
  10746. eopAdd,eopSubtract:
  10747. if (rrfReadable in LeftResolved.Flags)
  10748. and (rrfReadable in RightResolved.Flags) then
  10749. begin
  10750. if (LeftTypeEl.ClassType=TPasArrayType) then
  10751. begin
  10752. if IsDynArray(LeftTypeEl)
  10753. and (Bin.OpCode=eopAdd)
  10754. and ElHasModeSwitch(Bin,msArrayOperators)
  10755. and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
  10756. or IsDynArray(RightResolved.LoTypeEl)) then
  10757. begin
  10758. // dynarr+[...]
  10759. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,Bin,true);
  10760. SetLeftValueExpr([rrfReadable]);
  10761. exit;
  10762. end;
  10763. end
  10764. else if LeftTypeEl.ClassType=TPasPointerType then
  10765. begin
  10766. if (RightResolved.BaseType in btAllInteger)
  10767. and ElHasBoolSwitch(Bin,bsPointerMath) then
  10768. begin
  10769. // TypedPointer+Integer
  10770. SetLeftValueExpr([rrfReadable]);
  10771. exit;
  10772. end;
  10773. end;
  10774. end;
  10775. end;
  10776. end
  10777. else if LeftResolved.BaseType in [btSet,btArrayOrSet] then
  10778. begin
  10779. if (rrfReadable in LeftResolved.Flags)
  10780. and (rrfReadable in RightResolved.Flags) then
  10781. begin
  10782. if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  10783. case Bin.OpCode of
  10784. eopAdd,
  10785. eopSubtract,
  10786. eopMultiply,
  10787. eopSymmetricaldifference,
  10788. eopLessthanEqual,
  10789. eopGreaterThanEqual:
  10790. begin
  10791. if RightResolved.LoTypeEl=nil then
  10792. begin
  10793. // right is empty set/array
  10794. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  10795. SetBaseType(btBoolean)
  10796. else
  10797. begin
  10798. ResolvedEl:=LeftResolved;
  10799. ResolvedEl.IdentEl:=nil;
  10800. ResolvedEl.ExprEl:=Bin;
  10801. end;
  10802. exit;
  10803. end
  10804. else if LeftResolved.LoTypeEl=nil then
  10805. begin
  10806. // left is empty set/array
  10807. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  10808. SetBaseType(btBoolean)
  10809. else
  10810. begin
  10811. ResolvedEl:=RightResolved;
  10812. ResolvedEl.IdentEl:=nil;
  10813. ResolvedEl.ExprEl:=Bin;
  10814. end;
  10815. exit;
  10816. end
  10817. else if (LeftResolved.SubType=RightResolved.SubType)
  10818. or ((LeftResolved.SubType in btAllBooleans)
  10819. and (RightResolved.SubType in btAllBooleans))
  10820. or ((LeftResolved.SubType in btAllInteger)
  10821. and (RightResolved.SubType in btAllInteger)) then
  10822. begin
  10823. // compatible set
  10824. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  10825. SetBaseType(btBoolean)
  10826. else
  10827. begin
  10828. ResolvedEl:=LeftResolved;
  10829. ResolvedEl.IdentEl:=nil;
  10830. ResolvedEl.ExprEl:=Bin;
  10831. end;
  10832. exit;
  10833. end;
  10834. {$IFDEF VerbosePasResolver}
  10835. writeln('TPasResolver.ComputeBinaryExprRes + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
  10836. +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
  10837. {$ENDIF}
  10838. end;
  10839. end
  10840. else if RightResolved.BaseType=btContext then
  10841. begin
  10842. RightTypeEl:=RightResolved.LoTypeEl;
  10843. if RightTypeEl.ClassType=TPasArrayType then
  10844. begin
  10845. if IsDynArray(RightTypeEl) then
  10846. begin
  10847. // [...]+dynarr
  10848. CheckAssignCompatibilityArrayType(RightResolved,LeftResolved,Bin,true);
  10849. SetRightValueExpr([rrfReadable]);
  10850. exit;
  10851. end;
  10852. end;
  10853. end;
  10854. end;
  10855. end
  10856. else if LeftResolved.BaseType=btArrayLit then
  10857. begin
  10858. if (rrfReadable in LeftResolved.Flags)
  10859. and (rrfReadable in RightResolved.Flags)
  10860. and (Bin.OpCode=eopAdd)
  10861. and ElHasModeSwitch(Bin,msArrayOperators) then
  10862. begin
  10863. if RightResolved.BaseType=btArrayLit then
  10864. begin
  10865. if LeftResolved.LoTypeEl<>nil then
  10866. ResolvedEl:=LeftResolved
  10867. else
  10868. ResolvedEl:=RightResolved;
  10869. ResolvedEl.IdentEl:=nil;
  10870. ResolvedEl.ExprEl:=Bin;
  10871. exit;
  10872. end
  10873. else if (RightResolved.BaseType=btContext)
  10874. and (RightResolved.LoTypeEl.ClassType=TPasArrayType) then
  10875. begin
  10876. ResolvedEl:=RightResolved;
  10877. ResolvedEl.IdentEl:=nil;
  10878. ResolvedEl.ExprEl:=Bin;
  10879. exit;
  10880. end;
  10881. end;
  10882. end
  10883. else if LeftResolved.BaseType=btModule then
  10884. begin
  10885. if Bin.OpCode=eopSubIdent then
  10886. begin
  10887. ResolvedEl:=RightResolved;
  10888. exit;
  10889. end;
  10890. end;
  10891. {$IFDEF VerbosePasResolver}
  10892. writeln('TPasResolver.ComputeBinaryExprRes OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  10893. {$ENDIF}
  10894. RaiseIncompatibleTypeRes(20180204114631,nOperatorIsNotOverloadedAOpB,
  10895. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  10896. if Flags=[] then ;
  10897. end;
  10898. function TPasResolver.ComputeAddStringRes(const LeftResolved,
  10899. RightResolved: TPasResolverResult; ExprEl: TPasExpr; out
  10900. ResolvedEl: TPasResolverResult): boolean;
  10901. procedure SetBaseType(BaseType: TResolverBaseType);
  10902. begin
  10903. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  10904. ExprEl,[rrfReadable]);
  10905. end;
  10906. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  10907. begin
  10908. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  10909. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,ExprEl,Flags);
  10910. end;
  10911. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  10912. begin
  10913. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  10914. RightResolved.LoTypeEl,RightResolved.HiTypeEl,ExprEl,Flags);
  10915. end;
  10916. begin
  10917. Result:=true;
  10918. case LeftResolved.BaseType of
  10919. btChar:
  10920. begin
  10921. case RightResolved.BaseType of
  10922. btChar: SetBaseType(btString);
  10923. {$ifdef FPC_HAS_CPSTRING}
  10924. btAnsiChar:
  10925. if BaseTypeChar=btAnsiChar then
  10926. SetBaseType(btString)
  10927. else
  10928. SetBaseType(btUnicodeString);
  10929. {$endif}
  10930. btWideChar:
  10931. if BaseTypeChar=btWideChar then
  10932. SetBaseType(btString)
  10933. else
  10934. SetBaseType(btUnicodeString);
  10935. else
  10936. // use right type for result
  10937. SetRightValueExpr([rrfReadable]);
  10938. end;
  10939. exit;
  10940. end;
  10941. {$ifdef FPC_HAS_CPSTRING}
  10942. btAnsiChar:
  10943. begin
  10944. case RightResolved.BaseType of
  10945. btChar:
  10946. if BaseTypeChar=btAnsiChar then
  10947. SetBaseType(btString)
  10948. else
  10949. SetBaseType(btUnicodeString);
  10950. btAnsiChar:
  10951. if BaseTypeChar=btAnsiChar then
  10952. SetBaseType(btString)
  10953. else
  10954. SetBaseType(btAnsiString);
  10955. btWideChar:
  10956. if BaseTypeChar=btWideChar then
  10957. SetBaseType(btString)
  10958. else
  10959. SetBaseType(btUnicodeString);
  10960. else
  10961. // use right type for result
  10962. SetRightValueExpr([rrfReadable]);
  10963. end;
  10964. exit;
  10965. end;
  10966. {$endif}
  10967. btWideChar:
  10968. begin
  10969. case RightResolved.BaseType of
  10970. btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
  10971. if BaseTypeChar=btWideChar then
  10972. SetBaseType(btString)
  10973. else
  10974. SetBaseType(btUnicodeString);
  10975. else
  10976. // use right type for result
  10977. SetRightValueExpr([rrfReadable]);
  10978. end;
  10979. exit;
  10980. end;
  10981. {$ifdef FPC_HAS_CPSTRING}
  10982. btShortString:
  10983. begin
  10984. case RightResolved.BaseType of
  10985. btChar,btAnsiChar,btShortString,btWideChar:
  10986. // use left type for result
  10987. SetLeftValueExpr([rrfReadable]);
  10988. else
  10989. // shortstring + string => string
  10990. SetRightValueExpr([rrfReadable]);
  10991. end;
  10992. exit;
  10993. end;
  10994. {$endif}
  10995. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  10996. begin
  10997. // string + x => string
  10998. SetLeftValueExpr([rrfReadable]);
  10999. exit;
  11000. end;
  11001. end;
  11002. Result:=false;
  11003. end;
  11004. procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
  11005. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11006. StartEl: TPasElement);
  11007. procedure ComputeIndexProperty(Prop: TPasProperty);
  11008. begin
  11009. if [rcConstant,rcType]*Flags<>[] then
  11010. RaiseConstantExprExp(20170216152635,Params);
  11011. ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
  11012. ResolvedEl.IdentEl:=Prop;
  11013. ResolvedEl.Flags:=[];
  11014. if GetPasPropertyGetter(Prop)<>nil then
  11015. Include(ResolvedEl.Flags,rrfReadable);
  11016. if GetPasPropertySetter(Prop)<>nil then
  11017. Include(ResolvedEl.Flags,rrfWritable);
  11018. end;
  11019. procedure ComputeArrayPointer(TypeEl: TPasType);
  11020. begin
  11021. if TypeEl=nil then
  11022. RaiseInternalError(20180423092254);
  11023. ComputeElement(TypeEl,ResolvedEl,[rcType],Params);
  11024. ResolvedEl.IdentEl:=nil;
  11025. ResolvedEl.ExprEl:=Params;
  11026. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  11027. end;
  11028. var
  11029. TypeEl, ElType: TPasType;
  11030. ArrayEl: TPasArrayType;
  11031. ArgNo: Integer;
  11032. OrigResolved: TPasResolverResult;
  11033. ClassOrRecordScope: TPasClassOrRecordScope;
  11034. Ref: TResolvedReference;
  11035. begin
  11036. ComputeElement(Params.Value,ResolvedEl,
  11037. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  11038. {$IFDEF VerbosePasResolver}
  11039. writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  11040. {$ENDIF}
  11041. if ResolvedEl.BaseType in btAllStrings then
  11042. begin
  11043. // stringvar[] => char
  11044. case GetActualBaseType(ResolvedEl.BaseType) of
  11045. {$ifdef FPC_HAS_CPSTRING}
  11046. btAnsiString,btRawByteString,btShortString:
  11047. if BaseTypeChar=btAnsiChar then
  11048. ResolvedEl.BaseType:=btChar
  11049. else
  11050. ResolvedEl.BaseType:=btAnsiChar;
  11051. {$endif}
  11052. btWideString,btUnicodeString:
  11053. if BaseTypeChar=btWideChar then
  11054. ResolvedEl.BaseType:=btChar
  11055. else
  11056. ResolvedEl.BaseType:=btWideChar;
  11057. else
  11058. RaiseNotYetImplemented(20170417202354,Params);
  11059. end;
  11060. // keep ResolvedEl.IdentEl the string var
  11061. ResolvedEl.LoTypeEl:=FBaseTypes[ResolvedEl.BaseType];
  11062. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  11063. ResolvedEl.ExprEl:=Params;
  11064. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
  11065. end
  11066. else if ResolvedEl.BaseType=btPointer then
  11067. // (@something)[]
  11068. ComputeArrayPointer(ResolvedEl.LoTypeEl)
  11069. else if (ResolvedEl.IdentEl is TPasProperty)
  11070. and (GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then
  11071. // property with args
  11072. ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
  11073. else if ResolvedEl.BaseType=btContext then
  11074. begin
  11075. TypeEl:=ResolvedEl.LoTypeEl;
  11076. if (TypeEl.ClassType=TPasClassType)
  11077. or (TypeEl.ClassType=TPasRecordType)
  11078. or (TypeEl.ClassType=TPasClassOfType) then
  11079. begin
  11080. if not (Params.CustomData is TResolvedReference) then
  11081. RaiseNotYetImplemented(20190125143203,Params,GetObjName(Params.CustomData));
  11082. Ref:=TResolvedReference(Params.CustomData);
  11083. if Ref.Declaration is TPasProperty then
  11084. ComputeIndexProperty(TPasProperty(Ref.Declaration))
  11085. else if TypeEl is TPasMembersType then
  11086. begin
  11087. ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
  11088. ComputeArrayParams_Class(Params,ResolvedEl,ClassOrRecordScope,Flags,StartEl);
  11089. end
  11090. else
  11091. RaiseNotYetImplemented(20161010174916,Params);
  11092. end
  11093. else if TypeEl.ClassType=TPasArrayType then
  11094. begin
  11095. if not (rrfReadable in ResolvedEl.Flags) then
  11096. RaiseMsg(20170517001140,nIllegalQualifierAfter,sIllegalQualifierAfter,
  11097. ['[',TypeEl.ElementTypeName],Params);
  11098. ArrayEl:=TPasArrayType(TypeEl);
  11099. ArgNo:=0;
  11100. repeat
  11101. if length(ArrayEl.Ranges)=0 then
  11102. begin
  11103. inc(ArgNo); // dynamic/open array has one dimension
  11104. if IsDynArray(ArrayEl) then
  11105. Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
  11106. end
  11107. else
  11108. inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
  11109. if ArgNo>length(Params.Params) then
  11110. RaiseInternalError(20161010185535);
  11111. if ArgNo=length(Params.Params) then
  11112. break;
  11113. // continue in sub array
  11114. ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
  11115. until false;
  11116. OrigResolved:=ResolvedEl;
  11117. ElType:=GetArrayElType(ArrayEl);
  11118. ComputeElement(ElType,ResolvedEl,Flags,StartEl);
  11119. // identifier and value is the array itself
  11120. ResolvedEl.IdentEl:=OrigResolved.IdentEl;
  11121. ResolvedEl.ExprEl:=OrigResolved.ExprEl;
  11122. ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
  11123. if IsDynArray(ArrayEl) then
  11124. // dyn array elements are writable independent of the array
  11125. Include(ResolvedEl.Flags,rrfWritable);
  11126. end
  11127. else if TypeEl.ClassType=TPasPointerType then
  11128. ComputeArrayPointer(TPasPointerType(TypeEl).DestType)
  11129. else
  11130. RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
  11131. end
  11132. else
  11133. RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
  11134. end;
  11135. procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
  11136. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  11137. Flags: TPasResolverComputeFlags; StartEl: TPasElement);
  11138. begin
  11139. RaiseNotYetImplemented(20190125142240,Params);
  11140. if Params=nil then ;
  11141. if ClassOrRecScope=nil then ;
  11142. if Flags=[] then ;
  11143. if StartEl=nil then ;
  11144. SetResolverIdentifier(ResolvedEl,btNone,nil,nil,nil,[]);
  11145. end;
  11146. procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
  11147. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11148. StartEl: TPasElement);
  11149. var
  11150. DeclEl: TPasElement;
  11151. BuiltInProc: TResElDataBuiltInProc;
  11152. Proc: TPasProcedure;
  11153. ParamResolved: TPasResolverResult;
  11154. Ref: TResolvedReference;
  11155. DeclType: TPasType;
  11156. Param0: TPasExpr;
  11157. begin
  11158. Ref:=GetParamsValueRef(Params);
  11159. if Ref=nil then
  11160. RaiseNotYetImplemented(20160928174124,Params);
  11161. DeclEl:=Ref.Declaration;
  11162. if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  11163. begin
  11164. if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
  11165. begin
  11166. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  11167. if Assigned(BuiltInProc.GetCallResult) then
  11168. // built-in function
  11169. BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
  11170. else
  11171. // built-in procedure
  11172. SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,
  11173. BuiltInProc.Proc,BuiltInProc.Proc,[]);
  11174. if bipfCanBeStatement in BuiltInProc.Flags then
  11175. Include(ResolvedEl.Flags,rrfCanBeStatement);
  11176. end
  11177. else if DeclEl.CustomData is TResElDataBaseType then
  11178. begin
  11179. // type cast to base type
  11180. DeclType:=TPasUnresolvedSymbolRef(DeclEl);
  11181. if length(Params.Params)<>1 then
  11182. begin
  11183. {$IFDEF VerbosePasResolver}
  11184. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl));
  11185. {$ENDIF}
  11186. RaiseMsg(20180503105409,nWrongNumberOfParametersForTypeCast,
  11187. sWrongNumberOfParametersForTypeCast,[DeclType.Name],Params);
  11188. end;
  11189. Param0:=Params.Params[0];
  11190. ComputeElement(Param0,ParamResolved,[]);
  11191. ComputeTypeCast(DeclType,DeclType,Param0,ParamResolved,ResolvedEl,Flags);
  11192. end
  11193. else
  11194. RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
  11195. end
  11196. else
  11197. begin
  11198. // normal identifier (not built-in)
  11199. ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  11200. if ResolvedEl.BaseType=btProc then
  11201. begin
  11202. if not (ResolvedEl.IdentEl is TPasProcedure) then
  11203. RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
  11204. Proc:=TPasProcedure(ResolvedEl.IdentEl);
  11205. if rcConstant in Flags then
  11206. RaiseConstantExprExp(20170216152637,Params);
  11207. if Proc.ProcType is TPasFunctionType then
  11208. // function call => return result
  11209. ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
  11210. Flags+[rcNoImplicitProc],StartEl)
  11211. else if (Proc.ClassType=TPasConstructor) then
  11212. begin
  11213. // constructor -> return value of type class
  11214. ResolvedEl:=GetReference_ConstructorType(Ref,Params.Value);
  11215. end
  11216. else
  11217. // procedure call, result is neither readable nor writable
  11218. SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,Proc.ProcType,[]);
  11219. Include(ResolvedEl.Flags,rrfCanBeStatement);
  11220. end
  11221. else if ResolvedEl.LoTypeEl is TPasProcedureType then
  11222. begin
  11223. if Params.Value is TParamsExpr then
  11224. begin
  11225. // e.g. Name()() or Name[]()
  11226. Include(ResolvedEl.Flags,rrfReadable);
  11227. end;
  11228. if rrfReadable in ResolvedEl.Flags then
  11229. begin
  11230. // call procvar
  11231. if rcConstant in Flags then
  11232. RaiseConstantExprExp(20170216152639,Params);
  11233. if ResolvedEl.LoTypeEl is TPasFunctionType then
  11234. // function call => return result
  11235. ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  11236. ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  11237. else
  11238. // procedure call, result is neither readable nor writable
  11239. SetResolverTypeExpr(ResolvedEl,btProc,
  11240. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,[]);
  11241. Include(ResolvedEl.Flags,rrfCanBeStatement);
  11242. end
  11243. else
  11244. begin
  11245. // typecast to proctype
  11246. if length(Params.Params)<>1 then
  11247. begin
  11248. {$IFDEF VerbosePasResolver}
  11249. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
  11250. {$ENDIF}
  11251. RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
  11252. sWrongNumberOfParametersForTypeCast,[ResolvedEl.LoTypeEl.Name],Params);
  11253. end;
  11254. Param0:=Params.Params[0];
  11255. ComputeElement(Param0,ParamResolved,[]);
  11256. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  11257. ParamResolved,ResolvedEl,Flags);
  11258. end;
  11259. end
  11260. else if (DeclEl is TPasType) then
  11261. begin
  11262. // type cast
  11263. Param0:=Params.Params[0];
  11264. ComputeElement(Param0,ParamResolved,[]);
  11265. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  11266. ParamResolved,ResolvedEl,Flags);
  11267. end
  11268. else
  11269. RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
  11270. end;
  11271. end;
  11272. procedure TPasResolver.ComputeTypeCast(ToLoType, ToHiType: TPasType;
  11273. Param: TPasExpr; const ParamResolved: TPasResolverResult; out
  11274. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  11275. function ParamIsVar: boolean;
  11276. var
  11277. IdentEl: TPasElement;
  11278. begin
  11279. IdentEl:=ParamResolved.IdentEl;
  11280. if IdentEl=nil then exit(false);
  11281. if [rcConstant,rcType]*Flags<>[] then
  11282. Result:=(IdentEl.ClassType=TPasConst) and (TPasConst(IdentEl).IsConst)
  11283. else
  11284. Result:=(IdentEl is TPasVariable)
  11285. or (IdentEl.ClassType=TPasArgument)
  11286. or (IdentEl.ClassType=TPasResultElement);
  11287. end;
  11288. var
  11289. WriteFlags: TPasResolverResultFlags;
  11290. KeepWriteFlags: Boolean;
  11291. bt: TResolverBaseType;
  11292. Expr: TPasExpr;
  11293. begin
  11294. {$IFDEF VerbosePasResolver}
  11295. writeln('TPasResolver.ComputeFuncParams START ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved));
  11296. {$ENDIF}
  11297. if ToLoType.CustomData is TResElDataBaseType then
  11298. begin
  11299. // type cast to base type (or alias of base type)
  11300. bt:=GetActualBaseType(TResElDataBaseType(ToLoType.CustomData).BaseType);
  11301. SetResolverValueExpr(ResolvedEl,
  11302. TResElDataBaseType(ToLoType.CustomData).BaseType,
  11303. ToLoType,ToHiType,
  11304. Param,[rrfReadable]);
  11305. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  11306. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  11307. if (WriteFlags<>[]) and ParamIsVar then
  11308. begin
  11309. KeepWriteFlags:=false;
  11310. // Param is writable -> check if typecast keeps this
  11311. if (bt=btPointer) then
  11312. begin
  11313. // typecast to pointer
  11314. if (ParamResolved.BaseType=btPointer)
  11315. or (ParamResolved.BaseType in [btString,btUnicodeString,btWideString])
  11316. or (ParamResolved.LoTypeEl=nil) // untyped
  11317. or (ParamResolved.LoTypeEl.ClassType=TPasClassType)
  11318. or IsDynArray(ParamResolved.LoTypeEl)
  11319. then
  11320. // e.g. pointer(ObjVar)
  11321. KeepWriteFlags:=true;
  11322. end
  11323. else if IsSameType(ToLoType,ParamResolved.LoTypeEl,prraNone) then
  11324. // e.g. Byte(TAliasByte)
  11325. KeepWriteFlags:=true;
  11326. if KeepWriteFlags then
  11327. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  11328. end;
  11329. end
  11330. else if ToLoType is TPasProcedureType then
  11331. begin
  11332. // typecast to proctype
  11333. if ParamIsVar then
  11334. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable]
  11335. else
  11336. WriteFlags:=[];
  11337. SetResolverValueExpr(ResolvedEl,btContext,
  11338. ToLoType,ToHiType,
  11339. Param,[rrfReadable]+WriteFlags);
  11340. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  11341. end
  11342. else
  11343. begin
  11344. // typecast to custom type, e.g. to classtype, recordtype, arraytype, range, set
  11345. if (Param.Parent is TParamsExpr) then
  11346. Expr:=TParamsExpr(Param.Parent)
  11347. else
  11348. Expr:=Param;
  11349. ComputeElement(ToHiType,ResolvedEl,Flags,Expr);
  11350. ResolvedEl.ExprEl:=Expr;
  11351. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  11352. ResolvedEl.Flags:=[rrfReadable];
  11353. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  11354. if (WriteFlags<>[]) and ParamIsVar then
  11355. begin
  11356. KeepWriteFlags:=false;
  11357. if (rrfReadable in ResolvedEl.Flags) then
  11358. begin
  11359. // typecast a value
  11360. if ParamResolved.BaseType=btPointer then
  11361. begin
  11362. if (ToLoType.ClassType=TPasClassType)
  11363. or IsDynArray(ParamResolved.LoTypeEl) then
  11364. // aClassType(aPointer)
  11365. KeepWriteFlags:=true;
  11366. end
  11367. else if ParamResolved.LoTypeEl=nil then
  11368. // e.g. TAliasType(untyped)
  11369. KeepWriteFlags:=true
  11370. else if ToLoType=ParamResolved.LoTypeEl then
  11371. // e.g. TAliasType(ActualType)
  11372. KeepWriteFlags:=true
  11373. else if (ToLoType.ClassType=TPasClassType)
  11374. and (ParamResolved.LoTypeEl.ClassType=TPasClassType) then
  11375. begin
  11376. // e.g. aClassType(ObjVar)
  11377. if (TPasClassType(ToLoType).ObjKind<>TPasClassType(ParamResolved.LoTypeEl).ObjKind) then
  11378. // e.g. IntfType(ObjVar)
  11379. else
  11380. KeepWriteFlags:=true;
  11381. end
  11382. else if (ToLoType.ClassType=TPasRecordType)
  11383. and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
  11384. // typecast record
  11385. KeepWriteFlags:=true
  11386. else if (ToLoType.ClassType=TPasArrayType)
  11387. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  11388. and IsDynArray(ToLoType)
  11389. and IsDynArray(ParamResolved.LoTypeEl) then
  11390. // typecast dyn array to dyn array
  11391. KeepWriteFlags:=true;
  11392. end
  11393. else
  11394. begin
  11395. // typecast a type to a value, e.g. Pointer(TObject)
  11396. end;
  11397. if KeepWriteFlags then
  11398. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  11399. end;
  11400. end;
  11401. {$IFDEF VerbosePasResolver}
  11402. writeln('TPasResolver.ComputeFuncParams END ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved),' Result=',GetResolverResultDbg(ResolvedEl));
  11403. {$ENDIF}
  11404. end;
  11405. procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
  11406. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11407. StartEl: TPasElement);
  11408. // [param,param,...]
  11409. var
  11410. ParamResolved, FirstResolved: TPasResolverResult;
  11411. i: Integer;
  11412. Param: TPasExpr;
  11413. IsRange, IsArray: Boolean;
  11414. ArrayType: TPasArrayType;
  11415. begin
  11416. ArrayType:=IsArrayExpr(Params);
  11417. IsArray:=ArrayType<>nil;
  11418. if length(Params.Params)=0 then
  11419. begin
  11420. SetResolverValueExpr(ResolvedEl,btArrayOrSet,nil,nil,Params,[rrfReadable]);
  11421. if IsArray then
  11422. ResolvedEl.BaseType:=btArrayLit;
  11423. exit;
  11424. end;
  11425. FirstResolved:=Default(TPasResolverResult);
  11426. Flags:=Flags-[rcNoImplicitProc]+[rcNoImplicitProcType];
  11427. for i:=0 to length(Params.Params)-1 do
  11428. begin
  11429. Param:=Params.Params[i];
  11430. ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
  11431. IsRange:=ParamResolved.BaseType=btRange;
  11432. if IsRange then
  11433. begin
  11434. if IsArray then
  11435. RaiseXExpectedButYFound(20180615111713,'array value','range expression',Param);
  11436. ConvertRangeToElement(ParamResolved);
  11437. end;
  11438. if FirstResolved.BaseType=btNone then
  11439. begin
  11440. // first value -> check if type usable in a set/array
  11441. FirstResolved:=ParamResolved;
  11442. if IsRange then
  11443. CheckIsOrdinal(FirstResolved,Param,true);
  11444. if rrfReadable in FirstResolved.Flags then
  11445. begin
  11446. // has a value
  11447. if (not IsArray) and (not IsRange)
  11448. and (not CheckIsOrdinal(FirstResolved,Param,false)) then
  11449. begin
  11450. // can't be a set
  11451. IsArray:=true;
  11452. end;
  11453. end
  11454. else
  11455. begin
  11456. IsArray:=true;
  11457. if (FirstResolved.BaseType=btContext) then
  11458. begin
  11459. if FirstResolved.IdentEl is TPasClassType then
  11460. // array of classtypes
  11461. else
  11462. begin
  11463. {$IFDEF VerbosePasResolver}
  11464. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  11465. {$ENDIF}
  11466. RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
  11467. end;
  11468. end
  11469. else
  11470. begin
  11471. {$IFDEF VerbosePasResolver}
  11472. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  11473. {$ENDIF}
  11474. RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
  11475. end;
  11476. end;
  11477. end
  11478. else
  11479. begin
  11480. // next value
  11481. CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
  11482. end;
  11483. end;
  11484. FirstResolved.IdentEl:=nil;
  11485. FirstResolved.ExprEl:=Params;
  11486. FirstResolved.SubType:=FirstResolved.BaseType;
  11487. if IsArray then
  11488. FirstResolved.BaseType:=btArrayLit
  11489. else
  11490. FirstResolved.BaseType:=btArrayOrSet;
  11491. FirstResolved.Flags:=[rrfReadable];
  11492. ResolvedEl:=FirstResolved;
  11493. end;
  11494. procedure TPasResolver.ComputeDereference(El: TUnaryExpr;
  11495. var ResolvedEl: TPasResolverResult);
  11496. procedure Deref(TypeEl: TPasType);
  11497. var
  11498. Expr: TPasExpr;
  11499. begin
  11500. Expr:=ResolvedEl.ExprEl;
  11501. if Expr=nil then
  11502. Expr:=El;
  11503. ComputeElement(TypeEl,ResolvedEl,[rcNoImplicitProc],El);
  11504. ResolvedEl.IdentEl:=nil;
  11505. ResolvedEl.ExprEl:=Expr;
  11506. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  11507. end;
  11508. var
  11509. TypeEl: TPasType;
  11510. begin
  11511. if ResolvedEl.BaseType=btPointer then
  11512. begin
  11513. Deref(ResolvedEl.LoTypeEl);
  11514. exit;
  11515. end
  11516. else if ResolvedEl.BaseType=btContext then
  11517. begin
  11518. TypeEl:=ResolvedEl.LoTypeEl;
  11519. if TypeEl.ClassType=TPasPointerType then
  11520. begin
  11521. Deref(TPasPointerType(TypeEl).DestType);
  11522. exit;
  11523. end;
  11524. end;
  11525. RaiseMsg(20180422191139,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  11526. [OpcodeStrings[eopDeref],GetResolverResultDescription(ResolvedEl)],El);
  11527. end;
  11528. procedure TPasResolver.ComputeArrayValuesExpectedType(El: TArrayValues; out
  11529. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11530. StartEl: TPasElement);
  11531. // (expr, expr, ...)
  11532. var
  11533. Parent: TPasElement;
  11534. HiTypeEl, LoTypeEl: TPasType;
  11535. Field: PRecordValuesItem;
  11536. Ref: TResolvedReference;
  11537. Member: TPasVariable;
  11538. i: Integer;
  11539. ArrType: TPasArrayType;
  11540. begin
  11541. Parent:=El.Parent;
  11542. if Parent is TPasVariable then
  11543. begin
  11544. HiTypeEl:=TPasVariable(Parent).VarType;
  11545. if HiTypeEl=nil then
  11546. RaiseMsg(20180429171628,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  11547. ['const','array values'],El);
  11548. LoTypeEl:=ResolveAliasType(HiTypeEl);
  11549. if LoTypeEl.ClassType=TPasArrayType then
  11550. // ok
  11551. else
  11552. RaiseIncompatibleTypeDesc(20180429171714,nIncompatibleTypesGotExpected,
  11553. [],'array value',GetTypeDescription(HiTypeEl),El);
  11554. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  11555. El,[rrfReadable]);
  11556. end
  11557. else if Parent.ClassType=TRecordValues then
  11558. begin
  11559. // record field array
  11560. // get field
  11561. i:=length(TRecordValues(Parent).Fields)-1;
  11562. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  11563. dec(i);
  11564. if i<0 then
  11565. RaiseInternalError(20180429181150);
  11566. Field:=@TRecordValues(Parent).Fields[i];
  11567. // get member
  11568. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  11569. Member:=Ref.Declaration as TPasVariable;
  11570. if Member=nil then
  11571. RaiseInternalError(20180429181210);
  11572. ComputeElement(Member,ResolvedEl,[],StartEl);
  11573. ResolvedEl.Flags:=[rrfReadable];
  11574. end
  11575. else if Parent.ClassType=TArrayValues then
  11576. begin
  11577. // array of array
  11578. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  11579. if (ResolvedEl.BaseType=btContext)
  11580. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  11581. begin
  11582. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  11583. if length(ArrType.Ranges)>1 then
  11584. RaiseNotYetImplemented(20180429180930,El);
  11585. HiTypeEl:=ArrType.ElType;
  11586. LoTypeEl:=ResolveAliasType(HiTypeEl);
  11587. if LoTypeEl.ClassType<>TPasArrayType then
  11588. RaiseIncompatibleTypeDesc(20180429180938,nIncompatibleTypesGotExpected,
  11589. [],'array values',GetTypeDescription(HiTypeEl),El);
  11590. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  11591. El,[rrfReadable]);
  11592. end
  11593. else
  11594. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  11595. [],'array values',GetTypeDescription(ResolvedEl),El);
  11596. end
  11597. else
  11598. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable]);
  11599. end;
  11600. procedure TPasResolver.ComputeRecordValues(El: TRecordValues; out
  11601. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  11602. StartEl: TPasElement);
  11603. // (name:expr; name:expr; ...)
  11604. var
  11605. Parent, Member: TPasElement;
  11606. LoTypeEl, HiTypeEl: TPasType;
  11607. i: Integer;
  11608. Field: PRecordValuesItem;
  11609. Ref: TResolvedReference;
  11610. ArrType: TPasArrayType;
  11611. begin
  11612. Parent:=El.Parent;
  11613. if Parent is TPasVariable then
  11614. begin
  11615. HiTypeEl:=TPasVariable(Parent).VarType;
  11616. if HiTypeEl=nil then
  11617. RaiseMsg(20180429105451,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  11618. ['const','record values'],El);
  11619. LoTypeEl:=ResolveAliasType(HiTypeEl);
  11620. if LoTypeEl.ClassType<>TPasRecordType then
  11621. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  11622. [],'record value',GetTypeDescription(HiTypeEl),El);
  11623. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  11624. El,[rrfReadable]);
  11625. end
  11626. else if Parent.ClassType=TRecordValues then
  11627. begin
  11628. // nested record
  11629. // get field
  11630. i:=length(TRecordValues(Parent).Fields)-1;
  11631. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  11632. dec(i);
  11633. if i<0 then
  11634. RaiseInternalError(20180429130244);
  11635. Field:=@TRecordValues(Parent).Fields[i];
  11636. // get member
  11637. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  11638. Member:=Ref.Declaration as TPasVariable;
  11639. if Member=nil then
  11640. RaiseInternalError(20180429130548);
  11641. ComputeElement(Member,ResolvedEl,[],StartEl);
  11642. ResolvedEl.Flags:=[rrfReadable];
  11643. end
  11644. else if Parent.ClassType=TArrayValues then
  11645. begin
  11646. // array of record
  11647. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  11648. if (ResolvedEl.BaseType=btContext)
  11649. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  11650. begin
  11651. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  11652. if length(ArrType.Ranges)>1 then
  11653. RaiseNotYetImplemented(20180429180450,El);
  11654. HiTypeEl:=ArrType.ElType;
  11655. LoTypeEl:=ResolveAliasType(HiTypeEl);
  11656. if LoTypeEl.ClassType<>TPasRecordType then
  11657. RaiseIncompatibleTypeDesc(20180429180642,nIncompatibleTypesGotExpected,
  11658. [],'record values',GetTypeDescription(HiTypeEl),El);
  11659. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  11660. El,[rrfReadable]);
  11661. end
  11662. else
  11663. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  11664. [],'array values',GetTypeDescription(ResolvedEl),El);
  11665. end
  11666. else
  11667. RaiseMsg(20180429110227,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  11668. ['const','(name:'],El);
  11669. end;
  11670. procedure TPasResolver.CheckIsClass(El: TPasElement;
  11671. const ResolvedEl: TPasResolverResult);
  11672. var
  11673. TypeEl: TPasType;
  11674. begin
  11675. if (ResolvedEl.BaseType<>btContext) then
  11676. RaiseXExpectedButYFound(20170216152245,'class',BaseTypeNames[ResolvedEl.BaseType],El);
  11677. TypeEl:=ResolvedEl.LoTypeEl;
  11678. if (TypeEl.ClassType<>TPasClassType)
  11679. or (TPasClassType(TypeEl).ObjKind<>okClass) then
  11680. RaiseXExpectedButYFound(20170216152246,'class',GetElementTypeName(ResolvedEl.LoTypeEl),El);
  11681. end;
  11682. function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  11683. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  11684. // called when type casting a class instance into an unrelated class
  11685. begin
  11686. if FromClassRes.BaseType=btNone then ;
  11687. if ToClassRes.BaseType=btNone then ;
  11688. if ErrorEl=nil then ;
  11689. Result:=cIncompatible;
  11690. end;
  11691. procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
  11692. const LHS, RHS: TPasResolverResult);
  11693. var
  11694. LBT, RBT: TResolverBaseType;
  11695. begin
  11696. // check both are values
  11697. if not (rrfReadable in LHS.Flags) then
  11698. begin
  11699. if LHS.LoTypeEl<>nil then
  11700. RaiseXExpectedButYFound(20170216152645,'ordinal',GetElementTypeName(LHS.LoTypeEl),Left)
  11701. else
  11702. RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  11703. end;
  11704. if not (rrfReadable in RHS.Flags) then
  11705. begin
  11706. if RHS.LoTypeEl<>nil then
  11707. RaiseXExpectedButYFound(20170216152651,'ordinal',GetElementTypeName(RHS.LoTypeEl),Right)
  11708. else
  11709. RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
  11710. end;
  11711. // check both have the same ordinal type
  11712. LBT:=GetActualBaseType(LHS.BaseType);
  11713. RBT:=GetActualBaseType(RHS.BaseType);
  11714. if LBT in btAllBooleans then
  11715. begin
  11716. if RBT in btAllBooleans then
  11717. exit;
  11718. RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
  11719. end
  11720. else if LBT in btAllInteger then
  11721. begin
  11722. if RBT in btAllInteger then
  11723. exit;
  11724. RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
  11725. end
  11726. else if LBT in btAllChars then
  11727. begin
  11728. if RBT in btAllChars then
  11729. exit;
  11730. RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
  11731. end
  11732. else if LBT=btContext then
  11733. begin
  11734. if LHS.LoTypeEl.ClassType=TPasEnumType then
  11735. begin
  11736. if LHS.LoTypeEl=RHS.LoTypeEl then
  11737. exit;
  11738. if RHS.LoTypeEl.ClassType<>TPasEnumType then
  11739. RaiseXExpectedButYFound(20170216152707,LHS.LoTypeEl.Parent.Name,GetElementTypeName(RHS.LoTypeEl),Right);
  11740. if LHS.LoTypeEl.Parent<>RHS.LoTypeEl.Parent then
  11741. RaiseXExpectedButYFound(20170216152710,LHS.LoTypeEl.Parent.Name,RHS.LoTypeEl.Parent.Name,Right);
  11742. end
  11743. else
  11744. RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  11745. end
  11746. else
  11747. RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  11748. end;
  11749. function TPasResolver.CheckIsOrdinal(
  11750. const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
  11751. RaiseOnError: boolean): boolean;
  11752. begin
  11753. Result:=false;
  11754. if ResolvedEl.BaseType in btAllRanges then
  11755. else if (ResolvedEl.BaseType=btContext) then
  11756. begin
  11757. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  11758. else if RaiseOnError then
  11759. RaiseXExpectedButYFound(20170216152718,'ordinal value',GetElementTypeName(ResolvedEl.LoTypeEl),ErrorEl)
  11760. else
  11761. exit;
  11762. end
  11763. else if RaiseOnError then
  11764. RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
  11765. else
  11766. exit;
  11767. Result:=true;
  11768. end;
  11769. procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
  11770. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  11771. // LHS defines the array element type
  11772. // check if RHS
  11773. var
  11774. LBT, RBT: TResolverBaseType;
  11775. C: TClass;
  11776. begin
  11777. if (LHS.LoTypeEl=RHS.LoTypeEl) and (LHS.BaseType=RHS.BaseType) then
  11778. exit; // exact same type
  11779. LBT:=GetActualBaseType(LHS.BaseType);
  11780. RBT:=GetActualBaseType(RHS.BaseType);
  11781. if rrfReadable in LHS.Flags then
  11782. begin
  11783. if not (rrfReadable in RHS.Flags) then
  11784. RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
  11785. [],RHS,LHS,Right);
  11786. // array of values
  11787. if LBT in btAllBooleans then
  11788. begin
  11789. if RBT in btAllBooleans then
  11790. begin
  11791. LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
  11792. exit;
  11793. end;
  11794. RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
  11795. end
  11796. else if LBT in btAllInteger then
  11797. begin
  11798. if RBT in btAllInteger then
  11799. begin
  11800. LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
  11801. exit;
  11802. end;
  11803. RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
  11804. end
  11805. else if LBT in btAllChars then
  11806. begin
  11807. if RBT in btAllChars then
  11808. begin
  11809. LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
  11810. exit;
  11811. end;
  11812. RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
  11813. end
  11814. else if LBT in btAllStrings then
  11815. begin
  11816. if RBT in btAllStringAndChars then
  11817. begin
  11818. LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
  11819. exit;
  11820. end;
  11821. RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
  11822. end
  11823. else if LBT=btNil then
  11824. begin
  11825. if RBT=btNil then
  11826. exit
  11827. else if RBT=btPointer then
  11828. begin
  11829. LHS:=RHS;
  11830. exit;
  11831. end
  11832. else if RBT=btContext then
  11833. begin
  11834. C:=RHS.LoTypeEl.ClassType;
  11835. if (C=TPasClassType)
  11836. or (C=TPasClassOfType)
  11837. or (C=TPasPointerType)
  11838. or ((C=TPasArrayType) and IsDynArray(RHS.LoTypeEl))
  11839. or (C=TPasProcedureType)
  11840. or (C=TPasFunctionType) then
  11841. begin
  11842. LHS:=RHS;
  11843. exit;
  11844. end;
  11845. end;
  11846. end
  11847. else if LBT=btContext then
  11848. begin
  11849. C:=LHS.LoTypeEl.ClassType;
  11850. if C=TPasEnumType then
  11851. begin
  11852. if LHS.LoTypeEl=RHS.LoTypeEl then
  11853. exit;
  11854. end
  11855. else if C=TPasClassType then
  11856. begin
  11857. // array of class instances
  11858. if RHS.LoTypeEl.ClassType<>TPasClassType then
  11859. RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
  11860. [],RHS,LHS,Right);
  11861. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  11862. begin
  11863. // right class type is a left class type -> ok
  11864. exit;
  11865. end
  11866. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  11867. begin
  11868. // left class type is a right class type -> right is the new base class type
  11869. LHS:=RHS;
  11870. exit;
  11871. end;
  11872. end;
  11873. end;
  11874. end
  11875. else
  11876. begin
  11877. // array of types
  11878. if rrfReadable in RHS.Flags then
  11879. RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
  11880. [],RHS,LHS,Right);
  11881. if LBT=btContext then
  11882. begin
  11883. if LHS.LoTypeEl.ClassType=TPasClassType then
  11884. begin
  11885. // array of class type
  11886. if RHS.LoTypeEl.ClassType<>TPasClassType then
  11887. RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
  11888. [],RHS,LHS,Right);
  11889. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  11890. begin
  11891. // right class type is a left class type -> ok
  11892. exit;
  11893. end
  11894. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  11895. begin
  11896. // left class type is a right class type -> right is the new base class type
  11897. LHS:=RHS;
  11898. exit;
  11899. end;
  11900. end;
  11901. end;
  11902. end;
  11903. // can't combine
  11904. if LHS.LoTypeEl=nil then
  11905. RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
  11906. if RHS.LoTypeEl=nil then
  11907. RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
  11908. RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
  11909. [],RHS,LHS,Right);
  11910. end;
  11911. procedure TPasResolver.ConvertRangeToElement(
  11912. var ResolvedEl: TPasResolverResult);
  11913. var
  11914. TypeEl: TPasType;
  11915. begin
  11916. if ResolvedEl.BaseType<>btRange then
  11917. RaiseInternalError(20161001155732);
  11918. if ResolvedEl.LoTypeEl=nil then
  11919. if ResolvedEl.IdentEl<>nil then
  11920. RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
  11921. else
  11922. RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
  11923. TypeEl:=ResolvedEl.LoTypeEl;
  11924. if TypeEl is TPasRangeType then
  11925. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant])
  11926. else
  11927. begin
  11928. ResolvedEl.BaseType:=ResolvedEl.SubType;
  11929. ResolvedEl.SubType:=btNone;
  11930. end;
  11931. end;
  11932. function TPasResolver.IsCharLiteral(const Value: string; ErrorPos: TPasElement
  11933. ): TResolverBaseType;
  11934. // returns true if Value is a Pascal char literal
  11935. // btAnsiChar: #65, #$50, ^G, 'a'
  11936. // btWideChar: #10000, 'ä'
  11937. var
  11938. i: SizeInt;
  11939. p, base, l: Integer;
  11940. begin
  11941. Result:=btNone;
  11942. //writeln('TPasResolver.IsCharLiteral ',BaseTypeChar,' "',Value,'" l=',length(Value));
  11943. l:=length(Value);
  11944. if l=0 then exit;
  11945. p:=1;
  11946. case Value[1] of
  11947. '''':
  11948. begin
  11949. inc(p);
  11950. if p>l then exit;
  11951. {$ifdef FPC_HAS_CPSTRING}
  11952. case Value[2] of
  11953. '''':
  11954. if Value='''''''''' then
  11955. Result:=btAnsiChar; // ''''
  11956. #32..#38,#40..#191:
  11957. if (l=3) and (Value[3]='''') then
  11958. Result:=btAnsiChar; // e.g. 'a'
  11959. #192..#255:
  11960. if BaseTypeChar=btWideChar then
  11961. begin
  11962. // default char is widechar: UTF-8 'ä' is a widechar
  11963. i:=Utf8CodePointLen(@Value[2],4,false);
  11964. //writeln('TPasResolver.IsCharLiteral "',Value,'" ',length(Value),' i=',i);
  11965. if i<2 then
  11966. exit;
  11967. p:=2+i;
  11968. if (p=l) and (Value[p]='''') then
  11969. // single UTF-8 codepoint
  11970. Result:=btWideChar;
  11971. end;
  11972. end;
  11973. {$else}
  11974. case Value[p] of
  11975. '''':
  11976. if (p+2=l) and (Value[p+1]='''') and (Value[p+2]='''') then
  11977. Result:=btWideChar; // ''''
  11978. #$DC00..#$DFFF: ;
  11979. else
  11980. if (l=3) and (Value[3]='''') then
  11981. Result:=btWideChar; // e.g. 'a'
  11982. end;
  11983. {$endif}
  11984. end;
  11985. '#':
  11986. begin
  11987. inc(p);
  11988. if p>l then exit;
  11989. case Value[p] of
  11990. '$': begin base:=16; inc(p); end;
  11991. '&': begin base:=8; inc(p); end;
  11992. '%': begin base:=2; inc(p); end;
  11993. '0'..'9': base:=10;
  11994. else RaiseNotYetImplemented(20170728142709,ErrorPos);
  11995. end;
  11996. i:=0;
  11997. while p<=l do
  11998. begin
  11999. case Value[p] of
  12000. '0'..'9': i:=i*base+ord(Value[p])-ord('0');
  12001. 'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
  12002. 'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
  12003. end;
  12004. inc(p);
  12005. end;
  12006. if p>l then
  12007. begin
  12008. {$ifdef FPC_HAS_CPSTRING}
  12009. if i<256 then
  12010. Result:=btAnsiChar
  12011. else
  12012. {$endif}
  12013. Result:=btWideChar;
  12014. end;
  12015. end;
  12016. '^':
  12017. begin
  12018. if (l=2) and (Value[2] in ['a'..'z','A'..'Z']) then
  12019. Result:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  12020. end;
  12021. end;
  12022. if Result in [{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar] then
  12023. begin
  12024. if FBaseTypes[Result]=nil then
  12025. begin
  12026. {$ifdef FPC_HAS_CPSTRING}
  12027. if Result=btAnsiChar then
  12028. Result:=btWideChar
  12029. else
  12030. {$endif}
  12031. Result:=btChar;
  12032. end;
  12033. if Result=BaseTypeChar then
  12034. Result:=btChar;
  12035. end;
  12036. end;
  12037. function TPasResolver.CheckForIn(Loop: TPasImplForLoop; const VarResolved,
  12038. InResolved: TPasResolverResult): boolean;
  12039. begin
  12040. Result:=false;
  12041. if Loop=nil then ;
  12042. if VarResolved.BaseType=btCustom then ;
  12043. if InResolved.BaseType=btCustom then ;
  12044. end;
  12045. function TPasResolver.CheckForInClassOrRec(Loop: TPasImplForLoop; const VarResolved,
  12046. InResolved: TPasResolverResult): boolean;
  12047. var
  12048. TypeEl: TPasType;
  12049. EnumeratorClass: TPasClassType;
  12050. EnumeratorScope: TPasDotClassScope;
  12051. Getter, MoveNext, Current: TPasIdentifier;
  12052. GetterFunc, MoveNextFunc: TPasFunction;
  12053. ptm: TProcTypeModifier;
  12054. ResultResolved, MoveNextResolved, CurrentResolved: TPasResolverResult;
  12055. CurrentProp: TPasProperty;
  12056. ForScope: TPasForLoopScope;
  12057. DotScope: TPasDotBaseScope;
  12058. begin
  12059. Result:=false;
  12060. if InResolved.IdentEl is TPasType then
  12061. RaiseMsg(20190120180525,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  12062. [GetBaseDescription(InResolved)],Loop.StartExpr);
  12063. if not (rrfReadable in InResolved.Flags) then
  12064. RaiseMsg(20171221195421,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  12065. [GetBaseDescription(InResolved)],Loop.StartExpr);
  12066. TypeEl:=InResolved.LoTypeEl;
  12067. if TypeEl=nil then exit;
  12068. // check function InVar.GetEnumerator
  12069. DotScope:=PushDotScope(TypeEl);
  12070. if DotScope=nil then
  12071. exit;
  12072. // find aRecord.GetEnumerator
  12073. Getter:=DotScope.FindIdentifier('GetEnumerator');
  12074. PopScope;
  12075. if Getter=nil then
  12076. begin
  12077. if TypeEl is TPasMembersType then
  12078. RaiseIdentifierNotFound(20171221191511,'GetEnumerator',Loop.StartExpr)
  12079. else
  12080. exit;
  12081. end;
  12082. // check is function
  12083. if Getter.Element.ClassType<>TPasFunction then
  12084. RaiseContextXExpectedButYFound(20171221191638,'GetEnumerator','function',GetElementTypeName(Getter.Element),Loop.StartExpr);
  12085. GetterFunc:=TPasFunction(Getter.Element);
  12086. // check visibility
  12087. if not (GetterFunc.Visibility in [visPublic,visPublished]) then
  12088. RaiseContextXExpectedButYFound(20171221191824,'function GetEnumerator','public',VisibilityNames[GetterFunc.Visibility],Loop.StartExpr);
  12089. // check arguments
  12090. if GetterFunc.FuncType.Args.Count>0 then
  12091. RaiseContextXExpectedButYFound(20171221191944,'function GetEnumerator','no arguments',IntToStr(GetterFunc.ProcType.Args.Count),Loop.StartExpr);
  12092. // check proc type modifiers
  12093. for ptm in GetterFunc.ProcType.Modifiers do
  12094. if not (ptm in [ptmOfObject]) then
  12095. RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  12096. // check result type
  12097. ComputeElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcType]);
  12098. if (ResultResolved.BaseType<>btContext) then
  12099. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
  12100. TypeEl:=ResultResolved.LoTypeEl;
  12101. if not (TypeEl is TPasClassType) then
  12102. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  12103. if not (rrfReadable in ResultResolved.Flags) then
  12104. RaiseContextXExpectedButYFound(20171221195506,'function GetEnumerator','result class instance',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  12105. // find function MoveNext: boolean in Enumerator class
  12106. EnumeratorClass:=TPasClassType(TypeEl);
  12107. EnumeratorScope:=PushClassDotScope(EnumeratorClass);
  12108. MoveNext:=EnumeratorScope.FindIdentifier('MoveNext');
  12109. if MoveNext=nil then
  12110. RaiseIdentifierNotFound(20171221195632,'MoveNext',Loop.StartExpr);
  12111. // check is function
  12112. if MoveNext.Element.ClassType<>TPasFunction then
  12113. RaiseContextXExpectedButYFound(20171221195651,'MoveNext','function',GetElementTypeName(MoveNext.Element),Loop.StartExpr);
  12114. MoveNextFunc:=TPasFunction(MoveNext.Element);
  12115. // check visibility
  12116. if not (MoveNextFunc.Visibility in [visPublic,visPublished]) then
  12117. RaiseContextXExpectedButYFound(20171221195712,'function MoveNext','public',VisibilityNames[MoveNextFunc.Visibility],Loop.StartExpr);
  12118. // check arguments
  12119. if MoveNextFunc.FuncType.Args.Count>0 then
  12120. RaiseContextXExpectedButYFound(20171221195723,'function MoveNext','no arguments',IntToStr(MoveNextFunc.ProcType.Args.Count),Loop.StartExpr);
  12121. // check proc type modifiers
  12122. for ptm in MoveNextFunc.ProcType.Modifiers do
  12123. if not (ptm in [ptmOfObject]) then
  12124. RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  12125. // check result type
  12126. ComputeElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcType]);
  12127. if not (MoveNextResolved.BaseType in btAllBooleans) then
  12128. RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
  12129. // check property Current
  12130. Current:=EnumeratorScope.FindIdentifier('Current');
  12131. if Current=nil then
  12132. RaiseIdentifierNotFound(20171221200433,'Current',Loop.StartExpr);
  12133. // check is property
  12134. if Current.Element.ClassType<>TPasProperty then
  12135. RaiseContextXExpectedButYFound(20171221200508,'Current','property',GetElementTypeName(Current.Element),Loop.StartExpr);
  12136. CurrentProp:=TPasProperty(Current.Element);
  12137. // check visibility
  12138. if not (CurrentProp.Visibility in [visPublic,visPublished]) then
  12139. RaiseContextXExpectedButYFound(20171221200546,'property Current','public',VisibilityNames[CurrentProp.Visibility],Loop.StartExpr);
  12140. // check arguments
  12141. if CurrentProp.Args.Count>0 then
  12142. RaiseContextXExpectedButYFound(20171221200638,'property Current','no arguments',IntToStr(CurrentProp.Args.Count),Loop.StartExpr);
  12143. // check readable
  12144. if GetPasPropertyGetter(CurrentProp)=nil then
  12145. RaiseContextXInvalidY(20171221200823,'property Current','read accessor',Loop.StartExpr);
  12146. // check result type fits for-loop variable
  12147. ComputeElement(CurrentProp,CurrentResolved,[rcType]);
  12148. if CheckAssignResCompatibility(VarResolved,CurrentResolved,Loop.VariableName,false)=cIncompatible then
  12149. RaiseIncompatibleTypeRes(20171221200018,nIncompatibleTypesGotExpected,[],VarResolved,CurrentResolved,Loop.VariableName);
  12150. PopScope; // pop EnumeratorScope
  12151. ForScope:=Loop.CustomData as TPasForLoopScope;
  12152. ForScope.GetEnumerator:=GetterFunc;
  12153. ForScope.MoveNext:=MoveNextFunc;
  12154. ForScope.Current:=CurrentProp;
  12155. Result:=true;
  12156. end;
  12157. function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
  12158. Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
  12159. begin
  12160. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
  12161. begin
  12162. if RaiseOnError then
  12163. RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
  12164. sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
  12165. exit(false);
  12166. end;
  12167. Result:=true;
  12168. end;
  12169. function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
  12170. Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean): integer;
  12171. begin
  12172. if length(Params.Params)>MaxCount then
  12173. begin
  12174. if RaiseOnError then
  12175. RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
  12176. sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[MaxCount]);
  12177. exit(cIncompatible);
  12178. end;
  12179. Result:=cExact;
  12180. end;
  12181. function TPasResolver.CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer;
  12182. Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
  12183. RaiseOnError: boolean): integer;
  12184. begin
  12185. if RaiseOnError then
  12186. RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  12187. [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
  12188. Result:=cIncompatible;
  12189. end;
  12190. function TPasResolver.FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  12191. var
  12192. Clause: TPasUsesClause;
  12193. i: Integer;
  12194. Use: TPasUsesUnit;
  12195. ModName: String;
  12196. begin
  12197. Result:=nil;
  12198. if (Section=nil) then exit;
  12199. Clause:=Section.UsesClause;
  12200. for i:=0 to length(Clause)-1 do
  12201. begin
  12202. Use:=Clause[i];
  12203. if (Use.Module=nil) or not (Use.Module is TPasModule) then continue;
  12204. ModName:=Use.Module.Name;
  12205. if CompareText(ModName,aName)=0 then
  12206. exit(TPasModule(Use.Module));
  12207. end;
  12208. end;
  12209. function TPasResolver.FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  12210. var
  12211. C: TClass;
  12212. begin
  12213. C:=aMod.ClassType;
  12214. if C.InheritsFrom(TPasProgram) then
  12215. Result:=FindUsedUnitInSection(aName,TPasProgram(aMod).ProgramSection)
  12216. else if C.InheritsFrom(TPasLibrary) then
  12217. Result:=FindUsedUnitInSection(aName,TPasLibrary(aMod).LibrarySection)
  12218. else
  12219. begin
  12220. Result:=FindUsedUnitInSection(aName,aMod.InterfaceSection);
  12221. if Result<>nil then exit;
  12222. Result:=FindUsedUnitInSection(aName,aMod.ImplementationSection);
  12223. end
  12224. end;
  12225. procedure TPasResolver.FinishAssertCall(Proc: TResElDataBuiltInProc;
  12226. Params: TParamsExpr);
  12227. var
  12228. aMod: TPasModule;
  12229. ModScope: TPasModuleScope;
  12230. aConstructor: TPasConstructor;
  12231. begin
  12232. if Proc=nil then ;
  12233. aMod:=RootElement;
  12234. ModScope:=aMod.CustomData as TPasModuleScope;
  12235. if not (pmsfAssertSearched in ModScope.Flags) then
  12236. FindAssertExceptionConstructors(Params);
  12237. if ModScope.AssertClass=nil then exit;
  12238. if length(Params.Params)>1 then
  12239. aConstructor:=ModScope.AssertMsgConstructor
  12240. else
  12241. aConstructor:=ModScope.AssertDefConstructor;
  12242. if aConstructor=nil then exit;
  12243. CreateReference(aConstructor,Params,rraRead);
  12244. end;
  12245. function TPasResolver.FindExceptionConstructor(const aUnitName,
  12246. aClassName: string; out aClass: TPasClassType; out
  12247. aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
  12248. var
  12249. aMod, UtilsMod: TPasModule;
  12250. SectionScope: TPasSectionScope;
  12251. Identifier: TPasIdentifier;
  12252. El: TPasElement;
  12253. ClassScope: TPasClassScope;
  12254. begin
  12255. Result:=false;
  12256. aClass:=nil;
  12257. aConstructor:=nil;
  12258. // find unit in uses clauses
  12259. aMod:=RootElement;
  12260. UtilsMod:=FindUsedUnit(aUnitName,aMod);
  12261. if UtilsMod=nil then exit;
  12262. // find class in interface
  12263. if UtilsMod.InterfaceSection=nil then exit;
  12264. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  12265. Identifier:=SectionScope.FindLocalIdentifier(aClassName);
  12266. if Identifier=nil then exit;
  12267. El:=Identifier.Element;
  12268. if not (El is TPasClassType) then
  12269. RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl);
  12270. if TPasClassType(El).ObjKind<>okClass then
  12271. RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetElementTypeName(El),ErrorEl);
  12272. aClass:=TPasClassType(El);
  12273. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  12274. repeat
  12275. Identifier:=ClassScope.FindIdentifier('create');
  12276. while Identifier<>nil do
  12277. begin
  12278. if Identifier.Element.ClassType=TPasConstructor then
  12279. begin
  12280. aConstructor:=TPasConstructor(Identifier.Element);
  12281. if aConstructor.ProcType.Args.Count=0 then
  12282. exit(true);
  12283. end;
  12284. Identifier:=Identifier.NextSameIdentifier;
  12285. end;
  12286. ClassScope:=ClassScope.AncestorScope;
  12287. until ClassScope=nil;
  12288. aConstructor:=nil;
  12289. end;
  12290. procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
  12291. var
  12292. aMod: TPasModule;
  12293. ModScope: TPasModuleScope;
  12294. Identifier: TPasIdentifier;
  12295. aClass: TPasClassType;
  12296. ClassScope: TPasClassScope;
  12297. aConstructor: TPasConstructor;
  12298. Arg: TPasArgument;
  12299. ArgResolved: TPasResolverResult;
  12300. begin
  12301. aMod:=RootElement;
  12302. ModScope:=aMod.CustomData as TPasModuleScope;
  12303. if pmsfAssertSearched in ModScope.Flags then exit;
  12304. Include(ModScope.Flags,pmsfAssertSearched);
  12305. FindExceptionConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
  12306. if aClass=nil then exit;
  12307. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  12308. ModScope.AssertClass:=aClass;
  12309. repeat
  12310. Identifier:=ClassScope.FindIdentifier('create');
  12311. while Identifier<>nil do
  12312. begin
  12313. if Identifier.Element.ClassType=TPasConstructor then
  12314. begin
  12315. aConstructor:=TPasConstructor(Identifier.Element);
  12316. //writeln('TPasResolver.FindAssertExceptionConstructors ',aConstructor.Name,' ',aConstructor.ProcType.Args.Count);
  12317. if aConstructor.ProcType.Args.Count=0 then
  12318. begin
  12319. if ModScope.AssertDefConstructor=nil then
  12320. ModScope.AssertDefConstructor:=aConstructor;
  12321. end
  12322. else if aConstructor.ProcType.Args.Count=1 then
  12323. begin
  12324. if ModScope.AssertMsgConstructor=nil then
  12325. begin
  12326. Arg:=TPasArgument(aConstructor.ProcType.Args[0]);
  12327. //writeln('TPasResolver.FindAssertExceptionConstructors ',GetObjName(Arg.ArgType),' ',GetObjName(BaseTypes[BaseTypeString]));
  12328. ComputeElement(Arg.ArgType,ArgResolved,[rcType]);
  12329. if ArgResolved.BaseType in btAllStrings then
  12330. ModScope.AssertMsgConstructor:=aConstructor;
  12331. end;
  12332. end;
  12333. end;
  12334. Identifier:=Identifier.NextSameIdentifier;
  12335. end;
  12336. ClassScope:=ClassScope.AncestorScope;
  12337. until ClassScope=nil;
  12338. end;
  12339. procedure TPasResolver.FindRangeErrorConstructors(ErrorEl: TPasElement);
  12340. var
  12341. aMod: TPasModule;
  12342. ModScope: TPasModuleScope;
  12343. aClass: TPasClassType;
  12344. aConstructor: TPasConstructor;
  12345. begin
  12346. aMod:=RootElement;
  12347. ModScope:=aMod.CustomData as TPasModuleScope;
  12348. if pmsfRangeErrorSearched in ModScope.Flags then exit;
  12349. Include(ModScope.Flags,pmsfRangeErrorSearched);
  12350. FindExceptionConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
  12351. ModScope.RangeErrorClass:=aClass;
  12352. ModScope.RangeErrorConstructor:=aConstructor;
  12353. end;
  12354. function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
  12355. var
  12356. aMod, UtilsMod: TPasModule;
  12357. SectionScope: TPasSectionScope;
  12358. Identifier: TPasIdentifier;
  12359. El: TPasElement;
  12360. ModScope: TPasModuleScope;
  12361. begin
  12362. aMod:=RootElement;
  12363. ModScope:=aMod.CustomData as TPasModuleScope;
  12364. Result:=ModScope.SystemTVarRec;
  12365. if Result<>nil then exit;
  12366. // find unit in uses clauses
  12367. UtilsMod:=FindUsedUnit('system',aMod);
  12368. if UtilsMod=nil then
  12369. RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
  12370. // find class in interface
  12371. if UtilsMod.InterfaceSection=nil then
  12372. RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
  12373. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  12374. Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
  12375. if Identifier=nil then
  12376. RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
  12377. El:=Identifier.Element;
  12378. if not (El is TPasRecordType) then
  12379. RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
  12380. Result:=TPasRecordType(El);
  12381. ModScope.SystemTVarRec:=Result;
  12382. end;
  12383. function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
  12384. var
  12385. aModule: TPasModule;
  12386. ModScope: TPasModuleScope;
  12387. begin
  12388. aModule:=El.GetModule;
  12389. ModScope:=aModule.CustomData as TPasModuleScope;
  12390. Result:=ModScope.SystemTVarRec;
  12391. if Result=nil then
  12392. RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
  12393. end;
  12394. procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
  12395. const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  12396. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  12397. PosEl: TPasElement);
  12398. begin
  12399. if MsgType<=mtError then
  12400. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
  12401. else
  12402. LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  12403. if Sender=nil then ;
  12404. end;
  12405. function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
  12406. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
  12407. var
  12408. Ref: TResolvedReference;
  12409. Decl: TPasElement;
  12410. C: TClass;
  12411. ResolvedType: TPasResolverResult;
  12412. EnumValue: TPasEnumValue;
  12413. EnumType: TPasEnumType;
  12414. EvalFlags: TResEvalFlags;
  12415. begin
  12416. Result:=nil;
  12417. if not (Expr.CustomData is TResolvedReference) then
  12418. RaiseNotYetImplemented(20170518203134,Expr);
  12419. Ref:=TResolvedReference(Expr.CustomData);
  12420. Decl:=Ref.Declaration;
  12421. {$IFDEF VerbosePasResEval}
  12422. writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
  12423. {$ENDIF}
  12424. C:=Decl.ClassType;
  12425. if C=TPasConst then
  12426. begin
  12427. if (TPasConst(Decl).Expr<>nil)
  12428. and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
  12429. begin
  12430. if TPasConst(Decl).VarType<>nil then
  12431. begin
  12432. // typed const
  12433. ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
  12434. end
  12435. else
  12436. ResolvedType.BaseType:=btNone;
  12437. EvalFlags:=Flags;
  12438. if not (refConstExt in EvalFlags) then
  12439. Include(EvalFlags,refConst);
  12440. Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,EvalFlags);
  12441. if Result<>nil then
  12442. begin
  12443. if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
  12444. Result:=Result.Clone;
  12445. Result.IdentEl:=Decl;
  12446. if TPasConst(Decl).VarType<>nil then
  12447. begin
  12448. // typed const
  12449. if Result.Kind=revkInt then
  12450. case ResolvedType.BaseType of
  12451. btByte: TResEvalInt(Result).Typed:=reitByte;
  12452. btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
  12453. btWord: TResEvalInt(Result).Typed:=reitWord;
  12454. btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
  12455. btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
  12456. btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
  12457. btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
  12458. btLongint: TResEvalInt(Result).Typed:=reitLongInt;
  12459. btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
  12460. {$ifdef HasInt64}
  12461. btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
  12462. btInt64: TResEvalInt(Result).Typed:=reitNone; // default
  12463. {$else}
  12464. btIntDouble: TResEvalInt(Result).Typed:=reitNone; // default
  12465. {$endif}
  12466. else
  12467. ReleaseEvalValue(Result);
  12468. RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
  12469. end;
  12470. end;
  12471. exit;
  12472. end;
  12473. end
  12474. else if vmExternal in TPasConst(Decl).VarModifiers then
  12475. begin
  12476. Result:=TResEvalExternal.Create;
  12477. Result.IdentEl:=Decl;
  12478. exit;
  12479. end;
  12480. if refConst in Flags then
  12481. begin
  12482. ReleaseEvalValue(Result);
  12483. RaiseConstantExprExp(20170518214928,Expr);
  12484. end;
  12485. end
  12486. else if C=TPasEnumValue then
  12487. begin
  12488. EnumValue:=TPasEnumValue(Decl);
  12489. EnumType:=EnumValue.Parent as TPasEnumType;
  12490. Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
  12491. exit;
  12492. end
  12493. else if C.InheritsFrom(TPasType) then
  12494. Result:=EvalTypeRange(TPasType(Decl),Flags);
  12495. {$IFDEF VerbosePasResEval}
  12496. writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags,' refConstExt=',refConstExt in Flags);
  12497. {$ENDIF}
  12498. if (Result=nil) and ([refConst,refConstExt]*Flags<>[]) then
  12499. RaiseConstantExprExp(20170518213616,Expr);
  12500. if Sender=nil then ;
  12501. end;
  12502. function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
  12503. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  12504. var
  12505. Ref: TResolvedReference;
  12506. Decl: TPasElement;
  12507. C: TClass;
  12508. BuiltInProc: TResElDataBuiltInProc;
  12509. bt: TResolverBaseType;
  12510. ResolvedEl: TPasResolverResult;
  12511. TypeEl: TPasType;
  12512. begin
  12513. Result:=nil;
  12514. case Params.Kind of
  12515. pekArrayParams: ;
  12516. pekFuncParams:
  12517. if Params.Value.CustomData is TResolvedReference then
  12518. begin
  12519. Ref:=TResolvedReference(Params.Value.CustomData);
  12520. Decl:=Ref.Declaration;
  12521. if Decl is TPasType then
  12522. Decl:=ResolveAliasType(TPasType(Decl));
  12523. C:=Decl.ClassType;
  12524. if C=TPasUnresolvedSymbolRef then
  12525. begin
  12526. if Decl.CustomData is TResElDataBuiltInProc then
  12527. begin
  12528. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  12529. {$IFDEF VerbosePasResEval}
  12530. writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  12531. {$ENDIF}
  12532. if BuiltInProc.Eval<>nil then
  12533. BuiltInProc.Eval(BuiltInProc,Params,Flags,Result)
  12534. else
  12535. case BuiltInProc.BuiltIn of
  12536. bfAssigned: Result:=nil;
  12537. bfConcatArray: Result:=nil;
  12538. bfCopyArray: Result:=nil;
  12539. bfTypeInfo: Result:=nil;
  12540. else
  12541. {$IFDEF VerbosePasResEval}
  12542. writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  12543. {$ENDIF}
  12544. RaiseNotYetImplemented(20170624192324,Params);
  12545. end;
  12546. {$IFDEF VerbosePasResEval}
  12547. {AllowWriteln}
  12548. if Result<>nil then
  12549. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
  12550. else
  12551. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
  12552. {AllowWriteln-}
  12553. {$ENDIF}
  12554. exit;
  12555. end
  12556. else if Decl.CustomData is TResElDataBaseType then
  12557. begin
  12558. // typecast to basetype
  12559. bt:=TResElDataBaseType(Decl.CustomData).BaseType;
  12560. Result:=EvalBaseTypeCast(Params,bt);
  12561. end;
  12562. {$IFDEF VerbosePasResEval}
  12563. writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
  12564. {$ENDIF}
  12565. end
  12566. else if C=TPasEnumType then
  12567. begin
  12568. // typecast to enumtype
  12569. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
  12570. end
  12571. else if C=TPasRangeType then
  12572. begin
  12573. // typecast to custom range
  12574. ComputeElement(TPasRangeType(Decl).RangeExpr.left,ResolvedEl,[rcConstant]);
  12575. if ResolvedEl.BaseType=btContext then
  12576. begin
  12577. TypeEl:=ResolvedEl.LoTypeEl;
  12578. if TypeEl.ClassType=TPasEnumType then
  12579. begin
  12580. // typecast to enumtype
  12581. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(TypeEl),Params.Params[0],Flags);
  12582. end
  12583. else
  12584. RaiseNotYetImplemented(20171009223403,Params);
  12585. end
  12586. else
  12587. RaiseNotYetImplemented(20171009223303,Params);
  12588. end;
  12589. end;
  12590. pekSet: ;
  12591. end;
  12592. if Flags=[] then ;
  12593. if Sender=nil then ;
  12594. end;
  12595. procedure TPasResolver.OnRangeCheckEl(Sender: TResExprEvaluator;
  12596. El: TPasElement; var MsgType: TMessageType);
  12597. begin
  12598. if El=nil then exit;
  12599. if (MsgType=mtWarning)
  12600. and (bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
  12601. MsgType:=mtError;
  12602. if Sender=nil then ;
  12603. end;
  12604. function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
  12605. bt: TResolverBaseType): TResEvalvalue;
  12606. procedure TCFloatToInt(Value: TResEvalValue; Flo: TMaxPrecFloat);
  12607. var
  12608. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  12609. begin
  12610. if bt in btAllIntegerNoQWord then
  12611. begin
  12612. // float to int
  12613. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  12614. if (Flo<MinIntVal) or (Flo>MaxIntVal) then
  12615. fExprEvaluator.EmitRangeCheckConst(20170711001228,
  12616. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  12617. {$R-}
  12618. try
  12619. Int:=Round(Flo);
  12620. except
  12621. RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
  12622. end;
  12623. case bt of
  12624. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  12625. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  12626. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  12627. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  12628. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  12629. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  12630. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  12631. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  12632. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  12633. {$ifdef HasInt64}
  12634. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  12635. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  12636. {$else}
  12637. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  12638. {$endif}
  12639. else
  12640. RaiseNotYetImplemented(20170711001513,Params);
  12641. end;
  12642. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  12643. exit;
  12644. end
  12645. else if bt=btSingle then
  12646. begin
  12647. // float to single
  12648. try
  12649. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Flo));
  12650. except
  12651. RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
  12652. end;
  12653. end
  12654. else if bt=btDouble then
  12655. begin
  12656. // float to double
  12657. try
  12658. Result:=TResEvalFloat.CreateValue(double(Flo));
  12659. except
  12660. RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
  12661. end;
  12662. end
  12663. else if bt=btCurrency then
  12664. begin
  12665. // float to currency
  12666. try
  12667. Result:=TResEvalCurrency.CreateValue(Currency(Flo));
  12668. except
  12669. RaiseMsg(20180421171840,nRangeCheckError,sRangeCheckError,[],Params);
  12670. end;
  12671. end
  12672. else
  12673. begin
  12674. {$IFDEF VerbosePasResEval}
  12675. writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
  12676. {$ENDIF}
  12677. RaiseNotYetImplemented(20170711002542,Params);
  12678. end;
  12679. end;
  12680. var
  12681. Value: TResEvalValue;
  12682. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  12683. Flo: TMaxPrecFloat;
  12684. w: WideChar;
  12685. begin
  12686. Result:=nil;
  12687. {$IFDEF VerbosePasResEval}
  12688. writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
  12689. {$ENDIF}
  12690. Value:=Eval(Params.Params[0],[refAutoConstExt]);
  12691. if Value=nil then exit;
  12692. try
  12693. case Value.Kind of
  12694. revkInt:
  12695. begin
  12696. Int:=TResEvalInt(Value).Int;
  12697. {$ifdef HasInt64}
  12698. if bt=btQWord then
  12699. begin
  12700. // int to qword
  12701. {$R-}
  12702. Result:=TResEvalUInt.CreateValue(TMaxPrecUInt(Int));
  12703. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  12704. end
  12705. else
  12706. {$endif}
  12707. if bt in btAllIntegerNoQWord then
  12708. begin
  12709. // int to int
  12710. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  12711. if (Int<MinIntVal) or (Int>MaxIntVal) then
  12712. begin
  12713. {$R-}
  12714. case bt of
  12715. btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
  12716. btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
  12717. btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
  12718. btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
  12719. btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
  12720. btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
  12721. {$ifdef HasInt64}
  12722. btInt64: Result:=TResEvalInt.CreateValue(Int);
  12723. {$endif}
  12724. btUIntSingle,
  12725. btIntSingle,
  12726. btUIntDouble,
  12727. btIntDouble:
  12728. fExprEvaluator.EmitRangeCheckConst(20170624194534,
  12729. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  12730. else
  12731. RaiseNotYetImplemented(20170624200109,Params);
  12732. end;
  12733. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  12734. end
  12735. else
  12736. begin
  12737. {$R-}
  12738. case bt of
  12739. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  12740. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  12741. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  12742. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  12743. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  12744. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  12745. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  12746. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  12747. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  12748. {$ifdef HasInt64}
  12749. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  12750. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  12751. {$else}
  12752. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  12753. {$endif}
  12754. else
  12755. RaiseNotYetImplemented(20170624200109,Params);
  12756. end;
  12757. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  12758. end;
  12759. exit;
  12760. end
  12761. else if bt in btAllBooleans then
  12762. case Int of
  12763. 0: Result:=TResEvalBool.CreateValue(false);
  12764. 1: Result:=TResEvalBool.CreateValue(true);
  12765. else
  12766. fExprEvaluator.EmitRangeCheckConst(20170710203254,
  12767. Value.AsString,0,1,Params,mtError);
  12768. end
  12769. {$ifdef FPC_HAS_CPSTRING}
  12770. else if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  12771. try
  12772. Result:=TResEvalString.CreateValue(Char(Int));
  12773. except
  12774. RaiseMsg(20180125112510,nRangeCheckError,sRangeCheckError,[],Params);
  12775. end
  12776. {$endif}
  12777. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  12778. try
  12779. w:=WideChar(Int);
  12780. Result:=TResEvalUTF16.CreateValue(w);
  12781. except
  12782. RaiseMsg(20180125112716,nRangeCheckError,sRangeCheckError,[],Params);
  12783. end
  12784. else if bt=btSingle then
  12785. try
  12786. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Int));
  12787. except
  12788. RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
  12789. end
  12790. else if bt=btDouble then
  12791. try
  12792. Result:=TResEvalFloat.CreateValue(Double(Int));
  12793. except
  12794. RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
  12795. end
  12796. else if bt=btCurrency then
  12797. try
  12798. Result:=TResEvalCurrency.CreateValue(Currency(Int));
  12799. except
  12800. RaiseMsg(20180422093631,nRangeCheckError,sRangeCheckError,[],Params);
  12801. end
  12802. else
  12803. begin
  12804. {$IFDEF VerbosePasResEval}
  12805. writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
  12806. {$ENDIF}
  12807. RaiseNotYetImplemented(20170624194308,Params);
  12808. end;
  12809. end;
  12810. revkFloat:
  12811. begin
  12812. Flo:=TResEvalFloat(Value).FloatValue;
  12813. TCFloatToInt(Value,Flo);
  12814. end;
  12815. revkCurrency:
  12816. begin
  12817. if bt=btCurrency then
  12818. begin
  12819. Result:=Value;
  12820. Value:=nil;
  12821. end
  12822. else
  12823. begin
  12824. Flo:=TResEvalCurrency(Value).Value;
  12825. TCFloatToInt(Value,Flo);
  12826. end;
  12827. end;
  12828. {$ifdef FPC_HAS_CPSTRING}
  12829. revkString:
  12830. begin
  12831. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  12832. begin
  12833. // ansichar(ansistring)
  12834. if fExprEvaluator.StringToOrd(Value,nil)>$ffff then
  12835. RaiseXExpectedButYFound(20181005141025,'char','string',Params);
  12836. Result:=Value;
  12837. Value:=nil;
  12838. end
  12839. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  12840. begin
  12841. // widechar(ansistring)
  12842. if fExprEvaluator.GetWideChar(TResEvalString(Value).S,w) then
  12843. begin
  12844. Result:=Value;
  12845. Value:=nil;
  12846. end
  12847. else
  12848. RaiseXExpectedButYFound(20181005141058,'char','string',Params);
  12849. end
  12850. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  12851. begin
  12852. // ansistring(ansistring)
  12853. Result:=Value;
  12854. Value:=nil;
  12855. end
  12856. else if (bt=btUnicodeString) or (bt=btWideString)
  12857. or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  12858. begin
  12859. // unicodestring(ansistring)
  12860. Result:=TResEvalUTF16.CreateValue(
  12861. fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Params));
  12862. end
  12863. else if bt=btRawByteString then
  12864. begin
  12865. // rawbytestring(ansistring)
  12866. SetCodePage(TResEvalString(Value).S,CP_NONE,false);
  12867. end;
  12868. end;
  12869. {$endif}
  12870. revkUnicodeString:
  12871. if length(TResEvalUTF16(Value).S)=1 then
  12872. begin
  12873. w:=TResEvalUTF16(Value).S[1];
  12874. {$ifdef FPC_HAS_CPSTRING}
  12875. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  12876. begin
  12877. // ansichar(unicodestring)
  12878. if ord(w)<=255 then
  12879. begin
  12880. Result:=Value;
  12881. Value:=nil;
  12882. end
  12883. else
  12884. RaiseMsg(20181005141632,nRangeCheckError,sRangeCheckError,[],Params);
  12885. end
  12886. else
  12887. {$endif}
  12888. if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  12889. begin
  12890. // widechar(unicodestring)
  12891. Result:=Value;
  12892. Value:=nil;
  12893. end;
  12894. end
  12895. {$ifdef FPC_HAS_CPSTRING}
  12896. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  12897. begin
  12898. // ansistring(unicodestring)
  12899. Result:=TResEvalString.CreateValue(
  12900. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
  12901. end
  12902. else if bt=btRawByteString then
  12903. begin
  12904. // rawbytestring(unicodestring)
  12905. Result:=TResEvalString.CreateValue(
  12906. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
  12907. end
  12908. {$endif}
  12909. else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  12910. begin
  12911. // unicodestring(unicodestring)
  12912. Result:=Value;
  12913. Value:=nil;
  12914. end;
  12915. revkExternal:
  12916. exit;
  12917. else
  12918. {$IFDEF VerbosePasResEval}
  12919. writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
  12920. {$ENDIF}
  12921. RaiseNotYetImplemented(20170624193436,Params);
  12922. end;
  12923. finally
  12924. ReleaseEvalValue(Value);
  12925. end;
  12926. end;
  12927. function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
  12928. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  12929. var Handled: boolean): integer;
  12930. // called when LHS or RHS BaseType is btCustom
  12931. // if RaiseOnIncompatible=true you can raise an useful error.
  12932. begin
  12933. Result:=cIncompatible;
  12934. if LHS.BaseType=btNone then ;
  12935. if RHS.BaseType=btNone then ;
  12936. if ErrorEl=nil then ;
  12937. if RaiseOnIncompatible then ;
  12938. if Handled then ;
  12939. end;
  12940. function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
  12941. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  12942. ): integer;
  12943. begin
  12944. Result:=cIncompatible;
  12945. if LHS.BaseType=RHS.BaseType then;
  12946. if ErrorEl=nil then;
  12947. if RaiseOnIncompatible then ;
  12948. end;
  12949. function TPasResolver.BI_Length_OnGetCallCompatibility(
  12950. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  12951. // check params of built in proc 'length'
  12952. var
  12953. Params: TParamsExpr;
  12954. Param: TPasExpr;
  12955. ParamResolved: TPasResolverResult;
  12956. Ranges: TPasExprArray;
  12957. begin
  12958. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  12959. exit(cIncompatible);
  12960. Params:=TParamsExpr(Expr);
  12961. // first param: string or dynamic array or type/const of static array
  12962. Param:=Params.Params[0];
  12963. ComputeElement(Param,ParamResolved,[]);
  12964. Result:=cIncompatible;
  12965. if ParamResolved.BaseType in btAllStringAndChars then
  12966. begin
  12967. if rrfReadable in ParamResolved.Flags then
  12968. Result:=cExact;
  12969. end
  12970. else if ParamResolved.BaseType=btContext then
  12971. begin
  12972. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  12973. begin
  12974. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  12975. if length(Ranges)=0 then
  12976. begin
  12977. if rrfReadable in ParamResolved.Flags then
  12978. Result:=cExact;
  12979. end
  12980. else
  12981. // static array
  12982. Result:=cExact;
  12983. end;
  12984. end;
  12985. if Result=cIncompatible then
  12986. exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
  12987. 'string or dynamic array',RaiseOnError));
  12988. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  12989. end;
  12990. procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  12991. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  12992. begin
  12993. if Params=nil then ;
  12994. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  12995. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
  12996. end;
  12997. procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  12998. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  12999. var
  13000. Param, Expr: TPasExpr;
  13001. ParamResolved: TPasResolverResult;
  13002. Value: TResEvalValue;
  13003. Ranges: TPasExprArray;
  13004. IdentEl: TPasElement;
  13005. begin
  13006. Evaluated:=nil;
  13007. // first param: string or dynamic array or type/const of static array
  13008. Param:=Params.Params[0];
  13009. ComputeElement(Param,ParamResolved,[]);
  13010. if ParamResolved.BaseType in btAllStringAndChars then
  13011. begin
  13012. if rrfReadable in ParamResolved.Flags then
  13013. begin
  13014. Value:=Eval(Param,Flags);
  13015. if Value=nil then exit;
  13016. case Value.Kind of
  13017. {$ifdef FPC_HAS_CPSTRING}
  13018. revkString:
  13019. Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
  13020. {$endif}
  13021. revkUnicodeString:
  13022. Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
  13023. end;
  13024. ReleaseEvalValue(Value);
  13025. end
  13026. end
  13027. else if ParamResolved.BaseType=btContext then
  13028. begin
  13029. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  13030. begin
  13031. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  13032. if length(Ranges)=0 then
  13033. begin
  13034. // open or dynamic array
  13035. IdentEl:=ParamResolved.IdentEl;
  13036. if (IdentEl is TPasVariable)
  13037. and (TPasVariable(IdentEl).Expr is TPasExpr) then
  13038. begin
  13039. Expr:=TPasVariable(IdentEl).Expr;
  13040. if Expr is TArrayValues then
  13041. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values))
  13042. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  13043. Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params));
  13044. end;
  13045. end
  13046. else
  13047. begin
  13048. // static array
  13049. Evaluated:=TResEvalInt.CreateValue(GetRangeLength(Ranges[0]));
  13050. end;
  13051. end;
  13052. end;
  13053. if Proc=nil then ;
  13054. end;
  13055. function TPasResolver.BI_SetLength_OnGetCallCompatibility(
  13056. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13057. // check params of built in proc 'setlength'
  13058. var
  13059. Params: TParamsExpr;
  13060. Param: TPasExpr;
  13061. ParamResolved, DimResolved: TPasResolverResult;
  13062. ArgNo: Integer;
  13063. DynArr: TPasArrayType;
  13064. ElType: TPasType;
  13065. begin
  13066. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  13067. exit(cIncompatible);
  13068. Params:=TParamsExpr(Expr);
  13069. // first param: string or array variable
  13070. Param:=Params.Params[0];
  13071. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  13072. Result:=cIncompatible;
  13073. DynArr:=nil;
  13074. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  13075. begin
  13076. if ParamResolved.BaseType in btAllStrings then
  13077. Result:=cExact
  13078. else if ParamResolved.BaseType=btContext then
  13079. begin
  13080. if IsDynArray(ParamResolved.LoTypeEl) then
  13081. begin
  13082. Result:=cExact;
  13083. DynArr:=NoNil(ParamResolved.LoTypeEl) as TPasArrayType;
  13084. end;
  13085. end;
  13086. end;
  13087. if Result=cIncompatible then
  13088. exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
  13089. 'string or dynamic array variable',RaiseOnError));
  13090. // second param: new length
  13091. ArgNo:=2;
  13092. repeat
  13093. Param:=Params.Params[ArgNo-1];
  13094. ComputeElement(Param,DimResolved,[]);
  13095. Result:=cIncompatible;
  13096. if (rrfReadable in DimResolved.Flags)
  13097. and (DimResolved.BaseType in btAllInteger) then
  13098. Result:=cExact;
  13099. if Result=cIncompatible then
  13100. exit(CheckRaiseTypeArgNo(20170329160338,ArgNo,Param,DimResolved,
  13101. 'integer',RaiseOnError));
  13102. if (DynArr=nil) or (ArgNo=length(Params.Params)) then break;
  13103. ElType:=ResolveAliasType(DynArr.ElType);
  13104. if not IsDynArray(ElType) then break;
  13105. DynArr:=NoNil(ElType) as TPasArrayType;
  13106. inc(ArgNo);
  13107. until false;
  13108. Result:=CheckBuiltInMaxParamCount(Proc,Params,ArgNo,RaiseOnError);
  13109. end;
  13110. procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
  13111. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  13112. var
  13113. P: TPasExprArray;
  13114. begin
  13115. if Proc=nil then ;
  13116. P:=Params.Params;
  13117. if P=nil then ;
  13118. FinishCallArgAccess(P[0],rraVarParam);
  13119. FinishCallArgAccess(P[1],rraRead);
  13120. end;
  13121. function TPasResolver.BI_InExclude_OnGetCallCompatibility(
  13122. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13123. // check params of built in proc 'include'
  13124. var
  13125. Params: TParamsExpr;
  13126. Param: TPasExpr;
  13127. ParamResolved: TPasResolverResult;
  13128. EnumType: TPasEnumType;
  13129. C: TClass;
  13130. begin
  13131. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  13132. exit(cIncompatible);
  13133. Params:=TParamsExpr(Expr);
  13134. // first param: set variable
  13135. // todo set of int, set of char, set of bool
  13136. Param:=Params.Params[0];
  13137. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  13138. EnumType:=nil;
  13139. if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
  13140. and (ParamResolved.IdentEl<>nil) then
  13141. begin
  13142. C:=ParamResolved.IdentEl.ClassType;
  13143. if (C.InheritsFrom(TPasVariable)
  13144. or (C=TPasArgument)
  13145. or (C=TPasResultElement)) then
  13146. begin
  13147. if (ParamResolved.BaseType=btSet)
  13148. and (ParamResolved.LoTypeEl is TPasEnumType) then
  13149. EnumType:=TPasEnumType(ParamResolved.LoTypeEl);
  13150. end;
  13151. end;
  13152. if EnumType=nil then
  13153. begin
  13154. {$IFDEF VerbosePasResolver}
  13155. writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
  13156. {$ENDIF}
  13157. exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
  13158. 'variable of set of enumtype',RaiseOnError));
  13159. end;
  13160. // second param: enum
  13161. Param:=Params.Params[1];
  13162. ComputeElement(Param,ParamResolved,[]);
  13163. if (not (rrfReadable in ParamResolved.Flags))
  13164. or (ParamResolved.LoTypeEl<>EnumType) then
  13165. begin
  13166. if RaiseOnError then
  13167. RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
  13168. ['2'],ParamResolved.LoTypeEl,EnumType,Param);
  13169. exit(cIncompatible);
  13170. end;
  13171. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  13172. end;
  13173. procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
  13174. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  13175. var
  13176. P: TPasExprArray;
  13177. begin
  13178. if Proc=nil then ;
  13179. P:=Params.Params;
  13180. if P=nil then ;
  13181. FinishCallArgAccess(P[0],rraVarParam);
  13182. FinishCallArgAccess(P[1],rraRead);
  13183. end;
  13184. function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  13185. Expr: TPasExpr; RaiseOnError: boolean): integer;
  13186. var
  13187. Params: TParamsExpr;
  13188. begin
  13189. if GetLoop(Expr)=nil then
  13190. RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
  13191. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  13192. exit(cExact);
  13193. Params:=TParamsExpr(Expr);
  13194. {$IFDEF VerbosePasResolver}
  13195. writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
  13196. {$ENDIF}
  13197. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  13198. end;
  13199. function TPasResolver.BI_Continue_OnGetCallCompatibility(
  13200. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13201. var
  13202. Params: TParamsExpr;
  13203. begin
  13204. if GetLoop(Expr)=nil then
  13205. RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
  13206. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  13207. exit(cExact);
  13208. Params:=TParamsExpr(Expr);
  13209. {$IFDEF VerbosePasResolver}
  13210. writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
  13211. {$ENDIF}
  13212. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  13213. end;
  13214. function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  13215. Expr: TPasExpr; RaiseOnError: boolean): integer;
  13216. var
  13217. Params: TParamsExpr;
  13218. Param: TPasExpr;
  13219. ParamResolved, ResultResolved: TPasResolverResult;
  13220. i: Integer;
  13221. ProcScope: TPasProcedureScope;
  13222. ResultEl: TPasResultElement;
  13223. Flags: TPasResolverComputeFlags;
  13224. CtxProc: TPasProcedure;
  13225. begin
  13226. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  13227. exit(cExact);
  13228. Params:=TParamsExpr(Expr);
  13229. {$IFDEF VerbosePasResolver}
  13230. writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
  13231. {$ENDIF}
  13232. // first param: result
  13233. Param:=Params.Params[0];
  13234. Result:=cIncompatible;
  13235. i:=ScopeCount-1;
  13236. while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
  13237. if i>0 then
  13238. begin
  13239. // first param is function result
  13240. ProcScope:=TPasProcedureScope(Scopes[i]);
  13241. CtxProc:=TPasProcedure(ProcScope.Element);
  13242. if not (CtxProc.ProcType is TPasFunctionType) then
  13243. begin
  13244. if RaiseOnError then
  13245. RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
  13246. sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
  13247. exit(cIncompatible);
  13248. end;
  13249. ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
  13250. ComputeElement(ResultEl,ResultResolved,[rcType]);
  13251. end
  13252. else
  13253. begin
  13254. // default: main program, param is an integer
  13255. SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],FBaseTypes[btLongint],
  13256. [rrfReadable,rrfWritable]);
  13257. end;
  13258. {$IFDEF VerbosePasResolver}
  13259. writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
  13260. {$ENDIF}
  13261. Flags:=[];
  13262. if IsProcedureType(ResultResolved,true) then
  13263. Include(Flags,rcNoImplicitProc);
  13264. ComputeElement(Param,ParamResolved,Flags);
  13265. {$IFDEF VerbosePasResolver}
  13266. writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
  13267. {$ENDIF}
  13268. if rrfReadable in ParamResolved.Flags then
  13269. Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
  13270. if Result=cIncompatible then
  13271. begin
  13272. if RaiseOnError then
  13273. RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
  13274. ['1'],ParamResolved,ResultResolved,Param);
  13275. exit;
  13276. end;
  13277. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13278. end;
  13279. function TPasResolver.BI_IncDec_OnGetCallCompatibility(
  13280. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13281. var
  13282. Params: TParamsExpr;
  13283. Param: TPasExpr;
  13284. ParamResolved, IncrResolved: TPasResolverResult;
  13285. TypeEl: TPasType;
  13286. begin
  13287. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13288. exit(cIncompatible);
  13289. Params:=TParamsExpr(Expr);
  13290. // first param: var Integer
  13291. Param:=Params.Params[0];
  13292. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  13293. {$IFDEF VerbosePasResolver}
  13294. writeln('TPasResolver.BI_IncDec_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  13295. {$ENDIF}
  13296. Result:=cIncompatible;
  13297. // Expr must be a variable
  13298. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  13299. begin
  13300. if RaiseOnError then
  13301. RaiseVarExpected(20170216152319,Expr,ParamResolved.IdentEl);
  13302. exit;
  13303. end;
  13304. if ParamResolved.BaseType in btAllInteger then
  13305. Result:=cExact
  13306. else if ParamResolved.BaseType=btPointer then
  13307. begin
  13308. if ElHasBoolSwitch(Expr,bsPointerMath) then
  13309. Result:=cExact;
  13310. end
  13311. else if ParamResolved.BaseType=btContext then
  13312. begin
  13313. TypeEl:=ParamResolved.LoTypeEl;
  13314. if (TypeEl.ClassType=TPasPointerType)
  13315. and ElHasBoolSwitch(Expr,bsPointerMath) then
  13316. Result:=cExact;
  13317. end;
  13318. if Result=cIncompatible then
  13319. exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
  13320. if length(Params.Params)=1 then
  13321. exit;
  13322. // second param: increment/decrement
  13323. Param:=Params.Params[1];
  13324. ComputeElement(Param,IncrResolved,[]);
  13325. Result:=cIncompatible;
  13326. if rrfReadable in IncrResolved.Flags then
  13327. begin
  13328. if IncrResolved.BaseType in btAllInteger then
  13329. Result:=cExact;
  13330. end;
  13331. if Result=cIncompatible then
  13332. exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
  13333. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  13334. end;
  13335. procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
  13336. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  13337. var
  13338. P: TPasExprArray;
  13339. begin
  13340. if Proc=nil then ;
  13341. P:=Params.Params;
  13342. FinishCallArgAccess(P[0],rraVarParam);
  13343. if Length(P)>1 then
  13344. FinishCallArgAccess(P[1],rraRead);
  13345. end;
  13346. function TPasResolver.BI_Assigned_OnGetCallCompatibility(
  13347. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13348. // check params of built in proc 'Assigned'
  13349. var
  13350. Params: TParamsExpr;
  13351. Param: TPasExpr;
  13352. ParamResolved: TPasResolverResult;
  13353. C: TClass;
  13354. begin
  13355. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13356. exit(cIncompatible);
  13357. Params:=TParamsExpr(Expr);
  13358. // first param: pointer, class, class instance, proc type or array
  13359. Param:=Params.Params[0];
  13360. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  13361. Result:=cIncompatible;
  13362. if ParamResolved.BaseType in [btNil,btPointer] then
  13363. Result:=cExact
  13364. else if (ParamResolved.BaseType=btContext) then
  13365. begin
  13366. C:=ParamResolved.LoTypeEl.ClassType;
  13367. if (C=TPasClassType)
  13368. or (C=TPasClassOfType)
  13369. or C.InheritsFrom(TPasProcedureType)
  13370. or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.LoTypeEl).Ranges)=0)) then
  13371. Result:=cExact;
  13372. end;
  13373. if Result=cIncompatible then
  13374. exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
  13375. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13376. end;
  13377. procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13378. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13379. begin
  13380. SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,
  13381. FBaseTypes[btBoolean],FBaseTypes[btBoolean],[rrfReadable]);
  13382. if Params=nil then ;
  13383. end;
  13384. procedure TPasResolver.BI_Assigned_OnFinishParamsExpr(
  13385. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  13386. var
  13387. P: TPasExpr;
  13388. ResolvedEl: TPasResolverResult;
  13389. begin
  13390. if Proc=nil then ;
  13391. P:=Params.Params[0];
  13392. AccessExpr(P,rraRead);
  13393. ComputeElement(P,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
  13394. end;
  13395. function TPasResolver.BI_Chr_OnGetCallCompatibility(
  13396. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13397. var
  13398. Params: TParamsExpr;
  13399. Param: TPasExpr;
  13400. ParamResolved: TPasResolverResult;
  13401. begin
  13402. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13403. exit(cIncompatible);
  13404. Params:=TParamsExpr(Expr);
  13405. // first param: integer
  13406. Param:=Params.Params[0];
  13407. ComputeElement(Param,ParamResolved,[]);
  13408. Result:=cIncompatible;
  13409. if rrfReadable in ParamResolved.Flags then
  13410. begin
  13411. if ParamResolved.BaseType in btAllInteger then
  13412. Result:=cExact;
  13413. end;
  13414. if Result=cIncompatible then
  13415. exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
  13416. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13417. end;
  13418. procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13419. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13420. begin
  13421. SetResolverIdentifier(ResolvedEl,BaseTypeChar,Proc.Proc,
  13422. FBaseTypes[BaseTypeChar],FBaseTypes[BaseTypeChar],[rrfReadable]);
  13423. if Params=nil then ;
  13424. end;
  13425. procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  13426. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  13427. var
  13428. Param: TPasExpr;
  13429. Value: TResEvalValue;
  13430. begin
  13431. Evaluated:=nil;
  13432. Param:=Params.Params[0];
  13433. Value:=Eval(Param,Flags);
  13434. {$IFDEF VerbosePasResEval}
  13435. {AllowWriteln}
  13436. if Value=nil then
  13437. writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
  13438. else
  13439. writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
  13440. {AllowWriteln-}
  13441. {$ENDIF}
  13442. if Value=nil then exit;
  13443. try
  13444. Evaluated:=fExprEvaluator.ChrValue(Value,Params);
  13445. finally
  13446. ReleaseEvalValue(Value);
  13447. end;
  13448. if Proc=nil then ;
  13449. end;
  13450. function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  13451. Expr: TPasExpr; RaiseOnError: boolean): integer;
  13452. var
  13453. Params: TParamsExpr;
  13454. Param: TPasExpr;
  13455. ParamResolved, ResolvedEl: TPasResolverResult;
  13456. TypeEl: TPasType;
  13457. begin
  13458. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13459. exit(cIncompatible);
  13460. Params:=TParamsExpr(Expr);
  13461. // first param: bool, enum or char
  13462. Param:=Params.Params[0];
  13463. ComputeElement(Param,ParamResolved,[]);
  13464. Result:=cIncompatible;
  13465. if rrfReadable in ParamResolved.Flags then
  13466. begin
  13467. if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
  13468. Result:=cExact
  13469. else if (ParamResolved.BaseType=btContext) and (ParamResolved.LoTypeEl is TPasEnumType) then
  13470. Result:=cExact
  13471. else if ParamResolved.BaseType=btRange then
  13472. begin
  13473. if ParamResolved.SubType in btAllBooleans+btAllChars then
  13474. Result:=cExact
  13475. else if ParamResolved.SubType=btContext then
  13476. begin
  13477. TypeEl:=ParamResolved.LoTypeEl;
  13478. if TypeEl.ClassType=TPasRangeType then
  13479. begin
  13480. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  13481. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  13482. exit(cExact);
  13483. end;
  13484. end;
  13485. end;
  13486. end;
  13487. if Result=cIncompatible then
  13488. exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
  13489. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13490. end;
  13491. procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13492. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13493. begin
  13494. SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,
  13495. FBaseTypes[btLongint],FBaseTypes[btLongint],[rrfReadable]);
  13496. if Params=nil then ;
  13497. end;
  13498. procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  13499. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  13500. var
  13501. Param: TPasExpr;
  13502. Value: TResEvalValue;
  13503. begin
  13504. Evaluated:=nil;
  13505. Param:=Params.Params[0];
  13506. Value:=Eval(Param,Flags);
  13507. {$IFDEF VerbosePasResEval}
  13508. {AllowWriteln}
  13509. if Value=nil then
  13510. writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
  13511. else
  13512. writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
  13513. {AllowWriteln-}
  13514. {$ENDIF}
  13515. if Value=nil then exit;
  13516. try
  13517. Evaluated:=fExprEvaluator.OrdValue(Value,Params);
  13518. finally
  13519. ReleaseEvalValue(Value);
  13520. end;
  13521. if Proc=nil then ;
  13522. end;
  13523. function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
  13524. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13525. // check params of built in proc 'Low' or 'High'
  13526. var
  13527. Params: TParamsExpr;
  13528. Param: TPasExpr;
  13529. ParamResolved: TPasResolverResult;
  13530. C: TClass;
  13531. begin
  13532. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13533. exit(cIncompatible);
  13534. Params:=TParamsExpr(Expr);
  13535. // first param: enumtype, range, built-in ordinal type (char, longint, ...)
  13536. Param:=Params.Params[0];
  13537. ComputeElement(Param,ParamResolved,[]);
  13538. Result:=cIncompatible;
  13539. if ParamResolved.BaseType in btAllRanges then
  13540. // e.g. high(char)
  13541. Result:=cExact
  13542. else if ParamResolved.BaseType=btSet then
  13543. Result:=cExact
  13544. else if (ParamResolved.BaseType=btContext) then
  13545. begin
  13546. C:=ParamResolved.LoTypeEl.ClassType;
  13547. if (C=TPasArrayType)
  13548. or (C=TPasSetType)
  13549. or (C=TPasEnumType) then
  13550. Result:=cExact;
  13551. end;
  13552. if Result=cIncompatible then
  13553. begin
  13554. {$IFDEF VerbosePasResolver}
  13555. writeln('TPasResolver.BI_LowHigh_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  13556. {$ENDIF}
  13557. exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
  13558. end;
  13559. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13560. end;
  13561. procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13562. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13563. var
  13564. ArrayEl: TPasArrayType;
  13565. Param: TPasExpr;
  13566. TypeEl: TPasType;
  13567. begin
  13568. Param:=Params.Params[0];
  13569. ComputeElement(Param,ResolvedEl,[]);
  13570. if ResolvedEl.BaseType=btContext then
  13571. begin
  13572. TypeEl:=ResolvedEl.LoTypeEl;
  13573. if TypeEl.ClassType=TPasArrayType then
  13574. begin
  13575. // array: result type is type of first dimension
  13576. ArrayEl:=TPasArrayType(TypeEl);
  13577. if length(ArrayEl.Ranges)=0 then
  13578. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  13579. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable])
  13580. else
  13581. begin
  13582. ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
  13583. if ResolvedEl.BaseType=btRange then
  13584. ConvertRangeToElement(ResolvedEl);
  13585. end;
  13586. end
  13587. else if TypeEl.ClassType=TPasSetType then
  13588. begin
  13589. ResolvedEl.LoTypeEl:=TPasSetType(TypeEl).EnumType;
  13590. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  13591. end;
  13592. end
  13593. else if ResolvedEl.BaseType=btSet then
  13594. begin
  13595. ResolvedEl.BaseType:=ResolvedEl.SubType;
  13596. ResolvedEl.SubType:=btNone;
  13597. end
  13598. else
  13599. ;// ordinal: result type is argument type
  13600. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
  13601. end;
  13602. procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  13603. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  13604. function IsDynArrayConstExpr(IdentEl: TPasElement): boolean;
  13605. begin
  13606. Result:=false;
  13607. if not (IdentEl is TPasVariable) then exit;
  13608. if not (TPasVariable(IdentEl).Expr is TPasExpr) then exit;
  13609. if (IdentEl.ClassType=TPasConst) and TPasConst(IdentEl).IsConst then
  13610. exit(true);
  13611. if fExprEvaluator.IsConst(Params) then
  13612. exit(true); // a const refers an initial value
  13613. end;
  13614. var
  13615. Param: TPasExpr;
  13616. ParamResolved: TPasResolverResult;
  13617. var
  13618. TypeEl: TPasType;
  13619. ArrayEl: TPasArrayType;
  13620. Value: TResEvalValue;
  13621. EnumType: TPasEnumType;
  13622. aSet: TResEvalSet;
  13623. bt: TResolverBaseType;
  13624. Int, MinInt, MaxInt: TMaxPrecInt;
  13625. i: Integer;
  13626. Expr: TPasExpr;
  13627. begin
  13628. Evaluated:=nil;
  13629. Param:=Params.Params[0];
  13630. ComputeElement(Param,ParamResolved,[]);
  13631. TypeEl:=ParamResolved.LoTypeEl;
  13632. if ParamResolved.BaseType=btContext then
  13633. begin
  13634. if TypeEl.ClassType=TPasArrayType then
  13635. begin
  13636. // array: low/high of first dimension
  13637. ArrayEl:=TPasArrayType(TypeEl);
  13638. if length(ArrayEl.Ranges)=0 then
  13639. begin
  13640. // dyn or open array
  13641. if Proc.BuiltIn=bfLow then
  13642. Evaluated:=TResEvalInt.CreateValue(0)
  13643. else if IsDynArrayConstExpr(ParamResolved.IdentEl) then
  13644. begin
  13645. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  13646. if Expr is TArrayValues then
  13647. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
  13648. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  13649. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
  13650. if Evaluated=nil then
  13651. RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
  13652. end
  13653. else
  13654. exit;
  13655. end
  13656. else
  13657. begin
  13658. // static array
  13659. Evaluated:=EvalRangeLimit(ArrayEl.Ranges[0],Flags,Proc.BuiltIn=bfLow,Param);
  13660. end;
  13661. end
  13662. else if TypeEl.ClassType=TPasSetType then
  13663. begin
  13664. // set: first/last enum
  13665. TypeEl:=TPasSetType(TypeEl).EnumType;
  13666. if TypeEl.ClassType=TPasEnumType then
  13667. begin
  13668. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  13669. if Proc.BuiltIn=bfLow then
  13670. Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
  13671. else
  13672. Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
  13673. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  13674. end
  13675. else
  13676. begin
  13677. {$IFDEF VerbosePasResolver}
  13678. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  13679. {$ENDIF}
  13680. RaiseNotYetImplemented(20170601203026,Params);
  13681. end;
  13682. end
  13683. else if TypeEl.ClassType=TPasEnumType then
  13684. begin
  13685. EnumType:=TPasEnumType(TypeEl);
  13686. if Proc.BuiltIn=bfLow then
  13687. i:=0
  13688. else
  13689. i:=EnumType.Values.Count-1;
  13690. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  13691. end;
  13692. end
  13693. else if ParamResolved.BaseType=btSet then
  13694. begin
  13695. Value:=Eval(Param,Flags);
  13696. if Value=nil then exit;
  13697. case Value.Kind of
  13698. revkSetOfInt:
  13699. begin
  13700. aSet:=TResEvalSet(Value);
  13701. if length(aSet.Ranges)=0 then
  13702. RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
  13703. if Proc.BuiltIn=bfLow then
  13704. Int:=aSet.RangeStart
  13705. else
  13706. Int:=aSet.RangeEnd;
  13707. case aSet.ElKind of
  13708. revskEnum:
  13709. begin
  13710. EnumType:=aSet.IdentEl as TPasEnumType;
  13711. Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
  13712. end;
  13713. revskInt:
  13714. Evaluated:=TResEvalInt.CreateValue(Int);
  13715. revskChar:
  13716. {$ifdef FPC_HAS_CPSTRING}
  13717. if Int<256 then
  13718. Evaluated:=TResEvalString.CreateValue(chr(Int))
  13719. else
  13720. {$endif}
  13721. Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
  13722. revskBool:
  13723. if Int=0 then
  13724. Evaluated:=TResEvalBool.CreateValue(false)
  13725. else
  13726. Evaluated:=TResEvalBool.CreateValue(true)
  13727. end;
  13728. end;
  13729. else
  13730. RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
  13731. end;
  13732. end
  13733. else if (TypeEl is TPasUnresolvedSymbolRef)
  13734. and (TypeEl.CustomData is TResElDataBaseType) then
  13735. begin
  13736. // low,high(base type)
  13737. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  13738. bt:=GetActualBaseType(bt);
  13739. if bt in btAllBooleans then
  13740. Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
  13741. {$ifdef HasInt64}
  13742. else if bt=btQWord then
  13743. begin
  13744. if Proc.BuiltIn=bfLow then
  13745. Evaluated:=TResEvalInt.CreateValue(0)
  13746. else
  13747. Evaluated:=TResEvalUInt.CreateValue(High(QWord));
  13748. end
  13749. {$endif}
  13750. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  13751. begin
  13752. if Proc.BuiltIn=bfLow then
  13753. Evaluated:=TResEvalInt.CreateValue(MinInt)
  13754. else
  13755. Evaluated:=TResEvalInt.CreateValue(MaxInt);
  13756. end
  13757. {$ifdef FPC_HAS_CPSTRING}
  13758. else if bt=btAnsiChar then
  13759. begin
  13760. if Proc.BuiltIn=bfLow then
  13761. Evaluated:=TResEvalString.CreateValue(#0)
  13762. else
  13763. Evaluated:=TResEvalString.CreateValue(#255);
  13764. end
  13765. {$endif}
  13766. else if bt=btWideChar then
  13767. begin
  13768. if Proc.BuiltIn=bfLow then
  13769. Evaluated:=TResEvalUTF16.CreateValue(#0)
  13770. else
  13771. Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
  13772. end
  13773. else
  13774. begin
  13775. {$IFDEF VerbosePasResolver}
  13776. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  13777. {$ENDIF}
  13778. RaiseNotYetImplemented(20170602070738,Params);
  13779. end;
  13780. end
  13781. else if ParamResolved.LoTypeEl is TPasRangeType then
  13782. begin
  13783. // e.g. type t = 2..10;
  13784. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
  13785. end
  13786. else
  13787. begin
  13788. {$IFDEF VerbosePasResolver}
  13789. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  13790. {$ENDIF}
  13791. RaiseNotYetImplemented(20170601202353,Params);
  13792. end;
  13793. {$IFDEF VerbosePasResEval}
  13794. {AllowWriteln}
  13795. if Evaluated=nil then
  13796. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
  13797. else
  13798. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
  13799. {AllowWriteln-}
  13800. {$ENDIF}
  13801. end;
  13802. function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
  13803. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13804. // check params of built in proc 'Pred' or 'Succ'
  13805. var
  13806. Params: TParamsExpr;
  13807. Param: TPasExpr;
  13808. ParamResolved: TPasResolverResult;
  13809. begin
  13810. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13811. exit(cIncompatible);
  13812. Params:=TParamsExpr(Expr);
  13813. // first param: enum, range, set, char or integer
  13814. Param:=Params.Params[0];
  13815. ComputeElement(Param,ParamResolved,[]);
  13816. Result:=cIncompatible;
  13817. if CheckIsOrdinal(ParamResolved,Param,false) then
  13818. Result:=cExact;
  13819. if Result=cIncompatible then
  13820. exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
  13821. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  13822. end;
  13823. procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13824. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13825. begin
  13826. ComputeElement(Params.Params[0],ResolvedEl,[]);
  13827. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  13828. if Proc=nil then ;
  13829. end;
  13830. procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  13831. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  13832. var
  13833. Param: TPasExpr;
  13834. begin
  13835. //writeln('TPasResolver.BI_PredSucc_OnEval START');
  13836. Evaluated:=nil;
  13837. Param:=Params.Params[0];
  13838. Evaluated:=Eval(Param,Flags);
  13839. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
  13840. if Evaluated=nil then exit;
  13841. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
  13842. if Evaluated.Element<>nil then
  13843. Evaluated:=Evaluated.Clone;
  13844. if Proc.BuiltIn=bfPred then
  13845. fExprEvaluator.PredValue(Evaluated,Params)
  13846. else
  13847. fExprEvaluator.SuccValue(Evaluated,Params);
  13848. end;
  13849. function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  13850. const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
  13851. ): integer;
  13852. function CheckFormat(FormatExpr: TPasExpr; Index: integer;
  13853. const ParamResolved: TPasResolverResult): boolean;
  13854. var
  13855. ResolvedEl: TPasResolverResult;
  13856. Ok: Boolean;
  13857. begin
  13858. if FormatExpr=nil then exit(true);
  13859. Result:=false;
  13860. Ok:=false;
  13861. if ParamResolved.BaseType in btAllFloats then
  13862. // floats supports value:Width:Precision
  13863. Ok:=true
  13864. else
  13865. // all other only support value:Width
  13866. Ok:=Index<2;
  13867. if not Ok then
  13868. begin
  13869. if RaiseOnError then
  13870. RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
  13871. exit;
  13872. end;
  13873. ComputeElement(FormatExpr,ResolvedEl,[]);
  13874. if not (ResolvedEl.BaseType in btAllInteger) then
  13875. begin
  13876. if RaiseOnError then
  13877. RaiseXExpectedButYFound(20170319221515,
  13878. 'integer',GetResolverResultDescription(ResolvedEl,true),FormatExpr);
  13879. exit;
  13880. end;
  13881. if not (rrfReadable in ResolvedEl.Flags) then
  13882. begin
  13883. if RaiseOnError then
  13884. RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
  13885. exit;
  13886. end;
  13887. Result:=true;
  13888. end;
  13889. var
  13890. TypeEl: TPasType;
  13891. begin
  13892. Result:=cIncompatible;
  13893. if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
  13894. Result:=cExact
  13895. else if IsFunc and (ParamResolved.BaseType in btAllStringAndChars) then
  13896. Result:=cExact
  13897. else if ParamResolved.BaseType=btContext then
  13898. begin
  13899. TypeEl:=ParamResolved.LoTypeEl;
  13900. if TypeEl.ClassType=TPasEnumType then
  13901. Result:=cExact
  13902. end;
  13903. if Result=cIncompatible then
  13904. exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
  13905. if not CheckFormat(Param.format1,1,ParamResolved) then
  13906. exit(cIncompatible);
  13907. if not CheckFormat(Param.format2,2,ParamResolved) then
  13908. exit(cIncompatible);
  13909. end;
  13910. function TPasResolver.BI_StrProc_OnGetCallCompatibility(
  13911. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13912. // check params of built-in procedure 'Str'
  13913. var
  13914. Params: TParamsExpr;
  13915. Param: TPasExpr;
  13916. ParamResolved: TPasResolverResult;
  13917. begin
  13918. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  13919. exit(cIncompatible);
  13920. Params:=TParamsExpr(Expr);
  13921. if ParentNeedsExprResult(Params) then
  13922. begin
  13923. if RaiseOnError then
  13924. RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
  13925. sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
  13926. exit(cIncompatible);
  13927. end;
  13928. // first param: boolean, integer, enum, class instance
  13929. Param:=Params.Params[0];
  13930. ComputeElement(Param,ParamResolved,[]);
  13931. Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
  13932. if Result=cIncompatible then
  13933. exit;
  13934. // second parameter: string variable
  13935. Param:=Params.Params[1];
  13936. ComputeElement(Param,ParamResolved,[]);
  13937. Result:=cIncompatible;
  13938. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  13939. begin
  13940. if ParamResolved.BaseType in btAllStrings then
  13941. Result:=cExact;
  13942. end;
  13943. if Result=cIncompatible then
  13944. exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
  13945. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  13946. end;
  13947. procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  13948. Params: TParamsExpr);
  13949. var
  13950. P: TPasExprArray;
  13951. begin
  13952. if Proc=nil then ;
  13953. P:=Params.Params;
  13954. if P=nil then ;
  13955. FinishCallArgAccess(P[0],rraRead);
  13956. FinishCallArgAccess(P[1],rraVarParam);
  13957. end;
  13958. function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
  13959. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  13960. var
  13961. Params: TParamsExpr;
  13962. Param: TPasExpr;
  13963. ParamResolved: TPasResolverResult;
  13964. i: Integer;
  13965. begin
  13966. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  13967. exit(cIncompatible);
  13968. Params:=TParamsExpr(Expr);
  13969. if not ParentNeedsExprResult(Params) then
  13970. begin
  13971. // not in an expression -> the 'procedure str' is needed, not the 'function str'
  13972. if RaiseOnError then
  13973. RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
  13974. sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
  13975. exit(cIncompatible);
  13976. end;
  13977. // param: string, boolean, integer, enum, class instance
  13978. for i:=0 to length(Params.Params)-1 do
  13979. begin
  13980. Param:=Params.Params[i];
  13981. ComputeElement(Param,ParamResolved,[]);
  13982. Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
  13983. if Result=cIncompatible then
  13984. exit;
  13985. end;
  13986. Result:=cExact;
  13987. end;
  13988. procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  13989. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  13990. begin
  13991. SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,
  13992. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable]);
  13993. if Params=nil then ;
  13994. if Proc=nil then ;
  13995. end;
  13996. procedure TPasResolver.BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  13997. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  13998. begin
  13999. Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
  14000. if Proc=nil then ;
  14001. end;
  14002. function TPasResolver.BI_WriteStrProc_OnGetCallCompatibility(
  14003. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14004. // check params of built-in procedure 'Str'
  14005. var
  14006. Params: TParamsExpr;
  14007. Param: TPasExpr;
  14008. ParamResolved: TPasResolverResult;
  14009. i: Integer;
  14010. begin
  14011. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  14012. exit(cIncompatible);
  14013. Params:=TParamsExpr(Expr);
  14014. // first parameter: string variable
  14015. Param:=Params.Params[0];
  14016. ComputeElement(Param,ParamResolved,[]);
  14017. Result:=cIncompatible;
  14018. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14019. begin
  14020. if ParamResolved.BaseType in btAllStrings then
  14021. Result:=cExact;
  14022. end;
  14023. if Result=cIncompatible then
  14024. exit(CheckRaiseTypeArgNo(20180527190304,1,Param,ParamResolved,'string variable',RaiseOnError));
  14025. // other parameters: boolean, integer, enum, class instance
  14026. for i:=1 to length(Params.Params)-1 do
  14027. begin
  14028. Param:=Params.Params[i];
  14029. ComputeElement(Param,ParamResolved,[]);
  14030. Result:=BI_Str_CheckParam(false,Param,ParamResolved,i,RaiseOnError);
  14031. if Result=cIncompatible then
  14032. exit;
  14033. end;
  14034. end;
  14035. procedure TPasResolver.BI_WriteStrProc_OnFinishParamsExpr(
  14036. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14037. var
  14038. P: TPasExprArray;
  14039. i: Integer;
  14040. begin
  14041. if Proc=nil then ;
  14042. P:=Params.Params;
  14043. if P=nil then ;
  14044. FinishCallArgAccess(P[0],rraOutParam);
  14045. for i:=0 to length(Params.Params)-1 do
  14046. FinishCallArgAccess(P[i],rraRead);
  14047. end;
  14048. function TPasResolver.BI_Val_OnGetCallCompatibility(
  14049. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14050. // check params of built-in procedure 'Val(const s: string; out v: valtype; out code: integer)'
  14051. var
  14052. Params: TParamsExpr;
  14053. Param: TPasExpr;
  14054. ParamResolved: TPasResolverResult;
  14055. begin
  14056. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  14057. exit(cIncompatible);
  14058. Params:=TParamsExpr(Expr);
  14059. // first parameter: string
  14060. Param:=Params.Params[0];
  14061. ComputeElement(Param,ParamResolved,[]);
  14062. Result:=cIncompatible;
  14063. if ParamResolved.BaseType in btAllStrings then
  14064. Result:=cExact;
  14065. if Result=cIncompatible then
  14066. exit(CheckRaiseTypeArgNo(20181214141250,1,Param,ParamResolved,'string',RaiseOnError));
  14067. // second parameter: var value
  14068. Param:=Params.Params[1];
  14069. ComputeElement(Param,ParamResolved,[]);
  14070. Result:=cIncompatible;
  14071. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14072. begin
  14073. if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
  14074. Result:=cExact
  14075. else if ParamResolved.BaseType=btContext then
  14076. begin
  14077. if ParamResolved.LoTypeEl is TPasEnumType then
  14078. Result:=cExact;
  14079. end;
  14080. end;
  14081. if Result=cIncompatible then
  14082. exit(CheckRaiseTypeArgNo(20181214141704,2,Param,ParamResolved,
  14083. 'boolean/integer/float/enum variable',RaiseOnError));
  14084. // third parameter: out Code: integer
  14085. Param:=Params.Params[2];
  14086. ComputeElement(Param,ParamResolved,[]);
  14087. Result:=cIncompatible;
  14088. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14089. begin
  14090. if ParamResolved.BaseType in btAllInteger then
  14091. Result:=cExact;
  14092. end;
  14093. if Result=cIncompatible then
  14094. exit(CheckRaiseTypeArgNo(20181214141511,3,Param,ParamResolved,'integer variable',RaiseOnError));
  14095. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  14096. end;
  14097. procedure TPasResolver.BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  14098. Params: TParamsExpr);
  14099. var
  14100. P: TPasExprArray;
  14101. begin
  14102. if Proc=nil then ;
  14103. P:=Params.Params;
  14104. if P=nil then ;
  14105. FinishCallArgAccess(P[0],rraRead);
  14106. FinishCallArgAccess(P[1],rraOutParam);
  14107. FinishCallArgAccess(P[2],rraOutParam);
  14108. end;
  14109. function TPasResolver.BI_LoHi_OnGetCallCompatibility(
  14110. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14111. var
  14112. Params: TParamsExpr;
  14113. Param: TPasExpr;
  14114. ParamResolved: TPasResolverResult;
  14115. begin
  14116. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14117. Exit(cIncompatible);
  14118. Params:=TParamsExpr(Expr);
  14119. // first Param: any integer type
  14120. Param:=Params.params[0];
  14121. ComputeElement(Param,ParamResolved,[]);
  14122. Result:=cIncompatible;
  14123. if (rrfReadable in ParamResolved.Flags)
  14124. and (ParamResolved.BaseType in btAllInteger)
  14125. then
  14126. Result:=cExact;
  14127. if Result=cIncompatible then
  14128. Exit(CheckRaiseTypeArgNo(20190128232600,1,Param,ParamResolved,'integer type',RaiseOnError));
  14129. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  14130. end;
  14131. procedure TPasResolver.BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  14132. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  14133. var
  14134. ResolvedParam: TPasResolverResult;
  14135. BaseType: TResolverBaseType;
  14136. Mask: LongWord;
  14137. begin
  14138. ComputeElement(Params.Params[0],ResolvedParam,[]);
  14139. GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  14140. case Mask of
  14141. $F, $FF: BaseType := btByte;
  14142. $FFFF: BaseType := btWord;
  14143. else { $FFFFFFFF } BaseType := btLongWord;
  14144. end;
  14145. SetResolverIdentifier(ResolvedEl,BaseType,Proc.Proc,
  14146. FBaseTypes[BaseType],FBaseTypes[BaseType],[rrfReadable]);
  14147. end;
  14148. procedure TPasResolver.BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  14149. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  14150. var
  14151. Param: TPasExpr;
  14152. ResolvedParam: TPasResolverResult;
  14153. Value: TResEvalValue;
  14154. Shift: Integer;
  14155. Mask: LongWord;
  14156. begin
  14157. Evaluated := nil;
  14158. Param := Params.Params[0];
  14159. Value := Eval(Param,Flags);
  14160. {$IFDEF VerbosePasResEval}
  14161. {AllowWriteln}
  14162. if value=nil then
  14163. writeln('TPasResolver.BI_LoHi_OnEval Value=NIL')
  14164. else
  14165. writeln('TPasResolver.BI_LoHi_OnEval Value=',value.AsDebugString);
  14166. {AllowWriteln-}
  14167. {$ENDIF}
  14168. if Value=nil then exit;
  14169. try
  14170. ComputeElement(Param,ResolvedParam,[]);
  14171. Shift := GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  14172. Evaluated := fExprEvaluator.LoHiValue(Value,Shift,Mask,Params);
  14173. finally
  14174. ReleaseEvalValue(Value);
  14175. end;
  14176. end;
  14177. function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
  14178. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14179. var
  14180. Params: TParamsExpr;
  14181. Param: TPasExpr;
  14182. ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
  14183. i: Integer;
  14184. ArrType: TPasArrayType;
  14185. ElType: TPasType;
  14186. begin
  14187. Result:=cIncompatible;
  14188. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14189. exit;
  14190. Params:=TParamsExpr(Expr);
  14191. FirstElTypeResolved:=Default(TPasResolverResult);
  14192. for i:=0 to length(Params.Params)-1 do
  14193. begin
  14194. // all params: array
  14195. Param:=Params.Params[i];
  14196. ComputeElement(Param,ParamResolved,[]);
  14197. ElTypeResolved:=default(TPasResolverResult);
  14198. if rrfReadable in ParamResolved.Flags then
  14199. begin
  14200. if ParamResolved.BaseType=btContext then
  14201. begin
  14202. if IsDynArray(ParamResolved.LoTypeEl) then
  14203. begin
  14204. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  14205. ElType:=GetArrayElType(ArrType);
  14206. ComputeElement(ElType,ElTypeResolved,[rcType]);
  14207. end;
  14208. end
  14209. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  14210. SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
  14211. ParamResolved.LoTypeEl,ParamResolved.HiTypeEl,Param,ParamResolved.Flags);
  14212. end;
  14213. if ElTypeResolved.BaseType=btNone then
  14214. exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
  14215. Include(ElTypeResolved.Flags,rrfReadable);
  14216. if i=0 then
  14217. begin
  14218. FirstElTypeResolved:=ElTypeResolved;
  14219. Include(FirstElTypeResolved.Flags,rrfWritable);
  14220. end
  14221. else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
  14222. exit(cIncompatible);
  14223. end;
  14224. Result:=cExact;
  14225. end;
  14226. procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
  14227. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  14228. ResolvedEl: TPasResolverResult);
  14229. begin
  14230. ComputeElement(Params.Params[0],ResolvedEl,[]);
  14231. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  14232. ResolvedEl.ExprEl:=Params;
  14233. ResolvedEl.IdentEl:=nil;
  14234. if ResolvedEl.BaseType=btArrayOrSet then
  14235. ResolvedEl.BaseType:=btArrayLit;
  14236. if Proc=nil then ;
  14237. end;
  14238. function TPasResolver.BI_ConcatString_OnGetCallCompatibility(
  14239. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14240. var
  14241. Params: TParamsExpr;
  14242. i: Integer;
  14243. Param: TPasExpr;
  14244. ParamResolved: TPasResolverResult;
  14245. begin
  14246. Result:=cIncompatible;
  14247. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14248. exit;
  14249. Params:=TParamsExpr(Expr);
  14250. for i:=0 to length(Params.Params)-1 do
  14251. begin
  14252. // all params: char or string
  14253. Param:=Params.Params[i];
  14254. ComputeElement(Param,ParamResolved,[]);
  14255. if not (rrfReadable in ParamResolved.Flags)
  14256. or not (ParamResolved.BaseType in btAllStringAndChars) then
  14257. exit(CheckRaiseTypeArgNo(20181219230329,i+1,Param,ParamResolved,'string',RaiseOnError));
  14258. end;
  14259. Result:=cExact;
  14260. end;
  14261. procedure TPasResolver.BI_ConcatString_OnGetCallResult(
  14262. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  14263. ResolvedEl: TPasResolverResult);
  14264. var
  14265. i: Integer;
  14266. Param: TPasExpr;
  14267. ParamResolved, CombinedResolved: TPasResolverResult;
  14268. ParamsArr: TPasExprArray;
  14269. begin
  14270. if Proc=nil then ;
  14271. ParamsArr:=Params.Params;
  14272. for i:=0 to length(ParamsArr)-1 do
  14273. begin
  14274. // all params: char or string
  14275. Param:=ParamsArr[i];
  14276. ComputeElement(Param,ParamResolved,[]);
  14277. if i=0 then
  14278. ResolvedEl:=ParamResolved
  14279. else
  14280. begin
  14281. ComputeAddStringRes(ResolvedEl,ParamResolved,Params,CombinedResolved);
  14282. ResolvedEl:=CombinedResolved;
  14283. end;
  14284. end;
  14285. end;
  14286. procedure TPasResolver.BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  14287. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  14288. var
  14289. i: Integer;
  14290. Param: TPasExpr;
  14291. Value, NewValue: TResEvalValue;
  14292. ok: Boolean;
  14293. begin
  14294. if Proc=nil then ;
  14295. Value:=nil;
  14296. Evaluated:=nil;
  14297. ok:=false;
  14298. try
  14299. for i:=0 to length(Params.Params)-1 do
  14300. begin
  14301. // all params: char or string
  14302. Param:=Params.Params[i];
  14303. Value:=Eval(Param,Flags);
  14304. if Value=nil then
  14305. exit;
  14306. if i=0 then
  14307. begin
  14308. Evaluated:=Value;
  14309. Value:=nil;
  14310. end
  14311. else
  14312. begin
  14313. NewValue:=ExprEvaluator.EvalStringAddExpr(Param,Params.Params[i-1],Param,
  14314. Evaluated,Value);
  14315. ReleaseEvalValue(Evaluated);
  14316. Evaluated:=NewValue;
  14317. ReleaseEvalValue(Value);
  14318. end;
  14319. end;
  14320. ok:=true;
  14321. finally
  14322. ReleaseEvalValue(Value);
  14323. if not ok then
  14324. ReleaseEvalValue(Evaluated);
  14325. end;
  14326. end;
  14327. function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
  14328. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14329. var
  14330. Params: TParamsExpr;
  14331. Param: TPasExpr;
  14332. ParamResolved: TPasResolverResult;
  14333. begin
  14334. Result:=cIncompatible;
  14335. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14336. exit;
  14337. Params:=TParamsExpr(Expr);
  14338. // first param: array
  14339. Param:=Params.Params[0];
  14340. ComputeElement(Param,ParamResolved,[]);
  14341. if rrfReadable in ParamResolved.Flags then
  14342. begin
  14343. if ParamResolved.BaseType=btContext then
  14344. begin
  14345. if IsDynArray(ParamResolved.LoTypeEl) then
  14346. Result:=cExact;
  14347. end
  14348. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  14349. Result:=cExact;
  14350. end;
  14351. if Result=cIncompatible then
  14352. exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  14353. if length(Params.Params)=1 then
  14354. exit(cExact);
  14355. // check optional Start index
  14356. Param:=Params.Params[1];
  14357. ComputeElement(Param,ParamResolved,[]);
  14358. if not (rrfReadable in ParamResolved.Flags)
  14359. or not (ParamResolved.BaseType in btAllInteger) then
  14360. exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
  14361. if length(Params.Params)=2 then
  14362. exit(cExact);
  14363. // check optional Count
  14364. Param:=Params.Params[2];
  14365. ComputeElement(Param,ParamResolved,[]);
  14366. if not (rrfReadable in ParamResolved.Flags)
  14367. or not (ParamResolved.BaseType in btAllInteger) then
  14368. exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
  14369. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  14370. end;
  14371. procedure TPasResolver.BI_CopyArray_OnGetCallResult(
  14372. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  14373. ResolvedEl: TPasResolverResult);
  14374. begin
  14375. if Proc=nil then ;
  14376. ComputeElement(Params.Params[0],ResolvedEl,[]);
  14377. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  14378. ResolvedEl.ExprEl:=Params;
  14379. ResolvedEl.IdentEl:=nil;
  14380. if ResolvedEl.BaseType=btArrayOrSet then
  14381. ResolvedEl.BaseType:=btArrayLit;
  14382. end;
  14383. function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
  14384. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14385. // Insert(Item,var Array,Index)
  14386. var
  14387. Params: TParamsExpr;
  14388. Param, ItemParam: TPasExpr;
  14389. ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
  14390. ArrType: TPasArrayType;
  14391. ElType: TPasType;
  14392. begin
  14393. Result:=cIncompatible;
  14394. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  14395. exit;
  14396. Params:=TParamsExpr(Expr);
  14397. // check Item
  14398. ItemParam:=Params.Params[0];
  14399. ComputeElement(ItemParam,ItemResolved,[]);
  14400. if not (rrfReadable in ItemResolved.Flags) then
  14401. exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
  14402. // check Array
  14403. Param:=Params.Params[1];
  14404. ComputeElement(Param,ParamResolved,[]);
  14405. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14406. begin
  14407. if RaiseOnError then
  14408. RaiseVarExpected(20170329171514,Param,ParamResolved.IdentEl);
  14409. exit;
  14410. end;
  14411. if (ParamResolved.BaseType<>btContext)
  14412. or not IsDynArray(ParamResolved.LoTypeEl) then
  14413. exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
  14414. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  14415. ElType:=GetArrayElType(ArrType);
  14416. ComputeElement(ElType,ElTypeResolved,[rcType]);
  14417. if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
  14418. exit(cIncompatible);
  14419. // check insert Index
  14420. Param:=Params.Params[2];
  14421. ComputeElement(Param,ParamResolved,[]);
  14422. if not (rrfReadable in ParamResolved.Flags)
  14423. or not (ParamResolved.BaseType in btAllInteger) then
  14424. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  14425. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  14426. end;
  14427. procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
  14428. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14429. var
  14430. P: TPasExprArray;
  14431. Param0, Param1: TPasExpr;
  14432. ArrayResolved, ElTypeResolved: TPasResolverResult;
  14433. ElType: TPasType;
  14434. begin
  14435. if Proc=nil then ;
  14436. P:=Params.Params;
  14437. Param0:=P[0];
  14438. Param1:=P[1];
  14439. FinishCallArgAccess(Param0,rraRead);
  14440. FinishCallArgAccess(Param1,rraVarParam);
  14441. FinishCallArgAccess(P[2],rraRead);
  14442. if not (Param0 is TPrimitiveExpr) then
  14443. begin
  14444. // insert complex expression, e.g. insert([1],Arr,index)
  14445. // -> mark array and set literals
  14446. ComputeElement(Param1,ArrayResolved,[]);
  14447. if (ArrayResolved.BaseType<>btContext)
  14448. or not IsDynArray(ArrayResolved.LoTypeEl) then
  14449. RaiseNotYetImplemented(20180622144039,Param1);
  14450. ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
  14451. ComputeElement(ElType,ElTypeResolved,[rcType]);
  14452. if (ElTypeResolved.BaseType=btContext)
  14453. and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
  14454. MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
  14455. end;
  14456. end;
  14457. function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
  14458. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14459. // Delete(var Array; Start, Count: integer)
  14460. var
  14461. Params: TParamsExpr;
  14462. Param: TPasExpr;
  14463. ParamResolved: TPasResolverResult;
  14464. begin
  14465. Result:=cIncompatible;
  14466. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  14467. exit;
  14468. Params:=TParamsExpr(Expr);
  14469. // check Array
  14470. Param:=Params.Params[0];
  14471. ComputeElement(Param,ParamResolved,[]);
  14472. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14473. begin
  14474. if RaiseOnError then
  14475. RaiseVarExpected(20170329173421,Param,ParamResolved.IdentEl);
  14476. exit;
  14477. end;
  14478. if (ParamResolved.BaseType<>btContext)
  14479. or not IsDynArray(ParamResolved.LoTypeEl) then
  14480. exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  14481. // check param Start
  14482. Param:=Params.Params[1];
  14483. ComputeElement(Param,ParamResolved,[]);
  14484. if not (rrfReadable in ParamResolved.Flags)
  14485. or not (ParamResolved.BaseType in btAllInteger) then
  14486. exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
  14487. // check param Count
  14488. Param:=Params.Params[2];
  14489. ComputeElement(Param,ParamResolved,[]);
  14490. if not (rrfReadable in ParamResolved.Flags)
  14491. or not (ParamResolved.BaseType in btAllInteger) then
  14492. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  14493. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  14494. end;
  14495. procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
  14496. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14497. var
  14498. P: TPasExprArray;
  14499. begin
  14500. if Proc=nil then ;
  14501. P:=Params.Params;
  14502. if P=nil then ;
  14503. FinishCallArgAccess(P[0],rraVarParam);
  14504. FinishCallArgAccess(P[1],rraRead);
  14505. FinishCallArgAccess(P[2],rraRead);
  14506. end;
  14507. function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
  14508. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14509. var
  14510. Params: TParamsExpr;
  14511. Param: TPasExpr;
  14512. Decl: TPasElement;
  14513. ParamResolved: TPasResolverResult;
  14514. aType: TPasType;
  14515. begin
  14516. Result:=cIncompatible;
  14517. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14518. exit;
  14519. Params:=TParamsExpr(Expr);
  14520. // check type or var
  14521. Param:=Params.Params[0];
  14522. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14523. Decl:=ParamResolved.IdentEl;
  14524. aType:=nil;
  14525. if (Decl<>nil) then
  14526. begin
  14527. if Decl is TPasType then
  14528. aType:=TPasType(Decl)
  14529. else if Decl is TPasVariable then
  14530. aType:=TPasVariable(Decl).VarType
  14531. else if Decl.ClassType=TPasArgument then
  14532. aType:=TPasArgument(Decl).ArgType
  14533. else if Decl.ClassType=TPasResultElement then
  14534. aType:=TPasResultElement(Decl).ResultType
  14535. else if (Decl is TPasProcedure)
  14536. and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
  14537. aType:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
  14538. {$IFDEF VerbosePasResolver}
  14539. {AllowWriteln}
  14540. if aType=nil then
  14541. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility Decl=',GetObjName(Decl));
  14542. {AllowWriteln-}
  14543. {$ENDIF}
  14544. end;
  14545. if aType=nil then
  14546. begin
  14547. {$IFDEF VerbosePasResolver}
  14548. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  14549. {$ENDIF}
  14550. RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  14551. end;
  14552. aType:=ResolveAliasType(aType);
  14553. if not HasTypeInfo(aType) then
  14554. RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
  14555. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  14556. end;
  14557. procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  14558. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  14559. begin
  14560. if Proc=nil then;
  14561. if Params=nil then ;
  14562. SetResolverTypeExpr(ResolvedEl,btPointer,
  14563. FBaseTypes[btPointer],FBaseTypes[btPointer],[rrfReadable]);
  14564. end;
  14565. function TPasResolver.BI_Assert_OnGetCallCompatibility(
  14566. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14567. // check params of built-in procedure 'Assert'
  14568. // Assert(bool)
  14569. // Assert(bool,string)
  14570. var
  14571. Params: TParamsExpr;
  14572. Param: TPasExpr;
  14573. ParamResolved: TPasResolverResult;
  14574. begin
  14575. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14576. exit(cIncompatible);
  14577. Params:=TParamsExpr(Expr);
  14578. // first param: boolean
  14579. Param:=Params.Params[0];
  14580. ComputeElement(Param,ParamResolved,[]);
  14581. if not (rrfReadable in ParamResolved.Flags)
  14582. or not (ParamResolved.BaseType in btAllBooleans) then
  14583. exit(CheckRaiseTypeArgNo(20180117123819,1,Param,ParamResolved,'boolean',RaiseOnError));
  14584. // optional second parameter: string
  14585. if length(Params.Params)>1 then
  14586. begin
  14587. Param:=Params.Params[1];
  14588. ComputeElement(Param,ParamResolved,[]);
  14589. if not (rrfReadable in ParamResolved.Flags)
  14590. or not (ParamResolved.BaseType in btAllStringAndChars) then
  14591. exit(CheckRaiseTypeArgNo(20180117123932,2,Param,ParamResolved,'string',RaiseOnError));
  14592. end;
  14593. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  14594. end;
  14595. procedure TPasResolver.BI_Assert_OnFinishParamsExpr(
  14596. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14597. begin
  14598. FinishAssertCall(Proc,Params);
  14599. end;
  14600. function TPasResolver.BI_New_OnGetCallCompatibility(
  14601. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14602. var
  14603. Params: TParamsExpr;
  14604. Param: TPasExpr;
  14605. TypeEl, SubTypeEl: TPasType;
  14606. ParamResolved: TPasResolverResult;
  14607. begin
  14608. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14609. exit(cIncompatible);
  14610. Params:=TParamsExpr(Expr);
  14611. // first param: var PRecord
  14612. Param:=Params.Params[0];
  14613. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14614. {$IFDEF VerbosePasResolver}
  14615. writeln('TPasResolver.BI_New_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  14616. {$ENDIF}
  14617. Result:=cIncompatible;
  14618. // Expr must be a variable
  14619. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  14620. begin
  14621. if RaiseOnError then
  14622. RaiseVarExpected(20180425005303,Expr,ParamResolved.IdentEl);
  14623. exit;
  14624. end;
  14625. if ParamResolved.BaseType=btContext then
  14626. begin
  14627. TypeEl:=ParamResolved.LoTypeEl;
  14628. if TypeEl.ClassType=TPasPointerType then
  14629. begin
  14630. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  14631. if SubTypeEl.ClassType=TPasRecordType then
  14632. Result:=cExact;
  14633. end;
  14634. end;
  14635. if Result=cIncompatible then
  14636. exit(CheckRaiseTypeArgNo(20180425005421,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  14637. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  14638. end;
  14639. procedure TPasResolver.BI_New_OnFinishParamsExpr(
  14640. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14641. begin
  14642. if Proc=nil then ;
  14643. FinishCallArgAccess(Params.Params[0],rraOutParam);
  14644. end;
  14645. function TPasResolver.BI_Dispose_OnGetCallCompatibility(
  14646. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14647. var
  14648. Params: TParamsExpr;
  14649. Param: TPasExpr;
  14650. TypeEl, SubTypeEl: TPasType;
  14651. ParamResolved: TPasResolverResult;
  14652. begin
  14653. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14654. exit(cIncompatible);
  14655. Params:=TParamsExpr(Expr);
  14656. // first param: var PRecord
  14657. Param:=Params.Params[0];
  14658. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14659. {$IFDEF VerbosePasResolver}
  14660. writeln('TPasResolver.BI_Dispose_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  14661. {$ENDIF}
  14662. Result:=cIncompatible;
  14663. if (rrfReadable in ParamResolved.Flags) then
  14664. if ParamResolved.BaseType=btContext then
  14665. begin
  14666. TypeEl:=ParamResolved.LoTypeEl;
  14667. if TypeEl.ClassType=TPasPointerType then
  14668. begin
  14669. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  14670. if SubTypeEl.ClassType=TPasRecordType then
  14671. Result:=cExact;
  14672. end;
  14673. end;
  14674. if Result=cIncompatible then
  14675. exit(CheckRaiseTypeArgNo(20180425010620,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  14676. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  14677. end;
  14678. procedure TPasResolver.BI_Dispose_OnFinishParamsExpr(
  14679. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  14680. begin
  14681. if Proc=nil then ;
  14682. FinishCallArgAccess(Params.Params[0],rraRead);
  14683. end;
  14684. function TPasResolver.BI_Default_OnGetCallCompatibility(
  14685. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  14686. var
  14687. Params: TParamsExpr;
  14688. Param: TPasExpr;
  14689. ParamResolved: TPasResolverResult;
  14690. Decl: TPasElement;
  14691. aType: TPasType;
  14692. begin
  14693. Result:=cIncompatible;
  14694. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  14695. exit;
  14696. Params:=TParamsExpr(Expr);
  14697. // check type or var
  14698. Param:=Params.Params[0];
  14699. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14700. Decl:=ParamResolved.IdentEl;
  14701. aType:=nil;
  14702. if (Decl<>nil) and (ParamResolved.LoTypeEl<>nil) then
  14703. begin
  14704. if Decl is TPasType then
  14705. aType:=TPasType(Decl)
  14706. else if Decl is TPasVariable then
  14707. aType:=TPasVariable(Decl).VarType
  14708. else if Decl.ClassType=TPasArgument then
  14709. aType:=TPasArgument(Decl).ArgType;
  14710. {$IFDEF VerbosePasResolver}
  14711. {AllowWriteln}
  14712. if aType=nil then
  14713. writeln('TPasResolver.BI_Default_OnGetCallCompatibility Decl=',GetObjName(Decl));
  14714. {AllowWriteln-}
  14715. {$ENDIF}
  14716. end;
  14717. if aType=nil then
  14718. begin
  14719. {$IFDEF VerbosePasResolver}
  14720. writeln('TPasResolver.BI_Default_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  14721. {$ENDIF}
  14722. RaiseMsg(20180501004009,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  14723. end;
  14724. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  14725. end;
  14726. procedure TPasResolver.BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  14727. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  14728. var
  14729. Param: TPasExpr;
  14730. begin
  14731. if Proc=nil then ;
  14732. Param:=Params.Params[0];
  14733. ComputeElement(Param,ResolvedEl,[rcNoImplicitProc]);
  14734. ResolvedEl.Flags:=[rrfReadable];
  14735. ResolvedEl.IdentEl:=nil;
  14736. end;
  14737. procedure TPasResolver.BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  14738. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  14739. var
  14740. Param: TPasExpr;
  14741. ParamResolved: TPasResolverResult;
  14742. TypeEl: TPasType;
  14743. EnumType: TPasEnumType;
  14744. i: Integer;
  14745. ArrayEl: TPasArrayType;
  14746. bt: TResolverBaseType;
  14747. MinInt, MaxInt: TMaxPrecInt;
  14748. begin
  14749. if Proc=nil then ;
  14750. Evaluated:=nil;
  14751. Param:=Params.Params[0];
  14752. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14753. TypeEl:=ParamResolved.LoTypeEl;
  14754. if ParamResolved.BaseType=btContext then
  14755. begin
  14756. if TypeEl.ClassType=TPasArrayType then
  14757. begin
  14758. // array: []
  14759. RaiseNotYetImplemented(20180501005214,Param);
  14760. ArrayEl:=TPasArrayType(TypeEl);
  14761. if length(ArrayEl.Ranges)=0 then
  14762. begin
  14763. // dyn or open array
  14764. end
  14765. else
  14766. begin
  14767. // static array
  14768. end;
  14769. end
  14770. else if TypeEl.ClassType=TPasSetType then
  14771. begin
  14772. // set: first/last enum
  14773. TypeEl:=TPasSetType(TypeEl).EnumType;
  14774. if TypeEl.ClassType=TPasEnumType then
  14775. begin
  14776. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  14777. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,EnumType);
  14778. end
  14779. else
  14780. begin
  14781. {$IFDEF VerbosePasResolver}
  14782. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  14783. {$ENDIF}
  14784. RaiseNotYetImplemented(20180501005348,Params);
  14785. end;
  14786. end
  14787. else if TypeEl.ClassType=TPasEnumType then
  14788. begin
  14789. EnumType:=TPasEnumType(TypeEl);
  14790. i:=0;
  14791. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  14792. end;
  14793. end
  14794. else if (TypeEl is TPasUnresolvedSymbolRef)
  14795. and (TypeEl.CustomData is TResElDataBaseType) then
  14796. begin
  14797. // default(base type)
  14798. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  14799. bt:=GetActualBaseType(bt);
  14800. if bt in btAllBooleans then
  14801. Evaluated:=TResEvalBool.CreateValue(false)
  14802. {$ifdef HasInt64}
  14803. else if bt=btQWord then
  14804. Evaluated:=TResEvalInt.CreateValue(0)
  14805. {$endif}
  14806. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  14807. Evaluated:=TResEvalInt.CreateValue(MinInt)
  14808. {$ifdef FPC_HAS_CPSTRING}
  14809. else if bt in [btAnsiString,btShortString] then
  14810. Evaluated:=TResEvalString.CreateValue('')
  14811. {$endif}
  14812. else if bt in [btUnicodeString,btWideString] then
  14813. Evaluated:=TResEvalUTF16.CreateValue('')
  14814. {$ifdef FPC_HAS_CPSTRING}
  14815. else if bt=btAnsiChar then
  14816. Evaluated:=TResEvalString.CreateValue(#0)
  14817. {$endif}
  14818. else if bt=btWideChar then
  14819. Evaluated:=TResEvalUTF16.CreateValue(#0)
  14820. else if bt in btAllFloats then
  14821. Evaluated:=TResEvalFloat.CreateValue(0.0)
  14822. else
  14823. begin
  14824. {$IFDEF VerbosePasResolver}
  14825. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  14826. {$ENDIF}
  14827. RaiseNotYetImplemented(20180501005645,Params);
  14828. end;
  14829. end
  14830. else if ParamResolved.LoTypeEl is TPasRangeType then
  14831. begin
  14832. // e.g. type t = 2..10;
  14833. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,true,Param);
  14834. end
  14835. else if ParamResolved.BaseType=btSet then
  14836. begin
  14837. if ParamResolved.SubType=btContext then
  14838. begin
  14839. if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
  14840. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,TPasEnumType(ParamResolved.LoTypeEl))
  14841. else
  14842. begin
  14843. {$IFDEF VerbosePasResolver}
  14844. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  14845. {$ENDIF}
  14846. RaiseNotYetImplemented(20180501125138,Param);
  14847. end;
  14848. end
  14849. else
  14850. begin
  14851. {$IFDEF VerbosePasResolver}
  14852. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  14853. {$ENDIF}
  14854. RaiseNotYetImplemented(20180501125014,Param);
  14855. end;
  14856. end
  14857. else
  14858. begin
  14859. {$IFDEF VerbosePasResolver}
  14860. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  14861. {$ENDIF}
  14862. RaiseNotYetImplemented(20180501004839,Param);
  14863. end;
  14864. end;
  14865. constructor TPasResolver.Create;
  14866. begin
  14867. inherited Create;
  14868. FDefaultScope:=TPasDefaultScope.Create;
  14869. FPendingForwardProcs:=TFPList.Create;
  14870. FBaseTypeChar:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  14871. FBaseTypeString:={$ifdef FPC_HAS_CPSTRING}btAnsiString{$else}btUnicodeString{$endif};
  14872. FBaseTypeExtended:=btDouble;
  14873. FBaseTypeLength:={$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  14874. FDynArrayMinIndex:=0;
  14875. FDynArrayMaxIndex:=High(TMaxPrecInt);
  14876. cTGUIDToString:=cTypeConversion+1;
  14877. cStringToTGUID:=cTypeConversion+1;
  14878. cInterfaceToTGUID:=cTypeConversion+1;
  14879. cInterfaceToString:=cTypeConversion+2;
  14880. FScopeClass_Class:=TPasClassScope;
  14881. FScopeClass_InitialFinalization:=TPasInitialFinalizationScope;
  14882. FScopeClass_Module:=TPasModuleScope;
  14883. FScopeClass_Proc:=TPasProcedureScope;
  14884. FScopeClass_Section:=TPasSectionScope;
  14885. FScopeClass_WithExpr:=TPasWithExprScope;
  14886. fExprEvaluator:=TResExprEvaluator.Create;
  14887. fExprEvaluator.OnLog:=@OnExprEvalLog;
  14888. fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
  14889. fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
  14890. fExprEvaluator.OnRangeCheckEl:=@OnRangeCheckEl;
  14891. PushScope(FDefaultScope);
  14892. end;
  14893. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  14894. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  14895. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  14896. var
  14897. aScanner: TPascalScanner;
  14898. SrcPos: TPasSourcePos;
  14899. begin
  14900. // get source position for good error messages
  14901. aScanner:=CurrentParser.Scanner;
  14902. if (ASourceFilename='') or StoreSrcColumns then
  14903. begin
  14904. SrcPos.FileName:=aScanner.CurFilename;
  14905. SrcPos.Row:=aScanner.CurRow;
  14906. SrcPos.Column:=aScanner.CurColumn;
  14907. end
  14908. else
  14909. begin
  14910. SrcPos.FileName:=ASourceFilename;
  14911. SrcPos.Row:=ASourceLinenumber;
  14912. SrcPos.Column:=0;
  14913. end;
  14914. Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
  14915. end;
  14916. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  14917. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  14918. const ASrcPos: TPasSourcePos): TPasElement;
  14919. var
  14920. El: TPasElement;
  14921. SrcY: integer;
  14922. SectionScope: TPasSectionScope;
  14923. begin
  14924. {$IFDEF VerbosePasResolver}
  14925. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  14926. {$ENDIF}
  14927. if (AParent=nil) and (FRootElement<>nil) then
  14928. RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
  14929. if ASrcPos.FileName='' then
  14930. begin
  14931. {$IFDEF VerbosePasResolver}
  14932. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  14933. {$ENDIF}
  14934. RaiseInternalError(20160922163541,'missing filename');
  14935. end;
  14936. SrcY:=ASrcPos.Row;
  14937. if StoreSrcColumns then
  14938. SrcY:=MangleSourceLineNumber(SrcY,ASrcPos.Column);
  14939. if AClass=TSelfExpr then
  14940. RaiseInternalError(20190131154235);
  14941. // create element
  14942. El:=AClass.Create(AName,AParent);
  14943. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('CreateElement');{$ENDIF}
  14944. FLastElement:=El;
  14945. Result:=nil;
  14946. try
  14947. El.Visibility:=AVisibility;
  14948. El.SourceFilename:=ASrcPos.FileName;
  14949. El.SourceLinenumber:=SrcY;
  14950. if FRootElement=nil then
  14951. begin
  14952. RootElement:=El as TPasModule;
  14953. if FStep=prsInit then
  14954. FStep:=prsParsing;
  14955. end
  14956. else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
  14957. begin
  14958. // first element of section
  14959. SectionScope:=TPasSectionScope(AParent.CustomData);
  14960. SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  14961. SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  14962. end;
  14963. if IsElementSkipped(El) then exit;
  14964. // create scope
  14965. if (AClass=TPasVariable)
  14966. or (AClass=TPasConst) then
  14967. AddVariable(TPasVariable(El))
  14968. else if AClass=TPasResString then
  14969. AddResourceString(TPasResString(El))
  14970. else if (AClass=TPasProperty) then
  14971. AddProperty(TPasProperty(El))
  14972. else if AClass=TPasArgument then
  14973. AddArgument(TPasArgument(El))
  14974. else if AClass=TPasEnumType then
  14975. AddEnumType(TPasEnumType(El))
  14976. else if AClass=TPasEnumValue then
  14977. AddEnumValue(TPasEnumValue(El))
  14978. else if (AClass=TUnresolvedPendingRef) then
  14979. else if (AClass=TPasAliasType)
  14980. or (AClass=TPasTypeAliasType)
  14981. or (AClass=TPasClassOfType)
  14982. or (AClass=TPasPointerType)
  14983. or (AClass=TPasArrayType)
  14984. or (AClass=TPasProcedureType)
  14985. or (AClass=TPasFunctionType)
  14986. or (AClass=TPasSetType)
  14987. or (AClass=TPasRangeType) then
  14988. AddType(TPasType(El))
  14989. else if AClass=TPasStringType then
  14990. begin
  14991. AddType(TPasType(El));
  14992. {$ifdef FPC_HAS_CPSTRING}
  14993. if BaseTypes[btShortString]=nil then
  14994. {$endif}
  14995. RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
  14996. end
  14997. else if AClass=TPasRecordType then
  14998. AddRecordType(TPasRecordType(El))
  14999. else if AClass=TPasClassType then
  15000. AddClassType(TPasClassType(El))
  15001. else if AClass=TPasVariant then
  15002. else if AClass.InheritsFrom(TPasProcedure) then
  15003. AddProcedure(TPasProcedure(El))
  15004. else if AClass=TPasResultElement then
  15005. AddFunctionResult(TPasResultElement(El))
  15006. else if AClass=TProcedureBody then
  15007. AddProcedureBody(TProcedureBody(El))
  15008. else if AClass=TPasMethodResolution then
  15009. else if AClass=TPasImplExceptOn then
  15010. AddExceptOn(TPasImplExceptOn(El))
  15011. else if AClass=TPasImplWithDo then
  15012. AddWithDo(TPasImplWithDo(El))
  15013. else if AClass=TPasImplLabelMark then
  15014. else if AClass=TPasOverloadedProc then
  15015. else if (AClass=TInterfaceSection)
  15016. or (AClass=TImplementationSection)
  15017. or (AClass=TProgramSection)
  15018. or (AClass=TLibrarySection) then
  15019. AddSection(TPasSection(El))
  15020. else if (AClass=TPasModule)
  15021. or (AClass=TPasProgram)
  15022. or (AClass=TPasLibrary) then
  15023. AddModule(TPasModule(El))
  15024. else if AClass=TPasUsesUnit then
  15025. else if AClass.InheritsFrom(TPasExpr) then
  15026. // resolved when finished
  15027. else if AClass=TInitializationSection then
  15028. AddInitialFinalizationSection(TInitializationSection(El))
  15029. else if AClass=TFinalizationSection then
  15030. AddInitialFinalizationSection(TFinalizationSection(El))
  15031. else if AClass.InheritsFrom(TPasImplBlock) then
  15032. // resolved when finished
  15033. else if AClass=TPasImplCommand then
  15034. else if AClass=TPasAttributes then
  15035. else if AClass=TPasGenericTemplateType then
  15036. else if AClass=TPasUnresolvedUnitRef then
  15037. RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
  15038. else
  15039. RaiseNotYetImplemented(20160922163544,El);
  15040. Result:=El;
  15041. finally
  15042. if Result=nil then
  15043. El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  15044. end;
  15045. end;
  15046. function TPasResolver.FindModule(const AName: String; NameExpr,
  15047. InFileExpr: TPasExpr): TPasModule;
  15048. var
  15049. InFilename, FileUnitName: String;
  15050. begin
  15051. if InFileExpr<>nil then
  15052. begin
  15053. InFilename:=GetUsesUnitInFilename(InFileExpr);
  15054. if InFilename='' then
  15055. RaiseXExpectedButYFound(20180222001220,
  15056. 'file path','empty string',InFileExpr);
  15057. if msDelphi in CurrentParser.CurrentModeswitches then
  15058. begin
  15059. // in delphi the last unit name must match the filename
  15060. FileUnitName:=ChangeFileExt(ExtractFileName(InFilename),'');
  15061. if CompareText(AName,FileUnitName)<>0 then
  15062. RaiseXExpectedButYFound(20180222230400,AName,FileUnitName,InFileExpr);
  15063. end;
  15064. end;
  15065. Result:=FindUnit(AName,InFilename,NameExpr,InFileExpr);
  15066. if Result=nil then
  15067. begin
  15068. if InFileExpr<>nil then
  15069. RaiseMsg(20180223140434,nCantFindUnitX,sCantFindUnitX,[InFilename],InFileExpr)
  15070. else
  15071. RaiseMsg(20180223140409,nCantFindUnitX,sCantFindUnitX,[AName],NameExpr);
  15072. end;
  15073. end;
  15074. function TPasResolver.FindElement(const aName: String): TPasElement;
  15075. // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
  15076. var
  15077. p: SizeInt;
  15078. RightPath, CurName, LeftPath: String;
  15079. NeedPop: Boolean;
  15080. CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
  15081. CurSection: TPasSection;
  15082. i: Integer;
  15083. UsesUnit: TPasUsesUnit;
  15084. CurScope: TPasDotBaseScope;
  15085. begin
  15086. Result:=nil;
  15087. //writeln('TPasResolver.FindElement Name="',aName,'"');
  15088. ErrorEl:=nil; // use nil to use scanner position as error position
  15089. RightPath:=aName;
  15090. LeftPath:='';
  15091. p:=1;
  15092. CurScopeEl:=nil;
  15093. repeat
  15094. p:=Pos('.',RightPath);
  15095. if p<1 then
  15096. begin
  15097. CurName:=RightPath;
  15098. RightPath:='';
  15099. end
  15100. else
  15101. begin
  15102. CurName:=LeftStr(RightPath,p-1);
  15103. Delete(RightPath,1,p);
  15104. if RightPath='' then
  15105. RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  15106. end;
  15107. if LeftPath='' then
  15108. LeftPath:=CurName
  15109. else
  15110. LeftPath:=LeftPath+'.'+CurName;
  15111. {$IFDEF VerbosePasResolver}
  15112. {AllowWriteln}
  15113. if RightPath<>'' then
  15114. writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
  15115. {AllowWriteln-}
  15116. {$ENDIF}
  15117. if not IsValidIdent(CurName) then
  15118. RaiseNotYetImplemented(20170328000033,ErrorEl);
  15119. if CurScopeEl<>nil then
  15120. begin
  15121. NeedPop:=true;
  15122. if CurScopeEl is TPasType then
  15123. begin
  15124. CurScope:=PushDotScope(TPasType(CurScopeEl));
  15125. if CurScope=nil then
  15126. RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter,
  15127. ['.',LeftPath],ErrorEl);
  15128. end
  15129. else if CurScopeEl is TPasModule then
  15130. PushModuleDotScope(TPasModule(CurScopeEl))
  15131. else
  15132. RaiseMsg(20170504174021,nIllegalQualifierAfter,sIllegalQualifierAfter,
  15133. ['.',LeftPath],ErrorEl);
  15134. end
  15135. else
  15136. NeedPop:=false;
  15137. NextEl:=FindElementWithoutParams(CurName,ErrorEl,true);
  15138. {$IFDEF VerbosePasResolver}
  15139. //if RightPath<>'' then
  15140. // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
  15141. {$ENDIF}
  15142. if NextEl is TPasModule then
  15143. begin
  15144. if CurScopeEl is TPasModule then
  15145. RaiseXExpectedButYFound(20170328001619,'class',GetElementTypeName(NextEl)+' '+NextEl.Name,ErrorEl);
  15146. if Pos('.',NextEl.Name)>0 then
  15147. begin
  15148. // dotted module name -> check if the full module name is in aName
  15149. if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
  15150. begin
  15151. if CompareText(NextEl.Name,aName)=0 then
  15152. RaiseXExpectedButYFound(20170504165825,'type',GetElementTypeName(NextEl),ErrorEl)
  15153. else
  15154. RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
  15155. end;
  15156. RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
  15157. end;
  15158. CurScopeEl:=NextEl;
  15159. end
  15160. else if NextEl.ClassType=TPasUsesUnit then
  15161. begin
  15162. // the first name of a used unit matches -> find longest match
  15163. CurSection:=NextEl.Parent as TPasSection;
  15164. i:=length(CurSection.UsesClause)-1;
  15165. BestEl:=nil;
  15166. while i>=0 do
  15167. begin
  15168. UsesUnit:=CurSection.UsesClause[i];
  15169. CurName:=UsesUnit.Name;
  15170. if IsDottedIdentifierPrefix(CurName,aName)
  15171. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  15172. BestEl:=UsesUnit;
  15173. dec(i);
  15174. if (i<0) and (CurSection.ClassType=TImplementationSection) then
  15175. begin
  15176. CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
  15177. if CurSection=nil then break;
  15178. i:=length(CurSection.UsesClause)-1;
  15179. end;
  15180. end;
  15181. // check module name too
  15182. CurName:=RootElement.Name;
  15183. if IsDottedIdentifierPrefix(CurName,aName)
  15184. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  15185. BestEl:=RootElement;
  15186. if BestEl=nil then
  15187. RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
  15188. RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
  15189. if BestEl.ClassType=TPasUsesUnit then
  15190. CurScopeEl:=TPasUsesUnit(BestEl).Module
  15191. else
  15192. CurScopeEl:=BestEl;
  15193. end
  15194. else if NextEl<>nil then
  15195. CurScopeEl:=NextEl
  15196. else
  15197. RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
  15198. // restore scope
  15199. if NeedPop then
  15200. PopScope;
  15201. if RightPath='' then
  15202. exit(NextEl);
  15203. until false;
  15204. end;
  15205. function TPasResolver.FindElementWithoutParams(const AName: String;
  15206. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  15207. var
  15208. Data: TPRFindData;
  15209. begin
  15210. Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs);
  15211. if Data.Found=nil then exit; // forward type: class-of or ^
  15212. CheckFoundElement(Data,nil);
  15213. if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
  15214. and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
  15215. RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
  15216. end;
  15217. function TPasResolver.FindElementWithoutParams(const AName: String; out
  15218. Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean
  15219. ): TPasElement;
  15220. var
  15221. Abort: boolean;
  15222. begin
  15223. //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
  15224. Result:=Nil;
  15225. Abort:=false;
  15226. Data:=Default(TPRFindData);
  15227. Data.ErrorPosEl:=ErrorPosEl;
  15228. IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort);
  15229. Result:=Data.Found;
  15230. if Result=nil then
  15231. begin
  15232. if (ErrorPosEl=nil) and (LastElement<>nil) then
  15233. begin
  15234. if (LastElement.ClassType=TPasClassOfType)
  15235. and (TPasClassOfType(LastElement).DestType=nil) then
  15236. begin
  15237. // 'class of' of a not yet defined class
  15238. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  15239. CurrentParser.CurSourcePos);
  15240. exit;
  15241. end
  15242. else if (LastElement.ClassType=TPasPointerType)
  15243. and (TPasPointerType(LastElement).DestType=nil) then
  15244. begin
  15245. // pointer of a not yet defined type
  15246. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  15247. CurrentParser.CurSourcePos);
  15248. exit;
  15249. end
  15250. end;
  15251. RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
  15252. end;
  15253. if NoProcsWithArgs and (Result is TPasProcedure)
  15254. and ProcNeedsParams(TPasProcedure(Result).ProcType)
  15255. then
  15256. // proc needs parameters
  15257. RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
  15258. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
  15259. end;
  15260. function TPasResolver.FindFirstEl(const AName: String; out Data: TPRFindData;
  15261. ErrorPosEl: TPasElement): TPasElement;
  15262. var
  15263. Abort: boolean;
  15264. begin
  15265. Abort:=false;
  15266. Data:=Default(TPRFindData);
  15267. Data.ErrorPosEl:=ErrorPosEl;
  15268. IterateElements(AName,@OnFindFirst,@Data,Abort);
  15269. Result:=Data.Found;
  15270. end;
  15271. procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  15272. // Input: El is TPasUsesUnit
  15273. // Output: El is either a TPasUsesUnit or the root module
  15274. var
  15275. CurUsesUnit: TPasUsesUnit;
  15276. BestEl: TPasElement;
  15277. aName, CurName: String;
  15278. Clause: TPasUsesClause;
  15279. i: Integer;
  15280. Section: TPasSection;
  15281. begin
  15282. {$IFDEF VerbosePasResolver}
  15283. //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
  15284. {$ENDIF}
  15285. if not (El is TPasUsesUnit) then
  15286. RaiseInternalError(20170503000945);
  15287. aName:=GetNameExprValue(Expr);
  15288. if aName='' then
  15289. RaiseNotYetImplemented(20170503110217,Expr);
  15290. repeat
  15291. Expr:=GetNextDottedExpr(Expr);
  15292. if Expr=nil then break;
  15293. CurName:=GetNameExprValue(Expr);
  15294. if CurName='' then
  15295. RaiseNotYetImplemented(20170502164242,Expr);
  15296. aName:=aName+'.'+CurName;
  15297. until false;
  15298. {$IFDEF VerbosePasResolver}
  15299. //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
  15300. {$ENDIF}
  15301. // search in uses clause
  15302. BestEl:=nil;
  15303. Section:=TPasUsesUnit(El).Parent as TPasSection;
  15304. repeat
  15305. Clause:=Section.UsesClause;
  15306. for i:=0 to length(Clause)-1 do
  15307. begin
  15308. CurUsesUnit:=Clause[i];
  15309. CurName:=CurUsesUnit.Name;
  15310. if IsDottedIdentifierPrefix(CurName,aName)
  15311. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  15312. BestEl:=CurUsesUnit; // a better match
  15313. end;
  15314. if Section is TImplementationSection then
  15315. begin
  15316. // search in interface uses clause too
  15317. Section:=(Section.Parent as TPasModule).InterfaceSection;
  15318. end
  15319. else
  15320. break;
  15321. until Section=nil;
  15322. {$IFDEF VerbosePasResolver}
  15323. //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
  15324. {$ENDIF}
  15325. // check module name
  15326. CurName:=El.GetModule.Name;
  15327. if IsDottedIdentifierPrefix(CurName,aName)
  15328. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  15329. BestEl:=El.GetModule; // a better match
  15330. if BestEl=nil then
  15331. begin
  15332. // no dotted module name fits the expression
  15333. RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
  15334. end;
  15335. El:=BestEl;
  15336. {$IFDEF VerbosePasResolver}
  15337. //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
  15338. {$ENDIF}
  15339. end;
  15340. procedure TPasResolver.IterateElements(const aName: string;
  15341. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  15342. var Abort: boolean);
  15343. var
  15344. i: Integer;
  15345. Scope: TPasScope;
  15346. begin
  15347. for i:=FScopeCount-1 downto 0 do
  15348. begin
  15349. Scope:=Scopes[i];
  15350. Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
  15351. if Abort then
  15352. exit;
  15353. if Scope is TPasSubExprScope then break;
  15354. end;
  15355. end;
  15356. procedure TPasResolver.CheckFoundElement(
  15357. const FindData: TPRFindData; Ref: TResolvedReference);
  15358. // check visibility rules
  15359. // Call this method after finding an element by searching the scopes.
  15360. function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
  15361. // returns true of aRef is a TPasVariable that inherits its const from parent.
  15362. // For example
  15363. // type TRecord = record
  15364. // a: word; // inherits const
  15365. // const b: word = 3; // does not inherit const
  15366. // class var c: word; // does not inherit const
  15367. // end;
  15368. // procedure DoIt(const r:TRecord)
  15369. var
  15370. El: TPasElement;
  15371. begin
  15372. El:=aRef.Declaration;
  15373. Result:=(El.ClassType=TPasVariable)
  15374. and (TPasVariable(El).VarModifiers*[vmClass, vmStatic]=[]);
  15375. //writeln('IsFieldInheritingConst ',GetObjName(El),' ',Result,' vmClass=',vmClass in TPasVariable(El).VarModifiers);
  15376. end;
  15377. var
  15378. Proc: TPasProcedure;
  15379. StartScope: TPasScope;
  15380. OnlyTypeMembers, IsClassOf: Boolean;
  15381. C: TClass;
  15382. ClassRecScope: TPasClassOrRecordScope;
  15383. i: Integer;
  15384. AbstractProcs: TArrayOfPasProcedure;
  15385. TypeEl: TPasType;
  15386. begin
  15387. StartScope:=FindData.StartScope;
  15388. OnlyTypeMembers:=false;
  15389. IsClassOf:=false;
  15390. if StartScope is TPasDotBaseScope then
  15391. begin
  15392. OnlyTypeMembers:=TPasDotBaseScope(StartScope).OnlyTypeMembers;
  15393. if StartScope.ClassType=TPasDotClassScope then
  15394. IsClassOf:=TPasDotClassScope(StartScope).IsClassOf;
  15395. if Ref<>nil then
  15396. begin
  15397. Include(Ref.Flags,rrfDotScope);
  15398. if TPasDotBaseScope(StartScope).ConstParent
  15399. and IsFieldInheritingConst(Ref) then
  15400. Include(Ref.Flags,rrfConstInherited);
  15401. end;
  15402. end
  15403. else if StartScope.ClassType=ScopeClass_WithExpr then
  15404. begin
  15405. OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
  15406. IsClassOf:=wesfIsClassOf in TPasWithExprScope(StartScope).Flags;
  15407. if Ref<>nil then
  15408. begin
  15409. Include(Ref.Flags,rrfDotScope);
  15410. if (wesfConstParent in TPasWithExprScope(StartScope).Flags)
  15411. and IsFieldInheritingConst(Ref) then
  15412. Include(Ref.Flags,rrfConstInherited);
  15413. end;
  15414. end
  15415. else if StartScope.ClassType=FScopeClass_Proc then
  15416. begin
  15417. Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
  15418. //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
  15419. if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
  15420. OnlyTypeMembers:=true;
  15421. end;
  15422. //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
  15423. // ' StartIsDot=',StartScope is TPasDotBaseScope,
  15424. // ' OnlyTypeMembers=',(StartScope is TPasDotBaseScope)
  15425. // and TPasDotBaseScope(StartScope).OnlyTypeMembers,
  15426. // ' FindData.Found=',GetObjName(FindData.Found));
  15427. if OnlyTypeMembers then
  15428. begin
  15429. //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
  15430. // and (vmClass in TPasVariable(FindData.Found).VarModifiers));
  15431. // only class vars/procs allowed
  15432. if FindData.Found.ClassType=TPasConstructor then
  15433. // constructor: ok
  15434. else if IsClassMethod(FindData.Found)
  15435. then
  15436. // class proc: ok
  15437. else if (FindData.Found is TPasVariable)
  15438. and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
  15439. // class var/const/property: ok
  15440. else if FindData.Found is TPasType then
  15441. // nested type: ok
  15442. else if FindData.Found is TPasEnumValue then
  15443. // e.g. enumtype.enumvalue: ok
  15444. else
  15445. begin
  15446. RaiseMsg(20170216152348,nCannotAccessThisMemberFromAX,
  15447. sCannotAccessThisMemberFromAX,[GetElementTypeName(FindData.Found.Parent)],FindData.ErrorPosEl);
  15448. end;
  15449. end
  15450. else if (proExtClassInstanceNoTypeMembers in Options)
  15451. and (StartScope is TPasDotClassScope)
  15452. and TPasClassType(TPasDotClassScope(StartScope).ClassRecScope.Element).IsExternal then
  15453. begin
  15454. // e.g. ExtClassInstance.Member
  15455. C:=FindData.Found.ClassType;
  15456. if (C=TPasProcedure) or (C=TPasFunction) then
  15457. // ok
  15458. else if (C=TPasConst) then
  15459. // ok
  15460. else if ((C=TPasVariable) or (C=TPasProperty))
  15461. and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
  15462. // ok
  15463. else if IsHelper(FindData.Found.Parent) then
  15464. // ok
  15465. else
  15466. begin
  15467. RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
  15468. sExternalClassInstanceCannotAccessStaticX,
  15469. [GetElementTypeName(FindData.Found)+' '+FindData.Found.Name],
  15470. FindData.ErrorPosEl);
  15471. end;
  15472. end;
  15473. if (FindData.Found is TPasProcedure) then
  15474. begin
  15475. Proc:=TPasProcedure(FindData.Found);
  15476. if Proc.IsVirtual or Proc.IsOverride then
  15477. begin
  15478. if StartScope.ClassType=TPasInheritedScope then
  15479. begin
  15480. // inherited expr -> call directly
  15481. if Proc.IsAbstract then
  15482. RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
  15483. sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
  15484. end
  15485. else
  15486. begin
  15487. // call via virtual method table
  15488. if Ref<>nil then
  15489. Ref.Flags:=Ref.Flags+[rrfVMT];
  15490. end;
  15491. end;
  15492. // constructor: NewInstance or normal call
  15493. // it is a NewInstance iff the scope is a class/record, e.g. TObject.Create
  15494. if (Proc.ClassType=TPasConstructor)
  15495. and (Ref<>nil) then
  15496. begin
  15497. if OnlyTypeMembers then
  15498. Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
  15499. // store the class in Ref.Context
  15500. if Ref.Context<>nil then
  15501. RaiseInternalError(20170131141936);
  15502. Ref.Context:=TResolvedRefCtxConstructor.Create;
  15503. TypeEl:=nil;
  15504. ClassRecScope:=nil;
  15505. C:=StartScope.ClassType;
  15506. if C.InheritsFrom(TPasDotClassOrRecordScope) then
  15507. ClassRecScope:=TPasDotClassOrRecordScope(StartScope).ClassRecScope
  15508. else if C=ScopeClass_WithExpr then
  15509. begin
  15510. ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope;
  15511. if ClassRecScope=nil then
  15512. TypeEl:=TPasWithExprScope(StartScope).Scope.Element as TPasType;
  15513. end
  15514. else if C=ScopeClass_Procedure then
  15515. ClassRecScope:=TPasProcedureScope(StartScope).ClassRecScope
  15516. else if C=TPasDotHelperScope then
  15517. TypeEl:=NoNil(TPasDotHelperScope(StartScope).Element) as TPasType
  15518. else
  15519. RaiseInternalError(20170131150855,GetObjName(StartScope));
  15520. if TypeEl<>nil then
  15521. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl
  15522. else
  15523. begin
  15524. if ClassRecScope=nil then
  15525. RaiseInternalError(20190123120156,GetObjName(StartScope));
  15526. TypeEl:=ClassRecScope.Element as TPasMembersType;
  15527. if (TypeEl.ClassType=TPasClassType)
  15528. and (TPasClassType(TypeEl).HelperForType<>nil) then
  15529. TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
  15530. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
  15531. if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
  15532. begin
  15533. if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
  15534. LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
  15535. sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
  15536. else
  15537. begin
  15538. AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
  15539. if (length(AbstractProcs)>0) then
  15540. begin
  15541. if IsClassOf then
  15542. // aClass.Create: do not warn
  15543. else
  15544. for i:=0 to length(AbstractProcs)-1 do
  15545. LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
  15546. sConstructingClassXWithAbstractMethodY,
  15547. [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
  15548. end;
  15549. end;
  15550. end;
  15551. end;
  15552. end;
  15553. {$IFDEF VerbosePasResolver}
  15554. {AllowWriteln}
  15555. if (Proc.ClassType=TPasConstructor) then
  15556. begin
  15557. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  15558. if Ref=nil then
  15559. write(' no ref!')
  15560. else
  15561. begin
  15562. write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
  15563. ' StartScope=',GetObjName(StartScope),
  15564. ' OnlyTypeMembers=',OnlyTypeMembers);
  15565. end;
  15566. writeln;
  15567. end;
  15568. {AllowWriteln-}
  15569. {$ENDIF}
  15570. // destructor: FreeInstance or normal call
  15571. // it is a normal call if 'inherited'
  15572. if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
  15573. if not (StartScope is TPasInheritedScope) then
  15574. Ref.Flags:=Ref.Flags+[rrfFreeInstance];
  15575. {$IFDEF VerbosePasResolver}
  15576. {AllowWriteln}
  15577. if (Proc.ClassType=TPasDestructor) then
  15578. begin
  15579. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  15580. if Ref=nil then
  15581. write(' no ref!')
  15582. else
  15583. begin
  15584. write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
  15585. ' StartScope=',GetObjName(StartScope));
  15586. if StartScope is TPasDotClassOrRecordScope then
  15587. write(' InheritedExpr=',StartScope is TPasInheritedScope);
  15588. end;
  15589. writeln;
  15590. end;
  15591. {AllowWriteln-}
  15592. {$ENDIF}
  15593. end;
  15594. CheckFoundElementVisibility(FindData,Ref);
  15595. end;
  15596. procedure TPasResolver.CheckFoundElementVisibility(const FindData: TPRFindData;
  15597. Ref: TResolvedReference);
  15598. var
  15599. Context: TPasElement;
  15600. FoundContext: TPasMembersType;
  15601. CurScope: TPasScope;
  15602. {$IFDEF VerbosePasResolver}
  15603. i: Integer;
  15604. {$ENDIF}
  15605. begin
  15606. // check class visibility
  15607. if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
  15608. begin
  15609. Context:=GetVisibilityContext;
  15610. FoundContext:=FindData.Found.Parent as TPasMembersType;
  15611. case FindData.Found.Visibility of
  15612. visPrivate:
  15613. // private members can only be accessed in same module
  15614. if FoundContext.GetModule<>Context.GetModule then
  15615. RaiseMsg(20170216152354,nCantAccessXMember,sCantAccessXMember,
  15616. ['private',FindData.Found.Name],FindData.ErrorPosEl);
  15617. visProtected:
  15618. begin
  15619. // protected members can only be accessed in same module
  15620. // or descendant classes
  15621. CurScope:=TopScope;
  15622. if FoundContext.GetModule=Context.GetModule then
  15623. // same module -> ok
  15624. else if (Context is TPasType)
  15625. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  15626. // context in class or descendant
  15627. else if (CurScope is TPasDotClassOrRecordScope)
  15628. and (TPasDotClassOrRecordScope(CurScope).ClassRecScope.Element.GetModule=Context.GetModule) then
  15629. // e.g. aClassInThisModule.identifier
  15630. else if (CurScope is TPasWithExprScope)
  15631. and (TPasWithExprScope(CurScope).Scope.Element<>nil)
  15632. and (TPasWithExprScope(CurScope).Scope.Element.GetModule=Context.GetModule) then
  15633. // e.g. with aClassInThisModule do identifier
  15634. else
  15635. RaiseMsg(20170216152356,nCantAccessXMember,sCantAccessXMember,
  15636. ['protected',FindData.Found.Name],FindData.ErrorPosEl);
  15637. end;
  15638. visStrictPrivate:
  15639. // strict private members can only be accessed in their class
  15640. if Context<>FoundContext then
  15641. begin
  15642. {$IFDEF VerbosePasResolver}
  15643. {AllowWriteln}
  15644. writeln('TPasResolver.CheckFoundElement Context=',GetElementDbgPath(Context),' FoundContext=',GetElementDbgPath(FoundContext));
  15645. for i:=ScopeCount-1 downto 0 do
  15646. writeln(' ',i,' ',Scopes[i].ClassName,' Element=',GetObjName(Scopes[i].Element),' VisibilityContext=',GetObjName(Scopes[i].VisibilityContext));
  15647. {AllowWriteln-}
  15648. {$ENDIF}
  15649. RaiseMsg(20170216152357,nCantAccessXMember,sCantAccessXMember,
  15650. ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
  15651. end;
  15652. visStrictProtected:
  15653. // strict protected members can only be accessed in their and descendant classes
  15654. if (Context is TPasType)
  15655. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  15656. // context in class or descendant
  15657. else
  15658. RaiseMsg(20170216152400,nCantAccessXMember,sCantAccessXMember,
  15659. ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
  15660. end;
  15661. end;
  15662. if Ref=nil then ;
  15663. end;
  15664. function TPasResolver.GetVisibilityContext: TPasElement;
  15665. var
  15666. i: Integer;
  15667. begin
  15668. for i:=ScopeCount-1 downto 0 do
  15669. begin
  15670. Result:=Scopes[i].VisibilityContext;
  15671. if Result<>nil then exit;
  15672. end;
  15673. Result:=nil;
  15674. end;
  15675. procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
  15676. begin
  15677. case ScopeType of
  15678. stWithExpr: PushWithExprScope(El as TPasExpr);
  15679. else
  15680. RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
  15681. end;
  15682. end;
  15683. procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
  15684. begin
  15685. if IsElementSkipped(El) then exit;
  15686. case ScopeType of
  15687. stModule: FinishModule(El as TPasModule);
  15688. stUsesClause: FinishUsesClause;
  15689. stTypeSection: FinishTypeSection(El);
  15690. stTypeDef: FinishTypeDef(El as TPasType);
  15691. stResourceString: FinishResourcestring(El as TPasResString);
  15692. stProcedure: FinishProcedure(El as TPasProcedure);
  15693. stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
  15694. stExceptOnExpr: FinishExceptOnExpr;
  15695. stExceptOnStatement: FinishExceptOnStatement;
  15696. stWithExpr: FinishWithDo(El as TPasImplWithDo);
  15697. stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop);
  15698. stDeclaration: FinishDeclaration(El);
  15699. stAncestors: FinishAncestors(El as TPasClassType);
  15700. stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
  15701. else
  15702. RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
  15703. end;
  15704. end;
  15705. procedure TPasResolver.FinishTypeAlias(var NewType: TPasType);
  15706. var
  15707. TypeEl, DestType: TPasType;
  15708. AncestorClass, aClass: TPasClassType;
  15709. Scope: TPasIdentifierScope;
  15710. OldType: TPasTypeAliasType;
  15711. LocalScope: TPasScope;
  15712. begin
  15713. DestType:=TPasTypeAliasType(NewType).DestType;
  15714. TypeEl:=ResolveSimpleAliasType(DestType);
  15715. if TypeEl is TPasClassType then
  15716. begin
  15717. // change "=type aClassType" to "=class(aClassType)"
  15718. // or change "=type aInterfaceType" to "=interface(aInterfaceType)"
  15719. AncestorClass := TPasClassType(TypeEl);
  15720. // remove aliastype from scope
  15721. LocalScope:=GetLocalScope;
  15722. Scope:=LocalScope as TPasIdentifierScope;
  15723. Scope.RemoveLocalIdentifier(NewType);
  15724. // create class or interface
  15725. aClass := TPasClassType(CreateElement(TPasClassType,
  15726. NewType.Name,NewType.Parent,NewType.Visibility,
  15727. NewType.SourceFilename,NewType.SourceLinenumber));
  15728. aClass.ObjKind := AncestorClass.ObjKind;
  15729. // release old alias type
  15730. OldType := TPasTypeAliasType(NewType);
  15731. NewType := aClass;
  15732. TPasTypeAliasType(OldType).DestType:=nil; // clear reference
  15733. OldType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  15734. // set ancestor
  15735. aClass.AncestorType := DestType;
  15736. {$IFDEF CheckPasTreeRefCount}DestType.ChangeRefId('ResolveTypeReference','TPasClassType.AncestorType');{$ENDIF}
  15737. FinishScope(stAncestors,aClass);
  15738. end;
  15739. end;
  15740. function TPasResolver.IsUnitIntfFinished(AModule: TPasModule): boolean;
  15741. var
  15742. CurIntf: TInterfaceSection;
  15743. begin
  15744. CurIntf:=AModule.InterfaceSection;
  15745. Result:=(CurIntf<>nil)
  15746. and (CurIntf.CustomData is TPasSectionScope)
  15747. and TPasSectionScope(CurIntf.CustomData).Finished;
  15748. end;
  15749. procedure TPasResolver.NotifyPendingUsedInterfaces;
  15750. // called after unit interface is ready to be used by other modules
  15751. var
  15752. ModuleScope: TPasModuleScope;
  15753. i: Integer;
  15754. PendingResolver: TPasResolver;
  15755. PendingSection: TPasSection;
  15756. begin
  15757. // call all PendingResolvers
  15758. // Note that a waiting resolver might continue parsing
  15759. ModuleScope:=RootElement.CustomData as TPasModuleScope;
  15760. i:=ModuleScope.PendingResolvers.Count-1;
  15761. while i>=0 do
  15762. begin
  15763. PendingResolver:=TObject(ModuleScope.PendingResolvers[i]) as TPasResolver;
  15764. PendingSection:=PendingResolver.GetLastSection;
  15765. {$IFDEF VerbosePasResolver}
  15766. writeln('TPasResolver.NotifyPendingUsedInterfaces "',ModuleScope.Element.Name,'" Pending="',PendingResolver.RootElement.Name,'"');
  15767. {$ENDIF}
  15768. if PendingSection=nil then
  15769. RaiseInternalError(20180305141421);
  15770. PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
  15771. dec(i);
  15772. if i>=ModuleScope.PendingResolvers.Count then
  15773. i:=ModuleScope.PendingResolvers.Count-1;
  15774. end;
  15775. end;
  15776. function TPasResolver.GetPendingUsedInterface(Section: TPasSection
  15777. ): TPasUsesUnit;
  15778. var
  15779. i: Integer;
  15780. UseUnit: TPasUsesUnit;
  15781. begin
  15782. Result:=nil;
  15783. for i:=0 to length(Section.UsesClause)-1 do
  15784. begin
  15785. UseUnit:=Section.UsesClause[i];
  15786. if not (UseUnit.Module is TPasModule) then continue;
  15787. if not IsUnitIntfFinished(TPasModule(UseUnit.Module)) then
  15788. exit(UseUnit);
  15789. end;
  15790. end;
  15791. function TPasResolver.CheckPendingUsedInterface(Section: TPasSection): boolean;
  15792. var
  15793. PendingModule: TPasModule;
  15794. PendingModuleScope: TPasModuleScope;
  15795. List: TFPList;
  15796. WasPending: Boolean;
  15797. begin
  15798. {$IFDEF VerbosePasResolver}
  15799. //writeln('TPasResolver.CheckPendingUsedInterface START "',RootElement.Name,'" Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
  15800. {$ENDIF}
  15801. WasPending:=Section.PendingUsedIntf<>nil;
  15802. if WasPending then
  15803. begin
  15804. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  15805. if not IsUnitIntfFinished(PendingModule) then
  15806. exit; // still pending
  15807. // other unit interface is finished
  15808. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  15809. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" UnitIntf finished of "',PendingModule.Name,'"');
  15810. {$ENDIF}
  15811. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  15812. PendingModuleScope.PendingResolvers.Remove(Self);
  15813. Section.PendingUsedIntf:=nil;
  15814. end;
  15815. Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
  15816. //writeln('TPasResolver.CheckPendingUsedInterface ',GetObjName(RootElement),' Section=',GetObjName(Section),' PendingUsedIntf=',GetObjName(Section.PendingUsedIntf));
  15817. if Section.PendingUsedIntf<>nil then
  15818. begin
  15819. // module not yet finished due to pending used interfaces
  15820. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  15821. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  15822. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  15823. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" waiting for unit intf of "',PendingModule.Name,'"');
  15824. {$ENDIF}
  15825. List:=PendingModuleScope.PendingResolvers;
  15826. if List.IndexOf(Self)<0 then
  15827. List.Add(Self);
  15828. Result:=not WasPending;
  15829. end
  15830. else
  15831. begin
  15832. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  15833. {AllowWriteln}
  15834. if WasPending then
  15835. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" uses section complete: ',Section.ClassName);
  15836. {AllowWriteln-}
  15837. {$ENDIF}
  15838. Result:=WasPending;
  15839. if Result then
  15840. UsedInterfacesFinished(Section);
  15841. end;
  15842. end;
  15843. procedure TPasResolver.UsedInterfacesFinished(Section: TPasSection);
  15844. // if there is a unit cycle that stopped parsing this unit
  15845. // this method is called after the needed used unit interfaces have finished
  15846. begin
  15847. {$IFDEF VerbosePasResolver}
  15848. writeln('TPasResolver.UsesSectionFinished ',Section.ElementTypeName,' "',RootElement.Name,'"...');
  15849. {$ENDIF}
  15850. CurrentParser.ParseContinue;
  15851. if Section=nil then ;
  15852. end;
  15853. function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
  15854. // called by the parser when reading DoParseConstValueExpression
  15855. var
  15856. C: TClass;
  15857. V: TPasVariable;
  15858. TypeEl: TPasType;
  15859. begin
  15860. Result:=false;
  15861. if El=nil then exit;
  15862. C:=El.ClassType;
  15863. if (C=TPasConst) or (C=TPasVariable) then
  15864. begin
  15865. V:=TPasVariable(El);
  15866. if V.VarType=nil then exit;
  15867. TypeEl:=ResolveAliasType(V.VarType);
  15868. Result:=TypeEl.ClassType=TPasArrayType;
  15869. end;
  15870. //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
  15871. end;
  15872. function TPasResolver.GetDefaultClassVisibility(AClass: TPasClassType
  15873. ): TPasMemberVisibility;
  15874. var
  15875. ClassScope: TPasClassScope;
  15876. begin
  15877. if AClass.CustomData=nil then
  15878. exit(visDefault);
  15879. ClassScope:=(AClass.CustomData as TPasClassScope);
  15880. if pcsfPublished in ClassScope.Flags then
  15881. Result:=visPublished
  15882. else
  15883. Result:=visPublic;
  15884. end;
  15885. procedure TPasResolver.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  15886. Before: boolean; var Handled: boolean);
  15887. begin
  15888. inherited ModeChanged(Sender, NewMode, Before, Handled);
  15889. if not Before then
  15890. begin
  15891. if LastElement is TPasSection then
  15892. TPasSectionScope(LastElement.CustomData).ModeSwitches:=CurrentParser.CurrentModeswitches;
  15893. end;
  15894. end;
  15895. class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
  15896. Line, Column: integer);
  15897. begin
  15898. Line:=Linenumber;
  15899. Column:=0;
  15900. if Line<0 then begin
  15901. Line:=-Line;
  15902. Column:=Line mod ParserMaxEmbeddedColumn;
  15903. Line:=Line div ParserMaxEmbeddedColumn;
  15904. end;
  15905. end;
  15906. class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
  15907. var
  15908. Line, Column: integer;
  15909. begin
  15910. if El=nil then exit('nil');
  15911. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  15912. Result:=El.SourceFilename+'('+IntToStr(Line);
  15913. if Column>0 then
  15914. Result:=Result+','+IntToStr(Column);
  15915. Result:=Result+')';
  15916. end;
  15917. function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
  15918. var
  15919. Line, Column: integer;
  15920. begin
  15921. if El=nil then exit('nil');
  15922. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  15923. if (Line=0) then
  15924. begin
  15925. if El is TPasUnresolvedSymbolRef then
  15926. exit('intrinsic');
  15927. end;
  15928. Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
  15929. if Column>0 then
  15930. Result:=Result+','+IntToStr(Column);
  15931. Result:=Result+')';
  15932. end;
  15933. destructor TPasResolver.Destroy;
  15934. begin
  15935. {$IFDEF VerbosePasResolverMem}
  15936. writeln('TPasResolver.Destroy START ',ClassName);
  15937. {$ENDIF}
  15938. Clear;
  15939. {$IFDEF VerbosePasResolverMem}
  15940. writeln('TPasResolver.Destroy PopScope...');
  15941. {$ENDIF}
  15942. PopScope; // free default scope
  15943. {$IFDEF VerbosePasResolverMem}
  15944. writeln('TPasResolver.Destroy FPendingForwards...');
  15945. {$ENDIF}
  15946. FreeAndNil(FPendingForwardProcs);
  15947. FreeAndNil(fExprEvaluator);
  15948. ClearBuiltInIdentifiers;
  15949. inherited Destroy;
  15950. {$IFDEF VerbosePasResolverMem}
  15951. writeln('TPasResolver.Destroy END ',ClassName);
  15952. {$ENDIF}
  15953. end;
  15954. procedure TPasResolver.Clear;
  15955. begin
  15956. ClearHelperList(FActiveHelpers);
  15957. RestoreSubExprScopes(0);
  15958. // clear stack, keep DefaultScope
  15959. while (FScopeCount>0) and (FTopScope<>DefaultScope) do
  15960. PopScope;
  15961. ClearResolveDataList(lkModule);
  15962. end;
  15963. procedure TPasResolver.ClearBuiltInIdentifiers;
  15964. var
  15965. bt: TResolverBaseType;
  15966. bp: TResolverBuiltInProc;
  15967. begin
  15968. ClearResolveDataList(lkBuiltIn);
  15969. for bt in TResolverBaseType do
  15970. ReleaseAndNil(TPasElement(FBaseTypes[bt]){$IFDEF CheckPasTreeRefCount},'TPasResolver.AddBaseType'{$ENDIF});
  15971. for bp in TResolverBuiltInProc do
  15972. FBuiltInProcs[bp]:=nil;
  15973. end;
  15974. procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
  15975. const TheBaseTypes: TResolveBaseTypes;
  15976. const TheBaseProcs: TResolverBuiltInProcs);
  15977. var
  15978. bt: TResolverBaseType;
  15979. begin
  15980. for bt in TheBaseTypes do
  15981. AddBaseType(BaseTypeNames[bt],bt);
  15982. if bfLength in TheBaseProcs then
  15983. AddBuiltInProc('Length','function Length(const String or Array): sizeint',
  15984. @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
  15985. @BI_Length_OnEval,nil,bfLength);
  15986. if bfSetLength in TheBaseProcs then
  15987. AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
  15988. @BI_SetLength_OnGetCallCompatibility,nil,nil,
  15989. @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
  15990. if bfInclude in TheBaseProcs then
  15991. AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
  15992. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  15993. @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
  15994. if bfExclude in TheBaseProcs then
  15995. AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
  15996. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  15997. @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
  15998. if bfBreak in TheBaseProcs then
  15999. AddBuiltInProc('Break','procedure Break',
  16000. @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
  16001. if bfContinue in TheBaseProcs then
  16002. AddBuiltInProc('Continue','procedure Continue',
  16003. @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
  16004. if bfExit in TheBaseProcs then
  16005. AddBuiltInProc('Exit','procedure Exit(result)',
  16006. @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
  16007. if bfInc in TheBaseProcs then
  16008. AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
  16009. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  16010. @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
  16011. if bfDec in TheBaseProcs then
  16012. AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
  16013. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  16014. @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
  16015. if bfAssigned in TheBaseProcs then
  16016. AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
  16017. @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
  16018. nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
  16019. if bfChr in TheBaseProcs then
  16020. AddBuiltInProc('Chr','function Chr(const Integer): char',
  16021. @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,
  16022. @BI_Chr_OnEval,nil,bfChr);
  16023. if bfOrd in TheBaseProcs then
  16024. AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
  16025. @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
  16026. @BI_Ord_OnEval,nil,bfOrd);
  16027. if bfLow in TheBaseProcs then
  16028. AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
  16029. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  16030. @BI_LowHigh_OnEval,nil,bfLow);
  16031. if bfHigh in TheBaseProcs then
  16032. AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
  16033. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  16034. @BI_LowHigh_OnEval,nil,bfHigh);
  16035. if bfPred in TheBaseProcs then
  16036. AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
  16037. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  16038. @BI_PredSucc_OnEval,nil,bfPred);
  16039. if bfSucc in TheBaseProcs then
  16040. AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
  16041. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  16042. @BI_PredSucc_OnEval,nil,bfSucc);
  16043. if bfStrProc in TheBaseProcs then
  16044. AddBuiltInProc('Str','procedure Str(const var; var String)',
  16045. @BI_StrProc_OnGetCallCompatibility,nil,nil,
  16046. @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
  16047. if bfStrFunc in TheBaseProcs then
  16048. AddBuiltInProc('Str','function Str(const var): String',
  16049. @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
  16050. @BI_StrFunc_OnEval,nil,bfStrFunc);
  16051. if bfWriteStr in TheBaseProcs then
  16052. AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
  16053. @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
  16054. @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
  16055. if bfVal in TheBaseProcs then
  16056. AddBuiltInProc('Val','procedure Val(const String; var Value: bool|int|float|enum; out Int)',
  16057. @BI_Val_OnGetCallCompatibility,nil,nil,
  16058. @BI_Val_OnFinishParamsExpr,bfVal,[bipfCanBeStatement]);
  16059. if bfLo in TheBaseProcs then
  16060. AddBuiltInProc('Lo','function Lo(X: any integer type): Byte|Word)',
  16061. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  16062. @BI_LoHi_OnEval,nil,bfLo);
  16063. if bfHi in TheBaseProcs then
  16064. AddBuiltInProc('Hi','function Hi(X: any integer type): Byte|Word)',
  16065. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  16066. @BI_LoHi_OnEval,nil,bfHi);
  16067. if bfConcatArray in TheBaseProcs then
  16068. AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
  16069. @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
  16070. nil,nil,bfConcatArray);
  16071. if bfConcatString in TheBaseProcs then
  16072. AddBuiltInProc('Concat','function Concat(const String1, String2, ...): String',
  16073. @BI_ConcatString_OnGetCallCompatibility,@BI_ConcatString_OnGetCallResult,
  16074. @BI_ConcatString_OnEval,nil,bfConcatString);
  16075. if bfCopyArray in TheBaseProcs then
  16076. AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
  16077. @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
  16078. nil,nil,bfCopyArray);
  16079. if bfInsertArray in TheBaseProcs then
  16080. AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
  16081. @BI_InsertArray_OnGetCallCompatibility,nil,nil,
  16082. @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
  16083. if bfDeleteArray in TheBaseProcs then
  16084. AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
  16085. @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
  16086. @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
  16087. if bfTypeInfo in TheBaseProcs then
  16088. AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
  16089. @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
  16090. nil,nil,bfTypeInfo);
  16091. if bfAssert in TheBaseProcs then
  16092. AddBuiltInProc('Assert','procedure Assert(bool[,string])',
  16093. @BI_Assert_OnGetCallCompatibility,nil,nil,
  16094. @BI_Assert_OnFinishParamsExpr,bfAssert,[bipfCanBeStatement]);
  16095. if bfNew in TheBaseProcs then
  16096. AddBuiltInProc('New','procedure New(out ^record)',
  16097. @BI_New_OnGetCallCompatibility,nil,nil,
  16098. @BI_New_OnFinishParamsExpr,bfNew,[bipfCanBeStatement]);
  16099. if bfDispose in TheBaseProcs then
  16100. AddBuiltInProc('Dispose','procedure Dispose(var ^record)',
  16101. @BI_Dispose_OnGetCallCompatibility,nil,nil,
  16102. @BI_Dispose_OnFinishParamsExpr,bfDispose,[bipfCanBeStatement]);
  16103. if bfDefault in TheBaseProcs then
  16104. AddBuiltInProc('Default','function Default(T): T',
  16105. @BI_Default_OnGetCallCompatibility,@BI_Default_OnGetCallResult,
  16106. @BI_Default_OnEval,nil,bfDefault,[]);
  16107. end;
  16108. function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
  16109. ): TResElDataBaseType;
  16110. var
  16111. El: TPasUnresolvedSymbolRef;
  16112. begin
  16113. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  16114. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TPasResolver.AddBaseType');{$ENDIF}
  16115. if not (Typ in [btNone,btCustom]) then
  16116. FBaseTypes[Typ]:=El;
  16117. Result:=TResElDataBaseType.Create;
  16118. Result.BaseType:=Typ;
  16119. AddResolveData(El,Result,lkBuiltIn);
  16120. FDefaultScope.AddIdentifier(aName,El,pikBaseType);
  16121. end;
  16122. function TPasResolver.AddCustomBaseType(const aName: string;
  16123. aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  16124. var
  16125. CustomData: TResElDataBaseType;
  16126. begin
  16127. Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
  16128. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('TPasResolver.AddCustomBaseType');{$ENDIF}
  16129. CustomData:=aClass.Create;
  16130. CustomData.BaseType:=btCustom;
  16131. AddResolveData(Result,CustomData,lkBuiltIn);
  16132. FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
  16133. end;
  16134. function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
  16135. ResolveAlias: boolean): boolean;
  16136. begin
  16137. Result:=false;
  16138. if aType=nil then exit;
  16139. if ResolveAlias then
  16140. aType:=ResolveAliasType(aType);
  16141. if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
  16142. Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
  16143. end;
  16144. function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
  16145. const GetCallCompatibility: TOnGetCallCompatibility;
  16146. const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
  16147. const FinishParamsExpr: TOnFinishParamsExpr;
  16148. const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
  16149. ): TResElDataBuiltInProc;
  16150. var
  16151. El: TPasUnresolvedSymbolRef;
  16152. begin
  16153. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  16154. Result:=TResElDataBuiltInProc.Create;
  16155. Result.Proc:=El;
  16156. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TResElDataBuiltInProc.Proc');{$ENDIF}
  16157. Result.Signature:=Signature;
  16158. Result.BuiltIn:=BuiltIn;
  16159. Result.GetCallCompatibility:=GetCallCompatibility;
  16160. Result.GetCallResult:=GetCallResult;
  16161. Result.Eval:=EvalConst;
  16162. Result.FinishParamsExpression:=FinishParamsExpr;
  16163. Result.Flags:=Flags;
  16164. AddResolveData(El,Result,lkBuiltIn);
  16165. FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
  16166. if BuiltIn<>bfCustom then
  16167. FBuiltInProcs[BuiltIn]:=Result;
  16168. end;
  16169. procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
  16170. Kind: TResolveDataListKind);
  16171. begin
  16172. if Data.Element<>nil then
  16173. RaiseInternalError(20171111162227);
  16174. if El.CustomData<>nil then
  16175. RaiseInternalError(20171111162236);
  16176. Data.Element:=El;
  16177. Data.Owner:=Self;
  16178. Data.Next:=FLastCreatedData[Kind];
  16179. FLastCreatedData[Kind]:=Data;
  16180. El.CustomData:=Data;
  16181. end;
  16182. function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
  16183. Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
  16184. procedure RaiseAlreadySet;
  16185. var
  16186. FormerDeclEl: TPasElement;
  16187. begin
  16188. {AllowWriteln}
  16189. writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  16190. writeln(' RefEl at ',GetElementSourcePosStr(RefEl));
  16191. writeln(' RefEl.CustomData=',GetObjName(RefEl.CustomData));
  16192. if RefEl.CustomData is TResolvedReference then
  16193. begin
  16194. FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
  16195. writeln(' TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
  16196. ' IsSame=',FormerDeclEl=DeclEl);
  16197. end;
  16198. {AllowWriteln-}
  16199. RaiseInternalError(20160922163554,'customdata<>nil');
  16200. end;
  16201. begin
  16202. if RefEl.CustomData<>nil then
  16203. RaiseAlreadySet;
  16204. {$IFDEF VerbosePasResolver}
  16205. writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  16206. {$ENDIF}
  16207. Result:=TResolvedReference.Create;
  16208. if FindData<>nil then
  16209. begin
  16210. if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
  16211. Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
  16212. end;
  16213. AddResolveData(RefEl,Result,lkModule);
  16214. Result.Declaration:=DeclEl;
  16215. if RefEl is TPasExpr then
  16216. SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
  16217. EmitElementHints(RefEl,DeclEl);
  16218. end;
  16219. function TPasResolver.GetLocalScope: TPasScope;
  16220. begin
  16221. Result:=TopScope;
  16222. if Result.ClassType=TPasGroupScope then
  16223. Result:=TPasGroupScope(Result).Scopes[0];
  16224. end;
  16225. function TPasResolver.GetParentLocalScope: TPasScope;
  16226. begin
  16227. Result:=Scopes[ScopeCount-2];
  16228. if Result.ClassType=TPasGroupScope then
  16229. Result:=TPasGroupScope(Result).Scopes[0];
  16230. end;
  16231. function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
  16232. ): TPasScope;
  16233. begin
  16234. if not ScopeClass.IsStoredInElement then
  16235. RaiseInternalError(20160923121858);
  16236. if El.CustomData<>nil then
  16237. RaiseInternalError(20160923121849);
  16238. {$IFDEF VerbosePasResolver}
  16239. writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
  16240. {$ENDIF}
  16241. Result:=ScopeClass.Create;
  16242. if Result.FreeOnPop then
  16243. begin
  16244. Result.Element:=El;
  16245. El.CustomData:=Result;
  16246. Result.Owner:=Self;
  16247. end
  16248. else
  16249. // add to free list
  16250. AddResolveData(El,Result,lkModule);
  16251. end;
  16252. function TPasResolver.CreateGroupScope(aType: TPasType; WithTopHelpers: boolean
  16253. ): TPasGroupScope;
  16254. begin
  16255. Result:=TPasGroupScope.Create;
  16256. Result.Element:=aType;
  16257. GroupScope_AddTypeAndAncestors(Result,aType,WithTopHelpers);
  16258. end;
  16259. procedure TPasResolver.GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope;
  16260. TypeEl: TPasType; WithTopHelpers: boolean);
  16261. var
  16262. IsClass: Boolean;
  16263. i: Integer;
  16264. Entry: TPRHelperEntry;
  16265. HelperForType: TPasType;
  16266. AncestorScope, HelperScope: TPasClassScope;
  16267. C: TClass;
  16268. begin
  16269. TypeEl:=ResolveAliasType(TypeEl);
  16270. IsClass:=TypeEl.ClassType=TPasClassType;
  16271. if IsClass and (TPasClassType(TypeEl).HelperForType<>nil) then
  16272. begin
  16273. // start in a helper
  16274. WithTopHelpers:=false;
  16275. // first add helper and its ancestors
  16276. HelperScope:=TPasClassScope(TypeEl.CustomData);
  16277. while HelperScope<>nil do
  16278. begin
  16279. Scope.Add(HelperScope);
  16280. HelperScope:=HelperScope.AncestorScope;
  16281. end;
  16282. // then add the HelperForType and its ancestors
  16283. TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType);
  16284. IsClass:=TypeEl.ClassType=TPasClassType;
  16285. end;
  16286. repeat
  16287. // first add helper(s)
  16288. if WithTopHelpers then
  16289. begin
  16290. for i:=length(FActiveHelpers)-1 downto 0 do
  16291. begin
  16292. Entry:=FActiveHelpers[i];
  16293. HelperForType:=Entry.HelperForType;
  16294. if IsSameType(HelperForType,TypeEl,prraNone) then
  16295. begin
  16296. // add Helper and its ancestors
  16297. HelperScope:=TPasClassScope(Entry.Helper.CustomData);
  16298. while HelperScope<>nil do
  16299. begin
  16300. Scope.Add(HelperScope);
  16301. HelperScope:=HelperScope.AncestorScope;
  16302. end;
  16303. if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
  16304. break;
  16305. end;
  16306. end;
  16307. end
  16308. else
  16309. WithTopHelpers:=true;
  16310. // then add scope of TypeEl
  16311. C:=TypeEl.ClassType;
  16312. if (C=TPasClassType) or (C=TPasRecordType) then
  16313. Scope.Add(TypeEl.CustomData as TPasIdentifierScope);
  16314. // continue with ancestor
  16315. if not IsClass then break;
  16316. AncestorScope:=(TypeEl.CustomData as TPasClassScope).AncestorScope;
  16317. if AncestorScope=nil then break;
  16318. TypeEl:=TPasClassType(AncestorScope.Element);
  16319. until TypeEl=nil;
  16320. end;
  16321. procedure TPasResolver.PopScope;
  16322. var
  16323. Scope: TPasScope;
  16324. begin
  16325. if FScopeCount=0 then
  16326. RaiseInternalError(20160922163557);
  16327. {$IFDEF VerbosePasResolver}
  16328. {AllowWriteln}
  16329. //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
  16330. writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
  16331. {AllowWriteln-}
  16332. {$ENDIF}
  16333. dec(FScopeCount);
  16334. if FTopScope.FreeOnPop then
  16335. begin
  16336. Scope:=FScopes[FScopeCount];
  16337. if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
  16338. Scope.Element.CustomData:=nil;
  16339. if Scope=FDefaultScope then
  16340. FDefaultScope:=nil;
  16341. FScopes[FScopeCount]:=nil;
  16342. Scope.Free;
  16343. end;
  16344. if FScopeCount>0 then
  16345. FTopScope:=FScopes[FScopeCount-1]
  16346. else
  16347. FTopScope:=nil;
  16348. end;
  16349. procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
  16350. var
  16351. WithScope: TPasWithScope;
  16352. i: Integer;
  16353. begin
  16354. WithScope:=El.CustomData as TPasWithScope;
  16355. for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
  16356. begin
  16357. CheckTopScope(ScopeClass_WithExpr);
  16358. if TopScope<>WithScope.ExpressionScopes[i] then
  16359. RaiseInternalError(20160923102846);
  16360. PopScope;
  16361. end;
  16362. CheckTopScope(TPasWithScope);
  16363. PopScope;
  16364. end;
  16365. procedure TPasResolver.PushScope(Scope: TPasScope);
  16366. begin
  16367. if Scope=nil then
  16368. RaiseInternalError(20160922163601);
  16369. if length(FScopes)=FScopeCount then
  16370. SetLength(FScopes,FScopeCount*2+10);
  16371. FScopes[FScopeCount]:=Scope;
  16372. inc(FScopeCount);
  16373. FTopScope:=Scope;
  16374. {$IFDEF VerbosePasResolver}
  16375. writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
  16376. {$ENDIF}
  16377. end;
  16378. function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
  16379. ): TPasScope;
  16380. begin
  16381. Result:=CreateScope(El,ScopeClass);
  16382. PushScope(Result);
  16383. end;
  16384. function TPasResolver.PushGroupScope(aType: TPasType): TPasGroupScope;
  16385. begin
  16386. Result:=CreateGroupScope(aType);
  16387. PushScope(Result);
  16388. end;
  16389. function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  16390. begin
  16391. Result:=TPasModuleDotScope.Create;
  16392. Result.Owner:=Self;
  16393. Result.Module:=aModule;
  16394. if aModule is TPasProgram then
  16395. begin // program
  16396. if TPasProgram(aModule).ProgramSection<>nil then
  16397. Result.InterfaceScope:=
  16398. NoNil(TPasProgram(aModule).ProgramSection.CustomData) as TPasSectionScope;
  16399. end
  16400. else if aModule is TPasLibrary then
  16401. begin // library
  16402. if TPasLibrary(aModule).LibrarySection<>nil then
  16403. Result.InterfaceScope:=
  16404. NoNil(TPasLibrary(aModule).LibrarySection.CustomData) as TPasSectionScope;
  16405. end
  16406. else
  16407. begin // unit
  16408. if aModule.InterfaceSection<>nil then
  16409. Result.InterfaceScope:=
  16410. NoNil(aModule.InterfaceSection.CustomData) as TPasSectionScope;
  16411. if (aModule=RootElement)
  16412. and (aModule.ImplementationSection<>nil)
  16413. and (aModule.ImplementationSection.CustomData<>nil)
  16414. then
  16415. Result.ImplementationScope:=NoNil(aModule.ImplementationSection.CustomData) as TPasSectionScope;
  16416. if CompareText(aModule.Name,'system')=0 then
  16417. Result.SystemScope:=DefaultScope;
  16418. end;
  16419. PushScope(Result);
  16420. end;
  16421. function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType;
  16422. WithTopHelpers: boolean): TPasDotClassScope;
  16423. var
  16424. ClassScope: TPasClassScope;
  16425. Ref: TResolvedReference;
  16426. begin
  16427. if CurClassType.IsForward then
  16428. begin
  16429. Ref:=CurClassType.CustomData as TResolvedReference;
  16430. CurClassType:=Ref.Declaration as TPasClassType;
  16431. end;
  16432. if CurClassType.CustomData=nil then
  16433. RaiseInternalError(20160922163611);
  16434. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  16435. Result:=TPasDotClassScope.Create;
  16436. Result.Owner:=Self;
  16437. Result.ClassRecScope:=ClassScope;
  16438. Result.GroupScope:=CreateGroupScope(CurClassType,WithTopHelpers);
  16439. PushScope(Result);
  16440. end;
  16441. function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  16442. var
  16443. RecScope: TPasRecordScope;
  16444. begin
  16445. RecScope:=NoNil(CurRecordType.CustomData) as TPasRecordScope;
  16446. Result:=TPasDotClassOrRecordScope.Create;
  16447. Result.Owner:=Self;
  16448. Result.ClassRecScope:=RecScope;
  16449. Result.GroupScope:=CreateGroupScope(CurRecordType);
  16450. PushScope(Result);
  16451. end;
  16452. function TPasResolver.PushInheritedScope(ClassOrRec: TPasMembersType;
  16453. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  16454. begin
  16455. Result:=TPasInheritedScope.Create;
  16456. Result.Owner:=Self;
  16457. Result.ClassRecScope:=NoNil(ClassOrRec.CustomData) as TPasClassOrRecordScope;
  16458. Result.AncestorScope:=AncestorScope;
  16459. Result.GroupScope:=CreateGroupScope(ClassOrRec,WithTopHelpers);
  16460. PushScope(Result);
  16461. end;
  16462. function TPasResolver.PushEnumDotScope(CurEnumType: TPasEnumType
  16463. ): TPasDotEnumTypeScope;
  16464. begin
  16465. Result:=TPasDotEnumTypeScope.Create;
  16466. Result.Owner:=Self;
  16467. Result.EnumScope:=NoNil(CurEnumType.CustomData) as TPasEnumTypeScope;
  16468. Result.GroupScope:=CreateGroupScope(CurEnumType);
  16469. PushScope(Result);
  16470. end;
  16471. function TPasResolver.PushHelperDotScope(TypeEl: TPasType): TPasDotBaseScope;
  16472. var
  16473. Group: TPasGroupScope;
  16474. begin
  16475. Group:=CreateGroupScope(TypeEl);
  16476. if Group.Count=0 then
  16477. begin
  16478. Group.Free;
  16479. exit(nil);
  16480. end;
  16481. Result:=TPasDotHelperScope.Create;
  16482. Result.Element:=TypeEl;
  16483. Result.Owner:=Self;
  16484. Result.GroupScope:=Group;
  16485. PushScope(Result);
  16486. end;
  16487. function TPasResolver.PushDotScope(TypeEl: TPasType): TPasDotBaseScope;
  16488. var
  16489. C: TClass;
  16490. begin
  16491. C:=TypeEl.ClassType;
  16492. if C=TPasClassType then
  16493. Result:=PushClassDotScope(TPasClassType(TypeEl))
  16494. else if C=TPasRecordType then
  16495. Result:=PushRecordDotScope(TPasRecordType(TypeEl))
  16496. else if C=TPasEnumType then
  16497. Result:=PushEnumDotScope(TPasEnumType(TypeEl))
  16498. else
  16499. Result:=PushHelperDotScope(TypeEl);
  16500. end;
  16501. function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  16502. var
  16503. WithEl: TPasImplWithDo;
  16504. WithScope: TPasWithScope;
  16505. ExprResolved: TPasResolverResult;
  16506. ErrorEl: TPasExpr;
  16507. TypeEl: TPasType;
  16508. ExprScope: TPasGroupScope;
  16509. ClassEl: TPasClassType;
  16510. WithExprScope: TPasWithExprScope;
  16511. Flags: TPasWithExprScopeFlags;
  16512. ClassRecScope: TPasClassOrRecordScope;
  16513. begin
  16514. if not (Expr.Parent is TPasImplWithDo) then
  16515. RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
  16516. WithEl:=TPasImplWithDo(Expr.Parent);
  16517. if not (WithEl.CustomData is TPasWithScope) then
  16518. RaiseInternalError(20181210175526);
  16519. WithScope:=TPasWithScope(WithEl.CustomData);
  16520. ResolveExpr(Expr,rraRead);
  16521. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  16522. {$IFDEF VerbosePasResolver}
  16523. writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
  16524. {$ENDIF}
  16525. ErrorEl:=Expr;
  16526. TypeEl:=ExprResolved.LoTypeEl;
  16527. // ToDo: use last element in Expr for error position
  16528. if TypeEl=nil then
  16529. RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  16530. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  16531. if (ExprResolved.BaseType in btAllStandardTypes) then
  16532. // ok
  16533. else if (ExprResolved.BaseType=btContext) then
  16534. // ok
  16535. else
  16536. RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  16537. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  16538. Flags:=[];
  16539. CheckUseAsType(TypeEl,20190123113957,Expr);
  16540. ClassRecScope:=nil;
  16541. ExprScope:=nil;
  16542. if TypeEl.ClassType=TPasClassOfType then
  16543. begin
  16544. // e.g. with ImageClass do FindHandlerFromExtension()
  16545. ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
  16546. ExprScope:=CreateGroupScope(ClassEl);
  16547. ClassRecScope:=TPasClassOrRecordScope(ClassEl.CustomData);
  16548. Include(Flags,wesfOnlyTypeMembers);
  16549. Include(Flags,wesfIsClassOf);
  16550. end
  16551. else if TypeEl is TPasMembersType then
  16552. ClassRecScope:=TPasClassOrRecordScope(TypeEl.CustomData);
  16553. if ExprScope=nil then
  16554. begin
  16555. ExprScope:=CreateGroupScope(TypeEl);
  16556. if ExprScope.Count=0 then
  16557. begin
  16558. ExprScope.Free;
  16559. RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  16560. [GetElementTypeName(TypeEl)],ErrorEl);
  16561. end;
  16562. if ExprResolved.IdentEl is TPasType then
  16563. // e.g. with TPoint do PointInCircle
  16564. Include(Flags,wesfOnlyTypeMembers);
  16565. end;
  16566. WithExprScope:=ScopeClass_WithExpr.Create;
  16567. WithExprScope.WithScope:=WithScope;
  16568. WithExprScope.Index:=WithEl.Expressions.Count;
  16569. WithExprScope.Expr:=Expr;
  16570. WithExprScope.Scope:=ExprScope;
  16571. WithExprScope.ClassRecScope:=ClassRecScope;
  16572. if not (ExprResolved.IdentEl is TPasType) then
  16573. Include(Flags,wesfNeedTmpVar);
  16574. if (not (rrfWritable in ExprResolved.Flags))
  16575. and (ExprResolved.BaseType=btContext)
  16576. and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
  16577. Include(Flags,wesfConstParent);
  16578. WithExprScope.Flags:=Flags;
  16579. WithScope.ExpressionScopes.Add(WithExprScope);
  16580. PushScope(WithExprScope);
  16581. Result:=WithExprScope;
  16582. end;
  16583. procedure TPasResolver.ResetSubExprScopes(out Depth: integer);
  16584. // move all sub scopes from Scopes to SubScopes
  16585. begin
  16586. Depth:=FSubScopeCount;
  16587. while TopScope is TPasSubExprScope do
  16588. begin
  16589. {$IFDEF VerbosePasResolver}
  16590. writeln('TPasResolver.ResetSubScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
  16591. {$ENDIF}
  16592. if FSubScopeCount=length(FSubScopes) then
  16593. SetLength(FSubScopes,FSubScopeCount+4);
  16594. FSubScopes[FSubScopeCount]:=TopScope;
  16595. inc(FSubScopeCount);
  16596. dec(FScopeCount);
  16597. FScopes[FScopeCount]:=nil;
  16598. if FScopeCount>0 then
  16599. FTopScope:=FScopes[FScopeCount-1]
  16600. else
  16601. FTopScope:=nil;
  16602. end;
  16603. end;
  16604. procedure TPasResolver.RestoreSubExprScopes(Depth: integer);
  16605. // restore sub scopes
  16606. begin
  16607. while FSubScopeCount>Depth do
  16608. begin
  16609. {$IFDEF VerbosePasResolver}
  16610. writeln('TPasResolver.RestoreSubScopes moving ',FSubScopes[FSubScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
  16611. {$ENDIF}
  16612. if FScopeCount=length(FScopes) then
  16613. SetLength(FScopes,FScopeCount+4);
  16614. dec(FSubScopeCount);
  16615. FScopes[FScopeCount]:=FSubScopes[FSubScopeCount];
  16616. FTopScope:=FScopes[FScopeCount];
  16617. FSubScopes[FSubScopeCount]:=nil;
  16618. inc(FScopeCount);
  16619. end;
  16620. end;
  16621. function TPasResolver.GetCurrentProcScope(ErrorEl: TPasElement
  16622. ): TPasProcedureScope;
  16623. var
  16624. Scope: TPasScope;
  16625. i: Integer;
  16626. begin
  16627. i:=ScopeCount;
  16628. repeat
  16629. dec(i);
  16630. if i<0 then
  16631. RaiseMsg(20171006001229,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  16632. Scope:=Scopes[i];
  16633. if Scope is TPasProcedureScope then
  16634. exit(TPasProcedureScope(Scope));
  16635. until false;
  16636. Result:=nil;
  16637. end;
  16638. function TPasResolver.GetProcScope(El: TPasElement): TPasProcedureScope;
  16639. var
  16640. CurEl: TPasElement;
  16641. begin
  16642. CurEl:=El;
  16643. while CurEl<>nil do
  16644. begin
  16645. if CurEl is TPasProcedure then
  16646. exit(TPasProcedureScope(CurEl.CustomData));
  16647. CurEl:=CurEl.Parent;
  16648. end;
  16649. Result:=nil;
  16650. end;
  16651. function TPasResolver.GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  16652. begin
  16653. Result:=GetCurrentProcScope(ErrorEl);
  16654. Result:=Result.GetSelfScope;
  16655. end;
  16656. function TPasResolver.GetSelfScope(El: TPasElement): TPasProcedureScope;
  16657. begin
  16658. Result:=GetProcScope(El);
  16659. if Result<>nil then
  16660. Result:=Result.GetSelfScope;
  16661. end;
  16662. procedure TPasResolver.AddHelper(Helper: TPasClassType;
  16663. var List: TPRHelperEntryArray);
  16664. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  16665. procedure Insert(Item: TPRHelperEntry; var A: TPRHelperEntryArray; Index: integer); overload;
  16666. var
  16667. i: Integer;
  16668. begin
  16669. if Index<0 then
  16670. RaiseInternalError(20190118211455);
  16671. if Index>length(A) then
  16672. RaiseInternalError(20190119122624);
  16673. SetLength(A,length(A)+1);
  16674. for i:=length(A)-1 downto Index+1 do
  16675. A[i]:=A[i-1];
  16676. A[Index]:=Item;
  16677. end;
  16678. {$ENDIF}
  16679. var
  16680. NewEntry, Entry: TPRHelperEntry;
  16681. i: Integer;
  16682. HelperForType: TPasType;
  16683. begin
  16684. HelperForType:=ResolveAliasType(Helper.HelperForType);
  16685. NewEntry:=TPRHelperEntry.Create;
  16686. NewEntry.Helper:=Helper;
  16687. NewEntry.HelperForType:=HelperForType;
  16688. NewEntry.Added:=length(List);
  16689. // keep list sorted for 1. HelperForType and 2. Added
  16690. i:=0;
  16691. while i<length(List) do
  16692. begin
  16693. Entry:=List[i];
  16694. if ComparePRHelperEntries(NewEntry,Entry)<=0 then break;
  16695. inc(i);
  16696. end;
  16697. Insert(NewEntry,List,i);
  16698. end;
  16699. procedure TPasResolver.AddActiveHelper(Helper: TPasClassType);
  16700. begin
  16701. AddHelper(Helper,FActiveHelpers);
  16702. end;
  16703. class function TPasResolver.MangleSourceLineNumber(Line, Column: integer
  16704. ): integer;
  16705. begin
  16706. if (Column<ParserMaxEmbeddedColumn)
  16707. and (Line<ParserMaxEmbeddedRow) then
  16708. Result:=-(Line*ParserMaxEmbeddedColumn+integer(Column))
  16709. else
  16710. Result:=Line;
  16711. end;
  16712. procedure TPasResolver.SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  16713. MsgNumber: integer; const Fmt: String;
  16714. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16715. PosEl: TPasElement);
  16716. var
  16717. {$IFDEF VerbosePasResolver}
  16718. s: string;
  16719. {$ENDIF}
  16720. Column, Row: integer;
  16721. begin
  16722. FLastMsgId := id;
  16723. FLastMsgType := MsgType;
  16724. FLastMsgNumber := MsgNumber;
  16725. FLastMsgPattern := Fmt;
  16726. FLastMsg := SafeFormat(Fmt,Args);
  16727. FLastElement := PosEl;
  16728. if PosEl=nil then
  16729. FLastSourcePos:=CurrentParser.CurSourcePos
  16730. else
  16731. begin
  16732. FLastSourcePos.FileName:=PosEl.SourceFilename;
  16733. UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
  16734. if Row>=0 then
  16735. FLastSourcePos.Row:=Row
  16736. else
  16737. FLastSourcePos.Row:=0;
  16738. if Column>=0 then
  16739. FLastSourcePos.Column:=Column
  16740. else
  16741. FLastSourcePos.Column:=0;
  16742. end;
  16743. CreateMsgArgs(FLastMsgArgs,Args);
  16744. {$IFDEF VerbosePasResolver}
  16745. {AllowWriteln}
  16746. write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
  16747. s:='';
  16748. str(MsgType,s);
  16749. write(s);
  16750. writeln(': [',MsgNumber,'] ',FLastMsg);
  16751. {AllowWriteln-}
  16752. {$ENDIF}
  16753. end;
  16754. procedure TPasResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
  16755. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16756. ErrorPosEl: TPasElement);
  16757. var
  16758. E: EPasResolve;
  16759. begin
  16760. SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  16761. E:=EPasResolve.Create(FLastMsg);
  16762. E.Id:=Id;
  16763. E.MsgType:=mtError;
  16764. E.MsgNumber:=MsgNumber;
  16765. E.MsgPattern:=Fmt;
  16766. E.PasElement:=ErrorPosEl;
  16767. E.Args:=FLastMsgArgs;
  16768. E.SourcePos:=FLastSourcePos;
  16769. raise E;
  16770. end;
  16771. procedure TPasResolver.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
  16772. Msg: string);
  16773. var
  16774. s: String;
  16775. begin
  16776. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  16777. if Msg<>'' then
  16778. s:=s+' '+Msg;
  16779. {$IFDEF VerbosePasResolver}
  16780. writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  16781. {$ENDIF}
  16782. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  16783. end;
  16784. procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
  16785. begin
  16786. {$IFDEF VerbosePasResolver}
  16787. writeln('TPasResolver.RaiseInternalError [',id,'] ',Msg);
  16788. {$ENDIF}
  16789. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  16790. end;
  16791. procedure TPasResolver.RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement;
  16792. const Msg: string);
  16793. var
  16794. i: Integer;
  16795. s: String;
  16796. begin
  16797. s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
  16798. for i:=0 to ScopeCount-1 do
  16799. begin
  16800. if i>0 then s:=s+',';
  16801. s:=s+Scopes[i].ClassName;
  16802. end;
  16803. if Msg<>'' then
  16804. s:=s+': '+Msg;
  16805. RaiseInternalError(id,s);
  16806. end;
  16807. procedure TPasResolver.RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string;
  16808. El: TPasElement);
  16809. begin
  16810. {$IFDEF VerbosePasResolver}
  16811. writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
  16812. WriteScopes;
  16813. {$ENDIF}
  16814. RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
  16815. end;
  16816. procedure TPasResolver.RaiseXExpectedButYFound(id: TMaxPrecInt; const X, Y: string;
  16817. El: TPasElement);
  16818. begin
  16819. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
  16820. end;
  16821. procedure TPasResolver.RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C, X,
  16822. Y: string; El: TPasElement);
  16823. begin
  16824. RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
  16825. end;
  16826. procedure TPasResolver.RaiseContextXInvalidY(id: TMaxPrecInt; const X, Y: string;
  16827. El: TPasElement);
  16828. begin
  16829. RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
  16830. end;
  16831. procedure TPasResolver.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  16832. begin
  16833. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  16834. end;
  16835. procedure TPasResolver.RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement;
  16836. IdentEl: TPasElement);
  16837. begin
  16838. if IdentEl is TPasProperty then
  16839. RaiseMsg(id,nNoMemberIsProvidedToAccessProperty,
  16840. sNoMemberIsProvidedToAccessProperty,[],ErrorEl)
  16841. else
  16842. RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  16843. end;
  16844. procedure TPasResolver.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  16845. begin
  16846. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  16847. end;
  16848. procedure TPasResolver.RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  16849. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16850. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  16851. function GetString(ArgNo: integer): string;
  16852. begin
  16853. if ArgNo>High(Args) then
  16854. exit('invalid param '+IntToStr(ArgNo));
  16855. {$ifdef pas2js}
  16856. if isString(Args[ArgNo]) then
  16857. Result:=String(Args[ArgNo])
  16858. else
  16859. Result:='invalid param '+jsTypeOf(Args[ArgNo]);
  16860. {$else}
  16861. case Args[ArgNo].VType of
  16862. vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
  16863. else
  16864. Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
  16865. end;
  16866. {$endif}
  16867. end;
  16868. begin
  16869. case MsgNumber of
  16870. nIllegalTypeConversionTo:
  16871. RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
  16872. nIncompatibleTypesGotExpected:
  16873. RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
  16874. nIncompatibleTypeArgNo:
  16875. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
  16876. nIncompatibleTypeArgNoVarParamMustMatchExactly:
  16877. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
  16878. [GetString(0),GotDesc,ExpDesc],ErrorEl);
  16879. nResultTypeMismatchExpectedButFound:
  16880. RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
  16881. nXExpectedButYFound:
  16882. RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
  16883. nOperatorIsNotOverloadedAOpB:
  16884. RaiseMsg(id,MsgNumber,sOperatorIsNotOverloadedAOpB,[GotDesc,GetString(0),ExpDesc],ErrorEl);
  16885. nTypesAreNotRelatedXY:
  16886. RaiseMsg(id,MsgNumber,sTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  16887. else
  16888. RaiseInternalError(20170329112911);
  16889. end;
  16890. end;
  16891. procedure TPasResolver.RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  16892. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16893. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  16894. var
  16895. DescA, DescB: String;
  16896. begin
  16897. DescA:=GetTypeDescription(GotType);
  16898. DescB:=GetTypeDescription(ExpType);
  16899. if DescA=DescB then
  16900. begin
  16901. DescA:=GetTypeDescription(GotType,true);
  16902. DescB:=GetTypeDescription(ExpType,true);
  16903. end;
  16904. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
  16905. end;
  16906. procedure TPasResolver.RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  16907. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16908. const GotType, ExpType: TPasResolverResult;
  16909. ErrorEl: TPasElement);
  16910. var
  16911. GotDesc, ExpDesc: String;
  16912. begin
  16913. {$IFDEF VerbosePasResolver}
  16914. writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  16915. {$ENDIF}
  16916. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  16917. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  16918. end;
  16919. procedure TPasResolver.RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt;
  16920. ErrorEl: TPasElement);
  16921. begin
  16922. RaiseMsg(id,nHelpersCannotBeUsedAsTypes,sHelpersCannotBeUsedAsTypes,[],ErrorEl);
  16923. end;
  16924. procedure TPasResolver.RaiseInvalidProcTypeModifier(id: TMaxPrecInt;
  16925. ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
  16926. begin
  16927. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
  16928. ProcTypeModifiers[ptm]],ErrorEl);
  16929. end;
  16930. procedure TPasResolver.RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  16931. pm: TProcedureModifier; ErrorEl: TPasElement);
  16932. begin
  16933. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
  16934. ModifierNames[pm]],ErrorEl);
  16935. end;
  16936. procedure TPasResolver.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  16937. MsgNumber: integer; const Fmt: String;
  16938. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  16939. PosEl: TPasElement);
  16940. var
  16941. Scanner: TPascalScanner;
  16942. State: TWarnMsgState;
  16943. {$IFDEF VerbosePasResolver}
  16944. s: String;
  16945. {$ENDIF}
  16946. begin
  16947. Scanner:=CurrentParser.Scanner;
  16948. if (Scanner<>nil) then
  16949. begin
  16950. if (FStep<prsFinishingModule)
  16951. and (Scanner.IgnoreMsgType(MsgType)) then
  16952. exit; // during parsing consider directives like $Hints on|off
  16953. if MsgType>=mtWarning then
  16954. begin
  16955. State:=Scanner.WarnMsgState[MsgNumber];
  16956. case State of
  16957. wmsOff:
  16958. begin
  16959. {$IFDEF VerbosePasResolver}
  16960. {AllowWriteln}
  16961. write('TPasResolver.LogMsg ignoring ',id,' ',GetElementSourcePosStr(PosEl),' ');
  16962. s:='';
  16963. str(MsgType,s);
  16964. write(s);
  16965. writeln(': [',MsgNumber,'] ',SafeFormat(Fmt,Args));
  16966. {AllowWriteln-}
  16967. {$ENDIF}
  16968. exit; // ignore
  16969. end;
  16970. wmsError:
  16971. begin
  16972. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl);
  16973. exit;
  16974. end;
  16975. end;
  16976. end;
  16977. end;
  16978. SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  16979. if Assigned(OnLog) then
  16980. OnLog(Self,FLastMsg)
  16981. else if Assigned(CurrentParser.OnLog) then
  16982. CurrentParser.OnLog(Self,FLastMsg);
  16983. end;
  16984. class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
  16985. MsgNumbers: TIntegerDynArray): boolean;
  16986. procedure SetNumber(Number: integer);
  16987. begin
  16988. {$IF FPC_FULLVERSION>=30101}
  16989. MsgNumbers:=[Number];
  16990. {$ELSE}
  16991. Setlength(MsgNumbers,1);
  16992. MsgNumbers[0]:=Number;
  16993. {$ENDIF}
  16994. end;
  16995. procedure SetNumbers(Numbers: array of integer);
  16996. var
  16997. i: Integer;
  16998. begin
  16999. Setlength(MsgNumbers,length(Numbers));
  17000. for i:=0 to high(Numbers) do
  17001. MsgNumbers[i]:=Numbers[i];
  17002. end;
  17003. begin
  17004. if Identifier='' then exit(false);
  17005. if Identifier[1] in ['0'..'9'] then exit(false);
  17006. Result:=true;
  17007. case UpperCase(Identifier) of
  17008. // FPC:
  17009. 'CONSTRUCTING_ABSTRACT': SetNumber(nConstructingClassXWithAbstractMethodY); // Constructing an instance of a class with abstract methods.
  17010. //'IMPLICIT_VARIANTS': ; // Implicit use of the variants unit.
  17011. // useanalyzer: 'NO_RETVAL': ; // Function result is not set.
  17012. 'SYMBOL_DEPRECATED': SetNumber(nSymbolXIsDeprecated); // Deprecated symbol.
  17013. 'SYMBOL_EXPERIMENTAL': SetNumber(nSymbolXIsExperimental); // Experimental symbol
  17014. 'SYMBOL_LIBRARY': SetNumber(nSymbolXBelongsToALibrary); // Not used.
  17015. 'SYMBOL_PLATFORM': SetNumber(nSymbolXIsNotPortable); // Platform-dependent symbol.
  17016. 'SYMBOL_UNIMPLEMENTED': SetNumber(nSymbolXIsNotImplemented); // Unimplemented symbol.
  17017. //'UNIT_DEPRECATED': ; // Deprecated unit.
  17018. //'UNIT_EXPERIMENTAL': ; // Experimental unit.
  17019. //'UNIT_LIBRARY': ; //
  17020. //'UNIT_PLATFORM': ; // Platform dependent unit.
  17021. //'UNIT_UNIMPLEMENTED': ; // Unimplemented unit.
  17022. //'ZERO_NIL_COMPAT': ; // Converting 0 to NIL
  17023. //'IMPLICIT_STRING_CAST': ; // Implicit string type conversion
  17024. //'IMPLICIT_STRING_CAST_LOSS': ; // Implicit string typecast with potential data loss from ”$1” to ”$2”
  17025. //'EXPLICIT_STRING_CAST': ; // Explicit string type conversion
  17026. //'EXPLICIT_STRING_CAST_LOSS': ; // Explicit string typecast with potential data loss from ”$1” to ”$2”
  17027. //'CVT_NARROWING_STRING_LOST': ; // Unicode constant cast with potential data loss
  17028. // Delphi:
  17029. 'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
  17030. 'GARBAGE': SetNumber(nTextAfterFinalIgnored); // text after final end.
  17031. 'BOUNDS_ERROR': SetNumbers([nRangeCheckError,
  17032. nHighRangeLimitLTLowRangeLimit,
  17033. nRangeCheckEvaluatingConstantsVMinMax,
  17034. nRangeCheckInSetConstructor]);
  17035. 'MESSAGE_DIRECTIVE': SetNumber(nUserDefined); // $message directive
  17036. else
  17037. Result:=false;
  17038. end;
  17039. end;
  17040. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  17041. ExpType: TPasResolverResult; out GotDesc, ExpDesc: String);
  17042. begin
  17043. {$IFDEF VerbosePasResolver}
  17044. writeln('TPasResolver.GetIncompatibleTypeDesc Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  17045. {$ENDIF}
  17046. if GotType.BaseType<>ExpType.BaseType then
  17047. begin
  17048. GotDesc:=GetBaseDescription(GotType);
  17049. if ExpType.BaseType=btNil then
  17050. ExpDesc:=BaseTypeNames[btPointer]
  17051. else
  17052. ExpDesc:=GetBaseDescription(ExpType);
  17053. if GotDesc=ExpDesc then
  17054. begin
  17055. GotDesc:=GetBaseDescription(GotType,true);
  17056. ExpDesc:=GetBaseDescription(ExpType,true);
  17057. end;
  17058. end
  17059. else if (GotType.LoTypeEl<>nil) and (ExpType.LoTypeEl<>nil) then
  17060. begin
  17061. GotDesc:=GetTypeDescription(GotType);
  17062. ExpDesc:=GetTypeDescription(ExpType);
  17063. if GotDesc<>ExpDesc then exit;
  17064. if GotType.HiTypeEl<>ExpType.HiTypeEl then
  17065. begin
  17066. GotDesc:=GetTypeDescription(GotType.HiTypeEl);
  17067. ExpDesc:=GetTypeDescription(ExpType.HiTypeEl);
  17068. if GotDesc<>ExpDesc then exit;
  17069. end;
  17070. GotDesc:=GetTypeDescription(GotType,true);
  17071. ExpDesc:=GetTypeDescription(ExpType,true);
  17072. end
  17073. else
  17074. begin
  17075. GotDesc:=GetResolverResultDescription(GotType,true);
  17076. ExpDesc:=GetResolverResultDescription(ExpType,true);
  17077. if GotDesc=ExpDesc then
  17078. begin
  17079. GotDesc:=GetResolverResultDescription(GotType,false);
  17080. ExpDesc:=GetResolverResultDescription(ExpType,false);
  17081. end;
  17082. end;
  17083. end;
  17084. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  17085. ExpType: TPasType; out GotDesc, ExpDesc: String);
  17086. begin
  17087. GotDesc:=GetTypeDescription(GotType);
  17088. ExpDesc:=GetTypeDescription(ExpType);
  17089. if GotDesc<>ExpDesc then exit;
  17090. GotDesc:=GetTypeDescription(GotType,true);
  17091. ExpDesc:=GetTypeDescription(ExpType,true);
  17092. end;
  17093. function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
  17094. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
  17095. ): integer;
  17096. var
  17097. ProcArgs: TFPList;
  17098. i, ParamCnt, ParamCompatibility: Integer;
  17099. Param: TPasExpr;
  17100. ParamResolved: TPasResolverResult;
  17101. Flags: TPasResolverComputeFlags;
  17102. begin
  17103. Result:=cExact;
  17104. ProcArgs:=ProcType.Args;
  17105. // check args
  17106. ParamCnt:=length(Params.Params);
  17107. i:=0;
  17108. while i<ParamCnt do
  17109. begin
  17110. Param:=Params.Params[i];
  17111. {$IFDEF VerbosePasResolver}
  17112. writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
  17113. {$ENDIF}
  17114. if i<ProcArgs.Count then
  17115. begin
  17116. ParamCompatibility:=CheckParamCompatibility(Param,
  17117. TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
  17118. if ParamCompatibility=cIncompatible then
  17119. exit(cIncompatible);
  17120. end
  17121. else
  17122. begin
  17123. if ptmVarargs in ProcType.Modifiers then
  17124. begin
  17125. if SetReferenceFlags then
  17126. Flags:=[rcNoImplicitProcType,rcSetReferenceFlags]
  17127. else
  17128. Flags:=[rcNoImplicitProcType];
  17129. ComputeElement(Param,ParamResolved,Flags,Param);
  17130. if not (rrfReadable in ParamResolved.Flags) then
  17131. begin
  17132. if RaiseOnError then
  17133. RaiseVarExpected(20180712001415,Param,ParamResolved.IdentEl);
  17134. exit(cIncompatible);
  17135. end;
  17136. ParamCompatibility:=cExact;
  17137. end
  17138. else
  17139. begin
  17140. // too many arguments
  17141. if RaiseOnError then
  17142. RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
  17143. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
  17144. exit(cIncompatible);
  17145. end;
  17146. end;
  17147. if Result<cTypeConversion then
  17148. inc(Result,ParamCompatibility)
  17149. else
  17150. Result:=Max(Result,ParamCompatibility);
  17151. inc(i);
  17152. end;
  17153. if (i<ProcArgs.Count) then
  17154. if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
  17155. begin
  17156. // not enough arguments
  17157. if RaiseOnError then
  17158. // ToDo: position cursor on identifier
  17159. RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
  17160. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
  17161. exit(cIncompatible);
  17162. end
  17163. else
  17164. begin
  17165. // the rest are default params
  17166. end;
  17167. end;
  17168. function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
  17169. Params: TParamsExpr; RaiseOnError: boolean): integer;
  17170. var
  17171. PropArg: TPasArgument;
  17172. ArgNo, ParamComp: Integer;
  17173. Param: TPasExpr;
  17174. PropArgs: TFPList;
  17175. begin
  17176. Result:=cExact;
  17177. PropArgs:=GetPasPropertyArgs(PropEl);
  17178. if PropArgs.Count<length(Params.Params) then
  17179. begin
  17180. if not RaiseOnError then exit(cIncompatible);
  17181. RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  17182. [PropEl.Name],Params)
  17183. end
  17184. else if PropArgs.Count>length(Params.Params) then
  17185. begin
  17186. if not RaiseOnError then exit(cIncompatible);
  17187. RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
  17188. [TPasArgument(PropArgs[length(Params.Params)]).Name],Params);
  17189. end;
  17190. for ArgNo:=0 to PropArgs.Count-1 do
  17191. begin
  17192. PropArg:=TPasArgument(PropArgs[ArgNo]);
  17193. Param:=Params.Params[ArgNo];
  17194. ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
  17195. if ParamComp=cIncompatible then
  17196. exit(cIncompatible);
  17197. inc(Result,ParamComp);
  17198. end;
  17199. end;
  17200. function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  17201. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
  17202. var
  17203. ArgNo: Integer;
  17204. Param: TPasExpr;
  17205. ParamResolved: TPasResolverResult;
  17206. procedure GetNextParam;
  17207. begin
  17208. if ArgNo>=length(Params.Params) then
  17209. RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  17210. [],Params);
  17211. Param:=Params.Params[ArgNo];
  17212. ComputeElement(Param,ParamResolved,[]);
  17213. inc(ArgNo);
  17214. end;
  17215. var
  17216. DimNo: integer;
  17217. RangeResolved, OrigRangeResolved, OrigParamResolved: TPasResolverResult;
  17218. bt: TResolverBaseType;
  17219. NextType, TypeEl: TPasType;
  17220. RangeExpr: TPasExpr;
  17221. TypeFits: Boolean;
  17222. ParamValue: TResEvalValue;
  17223. begin
  17224. ArgNo:=0;
  17225. repeat
  17226. if length(ArrayEl.Ranges)=0 then
  17227. begin
  17228. // dynamic/open array -> needs exactly one integer
  17229. GetNextParam;
  17230. if (not (rrfReadable in ParamResolved.Flags))
  17231. or not (ParamResolved.BaseType in btAllInteger) then
  17232. exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
  17233. if EmitHints then
  17234. begin
  17235. ParamValue:=Eval(Param,[refAutoConstExt]);
  17236. if ParamValue<>nil then
  17237. try // has const value -> check range
  17238. if ParamValue.Kind=revkExternal then
  17239. // ignore
  17240. else if (ParamValue.Kind<>revkInt)
  17241. or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
  17242. or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
  17243. fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
  17244. DynArrayMinIndex,DynArrayMaxIndex,Param);
  17245. finally
  17246. ReleaseEvalValue(ParamValue);
  17247. end;
  17248. end;
  17249. end
  17250. else
  17251. begin
  17252. // static array
  17253. for DimNo:=0 to length(ArrayEl.Ranges)-1 do
  17254. begin
  17255. GetNextParam;
  17256. RangeExpr:=ArrayEl.Ranges[DimNo];
  17257. ComputeElement(RangeExpr,RangeResolved,[]);
  17258. bt:=RangeResolved.BaseType;
  17259. if not (rrfReadable in ParamResolved.Flags) then
  17260. begin
  17261. if not RaiseOnError then exit(cIncompatible);
  17262. RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
  17263. [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
  17264. end;
  17265. TypeFits:=false;
  17266. OrigRangeResolved:=RangeResolved;
  17267. OrigParamResolved:=ParamResolved;
  17268. if bt=btRange then
  17269. begin
  17270. ConvertRangeToElement(RangeResolved);
  17271. bt:=RangeResolved.BaseType;
  17272. end;
  17273. if ParamResolved.BaseType=btRange then
  17274. begin
  17275. ConvertRangeToElement(ParamResolved);
  17276. end;
  17277. if (bt in btAllBooleans) then
  17278. begin
  17279. if (ParamResolved.BaseType in btAllBooleans) then
  17280. TypeFits:=true;
  17281. end
  17282. else if (bt in btAllInteger) then
  17283. begin
  17284. if (ParamResolved.BaseType in btAllInteger) then
  17285. TypeFits:=true;
  17286. end
  17287. else if (bt in btAllChars) then
  17288. begin
  17289. if (ParamResolved.BaseType in btAllChars) then
  17290. TypeFits:=true;
  17291. end
  17292. else if (bt=btContext) then
  17293. begin
  17294. TypeEl:=RangeResolved.LoTypeEl;
  17295. if ParamResolved.BaseType=btContext then
  17296. begin
  17297. if (TypeEl.ClassType=TPasEnumType)
  17298. and IsSameType(TypeEl,ParamResolved.LoTypeEl,prraNone) then
  17299. TypeFits:=true;
  17300. end;
  17301. end;
  17302. if not TypeFits then
  17303. begin
  17304. // incompatible
  17305. if not RaiseOnError then exit(cIncompatible);
  17306. RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
  17307. [IntToStr(ArgNo)],OrigParamResolved,OrigRangeResolved,Param);
  17308. end;
  17309. if EmitHints then
  17310. fExprEvaluator.IsInRange(Param,RangeExpr,true);
  17311. end;
  17312. end;
  17313. if ArgNo=length(Params.Params) then exit(cExact);
  17314. // there are more parameters -> continue in sub array
  17315. NextType:=ResolveAliasType(ArrayEl.ElType);
  17316. if NextType.ClassType<>TPasArrayType then
  17317. RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  17318. [],Params);
  17319. ArrayEl:=TPasArrayType(NextType);
  17320. until false;
  17321. Result:=cIncompatible;
  17322. end;
  17323. function TPasResolver.CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure
  17324. ): boolean;
  17325. // returns if number and type of arguments fit
  17326. // does not check calling convention
  17327. var
  17328. ProcArgs1, ProcArgs2: TFPList;
  17329. i: Integer;
  17330. begin
  17331. Result:=false;
  17332. ProcArgs1:=Proc1.ProcType.Args;
  17333. ProcArgs2:=Proc2.ProcType.Args;
  17334. {$IFDEF VerbosePasResolver}
  17335. writeln('TPasResolver.CheckOverloadProcCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
  17336. {$ENDIF}
  17337. // check args
  17338. if ProcArgs1.Count<>ProcArgs2.Count then
  17339. exit;
  17340. for i:=0 to ProcArgs1.Count-1 do
  17341. begin
  17342. {$IFDEF VerbosePasResolver}
  17343. writeln('TPasResolver.CheckOverloadProcCompatibility ',i,'/',ProcArgs1.Count);
  17344. {$ENDIF}
  17345. if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),
  17346. TPasArgument(ProcArgs2[i])) then
  17347. exit;
  17348. end;
  17349. Result:=true;
  17350. end;
  17351. function TPasResolver.CheckProcTypeCompatibility(Proc1,
  17352. Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
  17353. RaiseOnIncompatible: boolean): boolean;
  17354. // if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
  17355. function ModifierError(Modifier: TProcTypeModifier): boolean;
  17356. begin
  17357. Result:=false;
  17358. if not RaiseOnIncompatible then exit;
  17359. RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
  17360. [GetElementTypeName(Proc1),ProcTypeModifiers[Modifier]],ErrorEl);
  17361. end;
  17362. var
  17363. ProcArgs1, ProcArgs2: TFPList;
  17364. i: Integer;
  17365. Result1Resolved, Result2Resolved: TPasResolverResult;
  17366. ExpectedArg, ActualArg: TPasArgument;
  17367. begin
  17368. Result:=false;
  17369. if Proc1.ClassType<>Proc2.ClassType then
  17370. begin
  17371. if RaiseOnIncompatible then
  17372. RaiseXExpectedButYFound(20170402112353,GetElementTypeName(Proc1),GetElementTypeName(Proc2),ErrorEl);
  17373. exit;
  17374. end;
  17375. if Proc1.IsReferenceTo then
  17376. begin
  17377. if IsAssign then
  17378. // aRefTo:=aproc -> any IsNested/OfObject is allowed
  17379. else
  17380. ; // aRefTo = AnyProc -> ok
  17381. end
  17382. else if Proc2.IsReferenceTo then
  17383. begin
  17384. if IsAssign then
  17385. // NonRefTo := aRefTo -> not possible
  17386. exit(ModifierError(ptmReferenceTo))
  17387. else
  17388. ; // AnyProc = aRefTo -> ok
  17389. end
  17390. else if Proc2.Parent is TPasAnonymousProcedure then
  17391. begin
  17392. if IsAssign then
  17393. // NonRefTo := AnonymousProc -> not possible
  17394. exit(ModifierError(ptmReferenceTo))
  17395. else
  17396. ; // AnyProc = AnonymousProc -> ok
  17397. end
  17398. else
  17399. begin
  17400. // neither Proc1 nor Proc2 is a reference-to -> check isNested and OfObject
  17401. if Proc1.IsNested<>Proc2.IsNested then
  17402. exit(ModifierError(ptmIsNested));
  17403. if Proc1.IsOfObject<>Proc2.IsOfObject then
  17404. begin
  17405. if (proProcTypeWithoutIsNested in Options) then
  17406. exit(ModifierError(ptmOfObject))
  17407. else if Proc1.IsNested then
  17408. // "is nested" can handle both, proc and method.
  17409. else
  17410. exit(ModifierError(ptmOfObject))
  17411. end;
  17412. end;
  17413. if Proc1.CallingConvention<>Proc2.CallingConvention then
  17414. begin
  17415. if RaiseOnIncompatible then
  17416. RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
  17417. [],ErrorEl);
  17418. exit;
  17419. end;
  17420. ProcArgs1:=Proc1.Args;
  17421. ProcArgs2:=Proc2.Args;
  17422. if ProcArgs1.Count<>ProcArgs2.Count then
  17423. begin
  17424. if RaiseOnIncompatible then
  17425. RaiseMsg(20170902142829,nIncompatibleTypesGotParametersExpected,
  17426. sIncompatibleTypesGotParametersExpected,
  17427. [IntToStr(ProcArgs1.Count),IntToStr(ProcArgs2.Count)],ErrorEl);
  17428. exit;
  17429. end;
  17430. for i:=0 to ProcArgs1.Count-1 do
  17431. begin
  17432. {$IFDEF VerbosePasResolver}
  17433. writeln('TPasResolver.CheckProcAssignCompatibility ',i,'/',ProcArgs1.Count);
  17434. {$ENDIF}
  17435. ExpectedArg:=TPasArgument(ProcArgs1[i]);
  17436. ActualArg:=TPasArgument(ProcArgs2[i]);
  17437. if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
  17438. begin
  17439. if RaiseOnIncompatible then
  17440. begin
  17441. if ExpectedArg.Access<>ActualArg.Access then
  17442. RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  17443. [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
  17444. AccessDescriptions[ExpectedArg.Access]],
  17445. ErrorEl);
  17446. RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
  17447. [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
  17448. end;
  17449. exit;
  17450. end;
  17451. end;
  17452. if Proc1 is TPasFunctionType then
  17453. begin
  17454. ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
  17455. ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
  17456. if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
  17457. or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
  17458. begin
  17459. if RaiseOnIncompatible then
  17460. RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
  17461. [],Result1Resolved,Result2Resolved,ErrorEl);
  17462. exit;
  17463. end;
  17464. end;
  17465. Result:=true;
  17466. end;
  17467. function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
  17468. begin
  17469. Result:=false;
  17470. // check access: var, const, ...
  17471. if Arg1.Access<>Arg2.Access then exit;
  17472. // check untyped
  17473. if Arg1.ArgType=nil then
  17474. exit(Arg2.ArgType=nil);
  17475. if Arg2.ArgType=nil then exit;
  17476. Result:=CheckElTypeCompatibility(Arg1.ArgType,Arg2.ArgType,prraSimple);
  17477. end;
  17478. function TPasResolver.CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  17479. ResolveAlias: TPRResolveAlias): boolean;
  17480. var
  17481. Arg1Resolved, Arg2Resolved: TPasResolverResult;
  17482. C: TClass;
  17483. Arr1, Arr2: TPasArrayType;
  17484. begin
  17485. ComputeElement(Arg1,Arg1Resolved,[rcType]);
  17486. ComputeElement(Arg2,Arg2Resolved,[rcType]);
  17487. {$IFDEF VerbosePasResolver}
  17488. //writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
  17489. {$ENDIF}
  17490. if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
  17491. or (Arg1Resolved.LoTypeEl=nil)
  17492. or (Arg2Resolved.LoTypeEl=nil) then
  17493. exit(false);
  17494. if Arg1Resolved.BaseType=Arg2Resolved.BaseType then
  17495. begin
  17496. if ResolveAlias=prraSimple then
  17497. begin
  17498. if IsSameType(Arg1Resolved.HiTypeEl,Arg2Resolved.HiTypeEl,prraSimple) then
  17499. exit(true);
  17500. end
  17501. else
  17502. begin
  17503. if IsSameType(Arg1Resolved.LoTypeEl,Arg2Resolved.LoTypeEl,prraNone) then
  17504. exit(true);
  17505. end;
  17506. end;
  17507. C:=Arg1Resolved.LoTypeEl.ClassType;
  17508. if (C=TPasArrayType) and (Arg2Resolved.LoTypeEl.ClassType=TPasArrayType) then
  17509. begin
  17510. Arr1:=TPasArrayType(Arg1Resolved.LoTypeEl);
  17511. Arr2:=TPasArrayType(Arg2Resolved.LoTypeEl);
  17512. if length(Arr1.Ranges)<>length(Arr2.Ranges) then
  17513. exit(false);
  17514. if length(Arr1.Ranges)>0 then
  17515. RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
  17516. Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
  17517. exit;
  17518. end;
  17519. Result:=false;
  17520. end;
  17521. function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  17522. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  17523. var
  17524. El: TPasElement;
  17525. begin
  17526. Result:=false;
  17527. El:=ResolvedEl.IdentEl;
  17528. if El=nil then
  17529. begin
  17530. if (ResolvedEl.ExprEl is TUnaryExpr)
  17531. and (TUnaryExpr(ResolvedEl.ExprEl).OpCode=eopDeref) then
  17532. begin
  17533. // e.g. p^:=
  17534. end
  17535. else
  17536. begin
  17537. if ErrorOnFalse then
  17538. begin
  17539. {$IFDEF VerbosePasResolver}
  17540. writeln('TPasResolver.CheckCanBeLHS no identifier: ',GetResolverResultDbg(ResolvedEl));
  17541. {$ENDIF}
  17542. if (ResolvedEl.LoTypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
  17543. RaiseXExpectedButYFound(20170216152727,'identifier',GetElementTypeName(ResolvedEl.LoTypeEl),ResolvedEl.ExprEl)
  17544. else
  17545. RaiseVarExpected(20170216152426,ErrorEl,ResolvedEl.IdentEl);
  17546. end;
  17547. exit;
  17548. end;
  17549. end;
  17550. if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
  17551. exit(not IsVariableConst(El,ErrorEl,ErrorOnFalse));
  17552. // not writable
  17553. if not ErrorOnFalse then exit;
  17554. {$IFDEF VerbosePasResolver}
  17555. writeln('TPasResolver.CheckCanBeLHS not writable: ',GetResolverResultDbg(ResolvedEl));
  17556. {$ENDIF}
  17557. if ResolvedEl.IdentEl is TPasProperty then
  17558. RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
  17559. else if ResolvedEl.IdentEl is TPasConst then
  17560. RaiseMsg(20180430012042,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],ErrorEl)
  17561. else
  17562. RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  17563. end;
  17564. function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
  17565. RaiseOnIncompatible: boolean; ErrorEl: TPasElement): integer;
  17566. var
  17567. LeftResolved, RightResolved: TPasResolverResult;
  17568. Flags: TPasResolverComputeFlags;
  17569. IsProcType: Boolean;
  17570. begin
  17571. if ErrorEl=nil then
  17572. ErrorEl:=RHS;
  17573. ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
  17574. Flags:=[];
  17575. IsProcType:=IsProcedureType(LeftResolved,true);
  17576. if IsProcType then
  17577. if msDelphi in CurrentParser.CurrentModeswitches then
  17578. Include(Flags,rcNoImplicitProc)
  17579. else
  17580. Include(Flags,rcNoImplicitProcType);
  17581. ComputeElement(RHS,RightResolved,Flags);
  17582. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  17583. if RHS is TPasExpr then
  17584. CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
  17585. end;
  17586. procedure TPasResolver.CheckAssignExprRange(
  17587. const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  17588. // if RHS is a constant check if it fits into range LeftResolved
  17589. var
  17590. LRangeValue, RValue: TResEvalValue;
  17591. Int, MinVal, MaxVal: TMaxPrecInt;
  17592. RangeExpr: TBinaryExpr;
  17593. C: TClass;
  17594. EnumType: TPasEnumType;
  17595. bt: TResolverBaseType;
  17596. LTypeEl: TPasType;
  17597. begin
  17598. LTypeEl:=LeftResolved.LoTypeEl;
  17599. if (LTypeEl<>nil)
  17600. and ((LTypeEl.ClassType=TPasArrayType)
  17601. or (LTypeEl.ClassType=TPasRecordType)) then
  17602. exit; // arrays and records are checked by element, not by the whole value
  17603. if LTypeEl is TPasClassOfType then
  17604. exit; // class-of are checked only by type, not by value
  17605. RValue:=Eval(RHS,[refAutoConstExt]);
  17606. if RValue=nil then
  17607. exit; // not a const expression
  17608. {$IFDEF VerbosePasResEval}
  17609. writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
  17610. {$ENDIF}
  17611. LRangeValue:=nil;
  17612. try
  17613. if RValue.Kind=revkExternal then
  17614. // skip
  17615. else if LeftResolved.BaseType=btCustom then
  17616. CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
  17617. else if LeftResolved.BaseType=btSet then
  17618. begin
  17619. // assign to a set
  17620. C:=LTypeEl.ClassType;
  17621. if C=TPasRangeType then
  17622. begin
  17623. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  17624. LRangeValue:=Eval(RangeExpr,[refConst],false);
  17625. end
  17626. else if C=TPasEnumType then
  17627. begin
  17628. EnumType:=TPasEnumType(LTypeEl);
  17629. LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
  17630. 0,TMaxPrecInt(EnumType.Values.Count)-1);
  17631. end
  17632. else if C=TPasUnresolvedSymbolRef then
  17633. begin
  17634. // set of basetype
  17635. if LTypeEl.CustomData is TResElDataBaseType then
  17636. begin
  17637. bt:=GetActualBaseType(TResElDataBaseType(LTypeEl.CustomData).BaseType);
  17638. if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinVal,MaxVal) then
  17639. LRangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
  17640. else if bt=btBoolean then
  17641. LRangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
  17642. {$ifdef FPC_HAS_CPSTRING}
  17643. else if bt=btAnsiChar then
  17644. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  17645. {$endif}
  17646. else if bt=btWideChar then
  17647. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
  17648. else
  17649. RaiseNotYetImplemented(20170714205110,RHS);
  17650. end
  17651. else
  17652. RaiseNotYetImplemented(20170714204803,RHS);
  17653. end
  17654. else
  17655. RaiseNotYetImplemented(20170714193100,RHS);
  17656. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true);
  17657. end
  17658. else if LTypeEl is TPasRangeType then
  17659. begin
  17660. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  17661. LRangeValue:=Eval(RangeExpr,[refConst]);
  17662. if LeftResolved.BaseType=btSet then
  17663. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true)
  17664. else
  17665. fExprEvaluator.IsInRange(RValue,RHS,LRangeValue,RangeExpr,true);
  17666. end
  17667. else if (LeftResolved.BaseType in btAllIntegerNoQWord)
  17668. and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
  17669. case RValue.Kind of
  17670. revkInt:
  17671. if (MinVal>TResEvalInt(RValue).Int)
  17672. or (MaxVal<TResEvalInt(RValue).Int) then
  17673. fExprEvaluator.EmitRangeCheckConst(20170530093126,
  17674. IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
  17675. revkUInt:
  17676. if (TResEvalUInt(RValue).UInt>High(TMaxPrecInt))
  17677. or (MinVal>TMaxPrecInt(TResEvalUInt(RValue).UInt))
  17678. or (MaxVal<TMaxPrecInt(TResEvalUInt(RValue).UInt)) then
  17679. fExprEvaluator.EmitRangeCheckConst(20170530093616,
  17680. IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
  17681. revkFloat:
  17682. if TResEvalFloat(RValue).IsInt(Int) then
  17683. begin
  17684. if (MinVal>Int) or (MaxVal<Int) then
  17685. fExprEvaluator.EmitRangeCheckConst(20170802133307,
  17686. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  17687. end
  17688. else
  17689. begin
  17690. {$IFDEF VerbosePasResEval}
  17691. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<TMaxPrecFloat(low(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>TMaxPrecFloat(high(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(TMaxPrecInt));
  17692. {$ENDIF}
  17693. RaiseRangeCheck(20170802133750,RHS);
  17694. end;
  17695. revkCurrency:
  17696. if TResEvalCurrency(RValue).IsInt(Int) then
  17697. begin
  17698. if (MinVal>Int) or (MaxVal<Int) then
  17699. fExprEvaluator.EmitRangeCheckConst(20180421171325,
  17700. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  17701. end
  17702. else
  17703. begin
  17704. {$IFDEF VerbosePasResEval}
  17705. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalCurrency(RValue).Value),' ',TResEvalCurrency(RValue).Value,' ',high(TMaxPrecInt));
  17706. {$ENDIF}
  17707. RaiseRangeCheck(20180421171438,RHS);
  17708. end;
  17709. else
  17710. {$IFDEF VerbosePasResEval}
  17711. writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
  17712. {$ENDIF}
  17713. RaiseNotYetImplemented(20170530092731,RHS);
  17714. end
  17715. {$ifdef HasInt64}
  17716. else if LeftResolved.BaseType=btQWord then
  17717. case RValue.Kind of
  17718. revkInt:
  17719. if (TResEvalInt(RValue).Int<0) then
  17720. fExprEvaluator.EmitRangeCheckConst(20170530094316,
  17721. IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
  17722. revkUInt: ;
  17723. else
  17724. RaiseNotYetImplemented(20170530094311,RHS);
  17725. end
  17726. {$endif}
  17727. else if RValue.Kind in [revkNil,revkBool] then
  17728. // simple type check is enough
  17729. else if LeftResolved.BaseType in [btSingle,btDouble,btCurrency] then
  17730. // simple type check is enough
  17731. // ToDo: warn if precision loss
  17732. else if LeftResolved.BaseType in btAllChars then
  17733. begin
  17734. case RValue.Kind of
  17735. {$ifdef FPC_HAS_CPSTRING}
  17736. revkString,
  17737. {$endif}
  17738. revkUnicodeString:
  17739. Int:=fExprEvaluator.StringToOrd(RValue,RHS);
  17740. else
  17741. RaiseNotYetImplemented(20170714171218,RHS);
  17742. end;
  17743. case GetActualBaseType(LeftResolved.BaseType) of
  17744. {$ifdef FPC_HAS_CPSTRING}
  17745. btAnsiChar: MaxVal:=$ff;
  17746. {$endif}
  17747. btWideChar: MaxVal:=$ffff;
  17748. end;
  17749. if (Int>MaxVal) then
  17750. fExprEvaluator.EmitRangeCheckConst(20170714171911,
  17751. '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
  17752. end
  17753. else if LeftResolved.BaseType in btAllStrings then
  17754. // simple type check is enough
  17755. // ToDo: warn if unicode to non-utf8
  17756. else if LeftResolved.BaseType=btContext then
  17757. // simple type check is enough
  17758. else if LeftResolved.BaseType=btRange then
  17759. begin
  17760. if (LeftResolved.ExprEl is TBinaryExpr)
  17761. and (TBinaryExpr(LeftResolved.ExprEl).Kind=pekRange) then
  17762. begin
  17763. LRangeValue:=Eval(LeftResolved.ExprEl,[refConst]);
  17764. try
  17765. case LRangeValue.Kind of
  17766. revkRangeInt:
  17767. case TResEvalRangeInt(LRangeValue).ElKind of
  17768. revskEnum:
  17769. if (RValue.Kind<>revkEnum) then
  17770. RaiseNotYetImplemented(20171009171251,RHS)
  17771. else if (TResEvalEnum(RValue).Index<TResEvalRangeInt(LRangeValue).RangeStart)
  17772. or (TResEvalEnum(RValue).Index>TResEvalRangeInt(LRangeValue).RangeEnd) then
  17773. fExprEvaluator.EmitRangeCheckConst(20171009171442,
  17774. TResEvalEnum(RValue).AsString,
  17775. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeStart),
  17776. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeEnd),
  17777. RHS);
  17778. else
  17779. RaiseNotYetImplemented(20171009165348,LeftResolved.ExprEl);
  17780. end;
  17781. else
  17782. RaiseNotYetImplemented(20171009165326,LeftResolved.ExprEl);
  17783. end;
  17784. finally
  17785. ReleaseEvalValue(LRangeValue);
  17786. end;
  17787. end
  17788. else
  17789. RaiseNotYetImplemented(20171009171005,RHS);
  17790. end
  17791. else
  17792. begin
  17793. {$IFDEF VerbosePasResolver}
  17794. writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
  17795. {$ENDIF}
  17796. RaiseNotYetImplemented(20170530095243,RHS);
  17797. end;
  17798. finally
  17799. ReleaseEvalValue(RValue);
  17800. ReleaseEvalValue(LRangeValue);
  17801. end;
  17802. end;
  17803. procedure TPasResolver.CheckAssignExprRangeToCustom(
  17804. const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
  17805. begin
  17806. if LeftResolved.BaseType<>btCustom then exit;
  17807. if RValue=nil then exit;
  17808. if RHS=nil then ;
  17809. end;
  17810. function TPasResolver.CheckAssignResCompatibility(const LHS,
  17811. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  17812. ): integer;
  17813. var
  17814. LTypeEl, RTypeEl: TPasType;
  17815. Handled: Boolean;
  17816. C: TClass;
  17817. LBT, RBT: TResolverBaseType;
  17818. LRange, RValue, Value: TResEvalValue;
  17819. RightSubResolved: TPasResolverResult;
  17820. wc: WideChar;
  17821. begin
  17822. // check if the RHS can be converted to LHS
  17823. {$IFDEF VerbosePasResolver}
  17824. writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  17825. {$ENDIF}
  17826. Result:=-1;
  17827. Handled:=false;
  17828. Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
  17829. if Handled and (Result>=cExact) and (Result<cIncompatible) then
  17830. exit;
  17831. if not Handled then
  17832. begin
  17833. LBT:=GetActualBaseType(LHS.BaseType);
  17834. RBT:=GetActualBaseType(RHS.BaseType);
  17835. if LHS.LoTypeEl=nil then
  17836. begin
  17837. if LBT=btUntyped then
  17838. begin
  17839. // untyped parameter
  17840. Result:=cTypeConversion;
  17841. end
  17842. else
  17843. RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
  17844. end
  17845. else if LBT=RBT then
  17846. begin
  17847. if LBT=btContext then
  17848. exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
  17849. else
  17850. begin
  17851. // same base type, maybe not same type (e.g. longint and integer)
  17852. if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  17853. and HasExactType(RHS) then
  17854. Result:=cExact
  17855. else
  17856. Result:=cAliasExact;
  17857. end;
  17858. end
  17859. else if (LBT in btAllBooleans)
  17860. and (RBT in btAllBooleans) then
  17861. Result:=cCompatible
  17862. else if (LBT in btAllChars) then
  17863. begin
  17864. if (RBT in btAllChars) then
  17865. case LBT of
  17866. {$ifdef FPC_HAS_CPSTRING}
  17867. btAnsiChar:
  17868. Result:=cLossyConversion;
  17869. {$endif}
  17870. btWideChar:
  17871. {$ifdef FPC_HAS_CPSTRING}
  17872. if RBT=btAnsiChar then
  17873. Result:=cCompatible
  17874. else
  17875. {$endif}
  17876. Result:=cLossyConversion;
  17877. else
  17878. RaiseNotYetImplemented(20170728132440,ErrorEl,BaseTypeNames[LBT]);
  17879. end
  17880. else if (RBT=btRange) and (RHS.SubType in btAllChars) then
  17881. begin
  17882. if LBT=btWideChar then
  17883. exit(cCompatible);
  17884. {$ifdef FPC_HAS_CPSTRING}
  17885. // LHS is ansichar
  17886. if GetActualBaseType(RHS.SubType)=btAnsiChar then
  17887. exit(cExact);
  17888. RValue:=Eval(RHS,[refAutoConstExt]);
  17889. if RValue<>nil then
  17890. try
  17891. // ansichar:=constvalue
  17892. case RValue.Kind of
  17893. revkString:
  17894. if not ExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  17895. exit(cIncompatible);
  17896. revkUnicodeString:
  17897. begin
  17898. if length(TResEvalUTF16(RValue).S)<>1 then
  17899. exit(cIncompatible);
  17900. wc:=TResEvalUTF16(RValue).S[1];
  17901. end;
  17902. revkExternal:
  17903. exit(cCompatible);
  17904. else
  17905. RaiseNotYetImplemented(20171108194650,ErrorEl);
  17906. end;
  17907. if ord(wc)>255 then
  17908. exit(cIncompatible);
  17909. exit(cCompatible);
  17910. finally
  17911. ReleaseEvalValue(RValue);
  17912. end;
  17913. // LHS is ansichar, RHS is not a const
  17914. if (RHS.ExprEl is TBinaryExpr) and (TBinaryExpr(RHS.ExprEl).Kind=pekRange) then
  17915. begin
  17916. RValue:=Eval(RHS.ExprEl,[refConst]);
  17917. try
  17918. if RValue.Kind<>revkRangeInt then
  17919. RaiseNotYetImplemented(20171108195035,ErrorEl);
  17920. if TResEvalRangeInt(RValue).RangeStart>255 then
  17921. exit(cIncompatible);
  17922. if TResEvalRangeInt(RValue).RangeEnd>255 then
  17923. exit(cLossyConversion);
  17924. exit(cCompatible);
  17925. finally
  17926. ReleaseEvalValue(RValue);
  17927. end;
  17928. end;
  17929. {$endif}
  17930. RaiseNotYetImplemented(20171108195216,ErrorEl);
  17931. end;
  17932. end
  17933. else if (LBT in btAllStrings) then
  17934. begin
  17935. if (RBT in btAllStringAndChars) then
  17936. case LBT of
  17937. {$ifdef FPC_HAS_CPSTRING}
  17938. btAnsiString:
  17939. if RBT in [btAnsiChar,btShortString,btRawByteString] then
  17940. Result:=cCompatible
  17941. else
  17942. Result:=cLossyConversion;
  17943. btShortString:
  17944. if RBT=btAnsiChar then
  17945. Result:=cCompatible
  17946. else
  17947. Result:=cLossyConversion;
  17948. btRawByteString:
  17949. if RBT in [btAnsiChar,btAnsiString,btShortString] then
  17950. Result:=cCompatible
  17951. else
  17952. Result:=cLossyConversion;
  17953. {$endif}
  17954. btWideString,btUnicodeString:
  17955. Result:=cCompatible;
  17956. else
  17957. {$IFDEF VerbosePasResolver}
  17958. writeln('TPasResolver.CheckAssignResCompatibility ',{$ifdef pas2js}str(LBT){$else}LBT{$ENDIF});
  17959. {$ENDIF}
  17960. RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
  17961. end
  17962. else if RBT=btContext then
  17963. begin
  17964. RTypeEl:=RHS.LoTypeEl;
  17965. if RTypeEl.ClassType=TPasClassType then
  17966. begin
  17967. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  17968. and IsTGUIDString(LHS) then
  17969. // aGUIDString:=IntfTypeOrVar
  17970. exit(cInterfaceToString); // no check for rrfReadable
  17971. end
  17972. else if RTypeEl.ClassType=TPasRecordType then
  17973. begin
  17974. if IsTGUID(TPasRecordType(RTypeEl)) then
  17975. // aString:=GUID
  17976. Result:=cTGUIDToString;
  17977. end;
  17978. end;
  17979. end
  17980. else if (LBT in btAllInteger)
  17981. and (RBT in btAllInteger) then
  17982. begin
  17983. Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
  17984. case LBT of
  17985. btByte,
  17986. btShortInt: inc(Result,cLossyConversion);
  17987. btWord,
  17988. btSmallInt:
  17989. if not (RBT in [btByte,btShortInt]) then
  17990. inc(Result,cLossyConversion);
  17991. btUIntSingle:
  17992. if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
  17993. inc(Result,cLossyConversion);
  17994. btIntSingle:
  17995. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
  17996. inc(Result,cLossyConversion);
  17997. btLongWord,
  17998. btLongint:
  17999. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
  18000. inc(Result,cLossyConversion);
  18001. btUIntDouble:
  18002. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
  18003. inc(Result,cLossyConversion);
  18004. btIntDouble:
  18005. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
  18006. inc(Result,cLossyConversion);
  18007. {$ifdef HasInt64}
  18008. btQWord,
  18009. btInt64,btComp:
  18010. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
  18011. btLongWord,btLongint,btUIntDouble,btIntDouble]) then
  18012. inc(Result,cLossyConversion);
  18013. {$endif}
  18014. else
  18015. RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
  18016. end;
  18017. end
  18018. else if (LBT in btAllFloats)
  18019. and (RBT in btAllFloats) then
  18020. begin
  18021. Result:=cFloatToFloatConversion+ord(LBT)-ord(RBT);
  18022. case LBT of
  18023. btSingle:
  18024. if RBT>btSingle then
  18025. inc(Result,cLossyConversion);
  18026. btDouble:
  18027. if RBT>btDouble then
  18028. inc(Result,cLossyConversion);
  18029. btExtended,btCExtended:
  18030. if RBT>btCExtended then
  18031. inc(Result,cLossyConversion);
  18032. btCurrency:
  18033. inc(Result,cLossyConversion);
  18034. else
  18035. RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
  18036. end;
  18037. end
  18038. else if (LBT in btAllFloats)
  18039. and (RBT in btAllInteger) then
  18040. begin
  18041. Result:=cIntToFloatConversion+ord(LBT)-ord(RBT);
  18042. case LBT of
  18043. btSingle:
  18044. if RBT>btUIntSingle then
  18045. inc(Result,cLossyConversion);
  18046. btDouble:
  18047. if RBT>btUIntDouble then
  18048. inc(Result,cLossyConversion);
  18049. btExtended,btCExtended:
  18050. if RBT>btCExtended then
  18051. inc(Result,cLossyConversion);
  18052. btCurrency:
  18053. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  18054. btIntSingle,btUIntSingle,
  18055. btLongWord,btLongint]) then
  18056. inc(Result,cLossyConversion);
  18057. else
  18058. RaiseNotYetImplemented(20170417205911,ErrorEl,BaseTypeNames[LBT]);
  18059. end;
  18060. end
  18061. else if LBT=btNil then
  18062. begin
  18063. if RaiseOnIncompatible then
  18064. RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
  18065. [],ErrorEl);
  18066. exit(cIncompatible);
  18067. end
  18068. else if LBT=btRange then
  18069. begin
  18070. if (LHS.ExprEl is TBinaryExpr) and (TBinaryExpr(LHS.ExprEl).Kind=pekRange) then
  18071. begin
  18072. LRange:=Eval(LHS.ExprEl,[refConst]);
  18073. RValue:=nil;
  18074. try
  18075. {$IFDEF VerbosePasResolver}
  18076. //writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString);
  18077. {$ENDIF}
  18078. case LRange.Kind of
  18079. revkRangeInt:
  18080. case TResEvalRangeInt(LRange).ElKind of
  18081. revskEnum:
  18082. if RHS.BaseType=btContext then
  18083. begin
  18084. if IsSameType(TResEvalRangeInt(LRange).ElType,RHS.LoTypeEl,prraAlias) then
  18085. begin
  18086. // same enum type
  18087. {$IFDEF VerbosePasResolver}
  18088. writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString,' Left.ElType=',GetObjName(TResEvalRangeInt(LRange).ElType),' RHS.TypeEl=',GetObjName(RHS.LoTypeEl));
  18089. {$ENDIF}
  18090. // ToDo: check if LRange is smaller than Range of RHS (cLossyConversion)
  18091. exit(cExact);
  18092. end;
  18093. end;
  18094. revskInt:
  18095. if RHS.BaseType in btAllInteger then
  18096. begin
  18097. RValue:=Eval(RHS,[refAutoConstExt]);
  18098. if RValue<>nil then
  18099. begin
  18100. // ToDo: check range
  18101. end;
  18102. exit(cCompatible);
  18103. end;
  18104. revskChar:
  18105. if RHS.BaseType in btAllStringAndChars then
  18106. begin
  18107. RValue:=Eval(RHS,[refAutoConstExt]);
  18108. if RValue<>nil then
  18109. begin
  18110. case RValue.Kind of
  18111. {$ifdef FPC_HAS_CPSTRING}
  18112. revkString:
  18113. if not fExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  18114. exit(cIncompatible);
  18115. {$endif}
  18116. revkUnicodeString:
  18117. begin
  18118. if length(TResEvalUTF16(RValue).S)<>1 then
  18119. exit(cIncompatible);
  18120. wc:=TResEvalUTF16(RValue).S[1];
  18121. end;
  18122. revkExternal:
  18123. exit(cCompatible);
  18124. else
  18125. RaiseNotYetImplemented(20171108192232,ErrorEl);
  18126. end;
  18127. if (ord(wc)<TResEvalRangeInt(LRange).RangeStart)
  18128. or (ord(wc)>TResEvalRangeInt(LRange).RangeEnd) then
  18129. exit(cIncompatible);
  18130. end;
  18131. exit(cCompatible);
  18132. end;
  18133. revskBool:
  18134. if RHS.BaseType=btBoolean then
  18135. begin
  18136. RValue:=Eval(RHS,[refAutoConstExt]);
  18137. if RValue<>nil then
  18138. begin
  18139. // ToDo: check range
  18140. end;
  18141. exit(cCompatible);
  18142. end;
  18143. end;
  18144. end;
  18145. finally
  18146. ReleaseEvalValue(LRange);
  18147. ReleaseEvalValue(RValue);
  18148. end;
  18149. end;
  18150. end
  18151. else if LBT=btSet then
  18152. begin
  18153. if RBT=btArrayOrSet then
  18154. begin
  18155. if RHS.SubType=btNone then
  18156. // a:=[]
  18157. Result:=cExact
  18158. else if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  18159. and HasExactType(RHS) then
  18160. Result:=cExact
  18161. else if LHS.SubType=RHS.SubType then
  18162. Result:=cAliasExact
  18163. else if (LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans) then
  18164. Result:=cCompatible
  18165. else if (LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger) then
  18166. begin
  18167. // ToDo: range check
  18168. Result:=cCompatible;
  18169. end
  18170. else if (LHS.SubType in btAllChars) and (RHS.SubType in btAllChars) then
  18171. begin
  18172. // ToDo: range check
  18173. Result:=cCompatible;
  18174. end;
  18175. end;
  18176. end
  18177. else if LBT in [btArrayLit,btArrayOrSet,btModule,btProc] then
  18178. begin
  18179. if RaiseOnIncompatible then
  18180. RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  18181. exit(cIncompatible);
  18182. end
  18183. else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
  18184. begin
  18185. if RaiseOnIncompatible then
  18186. RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  18187. exit(cIncompatible);
  18188. end
  18189. else if RBT=btNil then
  18190. begin
  18191. if LBT=btPointer then
  18192. Result:=cExact
  18193. else if LBT=btContext then
  18194. begin
  18195. LTypeEl:=LHS.LoTypeEl;
  18196. C:=LTypeEl.ClassType;
  18197. if (C=TPasClassType)
  18198. or (C=TPasClassOfType)
  18199. or (C=TPasPointerType)
  18200. or C.InheritsFrom(TPasProcedureType)
  18201. or IsDynArray(LTypeEl) then
  18202. Result:=cExact;
  18203. end;
  18204. end
  18205. else if RBT=btProc then
  18206. begin
  18207. if (msDelphi in CurrentParser.CurrentModeswitches)
  18208. and (LHS.LoTypeEl is TPasProcedureType)
  18209. and (RHS.IdentEl is TPasProcedure) then
  18210. begin
  18211. // for example ProcVar:=Proc
  18212. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  18213. TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
  18214. exit(cExact);
  18215. end
  18216. else if (LHS.LoTypeEl is TPasProcedureType)
  18217. and (RHS.ExprEl is TProcedureExpr) then
  18218. begin
  18219. // for example ProcVar:=anonymous-procedure...
  18220. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  18221. TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
  18222. exit(cExact);
  18223. end
  18224. end
  18225. else if LBT=btPointer then
  18226. begin
  18227. if RBT=btPointer then
  18228. begin
  18229. LTypeEl:=LHS.LoTypeEl;
  18230. RTypeEl:=RHS.LoTypeEl;
  18231. if IsBaseType(LTypeEl,btPointer) then
  18232. Result:=cExact // btPointer can take any pointer
  18233. else if IsBaseType(RTypeEl,btPointer) then
  18234. Result:=cTypeConversion // any pointer can take a btPointer
  18235. else if IsSameType(LTypeEl,RTypeEl,prraAlias) then
  18236. Result:=cExact // pointer of same type
  18237. else if (LTypeEl.ClassType=TPasPointerType)
  18238. and (RTypeEl.ClassType=TPasPointerType) then
  18239. Result:=CheckAssignCompatibility(TPasPointerType(LTypeEl).DestType,
  18240. TPasPointerType(RTypeEl).DestType,RaiseOnIncompatible);
  18241. end
  18242. else if IsBaseType(LHS.LoTypeEl,btPointer) then
  18243. begin
  18244. // UntypedPointer:=...
  18245. if RBT=btContext then
  18246. begin
  18247. RTypeEl:=RHS.LoTypeEl;
  18248. C:=RTypeEl.ClassType;
  18249. if C=TPasClassType then
  18250. // UntypedPointer:=ClassTypeOrInstance
  18251. exit(cTypeConversion)
  18252. else if C=TPasClassOfType then
  18253. // UntypedPointer:=ClassOfVar
  18254. Result:=cTypeConversion
  18255. else if C=TPasArrayType then
  18256. begin
  18257. if IsDynArray(RTypeEl) then
  18258. // UntypedPointer:=DynArray
  18259. Result:=cTypeConversion;
  18260. end
  18261. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  18262. // UntypedPointer:=procvar
  18263. Result:=cLossyConversion
  18264. else if C=TPasPointerType then
  18265. // UntypedPointer:=TypedPointer
  18266. Result:=cExact;
  18267. end;
  18268. end;
  18269. end
  18270. else if (LBT=btContext) then
  18271. begin
  18272. LTypeEl:=LHS.LoTypeEl;
  18273. if (LTypeEl.ClassType=TPasArrayType) then
  18274. Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
  18275. else if LTypeEl.ClassType=TPasEnumType then
  18276. begin
  18277. if (RHS.BaseType=btRange) and (RHS.SubType=btContext) then
  18278. begin
  18279. RTypeEl:=RHS.LoTypeEl;
  18280. if RTypeEl.ClassType=TPasRangeType then
  18281. begin
  18282. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,RightSubResolved,[rcConstant]);
  18283. if (RightSubResolved.BaseType=btContext)
  18284. and IsSameType(LTypeEl,RightSubResolved.LoTypeEl,prraAlias) then
  18285. begin
  18286. // enumtype := enumrange
  18287. Result:=cExact;
  18288. end;
  18289. end;
  18290. end;
  18291. end
  18292. else if LTypeEl.ClassType=TPasRecordType then
  18293. begin
  18294. if (RBT in btAllStrings) and IsTGUID(TPasRecordType(LTypeEl))
  18295. and (rrfReadable in RHS.Flags) then
  18296. begin
  18297. // GUIDVar := string, e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
  18298. Value:=Eval(RHS,[refConstExt]);
  18299. try
  18300. if Value=nil then
  18301. if RaiseOnIncompatible then
  18302. RaiseXExpectedButYFound(20180414105916,'string literal','string', ErrorEl)
  18303. else
  18304. exit(cIncompatible);
  18305. finally
  18306. ReleaseEvalValue(Value);
  18307. end;
  18308. Result:=cStringToTGUID;
  18309. end;
  18310. end
  18311. else if LTypeEl.ClassType=TPasPointerType then
  18312. begin
  18313. // TypedPointer:=
  18314. if RHS.BaseType=btPointer then
  18315. begin
  18316. RTypeEl:=RHS.LoTypeEl;
  18317. if IsBaseType(RTypeEl,btPointer) then
  18318. // TypedPointer:=UntypedPointer
  18319. Result:=cTypeConversion
  18320. else
  18321. begin
  18322. // TypedPointer:=@Var
  18323. Result:=CheckAssignCompatibilityPointerType(
  18324. TPasPointerType(LTypeEl).DestType,RTypeEl,ErrorEl,false);
  18325. end;
  18326. end;
  18327. end;
  18328. end;
  18329. end;
  18330. if (Result>=0) and (Result<cIncompatible) then
  18331. begin
  18332. // type fits -> check readable
  18333. if not (rrfReadable in RHS.Flags) then
  18334. begin
  18335. if RaiseOnIncompatible then
  18336. begin
  18337. {$IFDEF VerbosePasResolver}
  18338. writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  18339. {$ENDIF}
  18340. RaiseVarExpected(20170318235637,ErrorEl,RHS.IdentEl);
  18341. end;
  18342. exit(cIncompatible);
  18343. end;
  18344. exit;
  18345. end;
  18346. // incompatible
  18347. {$IFDEF VerbosePasResolver}
  18348. writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  18349. {$ENDIF}
  18350. if not RaiseOnIncompatible then
  18351. exit(cIncompatible);
  18352. // create error messages
  18353. RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
  18354. [],RHS,LHS,ErrorEl);
  18355. end;
  18356. function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
  18357. ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
  18358. ): integer;
  18359. // check if the RightResolved is type compatible to LeftResolved
  18360. var
  18361. LFlags, RFlags: TPasResolverComputeFlags;
  18362. LeftResolved, RightResolved: TPasResolverResult;
  18363. LeftErrorEl, RightErrorEl: TPasElement;
  18364. begin
  18365. Result:=cIncompatible;
  18366. // Delphi resolves both sides, so it forbids "if procvar=procvar then"
  18367. // FPC is more clever. It supports "if procvar=@proc then", "function=value"
  18368. if msDelphi in CurrentParser.CurrentModeswitches then
  18369. LFlags:=[]
  18370. else
  18371. LFlags:=[rcNoImplicitProcType];
  18372. if SetReferenceFlags then
  18373. Include(LFlags,rcSetReferenceFlags);
  18374. ComputeElement(Left,LeftResolved,LFlags);
  18375. if (msDelphi in CurrentParser.CurrentModeswitches) then
  18376. RFlags:=LFlags
  18377. else
  18378. begin
  18379. if LeftResolved.BaseType=btNil then
  18380. RFlags:=[rcNoImplicitProcType]
  18381. else if IsProcedureType(LeftResolved,true) then
  18382. RFlags:=[rcNoImplicitProcType]
  18383. else
  18384. RFlags:=[];
  18385. end;
  18386. if SetReferenceFlags then
  18387. Include(RFlags,rcSetReferenceFlags);
  18388. {$IFDEF VerbosePasResolver}
  18389. writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
  18390. {$ENDIF}
  18391. ComputeElement(Right,RightResolved,RFlags);
  18392. if ErrorEl=nil then
  18393. begin
  18394. LeftErrorEl:=Left;
  18395. RightErrorEl:=Right;
  18396. end
  18397. else
  18398. begin
  18399. LeftErrorEl:=ErrorEl;
  18400. RightErrorEl:=ErrorEl;
  18401. end;
  18402. Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
  18403. RaiseOnIncompatible,RightErrorEl);
  18404. end;
  18405. function TPasResolver.CheckEqualResCompatibility(const LHS,
  18406. RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  18407. RErrorEl: TPasElement): integer;
  18408. var
  18409. LTypeEl, RTypeEl: TPasType;
  18410. ResolvedEl: TPasResolverResult;
  18411. begin
  18412. Result:=cIncompatible;
  18413. if RErrorEl=nil then RErrorEl:=LErrorEl;
  18414. // check if the RHS is type compatible to LHS
  18415. {$IFDEF VerbosePasResolver}
  18416. writeln('TPasResolver.CheckEqualResCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  18417. {$ENDIF}
  18418. if not (rrfReadable in LHS.Flags) then
  18419. begin
  18420. if (LHS.BaseType=btContext) then
  18421. begin
  18422. LTypeEl:=LHS.LoTypeEl;
  18423. if (LTypeEl.ClassType=TPasClassType)
  18424. and (ResolveAliasTypeEl(LHS.IdentEl)=LTypeEl) then
  18425. begin
  18426. // LHS is class type, e.g. TObject or IInterface
  18427. if RHS.BaseType=btNil then
  18428. exit(cExact)
  18429. else if RHS.BaseType in btAllStrings then
  18430. begin
  18431. if (rrfReadable in RHS.Flags)
  18432. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  18433. and IsTGUIDString(RHS) then
  18434. // e.g. IUnknown=aGUIDString
  18435. exit(cInterfaceToString);
  18436. end
  18437. else if (RHS.BaseType=btContext) then
  18438. begin
  18439. RTypeEl:=RHS.LoTypeEl;
  18440. if (RTypeEl.ClassType=TPasClassOfType)
  18441. and (rrfReadable in RHS.Flags)
  18442. and (TPasClassType(LTypeEl).ObjKind=okClass) then
  18443. // for example if TImage=ImageClass then
  18444. exit(cExact)
  18445. else if (RTypeEl.ClassType=TPasRecordType)
  18446. and (rrfReadable in RHS.Flags)
  18447. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  18448. and IsTGUID(TPasRecordType(RTypeEl)) then
  18449. // e.g. if IUnknown=TGuidVar then
  18450. exit(cInterfaceToTGUID);
  18451. end;
  18452. end;
  18453. end;
  18454. RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
  18455. end;
  18456. if not (rrfReadable in RHS.Flags) then
  18457. begin
  18458. if (RHS.BaseType=btContext) then
  18459. begin
  18460. RTypeEl:=RHS.LoTypeEl;
  18461. if (RTypeEl.ClassType=TPasClassType)
  18462. and (ResolveAliasTypeEl(RHS.IdentEl)=RTypeEl) then
  18463. begin
  18464. // RHS is class type, e.g. TObject or IInterface
  18465. if LHS.BaseType=btNil then
  18466. exit(cExact)
  18467. else if LHS.BaseType in btAllStrings then
  18468. begin
  18469. if (rrfReadable in LHS.Flags)
  18470. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  18471. and IsTGUIDString(LHS) then
  18472. // e.g. aGUIDString=IUnknown
  18473. exit(cInterfaceToString);
  18474. end
  18475. else if (LHS.BaseType=btContext) then
  18476. begin
  18477. LTypeEl:=LHS.LoTypeEl;
  18478. if (LTypeEl.ClassType=TPasClassOfType)
  18479. and (rrfReadable in LHS.Flags)
  18480. and (TPasClassType(RTypeEl).ObjKind=okClass) then
  18481. // for example if ImageClass=TImage then
  18482. exit(cExact)
  18483. else if (LTypeEl.ClassType=TPasRecordType)
  18484. and (rrfReadable in LHS.Flags)
  18485. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  18486. and IsTGUID(TPasRecordType(LTypeEl)) then
  18487. // e.g. if TGuidVar=IUnknown then
  18488. exit(cInterfaceToTGUID);
  18489. end;
  18490. end;
  18491. end;
  18492. RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
  18493. end;
  18494. if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
  18495. begin
  18496. Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
  18497. if (Result=cIncompatible) and RaiseOnIncompatible then
  18498. RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
  18499. [],RHS,LHS,LErrorEl);
  18500. exit;
  18501. end
  18502. else if LHS.BaseType=RHS.BaseType then
  18503. begin
  18504. if LHS.BaseType=btContext then
  18505. exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
  18506. else
  18507. exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
  18508. end
  18509. else if LHS.BaseType in btAllInteger then
  18510. begin
  18511. if RHS.BaseType in btAllInteger+btAllFloats then
  18512. exit(cCompatible)
  18513. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  18514. exit(cCompatible);
  18515. end
  18516. else if LHS.BaseType in btAllFloats then
  18517. begin
  18518. if RHS.BaseType in btAllInteger+btAllFloats then
  18519. exit(cCompatible);
  18520. end
  18521. else if LHS.BaseType in btAllBooleans then
  18522. begin
  18523. if RHS.BaseType in btAllBooleans then
  18524. exit(cCompatible)
  18525. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  18526. exit(cCompatible);
  18527. end
  18528. else if LHS.BaseType in btAllStringAndChars then
  18529. begin
  18530. if RHS.BaseType in btAllStringAndChars then
  18531. exit(cCompatible)
  18532. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  18533. exit(cCompatible)
  18534. else if RHS.BaseType=btContext then
  18535. begin
  18536. RTypeEl:=RHS.LoTypeEl;
  18537. if (RTypeEl.ClassType=TPasClassType) then
  18538. begin
  18539. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  18540. and IsTGUIDString(LHS) then
  18541. // e.g. aGUIDString=IntfVar
  18542. exit(cInterfaceToString);
  18543. end
  18544. else if (RTypeEl.ClassType=TPasRecordType)
  18545. and IsTGUID(TPasRecordType(RTypeEl)) then
  18546. // e.g. aString=GuidVar
  18547. exit(cTGUIDToString);
  18548. end;
  18549. end
  18550. else if LHS.BaseType=btNil then
  18551. begin
  18552. if RHS.BaseType in [btPointer,btNil] then
  18553. exit(cExact)
  18554. else if RHS.BaseType=btContext then
  18555. begin
  18556. LTypeEl:=RHS.LoTypeEl;
  18557. if (LTypeEl.ClassType=TPasClassType)
  18558. or (LTypeEl.ClassType=TPasClassOfType)
  18559. or (LTypeEl.ClassType=TPasPointerType)
  18560. or (LTypeEl is TPasProcedureType)
  18561. or IsDynArray(LTypeEl) then
  18562. exit(cExact);
  18563. end;
  18564. if RaiseOnIncompatible then
  18565. RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
  18566. [],RHS,LHS,RErrorEl)
  18567. else
  18568. exit(cIncompatible);
  18569. end
  18570. else if RHS.BaseType=btNil then
  18571. begin
  18572. if LHS.BaseType=btPointer then
  18573. exit(cExact)
  18574. else if LHS.BaseType=btContext then
  18575. begin
  18576. LTypeEl:=LHS.LoTypeEl;
  18577. if (LTypeEl.ClassType=TPasClassType)
  18578. or (LTypeEl.ClassType=TPasClassOfType)
  18579. or (LTypeEl.ClassType=TPasPointerType)
  18580. or (LTypeEl is TPasProcedureType)
  18581. or IsDynArray(LTypeEl) then
  18582. exit(cExact);
  18583. end;
  18584. if RaiseOnIncompatible then
  18585. RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
  18586. [],LHS,RHS,LErrorEl)
  18587. else
  18588. exit(cIncompatible);
  18589. end
  18590. else if LHS.BaseType=btPointer then
  18591. begin
  18592. if RHS.BaseType=btContext then
  18593. begin
  18594. RTypeEl:=RHS.LoTypeEl;
  18595. if RTypeEl.ClassType=TPasPointerType then
  18596. // @Something=TypedPointer
  18597. exit(cExact)
  18598. else if RTypeEl.ClassType=TPasClassType then
  18599. // @Something=ClassOrInterface
  18600. exit(cCompatible)
  18601. else if RTypeEl.ClassType=TPasClassOfType then
  18602. // @Something=ClassOf
  18603. exit(cCompatible);
  18604. end;
  18605. end
  18606. else if LHS.BaseType in [btSet,btArrayOrSet] then
  18607. begin
  18608. if RHS.BaseType in [btSet,btArrayOrSet] then
  18609. begin
  18610. if LHS.LoTypeEl=nil then
  18611. exit(cExact); // empty set
  18612. if RHS.LoTypeEl=nil then
  18613. exit(cExact); // empty set
  18614. if IsSameType(LHS.LoTypeEl,RHS.LoTypeEl,prraAlias) then
  18615. exit(cExact);
  18616. if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+btAllChars)) then
  18617. exit(cExact);
  18618. if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
  18619. or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
  18620. exit(cCompatible);
  18621. if RaiseOnIncompatible then
  18622. RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  18623. ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
  18624. else
  18625. exit(cIncompatible);
  18626. end;
  18627. end
  18628. else if LHS.BaseType=btRange then
  18629. begin
  18630. if LHS.SubType in btAllInteger then
  18631. begin
  18632. // e.g. 2..4
  18633. if RHS.BaseType in btAllInteger then
  18634. exit(cCompatible)
  18635. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  18636. exit(cCompatible);
  18637. end
  18638. else if LHS.SubType in btAllBooleans then
  18639. begin
  18640. if RHS.BaseType in btAllBooleans then
  18641. exit(cCompatible)
  18642. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  18643. exit(cCompatible);
  18644. end
  18645. else if LHS.SubType in btAllChars then
  18646. begin
  18647. if RHS.BaseType in btAllStringAndChars then
  18648. exit(cCompatible)
  18649. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  18650. exit(cCompatible);
  18651. end
  18652. else if LHS.SubType=btContext then
  18653. begin
  18654. LTypeEl:=LHS.LoTypeEl;
  18655. if LTypeEl.ClassType=TPasRangeType then
  18656. begin
  18657. ComputeElement(TPasRangeType(LTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  18658. if ResolvedEl.BaseType=btContext then
  18659. begin
  18660. LTypeEl:=ResolvedEl.LoTypeEl;
  18661. if LTypeEl.ClassType=TPasEnumType then
  18662. begin
  18663. if RHS.BaseType=btContext then
  18664. begin
  18665. RTypeEl:=RHS.LoTypeEl;
  18666. if (LTypeEl=RTypeEl) then
  18667. exit(cCompatible);
  18668. end;
  18669. end;
  18670. end;
  18671. end;
  18672. end;
  18673. end
  18674. else if LHS.BaseType=btContext then
  18675. begin
  18676. LTypeEl:=LHS.LoTypeEl;
  18677. if LTypeEl.ClassType=TPasEnumType then
  18678. begin
  18679. if RHS.BaseType=btRange then
  18680. begin
  18681. RTypeEl:=RHS.LoTypeEl;
  18682. if RTypeEl.ClassType=TPasRangeType then
  18683. begin
  18684. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  18685. if ResolvedEl.BaseType=btContext then
  18686. begin
  18687. RTypeEl:=ResolvedEl.LoTypeEl;
  18688. if LTypeEl=RTypeEl then
  18689. exit(cCompatible);
  18690. end;
  18691. end;
  18692. end;
  18693. end
  18694. else if LTypeEl.ClassType=TPasClassType then
  18695. begin
  18696. if RHS.BaseType=btPointer then
  18697. exit(cCompatible)
  18698. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  18699. begin
  18700. if RHS.BaseType in btAllStrings then
  18701. begin
  18702. if IsTGUIDString(RHS) then
  18703. // e.g. IntfVar=aGUIDString
  18704. exit(cInterfaceToString);
  18705. end
  18706. else if RHS.BaseType=btContext then
  18707. begin
  18708. RTypeEl:=RHS.LoTypeEl;
  18709. if (RTypeEl.ClassType=TPasRecordType)
  18710. and IsTGUID(TPasRecordType(RTypeEl)) then
  18711. // e.g. IntfVar=GuidVar
  18712. exit(cInterfaceToTGUID);
  18713. end;
  18714. end;
  18715. end
  18716. else if LTypeEl.ClassType=TPasClassOfType then
  18717. begin
  18718. if RHS.BaseType=btPointer then
  18719. exit(cCompatible);
  18720. end
  18721. else if LTypeEl.ClassType=TPasRecordType then
  18722. begin
  18723. if IsTGUID(TPasRecordType(LTypeEl)) then
  18724. begin
  18725. // LHS is TGUID
  18726. if (RHS.BaseType in btAllStrings) then
  18727. // GuidVar=aString
  18728. exit(cTGUIDToString)
  18729. else if RHS.BaseType=btContext then
  18730. begin
  18731. RTypeEl:=RHS.LoTypeEl;
  18732. if (RTypeEl.ClassType=TPasClassType)
  18733. and (TPasClassType(RTypeEl).ObjKind=okInterface) then
  18734. // GUIDVar=IntfVar
  18735. exit(cInterfaceToTGUID);
  18736. end;
  18737. end;
  18738. end
  18739. else if LTypeEl.ClassType=TPasPointerType then
  18740. begin
  18741. if RHS.BaseType=btPointer then
  18742. // TypedPointer=@Something
  18743. exit(cExact);
  18744. end;
  18745. end;
  18746. if RaiseOnIncompatible then
  18747. RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
  18748. [],RHS,LHS,RErrorEl)
  18749. else
  18750. exit(cIncompatible);
  18751. end;
  18752. function TPasResolver.IsVariableConst(El, PosEl: TPasElement;
  18753. RaiseIfConst: boolean): boolean;
  18754. var
  18755. CurEl: TPasElement;
  18756. VarResolved: TPasResolverResult;
  18757. Loop: TPasImplForLoop;
  18758. begin
  18759. Result:=false;
  18760. CurEl:=PosEl;
  18761. while CurEl<>nil do
  18762. begin
  18763. if (CurEl.ClassType=TPasImplForLoop) then
  18764. begin
  18765. Loop:=TPasImplForLoop(CurEl);
  18766. if (Loop.VariableName<>PosEl) then
  18767. begin
  18768. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
  18769. if VarResolved.IdentEl=El then
  18770. begin
  18771. if RaiseIfConst then
  18772. RaiseMsg(20180430100719,nIllegalAssignmentToForLoopVar,
  18773. sIllegalAssignmentToForLoopVar,[El.Name],PosEl);
  18774. exit(true);
  18775. end;
  18776. end;
  18777. end;
  18778. CurEl:=CurEl.Parent;
  18779. end;
  18780. end;
  18781. function TPasResolver.ResolvedElCanBeVarParam(
  18782. const ResolvedEl: TPasResolverResult; PosEl: TPasElement;
  18783. RaiseIfConst: boolean): boolean;
  18784. function NotLocked(El: TPasElement): boolean;
  18785. begin
  18786. Result:=not IsVariableConst(El,PosEl,RaiseIfConst);
  18787. end;
  18788. var
  18789. IdentEl: TPasElement;
  18790. begin
  18791. Result:=false;
  18792. if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
  18793. exit;
  18794. if ResolvedEl.IdentEl=nil then
  18795. exit(true);
  18796. IdentEl:=ResolvedEl.IdentEl;
  18797. if IdentEl.ClassType=TPasVariable then
  18798. exit(NotLocked(IdentEl));
  18799. if (IdentEl.ClassType=TPasConst) then
  18800. begin
  18801. if TPasConst(IdentEl).IsConst then
  18802. begin
  18803. if RaiseIfConst then
  18804. RaiseMsg(20180430100719,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  18805. exit(false);
  18806. end;
  18807. exit(NotLocked(IdentEl));
  18808. end;
  18809. if (IdentEl.ClassType=TPasArgument) then
  18810. begin
  18811. if TPasArgument(IdentEl).Access in [argConst,argConstRef] then
  18812. begin
  18813. if RaiseIfConst then
  18814. RaiseMsg(20180430100843,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  18815. exit(false);
  18816. end;
  18817. Result:=(TPasArgument(IdentEl).Access in [argDefault, argVar, argOut]);
  18818. exit(Result and NotLocked(IdentEl));
  18819. end;
  18820. if IdentEl.ClassType=TPasResultElement then
  18821. exit(NotLocked(IdentEl));
  18822. if (proPropertyAsVarParam in Options)
  18823. and (IdentEl.ClassType=TPasProperty) then
  18824. exit(NotLocked(IdentEl));
  18825. end;
  18826. function TPasResolver.ResolvedElIsClassOrRecordInstance(
  18827. const ResolvedEl: TPasResolverResult): boolean;
  18828. var
  18829. TypeEl: TPasType;
  18830. begin
  18831. Result:=false;
  18832. if ResolvedEl.BaseType<>btContext then exit;
  18833. TypeEl:=ResolvedEl.LoTypeEl;
  18834. if TypeEl=nil then exit;
  18835. if TypeEl.ClassType=TPasClassType then
  18836. begin
  18837. if TPasClassType(TypeEl).ObjKind<>okClass then exit;
  18838. end
  18839. else if TypeEl.ClassType=TPasRecordType then
  18840. else
  18841. exit;
  18842. if (ResolvedEl.IdentEl is TPasVariable)
  18843. or (ResolvedEl.IdentEl.ClassType=TPasArgument)
  18844. or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
  18845. exit(true);
  18846. end;
  18847. function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
  18848. ): boolean;
  18849. begin
  18850. Result:=ms in GetElModeSwitches(El);
  18851. end;
  18852. function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
  18853. var
  18854. C: TClass;
  18855. begin
  18856. while El<>nil do
  18857. begin
  18858. if El.CustomData<>nil then
  18859. begin
  18860. C:=El.CustomData.ClassType;
  18861. if C.InheritsFrom(TPasProcedureScope) then
  18862. exit(TPasProcedureScope(El.CustomData).ModeSwitches)
  18863. else if C.InheritsFrom(TPasSectionScope) then
  18864. exit(TPasSectionScope(El.CustomData).ModeSwitches);
  18865. end;
  18866. El:=El.Parent;
  18867. end;
  18868. Result:=CurrentParser.CurrentModeswitches;
  18869. end;
  18870. function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
  18871. ): boolean;
  18872. begin
  18873. Result:=bs in GetElBoolSwitches(El);
  18874. end;
  18875. function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  18876. var
  18877. C: TClass;
  18878. begin
  18879. Result:=CurrentParser.Scanner.CurrentBoolSwitches;
  18880. while El<>nil do
  18881. begin
  18882. if El.CustomData<>nil then
  18883. begin
  18884. C:=El.CustomData.ClassType;
  18885. if C.InheritsFrom(TPasProcedureScope) then
  18886. exit(TPasProcedureScope(El.CustomData).BoolSwitches)
  18887. else if C.InheritsFrom(TPasSectionScope) then
  18888. exit(TPasSectionScope(El.CustomData).BoolSwitches)
  18889. else if C.InheritsFrom(TPasModuleScope) then
  18890. exit(TPasModuleScope(El.CustomData).BoolSwitches);
  18891. end;
  18892. El:=El.Parent;
  18893. end;
  18894. end;
  18895. function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
  18896. Flags: TPRProcTypeDescFlags): string;
  18897. var
  18898. Args: TFPList;
  18899. i: Integer;
  18900. Arg: TPasArgument;
  18901. ArgType: TPasType;
  18902. begin
  18903. if ProcType=nil then exit('nil');
  18904. Result:=ProcType.TypeName;
  18905. if ProcType.IsReferenceTo then
  18906. Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
  18907. if (prptdUseName in Flags) and (ProcType.Parent is TPasProcedure) then
  18908. begin
  18909. if prptdAddPaths in Flags then
  18910. Result:=Result+' '+ProcType.Parent.FullName
  18911. else
  18912. Result:=Result+' '+ProcType.Parent.Name;
  18913. end;
  18914. Args:=ProcType.Args;
  18915. if Args.Count>0 then
  18916. begin
  18917. Result:=Result+'(';
  18918. for i:=0 to Args.Count-1 do
  18919. begin
  18920. if i>0 then Result:=Result+';';
  18921. Arg:=TPasArgument(Args[i]);
  18922. if AccessNames[Arg.Access]<>'' then
  18923. Result:=Result+AccessNames[Arg.Access];
  18924. if Arg.ArgType=nil then
  18925. Result:=Result+'untyped'
  18926. else
  18927. begin
  18928. ArgType:=Arg.ArgType;
  18929. if prptdResolveSimpleAlias in Flags then
  18930. ArgType:=ResolveSimpleAliasType(ArgType);
  18931. Result:=Result+GetTypeDescription(ArgType,prptdAddPaths in Flags);
  18932. end;
  18933. end;
  18934. Result:=Result+')';
  18935. end;
  18936. if ProcType.IsOfObject then
  18937. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  18938. if ProcType.IsNested then
  18939. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  18940. if cCallingConventions[ProcType.CallingConvention]<>'' then
  18941. Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
  18942. end;
  18943. function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
  18944. OnlyType: boolean): string;
  18945. function GetSubTypeName: string;
  18946. begin
  18947. if (T.LoTypeEl<>nil) and (T.LoTypeEl.Name<>'') then
  18948. Result:=T.LoTypeEl.Name
  18949. else
  18950. Result:=BaseTypeNames[T.SubType];
  18951. end;
  18952. var
  18953. ArrayEl: TPasArrayType;
  18954. begin
  18955. case T.BaseType of
  18956. btModule: exit(GetElementTypeName(T.IdentEl)+' '+T.IdentEl.Name);
  18957. btNil: exit('nil');
  18958. btRange:
  18959. Result:='range of '+GetSubTypeName;
  18960. btSet:
  18961. Result:='set of '+GetSubTypeName;
  18962. btArrayLit:
  18963. Result:='array of '+GetSubTypeName;
  18964. btArrayOrSet:
  18965. Result:='set/array literal of '+GetSubTypeName;
  18966. btContext:
  18967. begin
  18968. if T.LoTypeEl.ClassType=TPasClassOfType then
  18969. Result:='class of '+TPasClassOfType(T.LoTypeEl).DestType.Name
  18970. else if T.LoTypeEl.ClassType=TPasAliasType then
  18971. Result:=TPasAliasType(T.LoTypeEl).DestType.Name
  18972. else if T.LoTypeEl.ClassType=TPasTypeAliasType then
  18973. Result:='type '+TPasAliasType(T.LoTypeEl).DestType.Name
  18974. else if T.LoTypeEl.ClassType=TPasArrayType then
  18975. begin
  18976. ArrayEl:=TPasArrayType(T.LoTypeEl);
  18977. if length(ArrayEl.Ranges)=0 then
  18978. begin
  18979. if ArrayEl.ElType=nil then
  18980. Result:='array of const'
  18981. else
  18982. begin
  18983. Result:='array of '+ArrayEl.ElType.Name;
  18984. if IsOpenArray(ArrayEl) then
  18985. Result:='open '+Result;
  18986. end;
  18987. end
  18988. else
  18989. Result:='static array[] of '+ArrayEl.ElType.Name;
  18990. end
  18991. else if T.LoTypeEl is TPasProcedureType then
  18992. Result:=GetProcTypeDescription(TPasProcedureType(T.LoTypeEl),[])
  18993. else if T.LoTypeEl.Name<>'' then
  18994. Result:=T.LoTypeEl.Name
  18995. else
  18996. Result:=T.LoTypeEl.ElementTypeName;
  18997. end;
  18998. btCustom:
  18999. Result:=T.LoTypeEl.Name;
  19000. else
  19001. Result:=BaseTypeNames[T.BaseType];
  19002. end;
  19003. if (not OnlyType) and (T.LoTypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
  19004. Result:=T.IdentEl.Name+':'+Result;
  19005. end;
  19006. function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
  19007. function GetName: string;
  19008. var
  19009. s: String;
  19010. begin
  19011. Result:=aType.Name;
  19012. if Result='' then
  19013. begin
  19014. if aType is TPasArrayType then
  19015. begin
  19016. if length(TPasArrayType(aType).Ranges)>0 then
  19017. Result:='static array'
  19018. else if TPasArrayType(aType).ElType=nil then
  19019. Result:='array of const'
  19020. else if IsOpenArray(aType) then
  19021. Result:='open array'
  19022. else
  19023. Result:='dynamic array';
  19024. end
  19025. else
  19026. Result:=GetElementTypeName(aType);
  19027. end;
  19028. if AddPath then
  19029. begin
  19030. s:=aType.ParentPath;
  19031. if (s<>'') and (s<>'.') then
  19032. Result:=s+'.'+Result;
  19033. end;
  19034. end;
  19035. begin
  19036. if aType=nil then exit('untyped');
  19037. Result:=GetName;
  19038. if (aType.ClassType=TPasUnresolvedSymbolRef) then
  19039. begin
  19040. if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
  19041. Result:=Result+'()';
  19042. exit;
  19043. end;
  19044. end;
  19045. function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
  19046. AddPath: boolean): string;
  19047. var
  19048. s: String;
  19049. begin
  19050. Result:=GetTypeDescription(R.LoTypeEl,AddPath);
  19051. if R.BaseType in [btSet,btArrayLit,btArrayOrSet] then
  19052. Result:=BaseTypeNames[R.BaseType]+' of '+Result;
  19053. if (R.LoTypeEl<>nil) and (R.IdentEl=R.LoTypeEl) then
  19054. begin
  19055. s:=GetElementTypeName(R.LoTypeEl);
  19056. if s<>'' then
  19057. Result:=s+' '+Result
  19058. else
  19059. Result:='type '+Result;
  19060. end;
  19061. end;
  19062. function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
  19063. AddPath: boolean): string;
  19064. begin
  19065. if R.BaseType=btContext then
  19066. Result:=GetTypeDescription(R,AddPath)
  19067. else if (R.BaseType=btPointer) and not IsBaseType(R.LoTypeEl,btPointer) then
  19068. Result:='^'+GetTypeDescription(R,AddPath)
  19069. else
  19070. Result:=BaseTypeNames[R.BaseType];
  19071. end;
  19072. function TPasResolver.GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  19073. var
  19074. Scope: TPasProcedureScope;
  19075. Body: TPasImplBlock;
  19076. begin
  19077. Result:=nil;
  19078. if Proc=nil then exit;
  19079. if Proc.Body<>nil then
  19080. Body:=Proc.Body.Body
  19081. else
  19082. Body:=nil;
  19083. if Body=nil then
  19084. begin
  19085. if Proc.CustomData=nil then exit;
  19086. Scope:=Proc.CustomData as TPasProcedureScope;
  19087. Proc:=Scope.ImplProc;
  19088. if Proc=nil then exit;
  19089. if Proc.Body=nil then exit;
  19090. Body:=Proc.Body.Body;
  19091. if Body=nil then exit;
  19092. end;
  19093. if Body.Elements=nil then exit;
  19094. if Body.Elements.Count=0 then exit;
  19095. Result:=TPasImplElement(Body.Elements[0]);
  19096. end;
  19097. function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
  19098. WithRedeclarations: boolean): TPasProperty;
  19099. begin
  19100. Result:=nil;
  19101. if El=nil then exit;
  19102. if (not WithRedeclarations) and (El.VarType<>nil) then exit;
  19103. if El.CustomData=nil then exit;
  19104. Result:=TPasPropertyScope(El.CustomData).AncestorProp;
  19105. end;
  19106. function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
  19107. begin
  19108. Result:=nil;
  19109. while El<>nil do
  19110. begin
  19111. if El.VarType<>nil then
  19112. exit(El.VarType);
  19113. El:=GetPasPropertyAncestor(El);
  19114. end;
  19115. end;
  19116. function TPasResolver.GetPasPropertyArgs(El: TPasProperty): TFPList;
  19117. begin
  19118. while El<>nil do
  19119. begin
  19120. if El.VarType<>nil then
  19121. exit(El.Args);
  19122. El:=GetPasPropertyAncestor(El);
  19123. end;
  19124. Result:=nil;
  19125. end;
  19126. function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
  19127. // search the member variable or getter function of a property
  19128. var
  19129. DeclEl: TPasElement;
  19130. begin
  19131. Result:=nil;
  19132. while El<>nil do
  19133. begin
  19134. if El.ReadAccessor<>nil then
  19135. begin
  19136. DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
  19137. Result:=DeclEl;
  19138. exit;
  19139. end;
  19140. El:=GetPasPropertyAncestor(El);
  19141. end;
  19142. end;
  19143. function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
  19144. // search the member variable or setter procedure of a property
  19145. var
  19146. DeclEl: TPasElement;
  19147. begin
  19148. Result:=nil;
  19149. while El<>nil do
  19150. begin
  19151. if El.WriteAccessor<>nil then
  19152. begin
  19153. DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
  19154. Result:=DeclEl;
  19155. exit;
  19156. end;
  19157. El:=GetPasPropertyAncestor(El);
  19158. end;
  19159. end;
  19160. function TPasResolver.GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  19161. // search the index expression of a property
  19162. begin
  19163. Result:=nil;
  19164. while El<>nil do
  19165. begin
  19166. if El.IndexExpr<>nil then
  19167. begin
  19168. Result:=El.IndexExpr;
  19169. exit;
  19170. end;
  19171. El:=GetPasPropertyAncestor(El);
  19172. end;
  19173. end;
  19174. function TPasResolver.GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  19175. // search the stored expression of a property
  19176. begin
  19177. Result:=nil;
  19178. while El<>nil do
  19179. begin
  19180. if El.StoredAccessor<>nil then
  19181. begin
  19182. Result:=El.StoredAccessor;
  19183. exit;
  19184. end;
  19185. El:=GetPasPropertyAncestor(El);
  19186. end;
  19187. end;
  19188. function TPasResolver.GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  19189. // search the stored expression of a property
  19190. begin
  19191. Result:=nil;
  19192. while El<>nil do
  19193. begin
  19194. if El.DefaultExpr<>nil then
  19195. begin
  19196. Result:=El.DefaultExpr;
  19197. exit;
  19198. end
  19199. else if El.IsNodefault then
  19200. exit(nil);
  19201. El:=GetPasPropertyAncestor(El);
  19202. end;
  19203. end;
  19204. function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
  19205. Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
  19206. SetReferenceFlags: boolean): integer;
  19207. var
  19208. ExprResolved, ParamResolved: TPasResolverResult;
  19209. NeedVar, UseAssignError: Boolean;
  19210. RHSFlags: TPasResolverComputeFlags;
  19211. begin
  19212. Result:=cIncompatible;
  19213. NeedVar:=Param.Access in [argVar, argOut];
  19214. ComputeElement(Param,ParamResolved,[]);
  19215. {$IFDEF VerbosePasResolver}
  19216. writeln('TPasResolver.CheckParamCompatibility Param=',GetTreeDbg(Param,2),' ParamResolved=',GetResolverResultDbg(ParamResolved));
  19217. {$ENDIF}
  19218. if (ParamResolved.LoTypeEl=nil) and (Param.ArgType<>nil) then
  19219. RaiseInternalError(20160922163628,'GetResolvedType returned TypeEl=nil for '+GetTreeDbg(Param));
  19220. RHSFlags:=[];
  19221. if NeedVar then
  19222. Include(RHSFlags,rcNoImplicitProc)
  19223. else if IsProcedureType(ParamResolved,true)
  19224. or (ParamResolved.BaseType=btPointer)
  19225. or (Param.ArgType=nil) then
  19226. Include(RHSFlags,rcNoImplicitProcType);
  19227. if SetReferenceFlags then
  19228. Include(RHSFlags,rcSetReferenceFlags);
  19229. ComputeElement(Expr,ExprResolved,RHSFlags);
  19230. {$IFDEF VerbosePasResolver}
  19231. writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDbg(Expr,2),' ResolvedExpr=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
  19232. {$ENDIF}
  19233. if NeedVar then
  19234. begin
  19235. // Expr must be a variable
  19236. if not ResolvedElCanBeVarParam(ExprResolved,Expr) then
  19237. begin
  19238. {$IFDEF VerbosePasResolver}
  19239. writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
  19240. {$ENDIF}
  19241. if RaiseOnError then
  19242. begin
  19243. if ExprResolved.IdentEl is TPasConst then
  19244. RaiseMsg(20180430012609,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],Expr)
  19245. else
  19246. RaiseVarExpected(20180430012457,Expr,ExprResolved.IdentEl);
  19247. end;
  19248. exit;
  19249. end;
  19250. if (Param.ArgType=nil) then
  19251. exit(cExact); // untyped argument
  19252. if (ParamResolved.BaseType=ExprResolved.BaseType) then
  19253. begin
  19254. if msDelphi in CurrentParser.CurrentModeswitches then
  19255. begin
  19256. // Delphi allows passing alias, but not type alias to a var arg
  19257. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  19258. exit(cExact);
  19259. end
  19260. else if IsSameType(ParamResolved.LoTypeEl,ExprResolved.LoTypeEl,prraNone) then
  19261. begin
  19262. // ObjFPC allows passing type alias to a var arg, but simple alias wins
  19263. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  19264. exit(cExact)
  19265. else
  19266. exit(cAliasExact);
  19267. end;
  19268. end;
  19269. if RaiseOnError then
  19270. RaiseIncompatibleTypeRes(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
  19271. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,
  19272. Expr);
  19273. exit(cIncompatible);
  19274. end;
  19275. UseAssignError:=false;
  19276. if RaiseOnError and (ExprResolved.BaseType in [btArrayLit,btArrayOrSet]) then
  19277. // e.g. Call([1,2]) -> on mismatch jump to the wrong param expression
  19278. UseAssignError:=true;
  19279. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,UseAssignError);
  19280. if (Result=cIncompatible) and RaiseOnError then
  19281. RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
  19282. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
  19283. if SetReferenceFlags and (ParamResolved.BaseType=btContext)
  19284. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  19285. MarkArrayExprRecursive(Expr,TPasArrayType(ParamResolved.LoTypeEl));
  19286. end;
  19287. function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
  19288. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  19289. ): integer;
  19290. var
  19291. RTypeEl, LTypeEl: TPasType;
  19292. SrcResolved, DstResolved: TPasResolverResult;
  19293. LArray, RArray: TPasArrayType;
  19294. GotDesc, ExpDesc: String;
  19295. CurTVarRec: TPasRecordType;
  19296. function RaiseIncompatType(Id: TMaxPrecInt): integer;
  19297. begin
  19298. Result:=cIncompatible;
  19299. if not RaiseOnIncompatible then exit;
  19300. RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
  19301. [],RHS,LHS,ErrorEl);
  19302. end;
  19303. begin
  19304. if (RHS.LoTypeEl=nil) then
  19305. RaiseInternalError(20160922163645);
  19306. if (LHS.LoTypeEl=nil) then
  19307. RaiseInternalError(20160922163648);
  19308. LTypeEl:=LHS.LoTypeEl;
  19309. RTypeEl:=RHS.LoTypeEl;
  19310. // Note: do not check if LHS is writable, because this method is used for 'const' too.
  19311. if (LTypeEl=RTypeEl) and (rrfReadable in RHS.Flags) then
  19312. exit(cExact);
  19313. {$IFDEF VerbosePasResolver}
  19314. writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
  19315. {$ENDIF}
  19316. Result:=-1;
  19317. if LTypeEl.ClassType=TPasClassType then
  19318. begin
  19319. if RHS.BaseType=btNil then
  19320. Result:=cExact
  19321. else if RTypeEl.ClassType=TPasClassType then
  19322. begin
  19323. Result:=cIncompatible;
  19324. if not (rrfReadable in RHS.Flags) then
  19325. exit(RaiseIncompatType(20190215112914));
  19326. if TPasClassType(LTypeEl).ObjKind=TPasClassType(RTypeEl).ObjKind then
  19327. Result:=CheckSrcIsADstType(RHS,LHS)
  19328. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  19329. begin
  19330. if (TPasClassType(RTypeEl).ObjKind=okClass)
  19331. and (not TPasClassType(RTypeEl).IsExternal) then
  19332. begin
  19333. // IntfVar:=ClassInstVar
  19334. if GetClassImplementsIntf(TPasClassType(RTypeEl),TPasClassType(LTypeEl))<>nil then
  19335. exit(cTypeConversion);
  19336. end;
  19337. end;
  19338. if (Result=cIncompatible) and RaiseOnIncompatible then
  19339. RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
  19340. [],RTypeEl,LTypeEl,ErrorEl);
  19341. end
  19342. else
  19343. exit(RaiseIncompatType(20190215112919));
  19344. end
  19345. else if LTypeEl.ClassType=TPasClassOfType then
  19346. begin
  19347. if RHS.BaseType=btNil then
  19348. Result:=cExact
  19349. else if (RTypeEl.ClassType=TPasClassOfType) then
  19350. begin
  19351. if RHS.IdentEl is TPasType then
  19352. begin
  19353. Result:=cIncompatible;
  19354. if RaiseOnIncompatible then
  19355. begin
  19356. if ResolveAliasType(TPasType(RHS.IdentEl)) is TPasClassOfType then
  19357. RaiseMsg(20180317103206,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19358. ['type class-of','class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  19359. else
  19360. RaiseMsg(20180511123859,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19361. [GetResolverResultDescription(RHS),'class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  19362. end;
  19363. end
  19364. else
  19365. begin
  19366. // e.g. ImageClass:=AnotherImageClass;
  19367. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  19368. TPasClassOfType(LTypeEl).DestType);
  19369. if (Result=cIncompatible) and RaiseOnIncompatible then
  19370. RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19371. ['class of '+TPasClassOfType(RTypeEl).DestType.PathName,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  19372. end;
  19373. end
  19374. else if (RHS.IdentEl is TPasType)
  19375. and (ResolveAliasType(TPasType(RHS.IdentEl)).ClassType=TPasClassType) then
  19376. begin
  19377. // e.g. ImageClass:=TFPMemoryImage;
  19378. Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType);
  19379. if (Result=cIncompatible) and RaiseOnIncompatible then
  19380. RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19381. [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  19382. // do not check rrfReadable -> exit
  19383. exit;
  19384. end;
  19385. end
  19386. else if LTypeEl is TPasProcedureType then
  19387. begin
  19388. if RHS.BaseType=btNil then
  19389. exit(cExact);
  19390. //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);
  19391. if (LTypeEl.ClassType=RTypeEl.ClassType)
  19392. and (rrfReadable in RHS.Flags) then
  19393. begin
  19394. // e.g. ProcVar1:=ProcVar2
  19395. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  19396. true,ErrorEl,RaiseOnIncompatible) then
  19397. exit(cExact);
  19398. end;
  19399. if RaiseOnIncompatible then
  19400. begin
  19401. if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
  19402. RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19403. [GetElementTypeName(RTypeEl),GetElementTypeName(LTypeEl)],ErrorEl);
  19404. end;
  19405. end
  19406. else if LTypeEl.ClassType=TPasArrayType then
  19407. begin
  19408. LArray:=TPasArrayType(LTypeEl);
  19409. if (length(LArray.Ranges)=0) and (RTypeEl.ClassType=TPasArrayType) then
  19410. begin
  19411. // DynOrOpenArr:=array
  19412. RArray:=TPasArrayType(RTypeEl);
  19413. if length(RArray.Ranges)=1 then
  19414. begin
  19415. // DynOrOpenArr:=SingleDimStaticArr
  19416. if (msDelphi in CurrentParser.CurrentModeswitches)
  19417. and not IsOpenArray(LArray) then
  19418. begin
  19419. // DynArr:=SingleDimStaticArr forbidden in Delphi
  19420. // Note: OpenArr:=StaticArr is allowed in Delphi
  19421. if RaiseOnIncompatible then
  19422. RaiseIncompatibleTypeDesc(20180620115341,nIncompatibleTypesGotExpected,
  19423. [],'static array','dynamic array',ErrorEl);
  19424. exit(cIncompatible);
  19425. end;
  19426. end
  19427. else if length(RArray.Ranges)>1 then
  19428. begin
  19429. // DynOrOpenArr:=MultiDimStaticArr -> no
  19430. if RaiseOnIncompatible then
  19431. RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
  19432. [],'multi dimensional static array','dynamic array',ErrorEl);
  19433. exit(cIncompatible);
  19434. end
  19435. else if not (proOpenAsDynArrays in Options) then
  19436. begin
  19437. if IsOpenArray(LArray) then
  19438. // OpenArray:=OpenOrDynArr -> ok
  19439. else if IsOpenArray(RArray) then
  19440. begin
  19441. // DynArray:=OpenArray
  19442. if RaiseOnIncompatible then
  19443. RaiseIncompatibleTypeDesc(20180620115515,nIncompatibleTypesGotExpected,
  19444. [],'open array','dynamic array',ErrorEl);
  19445. exit(cIncompatible)
  19446. end
  19447. else
  19448. begin
  19449. // DynArray:=DynArr
  19450. if (msDelphi in CurrentParser.CurrentModeswitches)
  19451. and (LArray<>RArray) then
  19452. begin
  19453. // Delphi does not allow assigning arrays with same element types
  19454. exit(RaiseIncompatType(20190215112626));
  19455. end;
  19456. end;
  19457. end;
  19458. // check element type
  19459. if LArray.ElType=nil then
  19460. begin
  19461. // ArrayOfConst:=SingleDimArr
  19462. if RArray.ElType=nil then
  19463. // ArrayOfConst:=ArrayOfConst
  19464. Result:=cExact
  19465. else
  19466. begin
  19467. CurTVarRec:=GetTVarRec(LArray);
  19468. if ResolveAliasType(RArray.ElType)=CurTVarRec then
  19469. // ArrayOfConst:=ArrayOfTVarRec
  19470. Result:=cExact
  19471. else
  19472. // ArrayOfConst:=SingleDimArr
  19473. exit(RaiseIncompatType(20190215112715));
  19474. end;
  19475. end
  19476. else if RArray.ElType=nil then
  19477. // ArrayOfNonConst:=ArrayOfConst
  19478. exit(RaiseIncompatType(20190215112907))
  19479. else if CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias) then
  19480. Result:=cExact
  19481. else if RaiseOnIncompatible then
  19482. begin
  19483. GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
  19484. RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  19485. ['array of '+GotDesc,
  19486. 'array of '+ExpDesc],ErrorEl)
  19487. end
  19488. else
  19489. exit(cIncompatible);
  19490. end;
  19491. end
  19492. else if LTypeEl.ClassType=TPasRecordType then
  19493. begin
  19494. if (RTypeEl is TPasClassType) and (TPasClassType(RTypeEl).ObjKind=okInterface)
  19495. and IsTGUID(TPasRecordType(LTypeEl)) then
  19496. begin
  19497. // GUIDVar := IntfTypeOrVar
  19498. exit(cInterfaceToTGUID);
  19499. end;
  19500. // records of different type
  19501. end
  19502. else if LTypeEl.ClassType=TPasEnumType then
  19503. begin
  19504. // enums of different type
  19505. end
  19506. else if RTypeEl.ClassType=TPasSetType then
  19507. begin
  19508. // sets of different type are compatible if enum types are compatible
  19509. if LTypeEl.ClassType=TPasSetType then
  19510. begin
  19511. ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
  19512. ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
  19513. if (SrcResolved.LoTypeEl<>nil)
  19514. and (SrcResolved.LoTypeEl=DstResolved.LoTypeEl) then
  19515. Result:=cExact
  19516. else if (SrcResolved.LoTypeEl.CustomData is TResElDataBaseType)
  19517. and (DstResolved.LoTypeEl.CustomData is TResElDataBaseType)
  19518. and (CompareText(SrcResolved.LoTypeEl.Name,DstResolved.LoTypeEl.Name)=0) then
  19519. Result:=cExact
  19520. else if RaiseOnIncompatible then
  19521. RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
  19522. [],SrcResolved,DstResolved,ErrorEl)
  19523. else
  19524. exit(cIncompatible);
  19525. end
  19526. else
  19527. exit(RaiseIncompatType(20190215112924));
  19528. end
  19529. else if LTypeEl.ClassType=TPasPointerType then
  19530. begin
  19531. if RTypeEl.ClassType=TPasPointerType then
  19532. begin
  19533. // TypedPointer:=TypedPointer
  19534. Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
  19535. TPasPointerType(RTypeEl).DestType,ErrorEl,false);
  19536. if Result=cIncompatible then
  19537. exit(RaiseIncompatType(20190215112927));
  19538. end;
  19539. end
  19540. else
  19541. {$IFDEF VerbosePasResolver}
  19542. RaiseNotYetImplemented(20160922163654,ErrorEl);
  19543. {$ELSE}
  19544. ;
  19545. {$ENDIF}
  19546. if Result=-1 then
  19547. exit(RaiseIncompatType(20190215112931));
  19548. if not (rrfReadable in RHS.Flags) then
  19549. exit(RaiseIncompatType(20190215112934));
  19550. end;
  19551. function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
  19552. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  19553. ): integer;
  19554. procedure Check_ArrayOfChar_String(ArrType: TPasArrayType;
  19555. ArrLength: integer; const ElTypeResolved: TPasResolverResult;
  19556. Expr: TPasExpr; ErrorEl: TPasElement);
  19557. // check if assigning a string to an array of char fits
  19558. var
  19559. Value: TResEvalValue;
  19560. ElBT: TResolverBaseType;
  19561. l: Integer;
  19562. S: String;
  19563. {$ifdef FPC_HAS_CPSTRING}
  19564. US: UnicodeString;
  19565. {$endif}
  19566. begin
  19567. if Expr=nil then exit;
  19568. ElBT:=GetActualBaseType(ElTypeResolved.BaseType);
  19569. if length(ArrType.Ranges)=0 then
  19570. begin
  19571. // dynamic array of char can hold any string
  19572. // ToDo: check if value can be converted without loss
  19573. Result:=cExact;
  19574. exit;
  19575. end;
  19576. // static array -> check length of string
  19577. Value:=Eval(Expr,[refAutoConst]); // no external const allowed
  19578. try
  19579. case Value.Kind of
  19580. {$ifdef FPC_HAS_CPSTRING}
  19581. revkString:
  19582. if ElBT=btAnsiChar then
  19583. l:=length(TResEvalString(Value).S)
  19584. else
  19585. begin
  19586. US:=fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,ErrorEl);
  19587. l:=length(US);
  19588. end;
  19589. {$endif}
  19590. revkUnicodeString:
  19591. begin
  19592. if ElBT=btWideChar then
  19593. l:=length(TResEvalUTF16(Value).S)
  19594. else
  19595. begin
  19596. S:=String(TResEvalUTF16(Value).S);
  19597. l:=length(S);
  19598. end;
  19599. end;
  19600. else
  19601. {$IFDEF VerbosePasResolver}
  19602. writeln('Check_ArrayOfChar_String Value=',Value.AsDebugString);
  19603. {$ENDIF}
  19604. exit; // incompatible
  19605. end;
  19606. if ArrLength<>l then
  19607. begin
  19608. {$IFDEF VerbosePasResolver}
  19609. writeln('Check_ArrayOfChar_String ElType=',ElBT,'=',GetResolverResultDbg(ElTypeResolved),' Value=',Value.AsDebugString);
  19610. {$ENDIF}
  19611. RaiseMsg(20170913113216,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  19612. [IntToStr(ArrLength),IntToStr(l)],ErrorEl);
  19613. end;
  19614. Result:=cExact;
  19615. finally
  19616. ReleaseEvalValue(Value);
  19617. end;
  19618. end;
  19619. procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
  19620. Values: TPasResolverResult; ErrorEl: TPasElement);
  19621. var
  19622. Range, Value, Expr: TPasExpr;
  19623. RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
  19624. i, ExpectedCount, ValCnt: Integer;
  19625. IsLastRange, IsConstExpr: Boolean;
  19626. ArrayValues: TPasExprArray;
  19627. LeftResult: integer;
  19628. ExprCompFlags: TPasResolverComputeFlags;
  19629. BuiltInProc: TResElDataBuiltInProc;
  19630. Ref: TResolvedReference;
  19631. RArrayType: TPasArrayType;
  19632. begin
  19633. {$IFDEF VerbosePasResolver}
  19634. writeln('TPasResolver.CheckAssignCompatibilityArrayType.CheckRange ArrType=',GetObjName(ArrType),' RgIndex=',RangeIndex,' Values=',GetResolverResultDbg(Values));
  19635. {$ENDIF}
  19636. if not (rrfReadable in RHS.Flags) then
  19637. exit;
  19638. if (Values.BaseType=btContext) and (RangeIndex=0) and (Values.LoTypeEl=ArrType) then
  19639. begin
  19640. Result:=cExact;
  19641. exit;
  19642. end;
  19643. Expr:=Values.ExprEl;
  19644. if (Expr=nil) and (Values.IdentEl is TPasConst)
  19645. and (TPasConst(Values.IdentEl).VarType=nil) then
  19646. Expr:=TPasVariable(Values.IdentEl).Expr;
  19647. IsConstExpr:=(Expr<>nil) and ExprEvaluator.IsConst(Expr);
  19648. if IsConstExpr then
  19649. ExprCompFlags:=[rcConstant]
  19650. else
  19651. ExprCompFlags:=[];
  19652. if Expr<>nil then
  19653. begin
  19654. if IsEmptyArrayExpr(Values) then
  19655. begin
  19656. if length(ArrType.Ranges)=0 then
  19657. begin
  19658. if RaiseOnIncompatible then
  19659. MarkArrayExprRecursive(Values.ExprEl,ArrType);
  19660. Result:=cExact; // empty set fits open and dyn array
  19661. exit;
  19662. end;
  19663. end
  19664. else if IsArrayOperatorAdd(Expr) and not (Values.BaseType in btAllStrings) then
  19665. begin
  19666. // a:=left+right
  19667. if length(ArrType.Ranges)>0 then
  19668. exit; // ToDo: StaticArray:=A+B
  19669. // check a:=left
  19670. ComputeElement(TBinaryExpr(Expr).left,ValueResolved,ExprCompFlags);
  19671. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  19672. if Result=cIncompatible then exit;
  19673. LeftResult:=Result;
  19674. // check a:=right
  19675. Result:=cIncompatible;
  19676. ComputeElement(TBinaryExpr(Expr).right,ValueResolved,ExprCompFlags);
  19677. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  19678. if Result=cIncompatible then exit;
  19679. if Result<LeftResult then
  19680. Result:=LeftResult;
  19681. exit;
  19682. end
  19683. else if (Expr<>nil) and (Expr.ClassType=TParamsExpr)
  19684. and (TParamsExpr(Expr).Kind=pekFuncParams) then
  19685. begin
  19686. if TParamsExpr(Expr).Value.CustomData is TResolvedReference then
  19687. begin
  19688. Ref:=TResolvedReference(TParamsExpr(Expr).Value.CustomData);
  19689. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  19690. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  19691. begin
  19692. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  19693. ArrayValues:=TParamsExpr(Expr).Params;
  19694. if BuiltInProc.BuiltIn=bfConcatArray then
  19695. begin
  19696. // check Concat(array1,array2,...)
  19697. Result:=cExact;
  19698. for i:=0 to length(ArrayValues)-1 do
  19699. begin
  19700. LeftResult:=Result;
  19701. Result:=cIncompatible;
  19702. ComputeElement(ArrayValues[i],ValueResolved,ExprCompFlags);
  19703. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  19704. if Result=cIncompatible then exit;
  19705. if Result<LeftResult then
  19706. Result:=LeftResult;
  19707. end;
  19708. exit;
  19709. end
  19710. else if BuiltInProc.BuiltIn=bfCopyArray then
  19711. begin
  19712. // check Copy(A...)
  19713. ComputeElement(ArrayValues[0],ValueResolved,ExprCompFlags);
  19714. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  19715. exit;
  19716. end;
  19717. end;
  19718. end;
  19719. end;
  19720. end;
  19721. ExpectedCount:=-1;
  19722. if length(ArrType.Ranges)=0 then
  19723. begin
  19724. // dynamic array
  19725. if (Expr<>nil) then
  19726. begin
  19727. if Expr.ClassType=TArrayValues then
  19728. ExpectedCount:=length(TArrayValues(Expr).Values)
  19729. else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  19730. ExpectedCount:=length(TParamsExpr(Expr).Params)
  19731. else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
  19732. begin
  19733. // const a: dynarray = string
  19734. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  19735. if ElTypeResolved.BaseType in btAllChars then
  19736. Result:=cExact;
  19737. exit;
  19738. end
  19739. else
  19740. begin
  19741. // invalid
  19742. exit;
  19743. end;
  19744. end
  19745. else
  19746. begin
  19747. // type check
  19748. if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
  19749. exit;
  19750. RArrayType:=TPasArrayType(Values.LoTypeEl);
  19751. if length(RArrayType.Ranges)>0 then
  19752. begin
  19753. if RaiseOnIncompatible then
  19754. RaiseXExpectedButYFound(20180622104834,'dynamic array','static array',ErrorEl);
  19755. exit;
  19756. end;
  19757. // dynarr:=dynarr -> check element type
  19758. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  19759. Include(ElTypeResolved.Flags,rrfWritable);
  19760. ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
  19761. Include(ValueResolved.Flags,rrfReadable);
  19762. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
  19763. exit;
  19764. end;
  19765. Range:=nil;
  19766. IsLastRange:=true;
  19767. end
  19768. else
  19769. begin
  19770. // static array
  19771. Range:=ArrType.Ranges[RangeIndex];
  19772. ExpectedCount:=GetRangeLength(Range);
  19773. if ExpectedCount=0 then
  19774. begin
  19775. ComputeElement(Range,RangeResolved,[rcConstant]);
  19776. RaiseNotYetImplemented(20170222232409,Expr,'range '+GetResolverResultDbg(RangeResolved));
  19777. end;
  19778. IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
  19779. if Expr=nil then
  19780. begin
  19781. if (ValueResolved.BaseType=btContext) and (ValueResolved.LoTypeEl.ClassType=TPasArrayType) then
  19782. begin
  19783. {$IFDEF VerbosePasResolver}
  19784. writeln('CheckRange TODO StaticArr:=Arr');
  19785. {$ENDIF}
  19786. end;
  19787. exit;
  19788. end;
  19789. end;
  19790. if IsLastRange then
  19791. begin
  19792. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  19793. ElTypeResolved.ExprEl:=Range;
  19794. Include(ElTypeResolved.Flags,rrfWritable);
  19795. end
  19796. else
  19797. ElTypeResolved.BaseType:=btNone;
  19798. if (Expr<>nil)
  19799. and ((Expr.ClassType=TArrayValues)
  19800. or ((Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet))) then
  19801. begin
  19802. // array literal
  19803. if (ErrorEl.Parent is TPasVariable) then
  19804. begin
  19805. // array initialization e.g. var a: tarray = []
  19806. if msDelphi in CurrentParser.CurrentModeswitches then
  19807. begin
  19808. // Delphi expects square brackets for dynamic arrays
  19809. // and round brackets for static arrays
  19810. if length(ArrType.Ranges)>0 then
  19811. begin
  19812. // static array
  19813. if Expr.ClassType<>TArrayValues then
  19814. begin
  19815. if RaiseOnIncompatible then
  19816. RaiseXExpectedButYFound(20180615121203,'(','[',ErrorEl);
  19817. exit;
  19818. end;
  19819. end
  19820. else
  19821. begin
  19822. // dyn array
  19823. if Expr.ClassType=TArrayValues then
  19824. begin
  19825. if RaiseOnIncompatible then
  19826. RaiseXExpectedButYFound(20180615122953,'[','(',ErrorEl);
  19827. exit;
  19828. end;
  19829. end;
  19830. end
  19831. else
  19832. begin
  19833. // ObjFPC always expects round brackets in initialization
  19834. if Expr.ClassType<>TArrayValues then
  19835. begin
  19836. if RaiseOnIncompatible then
  19837. RaiseXExpectedButYFound(20170913181208,'(','[',ErrorEl);
  19838. exit;
  19839. end;
  19840. end;
  19841. end;
  19842. // check each value
  19843. if Expr.ClassType=TArrayValues then
  19844. ArrayValues:=TArrayValues(Expr).Values
  19845. else
  19846. ArrayValues:=TParamsExpr(Expr).Params;
  19847. ValCnt:=length(ArrayValues);
  19848. Include(ExprCompFlags,rcNoImplicitProcType);
  19849. for i:=0 to ExpectedCount-1 do
  19850. begin
  19851. if i=ValCnt then
  19852. begin
  19853. // not enough values
  19854. if ValCnt>0 then
  19855. ErrorEl:=ArrayValues[ValCnt-1];
  19856. RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  19857. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  19858. end;
  19859. Value:=ArrayValues[i];
  19860. ComputeElement(Value,ValueResolved,ExprCompFlags);
  19861. if IsLastRange then
  19862. begin
  19863. // last dimension -> check element type
  19864. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
  19865. if Result=cIncompatible then
  19866. exit;
  19867. CheckAssignExprRange(ElTypeResolved,Value);
  19868. end
  19869. else
  19870. begin
  19871. // multi dimensional array -> check next range
  19872. CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
  19873. end;
  19874. end;
  19875. if ExpectedCount<ValCnt then
  19876. begin
  19877. // too many values
  19878. ErrorEl:=ArrayValues[ExpectedCount];
  19879. if RaiseOnIncompatible then
  19880. RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  19881. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  19882. exit;
  19883. end;
  19884. if RaiseOnIncompatible and (Expr.ClassType=TParamsExpr) then
  19885. // mark [] expression as an array
  19886. MarkArrayExpr(TParamsExpr(Expr),ArrType);
  19887. end
  19888. else
  19889. begin
  19890. // single value
  19891. // Note: the parser does not store the difference between (1) and 1
  19892. if not IsLastRange then
  19893. begin
  19894. if RaiseOnIncompatible then
  19895. RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  19896. [IntToStr(ExpectedCount),'1'],ErrorEl);
  19897. exit;
  19898. end;
  19899. if (Values.BaseType in btAllStrings) and (ElTypeResolved.BaseType in btAllChars) then
  19900. begin
  19901. // e.g. array of char = ''
  19902. Check_ArrayOfChar_String(ArrType,ExpectedCount,ElTypeResolved,Expr,ErrorEl);
  19903. exit;
  19904. end;
  19905. if (ExpectedCount>1) then
  19906. begin
  19907. if RaiseOnIncompatible then
  19908. begin
  19909. {$IFDEF VerbosePasResolver}
  19910. writeln('CheckRange Values=',GetResolverResultDbg(Values),' ElTypeResolved=',GetResolverResultDbg(ElTypeResolved));
  19911. {$ENDIF}
  19912. RaiseMsg(20170913103143,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  19913. [IntToStr(ExpectedCount),'1'],ErrorEl);
  19914. end;
  19915. exit;
  19916. end;
  19917. // check element type
  19918. Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
  19919. if Result=cIncompatible then
  19920. exit;
  19921. if Expr<>nil then
  19922. CheckAssignExprRange(ElTypeResolved,Expr);
  19923. end;
  19924. end;
  19925. var
  19926. LArrType: TPasArrayType;
  19927. begin
  19928. Result:=cIncompatible;
  19929. {$IFDEF VerbosePasResolver}
  19930. writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  19931. {$ENDIF}
  19932. if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
  19933. RaiseInternalError(20170222230012);
  19934. LArrType:=TPasArrayType(LHS.LoTypeEl);
  19935. if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
  19936. and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
  19937. begin
  19938. // ArrayOfConst:=[]
  19939. exit(cExact);
  19940. end;
  19941. CheckRange(LArrType,0,RHS,ErrorEl);
  19942. if (Result=cIncompatible) and RaiseOnIncompatible then
  19943. RaiseIncompatibleTypeRes(20180622104721,nIncompatibleTypesGotExpected,[],RHS,LHS,ErrorEl);
  19944. end;
  19945. function TPasResolver.CheckAssignCompatibilityPointerType(LTypeEl,
  19946. RTypeEl: TPasType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  19947. ): integer;
  19948. var
  19949. LeftResolved, RightResolved: TPasResolverResult;
  19950. begin
  19951. ComputeElement(LTypeEl,LeftResolved,[rcNoImplicitProc]);
  19952. ComputeElement(RTypeEl,RightResolved,[rcNoImplicitProc]);
  19953. Include(LeftResolved.Flags,rrfWritable);
  19954. Include(RightResolved.Flags,rrfReadable);
  19955. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  19956. end;
  19957. function TPasResolver.CheckEqualCompatibilityUserType(const LHS,
  19958. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  19959. ): integer;
  19960. // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  19961. var
  19962. LTypeEl, RTypeEl: TPasType;
  19963. AResolved, BResolved: TPasResolverResult;
  19964. function IncompatibleElements: integer;
  19965. begin
  19966. Result:=cIncompatible;
  19967. if not RaiseOnIncompatible then exit;
  19968. RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
  19969. [],LTypeEl,RTypeEl,ErrorEl);
  19970. end;
  19971. begin
  19972. if (LHS.LoTypeEl=nil) then
  19973. RaiseInternalError(20161007223118);
  19974. if (RHS.LoTypeEl=nil) then
  19975. RaiseInternalError(20161007223119);
  19976. LTypeEl:=LHS.LoTypeEl;
  19977. RTypeEl:=RHS.LoTypeEl;
  19978. if LTypeEl=RTypeEl then
  19979. exit(cExact);
  19980. if LTypeEl.ClassType=TPasClassType then
  19981. begin
  19982. if RTypeEl.ClassType=TPasClassType then
  19983. begin
  19984. // e.g. if Sender=Button1 then
  19985. Result:=CheckSrcIsADstType(LHS,RHS);
  19986. if Result=cIncompatible then
  19987. Result:=CheckSrcIsADstType(RHS,LHS);
  19988. if (Result=cIncompatible) and RaiseOnIncompatible then
  19989. RaiseIncompatibleTypeRes(20180324190757,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  19990. exit;
  19991. end
  19992. else if RTypeEl.ClassType=TPasRecordType then
  19993. begin
  19994. if (TPasClassType(LTypeEl).ObjKind=okInterface)
  19995. and IsTGUID(TPasRecordType(RTypeEl)) then
  19996. // IntfVar=GuidVar
  19997. exit(cInterfaceToTGUID);
  19998. end;
  19999. exit(IncompatibleElements);
  20000. end
  20001. else if LTypeEl.ClassType=TPasClassOfType then
  20002. begin
  20003. if RTypeEl.ClassType=TPasClassOfType then
  20004. begin
  20005. // for example: if ImageClass=ImageClass then
  20006. Result:=CheckClassIsClass(TPasClassOfType(LTypeEl).DestType,
  20007. TPasClassOfType(RTypeEl).DestType);
  20008. if Result=cIncompatible then
  20009. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  20010. TPasClassOfType(LTypeEl).DestType);
  20011. if (Result=cIncompatible) and RaiseOnIncompatible then
  20012. RaiseIncompatibleTypeRes(20180324190804,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  20013. exit;
  20014. end;
  20015. exit(IncompatibleElements);
  20016. end
  20017. else if LTypeEl.ClassType=TPasEnumType then
  20018. begin
  20019. // enums of different type
  20020. if not RaiseOnIncompatible then
  20021. exit(cIncompatible);
  20022. if RTypeEl.ClassType=TPasEnumValue then
  20023. RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
  20024. [],TPasEnumType(LTypeEl),TPasEnumType(RTypeEl),ErrorEl)
  20025. else
  20026. exit(IncompatibleElements);
  20027. end
  20028. else if LTypeEl.ClassType=TPasRecordType then
  20029. begin
  20030. if RTypeEl.ClassType=TPasClassType then
  20031. begin
  20032. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  20033. and IsTGUID(TPasRecordType(LTypeEl)) then
  20034. // GuidVar=IntfVar
  20035. exit(cInterfaceToTGUID);
  20036. end;
  20037. end
  20038. else if LTypeEl.ClassType=TPasSetType then
  20039. begin
  20040. if RTypeEl.ClassType=TPasSetType then
  20041. begin
  20042. ComputeElement(TPasSetType(LTypeEl).EnumType,AResolved,[]);
  20043. ComputeElement(TPasSetType(RTypeEl).EnumType,BResolved,[]);
  20044. if (AResolved.LoTypeEl<>nil)
  20045. and (AResolved.LoTypeEl=BResolved.LoTypeEl) then
  20046. exit(cExact);
  20047. if (AResolved.LoTypeEl.CustomData is TResElDataBaseType)
  20048. and (BResolved.LoTypeEl.CustomData is TResElDataBaseType)
  20049. and (CompareText(AResolved.LoTypeEl.Name,BResolved.LoTypeEl.Name)=0) then
  20050. exit(cExact);
  20051. if RaiseOnIncompatible then
  20052. RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
  20053. [],AResolved,BResolved,ErrorEl)
  20054. else
  20055. exit(cIncompatible);
  20056. end
  20057. else
  20058. exit(IncompatibleElements);
  20059. end
  20060. else if LTypeEl is TPasProcedureType then
  20061. begin
  20062. if RTypeEl is TPasProcedureType then
  20063. begin
  20064. // e.g. ProcVar1 = ProcVar2
  20065. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  20066. false,nil,false) then
  20067. exit(cExact);
  20068. end
  20069. else
  20070. exit(IncompatibleElements);
  20071. end
  20072. else if LTypeEl.ClassType=TPasPointerType then
  20073. begin
  20074. if RTypeEl.ClassType=TPasPointerType then
  20075. // TypedPointer=TypedPointer
  20076. exit(cExact);
  20077. end;
  20078. exit(IncompatibleElements);
  20079. end;
  20080. function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
  20081. RaiseOnError: boolean): integer;
  20082. // for example if TClassA(AnObject)=nil then ;
  20083. var
  20084. Param: TPasExpr;
  20085. ParamResolved, ResolvedEl: TPasResolverResult;
  20086. begin
  20087. if length(Params.Params)<>1 then
  20088. begin
  20089. if RaiseOnError then
  20090. RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
  20091. sWrongNumberOfParametersForTypeCast,[El.Name],Params);
  20092. exit(cIncompatible);
  20093. end;
  20094. Param:=Params.Params[0];
  20095. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  20096. ComputeElement(El,ResolvedEl,[rcType]);
  20097. Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
  20098. end;
  20099. function TPasResolver.CheckTypeCastRes(const FromResolved,
  20100. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  20101. ): integer;
  20102. var
  20103. ToTypeEl, ToClassType, FromClassType, FromTypeEl: TPasType;
  20104. ToTypeBaseType: TResolverBaseType;
  20105. C: TClass;
  20106. ToProcType, FromProcType: TPasProcedureType;
  20107. begin
  20108. Result:=cIncompatible;
  20109. ToTypeEl:=ToResolved.LoTypeEl;
  20110. if (ToTypeEl<>nil)
  20111. and (rrfReadable in FromResolved.Flags) then
  20112. begin
  20113. C:=ToTypeEl.ClassType;
  20114. if FromResolved.BaseType=btUntyped then
  20115. begin
  20116. // typecast an untyped parameter
  20117. Result:=cCompatible;
  20118. end
  20119. else if C=TPasUnresolvedSymbolRef then
  20120. begin
  20121. if ToTypeEl.CustomData is TResElDataBaseType then
  20122. begin
  20123. // base type cast, e.g. double(aninteger)
  20124. if ToTypeEl=FromResolved.LoTypeEl then
  20125. exit(cExact);
  20126. ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
  20127. if ToTypeBaseType=FromResolved.BaseType then
  20128. Result:=cExact
  20129. else if ToTypeBaseType in btAllInteger then
  20130. begin
  20131. if FromResolved.BaseType in (btArrayRangeTypes+[btRange,btCurrency]) then
  20132. Result:=cCompatible
  20133. else if FromResolved.BaseType=btContext then
  20134. begin
  20135. FromTypeEl:=FromResolved.LoTypeEl;
  20136. if FromTypeEl.ClassType=TPasEnumType then
  20137. // e.g. longint(TEnum)
  20138. Result:=cCompatible;
  20139. end;
  20140. end
  20141. else if ToTypeBaseType in btAllFloats then
  20142. begin
  20143. if FromResolved.BaseType in btAllFloats then
  20144. Result:=cCompatible
  20145. else if FromResolved.BaseType in btAllInteger then
  20146. Result:=cCompatible;
  20147. end
  20148. else if ToTypeBaseType in btAllBooleans then
  20149. begin
  20150. if FromResolved.BaseType in btAllBooleans then
  20151. Result:=cCompatible
  20152. else if FromResolved.BaseType in btAllInteger then
  20153. Result:=cCompatible;
  20154. end
  20155. else if ToTypeBaseType in btAllChars then
  20156. begin
  20157. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  20158. Result:=cCompatible
  20159. else if FromResolved.BaseType=btContext then
  20160. begin
  20161. FromTypeEl:=FromResolved.LoTypeEl;
  20162. if FromTypeEl.ClassType=TPasEnumType then
  20163. // e.g. char(TEnum)
  20164. Result:=cCompatible;
  20165. end;
  20166. end
  20167. else if ToTypeBaseType in btAllStrings then
  20168. begin
  20169. if FromResolved.BaseType in btAllStringAndChars then
  20170. Result:=cCompatible
  20171. else if (FromResolved.BaseType=btPointer)
  20172. and (ToTypeBaseType in btAllStringPointer) then
  20173. Result:=cExact;
  20174. end
  20175. else if ToTypeBaseType=btPointer then
  20176. begin
  20177. if FromResolved.BaseType in ([btPointer]+btAllStringPointer) then
  20178. Result:=cExact
  20179. else if FromResolved.BaseType=btContext then
  20180. begin
  20181. FromTypeEl:=FromResolved.LoTypeEl;
  20182. C:=FromTypeEl.ClassType;
  20183. if (C=TPasClassType)
  20184. or (C=TPasClassOfType)
  20185. or (C=TPasPointerType)
  20186. or ((C=TPasArrayType) and IsDynArray(FromTypeEl)) then
  20187. Result:=cExact
  20188. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  20189. begin
  20190. // from procvar to pointer
  20191. FromProcType:=TPasProcedureType(FromTypeEl);
  20192. if FromProcType.IsOfObject then
  20193. begin
  20194. if proMethodAddrAsPointer in Options then
  20195. Result:=cCompatible
  20196. else if RaiseOnError then
  20197. RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20198. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmOfObject],
  20199. BaseTypeNames[btPointer]],ErrorEl);
  20200. end
  20201. else if FromProcType.IsNested then
  20202. begin
  20203. if RaiseOnError then
  20204. RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20205. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmIsNested],
  20206. BaseTypeNames[btPointer]],ErrorEl);
  20207. end
  20208. else if FromProcType.IsReferenceTo then
  20209. begin
  20210. if proProcTypeWithoutIsNested in Options then
  20211. Result:=cCompatible
  20212. else if RaiseOnError then
  20213. RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20214. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmReferenceTo],
  20215. BaseTypeNames[btPointer]],ErrorEl);
  20216. end
  20217. else
  20218. Result:=cCompatible;
  20219. end;
  20220. end;
  20221. end;
  20222. end;
  20223. end
  20224. else if C=TPasClassType then
  20225. begin
  20226. // to class
  20227. if FromResolved.BaseType=btContext then
  20228. begin
  20229. FromTypeEl:=FromResolved.LoTypeEl;
  20230. if FromTypeEl.ClassType=TPasClassType then
  20231. begin
  20232. if FromResolved.IdentEl is TPasType then
  20233. RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  20234. if TPasClassType(FromTypeEl).ObjKind=TPasClassType(ToTypeEl).ObjKind then
  20235. begin
  20236. // type cast upwards or downwards
  20237. Result:=CheckSrcIsADstType(FromResolved,ToResolved);
  20238. if Result=cIncompatible then
  20239. Result:=CheckSrcIsADstType(ToResolved,FromResolved);
  20240. end
  20241. else if TPasClassType(ToTypeEl).ObjKind=okInterface then
  20242. begin
  20243. if (TPasClassType(FromTypeEl).ObjKind=okClass)
  20244. and (not TPasClassType(FromTypeEl).IsExternal) then
  20245. begin
  20246. // e.g. intftype(classinstvar)
  20247. Result:=cCompatible;
  20248. end;
  20249. end
  20250. else if TPasClassType(FromTypeEl).ObjKind=okInterface then
  20251. begin
  20252. if (TPasClassType(ToTypeEl).ObjKind=okClass)
  20253. and (not TPasClassType(ToTypeEl).IsExternal) then
  20254. begin
  20255. // e.g. classtype(intfvar)
  20256. Result:=cCompatible;
  20257. end;
  20258. end;
  20259. if Result=cIncompatible then
  20260. Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
  20261. end
  20262. end
  20263. else if FromResolved.BaseType=btPointer then
  20264. begin
  20265. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  20266. Result:=cExact; // untyped pointer to class instance
  20267. end;
  20268. end
  20269. else if C=TPasClassOfType then
  20270. begin
  20271. //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.LoTypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
  20272. if FromResolved.BaseType=btContext then
  20273. begin
  20274. if FromResolved.LoTypeEl.ClassType=TPasClassOfType then
  20275. begin
  20276. if (FromResolved.IdentEl is TPasType) then
  20277. RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  20278. // type cast classof(classof-var) upwards or downwards
  20279. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  20280. FromClassType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
  20281. Result:=CheckClassesAreRelated(ToClassType,FromClassType);
  20282. end;
  20283. end
  20284. else if FromResolved.BaseType=btPointer then
  20285. begin
  20286. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  20287. Result:=cExact; // untyped pointer to class-of
  20288. end;
  20289. end
  20290. else if C=TPasRecordType then
  20291. begin
  20292. if FromResolved.BaseType=btContext then
  20293. begin
  20294. if FromResolved.LoTypeEl.ClassType=TPasRecordType then
  20295. begin
  20296. // typecast record to record
  20297. Result:=cExact;
  20298. end;
  20299. end;
  20300. end
  20301. else if (C=TPasEnumType)
  20302. or (C=TPasRangeType) then
  20303. begin
  20304. if CheckIsOrdinal(FromResolved,ErrorEl,true) then
  20305. Result:=cExact;
  20306. end
  20307. else if C=TPasArrayType then
  20308. begin
  20309. if FromResolved.BaseType=btContext then
  20310. begin
  20311. if FromResolved.LoTypeEl.ClassType=TPasArrayType then
  20312. Result:=CheckTypeCastArray(TPasArrayType(FromResolved.LoTypeEl),
  20313. TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
  20314. end
  20315. else if FromResolved.BaseType=btPointer then
  20316. begin
  20317. if IsDynArray(ToResolved.LoTypeEl)
  20318. and IsBaseType(FromResolved.LoTypeEl,btPointer) then
  20319. Result:=cExact; // untyped pointer to dynnamic array
  20320. end;
  20321. end
  20322. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  20323. begin
  20324. ToProcType:=TPasProcedureType(ToTypeEl);
  20325. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  20326. begin
  20327. // type cast untyped pointer value to proctype
  20328. if ToProcType.IsOfObject then
  20329. begin
  20330. if proMethodAddrAsPointer in Options then
  20331. Result:=cCompatible
  20332. else if RaiseOnError then
  20333. RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20334. [BaseTypeNames[btPointer],
  20335. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
  20336. end
  20337. else if ToProcType.IsNested then
  20338. begin
  20339. if RaiseOnError then
  20340. RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20341. [BaseTypeNames[btPointer],
  20342. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
  20343. end
  20344. else if ToProcType.IsReferenceTo then
  20345. begin
  20346. if proMethodAddrAsPointer in Options then
  20347. Result:=cCompatible
  20348. else if RaiseOnError then
  20349. RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20350. [BaseTypeNames[btPointer],
  20351. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
  20352. end
  20353. else
  20354. Result:=cCompatible;
  20355. end
  20356. else if FromResolved.BaseType=btContext then
  20357. begin
  20358. FromTypeEl:=FromResolved.LoTypeEl;
  20359. if FromTypeEl is TPasProcedureType then
  20360. begin
  20361. // type cast procvar to proctype
  20362. FromProcType:=TPasProcedureType(FromTypeEl);
  20363. if ToProcType.IsReferenceTo then
  20364. Result:=cCompatible
  20365. else if FromProcType.IsReferenceTo then
  20366. Result:=cCompatible
  20367. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  20368. and not (proMethodAddrAsPointer in Options) then
  20369. begin
  20370. if RaiseOnError then
  20371. RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20372. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  20373. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  20374. end
  20375. else if FromProcType.IsNested<>ToProcType.IsNested then
  20376. begin
  20377. if RaiseOnError then
  20378. RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20379. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  20380. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  20381. end
  20382. else
  20383. Result:=cCompatible;
  20384. end
  20385. end
  20386. else if FromResolved.BaseType=btProc then
  20387. begin
  20388. FromTypeEl:=FromResolved.LoTypeEl;
  20389. if FromTypeEl is TPasProcedureType then
  20390. begin
  20391. // typecast procedure (or anonymous procedure) to proctype
  20392. FromProcType:=TPasProcedureType(FromTypeEl);
  20393. if (msDelphi in CurrentParser.CurrentModeswitches)
  20394. and (FromResolved.IdentEl=nil)
  20395. and (FromResolved.LoTypeEl.Name<>'') then
  20396. // Delphi forbids typecast (non anonymous) procedure to proctype
  20397. else if ToProcType.IsReferenceTo then
  20398. Result:=cCompatible
  20399. else if FromResolved.IdentEl=nil then
  20400. // anonymous proc to proctype
  20401. Result:=cCompatible
  20402. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  20403. and not (proMethodAddrAsPointer in Options) then
  20404. begin
  20405. // e.g. TProcedure(Obj.DoIt)
  20406. if RaiseOnError then
  20407. RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20408. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  20409. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  20410. end
  20411. else if FromProcType.IsNested<>ToProcType.IsNested then
  20412. begin
  20413. if RaiseOnError then
  20414. RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  20415. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  20416. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  20417. end
  20418. else
  20419. Result:=cCompatible;
  20420. end;
  20421. end;
  20422. end
  20423. else if C=TPasPointerType then
  20424. begin
  20425. // typecast to typedpointer
  20426. if FromResolved.BaseType in [btPointer,btNil] then
  20427. Result:=cExact
  20428. else if FromResolved.BaseType=btContext then
  20429. begin
  20430. FromTypeEl:=FromResolved.LoTypeEl;
  20431. C:=FromTypeEl.ClassType;
  20432. if (C=TPasPointerType)
  20433. or (C=TPasClassOfType)
  20434. or (C=TPasClassType)
  20435. or (C.InheritsFrom(TPasProcedureType))
  20436. or IsDynArray(FromTypeEl) then
  20437. Result:=cCompatible;
  20438. end;
  20439. end
  20440. end
  20441. else if ToTypeEl<>nil then
  20442. begin
  20443. // FromResolved is not readable
  20444. if FromResolved.BaseType=btContext then
  20445. begin
  20446. FromTypeEl:=FromResolved.LoTypeEl;
  20447. if (FromTypeEl.ClassType=TPasClassType)
  20448. and (FromTypeEl=FromResolved.IdentEl)
  20449. and (ToResolved.BaseType=btContext) then
  20450. begin
  20451. ToTypeEl:=ToResolved.LoTypeEl;
  20452. if (ToTypeEl.ClassType=TPasClassOfType)
  20453. and (ToTypeEl=ToResolved.IdentEl) then
  20454. begin
  20455. // for example class-of(Self) in a class function
  20456. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  20457. FromClassType:=TPasClassType(FromTypeEl);
  20458. Result:=CheckClassesAreRelated(ToClassType,FromClassType);
  20459. end;
  20460. end;
  20461. end;
  20462. if (Result=cIncompatible) and RaiseOnError then
  20463. begin
  20464. if FromResolved.IdentEl is TPasType then
  20465. RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  20466. end;
  20467. end;
  20468. if Result=cIncompatible then
  20469. begin
  20470. {$IFDEF VerbosePasResolver}
  20471. writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
  20472. {$ENDIF}
  20473. if RaiseOnError then
  20474. RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
  20475. [],FromResolved,ToResolved,ErrorEl);
  20476. exit;
  20477. end;
  20478. end;
  20479. function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
  20480. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  20481. function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
  20482. out ElTypeResolved: TPasResolverResult): boolean;
  20483. begin
  20484. inc(NextIndex);
  20485. if NextIndex<length(ArrType.Ranges) then
  20486. begin
  20487. ElTypeResolved.BaseType:=btNone;
  20488. exit(true);
  20489. end;
  20490. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  20491. if (ElTypeResolved.BaseType<>btContext)
  20492. or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
  20493. exit(false);
  20494. ArrType:=TPasArrayType(ElTypeResolved.LoTypeEl);
  20495. NextIndex:=0;
  20496. Result:=true;
  20497. end;
  20498. var
  20499. FromIndex, ToIndex: Integer;
  20500. FromElTypeRes, ToElTypeRes: TPasResolverResult;
  20501. StartFromType, StartToType: TPasArrayType;
  20502. begin
  20503. {$IFDEF VerbosePasResolver}
  20504. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
  20505. {$ENDIF}
  20506. StartFromType:=FromType;
  20507. StartToType:=ToType;
  20508. Result:=cIncompatible;
  20509. // check dimensions
  20510. FromIndex:=0;
  20511. ToIndex:=0;
  20512. repeat
  20513. {$IFDEF VerbosePasResolver}
  20514. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  20515. {$ENDIF}
  20516. if length(ToType.Ranges)=0 then
  20517. // ToType is dynamic/open array -> fits any size
  20518. else
  20519. begin
  20520. // ToType is ranged
  20521. // ToDo: check size of dimension
  20522. end;
  20523. // check next dimension
  20524. if not NextDim(FromType,FromIndex,FromElTypeRes) then
  20525. begin
  20526. // at end of FromType
  20527. if NextDim(ToType,ToIndex,ToElTypeRes) then
  20528. begin
  20529. {$IFDEF VerbosePasResolver}
  20530. writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  20531. {$ENDIF}
  20532. break; // ToType has more dimensions
  20533. end;
  20534. // have same dimension -> check ElType
  20535. {$IFDEF VerbosePasResolver}
  20536. writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
  20537. {$ENDIF}
  20538. Include(FromElTypeRes.Flags,rrfReadable);
  20539. Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
  20540. break;
  20541. end
  20542. else
  20543. begin
  20544. // FromType has more dimensions
  20545. if not NextDim(ToType,ToIndex,ToElTypeRes) then
  20546. begin
  20547. {$IFDEF VerbosePasResolver}
  20548. writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  20549. {$ENDIF}
  20550. break; // ToType has less dimensions
  20551. end;
  20552. end;
  20553. until false;
  20554. if (Result=cIncompatible) and RaiseOnError then
  20555. RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
  20556. [],StartFromType,StartToType,ErrorEl);
  20557. end;
  20558. procedure TPasResolver.ComputeElement(El: TPasElement; out
  20559. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  20560. StartEl: TPasElement);
  20561. procedure ComputeIdentifier(Expr: TPasExpr);
  20562. var
  20563. Ref: TResolvedReference;
  20564. Proc: TPasProcedure;
  20565. ProcType: TPasProcedureType;
  20566. begin
  20567. Ref:=TResolvedReference(Expr.CustomData);
  20568. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  20569. if rrfConstInherited in Ref.Flags then
  20570. Exclude(ResolvedEl.Flags,rrfWritable);
  20571. {$IFDEF VerbosePasResolver}
  20572. {AllowWriteln}
  20573. if Expr is TPrimitiveExpr then
  20574. writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
  20575. else
  20576. writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
  20577. {AllowWriteln-}
  20578. {$ENDIF}
  20579. //if (Expr is TPrimitiveExpr) and (Expr.Parent is TParamsExpr) and (TPrimitiveExpr(Expr).Value='FA') then
  20580. // RaiseNotYetImplemented(20180621235200,Expr);
  20581. if not (rcSetReferenceFlags in Flags)
  20582. and (rrfNoImplicitCallWithoutParams in Ref.Flags) then
  20583. exit;
  20584. if (ResolvedEl.BaseType=btProc) then
  20585. begin
  20586. // proc
  20587. if rcNoImplicitProc in Flags then
  20588. begin
  20589. if rcSetReferenceFlags in Flags then
  20590. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  20591. end
  20592. else if [rcConstant,rcType]*Flags=[] then
  20593. begin
  20594. // implicit call without params is allowed -> check if possible
  20595. Proc:=ResolvedEl.IdentEl as TPasProcedure;
  20596. if not ProcNeedsParams(Proc.ProcType) then
  20597. begin
  20598. // parameter less proc -> implicit call possible
  20599. if ResolvedEl.IdentEl is TPasFunction then
  20600. begin
  20601. // function => return result
  20602. ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
  20603. ResolvedEl,Flags+[rcType],StartEl);
  20604. end
  20605. else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
  20606. begin
  20607. // constructor -> return value of type class
  20608. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  20609. end
  20610. else if ParentNeedsExprResult(Expr) then
  20611. begin
  20612. // a procedure
  20613. exit;
  20614. end;
  20615. if rcSetReferenceFlags in Flags then
  20616. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  20617. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20618. end;
  20619. end;
  20620. end
  20621. else if IsProcedureType(ResolvedEl,true) then
  20622. begin
  20623. // proc type
  20624. if [rcNoImplicitProc,rcNoImplicitProcType]*Flags<>[] then
  20625. begin
  20626. if rcSetReferenceFlags in Flags then
  20627. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  20628. end
  20629. else if [rcConstant,rcType]*Flags=[] then
  20630. begin
  20631. // implicit call without params is allowed -> check if possible
  20632. ProcType:=TPasProcedureType(ResolvedEl.LoTypeEl);
  20633. if not ProcNeedsParams(ProcType) then
  20634. begin
  20635. // parameter less proc type -> implicit call possible
  20636. if ResolvedEl.LoTypeEl is TPasFunctionType then
  20637. // function => return result
  20638. ComputeElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  20639. ResolvedEl,Flags+[rcType],StartEl)
  20640. else if ParentNeedsExprResult(Expr) then
  20641. begin
  20642. // a procedure has no result
  20643. exit;
  20644. end;
  20645. if rcSetReferenceFlags in Flags then
  20646. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  20647. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20648. end;
  20649. end;
  20650. end;
  20651. end;
  20652. procedure ComputeInherited(Expr: TInheritedExpr);
  20653. var
  20654. Ref: TResolvedReference;
  20655. Proc: TPasProcedure;
  20656. TypeEl: TPasProcedureType;
  20657. HasName: Boolean;
  20658. begin
  20659. // "inherited;"
  20660. Ref:=TResolvedReference(El.CustomData);
  20661. Proc:=NoNil(Ref.Declaration) as TPasProcedure;
  20662. TypeEl:=TPasProcedure(Proc).ProcType;
  20663. SetResolverIdentifier(ResolvedEl,btProc,Proc,
  20664. TypeEl,TypeEl,[rrfCanBeStatement]);
  20665. HasName:=(El.Parent.ClassType=TBinaryExpr)
  20666. and (TBinaryExpr(El.Parent).OpCode=eopNone); // true if 'inherited Proc;'
  20667. if HasName or (rcNoImplicitProc in Flags) then
  20668. exit;
  20669. // inherited; -> implicit call possible
  20670. if Proc is TPasFunction then
  20671. begin
  20672. // function => return result
  20673. ComputeElement(TPasFunction(Proc).FuncType.ResultEl,
  20674. ResolvedEl,Flags+[rcType],StartEl);
  20675. Exclude(ResolvedEl.Flags,rrfWritable);
  20676. end
  20677. else if (Proc.ClassType=TPasConstructor)
  20678. and (rrfNewInstance in Ref.Flags) then
  20679. begin
  20680. // new instance constructor -> return value of type class
  20681. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  20682. end
  20683. else if ParentNeedsExprResult(Expr) then
  20684. begin
  20685. // a procedure
  20686. exit;
  20687. end;
  20688. if rcSetReferenceFlags in Flags then
  20689. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  20690. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20691. end;
  20692. var
  20693. DeclEl: TPasElement;
  20694. ElClass: TClass;
  20695. bt: TResolverBaseType;
  20696. TypeEl: TPasType;
  20697. Value: TResEvalValue;
  20698. Int: TMaxPrecInt;
  20699. begin
  20700. if StartEl=nil then StartEl:=El;
  20701. ResolvedEl:=Default(TPasResolverResult);
  20702. {$IFDEF VerbosePasResolver}
  20703. writeln('TPasResolver.ComputeElement El=',GetObjName(El));
  20704. {$ENDIF}
  20705. if El=nil then
  20706. exit;
  20707. ElClass:=El.ClassType;
  20708. if ElClass=TPrimitiveExpr then
  20709. begin
  20710. case TPrimitiveExpr(El).Kind of
  20711. pekIdent,pekSelf:
  20712. begin
  20713. if not (El.CustomData is TResolvedReference) then
  20714. RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  20715. ComputeIdentifier(TPrimitiveExpr(El));
  20716. end;
  20717. pekNumber:
  20718. begin
  20719. if NumberIsFloat(TPrimitiveExpr(El).Value) then
  20720. bt:=BaseTypeExtended
  20721. else if length(TPrimitiveExpr(El).Value)<9 then
  20722. bt:=btLongint
  20723. else
  20724. begin
  20725. // with 9+ it could be longword: e.g. $87654321
  20726. Value:=Eval(TPrimitiveExpr(El),[]);
  20727. if Value=nil then
  20728. RaiseNotYetImplemented(20190130162601,El);
  20729. try
  20730. case Value.Kind of
  20731. revkInt:
  20732. begin
  20733. Int:=TResEvalInt(Value).Int;
  20734. bt:=GetSmallestIntegerBaseType(Int,Int);
  20735. end;
  20736. {$IFDEF HasInt64}
  20737. revkUInt:
  20738. bt:=btQWord;
  20739. {$ENDIF}
  20740. else
  20741. bt:=BaseTypeExtended;
  20742. end;
  20743. finally
  20744. ReleaseEvalValue(Value);
  20745. end;
  20746. end;
  20747. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  20748. TPrimitiveExpr(El),[rrfReadable])
  20749. end;
  20750. pekString:
  20751. begin
  20752. {$IFDEF VerbosePasResolver}
  20753. writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
  20754. {$ENDIF}
  20755. bt:=IsCharLiteral(TPrimitiveExpr(El).Value,El);
  20756. if bt in btAllChars then
  20757. begin
  20758. if bt=BaseTypeChar then
  20759. bt:=btChar;
  20760. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  20761. TPrimitiveExpr(El),[rrfReadable]);
  20762. end
  20763. else
  20764. SetResolverValueExpr(ResolvedEl,btString,
  20765. FBaseTypes[btString],FBaseTypes[btString],
  20766. TPrimitiveExpr(El),[rrfReadable]);
  20767. end;
  20768. pekNil:
  20769. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  20770. TPrimitiveExpr(El),[rrfReadable]);
  20771. pekBoolConst:
  20772. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  20773. TPrimitiveExpr(El),[rrfReadable]);
  20774. else
  20775. RaiseNotYetImplemented(20160922163701,El);
  20776. end;
  20777. end
  20778. else if ElClass=TPasUnresolvedSymbolRef then
  20779. begin
  20780. // built-in type
  20781. if El.CustomData is TResElDataBaseType then
  20782. SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
  20783. El,TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[])
  20784. else if El.CustomData is TResElDataBuiltInProc then
  20785. begin
  20786. SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,
  20787. TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[]);
  20788. if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
  20789. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20790. end
  20791. else
  20792. RaiseNotYetImplemented(20160926194756,El);
  20793. end
  20794. else if ElClass=TBoolConstExpr then
  20795. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  20796. TBoolConstExpr(El),[rrfReadable])
  20797. else if ElClass=TBinaryExpr then
  20798. ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
  20799. else if ElClass=TUnaryExpr then
  20800. begin
  20801. if TUnaryExpr(El).OpCode in [eopAddress,eopMemAddress] then
  20802. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  20803. else
  20804. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
  20805. {$IFDEF VerbosePasResolver}
  20806. writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
  20807. {$ENDIF}
  20808. case TUnaryExpr(El).OpCode of
  20809. eopAdd, eopSubtract:
  20810. if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
  20811. exit
  20812. else
  20813. RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  20814. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  20815. eopNot:
  20816. begin
  20817. if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
  20818. else
  20819. ComputeUnaryNot(TUnaryExpr(El),ResolvedEl,Flags);
  20820. exit;
  20821. end;
  20822. eopAddress:
  20823. if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
  20824. begin
  20825. SetResolverValueExpr(ResolvedEl,btContext,
  20826. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  20827. exit;
  20828. end
  20829. else if (rrfReadable in ResolvedEl.Flags) and (ResolvedEl.BaseType<>btPointer) then
  20830. begin
  20831. SetResolverValueExpr(ResolvedEl,btPointer,
  20832. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  20833. exit;
  20834. end
  20835. else
  20836. RaiseMsg(20180208121541,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  20837. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  20838. eopDeref:
  20839. begin
  20840. ComputeDereference(TUnaryExpr(El),ResolvedEl);
  20841. exit;
  20842. end;
  20843. eopMemAddress:
  20844. if (ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasProcedureType) then
  20845. // @@ProcVar
  20846. exit
  20847. else
  20848. RaiseMsg(20180208121549,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  20849. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  20850. end;
  20851. {$IFDEF VerbosePasResolver}
  20852. writeln('TPasResolver.ComputeElement OpCode=',TUnaryExpr(El).OpCode);
  20853. {$ENDIF}
  20854. RaiseNotYetImplemented(20160926142426,El);
  20855. end
  20856. else if ElClass=TParamsExpr then
  20857. case TParamsExpr(El).Kind of
  20858. pekArrayParams: // a[]
  20859. ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  20860. pekFuncParams: // a()
  20861. ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  20862. pekSet: // []
  20863. ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  20864. else
  20865. RaiseNotYetImplemented(20161010184559,El);
  20866. end
  20867. else if ElClass=TInheritedExpr then
  20868. begin
  20869. // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
  20870. if El.CustomData is TResolvedReference then
  20871. ComputeInherited(TInheritedExpr(El))
  20872. else
  20873. // no ancestor proc
  20874. SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,nil,[rrfCanBeStatement]);
  20875. end
  20876. else if (ElClass=TPasAliasType) or (ElClass=TPasTypeAliasType) then
  20877. begin
  20878. // e.g. 'type a = b' -> compute b
  20879. ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  20880. ResolvedEl.IdentEl:=El;
  20881. ResolvedEl.HiTypeEl:=TPasAliasType(El);
  20882. end
  20883. else if (ElClass=TPasVariable) then
  20884. begin
  20885. // e.g. 'var a:b' -> compute b, use a as IdentEl
  20886. if rcConstant in Flags then
  20887. RaiseConstantExprExp(20170216152737,StartEl);
  20888. ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  20889. ResolvedEl.IdentEl:=El;
  20890. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  20891. end
  20892. else if (ElClass=TPasConst) then
  20893. begin
  20894. // e.g. 'var a:b' -> compute b, use a as IdentEl
  20895. if TPasConst(El).VarType<>nil then
  20896. begin
  20897. // typed const
  20898. if (not TPasConst(El).IsConst) and ([rcConstant,rcType]*Flags<>[]) then
  20899. RaiseConstantExprExp(20170216152739,StartEl);
  20900. ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  20901. ResolvedEl.IdentEl:=El;
  20902. if TPasConst(El).IsConst then
  20903. ResolvedEl.Flags:=[rrfReadable]
  20904. else
  20905. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  20906. end
  20907. else
  20908. begin
  20909. // untyped const
  20910. ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
  20911. ResolvedEl.IdentEl:=El;
  20912. ResolvedEl.Flags:=[rrfReadable];
  20913. end;
  20914. end
  20915. else if (ElClass=TPasEnumValue) then
  20916. begin
  20917. TypeEl:=NoNil(El.Parent) as TPasEnumType;
  20918. SetResolverIdentifier(ResolvedEl,btContext,El,TypeEl,TypeEl,[rrfReadable])
  20919. end
  20920. else if (ElClass=TPasEnumType) then
  20921. SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),TPasEnumType(El),[])
  20922. else if (ElClass=TPasProperty) then
  20923. begin
  20924. if rcConstant in Flags then
  20925. RaiseConstantExprExp(20170216152741,StartEl);
  20926. if GetPasPropertyArgs(TPasProperty(El)).Count=0 then
  20927. begin
  20928. ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
  20929. Flags+[rcType],StartEl);
  20930. ResolvedEl.IdentEl:=El;
  20931. ResolvedEl.Flags:=[];
  20932. if GetPasPropertyGetter(TPasProperty(El))<>nil then
  20933. Include(ResolvedEl.Flags,rrfReadable);
  20934. if GetPasPropertySetter(TPasProperty(El))<>nil then
  20935. Include(ResolvedEl.Flags,rrfWritable);
  20936. if IsProcedureType(ResolvedEl,true) then
  20937. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20938. end
  20939. else
  20940. begin
  20941. // index property without name
  20942. // Note: computing the pekArrayParams TParamsExpr will convert this to the type
  20943. SetResolverIdentifier(ResolvedEl,btArrayProperty,El,nil,nil,[]);
  20944. end;
  20945. end
  20946. else if ElClass=TPasArgument then
  20947. begin
  20948. if rcConstant in Flags then
  20949. RaiseConstantExprExp(20170216152744,StartEl);
  20950. if TPasArgument(El).ArgType=nil then
  20951. // untyped parameter
  20952. SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,nil,[])
  20953. else
  20954. begin
  20955. // typed parameter -> use param as IdentEl, compute type
  20956. ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
  20957. ResolvedEl.IdentEl:=El;
  20958. end;
  20959. ResolvedEl.Flags:=[rrfReadable];
  20960. if TPasArgument(El).Access in [argDefault, argVar, argOut] then
  20961. Include(ResolvedEl.Flags,rrfWritable);
  20962. if IsProcedureType(ResolvedEl,true) then
  20963. Include(ResolvedEl.Flags,rrfCanBeStatement);
  20964. end
  20965. else if ElClass=TPasClassType then
  20966. begin
  20967. if TPasClassType(El).IsForward and (El.CustomData<>nil) then
  20968. begin
  20969. DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
  20970. TypeEl:=NoNil(DeclEl) as TPasClassType;
  20971. end
  20972. else
  20973. TypeEl:=TPasClassType(El);
  20974. SetResolverIdentifier(ResolvedEl,btContext,
  20975. TypeEl,TypeEl,TypeEl,[]);
  20976. end
  20977. else if ElClass=TPasClassOfType then
  20978. SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),TPasClassOfType(El),[])
  20979. else if ElClass=TPasPointerType then
  20980. SetResolverIdentifier(ResolvedEl,btContext,El,TPasPointerType(El),TPasPointerType(El),[])
  20981. else if ElClass=TPasRecordType then
  20982. SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),TPasRecordType(El),[])
  20983. else if ElClass=TPasRangeType then
  20984. begin
  20985. ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
  20986. ResolvedEl.IdentEl:=El;
  20987. ResolvedEl.LoTypeEl:=TPasRangeType(El);
  20988. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  20989. if ResolvedEl.ExprEl=nil then
  20990. ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
  20991. ResolvedEl.Flags:=[];
  20992. end
  20993. else if ElClass=TPasSetType then
  20994. begin
  20995. ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
  20996. if ResolvedEl.BaseType=btRange then
  20997. begin
  20998. ConvertRangeToElement(ResolvedEl);
  20999. ResolvedEl.LoTypeEl:=TPasSetType(El).EnumType;
  21000. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  21001. end;
  21002. ResolvedEl.SubType:=ResolvedEl.BaseType;
  21003. ResolvedEl.BaseType:=btSet;
  21004. ResolvedEl.IdentEl:=El;
  21005. ResolvedEl.Flags:=[];
  21006. end
  21007. else if ElClass=TPasResultElement then
  21008. begin
  21009. if rcConstant in Flags then
  21010. RaiseConstantExprExp(20170216152746,StartEl);
  21011. ComputeElement(TPasResultElement(El).ResultType,ResolvedEl,Flags+[rcType],StartEl);
  21012. ResolvedEl.IdentEl:=El;
  21013. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  21014. end
  21015. else if ElClass=TPasUsesUnit then
  21016. begin
  21017. if TPasUsesUnit(El).Module is TPasModule then
  21018. SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,nil,[])
  21019. else
  21020. RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
  21021. end
  21022. else if El.InheritsFrom(TPasModule) then
  21023. SetResolverIdentifier(ResolvedEl,btModule,El,nil,nil,[])
  21024. else if ElClass=TNilExpr then
  21025. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  21026. TNilExpr(El),[rrfReadable])
  21027. else if El.InheritsFrom(TPasProcedure) then
  21028. begin
  21029. TypeEl:=TPasProcedure(El).ProcType;
  21030. SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
  21031. if (TPasProcedure(El).ProcType is TPasFunctionType)
  21032. or (ElClass=TPasConstructor) then
  21033. Include(ResolvedEl.Flags,rrfReadable);
  21034. // Note: implicit calls are handled in TPrimitiveExpr
  21035. end
  21036. else if El.InheritsFrom(TPasProcedureType) then
  21037. begin
  21038. SetResolverIdentifier(ResolvedEl,btContext,El,
  21039. TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
  21040. // Note: implicit calls are handled in TPrimitiveExpr
  21041. end
  21042. else if ElClass=TProcedureExpr then
  21043. begin
  21044. TypeEl:=TProcedureExpr(El).Proc.ProcType;
  21045. SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
  21046. end
  21047. else if ElClass=TPasArrayType then
  21048. SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
  21049. else if ElClass=TArrayValues then
  21050. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable])
  21051. else if ElClass=TRecordValues then
  21052. ComputeRecordValues(TRecordValues(El),ResolvedEl,Flags,StartEl)
  21053. else if ElClass=TPasStringType then
  21054. begin
  21055. {$ifdef FPC_HAS_CPSTRING}
  21056. SetResolverTypeExpr(ResolvedEl,btShortString,
  21057. BaseTypes[btShortString],BaseTypes[btShortString],[rrfReadable]);
  21058. if BaseTypes[btShortString]=nil then
  21059. {$endif}
  21060. RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
  21061. end
  21062. else if ElClass=TPasResString then
  21063. SetResolverIdentifier(ResolvedEl,btString,El,
  21064. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
  21065. else
  21066. RaiseNotYetImplemented(20160922163705,El);
  21067. {$IF defined(nodejs) and defined(VerbosePasResolver)}
  21068. if not isNumber(ResolvedEl.BaseType) then
  21069. begin
  21070. {AllowWriteln}
  21071. writeln('TPasResolver.ComputeElement ',GetObjName(El),' typeof ResolvedEl.BaseType=',jsTypeOf(ResolvedEl.BaseType),' ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  21072. RaiseInternalError(20181101123527,jsTypeOf(ResolvedEl.LoTypeEl));
  21073. {AllowWriteln-}
  21074. end;
  21075. {$ENDIF}
  21076. end;
  21077. function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
  21078. Store: boolean): TResEvalValue;
  21079. // Important: Caller must free result with ReleaseEvalValue(Result)
  21080. begin
  21081. Result:=fExprEvaluator.Eval(Expr,Flags);
  21082. if Result=nil then exit;
  21083. {$IFDEF VerbosePasResEval}
  21084. writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  21085. {$ENDIF}
  21086. if Store
  21087. and (Expr.CustomData=nil)
  21088. and (Result.Element=nil)
  21089. and (not fExprEvaluator.IsSimpleExpr(Expr))
  21090. and (Expr.GetModule=RootElement) then
  21091. begin
  21092. //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  21093. AddResolveData(Expr,Result,lkModule);
  21094. end;
  21095. end;
  21096. function TPasResolver.Eval(const Value: TPasResolverResult;
  21097. Flags: TResEvalFlags; Store: boolean): TResEvalValue;
  21098. var
  21099. Expr: TPasExpr;
  21100. begin
  21101. Result:=nil;
  21102. if Value.ExprEl<>nil then
  21103. Result:=Eval(Value.ExprEl,Flags,Store)
  21104. else if Value.IdentEl is TPasConst then
  21105. begin
  21106. Expr:=TPasVariable(Value.IdentEl).Expr;
  21107. if Expr=nil then exit;
  21108. Result:=Eval(Expr,Flags,Store)
  21109. end;
  21110. end;
  21111. function TPasResolver.IsSameType(TypeA, TypeB: TPasType;
  21112. ResolveAlias: TPRResolveAlias): boolean;
  21113. begin
  21114. if (TypeA=nil) or (TypeB=nil) then exit(false);
  21115. case ResolveAlias of
  21116. prraSimple:
  21117. begin
  21118. TypeA:=ResolveSimpleAliasType(TypeA);
  21119. TypeB:=ResolveSimpleAliasType(TypeB);
  21120. end;
  21121. prraAlias:
  21122. begin
  21123. TypeA:=ResolveAliasType(TypeA);
  21124. TypeB:=ResolveAliasType(TypeB);
  21125. end;
  21126. end;
  21127. if TypeA=TypeB then exit(true);
  21128. if (TypeA.ClassType=TPasUnresolvedSymbolRef)
  21129. and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
  21130. begin
  21131. Result:=CompareText(TypeA.Name,TypeB.Name)=0;
  21132. exit;
  21133. end;
  21134. Result:=false;
  21135. end;
  21136. function TPasResolver.HasExactType(const ResolvedEl: TPasResolverResult
  21137. ): boolean;
  21138. var
  21139. IdentEl: TPasElement;
  21140. begin
  21141. IdentEl:=ResolvedEl.IdentEl;
  21142. if IdentEl=nil then exit(false);
  21143. if IdentEl is TPasVariable then
  21144. exit(TPasVariable(IdentEl).VarType<>nil)
  21145. else if IdentEl.ClassType=TPasArgument then
  21146. exit(TPasArgument(IdentEl).ArgType<>nil)
  21147. else if IdentEl.ClassType=TPasResultElement then
  21148. exit(TPasResultElement(IdentEl).ResultType<>nil)
  21149. else if IdentEl is TPasType then
  21150. Result:=true
  21151. else
  21152. Result:=false;
  21153. end;
  21154. procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  21155. ErrorEl: TPasElement);
  21156. begin
  21157. if aType=nil then exit;
  21158. if aType.ClassType<>TPasClassType then exit;
  21159. if TPasClassType(aType).HelperForType<>nil then
  21160. RaiseHelpersCannotBeUsedAsType(id,ErrorEl);
  21161. end;
  21162. function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
  21163. SkipAlias: boolean): TPasType;
  21164. var
  21165. DeclEl: TPasElement;
  21166. ClassScope: TPasClassScope;
  21167. begin
  21168. Result:=nil;
  21169. if ClassEl=nil then
  21170. exit;
  21171. if ClassEl.CustomData=nil then
  21172. exit;
  21173. if ClassEl.IsForward then
  21174. begin
  21175. DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
  21176. ClassEl:=NoNil(DeclEl) as TPasClassType;
  21177. Result:=ClassEl;
  21178. end
  21179. else
  21180. begin
  21181. ClassScope:=ClassEl.CustomData as TPasClassScope;
  21182. if not (pcsfAncestorResolved in ClassScope.Flags) then
  21183. exit;
  21184. if SkipAlias then
  21185. begin
  21186. if ClassScope.AncestorScope=nil then
  21187. exit;
  21188. Result:=TPasClassType(ClassScope.AncestorScope.Element);
  21189. end
  21190. else
  21191. Result:=ClassScope.DirectAncestor;
  21192. end;
  21193. end;
  21194. function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
  21195. begin
  21196. while El<>nil do
  21197. begin
  21198. if El is TProcedureBody then
  21199. exit(TProcedureBody(El));
  21200. El:=El.Parent;
  21201. end;
  21202. Result:=nil;
  21203. end;
  21204. function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
  21205. begin
  21206. Result:=GetProcFirstImplEl(Proc)<>nil;
  21207. end;
  21208. function TPasResolver.IndexOfImplementedInterface(ClassEl: TPasClassType;
  21209. aType: TPasType): integer;
  21210. var
  21211. List: TFPList;
  21212. i: Integer;
  21213. begin
  21214. if aType=nil then exit(-1);
  21215. aType:=ResolveAliasType(aType);
  21216. List:=ClassEl.Interfaces;
  21217. for i:=0 to List.Count-1 do
  21218. if ResolveAliasType(TPasType(List[i]))=aType then
  21219. exit(i);
  21220. Result:=-1;
  21221. end;
  21222. function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
  21223. begin
  21224. while El<>nil do
  21225. begin
  21226. if (El.ClassType=TPasImplRepeatUntil)
  21227. or (El.ClassType=TPasImplWhileDo)
  21228. or (El.ClassType=TPasImplForLoop) then
  21229. exit(TPasImplElement(El));
  21230. El:=El.Parent;
  21231. end;
  21232. Result:=nil;
  21233. end;
  21234. function TPasResolver.ResolveAliasType(aType: TPasType): TPasType;
  21235. var
  21236. C: TClass;
  21237. begin
  21238. while aType<>nil do
  21239. begin
  21240. C:=aType.ClassType;
  21241. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  21242. aType:=TPasAliasType(aType).DestType
  21243. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  21244. and (aType.CustomData is TResolvedReference) then
  21245. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  21246. else
  21247. exit(aType);
  21248. end;
  21249. Result:=nil;
  21250. end;
  21251. function TPasResolver.ResolveAliasTypeEl(El: TPasElement): TPasType;
  21252. begin
  21253. if (El is TPasType) then
  21254. Result:=ResolveAliasType(TPasType(El))
  21255. else
  21256. Result:=nil;
  21257. end;
  21258. function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
  21259. { returns true if El is
  21260. a) the last element of an @ operator expression
  21261. e.g. '@p().o[].El' or '@El[]'
  21262. b) mode delphi: the last element of a right side of an assignment
  21263. c) an accessor function, e.g. property P read El;
  21264. }
  21265. var
  21266. Parent: TPasElement;
  21267. Prop: TPasProperty;
  21268. begin
  21269. Result:=false;
  21270. if El=nil then exit;
  21271. if not IsNameExpr(El) then
  21272. exit;
  21273. repeat
  21274. Parent:=El.Parent;
  21275. //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
  21276. if Parent.ClassType=TUnaryExpr then
  21277. begin
  21278. if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
  21279. end
  21280. else if Parent.ClassType=TBinaryExpr then
  21281. begin
  21282. if TBinaryExpr(Parent).right<>El then exit;
  21283. if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
  21284. end
  21285. else if Parent.ClassType=TParamsExpr then
  21286. begin
  21287. if TParamsExpr(Parent).Value<>El then exit;
  21288. end
  21289. else if Parent.ClassType=TPasProperty then
  21290. begin
  21291. Prop:=TPasProperty(Parent);
  21292. Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
  21293. exit;
  21294. end
  21295. else if Parent.ClassType=TPasImplAssign then
  21296. begin
  21297. if TPasImplAssign(Parent).right<>El then exit;
  21298. if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
  21299. exit;
  21300. end
  21301. else
  21302. exit;
  21303. El:=TPasExpr(Parent);
  21304. until false;
  21305. end;
  21306. function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
  21307. var
  21308. C: TClass;
  21309. P: TPasElement;
  21310. begin
  21311. if (El=nil) or (El.Parent=nil) then exit(false);
  21312. Result:=false;
  21313. P:=El.Parent;
  21314. C:=P.ClassType;
  21315. if C=TBinaryExpr then
  21316. begin
  21317. if TBinaryExpr(P).right=El then
  21318. begin
  21319. if (TBinaryExpr(P).OpCode=eopSubIdent)
  21320. or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
  21321. Result:=ParentNeedsExprResult(TBinaryExpr(P))
  21322. else
  21323. Result:=true;
  21324. end
  21325. else
  21326. Result:=true;
  21327. end
  21328. else if C.InheritsFrom(TPasExpr) then
  21329. Result:=true
  21330. else if (C=TPasEnumValue)
  21331. or (C=TPasArgument)
  21332. or (C=TPasVariable)
  21333. or (C=TPasExportSymbol) then
  21334. Result:=true
  21335. else if C=TPasClassType then
  21336. Result:=TPasClassType(P).GUIDExpr=El
  21337. else if C=TPasProperty then
  21338. Result:=(TPasProperty(P).IndexExpr=El)
  21339. or (TPasProperty(P).DispIDExpr=El)
  21340. or (TPasProperty(P).DefaultExpr=El)
  21341. else if C=TPasProcedure then
  21342. Result:=(TPasProcedure(P).LibraryExpr=El)
  21343. or (TPasProcedure(P).DispIDExpr=El)
  21344. else if C=TPasImplRepeatUntil then
  21345. Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
  21346. else if C=TPasImplIfElse then
  21347. Result:=(TPasImplIfElse(P).ConditionExpr=El)
  21348. else if C=TPasImplWhileDo then
  21349. Result:=(TPasImplWhileDo(P).ConditionExpr=El)
  21350. else if C=TPasImplWithDo then
  21351. Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
  21352. else if C=TPasImplCaseOf then
  21353. Result:=(TPasImplCaseOf(P).CaseExpr=El)
  21354. else if C=TPasImplCaseStatement then
  21355. Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
  21356. else if C=TPasImplForLoop then
  21357. Result:=(TPasImplForLoop(P).StartExpr=El)
  21358. or (TPasImplForLoop(P).EndExpr=El)
  21359. else if C=TPasImplAssign then
  21360. Result:=(TPasImplAssign(P).right=El)
  21361. else if C=TPasImplRaise then
  21362. Result:=(TPasImplRaise(P).ExceptAddr=El);
  21363. end;
  21364. function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference;
  21365. Expr: TPasExpr): TPasResolverResult;
  21366. var
  21367. TypeEl: TPasType;
  21368. begin
  21369. TypeEl:=(Ref.Context as TResolvedRefCtxConstructor).Typ;
  21370. if TypeEl=nil then
  21371. RaiseNotYetImplemented(20190125205339,Expr)
  21372. else if TypeEl is TPasMembersType then
  21373. SetResolverValueExpr(Result,btContext,TypeEl,TypeEl,Expr,[rrfReadable])
  21374. else
  21375. begin
  21376. ComputeElement(TypeEl,Result,[rcType]);
  21377. Result.ExprEl:=Expr;
  21378. Result.Flags:=[rrfReadable];
  21379. end;
  21380. end;
  21381. function TPasResolver.GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  21382. var
  21383. El: TPasExpr;
  21384. begin
  21385. Result:=nil;
  21386. if Params=nil then exit;
  21387. El:=Params.Value;
  21388. while El<>nil do
  21389. begin
  21390. if El.CustomData is TResolvedReference then
  21391. exit(TResolvedReference(El.CustomData));
  21392. if (El is TBinaryExpr)
  21393. and (TBinaryExpr(El).OpCode=eopSubIdent) then
  21394. El:=TBinaryExpr(El).right
  21395. else
  21396. break;
  21397. end;
  21398. end;
  21399. function TPasResolver.GetSetType(const ResolvedSet: TPasResolverResult
  21400. ): TPasSetType;
  21401. var
  21402. IdentEl: TPasElement;
  21403. aType: TPasType;
  21404. C: TClass;
  21405. begin
  21406. Result:=nil;
  21407. if ResolvedSet.BaseType=btSet then
  21408. begin
  21409. IdentEl:=ResolvedSet.IdentEl;
  21410. if IdentEl=nil then exit;
  21411. C:=IdentEl.ClassType;
  21412. if (C=TPasVariable)
  21413. or (C=TPasConst) then
  21414. aType:=TPasVariable(IdentEl).VarType
  21415. else if C=TPasProperty then
  21416. aType:=GetPasPropertyType(TPasProperty(IdentEl))
  21417. else if C=TPasArgument then
  21418. aType:=TPasArgument(IdentEl).ArgType
  21419. else if C.InheritsFrom(TPasProcedure)
  21420. and (TPasProcedure(IdentEl).ProcType is TPasFunctionType) then
  21421. aType:=TPasFunctionType(TPasProcedure(IdentEl).ProcType).ResultEl.ResultType
  21422. else if C=TPasSetType then
  21423. exit(TPasSetType(IdentEl))
  21424. else
  21425. exit;
  21426. if aType.ClassType=TPasSetType then
  21427. Result:=TPasSetType(aType);
  21428. end
  21429. else if ResolvedSet.BaseType=btContext then
  21430. begin
  21431. if ResolvedSet.LoTypeEl.ClassType=TPasSetType then
  21432. if ResolvedSet.HiTypeEl.ClassType=TPasSetType then
  21433. Result:=TPasSetType(ResolvedSet.HiTypeEl)
  21434. else
  21435. Result:=TPasSetType(ResolvedSet.LoTypeEl);
  21436. end;
  21437. end;
  21438. function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
  21439. ): boolean;
  21440. begin
  21441. TypeEl:=ResolveAliasType(TypeEl);
  21442. if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType) then
  21443. exit(false);
  21444. if length(TPasArrayType(TypeEl).Ranges)<>0 then
  21445. exit(false);
  21446. // Note: Array of Const is an open array of TVarRec
  21447. if OptionalOpenArray and (proOpenAsDynArrays in Options) then
  21448. Result:=true
  21449. else
  21450. Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
  21451. end;
  21452. function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
  21453. begin
  21454. Result:=(TypeEl<>nil)
  21455. and (TypeEl.ClassType=TPasArrayType)
  21456. and (length(TPasArrayType(TypeEl).Ranges)=0)
  21457. and (TypeEl.Parent<>nil)
  21458. and (TypeEl.Parent.ClassType=TPasArgument);
  21459. end;
  21460. function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
  21461. begin
  21462. TypeEl:=ResolveAliasType(TypeEl);
  21463. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  21464. and (length(TPasArrayType(TypeEl).Ranges)=0);
  21465. end;
  21466. function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
  21467. begin
  21468. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  21469. and (TPasArrayType(TypeEl).ElType=nil);
  21470. end;
  21471. function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
  21472. begin
  21473. Result:=ArrType.ElType;
  21474. if Result=nil then
  21475. Result:=GetTVarRec(ArrType);
  21476. end;
  21477. function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
  21478. var
  21479. C: TClass;
  21480. begin
  21481. Result:=false;
  21482. if Expr=nil then exit;
  21483. if Expr.Parent=nil then exit;
  21484. C:=Expr.Parent.ClassType;
  21485. if C.InheritsFrom(TPasVariable) then
  21486. Result:=(TPasVariable(Expr.Parent).Expr=Expr)
  21487. else if C=TPasArgument then
  21488. Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
  21489. end;
  21490. function TPasResolver.IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  21491. begin
  21492. Result:=(ResolvedEl.BaseType in [btSet,btArrayOrSet,btArrayLit])
  21493. and (ResolvedEl.SubType=btNone);
  21494. end;
  21495. function TPasResolver.IsClassMethod(El: TPasElement): boolean;
  21496. var
  21497. C: TClass;
  21498. begin
  21499. if El=nil then exit(false);
  21500. C:=El.ClassType;;
  21501. Result:=(C=TPasClassConstructor)
  21502. or (C=TPasClassDestructor)
  21503. or (C=TPasClassProcedure)
  21504. or (C=TPasClassFunction)
  21505. or (C=TPasClassOperator);
  21506. end;
  21507. function TPasResolver.IsClassField(El: TPasElement): boolean;
  21508. var
  21509. C: TClass;
  21510. begin
  21511. if ((El.ClassType=TPasVariable) or (El.ClassType=TPasConst))
  21512. and ([vmClass,vmStatic]*TPasVariable(El).VarModifiers<>[]) then
  21513. begin
  21514. C:=El.Parent.ClassType;
  21515. Result:=(C=TPasClassType) or (C=TPasRecordType);
  21516. end
  21517. else
  21518. Result:=false;
  21519. end;
  21520. function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
  21521. var
  21522. ProcType: TPasProcedureType;
  21523. begin
  21524. if not (El is TPasProcedure) then exit(nil);
  21525. ProcType:=TPasProcedure(El).ProcType;
  21526. if ProcType is TPasFunctionType then
  21527. Result:=TPasFunctionType(ProcType)
  21528. else
  21529. Result:=nil;
  21530. end;
  21531. function TPasResolver.MethodIsStatic(El: TPasProcedure): boolean;
  21532. begin
  21533. Result:=(ptmStatic in El.ProcType.Modifiers)
  21534. or (El.ClassType=TPasClassConstructor)
  21535. or (El.ClassType=TPasClassDestructor);
  21536. end;
  21537. function TPasResolver.IsMethod(El: TPasProcedure): boolean;
  21538. var
  21539. ProcScope: TPasProcedureScope;
  21540. begin
  21541. Result:=false;
  21542. if El=nil then exit;
  21543. if El.Parent is TPasMembersType then exit(true);
  21544. if not (El.CustomData is TPasProcedureScope) then exit;
  21545. ProcScope:=TPasProcedureScope(El.CustomData);
  21546. Result:=IsMethod(ProcScope.DeclarationProc);
  21547. end;
  21548. function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
  21549. begin
  21550. Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
  21551. and (TPasClassType(El.Parent).HelperForType<>nil);
  21552. end;
  21553. function TPasResolver.IsHelper(El: TPasElement): boolean;
  21554. begin
  21555. Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil);
  21556. end;
  21557. function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
  21558. const ExtName: string): boolean;
  21559. var
  21560. AncestorScope: TPasClassScope;
  21561. begin
  21562. Result:=false;
  21563. if aClass=nil then exit;
  21564. while (aClass<>nil) and aClass.IsExternal do
  21565. begin
  21566. if aClass.ExternalName=ExtName then exit(true);
  21567. AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
  21568. if AncestorScope=nil then exit;
  21569. aClass:=NoNil(AncestorScope.Element) as TPasClassType;
  21570. end;
  21571. end;
  21572. function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
  21573. HasValue: boolean): boolean;
  21574. var
  21575. TypeEl: TPasType;
  21576. begin
  21577. if (ResolvedEl.BaseType<>btContext) then
  21578. exit(false);
  21579. TypeEl:=ResolvedEl.LoTypeEl;
  21580. if not (TypeEl is TPasProcedureType) then
  21581. exit(false);
  21582. if HasValue and not (rrfReadable in ResolvedEl.Flags) then
  21583. exit(false);
  21584. Result:=true;
  21585. end;
  21586. function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
  21587. ): boolean;
  21588. begin
  21589. Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasArrayType);
  21590. end;
  21591. function TPasResolver.IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  21592. var
  21593. Ref: TResolvedReference;
  21594. begin
  21595. Result:=nil;
  21596. if Expr=nil then exit;
  21597. if Expr.Kind<>pekSet then exit;
  21598. if not (Expr.CustomData is TResolvedReference) then exit;
  21599. Ref:=TResolvedReference(Expr.CustomData);
  21600. if Ref.Declaration is TPasArrayType then
  21601. Result:=TPasArrayType(Ref.Declaration);
  21602. end;
  21603. function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  21604. begin
  21605. Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
  21606. and ElHasModeSwitch(Expr,msArrayOperators);
  21607. end;
  21608. function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
  21609. var
  21610. Value: TPasExpr;
  21611. Ref: TResolvedReference;
  21612. Decl: TPasElement;
  21613. C: TClass;
  21614. begin
  21615. Result:=false;
  21616. if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
  21617. Value:=Params.Value;
  21618. if not IsNameExpr(Value) then
  21619. exit;
  21620. if not (Value.CustomData is TResolvedReference) then exit;
  21621. Ref:=TResolvedReference(Value.CustomData);
  21622. Decl:=Ref.Declaration;
  21623. C:=Decl.ClassType;
  21624. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  21625. begin
  21626. Decl:=ResolveAliasType(TPasAliasType(Decl));
  21627. C:=Decl.ClassType;
  21628. end;
  21629. if (C=TPasProcedureType)
  21630. or (C=TPasFunctionType) then
  21631. exit(true)
  21632. else if (C=TPasClassType)
  21633. or (C=TPasClassOfType)
  21634. or (C=TPasEnumType) then
  21635. exit(true)
  21636. else if (C=TPasUnresolvedSymbolRef)
  21637. and (Decl.CustomData is TResElDataBaseType) then
  21638. exit(true);
  21639. end;
  21640. function TPasResolver.IsInterfaceType(const ResolvedEl: TPasResolverResult;
  21641. IntfType: TPasClassInterfaceType): boolean;
  21642. begin
  21643. if ResolvedEl.BaseType<>btContext then exit(false);
  21644. Result:=IsInterfaceType(ResolvedEl.LoTypeEl,IntfType);
  21645. end;
  21646. function TPasResolver.IsInterfaceType(TypeEl: TPasType;
  21647. IntfType: TPasClassInterfaceType): boolean;
  21648. begin
  21649. if TypeEl=nil then exit(false);
  21650. TypeEl:=ResolveAliasType(TypeEl);
  21651. Result:=(TypeEl.ClassType=TPasClassType)
  21652. and (TPasClassType(TypeEl).ObjKind=okInterface)
  21653. and (TPasClassType(TypeEl).InterfaceType=IntfType);
  21654. end;
  21655. function TPasResolver.IsTGUID(RecTypeEl: TPasRecordType): boolean;
  21656. var
  21657. Members: TFPList;
  21658. El: TPasElement;
  21659. begin
  21660. Result:=false;
  21661. if not SameText(RecTypeEl.Name,'TGUID') then exit;
  21662. if SameText(RecTypeEl.GetModule.Name,'system') then exit(true);
  21663. Members:=RecTypeEl.Members;
  21664. if Members.Count<4 then exit;
  21665. El:=TPasElement(Members[0]);
  21666. if not SameText(El.Name,'D1') then exit;
  21667. El:=TPasElement(Members[1]);
  21668. if not SameText(El.Name,'D2') then exit;
  21669. El:=TPasElement(Members[2]);
  21670. if not SameText(El.Name,'D3') then exit;
  21671. El:=TPasElement(Members[3]);
  21672. if not SameText(El.Name,'D4') then exit;
  21673. Result:=true;
  21674. end;
  21675. function TPasResolver.IsTGUIDString(const ResolvedEl: TPasResolverResult
  21676. ): boolean;
  21677. var
  21678. TypeEl: TPasType;
  21679. C: TClass;
  21680. IdentEl: TPasElement;
  21681. begin
  21682. if not (ResolvedEl.BaseType in btAllStrings) then
  21683. exit(false);
  21684. if (ResolvedEl.ExprEl<>nil) and (ResolvedEl.LoTypeEl<>nil) then
  21685. exit(true); // untyped string literal
  21686. IdentEl:=ResolvedEl.IdentEl;
  21687. if IdentEl<>nil then
  21688. begin
  21689. C:=IdentEl.ClassType;
  21690. if C.InheritsFrom(TPasVariable) then
  21691. TypeEl:=TPasVariable(IdentEl).VarType
  21692. else if C=TPasArgument then
  21693. TypeEl:=TPasArgument(IdentEl).ArgType
  21694. else if C=TPasResultElement then
  21695. TypeEl:=TPasResultElement(IdentEl).ResultType
  21696. else
  21697. TypeEl:=nil;
  21698. while TypeEl<>nil do
  21699. begin
  21700. if (TypeEl.ClassType=TPasAliasType)
  21701. or (TypeEl.ClassType=TPasTypeAliasType) then
  21702. begin
  21703. if SameText(TypeEl.Name,'TGUIDString') then
  21704. exit(true);
  21705. TypeEl:=TPasAliasType(TypeEl).DestType;
  21706. end
  21707. else
  21708. break;
  21709. end;
  21710. end;
  21711. Result:=false;
  21712. end;
  21713. function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
  21714. var
  21715. ClassEl: TPasClassType;
  21716. ClassScope: TPasClassScope;
  21717. aModule: TPasModule;
  21718. begin
  21719. Result:=false;
  21720. if (El=nil)
  21721. or (El.ClassType<>TPasClassType) then exit;
  21722. ClassEl:=TPasClassType(El);
  21723. if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
  21724. while not SameText(ClassEl.Name,'TCustomAttribute') do
  21725. begin
  21726. ClassScope:=ClassEl.CustomData as TPasClassScope;
  21727. if ClassScope.AncestorScope=nil then exit;
  21728. ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
  21729. end;
  21730. if not (ClassEl.Parent is TPasSection) then
  21731. exit; // this TCustomAttribute is not top level
  21732. aModule:=ClassEl.GetModule;
  21733. Result:=IsSystemUnit(aModule);
  21734. end;
  21735. function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
  21736. var
  21737. Section: TPasSection;
  21738. begin
  21739. Result:=false;
  21740. if El=nil then exit;
  21741. if SameText(El.Name,'system') then exit(true);
  21742. // tests and scripts are their own system unit: check if this is the root module
  21743. if El.ClassType=TPasProgram then
  21744. Section:=TPasProgram(El).ProgramSection
  21745. else if El.ClassType=TPasLibrary then
  21746. Section:=TPasLibrary(El).LibrarySection
  21747. else
  21748. Section:=El.InterfaceSection;
  21749. Result:=length(Section.UsesClause)=0;
  21750. end;
  21751. function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
  21752. var
  21753. Parent: TPasElement;
  21754. C: TClass;
  21755. Members: TFPList;
  21756. i: Integer;
  21757. begin
  21758. Result:=nil;
  21759. if El=nil then exit;
  21760. // find El in El.Parent members
  21761. Parent:=El.Parent;
  21762. if Parent=nil then exit;
  21763. C:=Parent.ClassType;
  21764. if C.InheritsFrom(TPasDeclarations) then
  21765. Members:=TPasDeclarations(Parent).Declarations
  21766. else if C.InheritsFrom(TPasMembersType) then
  21767. Members:=TPasMembersType(Parent).Members
  21768. else
  21769. exit;
  21770. i:=Members.IndexOf(El);
  21771. if i<0 then exit;
  21772. Result:=GetAttributeCalls(Members,i);
  21773. end;
  21774. function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
  21775. ): TPasExprArray;
  21776. procedure AddAttributesInFront(Members: TFPList; i: integer);
  21777. var
  21778. j, l, k: Integer;
  21779. Calls: TPasExprArray;
  21780. begin
  21781. // find attributes in front
  21782. j:=i;
  21783. while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
  21784. dec(j);
  21785. // collect all attribute calls
  21786. l:=0;
  21787. while j<i do
  21788. begin
  21789. Calls:=TPasAttributes(Members[j]).Calls;
  21790. SetLength(Result,l+length(Calls));
  21791. for k:=0 to length(Calls)-1 do
  21792. begin
  21793. Result[l]:=Calls[k];
  21794. inc(l);
  21795. end;
  21796. inc(j);
  21797. end;
  21798. end;
  21799. var
  21800. El, CurEl: TPasElement;
  21801. begin
  21802. Result:=nil;
  21803. El:=TPasElement(Members[Index]);
  21804. AddAttributesInFront(Members,Index);
  21805. if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
  21806. repeat
  21807. dec(Index);
  21808. if Index<1 then break;
  21809. CurEl:=TPasElement(Members[Index]);
  21810. if (CurEl.ClassType=TPasClassType)
  21811. and TPasClassType(CurEl).IsForward
  21812. and (TPasClassType(CurEl).CustomData is TResolvedReference)
  21813. and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
  21814. then
  21815. begin
  21816. // class has a forward declaration -> add attributes
  21817. AddAttributesInFront(Members,Index);
  21818. break;
  21819. end;
  21820. until false;
  21821. end;
  21822. function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
  21823. begin
  21824. Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
  21825. end;
  21826. function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
  21827. ): boolean;
  21828. var
  21829. Proc, OverriddenProc: TPasProcedure;
  21830. begin
  21831. Result:=false;
  21832. Proc:=DescendantProc;
  21833. if not Proc.IsOverride then exit;
  21834. if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
  21835. repeat
  21836. OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
  21837. if AncestorProc=OverriddenProc then exit(true);
  21838. Proc:=OverriddenProc;
  21839. until Proc=nil;
  21840. end;
  21841. function TPasResolver.GetTopLvlProc(El: TPasElement): TPasProcedure;
  21842. begin
  21843. Result:=nil;
  21844. while El<>nil do
  21845. begin
  21846. if El is TPasProcedure then
  21847. Result:=TPasProcedure(El);
  21848. El:=El.Parent;
  21849. end;
  21850. end;
  21851. function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  21852. var
  21853. Range: TResEvalValue;
  21854. begin
  21855. Result:=0;
  21856. Range:=Eval(RangeExpr,[refConst]);
  21857. if Range=nil then
  21858. RaiseNotYetImplemented(20170910210416,RangeExpr);
  21859. try
  21860. case Range.Kind of
  21861. revkRangeInt:
  21862. Result:=TResEvalRangeInt(Range).RangeEnd-TResEvalRangeInt(Range).RangeStart+1;
  21863. revkRangeUInt:
  21864. Result:=TResEvalRangeUInt(Range).RangeEnd-TResEvalRangeUInt(Range).RangeStart+1;
  21865. else
  21866. RaiseNotYetImplemented(20170910210554,RangeExpr);
  21867. end;
  21868. finally
  21869. ReleaseEvalValue(Range);
  21870. end;
  21871. {$IFDEF VerbosePasResolver}
  21872. {AllowWriteln}
  21873. //if Result=0 then
  21874. writeln('TPasResolver.GetRangeLength Result=',Result);
  21875. {AllowWriteln-}
  21876. {$ENDIF}
  21877. end;
  21878. function TPasResolver.EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  21879. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue;
  21880. var
  21881. Range: TResEvalValue;
  21882. EnumType: TPasEnumType;
  21883. begin
  21884. Result:=nil;
  21885. Range:=Eval(RangeExpr,Flags+[refConst]);
  21886. if Range=nil then
  21887. RaiseNotYetImplemented(20170601191258,RangeExpr);
  21888. case Range.Kind of
  21889. revkRangeInt:
  21890. case TResEvalRangeInt(Range).ElKind of
  21891. revskEnum:
  21892. begin
  21893. EnumType:=NoNil(TResEvalRangeInt(Range).ElType) as TPasEnumType;
  21894. if EvalLow then
  21895. Result:=TResEvalEnum.CreateValue(
  21896. TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
  21897. else
  21898. Result:=TResEvalEnum.CreateValue(
  21899. TResEvalRangeInt(Range).RangeEnd,
  21900. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  21901. end;
  21902. revskInt:
  21903. if EvalLow then
  21904. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
  21905. else
  21906. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
  21907. revskChar:
  21908. {$ifdef FPC_HAS_CPSTRING}
  21909. if TResEvalRangeInt(Range).RangeEnd<256 then
  21910. begin
  21911. if EvalLow then
  21912. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
  21913. else
  21914. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd));
  21915. end
  21916. else
  21917. {$endif}
  21918. begin
  21919. if EvalLow then
  21920. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeStart))
  21921. else
  21922. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
  21923. end;
  21924. revskBool:
  21925. if EvalLow then
  21926. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
  21927. else
  21928. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
  21929. else
  21930. ReleaseEvalValue(Range);
  21931. RaiseNotYetImplemented(20170601195240,ErrorEl);
  21932. end;
  21933. revkRangeUInt:
  21934. if EvalLow then
  21935. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
  21936. else
  21937. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
  21938. else
  21939. ReleaseEvalValue(Range);
  21940. RaiseNotYetImplemented(20170601195336,ErrorEl);
  21941. end;
  21942. ReleaseEvalValue(Range);
  21943. end;
  21944. function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags
  21945. ): TResEvalValue;
  21946. var
  21947. C: TClass;
  21948. BaseTypeData: TResElDataBaseType;
  21949. begin
  21950. Result:=nil;
  21951. Decl:=ResolveAliasType(Decl);
  21952. C:=Decl.ClassType;
  21953. if C=TPasRangeType then
  21954. begin
  21955. Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
  21956. if (Result<>nil) and (Result.IdentEl=nil) then
  21957. begin
  21958. Result.IdentEl:=Decl;
  21959. exit;
  21960. end;
  21961. end
  21962. else if C=TPasEnumType then
  21963. begin
  21964. Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
  21965. 0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
  21966. Result.IdentEl:=Decl;
  21967. exit;
  21968. end
  21969. else if C=TPasUnresolvedSymbolRef then
  21970. begin
  21971. if (Decl.CustomData is TResElDataBaseType) then
  21972. begin
  21973. BaseTypeData:=TResElDataBaseType(Decl.CustomData);
  21974. case BaseTypeData.BaseType of
  21975. btChar:
  21976. begin
  21977. Result:=TResEvalRangeInt.Create;
  21978. TResEvalRangeInt(Result).ElKind:=revskChar;
  21979. TResEvalRangeInt(Result).RangeStart:=0;
  21980. {$ifdef FPC_HAS_CPSTRING}
  21981. if BaseTypeChar in [btChar,btAnsiChar] then
  21982. TResEvalRangeInt(Result).RangeEnd:=$ff
  21983. else
  21984. {$endif}
  21985. TResEvalRangeInt(Result).RangeEnd:=$ffff;
  21986. end;
  21987. {$ifdef FPC_HAS_CPSTRING}
  21988. btAnsiChar:
  21989. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  21990. {$endif}
  21991. btWideChar:
  21992. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  21993. btBoolean,btByteBool,btWordBool{$ifdef HasInt64},btQWordBool{$endif}:
  21994. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
  21995. btByte,
  21996. btShortInt,
  21997. btWord,
  21998. btSmallInt,
  21999. btLongWord,
  22000. btLongint,
  22001. {$ifdef HasInt64}
  22002. btInt64,
  22003. btComp,
  22004. {$endif}
  22005. btIntSingle,
  22006. btUIntSingle,
  22007. btIntDouble,
  22008. btUIntDouble:
  22009. begin
  22010. Result:=TResEvalRangeInt.Create;
  22011. TResEvalRangeInt(Result).ElKind:=revskInt;
  22012. GetIntegerRange(BaseTypeData.BaseType,
  22013. TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
  22014. end;
  22015. end;
  22016. end;
  22017. end;
  22018. end;
  22019. function TPasResolver.HasTypeInfo(El: TPasType): boolean;
  22020. begin
  22021. Result:=false;
  22022. if El=nil then exit;
  22023. if El.CustomData is TResElDataBaseType then
  22024. exit(true); // base type
  22025. if El.Parent=nil then exit;
  22026. if El.Parent is TPasType then
  22027. begin
  22028. if not HasTypeInfo(TPasType(El.Parent)) then
  22029. exit;
  22030. end
  22031. else if ElHasModeSwitch(El,msOmitRTTI) then
  22032. exit
  22033. else if El.Parent is TPasAnonymousProcedure then
  22034. exit;
  22035. Result:=true;
  22036. end;
  22037. function TPasResolver.GetActualBaseType(bt: TResolverBaseType
  22038. ): TResolverBaseType;
  22039. begin
  22040. case bt of
  22041. btChar: Result:=BaseTypeChar;
  22042. btString: Result:=BaseTypeString;
  22043. btExtended: Result:=BaseTypeExtended;
  22044. else Result:=bt;
  22045. end;
  22046. end;
  22047. function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
  22048. ErrorEl: TPasElement): TResolverBaseType;
  22049. begin
  22050. if Bool1=Bool2 then exit(Bool1);
  22051. case Bool1 of
  22052. btBoolean: Result:=Bool2;
  22053. btByteBool: if Bool2<>btBoolean then Result:=Bool2;
  22054. btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
  22055. btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
  22056. {$ifdef HasInt64}
  22057. btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
  22058. {$endif}
  22059. else
  22060. RaiseNotYetImplemented(20170420093805,ErrorEl);
  22061. end;
  22062. end;
  22063. function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
  22064. ErrorEl: TPasElement): TResolverBaseType;
  22065. var
  22066. Precision1, Precision2: word;
  22067. Signed1, Signed2: boolean;
  22068. begin
  22069. if Int1.BaseType=Int2.BaseType then exit;
  22070. GetIntegerProps(Int1.BaseType,Precision1,Signed1);
  22071. GetIntegerProps(Int2.BaseType,Precision2,Signed2);
  22072. if Precision1=Precision2 then
  22073. begin
  22074. if Signed1<>Signed2 then
  22075. Precision1:=Max(Precision1,Precision2)+1;
  22076. end;
  22077. Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
  22078. end;
  22079. procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
  22080. Precision: word; out Signed: boolean);
  22081. begin
  22082. case bt of
  22083. btByte: begin Precision:=8; Signed:=false; end;
  22084. btShortInt: begin Precision:=8; Signed:=true; end;
  22085. btWord: begin Precision:=16; Signed:=false; end;
  22086. btSmallInt: begin Precision:=16; Signed:=true; end;
  22087. btIntSingle: begin Precision:=23; Signed:=true; end;
  22088. btUIntSingle: begin Precision:=22; Signed:=false; end;
  22089. btLongWord: begin Precision:=32; Signed:=false; end;
  22090. btLongint: begin Precision:=32; Signed:=true; end;
  22091. btIntDouble: begin Precision:=53; Signed:=true; end;
  22092. btUIntDouble: begin Precision:=52; Signed:=false; end;
  22093. {$ifdef HasInt64}
  22094. btQWord: begin Precision:=64; Signed:=false; end;
  22095. btInt64,btComp: begin Precision:=64; Signed:=true; end;
  22096. {$endif}
  22097. else
  22098. RaiseInternalError(20170420095727);
  22099. end;
  22100. end;
  22101. function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
  22102. MaxVal: TMaxPrecInt): boolean;
  22103. begin
  22104. Result:=true;
  22105. if bt=btExtended then bt:=BaseTypeExtended;
  22106. case bt of
  22107. btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
  22108. btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
  22109. btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
  22110. btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
  22111. btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
  22112. btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
  22113. {$ifdef HasInt64}
  22114. btInt64,
  22115. btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
  22116. {$endif}
  22117. btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
  22118. btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
  22119. btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
  22120. btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
  22121. btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
  22122. else
  22123. Result:=false;
  22124. end;
  22125. end;
  22126. function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
  22127. ErrorEl: TPasElement): TResolverBaseType;
  22128. begin
  22129. if Precision<=8 then
  22130. begin
  22131. if Signed then
  22132. Result:=btShortInt
  22133. else
  22134. Result:=btByte;
  22135. if BaseTypes[Result]<>nil then exit;
  22136. end;
  22137. if Precision<=16 then
  22138. begin
  22139. if Signed then
  22140. Result:=btSmallInt
  22141. else
  22142. Result:=btWord;
  22143. if BaseTypes[Result]<>nil then exit;
  22144. end;
  22145. if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
  22146. exit(btUIntSingle);
  22147. if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
  22148. exit(btIntSingle);
  22149. if Precision<=32 then
  22150. begin
  22151. if Signed then
  22152. Result:=btLongint
  22153. else
  22154. Result:=btLongWord;
  22155. if BaseTypes[Result]<>nil then exit;
  22156. end;
  22157. if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
  22158. exit(btUIntDouble);
  22159. if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
  22160. exit(btIntDouble);
  22161. {$ifdef HasInt64}
  22162. if Precision<=64 then
  22163. begin
  22164. if Signed then
  22165. Result:=btInt64
  22166. else
  22167. Result:=btQWord;
  22168. if BaseTypes[Result]<>nil then exit;
  22169. end;
  22170. {$endif}
  22171. RaiseRangeCheck(20170420100336,ErrorEl);
  22172. end;
  22173. function TPasResolver.GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt
  22174. ): TResolverBaseType;
  22175. // returns BaseTypeExtended if too big
  22176. var
  22177. V: TMaxPrecInt;
  22178. begin
  22179. if MinVal>MaxVal then
  22180. MinVal:=MaxVal;
  22181. if MinVal<0 then
  22182. begin
  22183. if MaxVal>-(MinVal+1) then
  22184. V:=MaxVal
  22185. else
  22186. V:=-(MinVal+1);
  22187. if V<=high(ShortInt) then
  22188. Result:=btShortInt
  22189. else if V<=high(SmallInt) then
  22190. Result:=btSmallInt
  22191. else if (BaseTypes[btIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  22192. Result:=btIntSingle
  22193. else if V<=High(Longint) then
  22194. Result:=btLongint
  22195. else if (BaseTypes[btIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  22196. Result:=btIntDouble
  22197. else
  22198. begin
  22199. Result:=btIntMax;
  22200. if BaseTypes[Result]=nil then
  22201. Result:=BaseTypeExtended;
  22202. end;
  22203. end
  22204. else
  22205. begin
  22206. V:=MaxVal;
  22207. if V<=high(Byte) then
  22208. Result:=btByte
  22209. else if V<=high(Word) then
  22210. Result:=btWord
  22211. else if (BaseTypes[btUIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  22212. Result:=btUIntSingle
  22213. else if V<=High(LongWord) then
  22214. Result:=btLongWord
  22215. else if (BaseTypes[btUIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  22216. Result:=btUIntDouble
  22217. else
  22218. begin
  22219. Result:=btIntMax;
  22220. if BaseTypes[Result]=nil then
  22221. Result:=BaseTypeExtended;
  22222. end;
  22223. end;
  22224. end;
  22225. function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
  22226. ErrorEl: TPasElement): TResolverBaseType;
  22227. var
  22228. bt1, bt2: TResolverBaseType;
  22229. begin
  22230. bt1:=GetActualBaseType(Char1.BaseType);
  22231. bt2:=GetActualBaseType(Char2.BaseType);
  22232. if bt1=bt2 then exit(bt1);
  22233. if not (bt1 in btAllChars) then
  22234. RaiseInternalError(20170420103128);
  22235. Result:=btWideChar;
  22236. if Result=BaseTypeChar then
  22237. Result:=btChar;
  22238. if ErrorEl=nil then ;
  22239. end;
  22240. function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
  22241. ErrorEl: TPasElement): TResolverBaseType;
  22242. var
  22243. bt1, bt2: TResolverBaseType;
  22244. begin
  22245. bt1:=GetActualBaseType(Str1.BaseType);
  22246. bt2:=GetActualBaseType(Str2.BaseType);
  22247. if bt1=bt2 then exit(bt1);
  22248. case bt1 of
  22249. {$ifdef FPC_HAS_CPSTRING}
  22250. btAnsiChar:
  22251. case bt2 of
  22252. btChar: Result:=btChar;
  22253. btWideChar: Result:=btWideChar;
  22254. else Result:=bt2;
  22255. end;
  22256. {$endif}
  22257. btWideChar:
  22258. case bt2 of
  22259. {$ifdef FPC_HAS_CPSTRING}
  22260. btAnsiChar: Result:=btWideChar;
  22261. {$endif}
  22262. btWideString: Result:=btWideString;
  22263. btString,btUnicodeString
  22264. {$ifdef FPC_HAS_CPSTRING},btShortString,btAnsiString,btRawByteString{$endif}:
  22265. Result:=btUnicodeString;
  22266. else RaiseNotYetImplemented(20170420103808,ErrorEl);
  22267. end;
  22268. {$ifdef FPC_HAS_CPSTRING}
  22269. btShortString:
  22270. case bt2 of
  22271. btChar,btAnsiChar: Result:=btShortString;
  22272. btString,btAnsiString: Result:=btAnsiString;
  22273. btRawByteString: Result:=btRawByteString;
  22274. btWideChar,btUnicodeString: Result:=btUnicodeString;
  22275. btWideString: Result:=btWideString;
  22276. else RaiseNotYetImplemented(20170420120937,ErrorEl);
  22277. end;
  22278. {$endif}
  22279. btString{$ifdef FPC_HAS_CPSTRING},btAnsiString{$endif}:
  22280. case bt2 of
  22281. {$ifdef FPC_HAS_CPSTRING}
  22282. btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
  22283. {$endif}
  22284. btWideChar,btUnicodeString: Result:=btUnicodeString;
  22285. btWideString: Result:=btWideString;
  22286. else RaiseNotYetImplemented(20170420121201,ErrorEl);
  22287. end;
  22288. {$ifdef FPC_HAS_CPSTRING}
  22289. btRawByteString:
  22290. case bt2 of
  22291. btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
  22292. btString,btAnsiString: Result:=btAnsiString;
  22293. btWideChar,btUnicodeString: Result:=btUnicodeString;
  22294. btWideString: Result:=btWideString;
  22295. else RaiseNotYetImplemented(20170420121352,ErrorEl);
  22296. end;
  22297. {$endif}
  22298. btWideString:
  22299. case bt2 of
  22300. btChar,btWideChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,btShortString,{$endif}btWideString:
  22301. Result:=btWideString;
  22302. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  22303. Result:=btUnicodeString;
  22304. else RaiseNotYetImplemented(20170420121532,ErrorEl);
  22305. end;
  22306. btUnicodeString:
  22307. Result:=btUnicodeString;
  22308. else
  22309. RaiseNotYetImplemented(20170420103153,ErrorEl);
  22310. end;
  22311. if Result=BaseTypeChar then
  22312. Result:=btChar
  22313. else if Result=BaseTypeString then
  22314. Result:=btString;
  22315. end;
  22316. function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
  22317. begin
  22318. Result:=El=nil;
  22319. end;
  22320. function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
  22321. var
  22322. Data: TObject;
  22323. begin
  22324. Data:=El.CustomData;
  22325. if Data=nil then
  22326. RaiseInternalError(20180215185302,GetObjName(El));
  22327. if Data.ClassType=TResElDataBaseType then
  22328. Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
  22329. else if Data.ClassType=TResElDataBuiltInProc then
  22330. Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
  22331. else
  22332. Result:=nil;
  22333. end;
  22334. function TPasResolver.GetLastSection: TPasSection;
  22335. var
  22336. Module: TPasModule;
  22337. begin
  22338. Result:=nil;
  22339. Module:=RootElement;
  22340. if Module=nil then exit;
  22341. if Module is TPasProgram then
  22342. Result:=TPasProgram(Module).ProgramSection
  22343. else if Module is TPasLibrary then
  22344. Result:=TPasLibrary(Module).LibrarySection
  22345. else if Module.ImplementationSection<>nil then
  22346. Result:=Module.ImplementationSection
  22347. else
  22348. Result:=Module.InterfaceSection;
  22349. end;
  22350. function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  22351. isLoFunc: Boolean; out Mask: LongWord): Integer;
  22352. const
  22353. SHIFT_SIZE: array[btByte..{$IFDEF HasInt64}btComp{$ELSE}btIntDouble{$ENDIF}] of Integer = (
  22354. 4, // btByte
  22355. 8, // btShortInt FPC lo/hi(shortint) works like SmallInt
  22356. 8, 8, // btWord, btSmallInt
  22357. 16, 16, 16, 16, // btUIntSingle, btIntSingle, btLongWord, btLongint
  22358. 32, 32 // btUIntDouble, btIntDouble
  22359. {$IFDEF HasInt64}
  22360. , 32, 32, 32 // btQWord, btInt64, btComp
  22361. {$endif}
  22362. );
  22363. begin
  22364. if (BaseType >= Low(SHIFT_SIZE)) and (BaseType <= High(SHIFT_SIZE)) then
  22365. begin
  22366. if msDelphi in CurrentParser.CurrentModeswitches then
  22367. Result := 8
  22368. else
  22369. Result := SHIFT_SIZE[BaseType];
  22370. case Result of
  22371. 8: Mask := $FF;
  22372. 16: Mask := $FFFF;
  22373. 32: Mask := $FFFFFFFF;
  22374. else
  22375. {4} Mask := $F;
  22376. end;
  22377. if isLoFunc then
  22378. Result := 0;
  22379. end
  22380. else
  22381. begin
  22382. RaiseInternalError(20190130122300);
  22383. Result := -1;
  22384. end;
  22385. end;
  22386. function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
  22387. ResolvedDestType: TPasResolverResult): integer;
  22388. // finds distance between classes SrcType and DestType
  22389. begin
  22390. Result:=CheckClassIsClass(ResolvedSrcType.LoTypeEl,ResolvedDestType.LoTypeEl);
  22391. end;
  22392. function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
  22393. // check if Src is equal or descends from Dest
  22394. var
  22395. ClassEl: TPasClassType;
  22396. begin
  22397. {$IFDEF VerbosePasResolver}
  22398. writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  22399. {$ENDIF}
  22400. if DestType=nil then exit(cIncompatible);
  22401. DestType:=ResolveAliasType(DestType);
  22402. Result:=cExact;
  22403. while SrcType<>nil do
  22404. begin
  22405. {$IFDEF VerbosePasResolver}
  22406. writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  22407. {$ENDIF}
  22408. if SrcType=DestType then
  22409. exit
  22410. else if SrcType.ClassType=TPasAliasType then
  22411. // alias -> skip
  22412. SrcType:=TPasAliasType(SrcType).DestType
  22413. else if SrcType.ClassType=TPasTypeAliasType then
  22414. begin
  22415. // type alias -> increase distance
  22416. SrcType:=TPasAliasType(SrcType).DestType;
  22417. inc(Result);
  22418. end
  22419. else if SrcType.ClassType=TPasClassType then
  22420. begin
  22421. ClassEl:=TPasClassType(SrcType);
  22422. if ClassEl.IsForward then
  22423. // class forward -> skip
  22424. SrcType:=(ClassEl.CustomData as TResolvedReference).Declaration as TPasType
  22425. else
  22426. begin
  22427. // class ancestor -> increase distance
  22428. SrcType:=(ClassEl.CustomData as TPasClassScope).DirectAncestor;
  22429. inc(Result);
  22430. end;
  22431. end
  22432. else
  22433. exit(cIncompatible);
  22434. end;
  22435. Result:=cIncompatible;
  22436. end;
  22437. function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  22438. begin
  22439. Result:=CheckClassIsClass(TypeA,TypeB);
  22440. if Result<>cIncompatible then exit;
  22441. Result:=CheckClassIsClass(TypeB,TypeA);
  22442. end;
  22443. function TPasResolver.GetClassImplementsIntf(ClassEl, Intf: TPasClassType
  22444. ): TPasClassType;
  22445. begin
  22446. Result:=nil;
  22447. while ClassEl<>nil do
  22448. begin
  22449. if IndexOfImplementedInterface(ClassEl,Intf)>=0 then
  22450. exit(ClassEl);
  22451. ClassEl:=GetPasClassAncestor(ClassEl,true) as TPasClassType;
  22452. end;
  22453. end;
  22454. end.