pasresolver.pp 551 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821982298239824982598269827982898299830983198329833983498359836983798389839984098419842984398449845984698479848984998509851985298539854985598569857985898599860986198629863986498659866986798689869987098719872987398749875987698779878987998809881988298839884988598869887988898899890989198929893989498959896989798989899990099019902990399049905990699079908990999109911991299139914991599169917991899199920992199229923992499259926992799289929993099319932993399349935993699379938993999409941994299439944994599469947994899499950995199529953995499559956995799589959996099619962996399649965996699679968996999709971997299739974997599769977997899799980998199829983998499859986998799889989999099919992999399949995999699979998999910000100011000210003100041000510006100071000810009100101001110012100131001410015100161001710018100191002010021100221002310024100251002610027100281002910030100311003210033100341003510036100371003810039100401004110042100431004410045100461004710048100491005010051100521005310054100551005610057100581005910060100611006210063100641006510066100671006810069100701007110072100731007410075100761007710078100791008010081100821008310084100851008610087100881008910090100911009210093100941009510096100971009810099101001010110102101031010410105101061010710108101091011010111101121011310114101151011610117101181011910120101211012210123101241012510126101271012810129101301013110132101331013410135101361013710138101391014010141101421014310144101451014610147101481014910150101511015210153101541015510156101571015810159101601016110162101631016410165101661016710168101691017010171101721017310174101751017610177101781017910180101811018210183101841018510186101871018810189101901019110192101931019410195101961019710198101991020010201102021020310204102051020610207102081020910210102111021210213102141021510216102171021810219102201022110222102231022410225102261022710228102291023010231102321023310234102351023610237102381023910240102411024210243102441024510246102471024810249102501025110252102531025410255102561025710258102591026010261102621026310264102651026610267102681026910270102711027210273102741027510276102771027810279102801028110282102831028410285102861028710288102891029010291102921029310294102951029610297102981029910300103011030210303103041030510306103071030810309103101031110312103131031410315103161031710318103191032010321103221032310324103251032610327103281032910330103311033210333103341033510336103371033810339103401034110342103431034410345103461034710348103491035010351103521035310354103551035610357103581035910360103611036210363103641036510366103671036810369103701037110372103731037410375103761037710378103791038010381103821038310384103851038610387103881038910390103911039210393103941039510396103971039810399104001040110402104031040410405104061040710408104091041010411104121041310414104151041610417104181041910420104211042210423104241042510426104271042810429104301043110432104331043410435104361043710438104391044010441104421044310444104451044610447104481044910450104511045210453104541045510456104571045810459104601046110462104631046410465104661046710468104691047010471104721047310474104751047610477104781047910480104811048210483104841048510486104871048810489104901049110492104931049410495104961049710498104991050010501105021050310504105051050610507105081050910510105111051210513105141051510516105171051810519105201052110522105231052410525105261052710528105291053010531105321053310534105351053610537105381053910540105411054210543105441054510546105471054810549105501055110552105531055410555105561055710558105591056010561105621056310564105651056610567105681056910570105711057210573105741057510576105771057810579105801058110582105831058410585105861058710588105891059010591105921059310594105951059610597105981059910600106011060210603106041060510606106071060810609106101061110612106131061410615106161061710618106191062010621106221062310624106251062610627106281062910630106311063210633106341063510636106371063810639106401064110642106431064410645106461064710648106491065010651106521065310654106551065610657106581065910660106611066210663106641066510666106671066810669106701067110672106731067410675106761067710678106791068010681106821068310684106851068610687106881068910690106911069210693106941069510696106971069810699107001070110702107031070410705107061070710708107091071010711107121071310714107151071610717107181071910720107211072210723107241072510726107271072810729107301073110732107331073410735107361073710738107391074010741107421074310744107451074610747107481074910750107511075210753107541075510756107571075810759107601076110762107631076410765107661076710768107691077010771107721077310774107751077610777107781077910780107811078210783107841078510786107871078810789107901079110792107931079410795107961079710798107991080010801108021080310804108051080610807108081080910810108111081210813108141081510816108171081810819108201082110822108231082410825108261082710828108291083010831108321083310834108351083610837108381083910840108411084210843108441084510846108471084810849108501085110852108531085410855108561085710858108591086010861108621086310864108651086610867108681086910870108711087210873108741087510876108771087810879108801088110882108831088410885108861088710888108891089010891108921089310894108951089610897108981089910900109011090210903109041090510906109071090810909109101091110912109131091410915109161091710918109191092010921109221092310924109251092610927109281092910930109311093210933109341093510936109371093810939109401094110942109431094410945109461094710948109491095010951109521095310954109551095610957109581095910960109611096210963109641096510966109671096810969109701097110972109731097410975109761097710978109791098010981109821098310984109851098610987109881098910990109911099210993109941099510996109971099810999110001100111002110031100411005110061100711008110091101011011110121101311014110151101611017110181101911020110211102211023110241102511026110271102811029110301103111032110331103411035110361103711038110391104011041110421104311044110451104611047110481104911050110511105211053110541105511056110571105811059110601106111062110631106411065110661106711068110691107011071110721107311074110751107611077110781107911080110811108211083110841108511086110871108811089110901109111092110931109411095110961109711098110991110011101111021110311104111051110611107111081110911110111111111211113111141111511116111171111811119111201112111122111231112411125111261112711128111291113011131111321113311134111351113611137111381113911140111411114211143111441114511146111471114811149111501115111152111531115411155111561115711158111591116011161111621116311164111651116611167111681116911170111711117211173111741117511176111771117811179111801118111182111831118411185111861118711188111891119011191111921119311194111951119611197111981119911200112011120211203112041120511206112071120811209112101121111212112131121411215112161121711218112191122011221112221122311224112251122611227112281122911230112311123211233112341123511236112371123811239112401124111242112431124411245112461124711248112491125011251112521125311254112551125611257112581125911260112611126211263112641126511266112671126811269112701127111272112731127411275112761127711278112791128011281112821128311284112851128611287112881128911290112911129211293112941129511296112971129811299113001130111302113031130411305113061130711308113091131011311113121131311314113151131611317113181131911320113211132211323113241132511326113271132811329113301133111332113331133411335113361133711338113391134011341113421134311344113451134611347113481134911350113511135211353113541135511356113571135811359113601136111362113631136411365113661136711368113691137011371113721137311374113751137611377113781137911380113811138211383113841138511386113871138811389113901139111392113931139411395113961139711398113991140011401114021140311404114051140611407114081140911410114111141211413114141141511416114171141811419114201142111422114231142411425114261142711428114291143011431114321143311434114351143611437114381143911440114411144211443114441144511446114471144811449114501145111452114531145411455114561145711458114591146011461114621146311464114651146611467114681146911470114711147211473114741147511476114771147811479114801148111482114831148411485114861148711488114891149011491114921149311494114951149611497114981149911500115011150211503115041150511506115071150811509115101151111512115131151411515115161151711518115191152011521115221152311524115251152611527115281152911530115311153211533115341153511536115371153811539115401154111542115431154411545115461154711548115491155011551115521155311554115551155611557115581155911560115611156211563115641156511566115671156811569115701157111572115731157411575115761157711578115791158011581115821158311584115851158611587115881158911590115911159211593115941159511596115971159811599116001160111602116031160411605116061160711608116091161011611116121161311614116151161611617116181161911620116211162211623116241162511626116271162811629116301163111632116331163411635116361163711638116391164011641116421164311644116451164611647116481164911650116511165211653116541165511656116571165811659116601166111662116631166411665116661166711668116691167011671116721167311674116751167611677116781167911680116811168211683116841168511686116871168811689116901169111692116931169411695116961169711698116991170011701117021170311704117051170611707117081170911710117111171211713117141171511716117171171811719117201172111722117231172411725117261172711728117291173011731117321173311734117351173611737117381173911740117411174211743117441174511746117471174811749117501175111752117531175411755117561175711758117591176011761117621176311764117651176611767117681176911770117711177211773117741177511776117771177811779117801178111782117831178411785117861178711788117891179011791117921179311794117951179611797117981179911800118011180211803118041180511806118071180811809118101181111812118131181411815118161181711818118191182011821118221182311824118251182611827118281182911830118311183211833118341183511836118371183811839118401184111842118431184411845118461184711848118491185011851118521185311854118551185611857118581185911860118611186211863118641186511866118671186811869118701187111872118731187411875118761187711878118791188011881118821188311884118851188611887118881188911890118911189211893118941189511896118971189811899119001190111902119031190411905119061190711908119091191011911119121191311914119151191611917119181191911920119211192211923119241192511926119271192811929119301193111932119331193411935119361193711938119391194011941119421194311944119451194611947119481194911950119511195211953119541195511956119571195811959119601196111962119631196411965119661196711968119691197011971119721197311974119751197611977119781197911980119811198211983119841198511986119871198811989119901199111992119931199411995119961199711998119991200012001120021200312004120051200612007120081200912010120111201212013120141201512016120171201812019120201202112022120231202412025120261202712028120291203012031120321203312034120351203612037120381203912040120411204212043120441204512046120471204812049120501205112052120531205412055120561205712058120591206012061120621206312064120651206612067120681206912070120711207212073120741207512076120771207812079120801208112082120831208412085120861208712088120891209012091120921209312094120951209612097120981209912100121011210212103121041210512106121071210812109121101211112112121131211412115121161211712118121191212012121121221212312124121251212612127121281212912130121311213212133121341213512136121371213812139121401214112142121431214412145121461214712148121491215012151121521215312154121551215612157121581215912160121611216212163121641216512166121671216812169121701217112172121731217412175121761217712178121791218012181121821218312184121851218612187121881218912190121911219212193121941219512196121971219812199122001220112202122031220412205122061220712208122091221012211122121221312214122151221612217122181221912220122211222212223122241222512226122271222812229122301223112232122331223412235122361223712238122391224012241122421224312244122451224612247122481224912250122511225212253122541225512256122571225812259122601226112262122631226412265122661226712268122691227012271122721227312274122751227612277122781227912280122811228212283122841228512286122871228812289122901229112292122931229412295122961229712298122991230012301123021230312304123051230612307123081230912310123111231212313123141231512316123171231812319123201232112322123231232412325123261232712328123291233012331123321233312334123351233612337123381233912340123411234212343123441234512346123471234812349123501235112352123531235412355123561235712358123591236012361123621236312364123651236612367123681236912370123711237212373123741237512376123771237812379123801238112382123831238412385123861238712388123891239012391123921239312394123951239612397123981239912400124011240212403124041240512406124071240812409124101241112412124131241412415124161241712418124191242012421124221242312424124251242612427124281242912430124311243212433124341243512436124371243812439124401244112442124431244412445124461244712448124491245012451124521245312454124551245612457124581245912460124611246212463124641246512466124671246812469124701247112472124731247412475124761247712478124791248012481124821248312484124851248612487124881248912490124911249212493124941249512496124971249812499125001250112502125031250412505125061250712508125091251012511125121251312514125151251612517125181251912520125211252212523125241252512526125271252812529125301253112532125331253412535125361253712538125391254012541125421254312544125451254612547125481254912550125511255212553125541255512556125571255812559125601256112562125631256412565125661256712568125691257012571125721257312574125751257612577125781257912580125811258212583125841258512586125871258812589125901259112592125931259412595125961259712598125991260012601126021260312604126051260612607126081260912610126111261212613126141261512616126171261812619126201262112622126231262412625126261262712628126291263012631126321263312634126351263612637126381263912640126411264212643126441264512646126471264812649126501265112652126531265412655126561265712658126591266012661126621266312664126651266612667126681266912670126711267212673126741267512676126771267812679126801268112682126831268412685126861268712688126891269012691126921269312694126951269612697126981269912700127011270212703127041270512706127071270812709127101271112712127131271412715127161271712718127191272012721127221272312724127251272612727127281272912730127311273212733127341273512736127371273812739127401274112742127431274412745127461274712748127491275012751127521275312754127551275612757127581275912760127611276212763127641276512766127671276812769127701277112772127731277412775127761277712778127791278012781127821278312784127851278612787127881278912790127911279212793127941279512796127971279812799128001280112802128031280412805128061280712808128091281012811128121281312814128151281612817128181281912820128211282212823128241282512826128271282812829128301283112832128331283412835128361283712838128391284012841128421284312844128451284612847128481284912850128511285212853128541285512856128571285812859128601286112862128631286412865128661286712868128691287012871128721287312874128751287612877128781287912880128811288212883128841288512886128871288812889128901289112892128931289412895128961289712898128991290012901129021290312904129051290612907129081290912910129111291212913129141291512916129171291812919129201292112922129231292412925129261292712928129291293012931129321293312934129351293612937129381293912940129411294212943129441294512946129471294812949129501295112952129531295412955129561295712958129591296012961129621296312964129651296612967129681296912970129711297212973129741297512976129771297812979129801298112982129831298412985129861298712988129891299012991129921299312994129951299612997129981299913000130011300213003130041300513006130071300813009130101301113012130131301413015130161301713018130191302013021130221302313024130251302613027130281302913030130311303213033130341303513036130371303813039130401304113042130431304413045130461304713048130491305013051130521305313054130551305613057130581305913060130611306213063130641306513066130671306813069130701307113072130731307413075130761307713078130791308013081130821308313084130851308613087130881308913090130911309213093130941309513096130971309813099131001310113102131031310413105131061310713108131091311013111131121311313114131151311613117131181311913120131211312213123131241312513126131271312813129131301313113132131331313413135131361313713138131391314013141131421314313144131451314613147131481314913150131511315213153131541315513156131571315813159131601316113162131631316413165131661316713168131691317013171131721317313174131751317613177131781317913180131811318213183131841318513186131871318813189131901319113192131931319413195131961319713198131991320013201132021320313204132051320613207132081320913210132111321213213132141321513216132171321813219132201322113222132231322413225132261322713228132291323013231132321323313234132351323613237132381323913240132411324213243132441324513246132471324813249132501325113252132531325413255132561325713258132591326013261132621326313264132651326613267132681326913270132711327213273132741327513276132771327813279132801328113282132831328413285132861328713288132891329013291132921329313294132951329613297132981329913300133011330213303133041330513306133071330813309133101331113312133131331413315133161331713318133191332013321133221332313324133251332613327133281332913330133311333213333133341333513336133371333813339133401334113342133431334413345133461334713348133491335013351133521335313354133551335613357133581335913360133611336213363133641336513366133671336813369133701337113372133731337413375133761337713378133791338013381133821338313384133851338613387133881338913390133911339213393133941339513396133971339813399134001340113402134031340413405134061340713408134091341013411134121341313414134151341613417134181341913420134211342213423134241342513426134271342813429134301343113432134331343413435134361343713438134391344013441134421344313444134451344613447134481344913450134511345213453134541345513456134571345813459134601346113462134631346413465134661346713468134691347013471134721347313474134751347613477134781347913480134811348213483134841348513486134871348813489134901349113492134931349413495134961349713498134991350013501135021350313504135051350613507135081350913510135111351213513135141351513516135171351813519135201352113522135231352413525135261352713528135291353013531135321353313534135351353613537135381353913540135411354213543135441354513546135471354813549135501355113552135531355413555135561355713558135591356013561135621356313564135651356613567135681356913570135711357213573135741357513576135771357813579135801358113582135831358413585135861358713588135891359013591135921359313594135951359613597135981359913600136011360213603136041360513606136071360813609136101361113612136131361413615136161361713618136191362013621136221362313624136251362613627136281362913630136311363213633136341363513636136371363813639136401364113642136431364413645136461364713648136491365013651136521365313654136551365613657136581365913660136611366213663136641366513666136671366813669136701367113672136731367413675136761367713678136791368013681136821368313684136851368613687136881368913690136911369213693136941369513696136971369813699137001370113702137031370413705137061370713708137091371013711137121371313714137151371613717137181371913720137211372213723137241372513726137271372813729137301373113732137331373413735137361373713738137391374013741137421374313744137451374613747137481374913750137511375213753137541375513756137571375813759137601376113762137631376413765137661376713768137691377013771137721377313774137751377613777137781377913780137811378213783137841378513786137871378813789137901379113792137931379413795137961379713798137991380013801138021380313804138051380613807138081380913810138111381213813138141381513816138171381813819138201382113822138231382413825138261382713828138291383013831138321383313834138351383613837138381383913840138411384213843138441384513846138471384813849138501385113852138531385413855138561385713858138591386013861138621386313864138651386613867138681386913870138711387213873138741387513876138771387813879138801388113882138831388413885138861388713888138891389013891138921389313894138951389613897138981389913900139011390213903139041390513906139071390813909139101391113912139131391413915139161391713918139191392013921139221392313924139251392613927139281392913930139311393213933139341393513936139371393813939139401394113942139431394413945139461394713948139491395013951139521395313954139551395613957139581395913960139611396213963139641396513966139671396813969139701397113972139731397413975139761397713978139791398013981139821398313984139851398613987139881398913990139911399213993139941399513996139971399813999140001400114002140031400414005140061400714008140091401014011140121401314014140151401614017140181401914020140211402214023140241402514026140271402814029140301403114032140331403414035140361403714038140391404014041140421404314044140451404614047140481404914050140511405214053140541405514056140571405814059140601406114062140631406414065140661406714068140691407014071140721407314074140751407614077140781407914080140811408214083140841408514086140871408814089140901409114092140931409414095140961409714098140991410014101141021410314104141051410614107141081410914110141111411214113141141411514116141171411814119141201412114122141231412414125141261412714128141291413014131141321413314134141351413614137141381413914140141411414214143141441414514146141471414814149141501415114152141531415414155141561415714158141591416014161141621416314164141651416614167141681416914170141711417214173141741417514176141771417814179141801418114182141831418414185141861418714188141891419014191141921419314194141951419614197141981419914200142011420214203142041420514206142071420814209142101421114212142131421414215142161421714218142191422014221142221422314224142251422614227142281422914230142311423214233142341423514236142371423814239142401424114242142431424414245142461424714248142491425014251142521425314254142551425614257142581425914260142611426214263142641426514266142671426814269142701427114272142731427414275142761427714278142791428014281142821428314284142851428614287142881428914290142911429214293142941429514296142971429814299143001430114302143031430414305143061430714308143091431014311143121431314314143151431614317143181431914320143211432214323143241432514326143271432814329143301433114332143331433414335143361433714338143391434014341143421434314344143451434614347143481434914350143511435214353143541435514356143571435814359143601436114362143631436414365143661436714368143691437014371143721437314374143751437614377143781437914380143811438214383143841438514386143871438814389143901439114392143931439414395143961439714398143991440014401144021440314404144051440614407144081440914410144111441214413144141441514416144171441814419144201442114422144231442414425144261442714428144291443014431144321443314434144351443614437144381443914440144411444214443144441444514446144471444814449144501445114452144531445414455144561445714458144591446014461144621446314464144651446614467144681446914470144711447214473144741447514476144771447814479144801448114482144831448414485144861448714488144891449014491144921449314494144951449614497144981449914500145011450214503145041450514506145071450814509145101451114512145131451414515145161451714518145191452014521145221452314524145251452614527145281452914530145311453214533145341453514536145371453814539145401454114542145431454414545145461454714548145491455014551145521455314554145551455614557145581455914560145611456214563145641456514566145671456814569145701457114572145731457414575145761457714578145791458014581145821458314584145851458614587145881458914590145911459214593145941459514596145971459814599146001460114602146031460414605146061460714608146091461014611146121461314614146151461614617146181461914620146211462214623146241462514626146271462814629146301463114632146331463414635146361463714638146391464014641146421464314644146451464614647146481464914650146511465214653146541465514656146571465814659146601466114662146631466414665146661466714668146691467014671146721467314674146751467614677146781467914680146811468214683146841468514686146871468814689146901469114692146931469414695146961469714698146991470014701147021470314704147051470614707147081470914710147111471214713147141471514716147171471814719147201472114722147231472414725147261472714728147291473014731147321473314734147351473614737147381473914740147411474214743147441474514746147471474814749147501475114752147531475414755147561475714758147591476014761147621476314764147651476614767147681476914770147711477214773147741477514776147771477814779147801478114782147831478414785147861478714788147891479014791147921479314794147951479614797147981479914800148011480214803148041480514806148071480814809148101481114812148131481414815148161481714818148191482014821148221482314824148251482614827148281482914830148311483214833148341483514836148371483814839148401484114842148431484414845148461484714848148491485014851148521485314854148551485614857148581485914860148611486214863148641486514866148671486814869148701487114872148731487414875148761487714878148791488014881148821488314884148851488614887148881488914890148911489214893148941489514896148971489814899149001490114902149031490414905149061490714908149091491014911149121491314914149151491614917149181491914920149211492214923149241492514926149271492814929149301493114932149331493414935149361493714938149391494014941149421494314944149451494614947149481494914950149511495214953149541495514956149571495814959149601496114962149631496414965149661496714968149691497014971149721497314974149751497614977149781497914980149811498214983149841498514986149871498814989149901499114992149931499414995149961499714998149991500015001150021500315004150051500615007150081500915010150111501215013150141501515016150171501815019150201502115022150231502415025150261502715028150291503015031150321503315034150351503615037150381503915040150411504215043150441504515046150471504815049150501505115052150531505415055150561505715058150591506015061150621506315064150651506615067150681506915070150711507215073150741507515076150771507815079150801508115082150831508415085150861508715088150891509015091150921509315094150951509615097150981509915100151011510215103151041510515106151071510815109151101511115112151131511415115151161511715118151191512015121151221512315124151251512615127151281512915130151311513215133151341513515136151371513815139151401514115142151431514415145151461514715148151491515015151151521515315154151551515615157151581515915160151611516215163151641516515166151671516815169151701517115172151731517415175151761517715178151791518015181151821518315184151851518615187151881518915190151911519215193151941519515196151971519815199152001520115202152031520415205152061520715208152091521015211152121521315214152151521615217152181521915220152211522215223152241522515226152271522815229152301523115232152331523415235152361523715238152391524015241152421524315244152451524615247152481524915250152511525215253152541525515256152571525815259152601526115262152631526415265152661526715268152691527015271152721527315274152751527615277152781527915280152811528215283152841528515286152871528815289152901529115292152931529415295152961529715298152991530015301153021530315304153051530615307153081530915310153111531215313153141531515316153171531815319153201532115322153231532415325153261532715328153291533015331153321533315334153351533615337153381533915340153411534215343153441534515346153471534815349153501535115352153531535415355153561535715358153591536015361153621536315364153651536615367153681536915370153711537215373153741537515376153771537815379153801538115382153831538415385153861538715388153891539015391153921539315394153951539615397153981539915400154011540215403154041540515406154071540815409154101541115412154131541415415154161541715418154191542015421154221542315424154251542615427154281542915430154311543215433154341543515436154371543815439154401544115442154431544415445154461544715448154491545015451154521545315454154551545615457154581545915460154611546215463154641546515466154671546815469154701547115472154731547415475154761547715478154791548015481154821548315484154851548615487154881548915490154911549215493154941549515496154971549815499155001550115502155031550415505155061550715508155091551015511155121551315514155151551615517155181551915520155211552215523155241552515526155271552815529155301553115532155331553415535155361553715538155391554015541155421554315544155451554615547155481554915550155511555215553155541555515556155571555815559155601556115562155631556415565155661556715568155691557015571155721557315574155751557615577155781557915580155811558215583155841558515586155871558815589155901559115592155931559415595155961559715598155991560015601156021560315604156051560615607156081560915610156111561215613156141561515616156171561815619156201562115622156231562415625156261562715628156291563015631156321563315634156351563615637156381563915640156411564215643156441564515646156471564815649156501565115652156531565415655156561565715658156591566015661156621566315664156651566615667156681566915670156711567215673156741567515676156771567815679156801568115682156831568415685156861568715688156891569015691156921569315694156951569615697156981569915700157011570215703157041570515706157071570815709157101571115712157131571415715157161571715718157191572015721157221572315724157251572615727157281572915730157311573215733157341573515736157371573815739157401574115742157431574415745157461574715748157491575015751157521575315754157551575615757157581575915760157611576215763157641576515766157671576815769157701577115772157731577415775157761577715778157791578015781157821578315784157851578615787157881578915790157911579215793157941579515796157971579815799158001580115802158031580415805158061580715808158091581015811158121581315814158151581615817158181581915820158211582215823158241582515826158271582815829158301583115832158331583415835158361583715838158391584015841158421584315844158451584615847158481584915850158511585215853158541585515856158571585815859158601586115862158631586415865158661586715868158691587015871158721587315874158751587615877158781587915880158811588215883158841588515886158871588815889158901589115892158931589415895158961589715898158991590015901159021590315904159051590615907159081590915910159111591215913159141591515916159171591815919159201592115922159231592415925159261592715928159291593015931159321593315934159351593615937159381593915940159411594215943159441594515946159471594815949159501595115952159531595415955159561595715958159591596015961159621596315964159651596615967159681596915970159711597215973159741597515976159771597815979159801598115982159831598415985159861598715988159891599015991159921599315994159951599615997159981599916000160011600216003160041600516006160071600816009160101601116012160131601416015160161601716018160191602016021160221602316024160251602616027160281602916030160311603216033160341603516036160371603816039160401604116042160431604416045160461604716048160491605016051160521605316054160551605616057160581605916060160611606216063160641606516066160671606816069160701607116072160731607416075160761607716078160791608016081160821608316084160851608616087160881608916090160911609216093
  1. {
  2. This file is part of the Free Component Library
  3. Pascal source parser
  4. Copyright (c) 2000-2005 by
  5. Areca Systems GmbH / Sebastian Guenther, [email protected]
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************
  12. Abstract:
  13. Resolves references by setting TPasElement.CustomData as TResolvedReference.
  14. Creates search scopes for elements with sub identifiers by setting
  15. TPasElement.CustomData as TPasScope: unit, program, library, interface,
  16. implementation, procs
  17. Works:
  18. - built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
  19. - references in statements, error if not found
  20. - interface and implementation types, vars, const
  21. - params, local types, vars, const
  22. - nested procedures
  23. - nested forward procs, nested must be resolved before proc body
  24. - program/library/implementation forward procs
  25. - search in used units
  26. - unitname.identifier
  27. - alias types, 'type a=b'
  28. - type alias type 'type a=type b'
  29. - choose the most compatible overloaded procedure
  30. - while..do
  31. - repeat..until
  32. - if..then..else
  33. - binary operators
  34. - case..of
  35. - try..finally..except, on, else, raise
  36. - for loop
  37. - spot duplicates
  38. - type cast base types
  39. - char
  40. - ord(), chr()
  41. - record
  42. - variants
  43. - const param makes children const too
  44. - class:
  45. - forward declaration
  46. - instance.a
  47. - find ancestor, search in ancestors
  48. - virtual, abstract, override
  49. - method body
  50. - Self
  51. - inherited
  52. - property
  53. - read var, read function
  54. - write var, write function
  55. - stored function
  56. - defaultexpr
  57. - is and as operator
  58. - nil
  59. - constructor result type, rrfNewInstance
  60. - destructor call type: rrfFreeInstance
  61. - type cast
  62. - class of
  63. - class method, property, var, const
  64. - class-of.constructor
  65. - class-of typecast upwards/downwards
  66. - class-of option to allow is-operator
  67. - typecast Self in class method upwards/downwards
  68. - property with params
  69. - default property
  70. - visibility, override: warn and fix if lower
  71. - events, proc type of object
  72. - sealed
  73. - $M+ / $TYPEINFO use visPublished as default visibility
  74. - note: constructing class with abstract method
  75. - with..do
  76. - enums - TPasEnumType, TPasEnumValue
  77. - propagate to parent scopes
  78. - function ord(): integer
  79. - function low(ordinal): ordinal
  80. - function high(ordinal): ordinal
  81. - function pred(ordinal): ordinal
  82. - function high(ordinal): ordinal
  83. - cast integer to enum, enum to integer
  84. - $ScopedEnums
  85. - sets - TPasSetType
  86. - set of char
  87. - set of integer
  88. - set of boolean
  89. - set of enum
  90. - ranges 'a'..'z' 2..5
  91. - operators: +, -, *, ><, <=, >=
  92. - in-operator
  93. - assign operators: +=, -=, *=
  94. - include(), exclude()
  95. - typed const: check expr type
  96. - function length(const array or string): integer
  97. - procedure setlength(var array or string; newlength: integer)
  98. - ranges TPasRangeType
  99. - procedure exit, procedure exit(const function result)
  100. - check if types only refer types+const
  101. - check const expression types, e.g. bark on "const c:string=3;"
  102. - procedure inc/dec(var ordinal; decr: ordinal = 1)
  103. - function Assigned(Pointer or Class or Class-Of): boolean
  104. - arrays TPasArrayType
  105. - TPasEnumType, char, integer, range
  106. - low, high, length, setlength, assigned
  107. - function concat(array1,array2,...): array
  108. - function copy(array): array, copy(a,start), copy(a,start,end)
  109. - insert(item; var array; index: integer)
  110. - delete(var array; start, count: integer)
  111. - element
  112. - multi dimensional
  113. - const
  114. - open array, override, pass array literal, pass var
  115. - type cast array to arrays with same dimensions and compatible element type
  116. - static array range checking
  117. - const array of char = string
  118. - check if var initexpr fits vartype: var a: type = expr;
  119. - built-in functions high, low for range types
  120. - procedure type
  121. - call
  122. - as function result
  123. - as parameter
  124. - Delphi without @
  125. - @@ operator
  126. - FPC equal and not equal
  127. - "is nested"
  128. - bark on arguments access mismatch
  129. - function without params: mark if call or address, rrfImplicitCallWithoutParams
  130. - procedure break, procedure continue
  131. - built-in functions pred, succ for range type and enums
  132. - untyped parameters
  133. - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
  134. - pointer TPasPointerType
  135. - nil, assigned(), typecast, class, classref, dynarray, procvar
  136. - emit hints
  137. - platform, deprecated, experimental, library, unimplemented
  138. - hiding ancestor method
  139. - hiding other unit identifier
  140. - dotted unitnames
  141. - eval:
  142. - nil, true, false
  143. - range checking:
  144. - integer ranges
  145. - boolean ranges
  146. - enum ranges
  147. - char ranges
  148. - +, -, *, div, mod, /, shl, shr, or, and, xor, in, ^^, ><
  149. - =, <>, <, <=, >, >=
  150. - ord(), low(), high(), pred(), succ(), length()
  151. - string[index]
  152. - call(param)
  153. - a:=value
  154. - arr[index]
  155. - resourcestrings
  156. - custom ranges
  157. - enum: low(), high(), pred(), succ(), ord(), rg(int), int(rg), enum:=rg,
  158. rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
  159. array[rg], low(array), high(array)
  160. - for..in..do :
  161. - type boolean, char, byte, shortint, word, smallint, longword, longint
  162. - type enum range, char range, integer range
  163. - type/var set of: enum, enum range, integer, integer range, char, char range
  164. - array var
  165. - function: enumerator
  166. - class
  167. - var modifier 'absolute'
  168. - Assert(bool[,string])
  169. ToDo:
  170. - $pop, $push
  171. - $writableconst off $J-
  172. - $RTTI inherited|explicit
  173. - range checking:
  174. - indexedprop[param]
  175. - case-of unique
  176. - defaultvalue
  177. - fail to write a loop var inside the loop
  178. - nested classes
  179. - records - TPasRecordType,
  180. - const TRecordValues
  181. - function default(record type): record
  182. - pointer of record
  183. - proc: check if forward and impl default values match
  184. - call array of proc without ()
  185. - array+array
  186. - pointer type, ^type, @ operator, [] operator
  187. - type alias type
  188. - object
  189. - interfaces
  190. - implements, supports
  191. - generics, nested param lists
  192. - type helpers
  193. - record/class helpers
  194. - generics
  195. - futures
  196. - operator overload
  197. - operator enumerator
  198. - attributes
  199. - anonymous functions
  200. - TPasFileType
  201. - labels
  202. - $warn identifier ON|off|error|default
  203. - $zerobasedstrings on|off
  204. Debug flags: -d<x>
  205. VerbosePasResolver
  206. Notes:
  207. Functions and function types without parameters:
  208. property P read f; // use function f, not its result
  209. f. // implicit resolve f once if param less function or function type
  210. f[] // implicit resolve f once if a param less function or function type
  211. @f; use function f, not its result
  212. @p.f; @ operator applies to f, not p
  213. @f(); @ operator applies to result of f
  214. f(); use f's result
  215. FuncVar:=Func; if mode=objfpc: incompatible
  216. if mode=delphi: implicit addr of function f
  217. if f=g then : can implicit resolve each side once
  218. p(f), f as var parameter: can implicit
  219. }
  220. unit PasResolver;
  221. {$mode objfpc}{$H+}
  222. {$inline on}
  223. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  224. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  225. interface
  226. uses
  227. Classes, SysUtils, Math, contnrs,
  228. PasTree, PScanner, PParser, PasResolveEval;
  229. const
  230. ParserMaxEmbeddedColumn = 2048;
  231. ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
  232. type
  233. TResolverBaseType = (
  234. btNone, // undefined
  235. btCustom, // provided by descendant resolver
  236. btContext, // a class or record
  237. btModule,
  238. btUntyped, // TPasArgument without ArgType
  239. btChar, // char
  240. btAnsiChar, // ansichar
  241. btWideChar, // widechar
  242. btString, // string
  243. btAnsiString, // ansistring
  244. btShortString, // shortstring
  245. btWideString, // widestring
  246. btUnicodeString,// unicodestring
  247. btRawByteString, // rawbytestring
  248. btSingle, // single 1.5E-45..3.4E38, digits 7-8, bytes 4
  249. btDouble, // double 5.0E-324..1.7E308, digits 15-16, bytes 8
  250. btExtended, // extended platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
  251. btCExtended, // cextended
  252. btCurrency, // as int64 div 10000, float, not ordinal
  253. btBoolean, // boolean
  254. btByteBool, // bytebool true=not zero
  255. btWordBool, // wordbool true=not zero
  256. btLongBool, // longbool true=not zero
  257. btQWordBool, // qwordbool true=not zero
  258. btByte, // byte 0..255
  259. btShortInt, // shortint -128..127
  260. btWord, // word unsigned 2 bytes
  261. btSmallInt, // smallint signed 2 bytes
  262. btUIntSingle, // unsigned integer range of single 22bit
  263. btIntSingle, // integer range of single 23bit
  264. btLongWord, // longword unsigned 4 bytes
  265. btLongint, // longint signed 4 bytes
  266. btUIntDouble, // unsigned integer range of double 52bit
  267. btIntDouble, // integer range of double 53bit
  268. btQWord, // qword 0..18446744073709551615, bytes 8
  269. btInt64, // int64 -9223372036854775808..9223372036854775807, bytes 8
  270. btComp, // as Int64, not ordinal
  271. btPointer, // pointer
  272. btFile, // file
  273. btText, // text
  274. btVariant, // variant
  275. btNil, // nil = pointer, class, procedure, method, ...
  276. btProc, // TPasProcedure
  277. btBuiltInProc,
  278. btSet, // [] see SubType
  279. //btArrayLit, // [] array literal, can also be round bracket in var a:arraytype = (x,y)
  280. btRange // a..b see SubType
  281. );
  282. TResolveBaseTypes = set of TResolverBaseType;
  283. const
  284. btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
  285. btLongWord,btLongint,btIntDouble,btUIntDouble,btQWord,btInt64,btComp];
  286. btAllChars = [btChar,btAnsiChar,btWideChar];
  287. btAllStrings = [btString,btAnsiString,btShortString,
  288. btWideString,btUnicodeString,btRawByteString];
  289. btAllStringAndChars = btAllStrings+btAllChars;
  290. btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency];
  291. btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
  292. btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
  293. btAllRanges = btArrayRangeTypes+[btRange];
  294. btAllStandardTypes = [
  295. btChar,
  296. btAnsiChar,
  297. btWideChar,
  298. btString,
  299. btAnsiString,
  300. btShortString,
  301. btWideString,
  302. btUnicodeString,
  303. btRawByteString,
  304. btSingle,
  305. btDouble,
  306. btExtended,
  307. btCExtended,
  308. btCurrency,
  309. btBoolean,
  310. btByteBool,
  311. btWordBool,
  312. btLongBool,
  313. btQWordBool,
  314. btByte,
  315. btShortInt,
  316. btWord,
  317. btSmallInt,
  318. btLongWord,
  319. btLongint,
  320. btQWord,
  321. btInt64,
  322. btComp,
  323. btPointer,
  324. btFile,
  325. btText,
  326. btVariant
  327. ];
  328. ResBaseTypeNames: array[TResolverBaseType] of string =(
  329. 'None',
  330. 'Custom',
  331. 'Context',
  332. 'Module',
  333. 'Untyped',
  334. 'Char',
  335. 'AnsiChar',
  336. 'WideChar',
  337. 'String',
  338. 'AnsiString',
  339. 'ShortString',
  340. 'WideString',
  341. 'UnicodeString',
  342. 'RawByteString',
  343. 'Single',
  344. 'Double',
  345. 'Extended',
  346. 'CExtended',
  347. 'Currency',
  348. 'Boolean',
  349. 'ByteBool',
  350. 'WordBool',
  351. 'LongBool',
  352. 'QWordBool',
  353. 'Byte',
  354. 'ShortInt',
  355. 'Word',
  356. 'SmallInt',
  357. 'UIntSingle',
  358. 'IntSingle',
  359. 'LongWord',
  360. 'Longint',
  361. 'UIntDouble',
  362. 'IntDouble',
  363. 'QWord',
  364. 'Int64',
  365. 'Comp',
  366. 'Pointer',
  367. 'File',
  368. 'Text',
  369. 'Variant',
  370. 'Nil',
  371. 'Procedure/Function',
  372. 'BuiltInProc',
  373. 'set',
  374. 'range..'
  375. );
  376. type
  377. TResolverBuiltInProc = (
  378. bfCustom,
  379. bfLength,
  380. bfSetLength,
  381. bfInclude,
  382. bfExclude,
  383. bfBreak,
  384. bfContinue,
  385. bfExit,
  386. bfInc,
  387. bfDec,
  388. bfAssigned,
  389. bfChr,
  390. bfOrd,
  391. bfLow,
  392. bfHigh,
  393. bfPred,
  394. bfSucc,
  395. bfStrProc,
  396. bfStrFunc,
  397. bfConcatArray,
  398. bfCopyArray,
  399. bfInsertArray,
  400. bfDeleteArray,
  401. bfTypeInfo,
  402. bfAssert
  403. );
  404. TResolverBuiltInProcs = set of TResolverBuiltInProc;
  405. const
  406. ResolverBuiltInProcNames: array[TResolverBuiltInProc] of string = (
  407. 'Custom',
  408. 'Length',
  409. 'SetLength',
  410. 'Include',
  411. 'Exclude',
  412. 'Break',
  413. 'Continue',
  414. 'Exit',
  415. 'Inc',
  416. 'Dec',
  417. 'Assigned',
  418. 'Chr',
  419. 'Ord',
  420. 'Low',
  421. 'High',
  422. 'Pred',
  423. 'Succ',
  424. 'Str',
  425. 'Str',
  426. 'Concat',
  427. 'Copy',
  428. 'Insert',
  429. 'Delete',
  430. 'TypeInfo',
  431. 'Assert'
  432. );
  433. bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
  434. const
  435. ResolverResultVar = 'Result';
  436. type
  437. { EPasResolve }
  438. EPasResolve = class(Exception)
  439. private
  440. FPasElement: TPasElement;
  441. procedure SetPasElement(AValue: TPasElement);
  442. public
  443. Id: int64;
  444. MsgType: TMessageType;
  445. MsgNumber: integer;
  446. MsgPattern: String;
  447. Args: TMessageArgs;
  448. SourcePos: TPasSourcePos;
  449. destructor Destroy; override;
  450. property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
  451. end;
  452. type
  453. { TUnresolvedPendingRef }
  454. TUnresolvedPendingRef = class(TPasUnresolvedSymbolRef)
  455. public
  456. Element: TPasType; // TPasClassOfType or TPasPointerType
  457. end;
  458. TPasScope = class;
  459. TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
  460. Data: Pointer; var Abort: boolean) of object;
  461. { TPasScope -
  462. Elements like TPasClassType use TPasScope descendants as CustomData for
  463. their sub identifiers.
  464. TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
  465. }
  466. TPasScope = Class(TResolveData)
  467. public
  468. VisibilityContext: TPasElement; // methods sets this to a TPasClassType,
  469. // used to check if the current context is allowed to access a
  470. // private/protected element
  471. class function IsStoredInElement: boolean; virtual;
  472. class function FreeOnPop: boolean; virtual;
  473. procedure IterateElements(const aName: string; StartScope: TPasScope;
  474. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  475. var Abort: boolean); virtual;
  476. procedure WriteIdentifiers(Prefix: string); virtual;
  477. end;
  478. TPasScopeClass = class of TPasScope;
  479. TPasModuleScopeFlag = (
  480. pmsfAssertSearched, // assert constructors searched
  481. pmsfRangeErrorNeeded, // somewhere is range checking on
  482. pmsfRangeErrorSearched // ERangeError constructor searched
  483. );
  484. TPasModuleScopeFlags = set of TPasModuleScopeFlag;
  485. { TPasModuleScope }
  486. TPasModuleScope = class(TPasScope)
  487. private
  488. FAssertClass: TPasClassType;
  489. FAssertDefConstructor: TPasConstructor;
  490. FAssertMsgConstructor: TPasConstructor;
  491. FRangeErrorClass: TPasClassType;
  492. FRangeErrorConstructor: TPasConstructor;
  493. procedure SetAssertClass(const AValue: TPasClassType);
  494. procedure SetAssertDefConstructor(const AValue: TPasConstructor);
  495. procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
  496. procedure SetRangeErrorClass(const AValue: TPasClassType);
  497. procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
  498. public
  499. FirstName: string;
  500. PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
  501. Flags: TPasModuleScopeFlags;
  502. ScannerBoolSwitches: TBoolSwitches;
  503. constructor Create; override;
  504. destructor Destroy; override;
  505. procedure IterateElements(const aName: string; StartScope: TPasScope;
  506. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  507. var Abort: boolean); override;
  508. property AssertClass: TPasClassType read FAssertClass write SetAssertClass;
  509. property AssertDefConstructor: TPasConstructor read FAssertDefConstructor write SetAssertDefConstructor;
  510. property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
  511. property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
  512. property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
  513. end;
  514. TPasIdentifierKind = (
  515. pikNone, // not yet initialized
  516. pikBaseType, // e.g. longint
  517. pikBuiltInProc, // e.g. High(), SetLength()
  518. pikSimple, // simple vars, consts, types, enums
  519. pikProc, // may need parameter list with round brackets
  520. pikNamespace
  521. );
  522. TPasIdentifierKinds = set of TPasIdentifierKind;
  523. { TPasIdentifier }
  524. TPasIdentifier = Class(TObject)
  525. private
  526. FElement: TPasElement;
  527. procedure SetElement(AValue: TPasElement);
  528. public
  529. {$IFDEF VerbosePasResolver}
  530. Owner: TObject;
  531. {$ENDIF}
  532. Identifier: String;
  533. NextSameIdentifier: TPasIdentifier; // next identifier with same name
  534. Kind: TPasIdentifierKind;
  535. destructor Destroy; override;
  536. property Element: TPasElement read FElement write SetElement;
  537. end;
  538. { TPasIdentifierScope - elements with a list of sub identifiers }
  539. TPasIdentifierScope = Class(TPasScope)
  540. private
  541. FItems: TFPHashList;
  542. procedure InternalAdd(Item: TPasIdentifier);
  543. procedure OnClearItem(Item, Dummy: pointer);
  544. protected
  545. procedure OnWriteItem(Item, Dummy: pointer);
  546. public
  547. constructor Create; override;
  548. destructor Destroy; override;
  549. function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
  550. function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
  551. function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
  552. function AddIdentifier(const Identifier: String; El: TPasElement;
  553. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  554. function FindElement(const aName: string): TPasElement;
  555. procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
  556. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  557. var Abort: boolean);
  558. procedure IterateElements(const aName: string; StartScope: TPasScope;
  559. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  560. var Abort: boolean); override;
  561. procedure WriteIdentifiers(Prefix: string); override;
  562. end;
  563. { TPasDefaultScope - root scope }
  564. TPasDefaultScope = class(TPasIdentifierScope)
  565. public
  566. class function IsStoredInElement: boolean; override;
  567. end;
  568. { TPasSectionScope - e.g. interface, implementation, program, library }
  569. TPasSectionScope = Class(TPasIdentifierScope)
  570. private
  571. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  572. Data: Pointer; var Abort: boolean);
  573. public
  574. UsesScopes: TFPList; // list of TPasSectionScope
  575. Finished: boolean;
  576. constructor Create; override;
  577. destructor Destroy; override;
  578. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  579. procedure IterateElements(const aName: string; StartScope: TPasScope;
  580. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  581. var Abort: boolean); override;
  582. procedure WriteIdentifiers(Prefix: string); override;
  583. end;
  584. { TPasEnumTypeScope }
  585. TPasEnumTypeScope = Class(TPasIdentifierScope)
  586. public
  587. CanonicalSet: TPasSetType;
  588. destructor Destroy; override;
  589. end;
  590. { TPasRecordScope }
  591. TPasRecordScope = Class(TPasIdentifierScope)
  592. end;
  593. TPasClassScopeFlag = (
  594. pcsfAncestorResolved,
  595. pcsfSealed,
  596. pcsfPublished // default visibility is published due to $M directive
  597. );
  598. TPasClassScopeFlags = set of TPasClassScopeFlag;
  599. { TPasClassScope }
  600. TPasClassScope = Class(TPasIdentifierScope)
  601. public
  602. AncestorScope: TPasClassScope;
  603. CanonicalClassOf: TPasClassOfType;
  604. DirectAncestor: TPasType; // TPasClassType or TPasAliasType or TPasTypeAliasType
  605. DefaultProperty: TPasProperty;
  606. Flags: TPasClassScopeFlags;
  607. AbstractProcs: TArrayOfPasProcedure;
  608. destructor Destroy; override;
  609. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  610. procedure IterateElements(const aName: string; StartScope: TPasScope;
  611. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  612. var Abort: boolean); override;
  613. procedure WriteIdentifiers(Prefix: string); override;
  614. end;
  615. TPasClassScopeClass = class of TPasClassScope;
  616. TPasProcedureScopeFlag = (
  617. ppsfIsGroupOverload // mode objfpc: one overload is enough for all procs in same scope
  618. );
  619. TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
  620. { TPasProcedureScope }
  621. TPasProcedureScope = Class(TPasIdentifierScope)
  622. public
  623. DeclarationProc: TPasProcedure; // the corresponding forward declaration
  624. ImplProc: TPasProcedure; // the corresponding proc with Body
  625. OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
  626. ClassScope: TPasClassScope;
  627. SelfArg: TPasArgument;
  628. Mode: TModeSwitch;
  629. Flags: TPasProcedureScopeFlags;
  630. ScannerBoolSwitches: TBoolSwitches;
  631. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  632. procedure IterateElements(const aName: string; StartScope: TPasScope;
  633. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  634. var Abort: boolean); override;
  635. function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
  636. procedure WriteIdentifiers(Prefix: string); override;
  637. destructor Destroy; override;
  638. end;
  639. TPasProcedureScopeClass = class of TPasProcedureScope;
  640. { TPasPropertyScope }
  641. TPasPropertyScope = Class(TPasIdentifierScope)
  642. public
  643. AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
  644. otherwise it is a redeclaration }
  645. destructor Destroy; override;
  646. end;
  647. { TPasExceptOnScope }
  648. TPasExceptOnScope = Class(TPasIdentifierScope)
  649. end;
  650. TPasWithScope = class;
  651. TPasWithExprScopeFlag = (
  652. wesfNeedTmpVar,
  653. wesfOnlyTypeMembers,
  654. wesfConstParent // not writable
  655. );
  656. TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
  657. { TPasWithExprScope }
  658. TPasWithExprScope = Class(TPasScope)
  659. public
  660. WithScope: TPasWithScope; // owner
  661. Index: integer;
  662. Expr: TPasExpr;
  663. Scope: TPasScope;
  664. Flags: TPasWithExprScopeFlags;
  665. class function IsStoredInElement: boolean; override;
  666. class function FreeOnPop: boolean; override;
  667. procedure IterateElements(const aName: string; StartScope: TPasScope;
  668. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  669. var Abort: boolean); override;
  670. procedure WriteIdentifiers(Prefix: string); override;
  671. end;
  672. TPasWithExprScopeClass = class of TPasWithExprScope;
  673. { TPasWithScope }
  674. TPasWithScope = Class(TPasScope)
  675. public
  676. // Element is the TPasImplWithDo
  677. ExpressionScopes: TObjectList; // list of TPasWithExprScope
  678. constructor Create; override;
  679. destructor Destroy; override;
  680. end;
  681. { TPasForLoopScope }
  682. TPasForLoopScope = Class(TPasScope)
  683. public
  684. GetEnumerator: TPasFunction;
  685. MoveNext: TPasFunction;
  686. Current: TPasProperty;
  687. end;
  688. { TPasSubScope - base class for sub scopes aka dotted scopes }
  689. TPasSubScope = Class(TPasIdentifierScope)
  690. public
  691. class function IsStoredInElement: boolean; override;
  692. end;
  693. { TPasIterateFilterData }
  694. TPasIterateFilterData = record
  695. OnIterate: TIterateScopeElement;
  696. Data: Pointer;
  697. end;
  698. PPasIterateFilterData = ^TPasIterateFilterData;
  699. { TPasModuleDotScope - scope for searching unitname.<identifier> }
  700. TPasModuleDotScope = Class(TPasSubScope)
  701. private
  702. FModule: TPasModule;
  703. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  704. Data: Pointer; var Abort: boolean);
  705. procedure SetModule(AValue: TPasModule);
  706. public
  707. ImplementationScope: TPasSectionScope;
  708. InterfaceScope: TPasSectionScope;
  709. SystemScope: TPasDefaultScope;
  710. destructor Destroy; override;
  711. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  712. procedure IterateElements(const aName: string; StartScope: TPasScope;
  713. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  714. var Abort: boolean); override;
  715. procedure WriteIdentifiers(Prefix: string); override;
  716. property Module: TPasModule read FModule write SetModule;
  717. end;
  718. { TPasDotIdentifierScope }
  719. TPasDotIdentifierScope = Class(TPasSubScope)
  720. public
  721. IdentifierScope: TPasIdentifierScope;
  722. OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
  723. ConstParent: boolean;
  724. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  725. procedure IterateElements(const aName: string; StartScope: TPasScope;
  726. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  727. var Abort: boolean); override;
  728. procedure WriteIdentifiers(Prefix: string); override;
  729. end;
  730. { TPasDotRecordScope - used for aRecord.subidentifier }
  731. TPasDotRecordScope = Class(TPasDotIdentifierScope)
  732. end;
  733. { TPasDotEnumTypeScope - used for EnumType.EnumValue }
  734. TPasDotEnumTypeScope = Class(TPasDotIdentifierScope)
  735. end;
  736. { TPasDotClassScope - used for aClass.subidentifier }
  737. TPasDotClassScope = Class(TPasDotIdentifierScope)
  738. private
  739. FClassScope: TPasClassScope;
  740. procedure SetClassScope(AValue: TPasClassScope);
  741. public
  742. InheritedExpr: boolean; // this is 'inherited <name>' instead of '.<name'
  743. property ClassScope: TPasClassScope read FClassScope write SetClassScope;
  744. end;
  745. TResolvedReferenceFlag = (
  746. rrfDotScope, // found reference via a dot scope (TPasDotIdentifierScope)
  747. rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
  748. rrfNewInstance, // constructor call (without it call constructor as normal method)
  749. rrfFreeInstance, // destructor call (without it call destructor as normal method)
  750. rrfVMT, // use VMT for call
  751. rrfConstInherited // parent is const and children are too
  752. );
  753. TResolvedReferenceFlags = set of TResolvedReferenceFlag;
  754. type
  755. { TResolvedRefContext }
  756. TResolvedRefContext = Class
  757. end;
  758. TResolvedRefAccess = (
  759. rraNone,
  760. rraRead, // expression is read
  761. rraAssign, // expression is LHS assign
  762. rraReadAndAssign, // expression is LHS +=, -=, *=, /=
  763. rraVarParam, // expression is passed to a var parameter
  764. rraOutParam, // expression is passed to an out parameter
  765. rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
  766. // will later be changed to rraRead, rraVarParam, rraOutParam
  767. );
  768. TPRResolveVarAccesses = set of TResolvedRefAccess;
  769. { TResolvedReference - CustomData for normal references }
  770. TResolvedReference = Class(TResolveData)
  771. private
  772. FDeclaration: TPasElement;
  773. procedure SetDeclaration(AValue: TPasElement);
  774. public
  775. Flags: TResolvedReferenceFlags;
  776. Access: TResolvedRefAccess;
  777. Context: TResolvedRefContext;
  778. WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
  779. destructor Destroy; override;
  780. property Declaration: TPasElement read FDeclaration write SetDeclaration;
  781. end;
  782. { TResolvedRefCtxConstructor }
  783. TResolvedRefCtxConstructor = Class(TResolvedRefContext)
  784. public
  785. Typ: TPasType; // e.g. TPasClassType
  786. end;
  787. TPasResolverResultFlag = (
  788. rrfReadable,
  789. rrfWritable,
  790. rrfAssignable, // not writable in general, e.g. aString[1]:=
  791. rrfCanBeStatement
  792. );
  793. TPasResolverResultFlags = set of TPasResolverResultFlag;
  794. type
  795. { TPasResolverResult }
  796. TPasResolverResult = record
  797. BaseType: TResolverBaseType;
  798. SubType: TResolverBaseType; // for btSet and btRange
  799. IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
  800. TypeEl: TPasType; // can be nil for const expression
  801. ExprEl: TPasExpr;
  802. Flags: TPasResolverResultFlags;
  803. end;
  804. PPasResolvedElement = ^TPasResolverResult;
  805. type
  806. TPasResolverComputeFlag = (
  807. rcSkipTypeAlias,
  808. rcSetReferenceFlags, // set flags of references while computing type, used by Resolve* methods
  809. rcNoImplicitProc, // do not call a function without params, includes rcNoImplicitProcType
  810. rcNoImplicitProcType, // do not call a proc type without params
  811. rcConstant, // resolve a constant expresson
  812. rcType // resolve a type expression
  813. );
  814. TPasResolverComputeFlags = set of TPasResolverComputeFlag;
  815. TResElDataBuiltInSymbol = Class(TResolveData)
  816. public
  817. end;
  818. { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
  819. TResElDataBaseType = Class(TResElDataBuiltInSymbol)
  820. public
  821. BaseType: TResolverBaseType;
  822. end;
  823. TResElDataBaseTypeClass = class of TResElDataBaseType;
  824. TResElDataBuiltInProc = Class;
  825. TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
  826. Exp: TPasExpr; RaiseOnError: boolean): integer of object;
  827. TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  828. out ResolvedEl: TPasResolverResult) of object;
  829. TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  830. Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
  831. TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
  832. Params: TParamsExpr) of object;
  833. TBuiltInProcFlag = (
  834. bipfCanBeStatement // a call is enough for a simple statement
  835. );
  836. TBuiltInProcFlags = set of TBuiltInProcFlag;
  837. { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
  838. TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
  839. public
  840. Proc: TPasUnresolvedSymbolRef;
  841. Signature: string;
  842. BuiltIn: TResolverBuiltInProc;
  843. GetCallCompatibility: TOnGetCallCompatibility;
  844. GetCallResult: TOnGetCallResult;
  845. Eval: TOnEvalBIFunction;
  846. FinishParamsExpression: TOnFinishParamsExpr;
  847. Flags: TBuiltInProcFlags;
  848. end;
  849. { TPRFindData }
  850. TPRFindData = record
  851. ErrorPosEl: TPasElement;
  852. Found: TPasElement;
  853. ElScope: TPasScope; // Where Found was found
  854. StartScope: TPasScope; // where the searched started
  855. end;
  856. PPRFindData = ^TPRFindData;
  857. TPasResolverOption = (
  858. proFixCaseOfOverrides, // fix Name of overriding proc/property to the overriden proc/property
  859. proClassPropertyNonStatic, // class property accessors are non static
  860. proPropertyAsVarParam, // allows to pass a property as a var/out argument
  861. proClassOfIs, // class-of supports is and as operator
  862. proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
  863. proOpenAsDynArrays, // open arrays work like dynamic arrays
  864. //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
  865. //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
  866. proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
  867. proMethodAddrAsPointer // can assign @method to a pointer
  868. );
  869. TPasResolverOptions = set of TPasResolverOption;
  870. TPasResolverStep = (
  871. prsInit,
  872. prsParsing,
  873. prsFinishingModule,
  874. prsFinishedModule
  875. );
  876. TPasResolverSteps = set of TPasResolverStep;
  877. { TPasResolver }
  878. TPasResolver = Class(TPasTreeContainer)
  879. private
  880. type
  881. TResolveDataListKind = (lkBuiltIn,lkModule);
  882. function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
  883. function GetScopes(Index: integer): TPasScope; inline;
  884. private
  885. FAnonymousElTypePostfix: String;
  886. FBaseTypeChar: TResolverBaseType;
  887. FBaseTypeExtended: TResolverBaseType;
  888. FBaseTypeLength: TResolverBaseType;
  889. FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
  890. FBaseTypeString: TResolverBaseType;
  891. FDefaultNameSpace: String;
  892. FDefaultScope: TPasDefaultScope;
  893. FDynArrayMaxIndex: int64;
  894. FDynArrayMinIndex: int64;
  895. FLastCreatedData: array[TResolveDataListKind] of TResolveData;
  896. FLastElement: TPasElement;
  897. FLastMsg: string;
  898. FLastMsgArgs: TMessageArgs;
  899. FLastMsgElement: TPasElement;
  900. FLastMsgId: int64;
  901. FLastMsgNumber: integer;
  902. FLastMsgPattern: string;
  903. FLastMsgType: TMessageType;
  904. FLastSourcePos: TPasSourcePos;
  905. FOptions: TPasResolverOptions;
  906. FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
  907. FRootElement: TPasModule;
  908. FScopeClass_Class: TPasClassScopeClass;
  909. FScopeClass_Proc: TPasProcedureScopeClass;
  910. FScopeClass_WithExpr: TPasWithExprScopeClass;
  911. FScopeCount: integer;
  912. FScopes: array of TPasScope; // stack of scopes
  913. FStep: TPasResolverStep;
  914. FStoreSrcColumns: boolean;
  915. FSubScopeCount: integer;
  916. FSubScopes: array of TPasScope; // stack of scopes
  917. FTopScope: TPasScope;
  918. procedure ClearResolveDataList(Kind: TResolveDataListKind);
  919. function GetBaseTypeNames(bt: TResolverBaseType): string;
  920. protected
  921. const
  922. cExact = 0;
  923. cCompatible = cExact+1;
  924. cIntToIntConversion = ord(High(TResolverBaseType));
  925. cToFloatConversion = 2*cIntToIntConversion;
  926. cTypeConversion = cExact+10000; // e.g. TObject to Pointer
  927. cLossyConversion = cExact+100000;
  928. cCompatibleWithDefaultParams = cLossyConversion+100000;
  929. cIncompatible = High(integer);
  930. type
  931. TFindCallElData = record
  932. Params: TParamsExpr;
  933. Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
  934. LastProc: TPasProcedure;
  935. ElScope, StartScope: TPasScope;
  936. Distance: integer; // compatibility distance
  937. Count: integer;
  938. List: TFPList; // if not nil then collect all found elements here
  939. end;
  940. PFindCallElData = ^TFindCallElData;
  941. TFindOverloadProcKind = (
  942. fopkSameSignature, // search method declaration for a body
  943. fopkProc, // check overloads for a proc
  944. fopkMethod // check overloads for a method
  945. );
  946. TFindOverloadProcData = record
  947. Proc: TPasProcedure;
  948. Args: TFPList; // List of TPasArgument objects
  949. Kind: TFindOverloadProcKind;
  950. OnlyScope: TPasScope;
  951. FoundOverloadModifier: boolean;
  952. FoundInSameScope: integer;
  953. Found: TPasProcedure;
  954. ElScope, StartScope: TPasScope;
  955. FoundNonProc: TPasElement;
  956. end;
  957. PFindOverloadProcData = ^TFindOverloadProcData;
  958. procedure OnFindFirstElement(El: TPasElement; ElScope, StartScope: TPasScope;
  959. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  960. procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
  961. FindProcsData: Pointer; var Abort: boolean); virtual;
  962. procedure OnFindOverloadProc(El: TPasElement; ElScope, StartScope: TPasScope;
  963. FindOverloadData: Pointer; var Abort: boolean); virtual;
  964. function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
  965. function FindProcOverload(const ProcName: string; Proc: TPasProcedure;
  966. OnlyScope: TPasScope): TPasProcedure;
  967. protected
  968. procedure SetCurrentParser(AValue: TPasParser); override;
  969. procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
  970. function AddIdentifier(Scope: TPasIdentifierScope;
  971. const aName: String; El: TPasElement;
  972. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  973. procedure AddModule(El: TPasModule); virtual;
  974. procedure AddSection(El: TPasSection); virtual;
  975. procedure AddType(El: TPasType); virtual;
  976. procedure AddRecordType(El: TPasRecordType); virtual;
  977. procedure AddClassType(El: TPasClassType); virtual;
  978. procedure AddVariable(El: TPasVariable); virtual;
  979. procedure AddResourceString(El: TPasResString); virtual;
  980. procedure AddEnumType(El: TPasEnumType); virtual;
  981. procedure AddEnumValue(El: TPasEnumValue); virtual;
  982. procedure AddProperty(El: TPasProperty); virtual;
  983. procedure AddProcedure(El: TPasProcedure); virtual;
  984. procedure AddProcedureBody(El: TProcedureBody); virtual;
  985. procedure AddArgument(El: TPasArgument); virtual;
  986. procedure AddFunctionResult(El: TPasResultElement); virtual;
  987. procedure AddExceptOn(El: TPasImplExceptOn); virtual;
  988. procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
  989. procedure ResolveImplElement(El: TPasImplElement); virtual;
  990. procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
  991. procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
  992. procedure ResolveImplForLoop(Loop: TPasImplForLoop); virtual;
  993. procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
  994. procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
  995. procedure ResolveImplAssign(El: TPasImplAssign); virtual;
  996. procedure ResolveImplSimple(El: TPasImplSimple); virtual;
  997. procedure ResolveImplRaise(El: TPasImplRaise); virtual;
  998. procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
  999. procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
  1000. procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
  1001. procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
  1002. procedure ResolveInheritedCall(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1003. procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1004. procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1005. procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1006. procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1007. procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1008. procedure ResolveArrayParamsArgs(Params: TParamsExpr;
  1009. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
  1010. function ResolveBracketOperatorClass(Params: TParamsExpr;
  1011. const ResolvedValue: TPasResolverResult; ClassScope: TPasClassScope;
  1012. Access: TResolvedRefAccess): boolean; virtual;
  1013. procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
  1014. procedure ResolveArrayValues(El: TArrayValues); virtual;
  1015. procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
  1016. Access: TResolvedRefAccess); virtual;
  1017. procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
  1018. procedure FinishModule(CurModule: TPasModule); virtual;
  1019. procedure FinishUsesClause; virtual;
  1020. procedure FinishSection(Section: TPasSection); virtual;
  1021. procedure FinishInterfaceSection(Section: TPasSection); virtual;
  1022. procedure FinishTypeSection(El: TPasDeclarations); virtual;
  1023. procedure FinishTypeDef(El: TPasType); virtual;
  1024. procedure FinishEnumType(El: TPasEnumType); virtual;
  1025. procedure FinishSetType(El: TPasSetType); virtual;
  1026. procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
  1027. procedure FinishRangeType(El: TPasRangeType); virtual;
  1028. procedure FinishConstRangeExpr(RangeExpr: TBinaryExpr;
  1029. out LeftResolved, RightResolved: TPasResolverResult);
  1030. procedure FinishRecordType(El: TPasRecordType); virtual;
  1031. procedure FinishClassType(El: TPasClassType); virtual;
  1032. procedure FinishClassOfType(El: TPasClassOfType); virtual;
  1033. procedure FinishArrayType(El: TPasArrayType); virtual;
  1034. procedure FinishConstDef(El: TPasConst); virtual;
  1035. procedure FinishResourcestring(El: TPasResString); virtual;
  1036. procedure FinishProcedure(aProc: TPasProcedure); virtual;
  1037. procedure FinishProcedureType(El: TPasProcedureType); virtual;
  1038. procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
  1039. procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
  1040. procedure FinishExceptOnExpr; virtual;
  1041. procedure FinishExceptOnStatement; virtual;
  1042. procedure FinishDeclaration(El: TPasElement); virtual;
  1043. procedure FinishVariable(El: TPasVariable); virtual;
  1044. procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
  1045. procedure FinishArgument(El: TPasArgument); virtual;
  1046. procedure FinishAncestors(aClass: TPasClassType); virtual;
  1047. procedure FinishPropertyParamAccess(Params: TParamsExpr;
  1048. Prop: TPasProperty);
  1049. procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess);
  1050. procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
  1051. function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
  1052. procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  1053. procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
  1054. procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
  1055. procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure; CheckNames: boolean);
  1056. procedure CheckPendingForwardProcs(El: TPasElement);
  1057. procedure ComputeBinaryExpr(Bin: TBinaryExpr;
  1058. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1059. StartEl: TPasElement);
  1060. procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
  1061. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1062. var LeftResolved, RightResolved: TPasResolverResult); virtual;
  1063. procedure ComputeArrayParams(Params: TParamsExpr;
  1064. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1065. StartEl: TPasElement);
  1066. procedure ComputeArrayParams_Class(Params: TParamsExpr;
  1067. var ResolvedEl: TPasResolverResult; ClassScope: TPasClassScope;
  1068. Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
  1069. procedure ComputeFuncParams(Params: TParamsExpr;
  1070. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1071. StartEl: TPasElement);
  1072. procedure ComputeSetParams(Params: TParamsExpr;
  1073. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1074. StartEl: TPasElement);
  1075. procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
  1076. function CheckTypeCastClassInstanceToClass(
  1077. const FromClassRes, ToClassRes: TPasResolverResult;
  1078. ErrorEl: TPasElement): integer; virtual;
  1079. procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
  1080. const LHS, RHS: TPasResolverResult);
  1081. function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
  1082. ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
  1083. procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
  1084. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  1085. procedure ConvertRangeToElement(var ResolvedEl: TPasResolverResult);
  1086. function IsCharLiteral(const Value: string; ErrorPos: TPasElement): TResolverBaseType; virtual;
  1087. function CheckForInClass(Loop: TPasImplForLoop;
  1088. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1089. function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
  1090. MinCount: integer; RaiseOnError: boolean): boolean;
  1091. function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1092. MaxCount: integer; RaiseOnError: boolean): integer;
  1093. function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
  1094. const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
  1095. function FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  1096. function FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  1097. procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
  1098. Params: TParamsExpr); virtual;
  1099. function FindExceptionConstructor(const aUnitName, aClassName: string;
  1100. out aClass: TPasClassType; out aConstructor: TPasConstructor;
  1101. ErrorEl: TPasElement): boolean; virtual;
  1102. procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
  1103. procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
  1104. protected
  1105. fExprEvaluator: TResExprEvaluator;
  1106. procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: int64;
  1107. MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
  1108. Args: array of const; PosEl: TPasElement); virtual;
  1109. function OnExprEvalIdentifier(Sender: TResExprEvaluator;
  1110. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1111. function OnExprEvalParams(Sender: TResExprEvaluator;
  1112. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1113. function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
  1114. protected
  1115. // custom types (added by descendant resolvers)
  1116. function CheckAssignCompatibilityCustom(
  1117. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1118. RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
  1119. function CheckEqualCompatibilityCustomType(
  1120. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1121. RaiseOnIncompatible: boolean): integer; virtual;
  1122. protected
  1123. // built-in functions
  1124. function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1125. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1126. procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1127. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1128. procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  1129. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1130. function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1131. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1132. procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1133. Params: TParamsExpr); virtual;
  1134. function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1135. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1136. procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1137. Params: TParamsExpr); virtual;
  1138. function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1139. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1140. function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1141. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1142. function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1143. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1144. function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1145. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1146. procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1147. Params: TParamsExpr); virtual;
  1148. function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1149. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1150. procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1151. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1152. procedure BI_Assigned_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1153. Params: TParamsExpr); virtual;
  1154. function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1155. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1156. procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1157. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1158. procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  1159. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1160. function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1161. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1162. procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1163. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1164. procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  1165. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1166. function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1167. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1168. procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1169. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1170. procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  1171. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1172. function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1173. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1174. procedure BI_PredSucc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
  1175. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1176. procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  1177. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1178. function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  1179. const ParamResolved: TPasResolverResult; ArgNo: integer;
  1180. RaiseOnError: boolean): integer;
  1181. function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1182. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1183. procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1184. Params: TParamsExpr); virtual;
  1185. function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1186. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1187. procedure BI_StrFunc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
  1188. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1189. procedure BI_StrFunc_OnEval({%H-}Proc: TResElDataBuiltInProc;
  1190. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1191. function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1192. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1193. procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
  1194. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1195. function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1196. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1197. procedure BI_CopyArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
  1198. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1199. function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1200. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1201. procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1202. Params: TParamsExpr); virtual;
  1203. function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1204. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1205. procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1206. Params: TParamsExpr); virtual;
  1207. function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1208. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1209. procedure BI_TypeInfo_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
  1210. {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1211. function BI_Assert_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1212. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1213. procedure BI_Assert_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1214. Params: TParamsExpr); virtual;
  1215. public
  1216. constructor Create;
  1217. destructor Destroy; override;
  1218. procedure Clear; virtual; // does not free built-in identifiers
  1219. // overrides of TPasTreeContainer
  1220. function CreateElement(AClass: TPTreeElement; const AName: String;
  1221. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1222. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1223. overload; override;
  1224. function CreateElement(AClass: TPTreeElement; const AName: String;
  1225. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1226. const ASrcPos: TPasSourcePos): TPasElement;
  1227. overload; override;
  1228. function FindElement(const aName: String): TPasElement; override; // used by TPasParser
  1229. function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
  1230. NoProcsWithArgs: boolean): TPasElement;
  1231. function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
  1232. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  1233. procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  1234. procedure IterateElements(const aName: string;
  1235. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1236. var Abort: boolean); virtual;
  1237. procedure CheckFoundElement(const FindData: TPRFindData;
  1238. Ref: TResolvedReference); virtual;
  1239. function GetVisibilityContext: TPasElement;
  1240. procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1241. function IsUnitIntfFinished(AModule: TPasModule): boolean;
  1242. function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
  1243. procedure CheckPendingUsedInterface(Section: TPasSection); override;
  1244. procedure ContinueParsing; virtual;
  1245. function NeedArrayValues(El: TPasElement): boolean; override;
  1246. function GetDefaultClassVisibility(AClass: TPasClassType
  1247. ): TPasMemberVisibility; override;
  1248. // built in types and functions
  1249. procedure ClearBuiltInIdentifiers; virtual;
  1250. procedure AddObjFPCBuiltInIdentifiers(
  1251. const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
  1252. const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
  1253. function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
  1254. function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  1255. function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
  1256. function AddBuiltInProc(const aName: string; Signature: string;
  1257. const GetCallCompatibility: TOnGetCallCompatibility;
  1258. const GetCallResult: TOnGetCallResult;
  1259. const EvalConst: TOnEvalBIFunction = nil;
  1260. const FinishParamsExpr: TOnFinishParamsExpr = nil;
  1261. const BuiltIn: TResolverBuiltInProc = bfCustom;
  1262. const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
  1263. // add extra TResolveData (E.CustomData) to free list
  1264. procedure AddResolveData(El: TPasElement; Data: TResolveData;
  1265. Kind: TResolveDataListKind);
  1266. function CreateReference(DeclEl, RefEl: TPasElement;
  1267. Access: TResolvedRefAccess;
  1268. FindData: PPRFindData = nil): TResolvedReference; virtual;
  1269. // scopes
  1270. function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
  1271. procedure PopScope;
  1272. procedure PushScope(Scope: TPasScope); overload;
  1273. function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
  1274. function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  1275. function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
  1276. function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
  1277. function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
  1278. procedure ResetSubScopes(out Depth: integer);
  1279. procedure RestoreSubScopes(Depth: integer);
  1280. function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
  1281. // log and messages
  1282. class procedure UnmangleSourceLineNumber(LineNumber: integer;
  1283. out Line, Column: integer);
  1284. class function GetDbgSourcePosStr(El: TPasElement): string;
  1285. function GetElementSourcePosStr(El: TPasElement): string;
  1286. procedure SetLastMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
  1287. Const Fmt : String; Args : Array of const; PosEl: TPasElement);
  1288. procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
  1289. const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
  1290. procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String;
  1291. Args: Array of const; ErrorPosEl: TPasElement);
  1292. procedure RaiseNotYetImplemented(id: int64; El: TPasElement; Msg: string = ''); virtual;
  1293. procedure RaiseInternalError(id: int64; const Msg: string = '');
  1294. procedure RaiseInvalidScopeForElement(id: int64; El: TPasElement; const Msg: string = '');
  1295. procedure RaiseIdentifierNotFound(id: int64; Identifier: string; El: TPasElement);
  1296. procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
  1297. procedure RaiseContextXExpectedButYFound(id: int64; const C,X,Y: string; El: TPasElement);
  1298. procedure RaiseContextXInvalidY(id: int64; const X,Y: string; El: TPasElement);
  1299. procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
  1300. procedure RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
  1301. procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
  1302. const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  1303. procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
  1304. const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
  1305. procedure RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
  1306. const Args: array of const; const GotType, ExpType: TPasResolverResult;
  1307. ErrorEl: TPasElement);
  1308. procedure RaiseInvalidProcTypeModifier(id: int64; ProcType: TPasProcedureType;
  1309. ptm: TProcTypeModifier; ErrorEl: TPasElement);
  1310. procedure RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
  1311. pm: TProcedureModifier; ErrorEl: TPasElement);
  1312. procedure WriteScopes;
  1313. // find value and type of an element
  1314. procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
  1315. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1316. function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue;
  1317. function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue;
  1318. // checking compatibilility
  1319. function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: boolean = false): boolean; // check if it is exactly the same
  1320. function CheckCallProcCompatibility(ProcType: TPasProcedureType;
  1321. Params: TParamsExpr; RaiseOnError: boolean;
  1322. SetReferenceFlags: boolean = false): integer;
  1323. function CheckCallPropertyCompatibility(PropEl: TPasProperty;
  1324. Params: TParamsExpr; RaiseOnError: boolean): integer;
  1325. function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  1326. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
  1327. function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
  1328. ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  1329. function CheckAssignCompatibilityUserType(
  1330. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1331. RaiseOnIncompatible: boolean): integer;
  1332. function CheckAssignCompatibilityArrayType(
  1333. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1334. RaiseOnIncompatible: boolean): integer;
  1335. function CheckConstArrayCompatibility(Params: TParamsExpr;
  1336. const ArrayResolved: TPasResolverResult; RaiseOnError: boolean;
  1337. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil): integer;
  1338. function CheckEqualCompatibilityUserType(
  1339. const TypeA, TypeB: TPasResolverResult; ErrorEl: TPasElement;
  1340. RaiseOnIncompatible: boolean): integer;
  1341. function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
  1342. function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
  1343. ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
  1344. function CheckTypeCastArray(FromType, ToType: TPasArrayType;
  1345. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  1346. function CheckSrcIsADstType(
  1347. const ResolvedSrcType, ResolvedDestType: TPasResolverResult;
  1348. ErrorEl: TPasElement): integer;
  1349. function CheckClassIsClass(SrcType, DestType: TPasType;
  1350. ErrorEl: TPasElement): integer; virtual;
  1351. function CheckClassesAreRelated(TypeA, TypeB: TPasType;
  1352. ErrorEl: TPasElement): integer;
  1353. function CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  1354. function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
  1355. IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
  1356. function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
  1357. function CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType): boolean;
  1358. function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  1359. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  1360. function CheckAssignCompatibility(const LHS, RHS: TPasElement;
  1361. RaiseOnIncompatible: boolean = true): integer;
  1362. procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  1363. procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
  1364. RValue: TResEvalValue; RHS: TPasExpr); virtual;
  1365. function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
  1366. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  1367. function CheckEqualElCompatibility(Left, Right: TPasElement;
  1368. ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  1369. SetReferenceFlags: boolean = false): integer;
  1370. function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
  1371. LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  1372. RErrorEl: TPasElement = nil): integer;
  1373. function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
  1374. function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
  1375. // uility functions
  1376. property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
  1377. function GetProcTypeDescription(ProcType: TPasProcedureType; UseName: boolean = true; AddPaths: boolean = false): string;
  1378. function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
  1379. function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
  1380. function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  1381. function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  1382. function GetPasPropertyType(El: TPasProperty): TPasType;
  1383. function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
  1384. function GetPasPropertyGetter(El: TPasProperty): TPasElement;
  1385. function GetPasPropertySetter(El: TPasProperty): TPasElement;
  1386. function GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  1387. function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  1388. function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
  1389. function GetLoop(El: TPasElement): TPasImplElement;
  1390. function ResolveAliasType(aType: TPasType): TPasType;
  1391. function ResolveAliasTypeEl(El: TPasElement): TPasType; inline;
  1392. function ExprIsAddrTarget(El: TPasExpr): boolean;
  1393. function IsNameExpr(El: TPasExpr): boolean; inline; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
  1394. function GetNameExprValue(El: TPasExpr): string; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
  1395. function GetNextDottedExpr(El: TPasExpr): TPasExpr;
  1396. function GetPathStart(El: TPasExpr): TPasExpr;
  1397. function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  1398. function ParentNeedsExprResult(El: TPasExpr): boolean;
  1399. function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
  1400. function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
  1401. function IsOpenArray(TypeEl: TPasType): boolean;
  1402. function IsDynOrOpenArray(TypeEl: TPasType): boolean;
  1403. function IsVarInit(Expr: TPasExpr): boolean;
  1404. function IsEmptySet(const ResolvedEl: TPasResolverResult): boolean;
  1405. function IsClassMethod(El: TPasElement): boolean;
  1406. function IsExternalClassName(aClass: TPasClassType; const ExtName: string): boolean;
  1407. function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
  1408. function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
  1409. function IsTypeCast(Params: TParamsExpr): boolean;
  1410. function ProcNeedsParams(El: TPasProcedureType): boolean;
  1411. function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
  1412. function GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
  1413. function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  1414. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
  1415. function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
  1416. function HasTypeInfo(El: TPasType): boolean; virtual;
  1417. function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
  1418. function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1419. function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1420. procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
  1421. function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: MaxPrecInt): boolean;
  1422. function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
  1423. function GetSmallestIntegerBaseType(MinVal, MaxVal: MaxPrecInt): TResolverBaseType;
  1424. function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1425. function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  1426. function IsElementSkipped(El: TPasElement): boolean; virtual;
  1427. public
  1428. // options
  1429. property Options: TPasResolverOptions read FOptions write FOptions;
  1430. property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
  1431. write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
  1432. property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
  1433. property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
  1434. property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
  1435. property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
  1436. property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
  1437. property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
  1438. property DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex;
  1439. property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
  1440. // parsed values
  1441. property DefaultNameSpace: String read FDefaultNameSpace;
  1442. property RootElement: TPasModule read FRootElement;
  1443. property Step: TPasResolverStep read FStep;
  1444. // scopes
  1445. property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
  1446. If true Line and Column is mangled together in TPasElement.SourceLineNumber.
  1447. Use method UnmangleSourceLineNumber to extract. }
  1448. property Scopes[Index: integer]: TPasScope read GetScopes;
  1449. property ScopeCount: integer read FScopeCount;
  1450. property TopScope: TPasScope read FTopScope;
  1451. property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
  1452. property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
  1453. property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
  1454. property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
  1455. // last element
  1456. property LastElement: TPasElement read FLastElement;
  1457. property LastMsg: string read FLastMsg write FLastMsg;
  1458. property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
  1459. property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
  1460. property LastMsgId: int64 read FLastMsgId write FLastMsgId;
  1461. property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
  1462. property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
  1463. property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
  1464. property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
  1465. end;
  1466. function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
  1467. function GetResolverResultDbg(const T: TPasResolverResult): string;
  1468. function GetClassAncestorsDbg(El: TPasClassType): string;
  1469. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  1470. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  1471. BaseType: TResolverBaseType; IdentEl: TPasElement;
  1472. TypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
  1473. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  1474. BaseType: TResolverBaseType; TypeEl: TPasType;
  1475. Flags: TPasResolverResultFlags); overload;
  1476. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  1477. BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
  1478. Flags: TPasResolverResultFlags); overload;
  1479. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  1480. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  1481. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  1482. function ChompDottedIdentifier(const Identifier: string): string;
  1483. function FirstDottedIdentifier(const Identifier: string): string;
  1484. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  1485. {$IF FPC_FULLVERSION<30101}
  1486. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  1487. {$ENDIF}
  1488. function NoNil(o: TObject): TObject;
  1489. function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
  1490. function dbgs(const a: TResolvedRefAccess): string;
  1491. function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
  1492. implementation
  1493. function GetTreeDbg(El: TPasElement; Indent: integer): string;
  1494. procedure LineBreak(SubIndent: integer);
  1495. begin
  1496. Inc(Indent,SubIndent);
  1497. Result:=Result+LineEnding+Space(Indent);
  1498. end;
  1499. var
  1500. i, l: Integer;
  1501. begin
  1502. if El=nil then exit('nil');
  1503. Result:=El.Name+':'+El.ClassName+'=';
  1504. if El is TPasExpr then
  1505. begin
  1506. if El.ClassType<>TBinaryExpr then
  1507. Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
  1508. if El.ClassType=TUnaryExpr then
  1509. Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
  1510. else if El.ClassType=TBinaryExpr then
  1511. Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
  1512. +OpcodeStrings[TPasExpr(El).OpCode]
  1513. +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
  1514. else if El.ClassType=TPrimitiveExpr then
  1515. Result:=Result+TPrimitiveExpr(El).Value
  1516. else if El.ClassType=TBoolConstExpr then
  1517. Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
  1518. else if El.ClassType=TNilExpr then
  1519. Result:=Result+'nil'
  1520. else if El.ClassType=TInheritedExpr then
  1521. Result:=Result+'inherited'
  1522. else if El.ClassType=TSelfExpr then
  1523. Result:=Result+'Self'
  1524. else if El.ClassType=TParamsExpr then
  1525. begin
  1526. LineBreak(2);
  1527. Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
  1528. l:=length(TParamsExpr(El).Params);
  1529. if l>0 then
  1530. begin
  1531. inc(Indent,2);
  1532. for i:=0 to l-1 do
  1533. begin
  1534. LineBreak(0);
  1535. Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
  1536. if i<l-1 then
  1537. Result:=Result+','
  1538. end;
  1539. dec(Indent,2);
  1540. end;
  1541. Result:=Result+')';
  1542. end
  1543. else if El.ClassType=TRecordValues then
  1544. begin
  1545. Result:=Result+'(';
  1546. l:=length(TRecordValues(El).Fields);
  1547. if l>0 then
  1548. begin
  1549. inc(Indent,2);
  1550. for i:=0 to l-1 do
  1551. begin
  1552. LineBreak(0);
  1553. Result:=Result+TRecordValues(El).Fields[i].Name+':'
  1554. +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
  1555. if i<l-1 then
  1556. Result:=Result+','
  1557. end;
  1558. dec(Indent,2);
  1559. end;
  1560. Result:=Result+')';
  1561. end
  1562. else if El.ClassType=TArrayValues then
  1563. begin
  1564. Result:=Result+'[';
  1565. l:=length(TArrayValues(El).Values);
  1566. if l>0 then
  1567. begin
  1568. inc(Indent,2);
  1569. for i:=0 to l-1 do
  1570. begin
  1571. LineBreak(0);
  1572. Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
  1573. if i<l-1 then
  1574. Result:=Result+','
  1575. end;
  1576. dec(Indent,2);
  1577. end;
  1578. Result:=Result+']';
  1579. end;
  1580. end
  1581. else if El is TPasProcedure then
  1582. begin
  1583. Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
  1584. end
  1585. else if El is TPasProcedureType then
  1586. begin
  1587. if TPasProcedureType(El).IsReferenceTo then
  1588. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  1589. Result:=Result+'(';
  1590. l:=TPasProcedureType(El).Args.Count;
  1591. if l>0 then
  1592. begin
  1593. inc(Indent,2);
  1594. for i:=0 to l-1 do
  1595. begin
  1596. LineBreak(0);
  1597. Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
  1598. if i<l-1 then
  1599. Result:=Result+';'
  1600. end;
  1601. dec(Indent,2);
  1602. end;
  1603. Result:=Result+')';
  1604. if El is TPasFunction then
  1605. Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
  1606. if TPasProcedureType(El).IsOfObject then
  1607. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  1608. if TPasProcedureType(El).IsNested then
  1609. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  1610. if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
  1611. Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
  1612. end
  1613. else if El.ClassType=TPasResultElement then
  1614. Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
  1615. else if El.ClassType=TPasArgument then
  1616. begin
  1617. if AccessNames[TPasArgument(El).Access]<>'' then
  1618. Result:=Result+AccessNames[TPasArgument(El).Access];
  1619. if TPasArgument(El).ArgType=nil then
  1620. Result:=Result+'untyped'
  1621. else
  1622. Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
  1623. end
  1624. else if El.ClassType=TPasUnresolvedSymbolRef then
  1625. begin
  1626. if El.CustomData is TResElDataBuiltInProc then
  1627. Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
  1628. end;
  1629. end;
  1630. function GetResolverResultDbg(const T: TPasResolverResult): string;
  1631. begin
  1632. Result:='[bt='+ResBaseTypeNames[T.BaseType];
  1633. if T.SubType<>btNone then
  1634. Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
  1635. Result:=Result
  1636. +' Ident='+GetObjName(T.IdentEl)
  1637. +' Type='+GetObjName(T.TypeEl)
  1638. +' Expr='+GetObjName(T.ExprEl)
  1639. +' Flags='+ResolverResultFlagsToStr(T.Flags)
  1640. +']';
  1641. end;
  1642. function GetClassAncestorsDbg(El: TPasClassType): string;
  1643. function GetClassDesc(C: TPasClassType): string;
  1644. var
  1645. Module: TPasModule;
  1646. begin
  1647. if C.IsExternal then
  1648. Result:='class external '
  1649. else
  1650. Result:='class ';
  1651. Module:=C.GetModule;
  1652. if Module<>nil then
  1653. Result:=Result+Module.Name+'.';
  1654. Result:=Result+C.FullName;
  1655. end;
  1656. var
  1657. Scope, AncestorScope: TPasClassScope;
  1658. AncestorEl: TPasClassType;
  1659. begin
  1660. if El=nil then exit('nil');
  1661. Result:=GetClassDesc(El);
  1662. if El.CustomData is TPasClassScope then
  1663. begin
  1664. Scope:=TPasClassScope(El.CustomData);
  1665. AncestorScope:=Scope.AncestorScope;
  1666. while AncestorScope<>nil do
  1667. begin
  1668. Result:=Result+LineEnding+' ';
  1669. AncestorEl:=NoNil(AncestorScope.Element) as TPasClassType;
  1670. Result:=Result+GetClassDesc(AncestorEl);
  1671. AncestorScope:=AncestorScope.AncestorScope;
  1672. end;
  1673. end;
  1674. end;
  1675. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  1676. var
  1677. f: TPasResolverResultFlag;
  1678. s: string;
  1679. begin
  1680. Result:='';
  1681. for f in Flags do
  1682. begin
  1683. if Result<>'' then Result:=Result+',';
  1684. str(f,s);
  1685. Result:=Result+s;
  1686. end;
  1687. Result:='['+Result+']';
  1688. end;
  1689. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  1690. BaseType: TResolverBaseType; IdentEl: TPasElement; TypeEl: TPasType;
  1691. Flags: TPasResolverResultFlags);
  1692. begin
  1693. if IdentEl is TPasExpr then
  1694. raise Exception.Create('20170729101017');
  1695. ResolvedType.BaseType:=BaseType;
  1696. ResolvedType.SubType:=btNone;
  1697. ResolvedType.IdentEl:=IdentEl;
  1698. ResolvedType.TypeEl:=TypeEl;
  1699. ResolvedType.ExprEl:=nil;
  1700. ResolvedType.Flags:=Flags;
  1701. end;
  1702. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  1703. BaseType: TResolverBaseType; TypeEl: TPasType; Flags: TPasResolverResultFlags
  1704. );
  1705. begin
  1706. ResolvedType.BaseType:=BaseType;
  1707. ResolvedType.SubType:=btNone;
  1708. ResolvedType.IdentEl:=nil;
  1709. ResolvedType.TypeEl:=TypeEl;
  1710. ResolvedType.ExprEl:=nil;
  1711. ResolvedType.Flags:=Flags;
  1712. end;
  1713. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  1714. BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
  1715. Flags: TPasResolverResultFlags);
  1716. begin
  1717. ResolvedType.BaseType:=BaseType;
  1718. ResolvedType.SubType:=btNone;
  1719. ResolvedType.IdentEl:=nil;
  1720. ResolvedType.TypeEl:=TypeEl;
  1721. ResolvedType.ExprEl:=ExprEl;
  1722. ResolvedType.Flags:=Flags;
  1723. end;
  1724. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  1725. begin
  1726. Result:=true;
  1727. if Proc.IsExternal then exit(false);
  1728. if Proc.IsForward then exit;
  1729. if Proc.Parent.ClassType=TInterfaceSection then exit;
  1730. if Proc.Parent.ClassType=TPasClassType then
  1731. begin
  1732. // a method declaration
  1733. if not Proc.IsAbstract then exit;
  1734. end;
  1735. Result:=false;
  1736. end;
  1737. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  1738. var
  1739. C: TClass;
  1740. begin
  1741. if Proc.IsForward or Proc.IsExternal then exit(false);
  1742. C:=Proc.Parent.ClassType;
  1743. if (C=TInterfaceSection) or C.InheritsFrom(TPasClassType) then exit(false);
  1744. Result:=true;
  1745. end;
  1746. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  1747. var
  1748. Data: TObject;
  1749. begin
  1750. if Proc.IsOverload then
  1751. exit(true);
  1752. Data:=Proc.CustomData;
  1753. Result:=(Data is TPasProcedureScope)
  1754. and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
  1755. end;
  1756. function ChompDottedIdentifier(const Identifier: string): string;
  1757. var
  1758. p: Integer;
  1759. begin
  1760. Result:=Identifier;
  1761. p:=length(Identifier);
  1762. while (p>0) do
  1763. begin
  1764. if Identifier[p]='.' then
  1765. break;
  1766. dec(p);
  1767. end;
  1768. Result:=LeftStr(Identifier,p-1);
  1769. end;
  1770. function FirstDottedIdentifier(const Identifier: string): string;
  1771. var
  1772. p: SizeInt;
  1773. begin
  1774. p:=Pos('.',Identifier);
  1775. if p<1 then
  1776. Result:=Identifier
  1777. else
  1778. Result:=LeftStr(Identifier,p-1);
  1779. end;
  1780. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  1781. var
  1782. l: Integer;
  1783. begin
  1784. l:=length(Prefix);
  1785. if (l>length(Identifier))
  1786. or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
  1787. exit(false);
  1788. Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
  1789. end;
  1790. function NoNil(o: TObject): TObject;
  1791. begin
  1792. if o=nil then
  1793. raise Exception.Create('');
  1794. Result:=o;
  1795. end;
  1796. {$IF FPC_FULLVERSION<30101}
  1797. function IsValidIdent(const Ident: string; AllowDots: Boolean;
  1798. StrictDots: Boolean): Boolean;
  1799. const
  1800. Alpha = ['A'..'Z', 'a'..'z', '_'];
  1801. AlphaNum = Alpha + ['0'..'9'];
  1802. Dot = '.';
  1803. var
  1804. First: Boolean;
  1805. I, Len: Integer;
  1806. begin
  1807. Len := Length(Ident);
  1808. if Len < 1 then
  1809. Exit(False);
  1810. First := True;
  1811. for I := 1 to Len do
  1812. begin
  1813. if First then
  1814. begin
  1815. Result := Ident[I] in Alpha;
  1816. First := False;
  1817. end
  1818. else if AllowDots and (Ident[I] = Dot) then
  1819. begin
  1820. if StrictDots then
  1821. begin
  1822. Result := I < Len;
  1823. First := True;
  1824. end;
  1825. end
  1826. else
  1827. Result := Ident[I] in AlphaNum;
  1828. if not Result then
  1829. Break;
  1830. end;
  1831. end;
  1832. {$ENDIF}
  1833. function dbgs(const Flags: TPasResolverComputeFlags): string;
  1834. var
  1835. s: string;
  1836. f: TPasResolverComputeFlag;
  1837. begin
  1838. Result:='';
  1839. for f in Flags do
  1840. if f in Flags then
  1841. begin
  1842. if Result<>'' then Result:=Result+',';
  1843. str(f,s);
  1844. Result:=Result+s;
  1845. end;
  1846. Result:='['+Result+']';
  1847. end;
  1848. function dbgs(const a: TResolvedRefAccess): string;
  1849. begin
  1850. str(a,Result);
  1851. end;
  1852. function dbgs(const Flags: TResolvedReferenceFlags): string;
  1853. var
  1854. s: string;
  1855. f: TResolvedReferenceFlag;
  1856. begin
  1857. Result:='';
  1858. for f in Flags do
  1859. if f in Flags then
  1860. begin
  1861. if Result<>'' then Result:=Result+',';
  1862. str(f,s);
  1863. Result:=Result+s;
  1864. end;
  1865. Result:='['+Result+']';
  1866. end;
  1867. { TPasPropertyScope }
  1868. destructor TPasPropertyScope.Destroy;
  1869. begin
  1870. {$IFDEF VerbosePasResolverMem}
  1871. writeln('TPasPropertyScope.Destroy START ',ClassName);
  1872. {$ENDIF}
  1873. ReleaseAndNil(TPasElement(AncestorProp));
  1874. inherited Destroy;
  1875. {$IFDEF VerbosePasResolverMem}
  1876. writeln('TPasPropertyScope.Destroy END',ClassName);
  1877. {$ENDIF}
  1878. end;
  1879. { TPasEnumTypeScope }
  1880. destructor TPasEnumTypeScope.Destroy;
  1881. begin
  1882. {$IFDEF VerbosePasResolverMem}
  1883. writeln('TPasEnumTypeScope.Destroy START ',ClassName);
  1884. {$ENDIF}
  1885. ReleaseAndNil(TPasElement(CanonicalSet));
  1886. inherited Destroy;
  1887. {$IFDEF VerbosePasResolverMem}
  1888. writeln('TPasEnumTypeScope.Destroy END ',ClassName);
  1889. {$ENDIF}
  1890. end;
  1891. { TPasDotIdentifierScope }
  1892. function TPasDotIdentifierScope.FindIdentifier(const Identifier: String
  1893. ): TPasIdentifier;
  1894. begin
  1895. Result:=IdentifierScope.FindIdentifier(Identifier);
  1896. end;
  1897. procedure TPasDotIdentifierScope.IterateElements(const aName: string;
  1898. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  1899. Data: Pointer; var Abort: boolean);
  1900. begin
  1901. IdentifierScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  1902. end;
  1903. procedure TPasDotIdentifierScope.WriteIdentifiers(Prefix: string);
  1904. begin
  1905. IdentifierScope.WriteIdentifiers(Prefix);
  1906. end;
  1907. { TPasWithExprScope }
  1908. class function TPasWithExprScope.IsStoredInElement: boolean;
  1909. begin
  1910. Result:=false;
  1911. end;
  1912. class function TPasWithExprScope.FreeOnPop: boolean;
  1913. begin
  1914. Result:=false;
  1915. end;
  1916. procedure TPasWithExprScope.IterateElements(const aName: string;
  1917. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  1918. Data: Pointer; var Abort: boolean);
  1919. begin
  1920. Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  1921. end;
  1922. procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
  1923. begin
  1924. writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
  1925. Scope.WriteIdentifiers(Prefix);
  1926. end;
  1927. { TPasWithScope }
  1928. constructor TPasWithScope.Create;
  1929. begin
  1930. inherited Create;
  1931. ExpressionScopes:=TObjectList.Create(true);
  1932. end;
  1933. destructor TPasWithScope.Destroy;
  1934. begin
  1935. {$IFDEF VerbosePasResolverMem}
  1936. writeln('TPasWithScope.Destroy START ',ClassName);
  1937. {$ENDIF}
  1938. FreeAndNil(ExpressionScopes);
  1939. inherited Destroy;
  1940. {$IFDEF VerbosePasResolverMem}
  1941. writeln('TPasWithScope.Destroy END ',ClassName);
  1942. {$ENDIF}
  1943. end;
  1944. { TPasProcedureScope }
  1945. function TPasProcedureScope.FindIdentifier(const Identifier: String
  1946. ): TPasIdentifier;
  1947. begin
  1948. Result:=inherited FindIdentifier(Identifier);
  1949. if Result<>nil then exit;
  1950. if ClassScope<>nil then
  1951. Result:=ClassScope.FindIdentifier(Identifier);
  1952. end;
  1953. procedure TPasProcedureScope.IterateElements(const aName: string;
  1954. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  1955. Data: Pointer; var Abort: boolean);
  1956. begin
  1957. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  1958. if Abort then exit;
  1959. if ClassScope<>nil then
  1960. ClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  1961. end;
  1962. function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
  1963. var
  1964. Proc: TPasProcedure;
  1965. begin
  1966. Result:=Self;
  1967. repeat
  1968. if Result.ClassScope<>nil then exit;
  1969. Proc:=TPasProcedure(Element);
  1970. if not (Proc.Parent is TProcedureBody) then exit(nil);
  1971. Proc:=Proc.Parent.Parent as TPasProcedure;
  1972. Result:=TPasProcedureScope(Proc.CustomData);
  1973. until false;
  1974. end;
  1975. procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
  1976. begin
  1977. inherited WriteIdentifiers(Prefix);
  1978. if ClassScope<>nil then
  1979. ClassScope.WriteIdentifiers(Prefix+' ');
  1980. end;
  1981. destructor TPasProcedureScope.Destroy;
  1982. begin
  1983. {$IFDEF VerbosePasResolverMem}
  1984. writeln('TPasProcedureScope.Destroy START ',ClassName);
  1985. {$ENDIF}
  1986. inherited Destroy;
  1987. ReleaseAndNil(TPasElement(SelfArg));
  1988. {$IFDEF VerbosePasResolverMem}
  1989. writeln('TPasProcedureScope.Destroy END ',ClassName);
  1990. {$ENDIF}
  1991. end;
  1992. { TPasClassScope }
  1993. destructor TPasClassScope.Destroy;
  1994. begin
  1995. ReleaseAndNil(TPasElement(CanonicalClassOf));
  1996. inherited Destroy;
  1997. end;
  1998. function TPasClassScope.FindIdentifier(const Identifier: String
  1999. ): TPasIdentifier;
  2000. begin
  2001. Result:=inherited FindIdentifier(Identifier);
  2002. if Result<>nil then exit;
  2003. if AncestorScope<>nil then
  2004. Result:=AncestorScope.FindIdentifier(Identifier);
  2005. end;
  2006. procedure TPasClassScope.IterateElements(const aName: string;
  2007. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2008. Data: Pointer; var Abort: boolean);
  2009. begin
  2010. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2011. if Abort then exit;
  2012. if AncestorScope<>nil then
  2013. AncestorScope.IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
  2014. end;
  2015. procedure TPasClassScope.WriteIdentifiers(Prefix: string);
  2016. begin
  2017. inherited WriteIdentifiers(Prefix);
  2018. if AncestorScope<>nil then
  2019. AncestorScope.WriteIdentifiers(Prefix+' ');
  2020. end;
  2021. { TPasDotClassScope }
  2022. procedure TPasDotClassScope.SetClassScope(AValue: TPasClassScope);
  2023. begin
  2024. if FClassScope=AValue then Exit;
  2025. FClassScope:=AValue;
  2026. IdentifierScope:=AValue;
  2027. end;
  2028. { TPasIdentifier }
  2029. procedure TPasIdentifier.SetElement(AValue: TPasElement);
  2030. begin
  2031. if FElement=AValue then Exit;
  2032. if Element<>nil then
  2033. Element.Release;
  2034. FElement:=AValue;
  2035. if Element<>nil then
  2036. Element.AddRef;
  2037. end;
  2038. destructor TPasIdentifier.Destroy;
  2039. begin
  2040. {$IFDEF VerbosePasResolverMem}
  2041. writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
  2042. {$ENDIF}
  2043. Element:=nil;
  2044. inherited Destroy;
  2045. {$IFDEF VerbosePasResolverMem}
  2046. writeln('TPasIdentifier.Destroy END ',ClassName);
  2047. {$ENDIF}
  2048. end;
  2049. { EPasResolve }
  2050. procedure EPasResolve.SetPasElement(AValue: TPasElement);
  2051. begin
  2052. if FPasElement=AValue then Exit;
  2053. if PasElement<>nil then
  2054. PasElement.Release;
  2055. FPasElement:=AValue;
  2056. if PasElement<>nil then
  2057. PasElement.AddRef;
  2058. end;
  2059. destructor EPasResolve.Destroy;
  2060. begin
  2061. {$IFDEF VerbosePasResolverMem}
  2062. writeln('EPasResolve.Destroy START ',ClassName);
  2063. {$ENDIF}
  2064. PasElement:=nil;
  2065. inherited Destroy;
  2066. {$IFDEF VerbosePasResolverMem}
  2067. writeln('EPasResolve.Destroy END ',ClassName);
  2068. {$ENDIF}
  2069. end;
  2070. { TResolvedReference }
  2071. procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
  2072. begin
  2073. if FDeclaration=AValue then Exit;
  2074. if Declaration<>nil then
  2075. Declaration.Release;
  2076. FDeclaration:=AValue;
  2077. if Declaration<>nil then
  2078. Declaration.AddRef;
  2079. end;
  2080. destructor TResolvedReference.Destroy;
  2081. begin
  2082. {$IFDEF VerbosePasResolverMem}
  2083. writeln('TResolvedReference.Destroy START ',ClassName);
  2084. {$ENDIF}
  2085. Declaration:=nil;
  2086. FreeAndNil(Context);
  2087. inherited Destroy;
  2088. {$IFDEF VerbosePasResolverMem}
  2089. writeln('TResolvedReference.Destroy END ',ClassName);
  2090. {$ENDIF}
  2091. end;
  2092. { TPasSubScope }
  2093. class function TPasSubScope.IsStoredInElement: boolean;
  2094. begin
  2095. Result:=false;
  2096. end;
  2097. { TPasModuleDotScope }
  2098. procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
  2099. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  2100. var
  2101. FilterData: PPasIterateFilterData absolute Data;
  2102. begin
  2103. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  2104. exit; // skip used units
  2105. // call the original iterator
  2106. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  2107. end;
  2108. procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
  2109. begin
  2110. if FModule=AValue then Exit;
  2111. if Module<>nil then
  2112. Module.Release;
  2113. FModule:=AValue;
  2114. if Module<>nil then
  2115. Module.AddRef;
  2116. end;
  2117. destructor TPasModuleDotScope.Destroy;
  2118. begin
  2119. {$IFDEF VerbosePasResolverMem}
  2120. writeln('TPasSubModuleScope.Destroy START ',ClassName);
  2121. {$ENDIF}
  2122. Module:=nil;
  2123. inherited Destroy;
  2124. {$IFDEF VerbosePasResolverMem}
  2125. writeln('TPasSubModuleScope.Destroy END ',ClassName);
  2126. {$ENDIF}
  2127. end;
  2128. function TPasModuleDotScope.FindIdentifier(const Identifier: String
  2129. ): TPasIdentifier;
  2130. function Find(Scope: TPasIdentifierScope): boolean;
  2131. var
  2132. Found: TPasIdentifier;
  2133. C: TClass;
  2134. begin
  2135. if Scope=nil then exit(false);
  2136. Found:=Scope.FindLocalIdentifier(Identifier);
  2137. FindIdentifier:=Found;
  2138. if Found=nil then exit(false);
  2139. C:=Found.Element.ClassType;
  2140. Result:=(C<>TPasModule) and (C<>TPasUsesUnit);
  2141. end;
  2142. begin
  2143. Result:=nil;
  2144. if Find(ImplementationScope) then exit;
  2145. if Find(InterfaceScope) then exit;
  2146. Find(SystemScope);
  2147. end;
  2148. procedure TPasModuleDotScope.IterateElements(const aName: string;
  2149. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2150. Data: Pointer; var Abort: boolean);
  2151. var
  2152. FilterData: TPasIterateFilterData;
  2153. function Iterate(Scope: TPasIdentifierScope): boolean;
  2154. begin
  2155. if Scope=nil then exit(false);
  2156. Scope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  2157. Result:=Abort;
  2158. end;
  2159. begin
  2160. FilterData.OnIterate:=OnIterateElement;
  2161. FilterData.Data:=Data;
  2162. if Iterate(ImplementationScope) then exit;
  2163. if Iterate(InterfaceScope) then exit;
  2164. Iterate(SystemScope);
  2165. end;
  2166. procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
  2167. begin
  2168. if ImplementationScope<>nil then
  2169. ImplementationScope.WriteIdentifiers(Prefix+' ');
  2170. if InterfaceScope<>nil then
  2171. InterfaceScope.WriteIdentifiers(Prefix+' ');
  2172. if SystemScope<>nil then
  2173. SystemScope.WriteIdentifiers(Prefix+' ');
  2174. end;
  2175. { TPasSectionScope }
  2176. procedure TPasSectionScope.OnInternalIterate(El: TPasElement; ElScope,
  2177. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  2178. var
  2179. FilterData: PPasIterateFilterData absolute Data;
  2180. begin
  2181. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  2182. exit; // skip used units
  2183. // call the original iterator
  2184. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  2185. end;
  2186. constructor TPasSectionScope.Create;
  2187. begin
  2188. inherited Create;
  2189. UsesScopes:=TFPList.Create;
  2190. end;
  2191. destructor TPasSectionScope.Destroy;
  2192. begin
  2193. {$IFDEF VerbosePasResolverMem}
  2194. writeln('TPasSectionScope.Destroy START ',ClassName);
  2195. {$ENDIF}
  2196. FreeAndNil(UsesScopes);
  2197. inherited Destroy;
  2198. {$IFDEF VerbosePasResolverMem}
  2199. writeln('TPasSectionScope.Destroy END ',ClassName);
  2200. {$ENDIF}
  2201. end;
  2202. function TPasSectionScope.FindIdentifier(const Identifier: String
  2203. ): TPasIdentifier;
  2204. var
  2205. i: Integer;
  2206. UsesScope: TPasIdentifierScope;
  2207. C: TClass;
  2208. begin
  2209. Result:=inherited FindIdentifier(Identifier);
  2210. if Result<>nil then
  2211. exit;
  2212. for i:=UsesScopes.Count-1 downto 0 do
  2213. begin
  2214. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  2215. {$IFDEF VerbosePasResolver}
  2216. writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
  2217. {$ENDIF}
  2218. Result:=UsesScope.FindLocalIdentifier(Identifier);
  2219. if Result<>nil then
  2220. begin
  2221. C:=Result.Element.ClassType;
  2222. if (C<>TPasModule) and (C<>TPasUsesUnit) then
  2223. exit;
  2224. end;
  2225. end;
  2226. end;
  2227. procedure TPasSectionScope.IterateElements(const aName: string;
  2228. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2229. Data: Pointer; var Abort: boolean);
  2230. var
  2231. i: Integer;
  2232. UsesScope: TPasIdentifierScope;
  2233. FilterData: TPasIterateFilterData;
  2234. begin
  2235. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  2236. if Abort then exit;
  2237. FilterData.OnIterate:=OnIterateElement;
  2238. FilterData.Data:=Data;
  2239. for i:=UsesScopes.Count-1 downto 0 do
  2240. begin
  2241. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  2242. {$IFDEF VerbosePasResolver}
  2243. writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',GetObjName(UsesScope.Element));
  2244. {$ENDIF}
  2245. UsesScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  2246. if Abort then exit;
  2247. end;
  2248. end;
  2249. procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
  2250. var
  2251. i: Integer;
  2252. UsesScope: TPasIdentifierScope;
  2253. SubPrefix: String;
  2254. begin
  2255. inherited WriteIdentifiers(Prefix);
  2256. SubPrefix:=Prefix+' ';
  2257. for i:=UsesScopes.Count-1 downto 0 do
  2258. begin
  2259. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  2260. writeln(Prefix+' Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
  2261. UsesScope.FItems.ForEachCall(@OnWriteItem,Pointer(SubPrefix));
  2262. end;
  2263. end;
  2264. { TPasModuleScope }
  2265. procedure TPasModuleScope.SetAssertDefConstructor(const AValue: TPasConstructor
  2266. );
  2267. begin
  2268. if FAssertDefConstructor=AValue then Exit;
  2269. if FAssertDefConstructor<>nil then
  2270. FAssertDefConstructor.Release;
  2271. FAssertDefConstructor:=AValue;
  2272. if FAssertDefConstructor<>nil then
  2273. FAssertDefConstructor.AddRef;
  2274. end;
  2275. procedure TPasModuleScope.SetAssertClass(const AValue: TPasClassType);
  2276. begin
  2277. if FAssertClass=AValue then Exit;
  2278. if FAssertClass<>nil then
  2279. FAssertClass.Release;
  2280. FAssertClass:=AValue;
  2281. if FAssertClass<>nil then
  2282. FAssertClass.AddRef;
  2283. end;
  2284. procedure TPasModuleScope.SetAssertMsgConstructor(const AValue: TPasConstructor
  2285. );
  2286. begin
  2287. if FAssertMsgConstructor=AValue then Exit;
  2288. if FAssertMsgConstructor<>nil then
  2289. FAssertMsgConstructor.Release;
  2290. FAssertMsgConstructor:=AValue;
  2291. if FAssertMsgConstructor<>nil then
  2292. FAssertMsgConstructor.AddRef;
  2293. end;
  2294. procedure TPasModuleScope.SetRangeErrorClass(const AValue: TPasClassType);
  2295. begin
  2296. if FRangeErrorClass=AValue then Exit;
  2297. if FRangeErrorClass<>nil then
  2298. FRangeErrorClass.Release;
  2299. FRangeErrorClass:=AValue;
  2300. if FRangeErrorClass<>nil then
  2301. FRangeErrorClass.AddRef;
  2302. end;
  2303. procedure TPasModuleScope.SetRangeErrorConstructor(const AValue: TPasConstructor
  2304. );
  2305. begin
  2306. if FRangeErrorConstructor=AValue then Exit;
  2307. if FRangeErrorConstructor<>nil then
  2308. FRangeErrorConstructor.Release;
  2309. FRangeErrorConstructor:=AValue;
  2310. if FRangeErrorConstructor<>nil then
  2311. FRangeErrorConstructor.AddRef;
  2312. end;
  2313. constructor TPasModuleScope.Create;
  2314. begin
  2315. inherited Create;
  2316. PendingResolvers:=TFPList.Create;
  2317. end;
  2318. destructor TPasModuleScope.Destroy;
  2319. begin
  2320. AssertClass:=nil;
  2321. AssertDefConstructor:=nil;
  2322. AssertMsgConstructor:=nil;
  2323. FreeAndNil(PendingResolvers);
  2324. inherited Destroy;
  2325. end;
  2326. procedure TPasModuleScope.IterateElements(const aName: string;
  2327. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2328. Data: Pointer; var Abort: boolean);
  2329. begin
  2330. if CompareText(aName,FirstName)<>0 then exit;
  2331. OnIterateElement(Element,Self,StartScope,Data,Abort);
  2332. end;
  2333. { TPasDefaultScope }
  2334. class function TPasDefaultScope.IsStoredInElement: boolean;
  2335. begin
  2336. Result:=false;
  2337. end;
  2338. { TPasScope }
  2339. class function TPasScope.IsStoredInElement: boolean;
  2340. begin
  2341. Result:=true;
  2342. end;
  2343. class function TPasScope.FreeOnPop: boolean;
  2344. begin
  2345. Result:=not IsStoredInElement;
  2346. end;
  2347. procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
  2348. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  2349. var Abort: boolean);
  2350. begin
  2351. if aName='' then ;
  2352. if StartScope=nil then ;
  2353. if Data=nil then ;
  2354. if OnIterateElement=nil then ;
  2355. if Abort then ;
  2356. end;
  2357. procedure TPasScope.WriteIdentifiers(Prefix: string);
  2358. begin
  2359. writeln(Prefix,'Element: ',GetObjName(Element));
  2360. end;
  2361. { TPasIdentifierScope }
  2362. // inline
  2363. function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
  2364. ): TPasIdentifier;
  2365. var
  2366. LoName: String;
  2367. begin
  2368. LoName:=lowercase(Identifier);
  2369. Result:=TPasIdentifier(FItems.Find(LoName));
  2370. end;
  2371. procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
  2372. var
  2373. PasIdentifier: TPasIdentifier absolute Item;
  2374. Ident: TPasIdentifier;
  2375. begin
  2376. if Dummy=nil then ;
  2377. //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  2378. while PasIdentifier<>nil do
  2379. begin
  2380. Ident:=PasIdentifier;
  2381. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  2382. Ident.Free;
  2383. end;
  2384. end;
  2385. procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
  2386. var
  2387. PasIdentifier: TPasIdentifier absolute Item;
  2388. Prefix: String;
  2389. begin
  2390. Prefix:=AnsiString(Dummy);
  2391. while PasIdentifier<>nil do
  2392. begin
  2393. writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
  2394. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  2395. end;
  2396. end;
  2397. procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
  2398. var
  2399. Index: Integer;
  2400. OldItem: TPasIdentifier;
  2401. LoName: string;
  2402. begin
  2403. LoName:=lowercase(Item.Identifier);
  2404. Index:=FItems.FindIndexOf(LoName);
  2405. {$IFDEF VerbosePasResolver}
  2406. if Item.Owner<>nil then
  2407. raise Exception.Create('20160925184110');
  2408. Item.Owner:=Self;
  2409. {$ENDIF}
  2410. //writeln(' Index=',Index);
  2411. if Index>=0 then
  2412. begin
  2413. // insert LIFO - last in, first out
  2414. OldItem:=TPasIdentifier(FItems.List^[Index].Data);
  2415. {$IFDEF VerbosePasResolver}
  2416. if lowercase(OldItem.Identifier)<>LoName then
  2417. raise Exception.Create('20160925183438');
  2418. {$ENDIF}
  2419. Item.NextSameIdentifier:=OldItem;
  2420. FItems.List^[Index].Data:=Item;
  2421. end
  2422. else
  2423. begin
  2424. FItems.Add(LoName, Item);
  2425. {$IFDEF VerbosePasResolver}
  2426. if FindIdentifier(Item.Identifier)<>Item then
  2427. raise Exception.Create('20160925183849');
  2428. {$ENDIF}
  2429. end;
  2430. end;
  2431. constructor TPasIdentifierScope.Create;
  2432. begin
  2433. FItems:=TFPHashList.Create;
  2434. end;
  2435. destructor TPasIdentifierScope.Destroy;
  2436. begin
  2437. {$IFDEF VerbosePasResolverMem}
  2438. writeln('TPasIdentifierScope.Destroy START ',ClassName);
  2439. {$ENDIF}
  2440. FItems.ForEachCall(@OnClearItem,nil);
  2441. FItems.Clear;
  2442. FreeAndNil(FItems);
  2443. inherited Destroy;
  2444. {$IFDEF VerbosePasResolverMem}
  2445. writeln('TPasIdentifierScope.Destroy END ',ClassName);
  2446. {$ENDIF}
  2447. end;
  2448. function TPasIdentifierScope.FindIdentifier(const Identifier: String
  2449. ): TPasIdentifier;
  2450. begin
  2451. Result:=FindLocalIdentifier(Identifier);
  2452. {$IFDEF VerbosePasResolver}
  2453. if (Result<>nil) and (Result.Owner<>Self) then
  2454. begin
  2455. writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  2456. raise Exception.Create('20160925184159');
  2457. end;
  2458. {$ENDIF}
  2459. end;
  2460. function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
  2461. var
  2462. Identifier, PrevIdentifier: TPasIdentifier;
  2463. LoName: string;
  2464. begin
  2465. LoName:=lowercase(El.Name);
  2466. Identifier:=TPasIdentifier(FItems.Find(LoName));
  2467. FindLocalIdentifier(El.Name);
  2468. PrevIdentifier:=nil;
  2469. Result:=false;
  2470. while Identifier<>nil do
  2471. begin
  2472. {$IFDEF VerbosePasResolver}
  2473. if (Identifier.Owner<>Self) then
  2474. raise Exception.Create('20160925184159');
  2475. {$ENDIF}
  2476. if Identifier.Element=El then
  2477. begin
  2478. if PrevIdentifier<>nil then
  2479. begin
  2480. PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
  2481. Identifier.Free;
  2482. Identifier:=PrevIdentifier.NextSameIdentifier;
  2483. end
  2484. else
  2485. begin
  2486. FItems.Remove(Identifier);
  2487. PrevIdentifier:=Identifier;
  2488. Identifier:=Identifier.NextSameIdentifier;
  2489. PrevIdentifier.Free;
  2490. PrevIdentifier:=nil;
  2491. if Identifier<>nil then
  2492. FItems.Add(Loname,Identifier);
  2493. end;
  2494. Result:=true;
  2495. continue;
  2496. end;
  2497. PrevIdentifier:=Identifier;
  2498. Identifier:=Identifier.NextSameIdentifier;
  2499. end;
  2500. end;
  2501. function TPasIdentifierScope.AddIdentifier(const Identifier: String;
  2502. El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
  2503. var
  2504. Item: TPasIdentifier;
  2505. begin
  2506. //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
  2507. Item:=TPasIdentifier.Create;
  2508. Item.Identifier:=Identifier;
  2509. Item.Element:=El;
  2510. Item.Kind:=Kind;
  2511. InternalAdd(Item);
  2512. //writeln('TPasIdentifierScope.AddIdentifier END');
  2513. Result:=Item;
  2514. end;
  2515. function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
  2516. var
  2517. Item: TPasIdentifier;
  2518. begin
  2519. //writeln('TPasIdentifierScope.FindElement "',aName,'"');
  2520. Item:=FindIdentifier(aName);
  2521. if Item=nil then
  2522. Result:=nil
  2523. else
  2524. Result:=Item.Element;
  2525. //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
  2526. end;
  2527. procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
  2528. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2529. Data: Pointer; var Abort: boolean);
  2530. var
  2531. Item: TPasIdentifier;
  2532. {$IFDEF VerbosePasResolver}
  2533. OldElement: TPasElement;
  2534. {$ENDIF}
  2535. begin
  2536. Item:=FindLocalIdentifier(aName);
  2537. while Item<>nil do
  2538. begin
  2539. //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
  2540. {$IFDEF VerbosePasResolver}
  2541. OldElement:=Item.Element;
  2542. {$ENDIF}
  2543. OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
  2544. {$IFDEF VerbosePasResolver}
  2545. if OldElement<>Item.Element then
  2546. raise Exception.Create('20160925183503');
  2547. {$ENDIF}
  2548. if Abort then exit;
  2549. Item:=Item.NextSameIdentifier;
  2550. end;
  2551. end;
  2552. procedure TPasIdentifierScope.IterateElements(const aName: string;
  2553. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  2554. Data: Pointer; var Abort: boolean);
  2555. begin
  2556. IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
  2557. end;
  2558. procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
  2559. begin
  2560. inherited WriteIdentifiers(Prefix);
  2561. Prefix:=Prefix+' ';
  2562. FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
  2563. end;
  2564. { TPasResolver }
  2565. // inline
  2566. function TPasResolver.GetBaseTypes(bt: TResolverBaseType
  2567. ): TPasUnresolvedSymbolRef;
  2568. begin
  2569. Result:=FBaseTypes[bt];
  2570. end;
  2571. // inline
  2572. function TPasResolver.GetScopes(Index: integer): TPasScope;
  2573. begin
  2574. Result:=FScopes[Index];
  2575. end;
  2576. // inline
  2577. function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
  2578. begin
  2579. Result:=(El.ClassType=TSelfExpr)
  2580. or ((El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent));
  2581. end;
  2582. function TPasResolver.GetNameExprValue(El: TPasExpr): string;
  2583. begin
  2584. if El=nil then
  2585. Result:=''
  2586. else if El.ClassType=TPrimitiveExpr then
  2587. begin
  2588. if TPrimitiveExpr(El).Kind=pekIdent then
  2589. Result:=TPrimitiveExpr(El).Value
  2590. else
  2591. Result:='';
  2592. end
  2593. else if El.ClassType=TSelfExpr then
  2594. Result:='self'
  2595. else
  2596. Result:='';
  2597. end;
  2598. function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
  2599. // returns TSelfExpr or TPrimitiveExpr (Kind=pekIdent)
  2600. var
  2601. Bin: TBinaryExpr;
  2602. C: TClass;
  2603. begin
  2604. Result:=nil;
  2605. if El=nil then exit;
  2606. repeat
  2607. if not (El.Parent is TBinaryExpr) then exit;
  2608. Bin:=TBinaryExpr(El.Parent);
  2609. if Bin.OpCode<>eopSubIdent then exit;
  2610. if El=Bin.right then
  2611. El:=Bin
  2612. else
  2613. begin
  2614. El:=Bin.right;
  2615. // find left most
  2616. repeat
  2617. C:=El.ClassType;
  2618. if C=TSelfExpr then
  2619. exit(El)
  2620. else if C=TPrimitiveExpr then
  2621. begin
  2622. if TPrimitiveExpr(El).Kind<>pekIdent then
  2623. RaiseNotYetImplemented(20170502163825,El);
  2624. exit(El);
  2625. end
  2626. else if C=TBinaryExpr then
  2627. begin
  2628. if TBinaryExpr(El).OpCode<>eopSubIdent then
  2629. RaiseNotYetImplemented(20170502163718,El);
  2630. El:=TBinaryExpr(El).left;
  2631. end
  2632. else if C=TParamsExpr then
  2633. begin
  2634. if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
  2635. RaiseNotYetImplemented(20170502163908,El);
  2636. El:=TParamsExpr(El).Value;
  2637. end;
  2638. until El=nil;
  2639. RaiseNotYetImplemented(20170502163953,Bin);
  2640. end;
  2641. until false;
  2642. end;
  2643. function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
  2644. // get leftmost name element (e.g. TPrimitiveExpr or TSelfExpr)
  2645. // nil if not found
  2646. var
  2647. C: TClass;
  2648. begin
  2649. Result:=nil;
  2650. while El<>nil do
  2651. begin
  2652. C:=El.ClassType;
  2653. if C=TPrimitiveExpr then
  2654. exit(El)
  2655. else if C=TSelfExpr then
  2656. exit(El)
  2657. else if C=TBinaryExpr then
  2658. begin
  2659. if TBinaryExpr(El).OpCode=eopSubIdent then
  2660. El:=TBinaryExpr(El).left
  2661. else
  2662. exit;
  2663. end
  2664. else if C=TParamsExpr then
  2665. El:=TParamsExpr(El).Value
  2666. else
  2667. exit;
  2668. end;
  2669. end;
  2670. function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  2671. // if the expression is a constructor newinstance call,
  2672. // return the element referring the constructor
  2673. // else nil
  2674. var
  2675. C: TClass;
  2676. begin
  2677. Result:=nil;
  2678. while El<>nil do
  2679. begin
  2680. if (El.CustomData is TResolvedReference)
  2681. and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
  2682. exit(El);
  2683. C:=El.ClassType;
  2684. if C=TBinaryExpr then
  2685. begin
  2686. if TBinaryExpr(El).OpCode=eopSubIdent then
  2687. El:=TBinaryExpr(El).right
  2688. else
  2689. exit;
  2690. end
  2691. else if C=TParamsExpr then
  2692. El:=TParamsExpr(El).Value
  2693. else
  2694. exit;
  2695. end;
  2696. end;
  2697. procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
  2698. var
  2699. El: TPasElement;
  2700. RData: TResolveData;
  2701. begin
  2702. // clear CustomData
  2703. while FLastCreatedData[Kind]<>nil do
  2704. begin
  2705. RData:=FLastCreatedData[Kind];
  2706. El:=RData.Element;
  2707. El.CustomData:=nil;
  2708. FLastCreatedData[Kind]:=RData.Next;
  2709. RData.Free;
  2710. end;
  2711. end;
  2712. function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
  2713. begin
  2714. if FBaseTypes[bt]<>nil then
  2715. Result:=FBaseTypes[bt].Name
  2716. else
  2717. Result:=ResBaseTypeNames[bt];
  2718. end;
  2719. procedure TPasResolver.OnFindFirstElement(El: TPasElement; ElScope,
  2720. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  2721. var
  2722. Data: PPRFindData absolute FindFirstElementData;
  2723. ok: Boolean;
  2724. begin
  2725. ok:=true;
  2726. if (El is TPasProcedure)
  2727. and ProcNeedsParams(TPasProcedure(El).ProcType) then
  2728. // found a proc, but it needs parameters -> remember the first and continue
  2729. ok:=false;
  2730. if ok or (Data^.Found=nil) then
  2731. begin
  2732. Data^.Found:=El;
  2733. Data^.ElScope:=ElScope;
  2734. Data^.StartScope:=StartScope;
  2735. end;
  2736. if ok then
  2737. Abort:=true;
  2738. end;
  2739. procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
  2740. StartScope: TPasScope; FindProcsData: Pointer; var Abort: boolean);
  2741. var
  2742. Data: PFindCallElData absolute FindProcsData;
  2743. Proc, PrevProc: TPasProcedure;
  2744. Distance: integer;
  2745. BuiltInProc: TResElDataBuiltInProc;
  2746. CandidateFound: Boolean;
  2747. VarType, TypeEl: TPasType;
  2748. C: TClass;
  2749. ProcScope: TPasProcedureScope;
  2750. begin
  2751. {$IFDEF VerbosePasResolver}
  2752. writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
  2753. {$ENDIF}
  2754. CandidateFound:=false;
  2755. if (El is TPasProcedure) then
  2756. begin
  2757. // identifier is a proc
  2758. Proc:=TPasProcedure(El);
  2759. PrevProc:=nil;
  2760. if Data^.Found=Proc then
  2761. begin
  2762. // this proc was already found. This happens when this is the forward
  2763. // declaration or a previously found implementation.
  2764. Data^.ElScope:=ElScope;
  2765. Data^.StartScope:=StartScope;
  2766. exit;
  2767. end;
  2768. ProcScope:=Proc.CustomData as TPasProcedureScope;
  2769. if ProcScope.DeclarationProc<>nil then
  2770. begin
  2771. // this proc has a forward declaration -> use that instead
  2772. Proc:=ProcScope.DeclarationProc;
  2773. El:=Proc;
  2774. end;
  2775. if Data^.Found is TPasProcedure then
  2776. begin
  2777. // there is already a previous proc
  2778. PrevProc:=TPasProcedure(Data^.Found);
  2779. if TPasProcedureScope(Data^.LastProc.CustomData).Mode=msDelphi then
  2780. begin
  2781. if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
  2782. begin
  2783. Abort:=true;
  2784. exit;
  2785. end;
  2786. end
  2787. else
  2788. begin
  2789. // mode objfpc
  2790. if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
  2791. // mode objfpc: procs in same context have implicit overload
  2792. else
  2793. begin
  2794. // mode objfpc, different context
  2795. if not ProcHasGroupOverload(Data^.LastProc) then
  2796. begin
  2797. Abort:=true;
  2798. exit;
  2799. end;
  2800. end;
  2801. end;
  2802. if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
  2803. and (PrevProc.Parent.ClassType=TPasClassType) then
  2804. begin
  2805. // there was already a perfect proc in a descendant
  2806. Abort:=true;
  2807. exit;
  2808. end;
  2809. // check if previous found proc is override of found proc
  2810. if IsProcOverride(Proc,PrevProc) then
  2811. begin
  2812. // previous found proc is override of found proc -> skip
  2813. exit;
  2814. end;
  2815. end;
  2816. if (ProcScope.Mode=msDelphi) and not Proc.IsOverload then
  2817. Abort:=true; // stop searching after this proc
  2818. CandidateFound:=true;
  2819. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  2820. {$IFDEF VerbosePasResolver}
  2821. writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
  2822. ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',ord(Data^.Distance),
  2823. ' Signature={',GetProcTypeDescription(Proc.ProcType,true,true),'}',
  2824. ' Abort=',Abort);
  2825. {$ENDIF}
  2826. Data^.LastProc:=Proc;
  2827. end
  2828. else if El is TPasType then
  2829. begin
  2830. TypeEl:=ResolveAliasType(TPasType(El));
  2831. C:=TypeEl.ClassType;
  2832. if C=TPasUnresolvedSymbolRef then
  2833. begin
  2834. if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
  2835. begin
  2836. // call of built-in proc
  2837. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  2838. if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
  2839. and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
  2840. begin
  2841. // str function can only be used within an expression
  2842. // str procedure can only be used outside an expression
  2843. {$IFDEF VerbosePasResolver}
  2844. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
  2845. {$ENDIF}
  2846. exit;
  2847. end;
  2848. Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
  2849. {$IFDEF VerbosePasResolver}
  2850. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
  2851. {$ENDIF}
  2852. CandidateFound:=true;
  2853. end
  2854. else if TypeEl.CustomData is TResElDataBaseType then
  2855. begin
  2856. // type cast to base type
  2857. Abort:=true; // can't be overloaded
  2858. if Data^.Found<>nil then exit;
  2859. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  2860. {$IFDEF VerbosePasResolver}
  2861. writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
  2862. {$ENDIF}
  2863. CandidateFound:=true;
  2864. end;
  2865. end
  2866. else if (C=TPasClassType)
  2867. or (C=TPasClassOfType)
  2868. or (C=TPasRecordType)
  2869. or (C=TPasEnumType)
  2870. or (C=TPasProcedureType)
  2871. or (C=TPasFunctionType)
  2872. or (C=TPasArrayType)
  2873. or (C=TPasRangeType) then
  2874. begin
  2875. // type cast to user type
  2876. Abort:=true; // can't be overloaded
  2877. if Data^.Found<>nil then exit;
  2878. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  2879. {$IFDEF VerbosePasResolver}
  2880. writeln('TPasResolver.OnFindCallElements type cast to =',GetObjName(El),' Distance=',Distance);
  2881. {$ENDIF}
  2882. CandidateFound:=true;
  2883. end;
  2884. end
  2885. else if El is TPasVariable then
  2886. begin
  2887. Abort:=true; // can't be overloaded
  2888. if Data^.Found<>nil then exit;
  2889. VarType:=ResolveAliasType(TPasVariable(El).VarType);
  2890. if VarType is TPasProcedureType then
  2891. begin
  2892. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  2893. {$IFDEF VerbosePasResolver}
  2894. writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
  2895. {$ENDIF}
  2896. CandidateFound:=true;
  2897. end;
  2898. end
  2899. else if El.ClassType=TPasArgument then
  2900. begin
  2901. Abort:=true; // can't be overloaded
  2902. if Data^.Found<>nil then exit;
  2903. VarType:=ResolveAliasType(TPasArgument(El).ArgType);
  2904. if VarType is TPasProcedureType then
  2905. begin
  2906. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  2907. {$IFDEF VerbosePasResolver}
  2908. writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
  2909. {$ENDIF}
  2910. CandidateFound:=true;
  2911. end;
  2912. end;
  2913. if not CandidateFound then
  2914. begin
  2915. // El does not support the () operator
  2916. Abort:=true;
  2917. if Data^.Found=nil then
  2918. begin
  2919. // El is the first element found -> raise error
  2920. // ToDo: use the ( as error position
  2921. RaiseMsg(20170216151525,nIllegalQualifier,sIllegalQualifier,['('],Data^.Params);
  2922. end;
  2923. exit;
  2924. end;
  2925. // El is a candidate (might be incompatible)
  2926. if (Data^.Found=nil)
  2927. or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
  2928. begin
  2929. {$IFDEF VerbosePasResolver}
  2930. writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
  2931. {$ENDIF}
  2932. Data^.Found:=El;
  2933. Data^.ElScope:=ElScope;
  2934. Data^.StartScope:=StartScope;
  2935. Data^.Distance:=Distance;
  2936. Data^.Count:=1;
  2937. if Data^.List<>nil then
  2938. begin
  2939. Data^.List.Clear;
  2940. Data^.List.Add(El);
  2941. end;
  2942. end
  2943. else if Distance=cIncompatible then
  2944. // another candidate, but it is incompatible -> ignore
  2945. {$IFDEF VerbosePasResolver}
  2946. writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
  2947. {$ENDIF}
  2948. else if (Distance>=cCompatibleWithDefaultParams)
  2949. or (Data^.Distance=Distance)
  2950. or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)) then
  2951. begin
  2952. // found another compatible one -> collect
  2953. {$IFDEF VerbosePasResolver}
  2954. writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
  2955. {$ENDIF}
  2956. inc(Data^.Count);
  2957. if (Data^.List<>nil) then
  2958. begin
  2959. if (Data^.List.IndexOf(El)>=0) then
  2960. begin
  2961. {$IFDEF VerbosePasResolver}
  2962. writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
  2963. ' ',GetElementSourcePosStr(El),
  2964. ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
  2965. ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
  2966. );
  2967. {$ENDIF}
  2968. RaiseInternalError(20160924230805);
  2969. end;
  2970. Data^.List.Add(El);
  2971. end;
  2972. end
  2973. else if (Distance<Data^.Distance) then
  2974. begin
  2975. // found a better one
  2976. {$IFDEF VerbosePasResolver}
  2977. writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  2978. {$ENDIF}
  2979. Data^.Found:=El;
  2980. Data^.ElScope:=ElScope;
  2981. Data^.StartScope:=StartScope;
  2982. Data^.Distance:=Distance;
  2983. if (Distance<cLossyConversion) then
  2984. begin
  2985. // found a good one
  2986. Data^.Count:=1;
  2987. if Data^.List<>nil then
  2988. Data^.List.Clear;
  2989. end
  2990. else
  2991. begin
  2992. // found another lossy one
  2993. // -> collect them
  2994. inc(Data^.Count);
  2995. end;
  2996. if Data^.List<>nil then
  2997. Data^.List.Add(El);
  2998. end;
  2999. end;
  3000. procedure TPasResolver.OnFindOverloadProc(El: TPasElement; ElScope,
  3001. StartScope: TPasScope; FindOverloadData: Pointer; var Abort: boolean);
  3002. var
  3003. Data: PFindOverloadProcData absolute FindOverloadData;
  3004. Proc: TPasProcedure;
  3005. Store, SameScope: Boolean;
  3006. procedure CountProcInSameModule;
  3007. begin
  3008. inc(Data^.FoundInSameScope);
  3009. if Proc.IsOverload then
  3010. Data^.FoundOverloadModifier:=true;
  3011. end;
  3012. begin
  3013. //writeln('TPasResolver.OnFindOverloadProc START ',El.Name,':',El.ElementTypeName,' itself=',El=Data^.Proc);
  3014. if not (El is TPasProcedure) then
  3015. begin
  3016. // identifier is not a proc
  3017. if (El is TPasVariable) then
  3018. begin
  3019. if TPasVariable(El).Visibility=visStrictPrivate then
  3020. exit; // not visible
  3021. if (TPasVariable(El).Visibility=visPrivate)
  3022. and (El.GetModule<>StartScope.Element.GetModule) then
  3023. exit; // not visible
  3024. end;
  3025. Data^.FoundNonProc:=El;
  3026. Abort:=true;
  3027. if (El.CustomData is TResElDataBuiltInProc) then
  3028. begin
  3029. if Data^.FoundOverloadModifier or Data^.Proc.IsOverload then
  3030. exit; // no hint
  3031. end;
  3032. case Data^.Kind of
  3033. fopkProc:
  3034. // proc hides a non proc
  3035. if (Data^.Proc.GetModule=El.GetModule) then
  3036. // forbidden within same module
  3037. RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
  3038. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
  3039. else
  3040. // give a hint
  3041. LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
  3042. [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  3043. fopkMethod:
  3044. // method hides a non proc
  3045. RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
  3046. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  3047. end;
  3048. exit;
  3049. end;
  3050. // identifier is a proc
  3051. Proc:=TPasProcedure(El);
  3052. if El=Data^.Proc then
  3053. begin
  3054. // found itself -> this is normal when searching for overloads
  3055. CountProcInSameModule;
  3056. exit;
  3057. end;
  3058. //writeln('TPasResolver.OnFindOverloadProc Data^.OnlyScope=',GetObjName(Data^.OnlyScope),' ElScope=',GetObjName(ElScope),' ',Data^.OnlyScope=ElScope);
  3059. if (Data^.OnlyScope<>nil) and (Data^.OnlyScope<>ElScope) then
  3060. begin
  3061. // do not search any further, only one scope should be searched
  3062. // for example when searching the method declaration of a method body
  3063. Abort:=false;
  3064. exit;
  3065. end;
  3066. {$IFDEF VerbosePasResolver}
  3067. writeln('TPasResolver.OnFindOverloadProc ',GetTreeDbg(El,2));
  3068. {$ENDIF}
  3069. Store:=CheckOverloadProcCompatibility(Data^.Proc,Proc);
  3070. if Data^.Kind=fopkSameSignature then
  3071. // finding a proc with same signature is enough, see above Data^.OnlyScope
  3072. else
  3073. begin
  3074. if Data^.Kind=fopkProc then
  3075. SameScope:=Data^.Proc.GetModule=Proc.GetModule
  3076. else
  3077. SameScope:=Data^.Proc.Parent=Proc.Parent;
  3078. if SameScope then
  3079. begin
  3080. // same scope
  3081. if (msObjfpc in CurrentParser.CurrentModeswitches) then
  3082. begin
  3083. if ProcHasGroupOverload(Data^.Proc) then
  3084. Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
  3085. else if ProcHasGroupOverload(Proc) then
  3086. Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
  3087. end;
  3088. if Store then
  3089. begin
  3090. // same scope, same signature
  3091. // Note: forward declaration was already handled in FinishProcedureHeader
  3092. RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
  3093. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  3094. end
  3095. else
  3096. begin
  3097. // same scope, different signature
  3098. if (msDelphi in CurrentParser.CurrentModeswitches) then
  3099. begin
  3100. // Delphi does not allow different procs without 'overload' in a scope
  3101. if not Proc.IsOverload then
  3102. RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
  3103. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  3104. else if not Data^.Proc.IsOverload then
  3105. RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
  3106. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  3107. end
  3108. else
  3109. begin
  3110. // ObjFPC allows different procs without 'overload' modifier
  3111. end;
  3112. CountProcInSameModule;
  3113. end;
  3114. end
  3115. else
  3116. begin
  3117. // different scopes
  3118. if Data^.Proc.IsOverride then
  3119. else if Data^.Proc.IsReintroduced then
  3120. else
  3121. begin
  3122. if Store
  3123. or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
  3124. and not ProcHasGroupOverload(Data^.Proc)) then
  3125. begin
  3126. // give a hint, that proc is hiding a proc in other scope
  3127. if (Data^.Kind=fopkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
  3128. LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
  3129. sMethodHidesMethodOfBaseType,
  3130. [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  3131. else
  3132. // Delphi/FPC do not give a message when hiding a non virtual method
  3133. // -> emit only an Info
  3134. LogMsg(20171118214523,mtInfo,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
  3135. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  3136. Abort:=true;
  3137. end;
  3138. end;
  3139. end;
  3140. end;
  3141. if Store then
  3142. begin
  3143. Data^.Found:=Proc;
  3144. Data^.ElScope:=ElScope;
  3145. Data^.StartScope:=StartScope;
  3146. Abort:=true;
  3147. end;
  3148. end;
  3149. function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
  3150. ): boolean;
  3151. begin
  3152. if ProcParentA=ProcParentB then exit(true);
  3153. if (ProcParentA.ClassType=TInterfaceSection) then
  3154. begin
  3155. if (ProcParentB.ClassType=TImplementationSection)
  3156. and (ProcParentB.Parent=ProcParentA.Parent) then
  3157. exit(true);
  3158. end
  3159. else if (ProcParentB.ClassType=TInterfaceSection) then
  3160. begin
  3161. if (ProcParentA.ClassType=TImplementationSection)
  3162. and (ProcParentA.Parent=ProcParentB.Parent) then
  3163. exit(true);
  3164. end;
  3165. Result:=false;
  3166. end;
  3167. function TPasResolver.FindProcOverload(const ProcName: string;
  3168. Proc: TPasProcedure; OnlyScope: TPasScope): TPasProcedure;
  3169. var
  3170. FindData: TFindOverloadProcData;
  3171. Abort: boolean;
  3172. begin
  3173. FindData:=Default(TFindOverloadProcData);
  3174. FindData.Proc:=Proc;
  3175. FindData.Args:=Proc.ProcType.Args;
  3176. FindData.Kind:=fopkSameSignature;
  3177. FindData.OnlyScope:=OnlyScope;
  3178. Abort:=false;
  3179. OnlyScope.IterateElements(ProcName,OnlyScope,@OnFindOverloadProc,@FindData,Abort);
  3180. Result:=FindData.Found;
  3181. end;
  3182. procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
  3183. begin
  3184. //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
  3185. if AValue=CurrentParser then exit;
  3186. Clear;
  3187. inherited SetCurrentParser(AValue);
  3188. if CurrentParser<>nil then
  3189. CurrentParser.Options:=CurrentParser.Options
  3190. +[po_resolvestandardtypes,po_nooverloadedprocs,po_keepclassforward,
  3191. po_arrayrangeexpr,po_CheckModeswitches,po_CheckCondFunction];
  3192. end;
  3193. procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
  3194. AllowDescendants: boolean);
  3195. var
  3196. Scope: TPasScope;
  3197. begin
  3198. Scope:=TopScope;
  3199. if Scope=nil then
  3200. RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
  3201. if Scope.ClassType<>ExpectedClass then
  3202. if (not AllowDescendants) or (not Scope.InheritsFrom(ExpectedClass)) then
  3203. RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+Scope.ClassName);
  3204. end;
  3205. function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
  3206. const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
  3207. ): TPasIdentifier;
  3208. var
  3209. Identifier, OlderIdentifier: TPasIdentifier;
  3210. ClassScope: TPasClassScope;
  3211. OlderEl: TPasElement;
  3212. IsClassScope: Boolean;
  3213. C: TClass;
  3214. begin
  3215. IsClassScope:=(Scope is TPasClassScope);
  3216. if (El.Visibility=visPublished) then
  3217. begin
  3218. C:=El.ClassType;
  3219. if (C=TPasProperty) or (C=TPasVariable) then
  3220. // Note: VarModifiers are not yet set
  3221. else if (C=TPasProcedure) or (C=TPasFunction) then
  3222. // ok
  3223. else
  3224. RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  3225. end;
  3226. if (Kind=pikSimple) and IsClassScope
  3227. and (El.ClassType<>TPasProperty) then
  3228. begin
  3229. // check duplicate in ancestors
  3230. ClassScope:=TPasClassScope(Scope).AncestorScope;
  3231. while ClassScope<>nil do
  3232. begin
  3233. OlderIdentifier:=ClassScope.FindLocalIdentifier(aName);
  3234. while OlderIdentifier<>nil do
  3235. begin
  3236. OlderEl:=OlderIdentifier.Element;
  3237. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  3238. if OlderEl is TPasVariable then
  3239. begin
  3240. if TPasVariable(OlderEl).Visibility=visStrictPrivate then
  3241. continue; // OlderEl is hidden
  3242. if (TPasVariable(OlderEl).Visibility=visPrivate)
  3243. and (OlderEl.GetModule<>El.GetModule) then
  3244. continue; // OlderEl is hidden
  3245. end;
  3246. RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
  3247. [aName,GetElementSourcePosStr(OlderEl)],El);
  3248. end;
  3249. ClassScope:=ClassScope.AncestorScope;
  3250. end;
  3251. end;
  3252. Identifier:=Scope.AddIdentifier(aName,El,Kind);
  3253. // check duplicate in current scope
  3254. OlderIdentifier:=Identifier.NextSameIdentifier;
  3255. if (OlderIdentifier<>nil) then
  3256. if (Identifier.Kind=pikSimple)
  3257. or (OlderIdentifier.Kind=pikSimple)
  3258. or (El.Visibility=visPublished) then
  3259. begin
  3260. if (OlderIdentifier.Element.ClassType=TPasEnumValue)
  3261. and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
  3262. // this enum was propagated from a sub type -> remove enum
  3263. Scope.RemoveLocalIdentifier(OlderIdentifier.Element);
  3264. RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
  3265. [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El);
  3266. end;
  3267. Result:=Identifier;
  3268. end;
  3269. procedure TPasResolver.FinishModule(CurModule: TPasModule);
  3270. var
  3271. CurModuleClass: TClass;
  3272. i: Integer;
  3273. ModScope: TPasModuleScope;
  3274. begin
  3275. {$IFDEF VerbosePasResolver}
  3276. writeln('TPasResolver.FinishModule START ',CurModule.Name);
  3277. {$ENDIF}
  3278. FStep:=prsFinishingModule;
  3279. CurModuleClass:=CurModule.ClassType;
  3280. ModScope:=CurModule.CustomData as TPasModuleScope;
  3281. ModScope.ScannerBoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  3282. if bsRangeChecks in ModScope.ScannerBoolSwitches then
  3283. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  3284. FindRangeErrorConstructors(CurModule);
  3285. if (CurModuleClass=TPasProgram) or (CurModuleClass=TPasLibrary) then
  3286. begin
  3287. // resolve begin..end block
  3288. ResolveImplBlock(CurModule.InitializationSection);
  3289. end
  3290. else if (CurModuleClass=TPasModule) then
  3291. begin
  3292. // unit
  3293. FinishSection(CurModule.InterfaceSection);
  3294. if CurModule.FinalizationSection<>nil then
  3295. // finalization section finished -> resolve
  3296. ResolveImplBlock(CurModule.FinalizationSection);
  3297. if CurModule.InitializationSection<>nil then
  3298. // initialization section finished -> resolve
  3299. ResolveImplBlock(CurModule.InitializationSection);
  3300. end
  3301. else
  3302. RaiseInternalError(20160922163327); // unknown module
  3303. // check all methods have bodies
  3304. // and all forward classes and pointers are resolved
  3305. for i:=0 to FPendingForwardProcs.Count-1 do
  3306. CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
  3307. FPendingForwardProcs.Clear;
  3308. // close all sections
  3309. while (TopScope<>nil) and (TopScope.ClassType=TPasSectionScope) do
  3310. PopScope;
  3311. CheckTopScope(TPasModuleScope);
  3312. PopScope;
  3313. FStep:=prsFinishedModule;
  3314. {$IFDEF VerbosePasResolver}
  3315. writeln('TPasResolver.FinishModule END ',CurModule.Name);
  3316. {$ENDIF}
  3317. end;
  3318. procedure TPasResolver.FinishUsesClause;
  3319. var
  3320. Section, CurSection: TPasSection;
  3321. i, j: Integer;
  3322. PublicEl, UseModule: TPasElement;
  3323. Scope: TPasSectionScope;
  3324. UsesScope: TPasIdentifierScope;
  3325. UseUnit: TPasUsesUnit;
  3326. FirstName: String;
  3327. p: SizeInt;
  3328. OldIdentifier: TPasIdentifier;
  3329. begin
  3330. CheckTopScope(TPasSectionScope);
  3331. Scope:=TPasSectionScope(TopScope);
  3332. Section:=TPasSection(Scope.Element);
  3333. {$IFDEF VerbosePasResolver}
  3334. writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
  3335. {$ENDIF}
  3336. for i:=0 to Section.UsesList.Count-1 do
  3337. begin
  3338. UseUnit:=Section.UsesClause[i];
  3339. {$IFDEF VerbosePasResolver}
  3340. writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
  3341. {$ENDIF}
  3342. UseModule:=UseUnit.Module;
  3343. // check used unit
  3344. PublicEl:=nil;
  3345. if (UseModule.ClassType=TLibrarySection) then
  3346. PublicEl:=UseModule
  3347. else if (UseModule.ClassType=TPasModule) then
  3348. PublicEl:=TPasModule(UseModule).InterfaceSection
  3349. else
  3350. RaiseXExpectedButYFound(20170503004803,'unit',UseModule.ElementTypeName,UseUnit);
  3351. if PublicEl=nil then
  3352. RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
  3353. if PublicEl.CustomData=nil then
  3354. RaiseInternalError(20160922163358,'uses element has no resolver data: '
  3355. +UseUnit.Name+'->'+GetObjName(PublicEl));
  3356. if not (PublicEl.CustomData is TPasIdentifierScope) then
  3357. RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
  3358. +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
  3359. // check if module was already used by a different name
  3360. j:=i;
  3361. CurSection:=Section;
  3362. repeat
  3363. dec(j);
  3364. if j<0 then
  3365. begin
  3366. if CurSection.ClassType<>TImplementationSection then
  3367. break;
  3368. CurSection:=CurSection.GetModule.InterfaceSection;
  3369. if CurSection=nil then break;
  3370. j:=length(CurSection.UsesClause)-1;
  3371. if j<0 then break;
  3372. end;
  3373. if CurSection.UsesClause[j].Module=UseModule then
  3374. RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
  3375. [UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
  3376. until false;
  3377. // add full uses name
  3378. AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
  3379. // add scope
  3380. UsesScope:=TPasIdentifierScope(PublicEl.CustomData);
  3381. {$IFDEF VerbosePasResolver}
  3382. writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
  3383. {$ENDIF}
  3384. Scope.UsesScopes.Add(UsesScope);
  3385. EmitElementHints(Section,UseUnit);
  3386. end;
  3387. // Add first name of dotted unitname (top level subnamespace) as identifier
  3388. for i:=Section.UsesList.Count-1 downto 0 do
  3389. begin
  3390. UseUnit:=Section.UsesClause[i];
  3391. FirstName:=UseUnit.Name;
  3392. p:=Pos('.',FirstName);
  3393. if p<1 then continue;
  3394. FirstName:=LeftStr(FirstName,p-1);
  3395. OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
  3396. if (OldIdentifier=nil) then
  3397. AddIdentifier(Scope,FirstName,UseUnit,pikNamespace);
  3398. end;
  3399. // Note: a sub identifier (e.g. a class member) hides all unitnames starting
  3400. // with this identifier
  3401. end;
  3402. procedure TPasResolver.FinishSection(Section: TPasSection);
  3403. // Note: can be called multiple times for a section
  3404. var
  3405. Scope: TPasSectionScope;
  3406. begin
  3407. Scope:=Section.CustomData as TPasSectionScope;
  3408. if Scope.Finished then exit;
  3409. Scope.Finished:=true;
  3410. if Section is TInterfaceSection then
  3411. FinishInterfaceSection(Section);
  3412. end;
  3413. procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
  3414. var
  3415. ModuleScope: TPasModuleScope;
  3416. PendingResolver: TPasResolver;
  3417. PendingParser: TPasParser;
  3418. PendingModule: TPasModule;
  3419. PendingImpl: TImplementationSection;
  3420. begin
  3421. {$IFDEF VerbosePasResolver}
  3422. if not IsUnitIntfFinished(Section.GetModule) then
  3423. RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+CurrentParser.CurModule.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
  3424. {$ENDIF}
  3425. ModuleScope:=CurrentParser.CurModule.CustomData as TPasModuleScope;
  3426. while ModuleScope.PendingResolvers.Count>0 do
  3427. begin
  3428. PendingResolver:=TObject(ModuleScope.PendingResolvers[0]) as TPasResolver;
  3429. PendingParser:=PendingResolver.CurrentParser;
  3430. PendingModule:=PendingParser.CurModule;
  3431. PendingImpl:=PendingModule.ImplementationSection;
  3432. {$IFDEF VerbosePasResolver}
  3433. writeln('TPasResolver.FinishInterfaceSection "',ModuleScope.Element.Name,'" Pending="',PendingModule.Name,'"');
  3434. {$ENDIF}
  3435. PendingResolver.CheckPendingUsedInterface(PendingImpl);
  3436. end;
  3437. if Section=nil then ;
  3438. end;
  3439. procedure TPasResolver.FinishTypeSection(El: TPasDeclarations);
  3440. function ReplaceDestType(AliasType: TPasAliasType; const DestName: string;
  3441. MustExist: boolean; ErrorEl: TPasElement): boolean;
  3442. // returns true if replaces
  3443. var
  3444. Abort: boolean;
  3445. Data: TPRFindData;
  3446. OldDestType: TPasType;
  3447. begin
  3448. Abort:=false;
  3449. Data:=Default(TPRFindData);
  3450. Data.ErrorPosEl:=ErrorEl;
  3451. (TopScope as TPasIdentifierScope).IterateElements(DestName,
  3452. TopScope,@OnFindFirstElement,@Data,Abort);
  3453. if (Data.Found=nil) then
  3454. if MustExist then
  3455. RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl)
  3456. else
  3457. exit(false);
  3458. if Data.Found.ClassType<>TPasClassType then
  3459. RaiseXExpectedButYFound(20170216151548,'class',Data.Found.ElementTypeName,ErrorEl);
  3460. // replace unresolved
  3461. OldDestType:=AliasType.DestType;
  3462. AliasType.DestType:=TPasType(Data.Found);
  3463. AliasType.DestType.AddRef;
  3464. OldDestType.Release;
  3465. Result:=true;
  3466. end;
  3467. var
  3468. i: Integer;
  3469. Decl: TPasElement;
  3470. ClassOfEl: TPasClassOfType;
  3471. UnresolvedEl: TUnresolvedPendingRef;
  3472. OldClassType: TPasClassType;
  3473. TypeEl: TPasType;
  3474. C: TClass;
  3475. begin
  3476. // resolve pending forwards
  3477. for i:=0 to El.Declarations.Count-1 do
  3478. begin
  3479. Decl:=TPasElement(El.Declarations[i]);
  3480. C:=Decl.ClassType;
  3481. if C.InheritsFrom(TPasClassType) then
  3482. begin
  3483. if TPasClassType(Decl).IsForward and (TPasClassType(Decl).CustomData=nil) then
  3484. RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[Decl.Name],Decl);
  3485. end
  3486. else if (C=TPasClassOfType) then
  3487. begin
  3488. ClassOfEl:=TPasClassOfType(Decl);
  3489. TypeEl:=ClassOfEl.DestType;
  3490. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  3491. begin
  3492. // forward class-of -> resolve now
  3493. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  3494. {$IFDEF VerbosePasResolver}
  3495. writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',TypeEl.Name,'"');
  3496. {$ENDIF}
  3497. ReplaceDestType(ClassOfEl,TypeEl.Name,true,UnresolvedEl);
  3498. end
  3499. else if TypeEl.ClassType=TPasClassType then
  3500. begin
  3501. // class-of has found a type
  3502. // another later in the same type section has priority -> check
  3503. OldClassType:=TypeEl as TPasClassType;
  3504. if OldClassType.Parent=ClassOfEl.Parent then
  3505. continue; // class in same type section -> ok
  3506. // class not in same type section -> check
  3507. {$IFDEF VerbosePasResolver}
  3508. writeln('TPasResolver.FinishTypeSection improving "',ClassOfEl.Name,'" = class of resolved "',TypeEl.Name,'"');
  3509. {$ENDIF}
  3510. ReplaceDestType(ClassOfEl,TypeEl.Name,false,ClassOfEl);
  3511. end;
  3512. end;
  3513. end;
  3514. end;
  3515. procedure TPasResolver.FinishTypeDef(El: TPasType);
  3516. var
  3517. C: TClass;
  3518. aType: TPasType;
  3519. begin
  3520. {$IFDEF VerbosePasResolver}
  3521. writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
  3522. {$ENDIF}
  3523. C:=El.ClassType;
  3524. if C=TPasEnumType then
  3525. FinishEnumType(TPasEnumType(El))
  3526. else if C=TPasSetType then
  3527. FinishSetType(TPasSetType(El))
  3528. else if C=TPasRangeType then
  3529. FinishRangeType(TPasRangeType(El))
  3530. else if C=TPasRecordType then
  3531. FinishRecordType(TPasRecordType(El))
  3532. else if C=TPasClassType then
  3533. FinishClassType(TPasClassType(El))
  3534. else if C=TPasClassOfType then
  3535. FinishClassOfType(TPasClassOfType(El))
  3536. else if C=TPasArrayType then
  3537. FinishArrayType(TPasArrayType(El))
  3538. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  3539. begin
  3540. aType:=ResolveAliasType(El);
  3541. if (aType is TPasClassType) and (TPasClassType(aType).ObjKind=okInterface) then
  3542. exit; // ToDo: msIgnoreInterfaces
  3543. EmitTypeHints(El,TPasAliasType(El).DestType);
  3544. end
  3545. else if (C=TPasPointerType) then
  3546. EmitTypeHints(El,TPasPointerType(El).DestType);
  3547. end;
  3548. procedure TPasResolver.FinishEnumType(El: TPasEnumType);
  3549. begin
  3550. if TopScope.Element=El then
  3551. PopScope;
  3552. end;
  3553. procedure TPasResolver.FinishSetType(El: TPasSetType);
  3554. var
  3555. BaseTypeData: TResElDataBaseType;
  3556. StartResolved, EndResolved: TPasResolverResult;
  3557. RangeExpr: TBinaryExpr;
  3558. C: TClass;
  3559. EnumType: TPasType;
  3560. begin
  3561. EnumType:=El.EnumType;
  3562. C:=EnumType.ClassType;
  3563. if C=TPasEnumType then
  3564. begin
  3565. FinishSubElementType(El,EnumType);
  3566. exit;
  3567. end
  3568. else if C=TPasRangeType then
  3569. begin
  3570. RangeExpr:=TPasRangeType(EnumType).RangeExpr;
  3571. if (RangeExpr.Parent=El) and (RangeExpr.CustomData=nil) then
  3572. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  3573. FinishSubElementType(El,EnumType);
  3574. exit;
  3575. end
  3576. else if C=TPasUnresolvedSymbolRef then
  3577. begin
  3578. if EnumType.CustomData is TResElDataBaseType then
  3579. begin
  3580. BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
  3581. if BaseTypeData.BaseType in (btAllChars+[btBoolean,btByte]) then
  3582. exit;
  3583. RaiseXExpectedButYFound(20170216151553,'char or boolean',EnumType.ElementTypeName,EnumType);
  3584. end;
  3585. end;
  3586. RaiseXExpectedButYFound(20170216151557,'enum type',EnumType.ElementTypeName,EnumType);
  3587. end;
  3588. procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
  3589. var
  3590. Decl: TPasDeclarations;
  3591. EnumScope: TPasEnumTypeScope;
  3592. begin
  3593. EmitTypeHints(Parent,El);
  3594. if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
  3595. if Parent.Name='' then
  3596. RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
  3597. if not (Parent.Parent is TPasDeclarations) then
  3598. RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
  3599. // give anonymous sub type a name
  3600. El.Name:=Parent.Name+AnonymousElTypePostfix;
  3601. {$IFDEF VerbosePasResolver}
  3602. writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
  3603. {$ENDIF}
  3604. Decl:=TPasDeclarations(Parent.Parent);
  3605. Decl.Declarations.Add(El);
  3606. El.AddRef;
  3607. El.Parent:=Decl;
  3608. Decl.Types.Add(El);
  3609. if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
  3610. begin
  3611. EnumScope:=TPasEnumTypeScope(El.CustomData);
  3612. if EnumScope.CanonicalSet<>Parent then
  3613. begin
  3614. if EnumScope.CanonicalSet<>nil then
  3615. EnumScope.CanonicalSet.Release;
  3616. EnumScope.CanonicalSet:=TPasSetType(Parent);
  3617. Parent.AddRef;
  3618. end;
  3619. end;
  3620. end;
  3621. procedure TPasResolver.FinishRangeType(El: TPasRangeType);
  3622. var
  3623. RangeExpr: TBinaryExpr;
  3624. StartResolved, EndResolved: TPasResolverResult;
  3625. begin
  3626. RangeExpr:=El.RangeExpr;
  3627. ResolveExpr(RangeExpr.left,rraRead);
  3628. ResolveExpr(RangeExpr.right,rraRead);
  3629. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  3630. end;
  3631. procedure TPasResolver.FinishConstRangeExpr(RangeExpr: TBinaryExpr; out
  3632. LeftResolved, RightResolved: TPasResolverResult);
  3633. // for example Left..Right
  3634. var
  3635. RgValue: TResEvalValue;
  3636. Left, Right: TPasExpr;
  3637. begin
  3638. Left:=RangeExpr.left;
  3639. Right:=RangeExpr.right;
  3640. {$IFDEF VerbosePasResEval}
  3641. writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
  3642. {$ENDIF}
  3643. // check type compatibility
  3644. ComputeElement(Left,LeftResolved,[rcSkipTypeAlias,rcConstant]);
  3645. ComputeElement(Right,RightResolved,[rcSkipTypeAlias,rcConstant]);
  3646. CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
  3647. RgValue:=Eval(RangeExpr,[refConst]);
  3648. ReleaseEvalValue(RgValue);
  3649. end;
  3650. procedure TPasResolver.FinishRecordType(El: TPasRecordType);
  3651. begin
  3652. if TopScope.Element=El then
  3653. PopScope;
  3654. end;
  3655. procedure TPasResolver.FinishClassType(El: TPasClassType);
  3656. begin
  3657. if TopScope.Element=El then
  3658. PopScope;
  3659. end;
  3660. procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
  3661. var
  3662. TypeEl: TPasType;
  3663. begin
  3664. TypeEl:=ResolveAliasType(El.DestType);
  3665. if TypeEl is TUnresolvedPendingRef then exit;
  3666. if TypeEl is TPasClassType then exit;
  3667. RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  3668. [El.DestType.Name,'class'],El);
  3669. end;
  3670. procedure TPasResolver.FinishArrayType(El: TPasArrayType);
  3671. var
  3672. i: Integer;
  3673. Expr: TPasExpr;
  3674. RangeResolved: TPasResolverResult;
  3675. TypeEl: TPasType;
  3676. begin
  3677. for i:=0 to length(El.Ranges)-1 do
  3678. begin
  3679. Expr:=El.Ranges[i];
  3680. ResolveExpr(Expr,rraRead);
  3681. ComputeElement(Expr,RangeResolved,[rcConstant]);
  3682. if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
  3683. RaiseXExpectedButYFound(20170216151607,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
  3684. if (RangeResolved.BaseType=btRange) then
  3685. begin
  3686. if (RangeResolved.SubType in btArrayRangeTypes) then
  3687. // range, e.g. 1..2
  3688. else if RangeResolved.SubType=btContext then
  3689. begin
  3690. TypeEl:=ResolveAliasType(RangeResolved.TypeEl);
  3691. if TypeEl is TPasRangeType then
  3692. // custom range
  3693. else
  3694. RaiseXExpectedButYFound(20171009193629,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
  3695. end
  3696. else
  3697. RaiseXExpectedButYFound(20171009193514,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
  3698. end
  3699. else if RangeResolved.BaseType in btArrayRangeTypes then
  3700. // full range, e.g. array[char]
  3701. else if (RangeResolved.BaseType=btContext) and (RangeResolved.TypeEl is TPasEnumType) then
  3702. // e.g. array[enumtype]
  3703. else
  3704. RaiseXExpectedButYFound(20170216151609,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
  3705. end;
  3706. if El.ElType=nil then
  3707. RaiseNotYetImplemented(20171005235610,El,'array of const');
  3708. FinishSubElementType(El,El.ElType);
  3709. end;
  3710. procedure TPasResolver.FinishConstDef(El: TPasConst);
  3711. begin
  3712. ResolveExpr(El.Expr,rraRead);
  3713. if El.VarType<>nil then
  3714. begin
  3715. CheckAssignCompatibility(El,El.Expr,true);
  3716. EmitTypeHints(El,El.VarType);
  3717. end
  3718. else
  3719. Eval(El.Expr,[refConst])
  3720. end;
  3721. procedure TPasResolver.FinishResourcestring(El: TPasResString);
  3722. var
  3723. ResolvedEl: TPasResolverResult;
  3724. begin
  3725. ResolveExpr(El.Expr,rraRead);
  3726. ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
  3727. if not (ResolvedEl.BaseType in btAllStringAndChars) then
  3728. RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
  3729. end;
  3730. procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
  3731. var
  3732. i: Integer;
  3733. Body: TProcedureBody;
  3734. SubEl: TPasElement;
  3735. SubProcScope, ProcScope: TPasProcedureScope;
  3736. begin
  3737. {$IFDEF VerbosePasResolver}
  3738. writeln('TPasResolver.FinishProcedure START');
  3739. {$ENDIF}
  3740. CheckTopScope(FScopeClass_Proc);
  3741. ProcScope:=TPasProcedureScope(TopScope);
  3742. if ProcScope.Element<>aProc then
  3743. RaiseInternalError(20170220163043);
  3744. Body:=aProc.Body;
  3745. if Body<>nil then
  3746. begin
  3747. StoreScannerFlagsInProc(ProcScope);
  3748. if Body.Body is TPasImplAsmStatement then
  3749. aProc.Modifiers:=aProc.Modifiers+[pmAssembler];
  3750. ResolveImplBlock(Body.Body);
  3751. // check if all forward procs are resolved
  3752. for i:=0 to Body.Declarations.Count-1 do
  3753. begin
  3754. SubEl:=TPasElement(Body.Declarations[i]);
  3755. if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
  3756. begin
  3757. SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
  3758. if SubProcScope.ImplProc=nil then
  3759. RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
  3760. [SubEl.ElementTypeName,SubEl.Name],SubEl);
  3761. end;
  3762. end;
  3763. end;
  3764. PopScope;
  3765. end;
  3766. procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
  3767. var
  3768. ProcName: String;
  3769. FindData: TFindOverloadProcData;
  3770. DeclProc, Proc, ParentProc: TPasProcedure;
  3771. Abort, HasDots: boolean;
  3772. DeclProcScope, ProcScope: TPasProcedureScope;
  3773. ParentScope: TPasScope;
  3774. pm: TProcedureModifier;
  3775. ptm: TProcTypeModifier;
  3776. begin
  3777. if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
  3778. begin
  3779. // finished header of a procedure declaration
  3780. // -> search the best fitting proc
  3781. CheckTopScope(FScopeClass_Proc);
  3782. Proc:=TPasProcedure(El.Parent);
  3783. {$IFDEF VerbosePasResolver}
  3784. writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
  3785. {$ENDIF}
  3786. ProcName:=Proc.Name;
  3787. if (proProcTypeWithoutIsNested in Options) and El.IsNested then
  3788. RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
  3789. if (Proc.Parent.ClassType=TProcedureBody) then
  3790. begin
  3791. // nested sub proc
  3792. if not (proProcTypeWithoutIsNested in Options) then
  3793. El.IsNested:=true;
  3794. // inherit 'of Object'
  3795. ParentProc:=Proc.Parent.Parent as TPasProcedure;
  3796. if ParentProc.ProcType.IsOfObject then
  3797. El.IsOfObject:=true;
  3798. end;
  3799. if El.IsReferenceTo then
  3800. begin
  3801. if El.IsNested then
  3802. RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
  3803. if El.IsOfObject then
  3804. RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
  3805. end;
  3806. if Proc.IsExternal then
  3807. begin
  3808. for pm in Proc.Modifiers do
  3809. if not (pm in [pmVirtual, pmDynamic, pmOverride,
  3810. pmOverload, pmMessage, pmReintroduce,
  3811. pmExternal, pmDispId,
  3812. pmfar]) then
  3813. RaiseMsg(20170216151616,nInvalidXModifierY,
  3814. sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
  3815. for ptm in Proc.ProcType.Modifiers do
  3816. if not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo]) then
  3817. RaiseMsg(20170411171224,nInvalidXModifierY,
  3818. sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ProcTypeModifiers[ptm]],Proc);
  3819. end;
  3820. HasDots:=Pos('.',ProcName)>1;
  3821. if Proc.Parent is TPasClassType then
  3822. begin
  3823. // method declaration
  3824. if Proc.IsAbstract then
  3825. begin
  3826. if not Proc.IsVirtual then
  3827. RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
  3828. if Proc.IsOverride then
  3829. RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract, override'],Proc);
  3830. end;
  3831. if Proc.IsVirtual and Proc.IsOverride then
  3832. RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual, override'],Proc);
  3833. if Proc.IsReintroduced and Proc.IsOverride then
  3834. RaiseMsg(20171119111845,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'reintroduce, override'],Proc);
  3835. if Proc.IsForward then
  3836. RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'forward'],Proc);
  3837. if Proc.IsStatic then
  3838. if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
  3839. RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
  3840. end
  3841. else
  3842. begin
  3843. // intf proc, forward proc, proc body, method body
  3844. if Proc.IsAbstract then
  3845. RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
  3846. if Proc.IsVirtual then
  3847. RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
  3848. if Proc.IsOverride then
  3849. RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
  3850. if Proc.IsMessage then
  3851. RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
  3852. if Proc.IsStatic then
  3853. RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
  3854. if (not HasDots)
  3855. and (Proc.ClassType<>TPasProcedure)
  3856. and (Proc.ClassType<>TPasFunction) then
  3857. RaiseMsg(20170419232724,nXExpectedButYFound,sXExpectedButYFound,
  3858. ['full method name','short name'],El);
  3859. end;
  3860. if HasDots then
  3861. begin
  3862. FinishMethodImplHeader(Proc);
  3863. exit;
  3864. end;
  3865. // finish interface/implementation/nested procedure/method declaration
  3866. if not IsValidIdent(ProcName) then
  3867. RaiseNotYetImplemented(20160922163407,El);
  3868. if El is TPasFunctionType then
  3869. EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
  3870. if Proc.LibraryExpr<>nil then
  3871. ResolveExpr(Proc.LibraryExpr,rraRead);
  3872. if Proc.LibrarySymbolName<>nil then
  3873. ResolveExpr(Proc.LibrarySymbolName,rraRead);
  3874. if Proc.Parent is TPasClassType then
  3875. begin
  3876. FinishMethodDeclHeader(Proc);
  3877. exit;
  3878. end;
  3879. // finish interface/implementation/nested procedure
  3880. if ProcNeedsBody(Proc) then
  3881. begin
  3882. // check if there is a forward declaration
  3883. ParentScope:=Scopes[ScopeCount-2];
  3884. //writeln('TPasResolver.FinishProcedureType FindForward2 ',GetObjName(ParentScope));
  3885. DeclProc:=FindProcOverload(ProcName,Proc,ParentScope);
  3886. //writeln('TPasResolver.FinishProcedureType FindForward3 ',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
  3887. if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
  3888. DeclProc:=FindProcOverload(ProcName,Proc,
  3889. (Proc.GetModule.InterfaceSection.CustomData) as TPasScope);
  3890. //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc));
  3891. if (DeclProc<>nil) and ProcNeedsImplProc(DeclProc) then
  3892. begin
  3893. // found forward declaration -> connect
  3894. {$IFDEF VerbosePasResolver}
  3895. writeln('TPasResolver.FinishProcedureHeader forward found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
  3896. {$ENDIF}
  3897. CheckProcSignatureMatch(DeclProc,Proc,true);
  3898. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  3899. DeclProcScope.ImplProc:=Proc;
  3900. ProcScope:=Proc.CustomData as TPasProcedureScope;
  3901. ProcScope.DeclarationProc:=DeclProc;
  3902. // remove ImplProc from scope
  3903. ParentScope:=Scopes[ScopeCount-2];
  3904. (ParentScope as TPasIdentifierScope).RemoveLocalIdentifier(Proc);
  3905. // replace arguments with declaration arguments
  3906. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  3907. exit;
  3908. end;
  3909. end
  3910. else
  3911. begin
  3912. // forward declaration
  3913. ProcScope:=Proc.CustomData as TPasProcedureScope;
  3914. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  3915. StoreScannerFlagsInProc(ProcScope);
  3916. end;
  3917. // check for invalid overloads
  3918. FindData:=Default(TFindOverloadProcData);
  3919. FindData.Proc:=Proc;
  3920. FindData.Args:=Proc.ProcType.Args;
  3921. FindData.Kind:=fopkProc;
  3922. Abort:=false;
  3923. IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
  3924. end
  3925. else if El.Name<>'' then
  3926. begin
  3927. // finished proc type, e.g. type TProcedure = procedure;
  3928. end
  3929. else
  3930. RaiseNotYetImplemented(20160922163411,El.Parent);
  3931. end;
  3932. procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
  3933. procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
  3934. begin
  3935. LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
  3936. sVirtualMethodXHasLowerVisibility,[Proc.Name,
  3937. VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
  3938. VisibilityNames[OverloadProc.Visibility]],Proc);
  3939. Proc.Visibility:=OverloadProc.Visibility;
  3940. end;
  3941. {$IF FPC_FULLVERSION<30101}
  3942. procedure Delete(var A: TArrayOfPasProcedure; Index, Count: integer); overload;
  3943. var
  3944. i: Integer;
  3945. begin
  3946. if Index<0 then
  3947. RaiseInternalError(20171227121538);
  3948. if Index+Count>length(A) then
  3949. RaiseInternalError(20171227121156);
  3950. for i:=Index+Count to length(A)-1 do
  3951. A[i-Count]:=A[i];
  3952. SetLength(A,length(A)-Count);
  3953. end;
  3954. procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
  3955. var
  3956. i: Integer;
  3957. begin
  3958. if Index<0 then
  3959. RaiseInternalError(20171227121544);
  3960. if Index>length(A) then
  3961. RaiseInternalError(20171227121558);
  3962. SetLength(A,length(A)+1);
  3963. for i:=length(A)-1 downto Index+1 do
  3964. A[i]:=A[i-1];
  3965. A[Index]:=Item;
  3966. end;
  3967. {$ENDIF}
  3968. var
  3969. Abort: boolean;
  3970. ClassScope: TPasClassScope;
  3971. FindData: TFindOverloadProcData;
  3972. OverloadProc: TPasProcedure;
  3973. ProcScope: TPasProcedureScope;
  3974. i: Integer;
  3975. begin
  3976. Proc.ProcType.IsOfObject:=true;
  3977. ProcScope:=TopScope as TPasProcedureScope;
  3978. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  3979. StoreScannerFlagsInProc(ProcScope);
  3980. ClassScope:=Scopes[ScopeCount-2] as TPasClassScope;
  3981. ProcScope.ClassScope:=ClassScope;
  3982. FindData:=Default(TFindOverloadProcData);
  3983. FindData.Proc:=Proc;
  3984. FindData.Args:=Proc.ProcType.Args;
  3985. FindData.Kind:=fopkMethod;
  3986. Abort:=false;
  3987. ClassScope.IterateElements(Proc.Name,ClassScope,@OnFindOverloadProc,@FindData,Abort);
  3988. if FindData.Found=nil then
  3989. begin
  3990. // no overload
  3991. if Proc.IsOverride then
  3992. RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
  3993. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  3994. end
  3995. else
  3996. begin
  3997. // overload found
  3998. OverloadProc:=FindData.Found;
  3999. // Note: 'inherited;' needs the OverriddenProc, even without 'override' modifier
  4000. ProcScope.OverriddenProc:=OverloadProc;
  4001. if Proc.IsOverride then
  4002. begin
  4003. if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
  4004. // the OverloadProc fits the signature, but is not virtual
  4005. RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
  4006. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  4007. // override a virtual method
  4008. CheckProcSignatureMatch(OverloadProc,Proc,false);
  4009. // check visibility
  4010. if Proc.Visibility<>OverloadProc.Visibility then
  4011. case Proc.Visibility of
  4012. visPrivate,visStrictPrivate:
  4013. if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
  4014. VisibilityLowered(Proc,OverloadProc);
  4015. visProtected,visStrictProtected:
  4016. if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
  4017. VisibilityLowered(Proc,OverloadProc);
  4018. visPublic:
  4019. if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
  4020. VisibilityLowered(Proc,OverloadProc);
  4021. visPublished: ;
  4022. else
  4023. RaiseNotYetImplemented(20170325003315,Proc,'visibility');
  4024. end;
  4025. // check name case
  4026. if proFixCaseOfOverrides in Options then
  4027. Proc.Name:=OverloadProc.Name;
  4028. // remove abstract
  4029. if OverloadProc.IsAbstract then
  4030. for i:=length(ClassScope.AbstractProcs)-1 downto 0 do
  4031. if ClassScope.AbstractProcs[i]=OverloadProc then
  4032. Delete(ClassScope.AbstractProcs,i,1);
  4033. end;
  4034. end;
  4035. // add abstract
  4036. if Proc.IsAbstract then
  4037. Insert(Proc,ClassScope.AbstractProcs,length(ClassScope.AbstractProcs));
  4038. end;
  4039. procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
  4040. var
  4041. ProcName: String;
  4042. CurClassType: TPasClassType;
  4043. ImplProcScope, DeclProcScope: TPasProcedureScope;
  4044. DeclProc: TPasProcedure;
  4045. CurClassScope: TPasClassScope;
  4046. SelfArg: TPasArgument;
  4047. p: Integer;
  4048. begin
  4049. if ImplProc.IsExternal then
  4050. RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'external'],ImplProc);
  4051. if ImplProc.IsExported then
  4052. RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'export'],ImplProc);
  4053. ProcName:=ImplProc.Name;
  4054. {$IFDEF VerbosePasResolver}
  4055. writeln('TPasResolver.FinishMethodBodyHeader searching declaration "',ProcName,'" ...');
  4056. {$ENDIF}
  4057. ImplProc.ProcType.IsOfObject:=true;
  4058. repeat
  4059. p:=Pos('.',ProcName);
  4060. if p<1 then break;
  4061. Delete(ProcName,1,p);
  4062. until false;
  4063. // search ImplProc in class
  4064. if not IsValidIdent(ProcName) then
  4065. RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
  4066. // search proc in class
  4067. ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
  4068. CurClassScope:=ImplProcScope.ClassScope;
  4069. if CurClassScope=nil then
  4070. RaiseInternalError(20161013172346);
  4071. CurClassType:=NoNil(CurClassScope.Element) as TPasClassType;
  4072. DeclProc:=FindProcOverload(ProcName,ImplProc,CurClassScope);
  4073. if DeclProc=nil then
  4074. RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
  4075. // connect method declaration and body
  4076. if DeclProc.IsAbstract then
  4077. RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
  4078. if DeclProc.IsExternal then
  4079. RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
  4080. CheckProcSignatureMatch(DeclProc,ImplProc,true);
  4081. ImplProcScope.DeclarationProc:=DeclProc;
  4082. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  4083. DeclProcScope.ImplProc:=ImplProc;
  4084. // replace arguments in scope with declaration arguments
  4085. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  4086. if not DeclProc.IsStatic then
  4087. begin
  4088. // add 'Self'
  4089. if (DeclProc.ClassType=TPasClassConstructor)
  4090. or (DeclProc.ClassType=TPasClassDestructor)
  4091. or (DeclProc.ClassType=TPasClassProcedure)
  4092. or (DeclProc.ClassType=TPasClassFunction) then
  4093. begin
  4094. if not DeclProc.IsStatic then
  4095. begin
  4096. // 'Self' in a class proc is the hidden classtype argument
  4097. SelfArg:=TPasArgument.Create('Self',DeclProc);
  4098. ImplProcScope.SelfArg:=SelfArg;
  4099. SelfArg.Access:=argConst;
  4100. SelfArg.ArgType:=CurClassScope.CanonicalClassOf;
  4101. SelfArg.ArgType.AddRef;
  4102. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  4103. end;
  4104. end
  4105. else
  4106. begin
  4107. // 'Self' in a proc is the hidden instance argument
  4108. SelfArg:=TPasArgument.Create('Self',DeclProc);
  4109. ImplProcScope.SelfArg:=SelfArg;
  4110. SelfArg.Access:=argConst;
  4111. SelfArg.ArgType:=CurClassType;
  4112. CurClassType.AddRef;
  4113. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  4114. end;
  4115. end;
  4116. {$IFDEF VerbosePasResolver}
  4117. writeln('TPasResolver.FinishMethodBodyHeader END of searching proc "',ImplProc.Name,'" ...');
  4118. {$ENDIF}
  4119. end;
  4120. procedure TPasResolver.FinishExceptOnExpr;
  4121. var
  4122. El: TPasImplExceptOn;
  4123. ResolvedType: TPasResolverResult;
  4124. begin
  4125. CheckTopScope(TPasExceptOnScope);
  4126. El:=TPasImplExceptOn(FTopScope.Element);
  4127. ComputeElement(El.TypeEl,ResolvedType,[rcSkipTypeAlias,rcType]);
  4128. CheckIsClass(El.TypeEl,ResolvedType);
  4129. end;
  4130. procedure TPasResolver.FinishExceptOnStatement;
  4131. begin
  4132. //writeln('TPasResolver.FinishExceptOnStatement START');
  4133. CheckTopScope(TPasExceptOnScope);
  4134. ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
  4135. PopScope;
  4136. end;
  4137. procedure TPasResolver.FinishDeclaration(El: TPasElement);
  4138. var
  4139. C: TClass;
  4140. begin
  4141. C:=El.ClassType;
  4142. if C=TPasVariable then
  4143. FinishVariable(TPasVariable(El))
  4144. else if C=TPasProperty then
  4145. FinishPropertyOfClass(TPasProperty(El))
  4146. else if C=TPasArgument then
  4147. FinishArgument(TPasArgument(El))
  4148. else
  4149. begin
  4150. {$IFDEF VerbosePasResolver}
  4151. writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
  4152. {$ENDIF}
  4153. end;
  4154. end;
  4155. procedure TPasResolver.FinishVariable(El: TPasVariable);
  4156. var
  4157. ResolvedAbs: TPasResolverResult;
  4158. C: TClass;
  4159. begin
  4160. if (El.Visibility=visPublished) then
  4161. begin
  4162. if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
  4163. RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  4164. end;
  4165. if El.Expr<>nil then
  4166. begin
  4167. ResolveExpr(El.Expr,rraRead);
  4168. CheckAssignCompatibility(El,El.Expr,true);
  4169. end;
  4170. if El.AbsoluteExpr<>nil then
  4171. begin
  4172. if El.VarType=nil then
  4173. RaiseMsg(20171225235125,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  4174. if vmExternal in El.VarModifiers then
  4175. RaiseMsg(20171226104221,nXModifierMismatchY,sXModifierMismatchY,
  4176. ['absolute','external'],El.AbsoluteExpr);
  4177. {$IFDEF VerbosePasResolver}
  4178. writeln('TPasResolver.FinishVariable El=',GetObjName(El),' Absolute="',GetObjName(El.AbsoluteExpr),'"');
  4179. {$ENDIF}
  4180. ResolveExpr(El.AbsoluteExpr,rraRead);
  4181. ComputeElement(El.AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
  4182. if (not (rrfReadable in ResolvedAbs.Flags))
  4183. or (ResolvedAbs.IdentEl=nil) then
  4184. RaiseMsg(20171225234734,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  4185. C:=ResolvedAbs.IdentEl.ClassType;
  4186. if (C=TPasVariable)
  4187. or (C=TPasArgument)
  4188. or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
  4189. else
  4190. RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  4191. if not (rrfReadable in ResolvedAbs.Flags) then
  4192. RaiseMsg(20171225235249,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  4193. // check for cycles
  4194. if ResolvedAbs.IdentEl=El then
  4195. RaiseMsg(20171226000703,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  4196. end;
  4197. EmitTypeHints(El,El.VarType);
  4198. end;
  4199. procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
  4200. var
  4201. PropType: TPasType;
  4202. ClassScope: TPasClassScope;
  4203. AncestorProp: TPasProperty;
  4204. IndexExpr: TPasExpr;
  4205. procedure GetPropType;
  4206. var
  4207. AncEl: TPasElement;
  4208. begin
  4209. if PropType<>nil then exit;
  4210. AncEl:=nil;
  4211. if ClassScope.AncestorScope<>nil then
  4212. AncEl:=ClassScope.AncestorScope.FindElement(PropEl.Name);
  4213. if AncEl is TPasProperty then
  4214. begin
  4215. // override or redeclaration property
  4216. AncestorProp:=TPasProperty(AncEl);
  4217. TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncestorProp;
  4218. AncestorProp.AddRef;
  4219. if proFixCaseOfOverrides in Options then
  4220. PropEl.Name:=AncestorProp.Name;
  4221. end
  4222. else
  4223. AncestorProp:=nil;
  4224. if PropEl.VarType<>nil then
  4225. begin
  4226. // new property or redeclaration
  4227. PropType:=PropEl.VarType;
  4228. end
  4229. else
  4230. begin
  4231. // property override
  4232. if AncestorProp=nil then
  4233. RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
  4234. // check property versus class property
  4235. if PropEl.ClassType<>AncestorProp.ClassType then
  4236. RaiseXExpectedButYFound(20170216151744,AncestorProp.ElementTypeName,PropEl.ElementTypeName,PropEl);
  4237. // get inherited type
  4238. PropType:=GetPasPropertyType(AncestorProp);
  4239. // update DefaultProperty
  4240. if (ClassScope.DefaultProperty=AncestorProp) then
  4241. ClassScope.DefaultProperty:=PropEl;
  4242. end;
  4243. end;
  4244. function GetAccessor(Expr: TPasExpr): TPasElement;
  4245. var
  4246. Prim: TPrimitiveExpr;
  4247. DeclEl: TPasElement;
  4248. Identifier: TPasIdentifier;
  4249. Scope: TPasIdentifierScope;
  4250. begin
  4251. if Expr.ClassType=TBinaryExpr then
  4252. begin
  4253. if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
  4254. begin
  4255. Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
  4256. if Prim.Kind<>pekIdent then
  4257. RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
  4258. Scope:=TopScope as TPasIdentifierScope;
  4259. // search in class and ancestors, not in unit interface
  4260. Identifier:=Scope.FindIdentifier(Prim.Value);
  4261. if Identifier=nil then
  4262. RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
  4263. DeclEl:=Identifier.Element;
  4264. if DeclEl.ClassType<>TPasClassType then
  4265. RaiseXExpectedButYFound(20170216151752,'class',DeclEl.ElementTypeName,Prim);
  4266. CreateReference(DeclEl,Prim,rraRead);
  4267. end
  4268. else
  4269. RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  4270. if TBinaryExpr(Expr).OpCode<>eopSubIdent then
  4271. RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  4272. PushClassDotScope(TPasClassType(DeclEl));
  4273. Expr:=TBinaryExpr(Expr).right;
  4274. Result:=GetAccessor(Expr);
  4275. PopScope;
  4276. end
  4277. else if Expr.ClassType=TPrimitiveExpr then
  4278. begin
  4279. Prim:=TPrimitiveExpr(Expr);
  4280. if Prim.Kind<>pekIdent then
  4281. RaiseXExpectedButYFound(20170216151800,'identifier',Prim.Value,Prim);
  4282. Scope:=TopScope as TPasIdentifierScope;
  4283. // search in class and ancestors, not in unit interface
  4284. Identifier:=Scope.FindIdentifier(Prim.Value);
  4285. if Identifier=nil then
  4286. RaiseIdentifierNotFound(20170216151803,Prim.Value,Prim);
  4287. DeclEl:=Identifier.Element;
  4288. CreateReference(DeclEl,Prim,rraRead);
  4289. Result:=DeclEl;
  4290. end
  4291. else
  4292. RaiseNotYetImplemented(20160922163436,Expr);
  4293. end;
  4294. procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
  4295. ProcArg: TPasArgument; ErrorEl: TPasElement);
  4296. var
  4297. ProcArgResolved: TPasResolverResult;
  4298. begin
  4299. // check access: const, ...
  4300. if not (ProcArg.Access in [argDefault,argConst]) then
  4301. RaiseMsg(20170924202437,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4302. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  4303. AccessDescriptions[argConst]],ErrorEl);
  4304. // check argument type
  4305. if ProcArg.ArgType=nil then
  4306. RaiseMsg(20170924202531,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4307. [IntToStr(ArgNo),'untyped',GetTypeDescription(IndexResolved)],ErrorEl)
  4308. else
  4309. begin
  4310. if CheckParamCompatibility(IndexExpr,ProcArg,ArgNo,true)=cIncompatible then
  4311. begin
  4312. ComputeElement(ProcArg.ArgType,ProcArgResolved,[rcType]);
  4313. RaiseIncompatibleTypeRes(20170924203829,nIncompatibleTypeArgNo,
  4314. [IntToStr(ArgNo)],ProcArgResolved,IndexResolved,ErrorEl);
  4315. end;
  4316. end;
  4317. end;
  4318. procedure CheckArgs(Proc: TPasProcedure; const IndexVal: TResEvalValue;
  4319. const IndexResolved: TPasResolverResult; ErrorEl: TPasElement);
  4320. var
  4321. ArgNo: Integer;
  4322. PropArg, ProcArg: TPasArgument;
  4323. PropArgResolved, ProcArgResolved: TPasResolverResult;
  4324. begin
  4325. ArgNo:=0;
  4326. while ArgNo<PropEl.Args.Count do
  4327. begin
  4328. if ArgNo>=Proc.ProcType.Args.Count then
  4329. RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
  4330. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  4331. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  4332. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  4333. inc(ArgNo);
  4334. // check access: var, const, ...
  4335. if PropArg.Access<>ProcArg.Access then
  4336. RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4337. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  4338. AccessDescriptions[PropArg.Access]],ErrorEl);
  4339. // check argument type
  4340. if PropArg.ArgType=nil then
  4341. begin
  4342. if ProcArg.ArgType<>nil then
  4343. RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4344. [IntToStr(ArgNo),ProcArg.ArgType.ElementTypeName,'untyped'],ErrorEl);
  4345. end
  4346. else if ProcArg.ArgType=nil then
  4347. RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4348. [IntToStr(ArgNo),'untyped',PropArg.ArgType.ElementTypeName],ErrorEl)
  4349. else
  4350. begin
  4351. ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
  4352. ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
  4353. if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
  4354. RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4355. [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
  4356. if PropArgResolved.TypeEl=nil then
  4357. RaiseInternalError(20161010125255);
  4358. if ProcArgResolved.TypeEl=nil then
  4359. RaiseInternalError(20161010125304);
  4360. if not IsSameType(PropArgResolved.TypeEl,ProcArgResolved.TypeEl,true) then
  4361. RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
  4362. [IntToStr(ArgNo)],ProcArgResolved.TypeEl,PropArgResolved.TypeEl,ErrorEl);
  4363. end;
  4364. end;
  4365. if IndexVal<>nil then
  4366. begin
  4367. if ArgNo>=Proc.ProcType.Args.Count then
  4368. RaiseMsg(20170924202334,nWrongNumberOfParametersForCallTo,
  4369. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  4370. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  4371. CheckIndexArg(ArgNo,IndexResolved,ProcArg,ErrorEl);
  4372. end;
  4373. end;
  4374. procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
  4375. const IndexResolved: TPasResolverResult);
  4376. var
  4377. ResolvedEl: TPasResolverResult;
  4378. Value: TResEvalValue;
  4379. Proc: TPasProcedure;
  4380. ResultType, TypeEl: TPasType;
  4381. aVar: TPasVariable;
  4382. IdentEl: TPasElement;
  4383. ExpArgCnt: Integer;
  4384. ProcArg: TPasArgument;
  4385. begin
  4386. ResolveExpr(Expr,rraRead);
  4387. ComputeElement(Expr,ResolvedEl,[rcNoImplicitProc]);
  4388. IdentEl:=ResolvedEl.IdentEl;
  4389. if IdentEl is TPasProcedure then
  4390. begin
  4391. // function
  4392. Proc:=TPasProcedure(IdentEl);
  4393. // check if member
  4394. if not (Expr is TPrimitiveExpr) then
  4395. RaiseXExpectedButYFound(20170923202002,'member function','foreign '+Proc.ElementTypeName,Expr);
  4396. if Proc.ClassType<>TPasFunction then
  4397. RaiseXExpectedButYFound(20170216151925,'function',Proc.ElementTypeName,Expr);
  4398. // check function result type
  4399. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  4400. if not IsBaseType(ResultType,btBoolean,true) then
  4401. RaiseXExpectedButYFound(20170923200836,'function: boolean',
  4402. 'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
  4403. // check arg count
  4404. ExpArgCnt:=0;
  4405. if IndexVal<>nil then
  4406. inc(ExpArgCnt);
  4407. if Proc.ProcType.Args.Count<>ExpArgCnt then
  4408. RaiseMsg(20170923200840,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  4409. [Proc.Name],Expr);
  4410. if IndexVal<>nil then
  4411. begin
  4412. // check arg type
  4413. ProcArg:=TPasArgument(Proc.ProcType.Args[0]);
  4414. CheckIndexArg(1,IndexResolved,ProcArg,Expr);
  4415. end;
  4416. exit;
  4417. end;
  4418. if (IdentEl<>nil)
  4419. and ((IdentEl.ClassType=TPasVariable)
  4420. or ((IdentEl.ClassType=TPasConst) and not TPasConst(IdentEl).IsConst)) then
  4421. begin
  4422. // field
  4423. aVar:=TPasVariable(IdentEl);
  4424. // check if member
  4425. if not (Expr is TPrimitiveExpr) then
  4426. RaiseXExpectedButYFound(20170923202003,'member variable','foreign '+aVar.ElementTypeName,Expr);
  4427. // check type boolean
  4428. TypeEl:=aVar.VarType;
  4429. TypeEl:=ResolveAliasType(TypeEl);
  4430. if not IsBaseType(TypeEl,btBoolean,true) then
  4431. RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
  4432. [],TypeEl,BaseTypes[btBoolean],Expr);
  4433. // check class var
  4434. if (vmClass in PropEl.VarModifiers)<>(vmClass in aVar.VarModifiers) then
  4435. if vmClass in PropEl.VarModifiers then
  4436. RaiseXExpectedButYFound(20170409214351,'class var','var',Expr)
  4437. else
  4438. RaiseXExpectedButYFound(20170409214359,'var','class var',Expr);
  4439. exit;
  4440. end;
  4441. if (ResolvedEl.BaseType=btBoolean) and (ResolvedEl.ExprEl<>nil) then
  4442. begin
  4443. // try evaluating const boolean
  4444. Value:=Eval(Expr,[refConst]);
  4445. if Value<>nil then
  4446. try
  4447. if Value.Kind<>revkBool then
  4448. RaiseXExpectedButYFound(20170923200256,'boolean',GetResolverResultDescription(ResolvedEl),Expr);
  4449. exit;
  4450. finally
  4451. ReleaseEvalValue(Value);
  4452. end;
  4453. end;
  4454. RaiseXExpectedButYFound(20170923194234,'identifier',GetResolverResultDescription(ResolvedEl),Expr);
  4455. end;
  4456. var
  4457. ResultType: TPasType;
  4458. CurClassType: TPasClassType;
  4459. AccEl: TPasElement;
  4460. Proc: TPasProcedure;
  4461. Arg: TPasArgument;
  4462. PropArgCount, NeedArgCnt: Integer;
  4463. PropTypeResolved, DefaultResolved, IndexResolved,
  4464. AncIndexResolved: TPasResolverResult;
  4465. m: TVariableModifier;
  4466. IndexVal: TResEvalValue;
  4467. AncIndexExpr: TPasExpr;
  4468. begin
  4469. CheckTopScope(TPasPropertyScope);
  4470. PopScope;
  4471. if PropEl.Visibility=visPublished then
  4472. for m in PropEl.VarModifiers do
  4473. if not (m in [vmExternal]) then
  4474. RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
  4475. ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
  4476. PropType:=nil;
  4477. CurClassType:=PropEl.Parent as TPasClassType;
  4478. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  4479. AncestorProp:=nil;
  4480. GetPropType;
  4481. IndexVal:=nil;
  4482. try
  4483. if PropEl.IndexExpr<>nil then
  4484. begin
  4485. // index specifier
  4486. // -> check if simple value
  4487. IndexExpr:=PropEl.IndexExpr;
  4488. ResolveExpr(IndexExpr,rraRead);
  4489. end
  4490. else
  4491. IndexExpr:=GetPasPropertyIndex(PropEl);
  4492. if IndexExpr<>nil then
  4493. begin
  4494. ComputeElement(IndexExpr,IndexResolved,[rcConstant]);
  4495. IndexVal:=Eval(IndexExpr,[refConst]);
  4496. case IndexVal.Kind of
  4497. revkBool,
  4498. revkInt, revkUInt,
  4499. revkFloat,
  4500. revkString, revkUnicodeString,
  4501. revkEnum: ; // ok
  4502. else
  4503. RaiseXExpectedButYFound(20170924202837,'ordinal',GetTypeDescription(IndexResolved),PropEl.IndexExpr);
  4504. end;
  4505. if (PropEl.IndexExpr<>nil) and (PropEl.VarType=nil) then
  4506. begin
  4507. // check if index is compatible to ancestor index specifier
  4508. AncIndexExpr:=GetPasPropertyIndex(AncestorProp);
  4509. if AncIndexExpr=nil then
  4510. begin
  4511. // ancestor had no index specifier
  4512. if PropEl.ReadAccessor=nil then
  4513. begin
  4514. AccEl:=GetPasPropertyGetter(AncestorProp);
  4515. if AccEl is TPasProcedure then
  4516. RaiseMsg(20171002144103,nAddingIndexSpecifierRequiresNewX,
  4517. sAddingIndexSpecifierRequiresNewX,['read'],IndexExpr);
  4518. end;
  4519. if PropEl.WriteAccessor=nil then
  4520. begin
  4521. AccEl:=GetPasPropertySetter(AncestorProp);
  4522. if AccEl is TPasProcedure then
  4523. RaiseMsg(20171002144419,nAddingIndexSpecifierRequiresNewX,
  4524. sAddingIndexSpecifierRequiresNewX,['write'],IndexExpr);
  4525. end;
  4526. if PropEl.StoredAccessor=nil then
  4527. begin
  4528. AccEl:=GetPasPropertyStoredExpr(AncestorProp);
  4529. if AccEl<>nil then
  4530. begin
  4531. ComputeElement(AccEl,AncIndexResolved,[rcNoImplicitProc]);
  4532. if AncIndexResolved.IdentEl is TPasProcedure then
  4533. RaiseMsg(20171002144644,nAddingIndexSpecifierRequiresNewX,
  4534. sAddingIndexSpecifierRequiresNewX,['stored'],IndexExpr);
  4535. end;
  4536. end;
  4537. end
  4538. else
  4539. // ancestor had already an index specifier -> check same type
  4540. CheckEqualElCompatibility(PropEl.IndexExpr,AncIndexExpr,PropEl.IndexExpr,true);
  4541. end;
  4542. end;
  4543. if PropEl.ReadAccessor<>nil then
  4544. begin
  4545. // check compatibility
  4546. AccEl:=GetAccessor(PropEl.ReadAccessor);
  4547. if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
  4548. begin
  4549. if (PropEl.Args.Count>0) then
  4550. RaiseXExpectedButYFound(20170216151823,'function',AccEl.ElementTypeName,PropEl.ReadAccessor);
  4551. if not IsSameType(TPasVariable(AccEl).VarType,PropType,true) then
  4552. RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
  4553. [],PropType,TPasVariable(AccEl).VarType,PropEl.ReadAccessor);
  4554. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  4555. if vmClass in PropEl.VarModifiers then
  4556. RaiseXExpectedButYFound(20170216151828,'class var','var',PropEl.ReadAccessor)
  4557. else
  4558. RaiseXExpectedButYFound(20170216151831,'var','class var',PropEl.ReadAccessor);
  4559. end
  4560. else if AccEl is TPasProcedure then
  4561. begin
  4562. // check function
  4563. Proc:=TPasProcedure(AccEl);
  4564. if (vmClass in PropEl.VarModifiers) then
  4565. begin
  4566. if Proc.ClassType<>TPasClassFunction then
  4567. RaiseXExpectedButYFound(20170216151834,'class function',Proc.ElementTypeName,PropEl.ReadAccessor);
  4568. if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
  4569. if Proc.IsStatic then
  4570. RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
  4571. else
  4572. RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
  4573. end
  4574. else
  4575. begin
  4576. if Proc.ClassType<>TPasFunction then
  4577. RaiseXExpectedButYFound(20170216151842,'function',Proc.ElementTypeName,PropEl.ReadAccessor);
  4578. end;
  4579. // check function result type
  4580. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  4581. if not IsSameType(ResultType,PropType,true) then
  4582. RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
  4583. GetTypeDescription(ResultType,true),PropEl.ReadAccessor);
  4584. // check args
  4585. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  4586. NeedArgCnt:=PropEl.Args.Count;
  4587. if IndexVal<>nil then
  4588. inc(NeedArgCnt);
  4589. if Proc.ProcType.Args.Count<>NeedArgCnt then
  4590. RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  4591. [Proc.Name],PropEl.ReadAccessor);
  4592. end
  4593. else
  4594. RaiseXExpectedButYFound(20170216151850,'variable',AccEl.ElementTypeName,PropEl.ReadAccessor);
  4595. end;
  4596. if PropEl.WriteAccessor<>nil then
  4597. begin
  4598. // check compatibility
  4599. AccEl:=GetAccessor(PropEl.WriteAccessor);
  4600. if (AccEl.ClassType=TPasVariable)
  4601. or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
  4602. begin
  4603. if (PropEl.Args.Count>0) then
  4604. RaiseXExpectedButYFound(20170216151852,'procedure',AccEl.ElementTypeName,PropEl.WriteAccessor);
  4605. if not IsSameType(TPasVariable(AccEl).VarType,PropType,true) then
  4606. RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
  4607. [],PropType,TPasVariable(AccEl).VarType,PropEl.WriteAccessor);
  4608. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  4609. if vmClass in PropEl.VarModifiers then
  4610. RaiseXExpectedButYFound(20170216151858,'class var','var',PropEl.WriteAccessor)
  4611. else
  4612. RaiseXExpectedButYFound(20170216151900,'var','class var',PropEl.WriteAccessor);
  4613. end
  4614. else if AccEl is TPasProcedure then
  4615. begin
  4616. // check procedure
  4617. Proc:=TPasProcedure(AccEl);
  4618. if (vmClass in PropEl.VarModifiers) then
  4619. begin
  4620. if Proc.ClassType<>TPasClassProcedure then
  4621. RaiseXExpectedButYFound(20170216151903,'class procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
  4622. if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
  4623. if Proc.IsStatic then
  4624. RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
  4625. else
  4626. RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
  4627. end
  4628. else
  4629. begin
  4630. if Proc.ClassType<>TPasProcedure then
  4631. RaiseXExpectedButYFound(20170216151910,'procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
  4632. end;
  4633. // check args
  4634. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  4635. // check write arg
  4636. PropArgCount:=PropEl.Args.Count;
  4637. if IndexVal<>nil then
  4638. inc(PropArgCount);
  4639. if Proc.ProcType.Args.Count<>PropArgCount+1 then
  4640. RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  4641. [Proc.Name],PropEl.WriteAccessor);
  4642. Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
  4643. if not (Arg.Access in [argDefault,argConst]) then
  4644. RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  4645. [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
  4646. AccessDescriptions[argConst]],PropEl.WriteAccessor);
  4647. if not IsSameType(Arg.ArgType,PropType,true) then
  4648. RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
  4649. [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
  4650. end
  4651. else
  4652. RaiseXExpectedButYFound(20170216151921,'variable',AccEl.ElementTypeName,PropEl.WriteAccessor);
  4653. end;
  4654. if PropEl.ImplementsFunc<>nil then
  4655. begin
  4656. ResolveExpr(PropEl.ImplementsFunc,rraRead);
  4657. // ToDo: check compatibility
  4658. RaiseNotYetImplemented(20170409213850,PropEl.ImplementsFunc);
  4659. end;
  4660. if PropEl.StoredAccessor<>nil then
  4661. begin
  4662. // check compatibility
  4663. CheckStoredAccessor(PropEl.StoredAccessor,IndexVal,IndexResolved);
  4664. end;
  4665. if PropEl.DefaultExpr<>nil then
  4666. begin
  4667. // check compatibility with type
  4668. ResolveExpr(PropEl.DefaultExpr,rraRead);
  4669. ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
  4670. ComputeElement(PropType,PropTypeResolved,[rcType]);
  4671. PropTypeResolved.IdentEl:=PropEl;
  4672. PropTypeResolved.Flags:=[rrfReadable];
  4673. CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
  4674. end;
  4675. if PropEl.IsDefault then
  4676. begin
  4677. // set default array property
  4678. if (ClassScope.DefaultProperty<>nil)
  4679. and (ClassScope.DefaultProperty.Parent=PropEl.Parent) then
  4680. RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
  4681. ClassScope.DefaultProperty:=PropEl;
  4682. end;
  4683. EmitTypeHints(PropEl,PropEl.VarType);
  4684. finally
  4685. ReleaseEvalValue(IndexVal);
  4686. end;
  4687. end;
  4688. procedure TPasResolver.FinishArgument(El: TPasArgument);
  4689. begin
  4690. if El.ValueExpr<>nil then
  4691. begin
  4692. ResolveExpr(El.ValueExpr,rraRead);
  4693. if El.ArgType<>nil then
  4694. CheckAssignCompatibility(El,El.ValueExpr,true);
  4695. end;
  4696. EmitTypeHints(El,El.ArgType);
  4697. end;
  4698. procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
  4699. // called when the ancestor and interface list of a class has been parsed,
  4700. // before parsing the class elements
  4701. var
  4702. AncestorEl: TPasClassType;
  4703. ClassScope, AncestorClassScope: TPasClassScope;
  4704. DirectAncestor, AncestorType, El: TPasType;
  4705. i: Integer;
  4706. aModifier: String;
  4707. IsSealed: Boolean;
  4708. CanonicalSelf: TPasClassOfType;
  4709. begin
  4710. if aClass.IsForward then
  4711. exit;
  4712. if aClass.ObjKind<>okClass then
  4713. begin
  4714. if (aClass.ObjKind=okInterface)
  4715. and (msIgnoreInterfaces in CurrentParser.CurrentModeswitches) then
  4716. exit;
  4717. RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
  4718. end;
  4719. IsSealed:=false;
  4720. for i:=0 to aClass.Modifiers.Count-1 do
  4721. begin
  4722. aModifier:=lowercase(aClass.Modifiers[i]);
  4723. case aModifier of
  4724. 'sealed': IsSealed:=true;
  4725. else
  4726. RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
  4727. end;
  4728. end;
  4729. DirectAncestor:=aClass.AncestorType;
  4730. AncestorType:=ResolveAliasType(DirectAncestor);
  4731. if AncestorType=nil then
  4732. begin
  4733. if (CompareText(aClass.Name,'TObject')=0) or aClass.IsExternal then
  4734. begin
  4735. // ok, no ancestors
  4736. AncestorEl:=nil;
  4737. end else begin
  4738. // search default ancestor TObject
  4739. AncestorEl:=TPasClassType(FindElementWithoutParams('TObject',aClass,false));
  4740. if not (AncestorEl is TPasClassType) then
  4741. RaiseXExpectedButYFound(20170216151941,'class type',GetObjName(AncestorEl),aClass);
  4742. if DirectAncestor=nil then
  4743. DirectAncestor:=AncestorEl;
  4744. end;
  4745. end
  4746. else if AncestorType.ClassType<>TPasClassType then
  4747. RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
  4748. else if aClass=AncestorType then
  4749. RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
  4750. else
  4751. begin
  4752. AncestorEl:=TPasClassType(AncestorType);
  4753. if AncestorEl.ObjKind<>okClass then
  4754. AncestorEl:=nil
  4755. else
  4756. EmitTypeHints(aClass,AncestorEl);
  4757. end;
  4758. AncestorClassScope:=nil;
  4759. if AncestorEl=nil then
  4760. begin
  4761. // root class e.g. TObject
  4762. end
  4763. else
  4764. begin
  4765. // inherited class
  4766. if AncestorEl.IsForward then
  4767. RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
  4768. sCantUseForwardDeclarationAsAncestor,[AncestorEl.Name],aClass);
  4769. if aClass.IsExternal and not AncestorEl.IsExternal then
  4770. RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
  4771. [AncestorEl.Name],aClass);
  4772. AncestorClassScope:=AncestorEl.CustomData as TPasClassScope;
  4773. if pcsfSealed in AncestorClassScope.Flags then
  4774. RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedClass,
  4775. sCannotCreateADescendantOfTheSealedClass,[AncestorEl.Name],aClass);
  4776. // check for cycle
  4777. El:=AncestorEl;
  4778. repeat
  4779. if El=aClass then
  4780. RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
  4781. if (El.ClassType=TPasAliasType)
  4782. or (El.ClassType=TPasTypeAliasType)
  4783. then
  4784. El:=TPasAliasType(El).DestType
  4785. else if El.ClassType=TPasClassType then
  4786. El:=TPasClassType(El).AncestorType;
  4787. until El=nil;
  4788. end;
  4789. // start scope for elements
  4790. {$IFDEF VerbosePasResolver}
  4791. //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
  4792. {$ENDIF}
  4793. PushScope(aClass,ScopeClass_Class);
  4794. ClassScope:=TPasClassScope(TopScope);
  4795. ClassScope.VisibilityContext:=aClass;
  4796. Include(ClassScope.Flags,pcsfAncestorResolved);
  4797. if IsSealed then
  4798. Include(ClassScope.Flags,pcsfSealed);
  4799. ClassScope.DirectAncestor:=DirectAncestor;
  4800. if AncestorEl<>nil then
  4801. begin
  4802. ClassScope.AncestorScope:=AncestorClassScope;
  4803. ClassScope.DefaultProperty:=AncestorClassScope.DefaultProperty;
  4804. if pcsfPublished in AncestorClassScope.Flags then
  4805. Include(ClassScope.Flags,pcsfPublished);
  4806. ClassScope.AbstractProcs:=copy(AncestorClassScope.AbstractProcs);
  4807. end;
  4808. if CurrentParser.Scanner.IsDefined(LetterSwitchNames['M']) then
  4809. Include(ClassScope.Flags,pcsfPublished);
  4810. // create canonical class-of for the "Self" in class functions
  4811. CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
  4812. ClassScope.CanonicalClassOf:=CanonicalSelf;
  4813. CanonicalSelf.DestType:=aClass;
  4814. aClass.AddRef;
  4815. CanonicalSelf.Visibility:=visStrictPrivate;
  4816. CanonicalSelf.SourceFilename:=aClass.SourceFilename;
  4817. CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
  4818. // ToDo: interfaces
  4819. end;
  4820. procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
  4821. Prop: TPasProperty);
  4822. var
  4823. i: Integer;
  4824. ParamAccess: TResolvedRefAccess;
  4825. begin
  4826. for i:=0 to length(Params.Params)-1 do
  4827. begin
  4828. ParamAccess:=rraRead;
  4829. if i<Prop.Args.Count then
  4830. case TPasArgument(Prop.Args[i]).Access of
  4831. argVar: ParamAccess:=rraVarParam;
  4832. argOut: ParamAccess:=rraOutParam;
  4833. end;
  4834. AccessExpr(Params.Params[i],ParamAccess);
  4835. end;
  4836. end;
  4837. procedure TPasResolver.FinishCallArgAccess(Expr: TPasExpr;
  4838. Access: TResolvedRefAccess);
  4839. var
  4840. ResolvedEl: TPasResolverResult;
  4841. Flags: TPasResolverComputeFlags;
  4842. begin
  4843. AccessExpr(Expr,Access);
  4844. Flags:=[rcSetReferenceFlags];
  4845. if Access<>rraRead then
  4846. Include(Flags,rcNoImplicitProc);
  4847. ComputeElement(Expr,ResolvedEl,Flags);
  4848. end;
  4849. procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
  4850. begin
  4851. while aType<>nil do
  4852. begin
  4853. if EmitElementHints(PosEl,aType) then
  4854. exit; // give only hints for the nearest
  4855. if aType.InheritsFrom(TPasAliasType) then
  4856. aType:=TPasAliasType(aType).DestType
  4857. else if aType.ClassType=TPasPointerType then
  4858. aType:=TPasPointerType(aType).DestType
  4859. else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
  4860. and (aType.CustomData<>nil) then
  4861. aType:=TPasType((aType.CustomData as TResolvedReference).Declaration)
  4862. else
  4863. exit;
  4864. end;
  4865. end;
  4866. function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
  4867. begin
  4868. if IsElementSkipped(El) then
  4869. RaiseMsg(20170927160030,nNotYetImplemented,sNotYetImplemented,[GetObjName(El)],PosEl);
  4870. if El.Hints=[] then exit(false);
  4871. Result:=true;
  4872. if hDeprecated in El.Hints then
  4873. begin
  4874. if El.HintMessage<>'' then
  4875. LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
  4876. [El.Name,El.HintMessage],PosEl)
  4877. else
  4878. LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
  4879. [El.Name],PosEl);
  4880. end;
  4881. if hLibrary in El.Hints then
  4882. LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
  4883. [El.Name],PosEl);
  4884. if hPlatform in El.Hints then
  4885. LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
  4886. [El.Name],PosEl);
  4887. if hExperimental in El.Hints then
  4888. LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
  4889. [El.Name],PosEl);
  4890. if hUnimplemented in El.Hints then
  4891. LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
  4892. [El.Name],PosEl);
  4893. end;
  4894. procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  4895. var
  4896. ModScope: TPasModuleScope;
  4897. begin
  4898. ProcScope.ScannerBoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  4899. if bsRangeChecks in ProcScope.ScannerBoolSwitches then
  4900. begin
  4901. ModScope:=RootElement.CustomData as TPasModuleScope;
  4902. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  4903. end;
  4904. end;
  4905. procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
  4906. ImplProcScope: TPasProcedureScope);
  4907. var
  4908. DeclProc, ImplProc: TPasProcedure;
  4909. DeclArgs, ImplArgs: TFPList;
  4910. i: Integer;
  4911. DeclArg, ImplArg: TPasArgument;
  4912. Identifier: TPasIdentifier;
  4913. begin
  4914. ImplProc:=ImplProcScope.Element as TPasProcedure;
  4915. ImplArgs:=ImplProc.ProcType.Args;
  4916. DeclProc:=ImplProcScope.DeclarationProc;
  4917. DeclArgs:=DeclProc.ProcType.Args;
  4918. for i:=0 to DeclArgs.Count-1 do
  4919. begin
  4920. DeclArg:=TPasArgument(DeclArgs[i]);
  4921. if i<ImplArgs.Count then
  4922. begin
  4923. ImplArg:=TPasArgument(ImplArgs[i]);
  4924. Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
  4925. //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
  4926. if Identifier.Element<>ImplArg then
  4927. RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
  4928. Identifier.Element:=DeclArg;
  4929. Identifier.Identifier:=DeclArg.Name;
  4930. end
  4931. else
  4932. RaiseNotYetImplemented(20170203161826,ImplProc);
  4933. end;
  4934. if DeclProc is TPasFunction then
  4935. begin
  4936. // redirect implementation 'Result' to declaration FuncType.ResultEl
  4937. Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
  4938. if Identifier.Element is TPasResultElement then
  4939. Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl;
  4940. end;
  4941. end;
  4942. procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
  4943. const ResolvedEl: TPasResolverResult);
  4944. begin
  4945. if ResolvedEl.BaseType<>btBoolean then
  4946. RaiseMsg(20170216152135,nXExpectedButYFound,sXExpectedButYFound,
  4947. [BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType]],El);
  4948. end;
  4949. procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
  4950. ImplProc: TPasProcedure; CheckNames: boolean);
  4951. var
  4952. i: Integer;
  4953. DeclArgs, ImplArgs: TFPList;
  4954. DeclName, ImplName: String;
  4955. ImplResult, DeclResult: TPasType;
  4956. begin
  4957. if ImplProc.ClassType<>DeclProc.ClassType then
  4958. RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
  4959. if ImplProc.CallingConvention<>DeclProc.CallingConvention then
  4960. RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
  4961. if ImplProc is TPasFunction then
  4962. begin
  4963. // check result type
  4964. ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
  4965. DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
  4966. if not CheckProcArgTypeCompatibility(ImplResult,DeclResult) then
  4967. RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
  4968. [],DeclResult,ImplResult,ImplProc);
  4969. end;
  4970. if CheckNames then
  4971. begin
  4972. // check argument names
  4973. DeclArgs:=DeclProc.ProcType.Args;
  4974. ImplArgs:=ImplProc.ProcType.Args;
  4975. for i:=0 to DeclArgs.Count-1 do
  4976. begin
  4977. DeclName:=TPasArgument(DeclArgs[i]).Name;
  4978. ImplName:=TPasArgument(ImplArgs[i]).Name;
  4979. if CompareText(DeclName,ImplName)<>0 then
  4980. RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
  4981. sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
  4982. end;
  4983. end;
  4984. end;
  4985. procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
  4986. var
  4987. i: Integer;
  4988. begin
  4989. if Block=nil then exit;
  4990. for i:=0 to Block.Elements.Count-1 do
  4991. ResolveImplElement(TPasImplElement(Block.Elements[i]));
  4992. end;
  4993. procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
  4994. var
  4995. C: TClass;
  4996. begin
  4997. //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
  4998. if El=nil then exit;
  4999. C:=El.ClassType;
  5000. if C=TPasImplBeginBlock then
  5001. ResolveImplBlock(TPasImplBeginBlock(El))
  5002. else if C=TPasImplAssign then
  5003. ResolveImplAssign(TPasImplAssign(El))
  5004. else if C=TPasImplSimple then
  5005. ResolveImplSimple(TPasImplSimple(El))
  5006. else if C=TPasImplBlock then
  5007. ResolveImplBlock(TPasImplBlock(El))
  5008. else if C=TPasImplRepeatUntil then
  5009. begin
  5010. ResolveImplBlock(TPasImplBlock(El));
  5011. ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
  5012. end
  5013. else if C=TPasImplIfElse then
  5014. begin
  5015. ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
  5016. ResolveImplElement(TPasImplIfElse(El).IfBranch);
  5017. ResolveImplElement(TPasImplIfElse(El).ElseBranch);
  5018. end
  5019. else if C=TPasImplWhileDo then
  5020. begin
  5021. ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
  5022. ResolveImplElement(TPasImplWhileDo(El).Body);
  5023. end
  5024. else if C=TPasImplCaseOf then
  5025. ResolveImplCaseOf(TPasImplCaseOf(El))
  5026. else if C=TPasImplLabelMark then
  5027. ResolveImplLabelMark(TPasImplLabelMark(El))
  5028. else if C=TPasImplForLoop then
  5029. ResolveImplForLoop(TPasImplForLoop(El))
  5030. else if C=TPasImplTry then
  5031. begin
  5032. ResolveImplBlock(TPasImplTry(El));
  5033. ResolveImplBlock(TPasImplTry(El).FinallyExcept);
  5034. ResolveImplBlock(TPasImplTry(El).ElseBranch);
  5035. end
  5036. else if C=TPasImplExceptOn then
  5037. // handled in FinishExceptOnStatement
  5038. else if C=TPasImplRaise then
  5039. ResolveImplRaise(TPasImplRaise(El))
  5040. else if C=TPasImplCommand then
  5041. begin
  5042. if TPasImplCommand(El).Command<>'' then
  5043. RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
  5044. end
  5045. else if C=TPasImplAsmStatement then
  5046. ResolveImplAsm(TPasImplAsmStatement(El))
  5047. else if C=TPasImplWithDo then
  5048. ResolveImplWithDo(TPasImplWithDo(El))
  5049. else
  5050. RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
  5051. end;
  5052. procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
  5053. var
  5054. i, j: Integer;
  5055. El: TPasElement;
  5056. Stat: TPasImplCaseStatement;
  5057. CaseExprResolved, OfExprResolved: TPasResolverResult;
  5058. OfExpr: TPasExpr;
  5059. ok: Boolean;
  5060. begin
  5061. ResolveExpr(CaseOf.CaseExpr,rraRead);
  5062. ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
  5063. ok:=false;
  5064. if (rrfReadable in CaseExprResolved.Flags) then
  5065. begin
  5066. if (CaseExprResolved.BaseType in (btAllInteger+btAllBooleans+btAllStringAndChars)) then
  5067. ok:=true
  5068. else if CaseExprResolved.BaseType=btContext then
  5069. begin
  5070. if CaseExprResolved.TypeEl.ClassType=TPasEnumType then
  5071. ok:=true;
  5072. end;
  5073. end;
  5074. if not ok then
  5075. RaiseXExpectedButYFound(20170216151952,'ordinal expression',
  5076. GetTypeDescription(CaseExprResolved.TypeEl),CaseOf.CaseExpr);
  5077. for i:=0 to CaseOf.Elements.Count-1 do
  5078. begin
  5079. El:=TPasElement(CaseOf.Elements[i]);
  5080. if El.ClassType=TPasImplCaseStatement then
  5081. begin
  5082. Stat:=TPasImplCaseStatement(El);
  5083. for j:=0 to Stat.Expressions.Count-1 do
  5084. begin
  5085. //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
  5086. OfExpr:=TPasExpr(Stat.Expressions[j]);
  5087. ResolveExpr(OfExpr,rraRead);
  5088. ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
  5089. if OfExprResolved.BaseType=btRange then
  5090. ConvertRangeToElement(OfExprResolved);
  5091. CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
  5092. end;
  5093. ResolveImplElement(Stat.Body);
  5094. end
  5095. else if El.ClassType=TPasImplCaseElse then
  5096. ResolveImplBlock(TPasImplCaseElse(El))
  5097. else
  5098. RaiseNotYetImplemented(20160922163448,El);
  5099. end;
  5100. // Note: CaseOf.ElseBranch was already resolved via Elements
  5101. end;
  5102. procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
  5103. begin
  5104. RaiseNotYetImplemented(20161014141636,Mark);
  5105. end;
  5106. procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
  5107. var
  5108. VarResolved, StartResolved, EndResolved,
  5109. OrigStartResolved: TPasResolverResult;
  5110. EnumeratorFound, HasInValues: Boolean;
  5111. InRange, VarRange: TResEvalValue;
  5112. InRangeInt, VarRangeInt: TResEvalRangeInt;
  5113. bt: TResolverBaseType;
  5114. TypeEl: TPasType;
  5115. C: TClass;
  5116. begin
  5117. CreateScope(Loop,TPasForLoopScope);
  5118. // loop var
  5119. ResolveExpr(Loop.VariableName,rraReadAndAssign);
  5120. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  5121. if not ResolvedElCanBeVarParam(VarResolved) then
  5122. RaiseMsg(20170216151955,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Loop.VariableName);
  5123. // resolve start expression
  5124. ResolveExpr(Loop.StartExpr,rraRead);
  5125. ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
  5126. case Loop.LoopType of
  5127. ltNormal,ltDown:
  5128. begin
  5129. // start value
  5130. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  5131. RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
  5132. [],StartResolved,VarResolved,Loop.StartExpr);
  5133. CheckAssignExprRange(VarResolved,Loop.StartExpr);
  5134. // end value
  5135. ResolveExpr(Loop.EndExpr,rraRead);
  5136. ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
  5137. if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
  5138. RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
  5139. [],EndResolved,VarResolved,Loop.EndExpr);
  5140. CheckAssignExprRange(VarResolved,Loop.EndExpr);
  5141. end;
  5142. ltIn:
  5143. begin
  5144. // check range
  5145. EnumeratorFound:=false;
  5146. if (StartResolved.BaseType=btContext) then
  5147. begin
  5148. TypeEl:=ResolveAliasType(StartResolved.TypeEl);
  5149. C:=TypeEl.ClassType;
  5150. if C=TPasClassType then
  5151. EnumeratorFound:=CheckForInClass(Loop,VarResolved,StartResolved);
  5152. end;
  5153. if not EnumeratorFound then
  5154. begin
  5155. VarRange:=EvalTypeRange(VarResolved.TypeEl,[]);
  5156. if VarRange=nil then
  5157. RaiseXExpectedButYFound(20171109191528,'range',
  5158. GetResolverResultDescription(VarResolved),Loop.VariableName);
  5159. //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  5160. InRange:=nil;
  5161. try
  5162. OrigStartResolved:=StartResolved;
  5163. if StartResolved.IdentEl is TPasType then
  5164. begin
  5165. // e.g. for e in TEnum do
  5166. TypeEl:=ResolveAliasType(StartResolved.TypeEl);
  5167. if TypeEl is TPasArrayType then
  5168. begin
  5169. if length(TPasArrayType(TypeEl).Ranges)=1 then
  5170. InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
  5171. end;
  5172. if InRange=nil then
  5173. InRange:=EvalTypeRange(TypeEl,[]);
  5174. {$IFDEF VerbosePasResolver}
  5175. if InRange<>nil then
  5176. writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
  5177. else
  5178. writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
  5179. {$ENDIF}
  5180. end
  5181. else if rrfReadable in StartResolved.Flags then
  5182. begin
  5183. // value (variable or expression)
  5184. bt:=StartResolved.BaseType;
  5185. if bt=btSet then
  5186. begin
  5187. if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
  5188. InRange:=Eval(StartResolved.ExprEl,[refAutoConst])
  5189. else
  5190. InRange:=EvalTypeRange(StartResolved.TypeEl,[]);
  5191. end
  5192. else if bt=btContext then
  5193. begin
  5194. TypeEl:=ResolveAliasType(StartResolved.TypeEl);
  5195. C:=TypeEl.ClassType;
  5196. if C=TPasArrayType then
  5197. begin
  5198. ComputeElement(TPasArrayType(TypeEl).ElType,StartResolved,[rcType]);
  5199. StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
  5200. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  5201. RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
  5202. [],StartResolved,VarResolved,Loop.StartExpr);
  5203. EnumeratorFound:=true;
  5204. end;
  5205. end
  5206. else
  5207. begin
  5208. bt:=GetActualBaseType(bt);
  5209. if bt=btAnsiString then
  5210. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  5211. else if bt=btUnicodeString then
  5212. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  5213. end;
  5214. end;
  5215. if (not EnumeratorFound) and (InRange<>nil) then
  5216. begin
  5217. // for v in <constant> do
  5218. // -> check if same type
  5219. //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
  5220. case InRange.Kind of
  5221. revkRangeInt,revkSetOfInt:
  5222. begin
  5223. InRangeInt:=TResEvalRangeInt(InRange);
  5224. case VarRange.Kind of
  5225. revkRangeInt:
  5226. begin
  5227. VarRangeInt:=TResEvalRangeInt(VarRange);
  5228. HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
  5229. case InRangeInt.ElKind of
  5230. revskEnum:
  5231. if (VarRangeInt.ElKind<>revskEnum)
  5232. or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType) then
  5233. RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
  5234. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  5235. revskInt:
  5236. if VarRangeInt.ElKind<>revskInt then
  5237. RaiseXExpectedButYFound(20171109200752,'integer',
  5238. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  5239. revskChar:
  5240. if VarRangeInt.ElKind<>revskChar then
  5241. RaiseXExpectedButYFound(20171109200753,'char',
  5242. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  5243. revskBool:
  5244. if VarRangeInt.ElKind<>revskBool then
  5245. RaiseXExpectedButYFound(20171109200754,'boolean',
  5246. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  5247. else
  5248. if HasInValues then
  5249. RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
  5250. end;
  5251. if HasInValues then
  5252. begin
  5253. if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
  5254. begin
  5255. {$IFDEF VerbosePasResolver}
  5256. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  5257. {$ENDIF}
  5258. fExprEvaluator.EmitRangeCheckConst(20171109201428,
  5259. InRangeInt.ElementAsString(InRangeInt.RangeStart),
  5260. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  5261. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  5262. end;
  5263. if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
  5264. begin
  5265. {$IFDEF VerbosePasResolver}
  5266. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  5267. {$ENDIF}
  5268. fExprEvaluator.EmitRangeCheckConst(20171109201429,
  5269. InRangeInt.ElementAsString(InRangeInt.RangeEnd),
  5270. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  5271. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  5272. end;
  5273. end;
  5274. EnumeratorFound:=true;
  5275. end;
  5276. else
  5277. {$IFDEF VerbosePasResolver}
  5278. writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  5279. {$ENDIF}
  5280. end;
  5281. end;
  5282. else
  5283. {$IFDEF VerbosePasResolver}
  5284. writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
  5285. {$ENDIF}
  5286. end;
  5287. end;
  5288. if not EnumeratorFound then
  5289. begin
  5290. {$IFDEF VerbosePasResolver}
  5291. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString,' StartResolved=',GetResolverResultDbg(StartResolved));
  5292. {$ENDIF}
  5293. RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  5294. [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
  5295. end;
  5296. finally
  5297. ReleaseEvalValue(VarRange);
  5298. ReleaseEvalValue(InRange);
  5299. end;
  5300. end;
  5301. end;
  5302. else
  5303. RaiseNotYetImplemented(20171108221334,Loop);
  5304. end;
  5305. ResolveImplElement(Loop.Body);
  5306. end;
  5307. procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
  5308. var
  5309. i, OldScopeCount: Integer;
  5310. Expr, ErrorEl: TPasExpr;
  5311. ExprResolved: TPasResolverResult;
  5312. TypeEl: TPasType;
  5313. WithScope: TPasWithScope;
  5314. WithExprScope: TPasWithExprScope;
  5315. ExprScope: TPasScope;
  5316. OnlyTypeMembers: Boolean;
  5317. ClassEl: TPasClassType;
  5318. begin
  5319. OldScopeCount:=ScopeCount;
  5320. WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
  5321. PushScope(WithScope);
  5322. for i:=0 to El.Expressions.Count-1 do
  5323. begin
  5324. Expr:=TPasExpr(El.Expressions[i]);
  5325. ResolveExpr(Expr,rraRead);
  5326. ComputeElement(Expr,ExprResolved,[rcSkipTypeAlias,rcSetReferenceFlags]);
  5327. {$IFDEF VerbosePasResolver}
  5328. writeln('TPasResolver.ResolveImplWithDo ExprResolved=',GetResolverResultDbg(ExprResolved));
  5329. {$ENDIF}
  5330. ErrorEl:=Expr;
  5331. TypeEl:=ExprResolved.TypeEl;
  5332. // ToDo: use last element in Expr for error position
  5333. if TypeEl=nil then
  5334. RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  5335. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  5336. OnlyTypeMembers:=false;
  5337. if TypeEl.ClassType=TPasRecordType then
  5338. begin
  5339. ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
  5340. if ExprResolved.IdentEl is TPasType then
  5341. // e.g. with TPoint do PointInCircle
  5342. OnlyTypeMembers:=true;
  5343. end
  5344. else if TypeEl.ClassType=TPasClassType then
  5345. begin
  5346. ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
  5347. if ExprResolved.IdentEl is TPasType then
  5348. // e.g. with TFPMemoryImage do FindHandlerFromExtension()
  5349. OnlyTypeMembers:=true;
  5350. end
  5351. else if TypeEl.ClassType=TPasClassOfType then
  5352. begin
  5353. // e.g. with ImageClass do FindHandlerFromExtension()
  5354. ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
  5355. ExprScope:=ClassEl.CustomData as TPasClassScope;
  5356. OnlyTypeMembers:=true;
  5357. end
  5358. else
  5359. RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  5360. [TypeEl.ElementTypeName],ErrorEl);
  5361. WithExprScope:=ScopeClass_WithExpr.Create;
  5362. WithExprScope.WithScope:=WithScope;
  5363. WithExprScope.Index:=i;
  5364. WithExprScope.Expr:=Expr;
  5365. WithExprScope.Scope:=ExprScope;
  5366. if not (ExprResolved.IdentEl is TPasType) then
  5367. Include(WithExprScope.Flags,wesfNeedTmpVar);
  5368. if OnlyTypeMembers then
  5369. Include(WithExprScope.Flags,wesfOnlyTypeMembers);
  5370. if (not (rrfWritable in ExprResolved.Flags))
  5371. and (ExprResolved.BaseType=btContext)
  5372. and (ExprResolved.TypeEl.ClassType=TPasRecordType) then
  5373. Include(WithExprScope.Flags,wesfConstParent);
  5374. WithScope.ExpressionScopes.Add(WithExprScope);
  5375. PushScope(WithExprScope);
  5376. end;
  5377. ResolveImplElement(El.Body);
  5378. CheckTopScope(ScopeClass_WithExpr);
  5379. if TopScope<>WithScope.ExpressionScopes[WithScope.ExpressionScopes.Count-1] then
  5380. RaiseInternalError(20160923102846);
  5381. while ScopeCount>OldScopeCount do
  5382. PopScope;
  5383. end;
  5384. procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  5385. begin
  5386. if El=nil then ;
  5387. end;
  5388. procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
  5389. var
  5390. LeftResolved, RightResolved: TPasResolverResult;
  5391. Flags: TPasResolverComputeFlags;
  5392. Access: TResolvedRefAccess;
  5393. begin
  5394. if El.Kind=akDefault then
  5395. Access:=rraAssign
  5396. else
  5397. Access:=rraReadAndAssign;
  5398. ResolveExpr(El.left,Access);
  5399. {$IFDEF VerbosePasResolver}
  5400. writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
  5401. {$ENDIF}
  5402. // check LHS can be assigned
  5403. ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
  5404. CheckCanBeLHS(LeftResolved,true,El.left);
  5405. // compute RHS
  5406. ResolveExpr(El.right,rraRead); // ToDo: btArrayLit: if LHS is array then pass ArrType and Dim
  5407. Flags:=[rcSkipTypeAlias,rcSetReferenceFlags];
  5408. if IsProcedureType(LeftResolved,true) then
  5409. if (msDelphi in CurrentParser.CurrentModeswitches) then
  5410. Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
  5411. else
  5412. Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
  5413. {$IFDEF VerbosePasResolver}
  5414. writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
  5415. {$ENDIF}
  5416. ComputeElement(El.right,RightResolved,Flags);
  5417. {$IFDEF VerbosePasResolver}
  5418. writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
  5419. {$ENDIF}
  5420. case El.Kind of
  5421. akDefault:
  5422. begin
  5423. CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
  5424. CheckAssignExprRange(LeftResolved,El.right);
  5425. end;
  5426. akAdd, akMinus,akMul,akDivision:
  5427. begin
  5428. if (El.Kind in [akAdd,akMinus,akMul]) and (LeftResolved.BaseType in btAllInteger) then
  5429. begin
  5430. if (not (rrfReadable in RightResolved.Flags))
  5431. or not (RightResolved.BaseType in btAllInteger) then
  5432. RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5433. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  5434. end
  5435. else if (El.Kind=akAdd) and (LeftResolved.BaseType in btAllStrings) then
  5436. begin
  5437. if (not (rrfReadable in RightResolved.Flags))
  5438. or not (RightResolved.BaseType in btAllStringAndChars) then
  5439. RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5440. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  5441. end
  5442. else if (El.Kind in [akAdd,akMinus,akMul,akDivision])
  5443. and (LeftResolved.BaseType in btAllFloats) then
  5444. begin
  5445. if (not (rrfReadable in RightResolved.Flags))
  5446. or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  5447. RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5448. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  5449. end
  5450. else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
  5451. begin
  5452. if (not (rrfReadable in RightResolved.Flags))
  5453. or not (RightResolved.BaseType=btSet) then
  5454. RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5455. [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  5456. if (LeftResolved.SubType=RightResolved.SubType)
  5457. or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
  5458. or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
  5459. then
  5460. else
  5461. RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  5462. ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  5463. end
  5464. else
  5465. RaiseMsg(20170216152125,nIllegalQualifier,sIllegalQualifier,[AssignKindNames[El.Kind]],El);
  5466. // store const expression result
  5467. Eval(El.right,[]);
  5468. end;
  5469. else
  5470. RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
  5471. end;
  5472. end;
  5473. procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
  5474. var
  5475. ExprResolved: TPasResolverResult;
  5476. Expr: TPasExpr;
  5477. begin
  5478. Expr:=El.expr;
  5479. ResolveExpr(Expr,rraRead);
  5480. ComputeElement(Expr,ExprResolved,[rcSkipTypeAlias,rcSetReferenceFlags]);
  5481. if (rrfCanBeStatement in ExprResolved.Flags) then
  5482. exit;
  5483. {$IFDEF VerbosePasResolver}
  5484. writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  5485. {$ENDIF}
  5486. RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
  5487. end;
  5488. procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
  5489. var
  5490. ResolvedEl: TPasResolverResult;
  5491. begin
  5492. if El.ExceptObject<>nil then
  5493. begin
  5494. ResolveExpr(El.ExceptObject,rraRead);
  5495. ComputeElement(El.ExceptObject,ResolvedEl,[rcSkipTypeAlias,rcSetReferenceFlags]);
  5496. CheckIsClass(El.ExceptObject,ResolvedEl);
  5497. if ResolvedEl.IdentEl<>nil then
  5498. begin
  5499. if (ResolvedEl.IdentEl is TPasVariable)
  5500. or (ResolvedEl.IdentEl is TPasArgument)
  5501. or (ResolvedEl.IdentEl is TPasResultElement) then
  5502. else
  5503. begin
  5504. {$IFDEF VerbosePasResolver}
  5505. writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
  5506. {$ENDIF}
  5507. RaiseMsg(20170216152133,nXExpectedButYFound,sXExpectedButYFound,
  5508. ['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
  5509. end;
  5510. end
  5511. else if ResolvedEl.ExprEl<>nil then
  5512. else
  5513. RaiseMsg(201702303145230,nXExpectedButYFound,sXExpectedButYFound,
  5514. ['variable',GetResolverResultDbg(ResolvedEl)],El.ExceptObject);
  5515. if not (rrfReadable in ResolvedEl.Flags) then
  5516. RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
  5517. end;
  5518. if El.ExceptAddr<>nil then
  5519. ResolveExpr(El.ExceptAddr,rraRead);
  5520. end;
  5521. procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
  5522. var
  5523. Primitive: TPrimitiveExpr;
  5524. ElClass: TClass;
  5525. begin
  5526. {$IFDEF VerbosePasResolver}
  5527. writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
  5528. {$ENDIF}
  5529. if El=nil then
  5530. RaiseNotYetImplemented(20160922163453,El);
  5531. ElClass:=El.ClassType;
  5532. if ElClass=TPrimitiveExpr then
  5533. begin
  5534. Primitive:=TPrimitiveExpr(El);
  5535. case Primitive.Kind of
  5536. pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
  5537. pekNumber: ;
  5538. pekString: ;
  5539. pekNil,pekBoolConst: ;
  5540. else
  5541. RaiseNotYetImplemented(20160922163451,El);
  5542. end;
  5543. end
  5544. else if ElClass=TUnaryExpr then
  5545. ResolveExpr(TUnaryExpr(El).Operand,Access)
  5546. else if ElClass=TBinaryExpr then
  5547. ResolveBinaryExpr(TBinaryExpr(El),Access)
  5548. else if ElClass=TParamsExpr then
  5549. ResolveParamsExpr(TParamsExpr(El),Access)
  5550. else if ElClass=TBoolConstExpr then
  5551. else if ElClass=TNilExpr then
  5552. else if ElClass=TSelfExpr then
  5553. ResolveNameExpr(El,'Self',Access)
  5554. else if ElClass=TInheritedExpr then
  5555. ResolveInherited(TInheritedExpr(El),Access)
  5556. else if ElClass=TArrayValues then
  5557. begin
  5558. if Access<>rraRead then
  5559. RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
  5560. [],El);
  5561. ResolveArrayValues(TArrayValues(El));
  5562. end
  5563. else
  5564. RaiseNotYetImplemented(20170222184329,El);
  5565. if El.format1<>nil then
  5566. ResolveExpr(El.format1,rraRead);
  5567. if El.format2<>nil then
  5568. ResolveExpr(El.format2,rraRead);
  5569. end;
  5570. procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
  5571. var
  5572. ResolvedCond: TPasResolverResult;
  5573. begin
  5574. ResolveExpr(El,rraRead);
  5575. ComputeElement(El,ResolvedCond,[rcSkipTypeAlias,rcSetReferenceFlags]);
  5576. CheckConditionExpr(El,ResolvedCond);
  5577. end;
  5578. procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
  5579. Access: TResolvedRefAccess);
  5580. var
  5581. FindData: TPRFindData;
  5582. DeclEl: TPasElement;
  5583. Proc, ImplProc: TPasProcedure;
  5584. Ref: TResolvedReference;
  5585. BuiltInProc: TResElDataBuiltInProc;
  5586. p: SizeInt;
  5587. DottedName: String;
  5588. Bin: TBinaryExpr;
  5589. ProcScope: TPasProcedureScope;
  5590. begin
  5591. {$IFDEF VerbosePasResolver}
  5592. writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
  5593. {$ENDIF}
  5594. DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
  5595. if DeclEl.ClassType=TPasUsesUnit then
  5596. begin
  5597. // the first name of a unit matches -> find unit with longest match
  5598. FindLongestUnitName(DeclEl,El);
  5599. FindData.Found:=DeclEl;
  5600. end;
  5601. Ref:=CreateReference(DeclEl,El,Access,@FindData);
  5602. CheckFoundElement(FindData,Ref);
  5603. if DeclEl is TPasProcedure then
  5604. begin
  5605. // identifier is a proc and args brackets are missing
  5606. if El.Parent.ClassType=TPasProperty then
  5607. // a property accessor does not need args -> ok
  5608. // Note: the detailed tests are in FinishPropertyOfClass
  5609. else
  5610. begin
  5611. // examples: funca or @proca or a.funca or @a.funca ...
  5612. Proc:=TPasProcedure(DeclEl);
  5613. if (Access=rraAssign) and (Proc is TPasFunction)
  5614. and (El.ClassType=TPrimitiveExpr)
  5615. and (El.Parent.ClassType=TPasImplAssign)
  5616. and (TPasImplAssign(El.Parent).left=El) then
  5617. begin
  5618. // e.g. funcname:=
  5619. ProcScope:=Proc.CustomData as TPasProcedureScope;
  5620. ImplProc:=ProcScope.ImplProc;
  5621. if ImplProc=nil then
  5622. ImplProc:=Proc;
  5623. if El.HasParent(ImplProc) then
  5624. begin
  5625. // "FuncA:=" within FuncA -> redirect to ResultEl
  5626. Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
  5627. exit;
  5628. end;
  5629. end;
  5630. if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
  5631. begin
  5632. {$IFDEF VerbosePasResolver}
  5633. writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
  5634. {$ENDIF}
  5635. RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
  5636. sWrongNumberOfParametersForCallTo,[Proc.Name],El);
  5637. end;
  5638. end;
  5639. end
  5640. else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  5641. begin
  5642. if DeclEl.CustomData is TResElDataBuiltInProc then
  5643. begin
  5644. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  5645. BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
  5646. end;
  5647. end
  5648. else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
  5649. begin
  5650. // unit reference
  5651. // dotted unit names needs a ref for each expression identifier
  5652. // Note: El is the first TPrimitiveExpr of the dotted unit name reference
  5653. DottedName:=DeclEl.Name;
  5654. repeat
  5655. p:=Pos('.',DottedName);
  5656. if p<1 then break;
  5657. Delete(DottedName,1,p);
  5658. El:=GetNextDottedExpr(El);
  5659. if El=nil then
  5660. RaiseInternalError(20170503002012);
  5661. CreateReference(DeclEl,El,Access);
  5662. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
  5663. begin
  5664. Bin:=TBinaryExpr(El.Parent);
  5665. while Bin.OpCode=eopSubIdent do
  5666. begin
  5667. CreateReference(DeclEl,Bin,Access);
  5668. if not (Bin.Parent is TBinaryExpr) then break;
  5669. if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
  5670. Bin:=TBinaryExpr(Bin.Parent);
  5671. end;
  5672. end;
  5673. until false;
  5674. end;
  5675. end;
  5676. procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
  5677. Access: TResolvedRefAccess);
  5678. var
  5679. ProcScope, DeclProcScope, SelfScope: TPasProcedureScope;
  5680. AncestorScope, ClassScope: TPasClassScope;
  5681. DeclProc, AncestorProc: TPasProcedure;
  5682. begin
  5683. {$IFDEF VerbosePasResolver}
  5684. writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
  5685. {$ENDIF}
  5686. if (El.Parent.ClassType=TBinaryExpr)
  5687. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  5688. begin
  5689. // e.g. 'inherited Proc;'
  5690. ResolveInheritedCall(TBinaryExpr(El.Parent),Access);
  5691. exit;
  5692. end;
  5693. // 'inherited;' without expression
  5694. ProcScope:=GetInheritedExprScope(El);
  5695. SelfScope:=ProcScope.GetSelfScope;
  5696. if SelfScope=nil then
  5697. RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  5698. ClassScope:=SelfScope.ClassScope;
  5699. AncestorScope:=ClassScope.AncestorScope;
  5700. if AncestorScope=nil then
  5701. begin
  5702. // 'inherited;' without ancestor class is silently ignored
  5703. exit;
  5704. end;
  5705. // search ancestor in element, i.e. 'inherited' expression
  5706. DeclProc:=SelfScope.DeclarationProc;
  5707. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  5708. AncestorProc:=DeclProcScope.OverriddenProc;
  5709. if AncestorProc=nil then
  5710. begin
  5711. // 'inherited;' without ancestor method is silently ignored
  5712. exit;
  5713. end;
  5714. CreateReference(AncestorProc,El,Access);
  5715. if AncestorProc.IsAbstract then
  5716. RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
  5717. sAbstractMethodsCannotBeCalledDirectly,[],El);
  5718. end;
  5719. procedure TPasResolver.ResolveInheritedCall(El: TBinaryExpr;
  5720. Access: TResolvedRefAccess);
  5721. // El.OpCode=eopNone
  5722. // El.left is TInheritedExpr
  5723. // El.right is the identifier and parameters
  5724. var
  5725. ProcScope, SelfScope: TPasProcedureScope;
  5726. AncestorScope, ClassScope: TPasClassScope;
  5727. AncestorClass: TPasClassType;
  5728. InhScope: TPasDotClassScope;
  5729. begin
  5730. {$IFDEF VerbosePasResolver}
  5731. writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El));
  5732. {$ENDIF}
  5733. ProcScope:=GetInheritedExprScope(El);
  5734. SelfScope:=ProcScope.GetSelfScope;
  5735. if SelfScope=nil then
  5736. RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  5737. ClassScope:=SelfScope.ClassScope;
  5738. AncestorScope:=ClassScope.AncestorScope;
  5739. if AncestorScope=nil then
  5740. RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
  5741. // search call in ancestor
  5742. AncestorClass:=TPasClassType(AncestorScope.Element);
  5743. InhScope:=PushClassDotScope(AncestorClass);
  5744. InhScope.InheritedExpr:=true;
  5745. ResolveExpr(El.right,Access);
  5746. PopScope;
  5747. end;
  5748. procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
  5749. Access: TResolvedRefAccess);
  5750. begin
  5751. {$IFDEF VerbosePasResolver}
  5752. //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
  5753. {$ENDIF}
  5754. ResolveExpr(El.left,rraRead);
  5755. if El.right=nil then exit;
  5756. case El.OpCode of
  5757. eopNone:
  5758. case El.Kind of
  5759. pekRange:
  5760. ResolveExpr(El.right,rraRead);
  5761. else
  5762. if El.left.ClassType=TInheritedExpr then
  5763. else
  5764. begin
  5765. {$IFDEF VerbosePasResolver}
  5766. writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
  5767. {$ENDIF}
  5768. RaiseNotYetImplemented(20160922163456,El);
  5769. end;
  5770. end;
  5771. eopAdd,
  5772. eopSubtract,
  5773. eopMultiply,
  5774. eopDivide,
  5775. eopDiv,
  5776. eopMod,
  5777. eopPower,
  5778. eopShr,
  5779. eopShl,
  5780. eopNot,
  5781. eopAnd,
  5782. eopOr,
  5783. eopXor,
  5784. eopEqual,
  5785. eopNotEqual,
  5786. eopLessThan,
  5787. eopGreaterThan,
  5788. eopLessthanEqual,
  5789. eopGreaterThanEqual,
  5790. eopIn,
  5791. eopIs,
  5792. eopAs,
  5793. eopSymmetricaldifference:
  5794. ResolveExpr(El.right,rraRead);
  5795. eopSubIdent:
  5796. ResolveSubIdent(El,Access);
  5797. else
  5798. RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
  5799. end;
  5800. end;
  5801. procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
  5802. Access: TResolvedRefAccess);
  5803. var
  5804. aModule: TPasModule;
  5805. ClassEl: TPasClassType;
  5806. ClassScope: TPasDotClassScope;
  5807. LeftResolved: TPasResolverResult;
  5808. Left: TPasExpr;
  5809. RecordEl: TPasRecordType;
  5810. RecordScope: TPasDotRecordScope;
  5811. begin
  5812. if El.CustomData is TResolvedReference then
  5813. exit; // for example, when a.b has a dotted unit name
  5814. Left:=El.left;
  5815. //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
  5816. ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
  5817. if LeftResolved.BaseType=btModule then
  5818. begin
  5819. // e.g. unitname.identifier
  5820. // => search in interface and if this is our module in the implementation
  5821. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  5822. PushModuleDotScope(aModule);
  5823. ResolveExpr(El.right,Access);
  5824. PopScope;
  5825. exit;
  5826. end
  5827. else if LeftResolved.TypeEl=nil then
  5828. begin
  5829. // illegal qualifier, see below
  5830. end
  5831. else if LeftResolved.TypeEl.ClassType=TPasClassType then
  5832. begin
  5833. ClassEl:=TPasClassType(LeftResolved.TypeEl);
  5834. ClassScope:=PushClassDotScope(ClassEl);
  5835. if LeftResolved.IdentEl is TPasType then
  5836. // e.g. TFPMemoryImage.FindHandlerFromExtension()
  5837. ClassScope.OnlyTypeMembers:=true
  5838. else
  5839. // e.g. Image.Width
  5840. ClassScope.OnlyTypeMembers:=false;
  5841. ResolveExpr(El.right,Access);
  5842. PopScope;
  5843. exit;
  5844. end
  5845. else if LeftResolved.TypeEl.ClassType=TPasClassOfType then
  5846. begin
  5847. // e.g. ImageClass.FindHandlerFromExtension()
  5848. ClassEl:=ResolveAliasType(TPasClassOfType(NoNil(LeftResolved.TypeEl)).DestType) as TPasClassType;
  5849. ClassScope:=PushClassDotScope(ClassEl);
  5850. ClassScope.OnlyTypeMembers:=true;
  5851. ResolveExpr(El.right,Access);
  5852. PopScope;
  5853. exit;
  5854. end
  5855. else if LeftResolved.TypeEl.ClassType=TPasRecordType then
  5856. begin
  5857. RecordEl:=TPasRecordType(LeftResolved.TypeEl);
  5858. RecordScope:=PushRecordDotScope(RecordEl);
  5859. RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
  5860. if LeftResolved.IdentEl is TPasType then
  5861. // e.g. TPoint.PointInCircle
  5862. RecordScope.OnlyTypeMembers:=true
  5863. else
  5864. begin
  5865. // e.g. aPoint.X
  5866. AccessExpr(El.left,Access);
  5867. RecordScope.OnlyTypeMembers:=false;
  5868. end;
  5869. ResolveExpr(El.right,Access);
  5870. PopScope;
  5871. exit;
  5872. end
  5873. else if LeftResolved.TypeEl.ClassType=TPasEnumType then
  5874. begin
  5875. if LeftResolved.IdentEl is TPasType then
  5876. begin
  5877. // e.g. TShiftState.ssAlt
  5878. PushEnumDotScope(TPasEnumType(LeftResolved.TypeEl));
  5879. ResolveExpr(El.right,Access);
  5880. PopScope;
  5881. exit;
  5882. end;
  5883. end
  5884. else
  5885. RaiseMsg(20170216152541,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  5886. [LeftResolved.TypeEl.ElementTypeName],El);
  5887. {$IFDEF VerbosePasResolver}
  5888. writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
  5889. {$ENDIF}
  5890. RaiseMsg(20170216152157,nIllegalQualifier,sIllegalQualifier,['.'],El);
  5891. end;
  5892. procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
  5893. Access: TResolvedRefAccess);
  5894. var
  5895. i, ScopeDepth: Integer;
  5896. ParamAccess: TResolvedRefAccess;
  5897. begin
  5898. if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
  5899. begin
  5900. {$IFDEF VerbosePasResolver}
  5901. writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
  5902. {$ENDIF}
  5903. RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  5904. end;
  5905. // first resolve params
  5906. ResetSubScopes(ScopeDepth);
  5907. if Params.Kind in [pekFuncParams,pekArrayParams] then
  5908. ParamAccess:=rraParamToUnknownProc
  5909. else
  5910. ParamAccess:=rraRead;
  5911. for i:=0 to length(Params.Params)-1 do
  5912. ResolveExpr(Params.Params[i],ParamAccess);
  5913. RestoreSubScopes(ScopeDepth);
  5914. // then resolve the call, typecast, array, set
  5915. if (Params.Kind=pekFuncParams) then
  5916. ResolveFuncParamsExpr(Params,Access)
  5917. else if (Params.Kind=pekArrayParams) then
  5918. ResolveArrayParamsExpr(Params,Access)
  5919. else if (Params.Kind=pekSet) then
  5920. ResolveSetParamsExpr(Params)
  5921. else
  5922. RaiseNotYetImplemented(20160922163501,Params);
  5923. end;
  5924. procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
  5925. Access: TResolvedRefAccess);
  5926. procedure FinishProcParams(ProcType: TPasProcedureType);
  5927. var
  5928. ParamAccess: TResolvedRefAccess;
  5929. i: Integer;
  5930. begin
  5931. if not (Access in [rraRead,rraParamToUnknownProc]) then
  5932. begin
  5933. {$IFDEF VerbosePasResolver}
  5934. writeln('TPasResolver.ResolveFuncParamsExpr.FinishProcParams Params=',GetObjName(Params),' Value=',GetObjName(Params.Value),' Access=',Access);
  5935. {$ENDIF}
  5936. RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  5937. end;
  5938. for i:=0 to length(Params.Params)-1 do
  5939. begin
  5940. ParamAccess:=rraRead;
  5941. if i<ProcType.Args.Count then
  5942. case TPasArgument(ProcType.Args[i]).Access of
  5943. argVar: ParamAccess:=rraVarParam;
  5944. argOut: ParamAccess:=rraOutParam;
  5945. end;
  5946. AccessExpr(Params.Params[i],ParamAccess);
  5947. CheckCallProcCompatibility(ProcType,Params,false,true);
  5948. end;
  5949. end;
  5950. procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
  5951. var
  5952. i: Integer;
  5953. begin
  5954. for i:=0 to length(Params.Params)-1 do
  5955. FinishCallArgAccess(Params.Params[i],ParamAccess);
  5956. end;
  5957. var
  5958. i: Integer;
  5959. ElName, Msg: String;
  5960. FindCallData: TFindCallElData;
  5961. Abort: boolean;
  5962. El, FoundEl: TPasElement;
  5963. Ref: TResolvedReference;
  5964. FindData: TPRFindData;
  5965. BuiltInProc: TResElDataBuiltInProc;
  5966. SubParams: TParamsExpr;
  5967. ResolvedEl: TPasResolverResult;
  5968. Value: TPasExpr;
  5969. TypeEl: TPasType;
  5970. C: TClass;
  5971. begin
  5972. Value:=Params.Value;
  5973. if IsNameExpr(Value) then
  5974. begin
  5975. // e.g. Name() -> find compatible
  5976. if Value.ClassType=TPrimitiveExpr then
  5977. ElName:=TPrimitiveExpr(Value).Value
  5978. else
  5979. ElName:='Self';
  5980. FindCallData:=Default(TFindCallElData);
  5981. FindCallData.Params:=Params;
  5982. Abort:=false;
  5983. IterateElements(ElName,@OnFindCallElements,@FindCallData,Abort);
  5984. if FindCallData.Found=nil then
  5985. RaiseIdentifierNotFound(20170216152544,ElName,Value);
  5986. if FindCallData.Distance=cIncompatible then
  5987. begin
  5988. // FoundEl one element, but it was incompatible => raise error
  5989. {$IFDEF VerbosePasResolver}
  5990. writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
  5991. WriteScopes;
  5992. {$ENDIF}
  5993. if FindCallData.Found is TPasProcedure then
  5994. CheckCallProcCompatibility(TPasProcedure(FindCallData.Found).ProcType,Params,true)
  5995. else if FindCallData.Found is TPasProcedureType then
  5996. CheckTypeCast(TPasProcedureType(FindCallData.Found),Params,true)
  5997. else if FindCallData.Found.ClassType=TPasUnresolvedSymbolRef then
  5998. begin
  5999. if FindCallData.Found.CustomData is TResElDataBuiltInProc then
  6000. begin
  6001. BuiltInProc:=TResElDataBuiltInProc(FindCallData.Found.CustomData);
  6002. BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
  6003. end
  6004. else if FindCallData.Found.CustomData is TResElDataBaseType then
  6005. CheckTypeCast(TPasUnresolvedSymbolRef(FindCallData.Found),Params,true)
  6006. else
  6007. RaiseNotYetImplemented(20161006132825,FindCallData.Found);
  6008. end
  6009. else if FindCallData.Found is TPasType then
  6010. // Note: check TPasType after TPasUnresolvedSymbolRef
  6011. CheckTypeCast(TPasType(FindCallData.Found),Params,true)
  6012. else if FindCallData.Found is TPasVariable then
  6013. begin
  6014. TypeEl:=ResolveAliasType(TPasVariable(FindCallData.Found).VarType);
  6015. if TypeEl is TPasProcedureType then
  6016. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  6017. else
  6018. RaiseMsg(20170405003522,nIllegalQualifier,sIllegalQualifier,['('],Params);
  6019. end
  6020. else
  6021. RaiseNotYetImplemented(20161003134755,FindCallData.Found);
  6022. end;
  6023. if FindCallData.Count>1 then
  6024. begin
  6025. // multiple overloads fit => search again and list the candidates
  6026. FindCallData:=Default(TFindCallElData);
  6027. FindCallData.Params:=Params;
  6028. FindCallData.List:=TFPList.Create;
  6029. try
  6030. IterateElements(ElName,@OnFindCallElements,@FindCallData,Abort);
  6031. Msg:='';
  6032. for i:=0 to FindCallData.List.Count-1 do
  6033. begin
  6034. El:=TPasElement(FindCallData.List[i]);
  6035. {$IFDEF VerbosePasResolver}
  6036. writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
  6037. {$ENDIF}
  6038. // emit a hint for each candidate
  6039. if El is TPasProcedure then
  6040. LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
  6041. [GetProcTypeDescription(TPasProcedure(El).ProcType,true,true)],El);
  6042. Msg:=Msg+', '+GetElementSourcePosStr(El);
  6043. end;
  6044. RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
  6045. sCantDetermineWhichOverloadedFunctionToCall+Msg,[ElName],Value);
  6046. finally
  6047. FindCallData.List.Free;
  6048. end;
  6049. end;
  6050. // FoundEl compatible element -> create reference
  6051. FoundEl:=FindCallData.Found;
  6052. Ref:=CreateReference(FoundEl,Value,rraRead);
  6053. if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
  6054. Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
  6055. FindData:=Default(TPRFindData);
  6056. FindData.ErrorPosEl:=Value;
  6057. FindData.StartScope:=FindCallData.StartScope;
  6058. FindData.ElScope:=FindCallData.ElScope;
  6059. FindData.Found:=FoundEl;
  6060. CheckFoundElement(FindData,Ref);
  6061. // set param expression Access flags
  6062. if FoundEl is TPasProcedure then
  6063. // now it is known which overloaded proc to call
  6064. FinishProcParams(TPasProcedure(FoundEl).ProcType)
  6065. else if FoundEl is TPasType then
  6066. begin
  6067. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  6068. C:=TypeEl.ClassType;
  6069. if (C=TPasClassType)
  6070. or (C=TPasClassOfType)
  6071. or (C=TPasRecordType)
  6072. or (C=TPasEnumType)
  6073. or (C=TPasSetType)
  6074. or (C=TPasPointerType)
  6075. or (C=TPasArrayType)
  6076. or (C=TPasRangeType) then
  6077. begin
  6078. // type cast
  6079. FinishUntypedParams(Access);
  6080. end
  6081. else if (C=TPasProcedureType)
  6082. or (C=TPasFunctionType) then
  6083. begin
  6084. // type cast to proc type
  6085. AccessExpr(Params.Params[0],Access);
  6086. end
  6087. else if C=TPasUnresolvedSymbolRef then
  6088. begin
  6089. if TypeEl.CustomData is TResElDataBuiltInProc then
  6090. begin
  6091. // call built-in proc
  6092. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  6093. if Assigned(BuiltInProc.FinishParamsExpression) then
  6094. BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
  6095. else
  6096. FinishUntypedParams(rraRead);
  6097. end
  6098. else if TypeEl.CustomData is TResElDataBaseType then
  6099. begin
  6100. // type cast to base type
  6101. FinishUntypedParams(Access);
  6102. end
  6103. else
  6104. begin
  6105. {$IFDEF VerbosePasResolver}
  6106. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  6107. {$ENDIF}
  6108. RaiseNotYetImplemented(20170325145720,Params);
  6109. end;
  6110. end
  6111. else
  6112. begin
  6113. {$IFDEF VerbosePasResolver}
  6114. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  6115. {$ENDIF}
  6116. RaiseMsg(20170306121908,nIllegalQualifier,sIllegalQualifier,['('],Params);
  6117. end;
  6118. end
  6119. else
  6120. begin
  6121. // FoundEl is not a type, maybe a var
  6122. ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  6123. if ResolvedEl.TypeEl is TPasProcedureType then
  6124. begin
  6125. FinishProcParams(TPasProcedureType(ResolvedEl.TypeEl));
  6126. exit;
  6127. end;
  6128. {$IFDEF VerbosePasResolver}
  6129. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
  6130. {$ENDIF}
  6131. RaiseMsg(20170306104301,nIllegalQualifier,sIllegalQualifier,['('],Params);
  6132. end;
  6133. end
  6134. else if Value.ClassType=TParamsExpr then
  6135. begin
  6136. SubParams:=TParamsExpr(Value);
  6137. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  6138. begin
  6139. // e.g. Name()() or Name[]()
  6140. ResolveExpr(SubParams,rraRead);
  6141. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  6142. if IsProcedureType(ResolvedEl,true) then
  6143. begin
  6144. CheckCallProcCompatibility(TPasProcedureType(ResolvedEl.TypeEl),Params,true);
  6145. CreateReference(TPasProcedureType(ResolvedEl.TypeEl),Value,Access);
  6146. exit;
  6147. end
  6148. end;
  6149. RaiseMsg(20170216152202,nIllegalQualifier,sIllegalQualifier,['('],Params);
  6150. end
  6151. else
  6152. RaiseNotYetImplemented(20161014085118,Params.Value);
  6153. end;
  6154. procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
  6155. Access: TResolvedRefAccess);
  6156. var
  6157. ResolvedEl: TPasResolverResult;
  6158. procedure ResolveValueName(Value: TPasElement; ArrayName: string);
  6159. var
  6160. FindData: TPRFindData;
  6161. Ref: TResolvedReference;
  6162. DeclEl: TPasElement;
  6163. Proc, ImplProc: TPasProcedure;
  6164. ProcScope: TPasProcedureScope;
  6165. begin
  6166. // e.g. Name[]
  6167. DeclEl:=FindElementWithoutParams(ArrayName,FindData,Value,true);
  6168. Ref:=CreateReference(DeclEl,Value,Access,@FindData);
  6169. CheckFoundElement(FindData,Ref);
  6170. if DeclEl is TPasProcedure then
  6171. begin
  6172. Proc:=TPasProcedure(DeclEl);
  6173. if (Access=rraAssign) and (Proc is TPasFunction)
  6174. and (Value.ClassType=TPrimitiveExpr)
  6175. and (Params.Parent.ClassType=TPasImplAssign)
  6176. and (TPasImplAssign(Params.Parent).left=Params) then
  6177. begin
  6178. // e.g. funcname[]:=
  6179. ProcScope:=Proc.CustomData as TPasProcedureScope;
  6180. ImplProc:=ProcScope.ImplProc;
  6181. if ImplProc=nil then
  6182. ImplProc:=Proc;
  6183. if Params.HasParent(ImplProc) then
  6184. begin
  6185. // "FuncA[]:=" within FuncA -> redirect to ResultEl
  6186. Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
  6187. end;
  6188. end;
  6189. end;
  6190. ComputeElement(Value,ResolvedEl,[rcSkipTypeAlias,rcSetReferenceFlags]);
  6191. end;
  6192. var
  6193. Value: TPasExpr;
  6194. SubParams: TParamsExpr;
  6195. begin
  6196. Value:=Params.Value;
  6197. if (Value.ClassType=TPrimitiveExpr)
  6198. and (TPrimitiveExpr(Value).Kind=pekIdent) then
  6199. // e.g. Name[]
  6200. ResolveValueName(Value,TPrimitiveExpr(Value).Value)
  6201. else if (Value.ClassType=TSelfExpr) then
  6202. // e.g. Self[]
  6203. ResolveValueName(Value,'Self')
  6204. else if Value.ClassType=TParamsExpr then
  6205. begin
  6206. SubParams:=TParamsExpr(Value);
  6207. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  6208. begin
  6209. // e.g. Name()[] or Name[][]
  6210. ResolveExpr(SubParams,rraRead);
  6211. ComputeElement(SubParams,ResolvedEl,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
  6212. if Value.CustomData=nil then
  6213. CreateReference(ResolvedEl.TypeEl,Value,Access);
  6214. end
  6215. else
  6216. RaiseNotYetImplemented(20161010194925,Value);
  6217. end
  6218. else
  6219. RaiseNotYetImplemented(20160927212610,Value);
  6220. {$IFDEF VerbosePasResolver}
  6221. writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
  6222. {$ENDIF}
  6223. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  6224. end;
  6225. procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
  6226. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
  6227. var
  6228. ArgExp: TPasExpr;
  6229. ResolvedArg: TPasResolverResult;
  6230. PropEl: TPasProperty;
  6231. ClassScope: TPasClassScope;
  6232. i: Integer;
  6233. begin
  6234. if ResolvedValue.BaseType in btAllStrings then
  6235. begin
  6236. // string -> check that ResolvedValue is not merely a type, but has a value
  6237. if not (rrfReadable in ResolvedValue.Flags) then
  6238. RaiseXExpectedButYFound(20170216152548,'variable',ResolvedValue.TypeEl.ElementTypeName,Params);
  6239. // check single argument
  6240. if length(Params.Params)<1 then
  6241. RaiseMsg(20170216152204,nMissingParameterX,
  6242. sMissingParameterX,['character index'],Params)
  6243. else if length(Params.Params)>1 then
  6244. RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
  6245. // check argument is integer
  6246. ArgExp:=Params.Params[0];
  6247. ComputeElement(ArgExp,ResolvedArg,[rcSkipTypeAlias,rcSetReferenceFlags]);
  6248. if not (ResolvedArg.BaseType in btAllInteger) then
  6249. RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  6250. [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
  6251. if not (rrfReadable in ResolvedArg.Flags) then
  6252. RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  6253. ['type','value'],ArgExp);
  6254. AccessExpr(ArgExp,rraRead);
  6255. exit;
  6256. end
  6257. else if (ResolvedValue.IdentEl is TPasProperty)
  6258. and (TPasProperty(ResolvedValue.IdentEl).Args.Count>0) then
  6259. begin
  6260. PropEl:=TPasProperty(ResolvedValue.IdentEl);
  6261. CheckCallPropertyCompatibility(PropEl,Params,true);
  6262. FinishPropertyParamAccess(Params,PropEl);
  6263. exit;
  6264. end
  6265. else if ResolvedValue.BaseType=btContext then
  6266. begin
  6267. if ResolvedValue.TypeEl.ClassType=TPasClassType then
  6268. begin
  6269. ClassScope:=NoNil(ResolvedValue.TypeEl.CustomData) as TPasClassScope;
  6270. if ResolveBracketOperatorClass(Params,ResolvedValue,ClassScope,Access) then
  6271. exit;
  6272. end
  6273. else if ResolvedValue.TypeEl.ClassType=TPasArrayType then
  6274. begin
  6275. if ResolvedValue.IdentEl is TPasType then
  6276. RaiseMsg(20170216152215,nIllegalQualifier,sIllegalQualifier,['['],Params);
  6277. CheckCallArrayCompatibility(TPasArrayType(ResolvedValue.TypeEl),Params,true,true);
  6278. for i:=0 to length(Params.Params)-1 do
  6279. AccessExpr(Params.Params[i],rraRead);
  6280. exit;
  6281. end;
  6282. end;
  6283. RaiseMsg(20170216152217,nIllegalQualifier,sIllegalQualifier,['['],Params);
  6284. end;
  6285. function TPasResolver.ResolveBracketOperatorClass(Params: TParamsExpr;
  6286. const ResolvedValue: TPasResolverResult; ClassScope: TPasClassScope;
  6287. Access: TResolvedRefAccess): boolean;
  6288. var
  6289. PropEl: TPasProperty;
  6290. Value: TPasExpr;
  6291. begin
  6292. PropEl:=ClassScope.DefaultProperty;
  6293. if PropEl<>nil then
  6294. begin
  6295. // class has default property
  6296. if (ResolvedValue.IdentEl is TPasType) and (not PropEl.IsClass) then
  6297. RaiseMsg(20170216152213,nIllegalQualifier,sIllegalQualifier,['['],Params);
  6298. Value:=Params.Value;
  6299. if Value.CustomData is TResolvedReference then
  6300. SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
  6301. CreateReference(PropEl,Params,Access);
  6302. CheckCallPropertyCompatibility(PropEl,Params,true);
  6303. FinishPropertyParamAccess(Params,PropEl);
  6304. exit(true);
  6305. end;
  6306. Result:=false;
  6307. end;
  6308. procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
  6309. // e.g. resolving '[1,2..3]'
  6310. begin
  6311. {$IFDEF VerbosePasResolver}
  6312. writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
  6313. {$ENDIF}
  6314. if Params.Value<>nil then
  6315. RaiseNotYetImplemented(20160930135910,Params);
  6316. end;
  6317. procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
  6318. var
  6319. i: Integer;
  6320. begin
  6321. for i:=0 to length(El.Values)-1 do
  6322. ResolveExpr(El.Values[i],rraRead);
  6323. end;
  6324. procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
  6325. Ref: TResolvedReference; Access: TResolvedRefAccess);
  6326. begin
  6327. if (Ref.Access=Access) then exit;
  6328. if Access in [rraNone,rraParamToUnknownProc] then
  6329. exit;
  6330. if Expr=nil then ;
  6331. case Ref.Access of
  6332. rraNone,rraParamToUnknownProc:
  6333. Ref.Access:=Access;
  6334. rraRead:
  6335. if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
  6336. Ref.Access:=rraReadAndAssign
  6337. else
  6338. exit;
  6339. rraAssign,rraOutParam:
  6340. if Access in [rraRead,rraReadAndAssign,rraVarParam] then
  6341. Ref.Access:=rraReadAndAssign
  6342. else
  6343. exit;
  6344. rraReadAndAssign: exit;
  6345. rraVarParam: exit;
  6346. else
  6347. RaiseInternalError(20170403163727);
  6348. end;
  6349. end;
  6350. procedure TPasResolver.AccessExpr(Expr: TPasExpr;
  6351. Access: TResolvedRefAccess);
  6352. // called after a call target was found, called for each element
  6353. // to change the rraParamToUnknownProc value to Access
  6354. var
  6355. Ref: TResolvedReference;
  6356. Bin: TBinaryExpr;
  6357. Params: TParamsExpr;
  6358. ValueResolved: TPasResolverResult;
  6359. C: TClass;
  6360. begin
  6361. if (Expr.CustomData is TResolvedReference) then
  6362. begin
  6363. Ref:=TResolvedReference(Expr.CustomData);
  6364. SetResolvedRefAccess(Expr,Ref,Access);
  6365. end;
  6366. C:=Expr.ClassType;
  6367. if C=TBinaryExpr then
  6368. begin
  6369. Bin:=TBinaryExpr(Expr);
  6370. if Bin.OpCode in [eopSubIdent,eopNone] then
  6371. AccessExpr(Bin.right,Access);
  6372. end
  6373. else if C=TParamsExpr then
  6374. begin
  6375. Params:=TParamsExpr(Expr);
  6376. case Params.Kind of
  6377. pekFuncParams:
  6378. if IsTypeCast(Params) then
  6379. AccessExpr(Params.Params[0],Access)
  6380. else
  6381. AccessExpr(Params.Value,Access);
  6382. pekArrayParams:
  6383. begin
  6384. ComputeElement(Params.Value,ValueResolved,[]);
  6385. if IsDynArray(ValueResolved.TypeEl,false) then
  6386. // an element of a dynamic array is independ of the array variable
  6387. else
  6388. AccessExpr(Params.Value,Access);
  6389. // Note: an element of an open or static array or a string is connected to the variable
  6390. end;
  6391. pekSet:
  6392. if Access<>rraRead then
  6393. RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  6394. else
  6395. RaiseNotYetImplemented(20170403173831,Params);
  6396. end;
  6397. end
  6398. else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
  6399. // ok
  6400. else if (Access in [rraRead,rraParamToUnknownProc])
  6401. and ((C=TPrimitiveExpr)
  6402. or (C=TNilExpr)
  6403. or (C=TBoolConstExpr)) then
  6404. // ok
  6405. else if C=TUnaryExpr then
  6406. AccessExpr(TUnaryExpr(Expr).Operand,Access)
  6407. else
  6408. begin
  6409. {$IFDEF VerbosePasResolver}
  6410. writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  6411. {$ENDIF}
  6412. RaiseNotYetImplemented(20170306102158,Expr);
  6413. end;
  6414. end;
  6415. procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
  6416. var
  6417. i: Integer;
  6418. DeclEl: TPasElement;
  6419. Proc: TPasProcedure;
  6420. aClassType: TPasClassType;
  6421. begin
  6422. if IsElementSkipped(El) then exit;
  6423. if El is TPasDeclarations then
  6424. begin
  6425. for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
  6426. begin
  6427. DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
  6428. if DeclEl is TPasProcedure then
  6429. begin
  6430. Proc:=TPasProcedure(DeclEl);
  6431. if ProcNeedsImplProc(Proc)
  6432. and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
  6433. RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
  6434. [Proc.ElementTypeName,Proc.Name],Proc);
  6435. end;
  6436. end;
  6437. end
  6438. else if El.ClassType=TPasClassType then
  6439. begin
  6440. aClassType:=TPasClassType(El);
  6441. for i:=0 to aClassType.Members.Count-1 do
  6442. begin
  6443. DeclEl:=TPasElement(aClassType.Members[i]);
  6444. if DeclEl is TPasProcedure then
  6445. begin
  6446. Proc:=TPasProcedure(DeclEl);
  6447. if Proc.IsAbstract or Proc.IsExternal then continue;
  6448. if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
  6449. RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
  6450. [Proc.ElementTypeName,Proc.Name],Proc);
  6451. end;
  6452. end;
  6453. end;
  6454. end;
  6455. procedure TPasResolver.AddModule(El: TPasModule);
  6456. var
  6457. C: TClass;
  6458. ModScope: TPasModuleScope;
  6459. begin
  6460. if TopScope<>DefaultScope then
  6461. RaiseInvalidScopeForElement(20160922163504,El);
  6462. ModScope:=TPasModuleScope(PushScope(El,TPasModuleScope));
  6463. ModScope.VisibilityContext:=El;
  6464. ModScope.FirstName:=FirstDottedIdentifier(El.Name);
  6465. C:=El.ClassType;
  6466. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  6467. FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
  6468. else
  6469. FDefaultNameSpace:='';
  6470. end;
  6471. procedure TPasResolver.AddSection(El: TPasSection);
  6472. // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
  6473. // Note: implementation scope is within the interface scope
  6474. begin
  6475. if TopScope is TPasSectionScope then
  6476. FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
  6477. FPendingForwardProcs.Add(El); // check forward declarations at the end
  6478. PushScope(El,TPasSectionScope);
  6479. end;
  6480. procedure TPasResolver.AddType(El: TPasType);
  6481. begin
  6482. if (El.Name='') then exit; // sub type
  6483. {$IFDEF VerbosePasResolver}
  6484. writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
  6485. {$ENDIF}
  6486. if not (TopScope is TPasIdentifierScope) then
  6487. RaiseInvalidScopeForElement(20160922163506,El);
  6488. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6489. end;
  6490. procedure TPasResolver.AddRecordType(El: TPasRecordType);
  6491. begin
  6492. {$IFDEF VerbosePasResolver}
  6493. writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  6494. {$ENDIF}
  6495. if not (TopScope is TPasIdentifierScope) then
  6496. RaiseInvalidScopeForElement(20160922163508,El);
  6497. if El.Name<>'' then begin
  6498. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6499. FPendingForwardProcs.Add(El); // check forward declarations at the end
  6500. end;
  6501. if El.Parent.ClassType<>TPasVariant then
  6502. PushScope(El,TPasRecordScope);
  6503. end;
  6504. procedure TPasResolver.AddClassType(El: TPasClassType);
  6505. var
  6506. Duplicate: TPasIdentifier;
  6507. ForwardDecl: TPasClassType;
  6508. begin
  6509. {$IFDEF VerbosePasResolver}
  6510. writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
  6511. {$ENDIF}
  6512. if not (TopScope is TPasIdentifierScope) then
  6513. RaiseInvalidScopeForElement(20160922163510,El);
  6514. if not (TopScope is TPasSectionScope) then
  6515. RaiseNotYetImplemented(20171225110934,El,'nested classes');
  6516. Duplicate:=TPasIdentifierScope(TopScope).FindIdentifier(El.Name);
  6517. //if Duplicate<>nil then
  6518. //writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
  6519. if (Duplicate<>nil)
  6520. and (Duplicate.Kind=pikSimple)
  6521. and (Duplicate.Element<>nil)
  6522. and (Duplicate.Element.Parent=El.Parent)
  6523. and (Duplicate.Element is TPasClassType)
  6524. and TPasClassType(Duplicate.Element).IsForward
  6525. then
  6526. begin
  6527. // forward declaration found
  6528. ForwardDecl:=TPasClassType(Duplicate.Element);
  6529. {$IFDEF VerbosePasResolver}
  6530. writeln(' Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
  6531. {$ENDIF}
  6532. if ForwardDecl.CustomData<>nil then
  6533. RaiseInternalError(20160922163513,'forward class has already customdata');
  6534. // create a ref from the forward to the real declaration
  6535. CreateReference(El,ForwardDecl,rraRead);
  6536. // change the cache item
  6537. Duplicate.Element:=El;
  6538. end
  6539. else
  6540. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6541. FPendingForwardProcs.Add(El); // check forward declarations at the end
  6542. end;
  6543. procedure TPasResolver.AddVariable(El: TPasVariable);
  6544. begin
  6545. if (El.Name='') then exit; // anonymous var
  6546. {$IFDEF VerbosePasResolver}
  6547. writeln('TPasResolver.AddVariable ',GetObjName(El));
  6548. {$ENDIF}
  6549. if not (TopScope is TPasIdentifierScope) then
  6550. RaiseInvalidScopeForElement(20160929205730,El);
  6551. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6552. end;
  6553. procedure TPasResolver.AddResourceString(El: TPasResString);
  6554. var
  6555. C: TClass;
  6556. begin
  6557. {$IFDEF VerbosePasResolver}
  6558. writeln('TPasResolver.AddResourceString ',GetObjName(El));
  6559. {$ENDIF}
  6560. if not (TopScope is TPasIdentifierScope) then
  6561. RaiseInvalidScopeForElement(20171004092114,El);
  6562. C:=El.Parent.ClassType;
  6563. if not C.InheritsFrom(TPasSection) then
  6564. RaiseNotYetImplemented(20171004092518,El);
  6565. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6566. end;
  6567. procedure TPasResolver.AddEnumType(El: TPasEnumType);
  6568. var
  6569. CanonicalSet: TPasSetType;
  6570. begin
  6571. {$IFDEF VerbosePasResolver}
  6572. writeln('TPasResolver.AddEnumType ',GetObjName(El));
  6573. {$ENDIF}
  6574. if not (TopScope is TPasIdentifierScope) then
  6575. RaiseInvalidScopeForElement(20160929205732,El);
  6576. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6577. PushScope(El,TPasEnumTypeScope);
  6578. // add canonical set
  6579. CanonicalSet:=TPasSetType.Create('',El);
  6580. CanonicalSet.EnumType:=El;
  6581. El.AddRef;
  6582. TPasEnumTypeScope(TopScope).CanonicalSet:=CanonicalSet;
  6583. end;
  6584. procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
  6585. var
  6586. i: Integer;
  6587. Scope: TPasScope;
  6588. Old: TPasIdentifier;
  6589. begin
  6590. {$IFDEF VerbosePasResolver}
  6591. writeln('TPasResolver.AddEnumValue ',GetObjName(El));
  6592. {$ENDIF}
  6593. if not (TopScope is TPasEnumTypeScope) then
  6594. RaiseInvalidScopeForElement(20160929205736,El);
  6595. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6596. if not (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches) then
  6597. begin
  6598. // propagate enum to parent scopes
  6599. for i:=ScopeCount-2 downto 0 do
  6600. begin
  6601. Scope:=Scopes[i];
  6602. if (Scope is TPasClassScope) or (Scope is TPasRecordScope) then
  6603. begin
  6604. // class or record: add if not duplicate
  6605. Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
  6606. if Old=nil then
  6607. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  6608. end
  6609. else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
  6610. begin
  6611. // procedure or section: check for duplicate and add
  6612. Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
  6613. if Old<>nil then
  6614. RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
  6615. [El.Name,GetElementSourcePosStr(Old.Element)],El);
  6616. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  6617. break;
  6618. end
  6619. else
  6620. break;
  6621. end;
  6622. end;
  6623. end;
  6624. procedure TPasResolver.AddProperty(El: TPasProperty);
  6625. begin
  6626. if (El.Name='') then
  6627. RaiseNotYetImplemented(20160922163518,El);
  6628. {$IFDEF VerbosePasResolver}
  6629. writeln('TPasResolver.AddProperty ',GetObjName(El));
  6630. {$ENDIF}
  6631. if not (TopScope is TPasClassScope) then
  6632. RaiseInvalidScopeForElement(20160922163520,El);
  6633. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6634. PushScope(El,TPasPropertyScope);
  6635. end;
  6636. procedure TPasResolver.AddProcedure(El: TPasProcedure);
  6637. var
  6638. ProcName, aClassName: String;
  6639. p: SizeInt;
  6640. CurClassType: TPasClassType;
  6641. ProcScope: TPasProcedureScope;
  6642. NeedPop, HasDot: Boolean;
  6643. begin
  6644. {$IFDEF VerbosePasResolver}
  6645. writeln('TPasResolver.AddProcedure ',GetObjName(El));
  6646. {$ENDIF}
  6647. if not (TopScope is TPasIdentifierScope) then
  6648. RaiseInvalidScopeForElement(20160922163522,El);
  6649. // Note: El.ProcType is nil !
  6650. ProcName:=El.Name;
  6651. HasDot:=Pos('.',ProcName)>1;
  6652. if not HasDot then
  6653. AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
  6654. ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
  6655. if msDelphi in CurrentParser.CurrentModeswitches then
  6656. ProcScope.Mode:=msDelphi
  6657. else
  6658. ProcScope.Mode:=msObjfpc;
  6659. if HasDot then
  6660. begin
  6661. // method implementation -> search class
  6662. {$IFDEF VerbosePasResolver}
  6663. writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
  6664. {$ENDIF}
  6665. CurClassType:=nil;
  6666. repeat
  6667. p:=Pos('.',ProcName);
  6668. if p<1 then
  6669. begin
  6670. if CurClassType=nil then
  6671. RaiseInternalError(20161013170829);
  6672. break;
  6673. end;
  6674. aClassName:=LeftStr(ProcName,p-1);
  6675. Delete(ProcName,1,p);
  6676. {$IFDEF VerbosePasResolver}
  6677. writeln('TPasResolver.AddProcedure searching class "',aClassName,'" ProcName="',ProcName,'" ...');
  6678. {$ENDIF}
  6679. if not IsValidIdent(aClassName) then
  6680. RaiseNotYetImplemented(20161013170844,El);
  6681. if CurClassType<>nil then
  6682. begin
  6683. NeedPop:=true;
  6684. PushClassDotScope(CurClassType);
  6685. end
  6686. else
  6687. NeedPop:=false;
  6688. CurClassType:=TPasClassType(FindElementWithoutParams(aClassName,El,false));
  6689. if not (CurClassType is TPasClassType) then
  6690. begin
  6691. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName));
  6692. RaiseXExpectedButYFound(20170216152557,'class',aClassname+':'+CurClassType.ElementTypeName,El);
  6693. end;
  6694. // restore scope
  6695. if NeedPop then
  6696. PopScope;
  6697. until false;
  6698. if not IsValidIdent(ProcName) then
  6699. RaiseNotYetImplemented(20161013170956,El);
  6700. ProcScope.VisibilityContext:=CurClassType;
  6701. ProcScope.ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  6702. end;
  6703. end;
  6704. procedure TPasResolver.AddArgument(El: TPasArgument);
  6705. var
  6706. ProcType: TPasProcedureType;
  6707. i: Integer;
  6708. Arg: TPasArgument;
  6709. begin
  6710. if (El.Name='') then
  6711. RaiseInternalError(20160922163526,GetObjName(El));
  6712. {$IFDEF VerbosePasResolver}
  6713. writeln('TPasResolver.AddArgument ',GetObjName(El));
  6714. {$ENDIF}
  6715. if (TopScope=nil) then
  6716. RaiseInvalidScopeForElement(20160922163529,El);
  6717. if El.Parent.ClassType=TPasProperty then
  6718. begin
  6719. if TopScope.ClassType<>TPasPropertyScope then
  6720. RaiseInvalidScopeForElement(20161014124530,El);
  6721. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6722. end
  6723. else if El.Parent is TPasProcedureType then
  6724. begin
  6725. ProcType:=TPasProcedureType(El.Parent);
  6726. if ProcType.Parent is TPasProcedure then
  6727. begin
  6728. if TopScope.ClassType<>FScopeClass_Proc then
  6729. RaiseInvalidScopeForElement(20160922163529,El);
  6730. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  6731. end
  6732. else
  6733. begin
  6734. for i:=0 to ProcType.Args.Count-1 do
  6735. begin
  6736. Arg:=TPasArgument(ProcType.Args[i]);
  6737. if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
  6738. RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
  6739. end;
  6740. end;
  6741. end
  6742. else
  6743. RaiseNotYetImplemented(20161014124937,El);
  6744. end;
  6745. procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
  6746. begin
  6747. if TopScope.ClassType<>FScopeClass_Proc then exit;
  6748. if not (El.Parent is TPasProcedure) then exit;
  6749. AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple);
  6750. end;
  6751. procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
  6752. begin
  6753. PushScope(El,TPasExceptOnScope);
  6754. end;
  6755. procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
  6756. begin
  6757. if El=nil then ;
  6758. CheckTopScope(FScopeClass_Proc);
  6759. end;
  6760. procedure TPasResolver.WriteScopes;
  6761. var
  6762. i: Integer;
  6763. Scope: TPasScope;
  6764. begin
  6765. writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
  6766. for i:=ScopeCount-1 downto 0 do
  6767. begin
  6768. Scope:=Scopes[i];
  6769. writeln(' ',i,'/',ScopeCount,' ',GetObjName(Scope));
  6770. Scope.WriteIdentifiers(' ');
  6771. end;
  6772. end;
  6773. procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
  6774. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  6775. StartEl: TPasElement);
  6776. var
  6777. LeftResolved, RightResolved: TPasResolverResult;
  6778. begin
  6779. if (Bin.OpCode=eopSubIdent)
  6780. or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
  6781. begin
  6782. // Note: bin.left was already resolved via ResolveSubIdent
  6783. ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
  6784. exit;
  6785. end;
  6786. if Bin.OpCode in [eopEqual,eopNotEqual] then
  6787. begin
  6788. if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
  6789. rcSetReferenceFlags in Flags)=cIncompatible then
  6790. RaiseInternalError(20161007215912);
  6791. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],Bin,[rrfReadable]);
  6792. exit;
  6793. end;
  6794. ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
  6795. ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
  6796. // ToDo: check operator overloading
  6797. ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
  6798. end;
  6799. procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
  6800. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  6801. var LeftResolved, RightResolved: TPasResolverResult);
  6802. procedure SetBaseType(BaseType: TResolverBaseType);
  6803. begin
  6804. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],Bin,[rrfReadable]);
  6805. end;
  6806. var
  6807. ElTypeResolved: TPasResolverResult;
  6808. LeftTypeEl, RightTypeEl: TPasType;
  6809. begin
  6810. if LeftResolved.BaseType=btRange then
  6811. ConvertRangeToElement(LeftResolved);
  6812. if RightResolved.BaseType=btRange then
  6813. ConvertRangeToElement(RightResolved);
  6814. //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  6815. if LeftResolved.BaseType in btAllInteger then
  6816. begin
  6817. if (rrfReadable in LeftResolved.Flags)
  6818. and (rrfReadable in RightResolved.Flags) then
  6819. begin
  6820. if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  6821. case Bin.OpCode of
  6822. eopNone:
  6823. if (Bin.Kind=pekRange) then
  6824. begin
  6825. if not (RightResolved.BaseType in btAllInteger) then
  6826. RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
  6827. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  6828. if Bin.Parent is TPasRangeType then
  6829. ResolvedEl.TypeEl:=TPasRangeType(Bin.Parent);
  6830. exit;
  6831. end;
  6832. eopAdd, eopSubtract,
  6833. eopMultiply, eopDiv, eopMod,
  6834. eopPower,
  6835. eopShl, eopShr,
  6836. eopAnd, eopOr, eopXor:
  6837. begin
  6838. // use left type for result
  6839. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  6840. exit;
  6841. end;
  6842. eopLessThan,
  6843. eopGreaterThan,
  6844. eopLessthanEqual,
  6845. eopGreaterThanEqual:
  6846. begin
  6847. SetBaseType(btBoolean);
  6848. exit;
  6849. end;
  6850. eopDivide:
  6851. begin
  6852. SetBaseType(BaseTypeExtended);
  6853. exit;
  6854. end;
  6855. end
  6856. else if (RightResolved.BaseType=btSet) and (RightResolved.SubType in btAllInteger)
  6857. and (Bin.OpCode=eopIn) then
  6858. begin
  6859. SetBaseType(btBoolean);
  6860. exit;
  6861. end;
  6862. end;
  6863. end
  6864. else if LeftResolved.BaseType in btAllBooleans then
  6865. begin
  6866. if (rrfReadable in LeftResolved.Flags)
  6867. and (RightResolved.BaseType in btAllBooleans)
  6868. and (rrfReadable in RightResolved.Flags) then
  6869. case Bin.OpCode of
  6870. eopNone:
  6871. if Bin.Kind=pekRange then
  6872. begin
  6873. SetResolverValueExpr(ResolvedEl,btRange,FBaseTypes[LeftResolved.BaseType],Bin,[rrfReadable]);
  6874. ResolvedEl.SubType:=LeftResolved.BaseType;
  6875. exit;
  6876. end;
  6877. eopAnd, eopOr, eopXor:
  6878. begin
  6879. // use left type for result
  6880. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  6881. exit;
  6882. end;
  6883. end;
  6884. end
  6885. else if LeftResolved.BaseType in btAllStringAndChars then
  6886. begin
  6887. if (rrfReadable in LeftResolved.Flags)
  6888. and (rrfReadable in RightResolved.Flags) then
  6889. begin
  6890. if (RightResolved.BaseType in btAllStringAndChars) then
  6891. case Bin.OpCode of
  6892. eopNone:
  6893. if (Bin.Kind=pekRange) and (LeftResolved.BaseType in btAllChars) then
  6894. begin
  6895. if not (RightResolved.BaseType in btAllChars) then
  6896. RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
  6897. SetResolverValueExpr(ResolvedEl,btRange,FBaseTypes[LeftResolved.BaseType],Bin,[rrfReadable]);
  6898. ResolvedEl.SubType:=LeftResolved.BaseType;
  6899. exit;
  6900. end;
  6901. eopAdd:
  6902. case LeftResolved.BaseType of
  6903. btChar:
  6904. begin
  6905. case RightResolved.BaseType of
  6906. btChar: SetBaseType(btString);
  6907. btAnsiChar:
  6908. if BaseTypeChar=btAnsiChar then
  6909. SetBaseType(btString)
  6910. else
  6911. SetBaseType(btUnicodeString);
  6912. btWideChar:
  6913. if BaseTypeChar=btWideChar then
  6914. SetBaseType(btString)
  6915. else
  6916. SetBaseType(btUnicodeString);
  6917. else
  6918. // use right type for result
  6919. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
  6920. end;
  6921. exit;
  6922. end;
  6923. btAnsiChar:
  6924. begin
  6925. case RightResolved.BaseType of
  6926. btChar:
  6927. if BaseTypeChar=btAnsiChar then
  6928. SetBaseType(btString)
  6929. else
  6930. SetBaseType(btUnicodeString);
  6931. btAnsiChar:
  6932. if BaseTypeChar=btAnsiChar then
  6933. SetBaseType(btString)
  6934. else
  6935. SetBaseType(btAnsiString);
  6936. btWideChar:
  6937. if BaseTypeChar=btWideChar then
  6938. SetBaseType(btString)
  6939. else
  6940. SetBaseType(btUnicodeString);
  6941. else
  6942. // use right type for result
  6943. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
  6944. end;
  6945. exit;
  6946. end;
  6947. btWideChar:
  6948. begin
  6949. case RightResolved.BaseType of
  6950. btChar,btAnsiChar,btWideChar:
  6951. if BaseTypeChar=btWideChar then
  6952. SetBaseType(btString)
  6953. else
  6954. SetBaseType(btUnicodeString);
  6955. else
  6956. // use right type for result
  6957. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
  6958. end;
  6959. exit;
  6960. end;
  6961. btShortString:
  6962. begin
  6963. case RightResolved.BaseType of
  6964. btChar,btAnsiChar,btShortString,btWideChar:
  6965. // use left type for result
  6966. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  6967. else
  6968. // shortstring + string => string
  6969. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
  6970. end;
  6971. exit;
  6972. end;
  6973. btString,btAnsiString,btUnicodeString:
  6974. begin
  6975. // string + x => string
  6976. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  6977. exit;
  6978. end;
  6979. end;
  6980. eopLessThan,
  6981. eopGreaterThan,
  6982. eopLessthanEqual,
  6983. eopGreaterThanEqual:
  6984. begin
  6985. SetBaseType(btBoolean);
  6986. exit;
  6987. end;
  6988. end
  6989. else if (RightResolved.BaseType=btSet)
  6990. and (RightResolved.SubType in btAllChars)
  6991. and (LeftResolved.BaseType in btAllChars) then
  6992. begin
  6993. case Bin.OpCode of
  6994. eopIn:
  6995. begin
  6996. SetBaseType(btBoolean);
  6997. exit;
  6998. end;
  6999. end;
  7000. end
  7001. end
  7002. end
  7003. else if LeftResolved.BaseType in btAllFloats then
  7004. begin
  7005. if (rrfReadable in LeftResolved.Flags)
  7006. and (RightResolved.BaseType in (btAllInteger+btAllFloats))
  7007. and (rrfReadable in RightResolved.Flags) then
  7008. case Bin.OpCode of
  7009. eopAdd, eopSubtract,
  7010. eopMultiply, eopDivide, eopMod,
  7011. eopPower:
  7012. begin
  7013. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
  7014. exit;
  7015. end;
  7016. eopLessThan,
  7017. eopGreaterThan,
  7018. eopLessthanEqual,
  7019. eopGreaterThanEqual:
  7020. begin
  7021. SetBaseType(btBoolean);
  7022. exit;
  7023. end;
  7024. end;
  7025. end
  7026. else if LeftResolved.BaseType=btPointer then
  7027. begin
  7028. if (rrfReadable in LeftResolved.Flags)
  7029. and (RightResolved.BaseType in btAllInteger)
  7030. and (rrfReadable in RightResolved.Flags) then
  7031. case Bin.OpCode of
  7032. eopAdd,eopSubtract:
  7033. begin
  7034. SetResolverValueExpr(ResolvedEl,btPointer,LeftResolved.TypeEl,Bin,[rrfReadable]);
  7035. exit;
  7036. end;
  7037. end
  7038. else if RightResolved.BaseType=btPointer then
  7039. case Bin.OpCode of
  7040. eopLessThan,
  7041. eopGreaterThan,
  7042. eopLessthanEqual,
  7043. eopGreaterThanEqual:
  7044. begin
  7045. SetBaseType(btBoolean);
  7046. exit;
  7047. end;
  7048. end;
  7049. end
  7050. else if LeftResolved.BaseType=btContext then
  7051. case Bin.OpCode of
  7052. eopNone:
  7053. if Bin.Kind=pekRange then
  7054. begin
  7055. if (rrfReadable in LeftResolved.Flags)
  7056. and (rrfReadable in RightResolved.Flags) then
  7057. begin
  7058. CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
  7059. ResolvedEl:=LeftResolved;
  7060. ResolvedEl.SubType:=ResolvedEl.BaseType;
  7061. ResolvedEl.BaseType:=btRange;
  7062. ResolvedEl.ExprEl:=Bin;
  7063. exit;
  7064. end;
  7065. end;
  7066. eopIn:
  7067. if (rrfReadable in LeftResolved.Flags)
  7068. and (rrfReadable in RightResolved.Flags) then
  7069. begin
  7070. if LeftResolved.BaseType in (btAllInteger+btAllChars) then
  7071. begin
  7072. if (RightResolved.BaseType<>btSet) then
  7073. RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],LeftResolved.TypeEl.ElementTypeName,Bin.right);
  7074. if LeftResolved.BaseType in btAllChars then
  7075. begin
  7076. if not (RightResolved.SubType in btAllChars) then
  7077. RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  7078. end
  7079. else if not (RightResolved.SubType in btAllInteger) then
  7080. RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  7081. SetBaseType(btBoolean);
  7082. exit;
  7083. end
  7084. else if (LeftResolved.BaseType=btContext) and (LeftResolved.TypeEl is TPasEnumType) then
  7085. begin
  7086. if (RightResolved.BaseType<>btSet) then
  7087. RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.TypeEl.Name,LeftResolved.TypeEl.ElementTypeName,Bin.right);
  7088. if LeftResolved.TypeEl=RightResolved.TypeEl then
  7089. else if RightResolved.TypeEl.ClassType=TPasRangeType then
  7090. begin
  7091. ComputeElement(TPasRangeType(RightResolved.TypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
  7092. if LeftResolved.TypeEl<>ElTypeResolved.TypeEl then
  7093. RaiseXExpectedButYFound(20171109215833,'set of '+LeftResolved.TypeEl.Name,'set of '+RightResolved.TypeEl.Name,Bin.right);
  7094. end
  7095. else
  7096. RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.TypeEl.Name,'set of '+RightResolved.TypeEl.Name,Bin.right);
  7097. SetBaseType(btBoolean);
  7098. exit;
  7099. end
  7100. else
  7101. RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
  7102. sInOperatorExpectsSetElementButGot,[LeftResolved.TypeEl.ElementTypeName],Bin);
  7103. end;
  7104. eopIs:
  7105. begin
  7106. LeftTypeEl:=ResolveAliasType(LeftResolved.TypeEl);
  7107. RightTypeEl:=ResolveAliasType(RightResolved.TypeEl);
  7108. if (LeftTypeEl is TPasClassType) then
  7109. begin
  7110. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  7111. RaiseMsg(20170216152230,nIllegalQualifier,sIllegalQualifier,['is'],Bin);
  7112. // left side is a class instance
  7113. if (RightResolved.IdentEl is TPasType)
  7114. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  7115. begin
  7116. // e.g. if Image is TFPMemoryImage then ;
  7117. // Note: at compile time the check is reversed: right must inherit from left
  7118. if CheckSrcIsADstType(RightResolved,LeftResolved,Bin)<>cIncompatible then
  7119. begin
  7120. SetBaseType(btBoolean);
  7121. exit;
  7122. end
  7123. else if CheckSrcIsADstType(LeftResolved,RightResolved,Bin)<>cIncompatible then
  7124. begin
  7125. // e.g. if Image is TObject then ;
  7126. // This is useful after some unchecked typecast -> allow
  7127. SetBaseType(btBoolean);
  7128. exit;
  7129. end;
  7130. {$IFDEF VerbosePasResolver}
  7131. writeln('TPasResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.TypeEl)));
  7132. writeln('TPasResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
  7133. {$ENDIF}
  7134. end
  7135. else if (RightTypeEl is TPasClassOfType)
  7136. and (rrfReadable in RightResolved.Flags) then
  7137. begin
  7138. // e.g. if Image is ImageClass then ;
  7139. if (CheckClassesAreRelated(LeftResolved.TypeEl,
  7140. TPasClassOfType(RightTypeEl).DestType,Bin)<>cIncompatible) then
  7141. begin
  7142. SetBaseType(btBoolean);
  7143. exit;
  7144. end;
  7145. end
  7146. else
  7147. RaiseXExpectedButYFound(20170216152625,'class type',RightResolved.TypeEl.ElementTypeName,Bin.right);
  7148. end
  7149. else if (proClassOfIs in Options) and (LeftTypeEl is TPasClassOfType)
  7150. and (rrfReadable in LeftResolved.Flags) then
  7151. begin
  7152. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  7153. RaiseMsg(20170322101128,nIllegalQualifier,sIllegalQualifier,['is'],Bin);
  7154. // left side is class-of variable
  7155. LeftTypeEl:=ResolveAliasType(TPasClassOfType(LeftResolved.TypeEl).DestType);
  7156. if (RightResolved.IdentEl is TPasType)
  7157. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  7158. begin
  7159. // e.g. if ImageClass is TFPMemoryImage then ;
  7160. // Note: at compile time the check is reversed: right must inherit from left
  7161. if CheckClassIsClass(RightResolved.TypeEl,LeftTypeEl,Bin)<>cIncompatible then
  7162. begin
  7163. SetBaseType(btBoolean);
  7164. exit;
  7165. end
  7166. end
  7167. else if (RightTypeEl is TPasClassOfType) then
  7168. begin
  7169. // e.g. if ImageClassA is ImageClassB then ;
  7170. // or if ImageClassA is TFPImageClass then ;
  7171. RightTypeEl:=ResolveAliasType(TPasClassOfType(RightTypeEl).DestType);
  7172. if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl,Bin)<>cIncompatible) then
  7173. begin
  7174. SetBaseType(btBoolean);
  7175. exit;
  7176. end
  7177. end
  7178. else
  7179. RaiseXExpectedButYFound(20170322105252,'class type',RightResolved.TypeEl.ElementTypeName,Bin.right);
  7180. end
  7181. else if LeftResolved.TypeEl=nil then
  7182. RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  7183. [BaseTypeNames[LeftResolved.BaseType]],Bin.left)
  7184. else
  7185. RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  7186. [LeftResolved.TypeEl.ElementTypeName],Bin.left);
  7187. {$IFDEF VerbosePasResolver}
  7188. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  7189. {$ENDIF}
  7190. RaiseMsg(20170216152236,nTypesAreNotRelated,sTypesAreNotRelated,[],Bin);
  7191. end;
  7192. eopAs:
  7193. begin
  7194. LeftTypeEl:=ResolveAliasType(LeftResolved.TypeEl);
  7195. if (LeftTypeEl is TPasClassType) then
  7196. begin
  7197. if (LeftResolved.IdentEl=nil)
  7198. or (LeftResolved.IdentEl is TPasType)
  7199. or (not (rrfReadable in LeftResolved.Flags)) then
  7200. RaiseMsg(20170216152237,nIllegalQualifier,sIllegalQualifier,['as'],Bin);
  7201. if RightResolved.IdentEl=nil then
  7202. RaiseXExpectedButYFound(20170216152630,'class',RightResolved.TypeEl.ElementTypeName,Bin.right);
  7203. if not (RightResolved.IdentEl is TPasType) then
  7204. RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
  7205. if (CheckSrcIsADstType(RightResolved,LeftResolved,Bin)<>cIncompatible) then
  7206. begin
  7207. SetResolverValueExpr(ResolvedEl,btContext,RightResolved.TypeEl,Bin,[rrfReadable]);
  7208. exit;
  7209. end;
  7210. RaiseMsg(20170216152239,nTypesAreNotRelated,sTypesAreNotRelated,[],Bin);
  7211. end;
  7212. end;
  7213. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  7214. begin
  7215. LeftTypeEl:=ResolveAliasType(LeftResolved.TypeEl);
  7216. RightTypeEl:=ResolveAliasType(RightResolved.TypeEl);
  7217. if (LeftTypeEl.ClassType=TPasEnumType)
  7218. and (rrfReadable in LeftResolved.Flags)
  7219. and (LeftTypeEl=RightTypeEl)
  7220. and (rrfReadable in RightResolved.Flags)
  7221. then
  7222. begin
  7223. SetBaseType(btBoolean);
  7224. exit;
  7225. end;
  7226. end;
  7227. eopSubIdent:
  7228. begin
  7229. ResolvedEl:=RightResolved;
  7230. exit;
  7231. end;
  7232. end
  7233. else if LeftResolved.BaseType=btSet then
  7234. begin
  7235. if (rrfReadable in LeftResolved.Flags)
  7236. and (RightResolved.BaseType=btSet)
  7237. and (rrfReadable in RightResolved.Flags) then
  7238. case Bin.OpCode of
  7239. eopAdd,
  7240. eopSubtract,
  7241. eopMultiply,
  7242. eopSymmetricaldifference,
  7243. eopLessthanEqual,
  7244. eopGreaterThanEqual:
  7245. begin
  7246. if RightResolved.TypeEl=nil then
  7247. begin
  7248. // right is empty set
  7249. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  7250. SetBaseType(btBoolean)
  7251. else
  7252. begin
  7253. ResolvedEl:=LeftResolved;
  7254. ResolvedEl.IdentEl:=nil;
  7255. ResolvedEl.ExprEl:=Bin;
  7256. end;
  7257. exit;
  7258. end
  7259. else if LeftResolved.TypeEl=nil then
  7260. begin
  7261. // left is empty set
  7262. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  7263. SetBaseType(btBoolean)
  7264. else
  7265. begin
  7266. ResolvedEl:=RightResolved;
  7267. ResolvedEl.IdentEl:=nil;
  7268. ResolvedEl.ExprEl:=Bin;
  7269. end;
  7270. exit;
  7271. end
  7272. else if (LeftResolved.SubType=RightResolved.SubType)
  7273. or ((LeftResolved.SubType in btAllBooleans)
  7274. and (RightResolved.SubType in btAllBooleans))
  7275. or ((LeftResolved.SubType in btAllInteger)
  7276. and (RightResolved.SubType in btAllInteger)) then
  7277. begin
  7278. // compatible set
  7279. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  7280. SetBaseType(btBoolean)
  7281. else
  7282. begin
  7283. ResolvedEl:=LeftResolved;
  7284. ResolvedEl.IdentEl:=nil;
  7285. ResolvedEl.ExprEl:=Bin;
  7286. end;
  7287. exit;
  7288. end;
  7289. {$IFDEF VerbosePasResolver}
  7290. writeln('TPasResolver.ComputeBinaryExprRes + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
  7291. +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
  7292. {$ENDIF}
  7293. end;
  7294. end;
  7295. end
  7296. else if LeftResolved.BaseType=btModule then
  7297. begin
  7298. if Bin.OpCode=eopSubIdent then
  7299. begin
  7300. ResolvedEl:=RightResolved;
  7301. exit;
  7302. end;
  7303. end;
  7304. {$IFDEF VerbosePasResolver}
  7305. writeln('TPasResolver.ComputeBinaryExprRes OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  7306. {$ENDIF}
  7307. RaiseMsg(20170216152241,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[Bin.OpCode]],Bin);
  7308. if Flags=[] then ;
  7309. end;
  7310. procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
  7311. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  7312. StartEl: TPasElement);
  7313. procedure ComputeIndexProperty(Prop: TPasProperty);
  7314. begin
  7315. if [rcConstant,rcType]*Flags<>[] then
  7316. RaiseConstantExprExp(20170216152635,Params);
  7317. ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
  7318. ResolvedEl.IdentEl:=Prop;
  7319. ResolvedEl.Flags:=[];
  7320. if GetPasPropertyGetter(Prop)<>nil then
  7321. Include(ResolvedEl.Flags,rrfReadable);
  7322. if GetPasPropertySetter(Prop)<>nil then
  7323. Include(ResolvedEl.Flags,rrfWritable);
  7324. end;
  7325. var
  7326. TypeEl: TPasType;
  7327. ClassScope: TPasClassScope;
  7328. ArrayEl: TPasArrayType;
  7329. ArgNo: Integer;
  7330. OrigResolved: TPasResolverResult;
  7331. SubParams: TParamsExpr;
  7332. begin
  7333. if Params.Value.CustomData is TResolvedReference then
  7334. begin
  7335. // e.g. Name[]
  7336. ComputeElement(Params.Value,ResolvedEl,
  7337. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  7338. end
  7339. else if Params.Value.ClassType=TParamsExpr then
  7340. begin
  7341. SubParams:=TParamsExpr(Params.Value);
  7342. if SubParams.Kind in [pekArrayParams,pekFuncParams] then
  7343. begin
  7344. // e.g. Name()[] or Name[][]
  7345. ComputeElement(SubParams,ResolvedEl,
  7346. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  7347. end
  7348. else
  7349. RaiseNotYetImplemented(20161010195646,SubParams);
  7350. end
  7351. else
  7352. RaiseNotYetImplemented(20160928174144,Params);
  7353. {$IFDEF VerbosePasResolver}
  7354. writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  7355. {$ENDIF}
  7356. if ResolvedEl.BaseType in btAllStrings then
  7357. begin
  7358. // stringvar[] => char
  7359. case GetActualBaseType(ResolvedEl.BaseType) of
  7360. btWideString,btUnicodeString:
  7361. if BaseTypeChar=btWideChar then
  7362. ResolvedEl.BaseType:=btChar
  7363. else
  7364. ResolvedEl.BaseType:=btWideChar;
  7365. btAnsiString,btRawByteString,btShortString:
  7366. if BaseTypeChar=btAnsiChar then
  7367. ResolvedEl.BaseType:=btChar
  7368. else
  7369. ResolvedEl.BaseType:=btAnsiChar;
  7370. else
  7371. RaiseNotYetImplemented(20170417202354,Params);
  7372. end;
  7373. // keep ResolvedEl.IdentEl the string var
  7374. ResolvedEl.TypeEl:=FBaseTypes[ResolvedEl.BaseType];
  7375. ResolvedEl.ExprEl:=Params;
  7376. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
  7377. end
  7378. else if (ResolvedEl.IdentEl is TPasProperty)
  7379. and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
  7380. // property with args
  7381. ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
  7382. else if ResolvedEl.BaseType=btContext then
  7383. begin
  7384. TypeEl:=ResolvedEl.TypeEl;
  7385. if TypeEl.ClassType=TPasClassType then
  7386. begin
  7387. ClassScope:=NoNil(TypeEl.CustomData) as TPasClassScope;
  7388. if ClassScope.DefaultProperty<>nil then
  7389. ComputeIndexProperty(ClassScope.DefaultProperty)
  7390. else
  7391. ComputeArrayParams_Class(Params,ResolvedEl,ClassScope,Flags,StartEl);
  7392. end
  7393. else if TypeEl.ClassType=TPasClassOfType then
  7394. begin
  7395. ClassScope:=ResolveAliasType(TPasClassOfType(TypeEl).DestType).CustomData as TPasClassScope;
  7396. if ClassScope.DefaultProperty<>nil then
  7397. ComputeIndexProperty(ClassScope.DefaultProperty)
  7398. else
  7399. RaiseInternalError(20161010174916);
  7400. end
  7401. else if TypeEl.ClassType=TPasArrayType then
  7402. begin
  7403. if not (rrfReadable in ResolvedEl.Flags) then
  7404. RaiseMsg(20170517001140,nIllegalQualifier,sIllegalQualifier,['['],Params);
  7405. ArrayEl:=TPasArrayType(TypeEl);
  7406. ArgNo:=0;
  7407. repeat
  7408. if length(ArrayEl.Ranges)=0 then
  7409. begin
  7410. inc(ArgNo); // dynamic/open array has one dimension
  7411. if IsDynArray(ArrayEl) then
  7412. Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
  7413. end
  7414. else
  7415. inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
  7416. if ArgNo>length(Params.Params) then
  7417. RaiseInternalError(20161010185535);
  7418. if ArgNo=length(Params.Params) then
  7419. break;
  7420. // continue in sub array
  7421. ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
  7422. until false;
  7423. OrigResolved:=ResolvedEl;
  7424. ComputeElement(ArrayEl.ElType,ResolvedEl,Flags,StartEl);
  7425. // identifier and value is the array itself
  7426. ResolvedEl.IdentEl:=OrigResolved.IdentEl;
  7427. ResolvedEl.ExprEl:=OrigResolved.ExprEl;
  7428. ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
  7429. if IsDynArray(ArrayEl) then
  7430. // dyn array elements are writable independent of the array
  7431. Include(ResolvedEl.Flags,rrfWritable);
  7432. end
  7433. else
  7434. RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
  7435. end
  7436. else
  7437. RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
  7438. end;
  7439. procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
  7440. var ResolvedEl: TPasResolverResult; ClassScope: TPasClassScope;
  7441. Flags: TPasResolverComputeFlags; StartEl: TPasElement);
  7442. begin
  7443. RaiseInternalError(20161010174916);
  7444. if Params=nil then ;
  7445. if ClassScope=nil then ;
  7446. if Flags=[] then ;
  7447. if StartEl=nil then ;
  7448. SetResolverIdentifier(ResolvedEl,btNone,nil,nil,[]);
  7449. end;
  7450. procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
  7451. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  7452. StartEl: TPasElement);
  7453. var
  7454. DeclEl: TPasElement;
  7455. BuiltInProc: TResElDataBuiltInProc;
  7456. Proc: TPasProcedure;
  7457. aClass: TPasClassType;
  7458. ResolvedTypeEl: TPasResolverResult;
  7459. Ref: TResolvedReference;
  7460. begin
  7461. if Params.Value.CustomData is TResolvedReference then
  7462. begin
  7463. Ref:=TResolvedReference(Params.Value.CustomData);
  7464. DeclEl:=Ref.Declaration;
  7465. if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  7466. begin
  7467. if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
  7468. begin
  7469. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  7470. if Assigned(BuiltInProc.GetCallResult) then
  7471. // built in function
  7472. BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
  7473. else
  7474. // built in procedure
  7475. SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,BuiltInProc.Proc,[]);
  7476. if bipfCanBeStatement in BuiltInProc.Flags then
  7477. Include(ResolvedEl.Flags,rrfCanBeStatement);
  7478. end
  7479. else if DeclEl.CustomData is TResElDataBaseType then
  7480. begin
  7481. // type cast to base type
  7482. if TResElDataBaseType(DeclEl.CustomData).BaseType=btCustom then
  7483. // custom base type
  7484. SetResolverValueExpr(ResolvedEl,
  7485. btCustom,
  7486. TPasUnresolvedSymbolRef(DeclEl),Params.Params[0],[rrfReadable])
  7487. else
  7488. SetResolverValueExpr(ResolvedEl,
  7489. TResElDataBaseType(DeclEl.CustomData).BaseType,
  7490. TPasUnresolvedSymbolRef(DeclEl),Params.Params[0],[rrfReadable]);
  7491. end
  7492. else
  7493. RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
  7494. end
  7495. else
  7496. begin
  7497. // normal identifier (not built-in)
  7498. ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  7499. if ResolvedEl.BaseType=btProc then
  7500. begin
  7501. if not (ResolvedEl.IdentEl is TPasProcedure) then
  7502. RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
  7503. Proc:=TPasProcedure(ResolvedEl.IdentEl);
  7504. if rcConstant in Flags then
  7505. RaiseConstantExprExp(20170216152637,Params);
  7506. if Proc is TPasFunction then
  7507. // function call => return result
  7508. ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,
  7509. Flags+[rcNoImplicitProc],StartEl)
  7510. else if (Proc.ClassType=TPasConstructor)
  7511. and (rrfNewInstance in Ref.Flags) then
  7512. begin
  7513. // new instance call -> return value of type class
  7514. aClass:=GetReference_NewInstanceClass(Ref);
  7515. SetResolverValueExpr(ResolvedEl,btContext,aClass,Params.Value,[rrfReadable]);
  7516. end
  7517. else
  7518. // procedure call, result is neither readable nor writable
  7519. SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,[]);
  7520. Include(ResolvedEl.Flags,rrfCanBeStatement);
  7521. end
  7522. else if ResolvedEl.TypeEl is TPasProcedureType then
  7523. begin
  7524. if Params.Value is TParamsExpr then
  7525. begin
  7526. // e.g. Name()() or Name[]()
  7527. Include(ResolvedEl.Flags,rrfReadable);
  7528. end;
  7529. if rrfReadable in ResolvedEl.Flags then
  7530. begin
  7531. // call procvar
  7532. if rcConstant in Flags then
  7533. RaiseConstantExprExp(20170216152639,Params);
  7534. if ResolvedEl.TypeEl is TPasFunctionType then
  7535. // function call => return result
  7536. ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
  7537. ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  7538. else
  7539. // procedure call, result is neither readable nor writable
  7540. SetResolverTypeExpr(ResolvedEl,btProc,TPasProcedureType(ResolvedEl.TypeEl),[]);
  7541. Include(ResolvedEl.Flags,rrfCanBeStatement);
  7542. end
  7543. else
  7544. begin
  7545. // typecast proctype
  7546. if length(Params.Params)<>1 then
  7547. begin
  7548. {$IFDEF VerbosePasResolver}
  7549. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
  7550. {$ENDIF}
  7551. RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
  7552. sWrongNumberOfParametersForTypeCast,[ResolvedEl.TypeEl.Name],Params);
  7553. end;
  7554. SetResolverValueExpr(ResolvedEl,btContext,TPasProcedureType(ResolvedEl.TypeEl),
  7555. Params.Params[0],[rrfReadable]);
  7556. end;
  7557. end
  7558. else if (DeclEl is TPasType) then
  7559. begin
  7560. // type cast
  7561. ResolvedTypeEl:=ResolvedEl;
  7562. ComputeElement(Params.Params[0],ResolvedEl,Flags,StartEl);
  7563. ResolvedEl.BaseType:=ResolvedTypeEl.BaseType;
  7564. ResolvedEl.TypeEl:=ResolvedTypeEl.TypeEl;
  7565. end
  7566. else
  7567. RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
  7568. end;
  7569. end
  7570. else
  7571. RaiseNotYetImplemented(20160928174124,Params);
  7572. end;
  7573. procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
  7574. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  7575. StartEl: TPasElement);
  7576. // [param,param,...]
  7577. var
  7578. ParamResolved, FirstResolved: TPasResolverResult;
  7579. i: Integer;
  7580. Param: TPasExpr;
  7581. IsRange: Boolean;
  7582. begin
  7583. if length(Params.Params)=0 then
  7584. SetResolverValueExpr(ResolvedEl,btSet,nil,Params,[rrfReadable])
  7585. else
  7586. begin
  7587. FirstResolved:=Default(TPasResolverResult);
  7588. Flags:=Flags-[rcNoImplicitProc,rcNoImplicitProcType];
  7589. for i:=0 to length(Params.Params)-1 do
  7590. begin
  7591. Param:=Params.Params[i];
  7592. ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
  7593. if ParamResolved.BaseType=btSet then
  7594. RaiseNotYetImplemented(20170420134325,Param,'nested array literals');
  7595. IsRange:=ParamResolved.BaseType=btRange;
  7596. if IsRange then
  7597. ConvertRangeToElement(ParamResolved);
  7598. if FirstResolved.BaseType=btNone then
  7599. begin
  7600. // first value -> check type usable in a set
  7601. FirstResolved:=ParamResolved;
  7602. if IsRange then
  7603. CheckIsOrdinal(FirstResolved,Param,true);
  7604. if rrfReadable in FirstResolved.Flags then
  7605. begin
  7606. // has a value
  7607. end
  7608. else
  7609. begin
  7610. if (FirstResolved.BaseType=btContext) then
  7611. begin
  7612. if FirstResolved.IdentEl is TPasClassType then
  7613. // array of classtypes
  7614. else
  7615. begin
  7616. {$IFDEF VerbosePasResolver}
  7617. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  7618. {$ENDIF}
  7619. RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
  7620. end;
  7621. end
  7622. else
  7623. begin
  7624. {$IFDEF VerbosePasResolver}
  7625. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  7626. {$ENDIF}
  7627. RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
  7628. end;
  7629. end;
  7630. end
  7631. else
  7632. begin
  7633. // next value
  7634. CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
  7635. end;
  7636. end;
  7637. FirstResolved.IdentEl:=nil;
  7638. FirstResolved.ExprEl:=Params;
  7639. FirstResolved.SubType:=FirstResolved.BaseType;
  7640. FirstResolved.BaseType:=btSet;
  7641. FirstResolved.Flags:=[rrfReadable];
  7642. ResolvedEl:=FirstResolved;
  7643. end;
  7644. end;
  7645. procedure TPasResolver.CheckIsClass(El: TPasElement;
  7646. const ResolvedEl: TPasResolverResult);
  7647. begin
  7648. if (ResolvedEl.BaseType<>btContext) then
  7649. RaiseMsg(20170216152245,nXExpectedButYFound,sXExpectedButYFound,
  7650. ['class',BaseTypeNames[ResolvedEl.BaseType]],El);
  7651. if (ResolvedEl.TypeEl.ClassType<>TPasClassType) then
  7652. RaiseMsg(20170216152246,nXExpectedButYFound,sXExpectedButYFound,
  7653. ['class',ResolvedEl.TypeEl.ElementTypeName],El);
  7654. end;
  7655. function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  7656. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  7657. // called when type casting a class instance into an unrelated class
  7658. begin
  7659. if FromClassRes.BaseType=btNone then ;
  7660. if ToClassRes.BaseType=btNone then ;
  7661. if ErrorEl=nil then ;
  7662. Result:=cIncompatible;
  7663. end;
  7664. procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
  7665. const LHS, RHS: TPasResolverResult);
  7666. var
  7667. LBT, RBT: TResolverBaseType;
  7668. begin
  7669. // check both are values
  7670. if not (rrfReadable in LHS.Flags) then
  7671. begin
  7672. if LHS.TypeEl<>nil then
  7673. RaiseXExpectedButYFound(20170216152645,'ordinal',LHS.TypeEl.ElementTypeName,Left)
  7674. else
  7675. RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  7676. end;
  7677. if not (rrfReadable in RHS.Flags) then
  7678. begin
  7679. if RHS.TypeEl<>nil then
  7680. RaiseXExpectedButYFound(20170216152651,'ordinal',RHS.TypeEl.ElementTypeName,Right)
  7681. else
  7682. RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
  7683. end;
  7684. // check both have the same ordinal type
  7685. LBT:=GetActualBaseType(LHS.BaseType);
  7686. RBT:=GetActualBaseType(RHS.BaseType);
  7687. if LBT in btAllBooleans then
  7688. begin
  7689. if RBT in btAllBooleans then
  7690. exit;
  7691. RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
  7692. end
  7693. else if LBT in btAllInteger then
  7694. begin
  7695. if RBT in btAllInteger then
  7696. exit;
  7697. RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
  7698. end
  7699. else if LBT in btAllChars then
  7700. begin
  7701. if RBT in btAllChars then
  7702. exit;
  7703. RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
  7704. end
  7705. else if LBT=btContext then
  7706. begin
  7707. if LHS.TypeEl.ClassType=TPasEnumType then
  7708. begin
  7709. if LHS.TypeEl=RHS.TypeEl then
  7710. exit;
  7711. if RHS.TypeEl.ClassType<>TPasEnumType then
  7712. RaiseXExpectedButYFound(20170216152707,LHS.TypeEl.Parent.Name,RHS.TypeEl.ElementTypeName,Right);
  7713. if LHS.TypeEl.Parent<>RHS.TypeEl.Parent then
  7714. RaiseXExpectedButYFound(20170216152710,LHS.TypeEl.Parent.Name,RHS.TypeEl.Parent.Name,Right);
  7715. end
  7716. else
  7717. RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  7718. end
  7719. else
  7720. RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  7721. end;
  7722. function TPasResolver.CheckIsOrdinal(
  7723. const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
  7724. RaiseOnError: boolean): boolean;
  7725. begin
  7726. Result:=false;
  7727. if ResolvedEl.BaseType in btAllRanges then
  7728. else if (ResolvedEl.BaseType=btContext) then
  7729. begin
  7730. if ResolvedEl.TypeEl.ClassType=TPasEnumType then
  7731. else if RaiseOnError then
  7732. RaiseXExpectedButYFound(20170216152718,'ordinal value',ResolvedEl.TypeEl.ElementTypeName,ErrorEl)
  7733. else
  7734. exit;
  7735. end
  7736. else if RaiseOnError then
  7737. RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
  7738. else
  7739. exit;
  7740. Result:=true;
  7741. end;
  7742. procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
  7743. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  7744. // LHS defines the array element type
  7745. // check if RHS
  7746. var
  7747. LBT, RBT: TResolverBaseType;
  7748. C: TClass;
  7749. begin
  7750. if LHS.TypeEl=nil then
  7751. RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
  7752. if RHS.TypeEl=nil then
  7753. RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
  7754. if LHS.TypeEl=RHS.TypeEl then
  7755. exit; // exact same type
  7756. LBT:=GetActualBaseType(LHS.BaseType);
  7757. RBT:=GetActualBaseType(RHS.BaseType);
  7758. if rrfReadable in LHS.Flags then
  7759. begin
  7760. if not (rrfReadable in RHS.Flags) then
  7761. RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
  7762. [],RHS,LHS,Right);
  7763. // array of values
  7764. if LBT in btAllBooleans then
  7765. begin
  7766. if RBT in btAllBooleans then
  7767. begin
  7768. LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
  7769. exit;
  7770. end;
  7771. RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
  7772. end
  7773. else if LBT in btAllInteger then
  7774. begin
  7775. if RBT in btAllInteger then
  7776. begin
  7777. LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
  7778. exit;
  7779. end;
  7780. RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
  7781. end
  7782. else if LBT in btAllChars then
  7783. begin
  7784. if RBT in btAllChars then
  7785. begin
  7786. LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
  7787. exit;
  7788. end;
  7789. RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
  7790. end
  7791. else if LBT in btAllStrings then
  7792. begin
  7793. if RBT in btAllStringAndChars then
  7794. begin
  7795. LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
  7796. exit;
  7797. end;
  7798. RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
  7799. end
  7800. else if LBT=btNil then
  7801. begin
  7802. if RBT=btNil then
  7803. exit
  7804. else if RBT=btPointer then
  7805. begin
  7806. LHS:=RHS;
  7807. exit;
  7808. end
  7809. else if RBT=btContext then
  7810. begin
  7811. C:=ResolveAliasType(RHS.TypeEl).ClassType;
  7812. if (C=TPasClassType)
  7813. or (C=TPasClassOfType)
  7814. or (C=TPasPointerType)
  7815. or ((C=TPasArrayType) and IsDynArray(RHS.TypeEl))
  7816. or (C=TPasProcedureType)
  7817. or (C=TPasFunctionType) then
  7818. begin
  7819. LHS:=RHS;
  7820. exit;
  7821. end;
  7822. end;
  7823. end
  7824. else if LBT=btContext then
  7825. begin
  7826. C:=LHS.TypeEl.ClassType;
  7827. if C=TPasEnumType then
  7828. begin
  7829. if LHS.TypeEl=RHS.TypeEl then
  7830. exit;
  7831. end
  7832. else if C=TPasClassType then
  7833. begin
  7834. // array of class instances
  7835. if RHS.TypeEl.ClassType<>TPasClassType then
  7836. RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
  7837. [],RHS,LHS,Right);
  7838. if CheckClassIsClass(LHS.TypeEl,RHS.TypeEl,Right)<cIncompatible then
  7839. begin
  7840. // right class type is a left class type -> ok
  7841. exit;
  7842. end
  7843. else if CheckClassIsClass(RHS.TypeEl,LHS.TypeEl,Right)<cIncompatible then
  7844. begin
  7845. // left class type is a right class type -> right is the new base class type
  7846. LHS:=RHS;
  7847. exit;
  7848. end;
  7849. end;
  7850. end;
  7851. end
  7852. else
  7853. begin
  7854. // array of types
  7855. if rrfReadable in RHS.Flags then
  7856. RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
  7857. [],RHS,LHS,Right);
  7858. if LBT=btContext then
  7859. begin
  7860. if LHS.TypeEl.ClassType=TPasClassType then
  7861. begin
  7862. // array of class type
  7863. if RHS.TypeEl.ClassType<>TPasClassType then
  7864. RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
  7865. [],RHS,LHS,Right);
  7866. if CheckClassIsClass(LHS.TypeEl,RHS.TypeEl,Right)<cIncompatible then
  7867. begin
  7868. // right class type is a left class type -> ok
  7869. exit;
  7870. end
  7871. else if CheckClassIsClass(RHS.TypeEl,LHS.TypeEl,Right)<cIncompatible then
  7872. begin
  7873. // left class type is a right class type -> right is the new base class type
  7874. LHS:=RHS;
  7875. exit;
  7876. end;
  7877. end;
  7878. end;
  7879. end;
  7880. RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
  7881. [],RHS,LHS,Right);
  7882. end;
  7883. procedure TPasResolver.ConvertRangeToElement(
  7884. var ResolvedEl: TPasResolverResult);
  7885. var
  7886. TypeEl: TPasType;
  7887. begin
  7888. if ResolvedEl.BaseType<>btRange then
  7889. RaiseInternalError(20161001155732);
  7890. if ResolvedEl.TypeEl=nil then
  7891. if ResolvedEl.IdentEl<>nil then
  7892. RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
  7893. else
  7894. RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
  7895. TypeEl:=ResolveAliasType(ResolvedEl.TypeEl);
  7896. if TypeEl is TPasRangeType then
  7897. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant])
  7898. else
  7899. begin
  7900. ResolvedEl.BaseType:=ResolvedEl.SubType;
  7901. ResolvedEl.SubType:=btNone;
  7902. end;
  7903. end;
  7904. function TPasResolver.IsCharLiteral(const Value: string; ErrorPos: TPasElement
  7905. ): TResolverBaseType;
  7906. // returns true if Value is a Pascal char literal
  7907. // btAnsiChar: #65, #$50, ^G, 'a'
  7908. // btWideChar: #10000, 'ä'
  7909. var
  7910. p: PChar;
  7911. i: SizeInt;
  7912. base: Integer;
  7913. begin
  7914. Result:=btNone;
  7915. //writeln('TPasResolver.IsCharLiteral ',BaseTypeChar,' "',Value,'" l=',length(Value));
  7916. p:=PChar(Value);
  7917. case p^ of
  7918. '''':
  7919. begin
  7920. inc(p);
  7921. case p^ of
  7922. '''':
  7923. if (p[1]='''') and (p[2]='''') and (p[3]=#0) then
  7924. Result:=btAnsiChar;
  7925. #32..#38,#40..#191:
  7926. if (p[1]='''') and (p[2]=#0) then
  7927. Result:=btAnsiChar;
  7928. #192..#255:
  7929. if BaseTypeChar=btWideChar then
  7930. begin
  7931. // default char is widechar: UTF-8 'ä' is a widechar
  7932. i:=Utf8CodePointLen(p,4,false);
  7933. //writeln('TPasResolver.IsCharLiteral "',Value,'" ',length(Value),' i=',i);
  7934. if i<2 then
  7935. exit;
  7936. inc(p,i);
  7937. if (p^='''') and (p[1]=#0) then
  7938. // single UTF-8 codepoint
  7939. Result:=btWideChar;
  7940. end;
  7941. end;
  7942. end;
  7943. '#':
  7944. begin
  7945. inc(p);
  7946. case p^ of
  7947. '$': begin base:=16; inc(p); end;
  7948. '&': begin base:=8; inc(p); end;
  7949. '%': begin base:=2; inc(p); end;
  7950. '0'..'9': base:=10;
  7951. else RaiseNotYetImplemented(20170728142709,ErrorPos);
  7952. end;
  7953. i:=0;
  7954. repeat
  7955. case p^ of
  7956. '0'..'9': i:=i*base+ord(p^)-ord('0');
  7957. 'A'..'Z': i:=i*base+ord(p^)-ord('A')+10;
  7958. 'a'..'z': i:=i*base+ord(p^)-ord('a')+10;
  7959. else
  7960. break;
  7961. end;
  7962. inc(p);
  7963. until false;
  7964. if p^=#0 then
  7965. if i<256 then
  7966. Result:=btAnsiChar
  7967. else
  7968. Result:=btWideChar;
  7969. end;
  7970. '^':
  7971. begin
  7972. inc(p);
  7973. if (p^ in ['a'..'z','A'..'Z']) and (p[1]=#0) then
  7974. Result:=btAnsiChar;
  7975. end;
  7976. end;
  7977. if Result in [btAnsiChar,btWideChar] then
  7978. begin
  7979. if FBaseTypes[Result]=nil then
  7980. begin
  7981. if Result=btAnsiChar then
  7982. Result:=btWideChar
  7983. else
  7984. Result:=btChar;
  7985. end;
  7986. if Result=BaseTypeChar then
  7987. Result:=btChar;
  7988. end;
  7989. end;
  7990. function TPasResolver.CheckForInClass(Loop: TPasImplForLoop; const VarResolved,
  7991. InResolved: TPasResolverResult): boolean;
  7992. var
  7993. TypeEl: TPasType;
  7994. aClass: TPasClassType;
  7995. ClassScope: TPasDotClassScope;
  7996. Getter, MoveNext, Current: TPasIdentifier;
  7997. GetterFunc, MoveNextFunc: TPasFunction;
  7998. ptm: TProcTypeModifier;
  7999. ResultResolved, MoveNextResolved, CurrentResolved: TPasResolverResult;
  8000. CurrentProp: TPasProperty;
  8001. ForScope: TPasForLoopScope;
  8002. begin
  8003. Result:=false;
  8004. TypeEl:=ResolveAliasType(InResolved.TypeEl);
  8005. if TypeEl is TPasClassType then
  8006. begin
  8007. if not (rrfReadable in InResolved.Flags) then
  8008. RaiseMsg(20171221195421,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  8009. [GetBaseDescription(InResolved)],Loop.StartExpr);
  8010. // check function GetEnumerator: class
  8011. aClass:=TPasClassType(TypeEl);
  8012. // find aClass.GetEnumerator
  8013. ClassScope:=PushClassDotScope(aClass);
  8014. Getter:=ClassScope.FindIdentifier('GetEnumerator');
  8015. PopScope;
  8016. if Getter=nil then
  8017. RaiseIdentifierNotFound(20171221191511,'GetEnumerator',Loop.StartExpr);
  8018. // check is function
  8019. if Getter.Element.ClassType<>TPasFunction then
  8020. RaiseContextXExpectedButYFound(20171221191638,'GetEnumerator','function',Getter.Element.ElementTypeName,Loop.StartExpr);
  8021. GetterFunc:=TPasFunction(Getter.Element);
  8022. // check visibility
  8023. if not (GetterFunc.Visibility in [visPublic,visPublished]) then
  8024. RaiseContextXExpectedButYFound(20171221191824,'function GetEnumerator','public',VisibilityNames[GetterFunc.Visibility],Loop.StartExpr);
  8025. // check arguments
  8026. if GetterFunc.FuncType.Args.Count>0 then
  8027. RaiseContextXExpectedButYFound(20171221191944,'function GetEnumerator','no arguments',IntToStr(GetterFunc.ProcType.Args.Count),Loop.StartExpr);
  8028. // check proc type modifiers
  8029. for ptm in GetterFunc.ProcType.Modifiers do
  8030. if not (ptm in [ptmOfObject]) then
  8031. RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  8032. // check result type
  8033. ComputeElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcType]);
  8034. if (ResultResolved.BaseType<>btContext) then
  8035. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
  8036. TypeEl:=ResolveAliasType(ResultResolved.TypeEl);
  8037. if not (TypeEl is TPasClassType) then
  8038. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved.TypeEl),Loop.StartExpr);
  8039. if not (rrfReadable in ResultResolved.Flags) then
  8040. RaiseContextXExpectedButYFound(20171221195506,'function GetEnumerator','result class instance',GetTypeDescription(ResultResolved.TypeEl),Loop.StartExpr);
  8041. // check function MoveNext: boolean
  8042. aClass:=TPasClassType(TypeEl);
  8043. ClassScope:=PushClassDotScope(aClass);
  8044. MoveNext:=ClassScope.FindIdentifier('MoveNext');
  8045. if MoveNext=nil then
  8046. RaiseIdentifierNotFound(20171221195632,'MoveNext',Loop.StartExpr);
  8047. // check is function
  8048. if MoveNext.Element.ClassType<>TPasFunction then
  8049. RaiseContextXExpectedButYFound(20171221195651,'MoveNext','function',MoveNext.Element.ElementTypeName,Loop.StartExpr);
  8050. MoveNextFunc:=TPasFunction(MoveNext.Element);
  8051. // check visibility
  8052. if not (MoveNextFunc.Visibility in [visPublic,visPublished]) then
  8053. RaiseContextXExpectedButYFound(20171221195712,'function MoveNext','public',VisibilityNames[MoveNextFunc.Visibility],Loop.StartExpr);
  8054. // check arguments
  8055. if MoveNextFunc.FuncType.Args.Count>0 then
  8056. RaiseContextXExpectedButYFound(20171221195723,'function MoveNext','no arguments',IntToStr(MoveNextFunc.ProcType.Args.Count),Loop.StartExpr);
  8057. // check proc type modifiers
  8058. for ptm in MoveNextFunc.ProcType.Modifiers do
  8059. if not (ptm in [ptmOfObject]) then
  8060. RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  8061. // check result type
  8062. ComputeElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcType]);
  8063. if not (MoveNextResolved.BaseType in btAllBooleans) then
  8064. RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
  8065. // check property Current
  8066. Current:=ClassScope.FindIdentifier('Current');
  8067. if Current=nil then
  8068. RaiseIdentifierNotFound(20171221200433,'Current',Loop.StartExpr);
  8069. // check is property
  8070. if Current.Element.ClassType<>TPasProperty then
  8071. RaiseContextXExpectedButYFound(20171221200508,'Current','property',Current.Element.ElementTypeName,Loop.StartExpr);
  8072. CurrentProp:=TPasProperty(Current.Element);
  8073. // check visibility
  8074. if not (CurrentProp.Visibility in [visPublic,visPublished]) then
  8075. RaiseContextXExpectedButYFound(20171221200546,'property Current','public',VisibilityNames[CurrentProp.Visibility],Loop.StartExpr);
  8076. // check arguments
  8077. if CurrentProp.Args.Count>0 then
  8078. RaiseContextXExpectedButYFound(20171221200638,'property Current','no arguments',IntToStr(CurrentProp.Args.Count),Loop.StartExpr);
  8079. // check readable
  8080. if GetPasPropertyGetter(CurrentProp)=nil then
  8081. RaiseContextXInvalidY(20171221200823,'property Current','read accessor',Loop.StartExpr);
  8082. // check result type fits for-loop variable
  8083. ComputeElement(CurrentProp,CurrentResolved,[rcType]);
  8084. if CheckAssignResCompatibility(VarResolved,CurrentResolved,Loop.VariableName,false)=cIncompatible then
  8085. RaiseIncompatibleTypeRes(20171221200018,nIncompatibleTypesGotExpected,[],VarResolved,CurrentResolved,Loop.VariableName);
  8086. PopScope;
  8087. ForScope:=Loop.CustomData as TPasForLoopScope;
  8088. ForScope.GetEnumerator:=GetterFunc;
  8089. ForScope.MoveNext:=MoveNextFunc;
  8090. ForScope.Current:=CurrentProp;
  8091. exit(true);
  8092. end;
  8093. RaiseMsg(20171221192929,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  8094. [GetBaseDescription(InResolved)],Loop.StartExpr);
  8095. end;
  8096. function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
  8097. Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
  8098. begin
  8099. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
  8100. begin
  8101. if RaiseOnError then
  8102. RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
  8103. sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
  8104. exit(false);
  8105. end;
  8106. Result:=true;
  8107. end;
  8108. function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
  8109. Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean): integer;
  8110. begin
  8111. if length(Params.Params)>MaxCount then
  8112. begin
  8113. if RaiseOnError then
  8114. RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
  8115. sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[MaxCount]);
  8116. exit(cIncompatible);
  8117. end;
  8118. Result:=cExact;
  8119. end;
  8120. function TPasResolver.CheckRaiseTypeArgNo(id: int64; ArgNo: integer;
  8121. Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
  8122. RaiseOnError: boolean): integer;
  8123. begin
  8124. if RaiseOnError then
  8125. RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  8126. [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
  8127. Result:=cIncompatible;
  8128. end;
  8129. function TPasResolver.FindUsedUnitInSection(const aName: string; Section: TPasSection): TPasModule;
  8130. var
  8131. Clause: TPasUsesClause;
  8132. i: Integer;
  8133. Use: TPasUsesUnit;
  8134. ModName: String;
  8135. begin
  8136. Result:=nil;
  8137. if (Section=nil) then exit;
  8138. Clause:=Section.UsesClause;
  8139. for i:=0 to length(Clause)-1 do
  8140. begin
  8141. Use:=Clause[i];
  8142. if (Use.Module=nil) or not (Use.Module is TPasModule) then continue;
  8143. ModName:=Use.Module.Name;
  8144. if CompareText(ModName,aName)=0 then
  8145. exit(TPasModule(Use.Module));
  8146. end;
  8147. end;
  8148. function TPasResolver.FindUsedUnit(const aName: string; aMod: TPasModule): TPasModule;
  8149. var
  8150. C: TClass;
  8151. begin
  8152. C:=aMod.ClassType;
  8153. if C.InheritsFrom(TPasProgram) then
  8154. Result:=FindUsedUnitInSection(aName,TPasProgram(aMod).ProgramSection)
  8155. else if C.InheritsFrom(TPasLibrary) then
  8156. Result:=FindUsedUnitInSection(aName,TPasLibrary(aMod).LibrarySection)
  8157. else
  8158. begin
  8159. Result:=FindUsedUnitInSection(aName,aMod.InterfaceSection);
  8160. if Result<>nil then exit;
  8161. Result:=FindUsedUnitInSection(aName,aMod.ImplementationSection);
  8162. end
  8163. end;
  8164. procedure TPasResolver.FinishAssertCall(Proc: TResElDataBuiltInProc;
  8165. Params: TParamsExpr);
  8166. var
  8167. aMod: TPasModule;
  8168. ModScope: TPasModuleScope;
  8169. aConstructor: TPasConstructor;
  8170. begin
  8171. if Proc=nil then ;
  8172. aMod:=RootElement;
  8173. ModScope:=aMod.CustomData as TPasModuleScope;
  8174. if not (pmsfAssertSearched in ModScope.Flags) then
  8175. FindAssertExceptionConstructors(Params);
  8176. if ModScope.AssertClass=nil then exit;
  8177. if length(Params.Params)>1 then
  8178. aConstructor:=ModScope.AssertMsgConstructor
  8179. else
  8180. aConstructor:=ModScope.AssertDefConstructor;
  8181. if aConstructor=nil then exit;
  8182. CreateReference(aConstructor,Params,rraRead);
  8183. end;
  8184. function TPasResolver.FindExceptionConstructor(const aUnitName,
  8185. aClassName: string; out aClass: TPasClassType; out
  8186. aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
  8187. var
  8188. aMod, UtilsMod: TPasModule;
  8189. SectionScope: TPasSectionScope;
  8190. Identifier: TPasIdentifier;
  8191. El: TPasElement;
  8192. ClassScope: TPasClassScope;
  8193. begin
  8194. Result:=false;
  8195. aClass:=nil;
  8196. aConstructor:=nil;
  8197. // find unit in uses clauses
  8198. aMod:=RootElement;
  8199. UtilsMod:=FindUsedUnit(aUnitName,aMod);
  8200. if UtilsMod=nil then exit;
  8201. // find class in interface
  8202. if UtilsMod.InterfaceSection=nil then exit;
  8203. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  8204. Identifier:=SectionScope.FindLocalIdentifier(aClassName);
  8205. if Identifier=nil then exit;
  8206. El:=Identifier.Element;
  8207. if not (El is TPasClassType) then
  8208. RaiseXExpectedButYFound(20180119172517,'class '+aClassName,El.ElementTypeName,ErrorEl);
  8209. aClass:=TPasClassType(El);
  8210. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  8211. repeat
  8212. Identifier:=ClassScope.FindIdentifier('create');
  8213. while Identifier<>nil do
  8214. begin
  8215. if Identifier.Element.ClassType=TPasConstructor then
  8216. begin
  8217. aConstructor:=TPasConstructor(Identifier.Element);
  8218. if aConstructor.ProcType.Args.Count=0 then
  8219. exit(true);
  8220. end;
  8221. Identifier:=Identifier.NextSameIdentifier;
  8222. end;
  8223. ClassScope:=ClassScope.AncestorScope;
  8224. until ClassScope=nil;
  8225. aConstructor:=nil;
  8226. end;
  8227. procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
  8228. var
  8229. aMod: TPasModule;
  8230. ModScope: TPasModuleScope;
  8231. Identifier: TPasIdentifier;
  8232. aClass: TPasClassType;
  8233. ClassScope: TPasClassScope;
  8234. aConstructor: TPasConstructor;
  8235. Arg: TPasArgument;
  8236. ArgResolved: TPasResolverResult;
  8237. begin
  8238. aMod:=RootElement;
  8239. ModScope:=aMod.CustomData as TPasModuleScope;
  8240. if pmsfAssertSearched in ModScope.Flags then exit;
  8241. Include(ModScope.Flags,pmsfAssertSearched);
  8242. FindExceptionConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
  8243. if aClass=nil then exit;
  8244. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  8245. ModScope.AssertClass:=aClass;
  8246. repeat
  8247. Identifier:=ClassScope.FindIdentifier('create');
  8248. while Identifier<>nil do
  8249. begin
  8250. if Identifier.Element.ClassType=TPasConstructor then
  8251. begin
  8252. aConstructor:=TPasConstructor(Identifier.Element);
  8253. //writeln('TPasResolver.FindAssertExceptionConstructors ',aConstructor.Name,' ',aConstructor.ProcType.Args.Count);
  8254. if aConstructor.ProcType.Args.Count=0 then
  8255. begin
  8256. if ModScope.AssertDefConstructor=nil then
  8257. ModScope.AssertDefConstructor:=aConstructor;
  8258. end
  8259. else if aConstructor.ProcType.Args.Count=1 then
  8260. begin
  8261. if ModScope.AssertMsgConstructor=nil then
  8262. begin
  8263. Arg:=TPasArgument(aConstructor.ProcType.Args[0]);
  8264. //writeln('TPasResolver.FindAssertExceptionConstructors ',GetObjName(Arg.ArgType),' ',GetObjName(BaseTypes[BaseTypeString]));
  8265. ComputeElement(Arg.ArgType,ArgResolved,[rcType]);
  8266. if ArgResolved.BaseType in btAllStrings then
  8267. ModScope.AssertMsgConstructor:=aConstructor;
  8268. end;
  8269. end;
  8270. end;
  8271. Identifier:=Identifier.NextSameIdentifier;
  8272. end;
  8273. ClassScope:=ClassScope.AncestorScope;
  8274. until ClassScope=nil;
  8275. end;
  8276. procedure TPasResolver.FindRangeErrorConstructors(ErrorEl: TPasElement);
  8277. var
  8278. aMod: TPasModule;
  8279. ModScope: TPasModuleScope;
  8280. aClass: TPasClassType;
  8281. aConstructor: TPasConstructor;
  8282. begin
  8283. aMod:=RootElement;
  8284. ModScope:=aMod.CustomData as TPasModuleScope;
  8285. if pmsfRangeErrorSearched in ModScope.Flags then exit;
  8286. Include(ModScope.Flags,pmsfRangeErrorSearched);
  8287. FindExceptionConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
  8288. ModScope.RangeErrorClass:=aClass;
  8289. ModScope.RangeErrorConstructor:=aConstructor;
  8290. end;
  8291. procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
  8292. const id: int64; MsgType: TMessageType; MsgNumber: integer;
  8293. const Fmt: String; Args: array of const; PosEl: TPasElement);
  8294. begin
  8295. if MsgType<=mtError then
  8296. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
  8297. else
  8298. LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  8299. if Sender=nil then ;
  8300. end;
  8301. function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
  8302. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
  8303. var
  8304. Ref: TResolvedReference;
  8305. Decl: TPasElement;
  8306. C: TClass;
  8307. ResolvedType: TPasResolverResult;
  8308. EnumValue: TPasEnumValue;
  8309. EnumType: TPasEnumType;
  8310. begin
  8311. Result:=nil;
  8312. if not (Expr.CustomData is TResolvedReference) then
  8313. RaiseNotYetImplemented(20170518203134,Expr);
  8314. Ref:=TResolvedReference(Expr.CustomData);
  8315. Decl:=Ref.Declaration;
  8316. {$IFDEF VerbosePasResEval}
  8317. writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
  8318. {$ENDIF}
  8319. C:=Decl.ClassType;
  8320. if C=TPasConst then
  8321. begin
  8322. if (TPasConst(Decl).Expr<>nil)
  8323. and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
  8324. begin
  8325. if TPasConst(Decl).VarType<>nil then
  8326. begin
  8327. // typed const
  8328. ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
  8329. end
  8330. else
  8331. ResolvedType.BaseType:=btNone;
  8332. Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,Flags+[refConst]);
  8333. if Result<>nil then
  8334. begin
  8335. if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
  8336. Result:=Result.Clone;
  8337. Result.IdentEl:=Decl;
  8338. if TPasConst(Decl).VarType<>nil then
  8339. begin
  8340. // typed const
  8341. if Result.Kind=revkInt then
  8342. case ResolvedType.BaseType of
  8343. btByte: TResEvalInt(Result).Typed:=reitByte;
  8344. btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
  8345. btWord: TResEvalInt(Result).Typed:=reitWord;
  8346. btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
  8347. btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
  8348. btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
  8349. btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
  8350. btLongint: TResEvalInt(Result).Typed:=reitLongInt;
  8351. btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
  8352. btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
  8353. btInt64: TResEvalInt(Result).Typed:=reitNone; // default
  8354. else
  8355. ReleaseEvalValue(Result);
  8356. RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
  8357. end;
  8358. end;
  8359. exit;
  8360. end;
  8361. end;
  8362. if refConst in Flags then
  8363. RaiseConstantExprExp(20170518214928,Expr);
  8364. end
  8365. else if C=TPasEnumValue then
  8366. begin
  8367. EnumValue:=TPasEnumValue(Decl);
  8368. EnumType:=EnumValue.Parent as TPasEnumType;
  8369. Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
  8370. exit;
  8371. end
  8372. else if C.InheritsFrom(TPasType) then
  8373. Result:=EvalTypeRange(TPasType(Decl),Flags);
  8374. {$IFDEF VerbosePasResEval}
  8375. writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags);
  8376. {$ENDIF}
  8377. if (Result=nil) and (refConst in Flags) then
  8378. RaiseConstantExprExp(20170518213616,Expr);
  8379. end;
  8380. function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
  8381. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  8382. var
  8383. Ref: TResolvedReference;
  8384. Decl: TPasElement;
  8385. C: TClass;
  8386. BuiltInProc: TResElDataBuiltInProc;
  8387. bt: TResolverBaseType;
  8388. ResolvedEl: TPasResolverResult;
  8389. TypeEl: TPasType;
  8390. begin
  8391. Result:=nil;
  8392. case Params.Kind of
  8393. pekArrayParams: ;
  8394. pekFuncParams:
  8395. if Params.Value.CustomData is TResolvedReference then
  8396. begin
  8397. Ref:=TResolvedReference(Params.Value.CustomData);
  8398. Decl:=Ref.Declaration;
  8399. if Decl is TPasType then
  8400. Decl:=ResolveAliasType(TPasType(Decl));
  8401. C:=Decl.ClassType;
  8402. if C=TPasUnresolvedSymbolRef then
  8403. begin
  8404. if Decl.CustomData is TResElDataBuiltInProc then
  8405. begin
  8406. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  8407. {$IFDEF VerbosePasResEval}
  8408. writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  8409. {$ENDIF}
  8410. case BuiltInProc.BuiltIn of
  8411. bfLength: BI_Length_OnEval(BuiltInProc,Params,Flags,Result);
  8412. bfAssigned: Result:=nil;
  8413. bfChr: BI_Chr_OnEval(BuiltInProc,Params,Flags,Result);
  8414. bfOrd: BI_Ord_OnEval(BuiltInProc,Params,Flags,Result);
  8415. bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Flags,Result);
  8416. bfPred,bfSucc: BI_PredSucc_OnEval(BuiltInProc,Params,Flags,Result);
  8417. bfStrFunc: BI_StrFunc_OnEval(BuiltInProc,Params,Flags,Result);
  8418. bfConcatArray: Result:=nil;
  8419. bfCopyArray: Result:=nil;
  8420. bfTypeInfo: Result:=nil;
  8421. else
  8422. {$IFDEF VerbosePasResEval}
  8423. writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  8424. {$ENDIF}
  8425. RaiseNotYetImplemented(20170624192324,Params);
  8426. end;
  8427. {$IFDEF VerbosePasResEval}
  8428. if Result<>nil then
  8429. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
  8430. else
  8431. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
  8432. {$ENDIF}
  8433. exit;
  8434. end
  8435. else if Decl.CustomData is TResElDataBaseType then
  8436. begin
  8437. // typecast to basetype
  8438. bt:=TResElDataBaseType(Decl.CustomData).BaseType;
  8439. Result:=EvalBaseTypeCast(Params,bt);
  8440. end;
  8441. {$IFDEF VerbosePasResEval}
  8442. writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
  8443. {$ENDIF}
  8444. end
  8445. else if C=TPasEnumType then
  8446. begin
  8447. // typecast to enumtype
  8448. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
  8449. end
  8450. else if C=TPasRangeType then
  8451. begin
  8452. // typecast to custom range
  8453. ComputeElement(TPasRangeType(Decl).RangeExpr.left,ResolvedEl,[rcConstant]);
  8454. if ResolvedEl.BaseType=btContext then
  8455. begin
  8456. TypeEl:=ResolveAliasType(ResolvedEl.TypeEl);
  8457. if TypeEl.ClassType=TPasEnumType then
  8458. begin
  8459. // typecast to enumtype
  8460. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(TypeEl),Params.Params[0],Flags);
  8461. end
  8462. else
  8463. RaiseNotYetImplemented(20171009223403,Params);
  8464. end
  8465. else
  8466. RaiseNotYetImplemented(20171009223303,Params);
  8467. end;
  8468. end;
  8469. pekSet: ;
  8470. end;
  8471. if Flags=[] then ;
  8472. end;
  8473. function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
  8474. bt: TResolverBaseType): TResEvalvalue;
  8475. var
  8476. Value: TResEvalValue;
  8477. Int: MaxPrecInt;
  8478. MinIntVal, MaxIntVal: int64;
  8479. Flo: MaxPrecFloat;
  8480. c: Char;
  8481. w: WideChar;
  8482. begin
  8483. Result:=nil;
  8484. {$IFDEF VerbosePasResEval}
  8485. writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
  8486. {$ENDIF}
  8487. Value:=Eval(Params.Params[0],[refAutoConst]);
  8488. if Value=nil then exit;
  8489. try
  8490. case Value.Kind of
  8491. revkInt:
  8492. begin
  8493. Int:=TResEvalInt(Value).Int;
  8494. if bt=btQWord then
  8495. begin
  8496. // int to qword
  8497. {$R-}
  8498. Result:=TResEvalUInt.CreateValue(MaxPrecUInt(Int));
  8499. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  8500. end
  8501. else if bt in (btAllInteger-[btQWord]) then
  8502. begin
  8503. // int to int
  8504. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  8505. if (Int<MinIntVal) or (Int>MaxIntVal) then
  8506. begin
  8507. {$R-}
  8508. case bt of
  8509. btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
  8510. btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
  8511. btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
  8512. btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
  8513. btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
  8514. btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
  8515. btInt64: Result:=TResEvalInt.CreateValue(Int);
  8516. btUIntSingle,
  8517. btIntSingle,
  8518. btUIntDouble,
  8519. btIntDouble:
  8520. fExprEvaluator.EmitRangeCheckConst(20170624194534,
  8521. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  8522. else
  8523. RaiseNotYetImplemented(20170624200109,Params);
  8524. end;
  8525. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  8526. end
  8527. else
  8528. begin
  8529. {$R-}
  8530. case bt of
  8531. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  8532. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  8533. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  8534. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  8535. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  8536. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  8537. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  8538. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  8539. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  8540. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  8541. btInt64: Result:=TResEvalInt.CreateValue(Int);
  8542. else
  8543. RaiseNotYetImplemented(20170624200109,Params);
  8544. end;
  8545. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  8546. end;
  8547. exit;
  8548. end
  8549. else if bt in btAllBooleans then
  8550. case Int of
  8551. 0: Result:=TResEvalBool.CreateValue(false);
  8552. 1: Result:=TResEvalBool.CreateValue(true);
  8553. else
  8554. fExprEvaluator.EmitRangeCheckConst(20170710203254,
  8555. Value.AsString,0,1,Params,mtError);
  8556. end
  8557. else if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  8558. try
  8559. c:=Char(Int);
  8560. Result:=TResEvalString.CreateValue(c);
  8561. except
  8562. RaiseMsg(20180125112510,nRangeCheckError,sRangeCheckError,[],Params);
  8563. end
  8564. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  8565. try
  8566. w:=WideChar(Int);
  8567. Result:=TResEvalUTF16.CreateValue(w);
  8568. except
  8569. RaiseMsg(20180125112716,nRangeCheckError,sRangeCheckError,[],Params);
  8570. end
  8571. else if bt=btSingle then
  8572. try
  8573. Result:=TResEvalFloat.CreateValue(Single(Int));
  8574. except
  8575. RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
  8576. end
  8577. else if bt=btDouble then
  8578. try
  8579. Result:=TResEvalFloat.CreateValue(Double(Int));
  8580. except
  8581. RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
  8582. end
  8583. else
  8584. begin
  8585. {$IFDEF VerbosePasResEval}
  8586. writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
  8587. {$ENDIF}
  8588. RaiseNotYetImplemented(20170624194308,Params);
  8589. end;
  8590. end;
  8591. revkFloat:
  8592. begin
  8593. Flo:=TResEvalFloat(Value).FloatValue;
  8594. if bt in (btAllInteger-[btQWord]) then
  8595. begin
  8596. // float to int
  8597. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  8598. if (Flo<MinIntVal) or (Flo>MaxIntVal) then
  8599. fExprEvaluator.EmitRangeCheckConst(20170711001228,
  8600. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  8601. {$R-}
  8602. try
  8603. Int:=Round(Flo);
  8604. except
  8605. RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
  8606. end;
  8607. case bt of
  8608. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  8609. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  8610. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  8611. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  8612. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  8613. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  8614. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  8615. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  8616. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  8617. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  8618. btInt64: Result:=TResEvalInt.CreateValue(Int);
  8619. else
  8620. RaiseNotYetImplemented(20170711001513,Params);
  8621. end;
  8622. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  8623. exit;
  8624. end
  8625. else if bt=btSingle then
  8626. begin
  8627. // float to single
  8628. try
  8629. Result:=TResEvalFloat.CreateValue(single(Flo));
  8630. except
  8631. RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
  8632. end;
  8633. end
  8634. else if bt=btDouble then
  8635. begin
  8636. // float to double
  8637. try
  8638. Result:=TResEvalFloat.CreateValue(double(Flo));
  8639. except
  8640. RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
  8641. end;
  8642. end
  8643. else
  8644. begin
  8645. {$IFDEF VerbosePasResEval}
  8646. writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
  8647. {$ENDIF}
  8648. RaiseNotYetImplemented(20170711002542,Params);
  8649. end;
  8650. end
  8651. else
  8652. {$IFDEF VerbosePasResEval}
  8653. writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
  8654. {$ENDIF}
  8655. RaiseNotYetImplemented(20170624193436,Params);
  8656. end;
  8657. finally
  8658. ReleaseEvalValue(Value);
  8659. end;
  8660. end;
  8661. function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
  8662. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  8663. var Handled: boolean): integer;
  8664. // called when LHS or RHS BaseType is btCustom
  8665. // if RaiseOnIncompatible=true you can raise an useful error.
  8666. begin
  8667. Result:=cIncompatible;
  8668. if LHS.BaseType=btNone then ;
  8669. if RHS.BaseType=btNone then ;
  8670. if ErrorEl=nil then ;
  8671. if RaiseOnIncompatible then ;
  8672. if Handled then ;
  8673. end;
  8674. function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
  8675. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  8676. ): integer;
  8677. begin
  8678. Result:=cIncompatible;
  8679. if LHS.BaseType=RHS.BaseType then;
  8680. if ErrorEl=nil then;
  8681. if RaiseOnIncompatible then ;
  8682. end;
  8683. function TPasResolver.BI_Length_OnGetCallCompatibility(
  8684. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  8685. // check params of built in proc 'length'
  8686. var
  8687. Params: TParamsExpr;
  8688. Param: TPasExpr;
  8689. ParamResolved: TPasResolverResult;
  8690. Ranges: TPasExprArray;
  8691. begin
  8692. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  8693. exit(cIncompatible);
  8694. Params:=TParamsExpr(Expr);
  8695. // first param: string or dynamic array or type/const of static array
  8696. Param:=Params.Params[0];
  8697. ComputeElement(Param,ParamResolved,[]);
  8698. Result:=cIncompatible;
  8699. if ParamResolved.BaseType in btAllStringAndChars then
  8700. begin
  8701. if rrfReadable in ParamResolved.Flags then
  8702. Result:=cExact;
  8703. end
  8704. else if ParamResolved.BaseType=btContext then
  8705. begin
  8706. if (ParamResolved.TypeEl.ClassType=TPasArrayType) then
  8707. begin
  8708. Ranges:=TPasArrayType(ParamResolved.TypeEl).Ranges;
  8709. if length(Ranges)=0 then
  8710. begin
  8711. if rrfReadable in ParamResolved.Flags then
  8712. Result:=cExact;
  8713. end
  8714. else
  8715. // static array
  8716. Result:=cExact;
  8717. end;
  8718. end;
  8719. if Result=cIncompatible then
  8720. exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
  8721. 'string or dynamic array',RaiseOnError));
  8722. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  8723. end;
  8724. procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  8725. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  8726. begin
  8727. if Params=nil then ;
  8728. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  8729. FBaseTypes[BaseTypeLength],[rrfReadable]);
  8730. end;
  8731. procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  8732. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  8733. var
  8734. Param, Expr: TPasExpr;
  8735. ParamResolved: TPasResolverResult;
  8736. Value: TResEvalValue;
  8737. Ranges: TPasExprArray;
  8738. begin
  8739. Evaluated:=nil;
  8740. // first param: string or dynamic array or type/const of static array
  8741. Param:=Params.Params[0];
  8742. ComputeElement(Param,ParamResolved,[]);
  8743. if ParamResolved.BaseType in btAllStringAndChars then
  8744. begin
  8745. if rrfReadable in ParamResolved.Flags then
  8746. begin
  8747. Value:=Eval(Param,Flags);
  8748. if Value=nil then exit;
  8749. case Value.Kind of
  8750. revkString:
  8751. Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
  8752. revkUnicodeString:
  8753. Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
  8754. end;
  8755. ReleaseEvalValue(Value);
  8756. end
  8757. end
  8758. else if ParamResolved.BaseType=btContext then
  8759. begin
  8760. if (ParamResolved.TypeEl.ClassType=TPasArrayType) then
  8761. begin
  8762. Ranges:=TPasArrayType(ParamResolved.TypeEl).Ranges;
  8763. if length(Ranges)=0 then
  8764. begin
  8765. // open or dynamic array
  8766. if (ParamResolved.IdentEl is TPasVariable)
  8767. and (TPasVariable(ParamResolved.IdentEl).Expr is TPasExpr) then
  8768. begin
  8769. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  8770. if Expr is TArrayValues then
  8771. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values));
  8772. end;
  8773. end
  8774. else
  8775. begin
  8776. // static array
  8777. Evaluated:=TResEvalInt.CreateValue(GetRangeLength(Ranges[0]));
  8778. end;
  8779. end;
  8780. end;
  8781. if Proc=nil then ;
  8782. end;
  8783. function TPasResolver.BI_SetLength_OnGetCallCompatibility(
  8784. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  8785. // check params of built in proc 'setlength'
  8786. var
  8787. Params: TParamsExpr;
  8788. Param: TPasExpr;
  8789. ParamResolved, DimResolved: TPasResolverResult;
  8790. ArgNo: Integer;
  8791. DynArr: TPasArrayType;
  8792. ElType: TPasType;
  8793. begin
  8794. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  8795. exit(cIncompatible);
  8796. Params:=TParamsExpr(Expr);
  8797. // first param: string or array variable
  8798. Param:=Params.Params[0];
  8799. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  8800. Result:=cIncompatible;
  8801. DynArr:=nil;
  8802. if ResolvedElCanBeVarParam(ParamResolved) then
  8803. begin
  8804. if ParamResolved.BaseType in btAllStrings then
  8805. Result:=cExact
  8806. else if ParamResolved.BaseType=btContext then
  8807. begin
  8808. if IsDynArray(ParamResolved.TypeEl,false) then
  8809. begin
  8810. Result:=cExact;
  8811. DynArr:=NoNil(ParamResolved.TypeEl) as TPasArrayType;
  8812. end;
  8813. end;
  8814. end;
  8815. if Result=cIncompatible then
  8816. exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
  8817. 'string or dynamic array variable',RaiseOnError));
  8818. // second param: new length
  8819. ArgNo:=2;
  8820. repeat
  8821. Param:=Params.Params[ArgNo-1];
  8822. ComputeElement(Param,DimResolved,[]);
  8823. Result:=cIncompatible;
  8824. if (rrfReadable in DimResolved.Flags)
  8825. and (DimResolved.BaseType in btAllInteger) then
  8826. Result:=cExact;
  8827. if Result=cIncompatible then
  8828. exit(CheckRaiseTypeArgNo(20170329160338,ArgNo,Param,DimResolved,
  8829. 'integer',RaiseOnError));
  8830. if (DynArr=nil) or (ArgNo=length(Params.Params)) then break;
  8831. ElType:=ResolveAliasType(DynArr.ElType);
  8832. if not IsDynArray(ElType) then break;
  8833. DynArr:=NoNil(ElType) as TPasArrayType;
  8834. inc(ArgNo);
  8835. until false;
  8836. Result:=CheckBuiltInMaxParamCount(Proc,Params,ArgNo,RaiseOnError);
  8837. end;
  8838. procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
  8839. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  8840. var
  8841. P: TPasExprArray;
  8842. begin
  8843. if Proc=nil then ;
  8844. P:=Params.Params;
  8845. FinishCallArgAccess(P[0],rraVarParam);
  8846. FinishCallArgAccess(P[1],rraRead);
  8847. end;
  8848. function TPasResolver.BI_InExclude_OnGetCallCompatibility(
  8849. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  8850. // check params of built in proc 'include'
  8851. var
  8852. Params: TParamsExpr;
  8853. Param: TPasExpr;
  8854. ParamResolved: TPasResolverResult;
  8855. EnumType: TPasEnumType;
  8856. begin
  8857. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  8858. exit(cIncompatible);
  8859. Params:=TParamsExpr(Expr);
  8860. // first param: variable of set of enumtype
  8861. Param:=Params.Params[0];
  8862. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  8863. EnumType:=nil;
  8864. if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
  8865. and ((ParamResolved.IdentEl is TPasVariable)
  8866. or (ParamResolved.IdentEl is TPasArgument)) then
  8867. begin
  8868. if (ParamResolved.BaseType=btSet)
  8869. and (ParamResolved.TypeEl is TPasEnumType) then
  8870. EnumType:=TPasEnumType(ParamResolved.TypeEl);
  8871. end;
  8872. if EnumType=nil then
  8873. begin
  8874. {$IFDEF VerbosePasResolver}
  8875. writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
  8876. {$ENDIF}
  8877. exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
  8878. 'variable of set of enumtype',RaiseOnError));
  8879. end;
  8880. // second param: enum
  8881. Param:=Params.Params[1];
  8882. ComputeElement(Param,ParamResolved,[]);
  8883. if (not (rrfReadable in ParamResolved.Flags))
  8884. or (ParamResolved.TypeEl<>EnumType) then
  8885. begin
  8886. if RaiseOnError then
  8887. RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
  8888. ['2'],ParamResolved.TypeEl,EnumType,Param);
  8889. exit(cIncompatible);
  8890. end;
  8891. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  8892. end;
  8893. procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
  8894. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  8895. var
  8896. P: TPasExprArray;
  8897. begin
  8898. if Proc=nil then ;
  8899. P:=Params.Params;
  8900. FinishCallArgAccess(P[0],rraVarParam);
  8901. FinishCallArgAccess(P[1],rraRead);
  8902. end;
  8903. function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  8904. Expr: TPasExpr; RaiseOnError: boolean): integer;
  8905. var
  8906. Params: TParamsExpr;
  8907. begin
  8908. if GetLoop(Expr)=nil then
  8909. RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
  8910. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  8911. exit(cExact);
  8912. Params:=TParamsExpr(Expr);
  8913. {$IFDEF VerbosePasResolver}
  8914. writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
  8915. {$ENDIF}
  8916. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  8917. end;
  8918. function TPasResolver.BI_Continue_OnGetCallCompatibility(
  8919. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  8920. var
  8921. Params: TParamsExpr;
  8922. begin
  8923. if GetLoop(Expr)=nil then
  8924. RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
  8925. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  8926. exit(cExact);
  8927. Params:=TParamsExpr(Expr);
  8928. {$IFDEF VerbosePasResolver}
  8929. writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
  8930. {$ENDIF}
  8931. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  8932. end;
  8933. function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  8934. Expr: TPasExpr; RaiseOnError: boolean): integer;
  8935. var
  8936. Params: TParamsExpr;
  8937. Param: TPasExpr;
  8938. ParamResolved, ResultResolved: TPasResolverResult;
  8939. i: Integer;
  8940. ProcScope: TPasProcedureScope;
  8941. ResultEl: TPasResultElement;
  8942. Flags: TPasResolverComputeFlags;
  8943. begin
  8944. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  8945. exit(cExact);
  8946. Params:=TParamsExpr(Expr);
  8947. {$IFDEF VerbosePasResolver}
  8948. writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
  8949. {$ENDIF}
  8950. // first param: result
  8951. Param:=Params.Params[0];
  8952. Result:=cIncompatible;
  8953. i:=ScopeCount-1;
  8954. while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
  8955. if i>0 then
  8956. begin
  8957. // first param is function result
  8958. ProcScope:=TPasProcedureScope(Scopes[i]);
  8959. if not (ProcScope.Element is TPasFunction) then
  8960. begin
  8961. if RaiseOnError then
  8962. RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
  8963. sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
  8964. exit(cIncompatible);
  8965. end;
  8966. ResultEl:=(ProcScope.Element as TPasFunction).FuncType.ResultEl;
  8967. ComputeElement(ResultEl,ResultResolved,[rcType]);
  8968. end
  8969. else
  8970. begin
  8971. // default: main program, param is an integer
  8972. SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],[rrfReadable,rrfWritable]);
  8973. end;
  8974. {$IFDEF VerbosePasResolver}
  8975. writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
  8976. {$ENDIF}
  8977. Flags:=[];
  8978. if IsProcedureType(ResultResolved,true) then
  8979. Include(Flags,rcNoImplicitProc);
  8980. ComputeElement(Param,ParamResolved,Flags);
  8981. {$IFDEF VerbosePasResolver}
  8982. writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
  8983. {$ENDIF}
  8984. if rrfReadable in ParamResolved.Flags then
  8985. Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
  8986. if Result=cIncompatible then
  8987. begin
  8988. if RaiseOnError then
  8989. RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
  8990. ['1'],ParamResolved,ResultResolved,Param);
  8991. exit;
  8992. end;
  8993. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  8994. end;
  8995. function TPasResolver.BI_IncDec_OnGetCallCompatibility(
  8996. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  8997. var
  8998. Params: TParamsExpr;
  8999. Param: TPasExpr;
  9000. ParamResolved, IncrResolved: TPasResolverResult;
  9001. begin
  9002. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9003. exit(cIncompatible);
  9004. Params:=TParamsExpr(Expr);
  9005. // first param: var Integer
  9006. Param:=Params.Params[0];
  9007. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  9008. {$IFDEF VerbosePasResolver}
  9009. writeln('TPasResolver.OnGetCallCompatibility_IncDec ParamResolved=',GetResolverResultDbg(ParamResolved));
  9010. {$ENDIF}
  9011. Result:=cIncompatible;
  9012. // Expr must be a variable
  9013. if not ResolvedElCanBeVarParam(ParamResolved) then
  9014. begin
  9015. if RaiseOnError then
  9016. RaiseMsg(20170216152319,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  9017. exit;
  9018. end;
  9019. if ParamResolved.BaseType in btAllInteger then
  9020. Result:=cExact;
  9021. if Result=cIncompatible then
  9022. exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
  9023. if length(Params.Params)=1 then
  9024. exit;
  9025. // second param: increment/decrement
  9026. Param:=Params.Params[1];
  9027. ComputeElement(Param,IncrResolved,[]);
  9028. Result:=cIncompatible;
  9029. if rrfReadable in IncrResolved.Flags then
  9030. begin
  9031. if IncrResolved.BaseType in btAllInteger then
  9032. Result:=cExact;
  9033. end;
  9034. if Result=cIncompatible then
  9035. exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
  9036. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  9037. end;
  9038. procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
  9039. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  9040. var
  9041. P: TPasExprArray;
  9042. begin
  9043. if Proc=nil then ;
  9044. P:=Params.Params;
  9045. FinishCallArgAccess(P[0],rraVarParam);
  9046. if Length(P)>1 then
  9047. FinishCallArgAccess(P[1],rraRead);
  9048. end;
  9049. function TPasResolver.BI_Assigned_OnGetCallCompatibility(
  9050. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9051. // check params of built in proc 'Assigned'
  9052. var
  9053. Params: TParamsExpr;
  9054. Param: TPasExpr;
  9055. ParamResolved: TPasResolverResult;
  9056. C: TClass;
  9057. begin
  9058. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9059. exit(cIncompatible);
  9060. Params:=TParamsExpr(Expr);
  9061. // first param: pointer, class, class instance, proc type or array
  9062. Param:=Params.Params[0];
  9063. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  9064. Result:=cIncompatible;
  9065. if ParamResolved.BaseType in [btNil,btPointer] then
  9066. Result:=cExact
  9067. else if (ParamResolved.BaseType=btContext) then
  9068. begin
  9069. C:=ParamResolved.TypeEl.ClassType;
  9070. if (C=TPasClassType)
  9071. or (C=TPasClassOfType)
  9072. or C.InheritsFrom(TPasProcedureType)
  9073. or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.TypeEl).Ranges)=0)) then
  9074. Result:=cExact;
  9075. end;
  9076. if Result=cIncompatible then
  9077. exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
  9078. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9079. end;
  9080. procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9081. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9082. begin
  9083. SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,FBaseTypes[btBoolean],[rrfReadable]);
  9084. end;
  9085. procedure TPasResolver.BI_Assigned_OnFinishParamsExpr(
  9086. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  9087. var
  9088. P: TPasExpr;
  9089. ResolvedEl: TPasResolverResult;
  9090. begin
  9091. if Proc=nil then ;
  9092. P:=Params.Params[0];
  9093. AccessExpr(P,rraRead);
  9094. ComputeElement(P,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
  9095. end;
  9096. function TPasResolver.BI_Chr_OnGetCallCompatibility(
  9097. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9098. var
  9099. Params: TParamsExpr;
  9100. Param: TPasExpr;
  9101. ParamResolved: TPasResolverResult;
  9102. begin
  9103. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9104. exit(cIncompatible);
  9105. Params:=TParamsExpr(Expr);
  9106. // first param: integer
  9107. Param:=Params.Params[0];
  9108. ComputeElement(Param,ParamResolved,[]);
  9109. Result:=cIncompatible;
  9110. if rrfReadable in ParamResolved.Flags then
  9111. begin
  9112. if ParamResolved.BaseType in btAllInteger then
  9113. Result:=cExact;
  9114. end;
  9115. if Result=cIncompatible then
  9116. exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
  9117. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9118. end;
  9119. procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9120. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9121. begin
  9122. SetResolverIdentifier(ResolvedEl,BaseTypeChar,Proc.Proc,
  9123. FBaseTypes[BaseTypeChar],[rrfReadable]);
  9124. end;
  9125. procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  9126. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  9127. var
  9128. Param: TPasExpr;
  9129. Value: TResEvalValue;
  9130. begin
  9131. Evaluated:=nil;
  9132. Param:=Params.Params[0];
  9133. Value:=Eval(Param,Flags);
  9134. {$IFDEF VerbosePasResEval}
  9135. if Value=nil then
  9136. writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
  9137. else
  9138. writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
  9139. {$ENDIF}
  9140. if Value=nil then exit;
  9141. try
  9142. Evaluated:=fExprEvaluator.ChrValue(Value,Params);
  9143. finally
  9144. ReleaseEvalValue(Value);
  9145. end;
  9146. if Proc=nil then ;
  9147. end;
  9148. function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  9149. Expr: TPasExpr; RaiseOnError: boolean): integer;
  9150. var
  9151. Params: TParamsExpr;
  9152. Param: TPasExpr;
  9153. ParamResolved, ResolvedEl: TPasResolverResult;
  9154. TypeEl: TPasType;
  9155. begin
  9156. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9157. exit(cIncompatible);
  9158. Params:=TParamsExpr(Expr);
  9159. // first param: bool, enum or char
  9160. Param:=Params.Params[0];
  9161. ComputeElement(Param,ParamResolved,[]);
  9162. Result:=cIncompatible;
  9163. if rrfReadable in ParamResolved.Flags then
  9164. begin
  9165. if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
  9166. Result:=cExact
  9167. else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
  9168. Result:=cExact
  9169. else if ParamResolved.BaseType=btRange then
  9170. begin
  9171. if ParamResolved.SubType in btAllBooleans+btAllChars then
  9172. Result:=cExact
  9173. else if ParamResolved.SubType=btContext then
  9174. begin
  9175. TypeEl:=ResolveAliasType(ParamResolved.TypeEl);
  9176. if TypeEl.ClassType=TPasRangeType then
  9177. begin
  9178. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  9179. if ResolvedEl.TypeEl.ClassType=TPasEnumType then
  9180. exit(cExact);
  9181. end;
  9182. end;
  9183. end;
  9184. end;
  9185. if Result=cIncompatible then
  9186. exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
  9187. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9188. end;
  9189. procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9190. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9191. begin
  9192. SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,FBaseTypes[btLongint],[rrfReadable]);
  9193. end;
  9194. procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  9195. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  9196. var
  9197. Param: TPasExpr;
  9198. Value: TResEvalValue;
  9199. begin
  9200. Evaluated:=nil;
  9201. Param:=Params.Params[0];
  9202. Value:=Eval(Param,Flags);
  9203. {$IFDEF VerbosePasResEval}
  9204. if Value=nil then
  9205. writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
  9206. else
  9207. writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
  9208. {$ENDIF}
  9209. if Value=nil then exit;
  9210. try
  9211. Evaluated:=fExprEvaluator.OrdValue(Value,Params);
  9212. finally
  9213. ReleaseEvalValue(Value);
  9214. end;
  9215. if Proc=nil then ;
  9216. end;
  9217. function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
  9218. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9219. // check params of built in proc 'Low' or 'High'
  9220. var
  9221. Params: TParamsExpr;
  9222. Param: TPasExpr;
  9223. ParamResolved: TPasResolverResult;
  9224. C: TClass;
  9225. begin
  9226. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9227. exit(cIncompatible);
  9228. Params:=TParamsExpr(Expr);
  9229. // first param: enumtype, range, built-in ordinal type (char, longint, ...)
  9230. Param:=Params.Params[0];
  9231. ComputeElement(Param,ParamResolved,[]);
  9232. Result:=cIncompatible;
  9233. if not (rrfReadable in ParamResolved.Flags)
  9234. and (ParamResolved.BaseType in btAllRanges) then
  9235. // built-in range e.g. high(char)
  9236. Result:=cExact
  9237. else if ParamResolved.BaseType=btSet then
  9238. Result:=cExact
  9239. else if (ParamResolved.BaseType=btContext) then
  9240. begin
  9241. C:=ParamResolved.TypeEl.ClassType;
  9242. if (C=TPasArrayType)
  9243. or (C=TPasSetType)
  9244. or (C=TPasEnumType) then
  9245. Result:=cExact;
  9246. end;
  9247. if Result=cIncompatible then
  9248. exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
  9249. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9250. end;
  9251. procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9252. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9253. var
  9254. ArrayEl: TPasArrayType;
  9255. Param: TPasExpr;
  9256. TypeEl: TPasType;
  9257. begin
  9258. Param:=Params.Params[0];
  9259. ComputeElement(Param,ResolvedEl,[]);
  9260. if ResolvedEl.BaseType=btContext then
  9261. begin
  9262. TypeEl:=ResolvedEl.TypeEl;
  9263. if TypeEl.ClassType=TPasArrayType then
  9264. begin
  9265. // array: result type is type of first dimension
  9266. ArrayEl:=TPasArrayType(TypeEl);
  9267. if length(ArrayEl.Ranges)=0 then
  9268. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  9269. FBaseTypes[BaseTypeLength],[rrfReadable])
  9270. else
  9271. begin
  9272. ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
  9273. if ResolvedEl.BaseType=btRange then
  9274. ConvertRangeToElement(ResolvedEl);
  9275. end;
  9276. end
  9277. else if TypeEl.ClassType=TPasSetType then
  9278. begin
  9279. ResolvedEl.TypeEl:=TPasSetType(TypeEl).EnumType;
  9280. end;
  9281. end
  9282. else if ResolvedEl.BaseType=btSet then
  9283. begin
  9284. ResolvedEl.BaseType:=ResolvedEl.SubType;
  9285. ResolvedEl.SubType:=btNone;
  9286. end
  9287. else
  9288. ;// ordinal: result type is argument type
  9289. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
  9290. end;
  9291. procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  9292. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  9293. var
  9294. Param: TPasExpr;
  9295. ParamResolved: TPasResolverResult;
  9296. var
  9297. TypeEl: TPasType;
  9298. ArrayEl: TPasArrayType;
  9299. Value: TResEvalValue;
  9300. EnumType: TPasEnumType;
  9301. aSet: TResEvalSet;
  9302. Int: MaxPrecInt;
  9303. bt: TResolverBaseType;
  9304. MinInt, MaxInt: int64;
  9305. i: Integer;
  9306. Expr: TPasExpr;
  9307. begin
  9308. Evaluated:=nil;
  9309. Param:=Params.Params[0];
  9310. ComputeElement(Param,ParamResolved,[]);
  9311. TypeEl:=ParamResolved.TypeEl;
  9312. if ParamResolved.BaseType=btContext then
  9313. begin
  9314. if TypeEl.ClassType=TPasArrayType then
  9315. begin
  9316. // array: low/high of first dimension
  9317. ArrayEl:=TPasArrayType(TypeEl);
  9318. if length(ArrayEl.Ranges)=0 then
  9319. begin
  9320. // dyn or open array
  9321. if Proc.BuiltIn=bfLow then
  9322. Evaluated:=TResEvalInt.CreateValue(0)
  9323. else if (ParamResolved.IdentEl is TPasVariable)
  9324. and (TPasVariable(ParamResolved.IdentEl).Expr is TPasExpr) then
  9325. begin
  9326. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  9327. if Expr is TArrayValues then
  9328. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values)-1);
  9329. if Evaluated=nil then
  9330. RaiseNotYetImplemented(20170601191003,Params);
  9331. end
  9332. else
  9333. exit;
  9334. end
  9335. else
  9336. begin
  9337. // static array
  9338. Evaluated:=EvalRangeLimit(ArrayEl.Ranges[0],Flags,Proc.BuiltIn=bfLow,Param);
  9339. end;
  9340. end
  9341. else if TypeEl.ClassType=TPasSetType then
  9342. begin
  9343. // set: first/last enum
  9344. TypeEl:=TPasSetType(TypeEl).EnumType;
  9345. if TypeEl.ClassType=TPasEnumType then
  9346. begin
  9347. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  9348. if Proc.BuiltIn=bfLow then
  9349. Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
  9350. else
  9351. Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
  9352. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  9353. end
  9354. else
  9355. begin
  9356. {$IFDEF VerbosePasResolver}
  9357. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  9358. {$ENDIF}
  9359. RaiseNotYetImplemented(20170601203026,Params);
  9360. end;
  9361. end
  9362. else if TypeEl.ClassType=TPasEnumType then
  9363. begin
  9364. EnumType:=TPasEnumType(TypeEl);
  9365. if Proc.BuiltIn=bfLow then
  9366. i:=0
  9367. else
  9368. i:=EnumType.Values.Count-1;
  9369. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  9370. end;
  9371. end
  9372. else if ParamResolved.BaseType=btSet then
  9373. begin
  9374. Value:=Eval(Param,Flags);
  9375. if Value=nil then exit;
  9376. case Value.Kind of
  9377. revkSetOfInt:
  9378. begin
  9379. aSet:=TResEvalSet(Value);
  9380. if length(aSet.Ranges)=0 then
  9381. RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
  9382. if Proc.BuiltIn=bfLow then
  9383. Int:=aSet.Ranges[0].RangeStart
  9384. else
  9385. Int:=aSet.Ranges[length(aSet.Ranges)-1].RangeEnd;
  9386. case aSet.ElKind of
  9387. revskEnum:
  9388. begin
  9389. EnumType:=aSet.IdentEl as TPasEnumType;
  9390. Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
  9391. end;
  9392. revskInt:
  9393. Evaluated:=TResEvalInt.CreateValue(Int);
  9394. revskChar:
  9395. if Int<256 then
  9396. Evaluated:=TResEvalString.CreateValue(chr(Int))
  9397. else
  9398. Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
  9399. revskBool:
  9400. if Int=0 then
  9401. Evaluated:=TResEvalBool.CreateValue(false)
  9402. else
  9403. Evaluated:=TResEvalBool.CreateValue(true)
  9404. end;
  9405. end;
  9406. else
  9407. RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
  9408. end;
  9409. end
  9410. else if (TypeEl is TPasUnresolvedSymbolRef)
  9411. and (TypeEl.CustomData is TResElDataBaseType) then
  9412. begin
  9413. // low,high(base type)
  9414. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  9415. bt:=GetActualBaseType(bt);
  9416. if bt in btAllBooleans then
  9417. Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
  9418. else if bt=btQWord then
  9419. begin
  9420. if Proc.BuiltIn=bfLow then
  9421. Evaluated:=TResEvalInt.CreateValue(0)
  9422. else
  9423. Evaluated:=TResEvalUInt.CreateValue(High(QWord));
  9424. end
  9425. else if (bt in (btAllInteger-[btQWord])) and GetIntegerRange(bt,MinInt,MaxInt) then
  9426. begin
  9427. if Proc.BuiltIn=bfLow then
  9428. Evaluated:=TResEvalInt.CreateValue(MinInt)
  9429. else
  9430. Evaluated:=TResEvalInt.CreateValue(MaxInt);
  9431. end
  9432. else if bt in [btChar,btAnsiChar] then
  9433. begin
  9434. if Proc.BuiltIn=bfLow then
  9435. Evaluated:=TResEvalString.CreateValue(#0)
  9436. else
  9437. Evaluated:=TResEvalString.CreateValue(#255);
  9438. end
  9439. else if bt=btWideChar then
  9440. begin
  9441. if Proc.BuiltIn=bfLow then
  9442. Evaluated:=TResEvalUTF16.CreateValue(#0)
  9443. else
  9444. Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
  9445. end
  9446. else
  9447. begin
  9448. {$IFDEF VerbosePasResolver}
  9449. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  9450. {$ENDIF}
  9451. RaiseNotYetImplemented(20170602070738,Params);
  9452. end;
  9453. end
  9454. else if ParamResolved.TypeEl is TPasRangeType then
  9455. begin
  9456. // e.g. type t = 2..10;
  9457. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
  9458. end
  9459. else
  9460. begin
  9461. {$IFDEF VerbosePasResolver}
  9462. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  9463. {$ENDIF}
  9464. RaiseNotYetImplemented(20170601202353,Params);
  9465. end;
  9466. {$IFDEF VerbosePasResEval}
  9467. if Evaluated=nil then
  9468. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
  9469. else
  9470. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
  9471. {$ENDIF}
  9472. end;
  9473. function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
  9474. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9475. // check params of built in proc 'Pred' or 'Succ'
  9476. var
  9477. Params: TParamsExpr;
  9478. Param: TPasExpr;
  9479. ParamResolved: TPasResolverResult;
  9480. begin
  9481. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9482. exit(cIncompatible);
  9483. Params:=TParamsExpr(Expr);
  9484. // first param: enum, range, set, char or integer
  9485. Param:=Params.Params[0];
  9486. ComputeElement(Param,ParamResolved,[]);
  9487. Result:=cIncompatible;
  9488. if CheckIsOrdinal(ParamResolved,Param,false) then
  9489. Result:=cExact;
  9490. if Result=cIncompatible then
  9491. exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
  9492. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9493. end;
  9494. procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9495. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9496. begin
  9497. ComputeElement(Params.Params[0],ResolvedEl,[]);
  9498. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  9499. end;
  9500. procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  9501. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  9502. var
  9503. Param: TPasExpr;
  9504. begin
  9505. //writeln('TPasResolver.BI_PredSucc_OnEval START');
  9506. Evaluated:=nil;
  9507. Param:=Params.Params[0];
  9508. Evaluated:=Eval(Param,Flags);
  9509. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
  9510. if Evaluated=nil then exit;
  9511. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
  9512. if Evaluated.Element<>nil then
  9513. Evaluated:=Evaluated.Clone;
  9514. if Proc.BuiltIn=bfPred then
  9515. fExprEvaluator.PredValue(Evaluated,Params)
  9516. else
  9517. fExprEvaluator.SuccValue(Evaluated,Params);
  9518. end;
  9519. function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  9520. const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
  9521. ): integer;
  9522. function CheckFormat(FormatExpr: TPasExpr; Index: integer;
  9523. const ParamResolved: TPasResolverResult): boolean;
  9524. var
  9525. ResolvedEl: TPasResolverResult;
  9526. Ok: Boolean;
  9527. begin
  9528. if FormatExpr=nil then exit(true);
  9529. Result:=false;
  9530. Ok:=false;
  9531. if ParamResolved.BaseType in btAllFloats then
  9532. // floats supports value:Width:Precision
  9533. Ok:=true
  9534. else
  9535. // all other only support value:Width
  9536. Ok:=Index<2;
  9537. if not Ok then
  9538. begin
  9539. if RaiseOnError then
  9540. RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
  9541. exit;
  9542. end;
  9543. ComputeElement(FormatExpr,ResolvedEl,[]);
  9544. if not (ResolvedEl.BaseType in btAllInteger) then
  9545. begin
  9546. if RaiseOnError then
  9547. RaiseMsg(20170319221515,nXExpectedButYFound,sXExpectedButYFound,
  9548. ['integer',GetResolverResultDescription(ResolvedEl,true)],FormatExpr);
  9549. exit;
  9550. end;
  9551. if not (rrfReadable in ResolvedEl.Flags) then
  9552. begin
  9553. if RaiseOnError then
  9554. RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
  9555. exit;
  9556. end;
  9557. Result:=true;
  9558. end;
  9559. var
  9560. TypeEl: TPasType;
  9561. begin
  9562. Result:=cIncompatible;
  9563. if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
  9564. Result:=cExact
  9565. else if IsFunc and (ParamResolved.BaseType in btAllStringAndChars) then
  9566. Result:=cExact
  9567. else if ParamResolved.BaseType=btContext then
  9568. begin
  9569. TypeEl:=ParamResolved.TypeEl;
  9570. if TypeEl.ClassType=TPasEnumType then
  9571. Result:=cExact
  9572. end;
  9573. if Result=cIncompatible then
  9574. exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
  9575. if not CheckFormat(Param.format1,1,ParamResolved) then
  9576. exit(cIncompatible);
  9577. if not CheckFormat(Param.format2,2,ParamResolved) then
  9578. exit(cIncompatible);
  9579. end;
  9580. function TPasResolver.BI_StrProc_OnGetCallCompatibility(
  9581. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9582. // check params of built-in procedure 'Str'
  9583. var
  9584. Params: TParamsExpr;
  9585. Param: TPasExpr;
  9586. ParamResolved: TPasResolverResult;
  9587. begin
  9588. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  9589. exit(cIncompatible);
  9590. Params:=TParamsExpr(Expr);
  9591. if ParentNeedsExprResult(Params) then
  9592. begin
  9593. if RaiseOnError then
  9594. RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
  9595. sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
  9596. exit(cIncompatible);
  9597. end;
  9598. // first param: boolean, integer, enum, class instance
  9599. Param:=Params.Params[0];
  9600. ComputeElement(Param,ParamResolved,[]);
  9601. Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
  9602. if Result=cIncompatible then
  9603. exit;
  9604. // second parameter: string variable
  9605. Param:=Params.Params[1];
  9606. ComputeElement(Param,ParamResolved,[]);
  9607. Result:=cIncompatible;
  9608. if ResolvedElCanBeVarParam(ParamResolved) then
  9609. begin
  9610. if ParamResolved.BaseType in btAllStrings then
  9611. Result:=cExact;
  9612. end;
  9613. if Result=cIncompatible then
  9614. exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
  9615. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  9616. end;
  9617. procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  9618. Params: TParamsExpr);
  9619. var
  9620. P: TPasExprArray;
  9621. begin
  9622. if Proc=nil then ;
  9623. P:=Params.Params;
  9624. FinishCallArgAccess(P[0],rraRead);
  9625. FinishCallArgAccess(P[1],rraVarParam);
  9626. end;
  9627. function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
  9628. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9629. var
  9630. Params: TParamsExpr;
  9631. Param: TPasExpr;
  9632. ParamResolved: TPasResolverResult;
  9633. i: Integer;
  9634. begin
  9635. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9636. exit(cIncompatible);
  9637. Params:=TParamsExpr(Expr);
  9638. if not ParentNeedsExprResult(Params) then
  9639. begin
  9640. // not in an expression -> the 'procedure str' is needed, not the 'function str'
  9641. if RaiseOnError then
  9642. RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
  9643. sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
  9644. exit(cIncompatible);
  9645. end;
  9646. // param: string, boolean, integer, enum, class instance
  9647. for i:=0 to length(Params.Params)-1 do
  9648. begin
  9649. Param:=Params.Params[i];
  9650. ComputeElement(Param,ParamResolved,[]);
  9651. Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
  9652. if Result=cIncompatible then
  9653. exit;
  9654. end;
  9655. Result:=cExact;
  9656. end;
  9657. procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9658. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9659. begin
  9660. if Params=nil then ;
  9661. SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,FBaseTypes[btString],[rrfReadable]);
  9662. end;
  9663. procedure TPasResolver.BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  9664. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  9665. begin
  9666. Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
  9667. end;
  9668. function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
  9669. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9670. var
  9671. Params: TParamsExpr;
  9672. Param: TPasExpr;
  9673. ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
  9674. i: Integer;
  9675. begin
  9676. Result:=cIncompatible;
  9677. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9678. exit;
  9679. Params:=TParamsExpr(Expr);
  9680. FirstElTypeResolved:=Default(TPasResolverResult);
  9681. for i:=0 to length(Params.Params)-1 do
  9682. begin
  9683. // all params: array
  9684. Param:=Params.Params[i];
  9685. ComputeElement(Param,ParamResolved,[]);
  9686. if not (rrfReadable in ParamResolved.Flags)
  9687. or (ParamResolved.BaseType<>btContext)
  9688. or not IsDynArray(ParamResolved.TypeEl) then
  9689. exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
  9690. ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
  9691. Include(ElTypeResolved.Flags,rrfReadable);
  9692. if i=0 then
  9693. begin
  9694. FirstElTypeResolved:=ElTypeResolved;
  9695. Include(ElTypeResolved.Flags,rrfWritable);
  9696. end
  9697. else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
  9698. exit(cIncompatible);
  9699. end;
  9700. end;
  9701. procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
  9702. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  9703. ResolvedEl: TPasResolverResult);
  9704. begin
  9705. ComputeElement(Params.Params[0],ResolvedEl,[]);
  9706. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  9707. end;
  9708. function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
  9709. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9710. var
  9711. Params: TParamsExpr;
  9712. Param: TPasExpr;
  9713. ParamResolved: TPasResolverResult;
  9714. begin
  9715. Result:=cIncompatible;
  9716. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9717. exit;
  9718. Params:=TParamsExpr(Expr);
  9719. // first param: array
  9720. Param:=Params.Params[0];
  9721. ComputeElement(Param,ParamResolved,[]);
  9722. if (rrfReadable in ParamResolved.Flags)
  9723. and (ParamResolved.BaseType=btContext) then
  9724. begin
  9725. if IsDynArray(ParamResolved.TypeEl) then
  9726. Result:=cExact;
  9727. end;
  9728. if Result=cIncompatible then
  9729. exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  9730. if length(Params.Params)=1 then
  9731. exit(cExact);
  9732. // check optional Start index
  9733. Param:=Params.Params[1];
  9734. ComputeElement(Param,ParamResolved,[]);
  9735. if not (rrfReadable in ParamResolved.Flags)
  9736. or not (ParamResolved.BaseType in btAllInteger) then
  9737. exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
  9738. if length(Params.Params)=2 then
  9739. exit(cExact);
  9740. // check optional Count
  9741. Param:=Params.Params[2];
  9742. ComputeElement(Param,ParamResolved,[]);
  9743. if not (rrfReadable in ParamResolved.Flags)
  9744. or not (ParamResolved.BaseType in btAllInteger) then
  9745. exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
  9746. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  9747. end;
  9748. procedure TPasResolver.BI_CopyArray_OnGetCallResult(
  9749. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  9750. ResolvedEl: TPasResolverResult);
  9751. begin
  9752. ComputeElement(Params.Params[0],ResolvedEl,[]);
  9753. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  9754. end;
  9755. function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
  9756. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9757. // Insert(Item,var Array,Index)
  9758. var
  9759. Params: TParamsExpr;
  9760. Param, ItemParam: TPasExpr;
  9761. ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
  9762. begin
  9763. Result:=cIncompatible;
  9764. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  9765. exit;
  9766. Params:=TParamsExpr(Expr);
  9767. // check Item
  9768. ItemParam:=Params.Params[0];
  9769. ComputeElement(ItemParam,ItemResolved,[]);
  9770. if not (rrfReadable in ItemResolved.Flags) then
  9771. exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
  9772. // check Array
  9773. Param:=Params.Params[1];
  9774. ComputeElement(Param,ParamResolved,[]);
  9775. if not ResolvedElCanBeVarParam(ParamResolved) then
  9776. begin
  9777. if RaiseOnError then
  9778. RaiseMsg(20170329171514,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
  9779. exit;
  9780. end;
  9781. if (ParamResolved.BaseType<>btContext)
  9782. or not IsDynArray(ParamResolved.TypeEl) then
  9783. exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
  9784. ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
  9785. if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
  9786. exit(cIncompatible);
  9787. // check insert Index
  9788. Param:=Params.Params[2];
  9789. ComputeElement(Param,ParamResolved,[]);
  9790. if not (rrfReadable in ParamResolved.Flags)
  9791. or not (ParamResolved.BaseType in btAllInteger) then
  9792. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  9793. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  9794. end;
  9795. procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
  9796. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  9797. var
  9798. P: TPasExprArray;
  9799. begin
  9800. if Proc=nil then ;
  9801. P:=Params.Params;
  9802. FinishCallArgAccess(P[0],rraRead);
  9803. FinishCallArgAccess(P[1],rraVarParam);
  9804. FinishCallArgAccess(P[2],rraRead);
  9805. end;
  9806. function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
  9807. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9808. // Delete(var Array; Start, Count: integer)
  9809. var
  9810. Params: TParamsExpr;
  9811. Param: TPasExpr;
  9812. ParamResolved: TPasResolverResult;
  9813. begin
  9814. Result:=cIncompatible;
  9815. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  9816. exit;
  9817. Params:=TParamsExpr(Expr);
  9818. // check Array
  9819. Param:=Params.Params[0];
  9820. ComputeElement(Param,ParamResolved,[]);
  9821. if not ResolvedElCanBeVarParam(ParamResolved) then
  9822. begin
  9823. if RaiseOnError then
  9824. RaiseMsg(20170329173421,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
  9825. exit;
  9826. end;
  9827. if (ParamResolved.BaseType<>btContext)
  9828. or not IsDynArray(ParamResolved.TypeEl) then
  9829. exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  9830. // check param Start
  9831. Param:=Params.Params[1];
  9832. ComputeElement(Param,ParamResolved,[]);
  9833. if not (rrfReadable in ParamResolved.Flags)
  9834. or not (ParamResolved.BaseType in btAllInteger) then
  9835. exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
  9836. // check param Count
  9837. Param:=Params.Params[2];
  9838. ComputeElement(Param,ParamResolved,[]);
  9839. if not (rrfReadable in ParamResolved.Flags)
  9840. or not (ParamResolved.BaseType in btAllInteger) then
  9841. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  9842. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  9843. end;
  9844. procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
  9845. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  9846. var
  9847. P: TPasExprArray;
  9848. begin
  9849. if Proc=nil then ;
  9850. P:=Params.Params;
  9851. FinishCallArgAccess(P[0],rraVarParam);
  9852. FinishCallArgAccess(P[1],rraRead);
  9853. FinishCallArgAccess(P[2],rraRead);
  9854. end;
  9855. function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
  9856. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9857. var
  9858. Params: TParamsExpr;
  9859. Param: TPasExpr;
  9860. Decl: TPasElement;
  9861. ParamResolved: TPasResolverResult;
  9862. aType: TPasType;
  9863. begin
  9864. Result:=cIncompatible;
  9865. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9866. exit;
  9867. Params:=TParamsExpr(Expr);
  9868. // check type or var
  9869. Param:=Params.Params[0];
  9870. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  9871. Decl:=ParamResolved.IdentEl;
  9872. aType:=nil;
  9873. if (Decl<>nil) then
  9874. begin
  9875. if Decl is TPasType then
  9876. aType:=TPasType(Decl)
  9877. else if Decl is TPasVariable then
  9878. aType:=TPasVariable(Decl).VarType
  9879. else if Decl.ClassType=TPasArgument then
  9880. aType:=TPasArgument(Decl).ArgType
  9881. else if Decl.ClassType=TPasResultElement then
  9882. aType:=TPasResultElement(Decl).ResultType
  9883. else if Decl is TPasFunction then
  9884. aType:=TPasFunction(Decl).FuncType.ResultEl.ResultType;
  9885. {$IFDEF VerbosePasResolver}
  9886. if aType=nil then
  9887. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility Decl=',GetObjName(Decl));
  9888. {$ENDIF}
  9889. end;
  9890. if aType=nil then
  9891. begin
  9892. {$IFDEF VerbosePasResolver}
  9893. writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  9894. {$ENDIF}
  9895. RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  9896. end;
  9897. aType:=ResolveAliasType(aType);
  9898. if not HasTypeInfo(aType) then
  9899. RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
  9900. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  9901. end;
  9902. procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  9903. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  9904. begin
  9905. if Proc=nil then;
  9906. if Params=nil then ;
  9907. SetResolverTypeExpr(ResolvedEl,btPointer,FBaseTypes[btPointer],[rrfReadable]);
  9908. end;
  9909. function TPasResolver.BI_Assert_OnGetCallCompatibility(
  9910. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  9911. // check params of built-in procedure 'Assert'
  9912. // Assert(bool)
  9913. // Assert(bool,string)
  9914. var
  9915. Params: TParamsExpr;
  9916. Param: TPasExpr;
  9917. ParamResolved: TPasResolverResult;
  9918. begin
  9919. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  9920. exit(cIncompatible);
  9921. Params:=TParamsExpr(Expr);
  9922. // first param: boolean
  9923. Param:=Params.Params[0];
  9924. ComputeElement(Param,ParamResolved,[]);
  9925. if not (rrfReadable in ParamResolved.Flags)
  9926. or not (ParamResolved.BaseType in btAllBooleans) then
  9927. exit(CheckRaiseTypeArgNo(20180117123819,1,Param,ParamResolved,'boolean',RaiseOnError));
  9928. // optional second parameter: string
  9929. if length(Params.Params)>1 then
  9930. begin
  9931. Param:=Params.Params[1];
  9932. ComputeElement(Param,ParamResolved,[]);
  9933. if not (rrfReadable in ParamResolved.Flags)
  9934. or not (ParamResolved.BaseType in btAllStringAndChars) then
  9935. exit(CheckRaiseTypeArgNo(20180117123932,2,Param,ParamResolved,'string',RaiseOnError));
  9936. end;
  9937. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  9938. end;
  9939. procedure TPasResolver.BI_Assert_OnFinishParamsExpr(
  9940. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  9941. begin
  9942. FinishAssertCall(Proc,Params);
  9943. end;
  9944. constructor TPasResolver.Create;
  9945. begin
  9946. inherited Create;
  9947. FDefaultScope:=TPasDefaultScope.Create;
  9948. FPendingForwardProcs:=TFPList.Create;
  9949. FBaseTypeChar:=btAnsiChar;
  9950. FBaseTypeString:=btAnsiString;
  9951. FBaseTypeExtended:=btDouble;
  9952. FBaseTypeLength:=btInt64;
  9953. FDynArrayMinIndex:=0;
  9954. FDynArrayMaxIndex:=High(int64);
  9955. FScopeClass_Class:=TPasClassScope;
  9956. FScopeClass_Proc:=TPasProcedureScope;
  9957. FScopeClass_WithExpr:=TPasWithExprScope;
  9958. fExprEvaluator:=TResExprEvaluator.Create;
  9959. fExprEvaluator.OnLog:=@OnExprEvalLog;
  9960. fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
  9961. fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
  9962. PushScope(FDefaultScope);
  9963. end;
  9964. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  9965. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  9966. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  9967. var
  9968. aScanner: TPascalScanner;
  9969. SrcPos: TPasSourcePos;
  9970. begin
  9971. // get source position for good error messages
  9972. aScanner:=CurrentParser.Scanner;
  9973. if (ASourceFilename='') or StoreSrcColumns then
  9974. begin
  9975. SrcPos.FileName:=aScanner.CurFilename;
  9976. SrcPos.Row:=aScanner.CurRow;
  9977. SrcPos.Column:=aScanner.CurColumn;
  9978. end
  9979. else
  9980. begin
  9981. SrcPos.FileName:=ASourceFilename;
  9982. SrcPos.Row:=ASourceLinenumber;
  9983. SrcPos.Column:=0;
  9984. end;
  9985. Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
  9986. end;
  9987. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  9988. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  9989. const ASrcPos: TPasSourcePos): TPasElement;
  9990. var
  9991. El: TPasElement;
  9992. SrcY: integer;
  9993. begin
  9994. {$IFDEF VerbosePasResolver}
  9995. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  9996. {$ENDIF}
  9997. if (AParent=nil) and (FRootElement<>nil) then
  9998. RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
  9999. if ASrcPos.FileName='' then
  10000. begin
  10001. { $IFDEF VerbosePasResolver}
  10002. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  10003. { $ENDIF}
  10004. RaiseInternalError(20160922163541,'missing filename');
  10005. end;
  10006. SrcY:=ASrcPos.Row;
  10007. if StoreSrcColumns then
  10008. begin
  10009. if (ASrcPos.Column<ParserMaxEmbeddedColumn)
  10010. and (SrcY<ParserMaxEmbeddedRow) then
  10011. SrcY:=-(SrcY*ParserMaxEmbeddedColumn+integer(ASrcPos.Column));
  10012. end;
  10013. // create element
  10014. El:=AClass.Create(AName,AParent);
  10015. FLastElement:=El;
  10016. Result:=FLastElement;
  10017. El.Visibility:=AVisibility;
  10018. El.SourceFilename:=ASrcPos.FileName;
  10019. El.SourceLinenumber:=SrcY;
  10020. if FRootElement=nil then
  10021. begin
  10022. FRootElement:=NoNil(Result) as TPasModule;
  10023. if FStep=prsInit then
  10024. FStep:=prsParsing;
  10025. end;
  10026. if IsElementSkipped(El) then exit;
  10027. // create scope
  10028. if (AClass=TPasVariable)
  10029. or (AClass=TPasConst) then
  10030. AddVariable(TPasVariable(El))
  10031. else if AClass=TPasResString then
  10032. AddResourceString(TPasResString(El))
  10033. else if (AClass=TPasProperty) then
  10034. AddProperty(TPasProperty(El))
  10035. else if AClass=TPasArgument then
  10036. AddArgument(TPasArgument(El))
  10037. else if AClass=TPasEnumType then
  10038. AddEnumType(TPasEnumType(El))
  10039. else if AClass=TPasEnumValue then
  10040. AddEnumValue(TPasEnumValue(El))
  10041. else if (AClass=TUnresolvedPendingRef) then
  10042. else if (AClass=TPasAliasType)
  10043. or (AClass=TPasTypeAliasType)
  10044. or (AClass=TPasClassOfType)
  10045. or (AClass=TPasArrayType)
  10046. or (AClass=TPasProcedureType)
  10047. or (AClass=TPasFunctionType)
  10048. or (AClass=TPasSetType)
  10049. or (AClass=TPasRangeType) then
  10050. AddType(TPasType(El))
  10051. else if AClass=TPasStringType then
  10052. begin
  10053. AddType(TPasType(El));
  10054. if BaseTypes[btShortString]=nil then
  10055. RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
  10056. end
  10057. else if AClass=TPasRecordType then
  10058. AddRecordType(TPasRecordType(El))
  10059. else if AClass=TPasClassType then
  10060. AddClassType(TPasClassType(El))
  10061. else if AClass=TPasVariant then
  10062. else if AClass.InheritsFrom(TPasProcedure) then
  10063. AddProcedure(TPasProcedure(El))
  10064. else if AClass=TPasResultElement then
  10065. AddFunctionResult(TPasResultElement(El))
  10066. else if AClass=TProcedureBody then
  10067. AddProcedureBody(TProcedureBody(El))
  10068. else if AClass=TPasImplExceptOn then
  10069. AddExceptOn(TPasImplExceptOn(El))
  10070. else if AClass=TPasImplLabelMark then
  10071. else if AClass=TPasOverloadedProc then
  10072. else if (AClass=TInterfaceSection)
  10073. or (AClass=TImplementationSection)
  10074. or (AClass=TProgramSection)
  10075. or (AClass=TLibrarySection) then
  10076. AddSection(TPasSection(El))
  10077. else if (AClass=TPasModule)
  10078. or (AClass=TPasProgram)
  10079. or (AClass=TPasLibrary) then
  10080. AddModule(TPasModule(El))
  10081. else if AClass=TPasUsesUnit then
  10082. else if AClass.InheritsFrom(TPasExpr) then
  10083. // resolved when finished
  10084. else if AClass.InheritsFrom(TPasImplBlock) then
  10085. // resolved when finished
  10086. else if AClass=TPasUnresolvedUnitRef then
  10087. RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
  10088. else
  10089. RaiseNotYetImplemented(20160922163544,El);
  10090. end;
  10091. function TPasResolver.FindElement(const aName: String): TPasElement;
  10092. // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
  10093. var
  10094. p: SizeInt;
  10095. RightPath, CurName: String;
  10096. NeedPop: Boolean;
  10097. CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
  10098. CurSection: TPasSection;
  10099. i: Integer;
  10100. UsesUnit: TPasUsesUnit;
  10101. begin
  10102. //writeln('TPasResolver.FindElement Name="',aName,'"');
  10103. ErrorEl:=nil; // use nil to use scanner position as error position
  10104. RightPath:=aName;
  10105. p:=1;
  10106. CurScopeEl:=nil;
  10107. repeat
  10108. p:=Pos('.',RightPath);
  10109. if p<1 then
  10110. begin
  10111. CurName:=RightPath;
  10112. RightPath:='';
  10113. end
  10114. else
  10115. begin
  10116. CurName:=LeftStr(RightPath,p-1);
  10117. Delete(RightPath,1,p);
  10118. if RightPath='' then
  10119. RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  10120. end;
  10121. {$IFDEF VerbosePasResolver}
  10122. if RightPath<>'' then
  10123. writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
  10124. {$ENDIF}
  10125. if not IsValidIdent(CurName) then
  10126. RaiseNotYetImplemented(20170328000033,ErrorEl);
  10127. if CurScopeEl<>nil then
  10128. begin
  10129. NeedPop:=true;
  10130. if CurScopeEl.ClassType=TPasClassType then
  10131. // check visibility
  10132. PushClassDotScope(TPasClassType(CurScopeEl))
  10133. else if CurScopeEl is TPasModule then
  10134. PushModuleDotScope(TPasModule(CurScopeEl))
  10135. else
  10136. RaiseInternalError(20170504174021);
  10137. end
  10138. else
  10139. NeedPop:=false;
  10140. NextEl:=FindElementWithoutParams(CurName,ErrorEl,true);
  10141. {$IFDEF VerbosePasResolver}
  10142. //if RightPath<>'' then
  10143. // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
  10144. {$ENDIF}
  10145. if NextEl is TPasModule then
  10146. begin
  10147. if CurScopeEl is TPasModule then
  10148. RaiseXExpectedButYFound(20170328001619,'class',NextEl.ElementTypeName+' '+NextEl.Name,ErrorEl);
  10149. if Pos('.',NextEl.Name)>0 then
  10150. begin
  10151. // dotted module name -> check if the full module name is in aName
  10152. if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
  10153. begin
  10154. if CompareText(NextEl.Name,aName)=0 then
  10155. RaiseXExpectedButYFound(20170504165825,'type',NextEl.ElementTypeName,ErrorEl)
  10156. else
  10157. RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
  10158. end;
  10159. RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
  10160. end;
  10161. CurScopeEl:=NextEl;
  10162. end
  10163. else if NextEl.ClassType=TPasUsesUnit then
  10164. begin
  10165. // the first name of a used unit matches -> find longest match
  10166. CurSection:=NextEl.Parent as TPasSection;
  10167. i:=length(CurSection.UsesClause)-1;
  10168. BestEl:=nil;
  10169. while i>=0 do
  10170. begin
  10171. UsesUnit:=CurSection.UsesClause[i];
  10172. CurName:=UsesUnit.Name;
  10173. if IsDottedIdentifierPrefix(CurName,aName)
  10174. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  10175. BestEl:=UsesUnit;
  10176. dec(i);
  10177. if (i<0) and (CurSection.ClassType=TImplementationSection) then
  10178. begin
  10179. CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
  10180. if CurSection=nil then break;
  10181. i:=length(CurSection.UsesClause)-1;
  10182. end;
  10183. end;
  10184. // check module name too
  10185. CurName:=RootElement.Name;
  10186. if IsDottedIdentifierPrefix(CurName,aName)
  10187. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  10188. BestEl:=RootElement;
  10189. if BestEl=nil then
  10190. RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
  10191. RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
  10192. if BestEl.ClassType=TPasUsesUnit then
  10193. CurScopeEl:=TPasUsesUnit(BestEl).Module
  10194. else
  10195. CurScopeEl:=BestEl;
  10196. end
  10197. else if RightPath<>'' then
  10198. begin
  10199. if (CurScopeEl is TPasClassType) then
  10200. CurScopeEl:=NextEl
  10201. else
  10202. RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
  10203. end;
  10204. // restore scope
  10205. if NeedPop then
  10206. PopScope;
  10207. if RightPath='' then
  10208. exit(NextEl);
  10209. until false;
  10210. end;
  10211. function TPasResolver.FindElementWithoutParams(const AName: String;
  10212. ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
  10213. var
  10214. Data: TPRFindData;
  10215. begin
  10216. Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs);
  10217. if Data.Found=nil then exit; // forward type: class-of or ^
  10218. CheckFoundElement(Data,nil);
  10219. if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
  10220. and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
  10221. RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
  10222. end;
  10223. function TPasResolver.FindElementWithoutParams(const AName: String; out
  10224. Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean
  10225. ): TPasElement;
  10226. var
  10227. Abort: boolean;
  10228. begin
  10229. //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
  10230. Result:=Nil;
  10231. Abort:=false;
  10232. Data:=Default(TPRFindData);
  10233. Data.ErrorPosEl:=ErrorPosEl;
  10234. IterateElements(AName,@OnFindFirstElement,@Data,Abort);
  10235. Result:=Data.Found;
  10236. if Result=nil then
  10237. begin
  10238. if (ErrorPosEl=nil) and (LastElement<>nil)
  10239. and (LastElement.ClassType=TPasClassOfType)
  10240. and (TPasClassOfType(LastElement).DestType=nil) then
  10241. begin
  10242. // 'class of' of a not yet defined class
  10243. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  10244. CurrentParser.CurSourcePos);
  10245. exit;
  10246. end;
  10247. RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
  10248. end;
  10249. if NoProcsWithArgs and (Result is TPasProcedure)
  10250. and ProcNeedsParams(TPasProcedure(Result).ProcType)
  10251. then
  10252. // proc needs parameters
  10253. RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
  10254. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
  10255. end;
  10256. procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  10257. // Input: El is TPasUsesUnit
  10258. // Output: El is either a TPasUsesUnit or the root module
  10259. var
  10260. CurUsesUnit: TPasUsesUnit;
  10261. BestEl: TPasElement;
  10262. aName, CurName: String;
  10263. Clause: TPasUsesClause;
  10264. i: Integer;
  10265. Section: TPasSection;
  10266. begin
  10267. {$IFDEF VerbosePasResolver}
  10268. //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
  10269. {$ENDIF}
  10270. if not (El is TPasUsesUnit) then
  10271. RaiseInternalError(20170503000945);
  10272. aName:=GetNameExprValue(Expr);
  10273. if aName='' then
  10274. RaiseNotYetImplemented(20170503110217,Expr);
  10275. repeat
  10276. Expr:=GetNextDottedExpr(Expr);
  10277. if Expr=nil then break;
  10278. CurName:=GetNameExprValue(Expr);
  10279. if CurName='' then
  10280. RaiseNotYetImplemented(20170502164242,Expr);
  10281. aName:=aName+'.'+CurName;
  10282. until false;
  10283. {$IFDEF VerbosePasResolver}
  10284. //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
  10285. {$ENDIF}
  10286. // search in uses clause
  10287. BestEl:=nil;
  10288. Section:=TPasUsesUnit(El).Parent as TPasSection;
  10289. repeat
  10290. Clause:=Section.UsesClause;
  10291. for i:=0 to length(Clause)-1 do
  10292. begin
  10293. CurUsesUnit:=Clause[i];
  10294. CurName:=CurUsesUnit.Name;
  10295. if IsDottedIdentifierPrefix(CurName,aName)
  10296. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  10297. BestEl:=CurUsesUnit; // a better match
  10298. end;
  10299. if Section is TImplementationSection then
  10300. begin
  10301. // search in interface uses clause too
  10302. Section:=(Section.Parent as TPasModule).InterfaceSection;
  10303. end
  10304. else
  10305. break;
  10306. until Section=nil;
  10307. {$IFDEF VerbosePasResolver}
  10308. //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
  10309. {$ENDIF}
  10310. // check module name
  10311. CurName:=El.GetModule.Name;
  10312. if IsDottedIdentifierPrefix(CurName,aName)
  10313. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  10314. BestEl:=El.GetModule; // a better match
  10315. if BestEl=nil then
  10316. begin
  10317. // no dotted module name fits the expression
  10318. RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
  10319. end;
  10320. El:=BestEl;
  10321. {$IFDEF VerbosePasResolver}
  10322. //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
  10323. {$ENDIF}
  10324. end;
  10325. procedure TPasResolver.IterateElements(const aName: string;
  10326. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  10327. var Abort: boolean);
  10328. var
  10329. i: Integer;
  10330. Scope: TPasScope;
  10331. begin
  10332. for i:=FScopeCount-1 downto 0 do
  10333. begin
  10334. Scope:=Scopes[i];
  10335. Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
  10336. if Abort then
  10337. exit;
  10338. if Scope is TPasSubScope then break;
  10339. end;
  10340. end;
  10341. procedure TPasResolver.CheckFoundElement(
  10342. const FindData: TPRFindData; Ref: TResolvedReference);
  10343. // check visibility rules
  10344. // Call this method after finding an element by searching the scopes.
  10345. var
  10346. Proc: TPasProcedure;
  10347. Context: TPasElement;
  10348. FoundContext: TPasClassType;
  10349. StartScope: TPasScope;
  10350. OnlyTypeMembers: Boolean;
  10351. TypeEl: TPasType;
  10352. C: TClass;
  10353. ClassScope: TPasClassScope;
  10354. i: Integer;
  10355. begin
  10356. StartScope:=FindData.StartScope;
  10357. OnlyTypeMembers:=false;
  10358. if StartScope is TPasDotIdentifierScope then
  10359. begin
  10360. if Ref=nil then
  10361. begin
  10362. {$IFDEF VerbosePasResolver}
  10363. writeln('TPasResolver.CheckFoundElement FindData.Found=',GetObjName(FindData.Found),' StartScope=',GetObjName(StartScope));
  10364. {$ENDIF}
  10365. RaiseNotYetImplemented(20171225110626,FindData.ErrorPosEl);
  10366. end;
  10367. OnlyTypeMembers:=TPasDotIdentifierScope(StartScope).OnlyTypeMembers;
  10368. Include(Ref.Flags,rrfDotScope);
  10369. if TPasDotIdentifierScope(StartScope).ConstParent then
  10370. Include(Ref.Flags,rrfConstInherited);
  10371. end
  10372. else if StartScope.ClassType=ScopeClass_WithExpr then
  10373. begin
  10374. OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
  10375. Include(Ref.Flags,rrfDotScope);
  10376. if wesfConstParent in TPasWithExprScope(StartScope).Flags then
  10377. Include(Ref.Flags,rrfConstInherited);
  10378. end
  10379. else if StartScope.ClassType=FScopeClass_Proc then
  10380. begin
  10381. Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
  10382. //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
  10383. if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
  10384. OnlyTypeMembers:=true;
  10385. end;
  10386. //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
  10387. // ' StartIsDot=',StartScope is TPasDotIdentifierScope,
  10388. // ' OnlyTypeMembers=',(StartScope is TPasDotIdentifierScope)
  10389. // and TPasDotIdentifierScope(StartScope).OnlyTypeMembers,
  10390. // ' FindData.Found=',GetObjName(FindData.Found));
  10391. if OnlyTypeMembers then
  10392. begin
  10393. //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
  10394. // and (vmClass in TPasVariable(FindData.Found).VarModifiers));
  10395. // only class vars/procs allowed
  10396. if (FindData.Found.ClassType=TPasConstructor) then
  10397. // constructor: ok
  10398. else if IsClassMethod(FindData.Found)
  10399. then
  10400. // class proc: ok
  10401. else if (FindData.Found is TPasVariable)
  10402. and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
  10403. // class var/const/property: ok
  10404. else
  10405. begin
  10406. RaiseMsg(20170216152348,nCannotAccessThisMemberFromAX,
  10407. sCannotAccessThisMemberFromAX,[FindData.Found.Parent.ElementTypeName],FindData.ErrorPosEl);
  10408. end;
  10409. end
  10410. else if (proExtClassInstanceNoTypeMembers in Options)
  10411. and (StartScope.ClassType=TPasDotClassScope)
  10412. and TPasClassType(TPasDotClassScope(StartScope).ClassScope.Element).IsExternal then
  10413. begin
  10414. // found member in external class instance
  10415. C:=FindData.Found.ClassType;
  10416. if (C=TPasProcedure) or (C=TPasFunction) then
  10417. // ok
  10418. else if C.InheritsFrom(TPasVariable)
  10419. and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
  10420. // ok
  10421. else
  10422. begin
  10423. RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
  10424. sExternalClassInstanceCannotAccessStaticX,
  10425. [FindData.Found.ElementTypeName+' '+FindData.Found.Name],
  10426. FindData.ErrorPosEl);
  10427. end;
  10428. end;
  10429. if (FindData.Found is TPasProcedure) then
  10430. begin
  10431. Proc:=TPasProcedure(FindData.Found);
  10432. if Proc.IsVirtual or Proc.IsOverride then
  10433. begin
  10434. if (StartScope.ClassType=TPasDotClassScope)
  10435. and TPasDotClassScope(StartScope).InheritedExpr then
  10436. begin
  10437. // call directly
  10438. if Proc.IsAbstract then
  10439. RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
  10440. sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
  10441. end
  10442. else
  10443. begin
  10444. // call via virtual method table
  10445. if Ref<>nil then
  10446. Ref.Flags:=Ref.Flags+[rrfVMT];
  10447. end;
  10448. end;
  10449. // constructor: NewInstance or normal call
  10450. // it is a NewInstance iff the scope is a class, e.g. TObject.Create
  10451. if (Proc.ClassType=TPasConstructor)
  10452. and OnlyTypeMembers
  10453. and (Ref<>nil) then
  10454. begin
  10455. Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
  10456. // store the class in Ref.Context
  10457. if Ref.Context<>nil then
  10458. RaiseInternalError(20170131141936);
  10459. Ref.Context:=TResolvedRefCtxConstructor.Create;
  10460. if StartScope is TPasDotClassScope then
  10461. ClassScope:=TPasDotClassScope(StartScope).ClassScope
  10462. else if (StartScope is TPasWithExprScope)
  10463. and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
  10464. ClassScope:=TPasClassScope(TPasWithExprScope(StartScope).Scope)
  10465. else if (StartScope is TPasProcedureScope) then
  10466. ClassScope:=TPasProcedureScope(StartScope).ClassScope
  10467. else
  10468. RaiseInternalError(20170131150855,GetObjName(StartScope));
  10469. TypeEl:=ClassScope.Element as TPasType;
  10470. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
  10471. if length(ClassScope.AbstractProcs)>0 then
  10472. begin
  10473. for i:=0 to length(ClassScope.AbstractProcs)-1 do
  10474. LogMsg(20171227110746,mtNote,nConstructingClassXWithAbstractMethodY,
  10475. sConstructingClassXWithAbstractMethodY,
  10476. [TypeEl.Name,ClassScope.AbstractProcs[i].Name],FindData.ErrorPosEl);
  10477. end;
  10478. end;
  10479. {$IFDEF VerbosePasResolver}
  10480. if (Proc.ClassType=TPasConstructor) then
  10481. begin
  10482. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  10483. if Ref=nil then
  10484. write(' no ref!')
  10485. else
  10486. begin
  10487. write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
  10488. ' StartScope=',GetObjName(StartScope),
  10489. ' OnlyTypeMembers=',OnlyTypeMembers);
  10490. end;
  10491. writeln;
  10492. end;
  10493. {$ENDIF}
  10494. // destructor: FreeInstance or normal call
  10495. // it is a normal call if 'inherited'
  10496. if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
  10497. if ((StartScope.ClassType<>TPasDotClassScope)
  10498. or (not TPasDotClassScope(StartScope).InheritedExpr)) then
  10499. Ref.Flags:=Ref.Flags+[rrfFreeInstance];
  10500. {$IFDEF VerbosePasResolver}
  10501. if (Proc.ClassType=TPasDestructor) then
  10502. begin
  10503. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  10504. if Ref=nil then
  10505. write(' no ref!')
  10506. else
  10507. begin
  10508. write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
  10509. ' StartScope=',GetObjName(StartScope));
  10510. if StartScope.ClassType=TPasDotClassScope then
  10511. write(' InheritedExpr=',TPasDotClassScope(StartScope).InheritedExpr);
  10512. end;
  10513. writeln;
  10514. end;
  10515. {$ENDIF}
  10516. end;
  10517. // check class visibility
  10518. if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
  10519. begin
  10520. Context:=GetVisibilityContext;
  10521. FoundContext:=FindData.Found.Parent as TPasClassType;
  10522. case FindData.Found.Visibility of
  10523. visPrivate:
  10524. // private members can only be accessed in same module
  10525. if FoundContext.GetModule<>Context.GetModule then
  10526. RaiseMsg(20170216152354,nCantAccessPrivateMember,sCantAccessPrivateMember,
  10527. ['private',FindData.Found.Name],FindData.ErrorPosEl);
  10528. visProtected:
  10529. // protected members can only be accessed in same module
  10530. // or modules of descendant classes
  10531. if FoundContext.GetModule=Context.GetModule then
  10532. // same module -> ok
  10533. else if (Context is TPasType)
  10534. and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
  10535. // context in class or descendant
  10536. else if (TopScope is TPasDotClassScope)
  10537. and (TPasDotClassScope(TopScope).ClassScope.Element.GetModule=Context.GetModule) then
  10538. // e.g. aClassInThisModule.identifier
  10539. else if (TopScope is TPasWithExprScope)
  10540. and (TPasWithExprScope(TopScope).Scope is TPasClassScope)
  10541. and (TPasClassScope(TPasWithExprScope(TopScope).Scope).Element.GetModule=Context.GetModule) then
  10542. // e.g. with aClassInThisModule do identifier
  10543. else
  10544. RaiseMsg(20170216152356,nCantAccessPrivateMember,sCantAccessPrivateMember,
  10545. ['protected',FindData.Found.Name],FindData.ErrorPosEl);
  10546. visStrictPrivate:
  10547. // strict private members can only be accessed in their class
  10548. if Context<>FoundContext then
  10549. RaiseMsg(20170216152357,nCantAccessPrivateMember,sCantAccessPrivateMember,
  10550. ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
  10551. visStrictProtected:
  10552. // strict protected members can only be accessed in their and descendant classes
  10553. if (Context is TPasType)
  10554. and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
  10555. // context in class or descendant
  10556. else
  10557. RaiseMsg(20170216152400,nCantAccessPrivateMember,sCantAccessPrivateMember,
  10558. ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
  10559. end;
  10560. end;
  10561. end;
  10562. function TPasResolver.GetVisibilityContext: TPasElement;
  10563. var
  10564. i: Integer;
  10565. begin
  10566. for i:=ScopeCount-1 downto 0 do
  10567. begin
  10568. Result:=Scopes[i].VisibilityContext;
  10569. if Result<>nil then exit;
  10570. end;
  10571. Result:=nil;
  10572. end;
  10573. procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
  10574. begin
  10575. if IsElementSkipped(El) then exit;
  10576. case ScopeType of
  10577. stModule: FinishModule(El as TPasModule);
  10578. stUsesClause: FinishUsesClause;
  10579. stTypeSection: FinishTypeSection(El as TPasDeclarations);
  10580. stTypeDef: FinishTypeDef(El as TPasType);
  10581. stConstDef: FinishConstDef(El as TPasConst);
  10582. stResourceString: FinishResourcestring(El as TPasResString);
  10583. stProcedure: FinishProcedure(El as TPasProcedure);
  10584. stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
  10585. stExceptOnExpr: FinishExceptOnExpr;
  10586. stExceptOnStatement: FinishExceptOnStatement;
  10587. stDeclaration: FinishDeclaration(El);
  10588. stAncestors: FinishAncestors(El as TPasClassType);
  10589. else
  10590. RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
  10591. end;
  10592. end;
  10593. function TPasResolver.IsUnitIntfFinished(AModule: TPasModule): boolean;
  10594. var
  10595. CurIntf: TInterfaceSection;
  10596. begin
  10597. CurIntf:=AModule.InterfaceSection;
  10598. Result:=(CurIntf<>nil)
  10599. and (CurIntf.CustomData is TPasSectionScope)
  10600. and TPasSectionScope(CurIntf.CustomData).Finished;
  10601. end;
  10602. function TPasResolver.GetPendingUsedInterface(Section: TPasSection
  10603. ): TPasUsesUnit;
  10604. var
  10605. i: Integer;
  10606. UseUnit: TPasUsesUnit;
  10607. begin
  10608. Result:=nil;
  10609. if not (Section is TImplementationSection) then exit;
  10610. for i:=0 to length(Section.UsesClause)-1 do
  10611. begin
  10612. UseUnit:=Section.UsesClause[i];
  10613. if not (UseUnit.Module is TPasModule) then continue;
  10614. if not IsUnitIntfFinished(TPasModule(UseUnit.Module)) then
  10615. exit(UseUnit);
  10616. end;
  10617. end;
  10618. procedure TPasResolver.CheckPendingUsedInterface(Section: TPasSection);
  10619. var
  10620. PendingModule: TPasModule;
  10621. PendingModuleScope: TPasModuleScope;
  10622. List: TFPList;
  10623. WasPending: Boolean;
  10624. begin
  10625. {$IFDEF VerbosePasResolver}
  10626. //writeln('TPasResolver.CheckPendingUsedInterface START "',CurrentParser.CurModule.Name,'"');
  10627. {$ENDIF}
  10628. WasPending:=Section.PendingUsedIntf<>nil;
  10629. if WasPending then
  10630. begin
  10631. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  10632. if not IsUnitIntfFinished(PendingModule) then
  10633. exit; // still pending
  10634. // other unit interface is finished
  10635. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  10636. PendingModuleScope.PendingResolvers.Remove(Self);
  10637. Section.PendingUsedIntf:=nil;
  10638. end;
  10639. Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
  10640. if Section.PendingUsedIntf<>nil then
  10641. begin
  10642. // unit not yet finished due to pending used interfaces
  10643. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  10644. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  10645. {$IFDEF VerbosePasResolver}
  10646. writeln('TPasResolver.CheckPendingUsedInterface "',CurrentParser.CurModule.Name,'" waiting for unit intf of "',PendingModule.Name,'"');
  10647. {$ENDIF}
  10648. List:=PendingModuleScope.PendingResolvers;
  10649. if List.IndexOf(Self)<0 then
  10650. List.Add(Self);
  10651. end
  10652. else
  10653. begin
  10654. if WasPending then
  10655. // can now continue parsing
  10656. ContinueParsing;
  10657. end;
  10658. end;
  10659. procedure TPasResolver.ContinueParsing;
  10660. // if there is a unit cycle that stopped parsing this unit
  10661. // this method is called after the needed used unit interfaces have finished
  10662. begin
  10663. {$IFDEF VerbosePasResolver}
  10664. writeln('TPasResolver.ContinueParsing "',CurrentParser.CurModule.Name,'"...');
  10665. {$ENDIF}
  10666. CurrentParser.ParseContinueImplementation;
  10667. end;
  10668. function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
  10669. // called by the parser when reading DoParseConstValueExpression
  10670. var
  10671. C: TClass;
  10672. V: TPasVariable;
  10673. TypeEl: TPasType;
  10674. begin
  10675. Result:=false;
  10676. if El=nil then exit;
  10677. C:=El.ClassType;
  10678. if (C=TPasConst) or (C=TPasVariable) then
  10679. begin
  10680. V:=TPasVariable(El);
  10681. if V.VarType=nil then exit;
  10682. TypeEl:=ResolveAliasType(V.VarType);
  10683. Result:=TypeEl.ClassType=TPasArrayType;
  10684. end;
  10685. //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
  10686. end;
  10687. function TPasResolver.GetDefaultClassVisibility(AClass: TPasClassType
  10688. ): TPasMemberVisibility;
  10689. var
  10690. ClassScope: TPasClassScope;
  10691. begin
  10692. if AClass.CustomData=nil then
  10693. exit(visDefault);
  10694. ClassScope:=(AClass.CustomData as TPasClassScope);
  10695. if pcsfPublished in ClassScope.Flags then
  10696. Result:=visPublished
  10697. else
  10698. Result:=visPublic;
  10699. end;
  10700. class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
  10701. Line, Column: integer);
  10702. begin
  10703. Line:=Linenumber;
  10704. Column:=0;
  10705. if Line<0 then begin
  10706. Line:=-Line;
  10707. Column:=Line mod ParserMaxEmbeddedColumn;
  10708. Line:=Line div ParserMaxEmbeddedColumn;
  10709. end;
  10710. end;
  10711. class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
  10712. var
  10713. Line, Column: integer;
  10714. begin
  10715. if El=nil then exit('nil');
  10716. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  10717. Result:=El.SourceFilename+'('+IntToStr(Line);
  10718. if Column>0 then
  10719. Result:=Result+','+IntToStr(Column);
  10720. Result:=Result+')';
  10721. end;
  10722. function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
  10723. var
  10724. Line, Column: integer;
  10725. begin
  10726. if El=nil then exit('nil');
  10727. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  10728. Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
  10729. if Column>0 then
  10730. Result:=Result+','+IntToStr(Column);
  10731. Result:=Result+')';
  10732. end;
  10733. destructor TPasResolver.Destroy;
  10734. begin
  10735. {$IFDEF VerbosePasResolverMem}
  10736. writeln('TPasResolver.Destroy START ',ClassName);
  10737. {$ENDIF}
  10738. Clear;
  10739. {$IFDEF VerbosePasResolverMem}
  10740. writeln('TPasResolver.Destroy PopScope...');
  10741. {$ENDIF}
  10742. PopScope; // free default scope
  10743. {$IFDEF VerbosePasResolverMem}
  10744. writeln('TPasResolver.Destroy FPendingForwards...');
  10745. {$ENDIF}
  10746. FreeAndNil(FPendingForwardProcs);
  10747. FreeAndNil(fExprEvaluator);
  10748. inherited Destroy;
  10749. {$IFDEF VerbosePasResolverMem}
  10750. writeln('TPasResolver.Destroy END ',ClassName);
  10751. {$ENDIF}
  10752. end;
  10753. procedure TPasResolver.Clear;
  10754. begin
  10755. RestoreSubScopes(0);
  10756. // clear stack, keep DefaultScope
  10757. while (FScopeCount>0) and (FTopScope<>DefaultScope) do
  10758. PopScope;
  10759. ClearResolveDataList(lkModule);
  10760. end;
  10761. procedure TPasResolver.ClearBuiltInIdentifiers;
  10762. var
  10763. bt: TResolverBaseType;
  10764. begin
  10765. ClearResolveDataList(lkBuiltIn);
  10766. for bt in TResolverBaseType do
  10767. FBaseTypes[bt]:=nil;
  10768. end;
  10769. procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
  10770. const TheBaseTypes: TResolveBaseTypes;
  10771. const TheBaseProcs: TResolverBuiltInProcs);
  10772. var
  10773. bt: TResolverBaseType;
  10774. begin
  10775. for bt in TheBaseTypes do
  10776. AddBaseType(BaseTypeNames[bt],bt);
  10777. if bfLength in TheBaseProcs then
  10778. AddBuiltInProc('Length','function Length(const String or Array): sizeint',
  10779. @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
  10780. @BI_Length_OnEval,nil,bfLength);
  10781. if bfSetLength in TheBaseProcs then
  10782. AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
  10783. @BI_SetLength_OnGetCallCompatibility,nil,nil,
  10784. @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
  10785. if bfInclude in TheBaseProcs then
  10786. AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
  10787. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  10788. @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
  10789. if bfExclude in TheBaseProcs then
  10790. AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
  10791. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  10792. @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
  10793. if bfBreak in TheBaseProcs then
  10794. AddBuiltInProc('Break','procedure Break',
  10795. @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
  10796. if bfContinue in TheBaseProcs then
  10797. AddBuiltInProc('Continue','procedure Continue',
  10798. @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
  10799. if bfExit in TheBaseProcs then
  10800. AddBuiltInProc('Exit','procedure Exit(result)',
  10801. @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
  10802. if bfInc in TheBaseProcs then
  10803. AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
  10804. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  10805. @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
  10806. if bfDec in TheBaseProcs then
  10807. AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
  10808. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  10809. @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
  10810. if bfAssigned in TheBaseProcs then
  10811. AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
  10812. @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
  10813. nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
  10814. if bfChr in TheBaseProcs then
  10815. AddBuiltInProc('Chr','function Chr(const Integer): char',
  10816. @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,nil,nil,bfChr);
  10817. if bfOrd in TheBaseProcs then
  10818. AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
  10819. @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
  10820. @BI_Ord_OnEval,nil,bfOrd);
  10821. if bfLow in TheBaseProcs then
  10822. AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
  10823. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  10824. @BI_LowHigh_OnEval,nil,bfLow);
  10825. if bfHigh in TheBaseProcs then
  10826. AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
  10827. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  10828. @BI_LowHigh_OnEval,nil,bfHigh);
  10829. if bfPred in TheBaseProcs then
  10830. AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
  10831. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  10832. @BI_PredSucc_OnEval,nil,bfPred);
  10833. if bfSucc in TheBaseProcs then
  10834. AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
  10835. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  10836. @BI_PredSucc_OnEval,nil,bfSucc);
  10837. if bfStrProc in TheBaseProcs then
  10838. AddBuiltInProc('Str','procedure Str(const var; var String)',
  10839. @BI_StrProc_OnGetCallCompatibility,nil,nil,
  10840. @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
  10841. if bfStrFunc in TheBaseProcs then
  10842. AddBuiltInProc('Str','function Str(const var): String',
  10843. @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
  10844. @BI_StrFunc_OnEval,nil,bfStrFunc);
  10845. if bfConcatArray in TheBaseProcs then
  10846. AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
  10847. @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
  10848. nil,nil,bfConcatArray);
  10849. if bfCopyArray in TheBaseProcs then
  10850. AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
  10851. @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
  10852. nil,nil,bfCopyArray);
  10853. if bfInsertArray in TheBaseProcs then
  10854. AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
  10855. @BI_InsertArray_OnGetCallCompatibility,nil,nil,
  10856. @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
  10857. if bfDeleteArray in TheBaseProcs then
  10858. AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
  10859. @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
  10860. @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
  10861. if bfTypeInfo in TheBaseProcs then
  10862. AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
  10863. @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
  10864. nil,nil,bfTypeInfo);
  10865. if bfAssert in TheBaseProcs then
  10866. AddBuiltInProc('Assert','procedure Assert(bool[,string])',
  10867. @BI_Assert_OnGetCallCompatibility,nil,nil,
  10868. @BI_Assert_OnFinishParamsExpr,bfAssert,[bipfCanBeStatement]);
  10869. end;
  10870. function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
  10871. ): TResElDataBaseType;
  10872. var
  10873. El: TPasUnresolvedSymbolRef;
  10874. begin
  10875. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  10876. if not (Typ in [btNone,btCustom]) then
  10877. FBaseTypes[Typ]:=El;
  10878. Result:=TResElDataBaseType.Create;
  10879. Result.BaseType:=Typ;
  10880. AddResolveData(El,Result,lkBuiltIn);
  10881. FDefaultScope.AddIdentifier(aName,El,pikBaseType);
  10882. end;
  10883. function TPasResolver.AddCustomBaseType(const aName: string;
  10884. aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  10885. var
  10886. CustomData: TResElDataBaseType;
  10887. begin
  10888. Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
  10889. CustomData:=aClass.Create;
  10890. CustomData.BaseType:=btCustom;
  10891. AddResolveData(Result,CustomData,lkBuiltIn);
  10892. FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
  10893. end;
  10894. function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
  10895. ResolveAlias: boolean): boolean;
  10896. begin
  10897. Result:=false;
  10898. if aType=nil then exit;
  10899. if ResolveAlias then
  10900. aType:=ResolveAliasType(aType);
  10901. if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
  10902. Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
  10903. end;
  10904. function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
  10905. const GetCallCompatibility: TOnGetCallCompatibility;
  10906. const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
  10907. const FinishParamsExpr: TOnFinishParamsExpr;
  10908. const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
  10909. ): TResElDataBuiltInProc;
  10910. var
  10911. El: TPasUnresolvedSymbolRef;
  10912. begin
  10913. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  10914. Result:=TResElDataBuiltInProc.Create;
  10915. Result.Proc:=El;
  10916. Result.Signature:=Signature;
  10917. Result.BuiltIn:=BuiltIn;
  10918. Result.GetCallCompatibility:=GetCallCompatibility;
  10919. Result.GetCallResult:=GetCallResult;
  10920. Result.Eval:=EvalConst;
  10921. Result.FinishParamsExpression:=FinishParamsExpr;
  10922. Result.Flags:=Flags;
  10923. AddResolveData(El,Result,lkBuiltIn);
  10924. FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
  10925. end;
  10926. procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
  10927. Kind: TResolveDataListKind);
  10928. begin
  10929. if Data.Element<>nil then
  10930. RaiseInternalError(20171111162227);
  10931. if El.CustomData<>nil then
  10932. RaiseInternalError(20171111162236);
  10933. Data.Element:=El;
  10934. Data.Owner:=Self;
  10935. Data.Next:=FLastCreatedData[Kind];
  10936. FLastCreatedData[Kind]:=Data;
  10937. El.CustomData:=Data;
  10938. end;
  10939. function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
  10940. Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
  10941. procedure RaiseAlreadySet;
  10942. var
  10943. FormerDeclEl: TPasElement;
  10944. begin
  10945. writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  10946. writeln(' RefEl at ',GetElementSourcePosStr(RefEl));
  10947. writeln(' RefEl.CustomData=',GetObjName(RefEl.CustomData));
  10948. if RefEl.CustomData is TResolvedReference then
  10949. begin
  10950. FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
  10951. writeln(' TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
  10952. ' IsSame=',FormerDeclEl=DeclEl);
  10953. end;
  10954. RaiseInternalError(20160922163554,'customdata<>nil');
  10955. end;
  10956. begin
  10957. if RefEl.CustomData<>nil then
  10958. RaiseAlreadySet;
  10959. {$IFDEF VerbosePasResolver}
  10960. writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  10961. {$ENDIF}
  10962. Result:=TResolvedReference.Create;
  10963. if FindData<>nil then
  10964. begin
  10965. if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
  10966. Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
  10967. end;
  10968. AddResolveData(RefEl,Result,lkModule);
  10969. Result.Declaration:=DeclEl;
  10970. if RefEl is TPasExpr then
  10971. SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
  10972. EmitElementHints(RefEl,DeclEl);
  10973. end;
  10974. function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
  10975. ): TPasScope;
  10976. begin
  10977. if not ScopeClass.IsStoredInElement then
  10978. RaiseInternalError(20160923121858);
  10979. if El.CustomData<>nil then
  10980. RaiseInternalError(20160923121849);
  10981. {$IFDEF VerbosePasResolver}
  10982. writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
  10983. {$ENDIF}
  10984. Result:=ScopeClass.Create;
  10985. if Result.FreeOnPop then
  10986. begin
  10987. Result.Element:=El;
  10988. El.CustomData:=Result;
  10989. Result.Owner:=Self;
  10990. end
  10991. else
  10992. // add to free list
  10993. AddResolveData(El,Result,lkModule);
  10994. end;
  10995. procedure TPasResolver.PopScope;
  10996. var
  10997. Scope: TPasScope;
  10998. begin
  10999. if FScopeCount=0 then
  11000. RaiseInternalError(20160922163557);
  11001. {$IFDEF VerbosePasResolver}
  11002. //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
  11003. writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
  11004. {$ENDIF}
  11005. dec(FScopeCount);
  11006. if FTopScope.FreeOnPop then
  11007. begin
  11008. Scope:=FScopes[FScopeCount];
  11009. if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
  11010. Scope.Element.CustomData:=nil;
  11011. if Scope=FDefaultScope then
  11012. FDefaultScope:=nil;
  11013. FScopes[FScopeCount]:=nil;
  11014. Scope.Free;
  11015. end;
  11016. if FScopeCount>0 then
  11017. FTopScope:=FScopes[FScopeCount-1]
  11018. else
  11019. FTopScope:=nil;
  11020. end;
  11021. procedure TPasResolver.PushScope(Scope: TPasScope);
  11022. begin
  11023. if Scope=nil then
  11024. RaiseInternalError(20160922163601);
  11025. if length(FScopes)=FScopeCount then
  11026. SetLength(FScopes,FScopeCount*2+10);
  11027. FScopes[FScopeCount]:=Scope;
  11028. inc(FScopeCount);
  11029. FTopScope:=Scope;
  11030. {$IFDEF VerbosePasResolver}
  11031. writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
  11032. {$ENDIF}
  11033. end;
  11034. function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
  11035. ): TPasScope;
  11036. begin
  11037. Result:=CreateScope(El,ScopeClass);
  11038. PushScope(Result);
  11039. end;
  11040. function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  11041. begin
  11042. Result:=TPasModuleDotScope.Create;
  11043. Result.Owner:=Self;
  11044. Result.Module:=aModule;
  11045. if aModule is TPasProgram then
  11046. begin // program
  11047. if TPasProgram(aModule).ProgramSection<>nil then
  11048. Result.InterfaceScope:=
  11049. NoNil(TPasProgram(aModule).ProgramSection.CustomData) as TPasSectionScope;
  11050. end
  11051. else if aModule is TPasLibrary then
  11052. begin // library
  11053. if TPasLibrary(aModule).LibrarySection<>nil then
  11054. Result.InterfaceScope:=
  11055. NoNil(TPasLibrary(aModule).LibrarySection.CustomData) as TPasSectionScope;
  11056. end
  11057. else
  11058. begin // unit
  11059. if aModule.InterfaceSection<>nil then
  11060. Result.InterfaceScope:=
  11061. NoNil(aModule.InterfaceSection.CustomData) as TPasSectionScope;
  11062. if (aModule=CurrentParser.CurModule)
  11063. and (aModule.ImplementationSection<>nil)
  11064. and (aModule.ImplementationSection.CustomData<>nil)
  11065. then
  11066. Result.ImplementationScope:=NoNil(aModule.ImplementationSection.CustomData) as TPasSectionScope;
  11067. if CompareText(aModule.Name,'system')=0 then
  11068. Result.SystemScope:=DefaultScope;
  11069. end;
  11070. PushScope(Result);
  11071. end;
  11072. function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType
  11073. ): TPasDotClassScope;
  11074. var
  11075. ClassScope: TPasClassScope;
  11076. Ref: TResolvedReference;
  11077. begin
  11078. if CurClassType.IsForward then
  11079. begin
  11080. Ref:=CurClassType.CustomData as TResolvedReference;
  11081. CurClassType:=Ref.Declaration as TPasClassType;
  11082. end;
  11083. if CurClassType.CustomData=nil then
  11084. RaiseInternalError(20160922163611);
  11085. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  11086. Result:=TPasDotClassScope.Create;
  11087. Result.Owner:=Self;
  11088. Result.ClassScope:=ClassScope;
  11089. PushScope(Result);
  11090. end;
  11091. function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType
  11092. ): TPasDotRecordScope;
  11093. var
  11094. RecScope: TPasRecordScope;
  11095. begin
  11096. RecScope:=NoNil(CurRecordType.CustomData) as TPasRecordScope;
  11097. Result:=TPasDotRecordScope.Create;
  11098. Result.Owner:=Self;
  11099. Result.IdentifierScope:=RecScope;
  11100. PushScope(Result);
  11101. end;
  11102. function TPasResolver.PushEnumDotScope(CurEnumType: TPasEnumType
  11103. ): TPasDotEnumTypeScope;
  11104. var
  11105. EnumScope: TPasEnumTypeScope;
  11106. begin
  11107. EnumScope:=NoNil(CurEnumType.CustomData) as TPasEnumTypeScope;
  11108. Result:=TPasDotEnumTypeScope.Create;
  11109. Result.Owner:=Self;
  11110. Result.IdentifierScope:=EnumScope;
  11111. PushScope(Result);
  11112. end;
  11113. procedure TPasResolver.ResetSubScopes(out Depth: integer);
  11114. // move all sub scopes from Scopes to SubScopes
  11115. begin
  11116. Depth:=FSubScopeCount;
  11117. while TopScope is TPasSubScope do
  11118. begin
  11119. {$IFDEF VerbosePasResolver}
  11120. writeln('TPasResolver.ResetSubScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
  11121. {$ENDIF}
  11122. if FSubScopeCount=length(FSubScopes) then
  11123. SetLength(FSubScopes,FSubScopeCount+4);
  11124. FSubScopes[FSubScopeCount]:=TopScope;
  11125. inc(FSubScopeCount);
  11126. dec(FScopeCount);
  11127. FScopes[FScopeCount]:=nil;
  11128. if FScopeCount>0 then
  11129. FTopScope:=FScopes[FScopeCount-1]
  11130. else
  11131. FTopScope:=nil;
  11132. end;
  11133. end;
  11134. procedure TPasResolver.RestoreSubScopes(Depth: integer);
  11135. // restore sub scopes
  11136. begin
  11137. while FSubScopeCount>Depth do
  11138. begin
  11139. {$IFDEF VerbosePasResolver}
  11140. writeln('TPasResolver.RestoreSubScopes moving ',FSubScopes[FSubScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
  11141. {$ENDIF}
  11142. if FScopeCount=length(FScopes) then
  11143. SetLength(FScopes,FScopeCount+4);
  11144. dec(FSubScopeCount);
  11145. FScopes[FScopeCount]:=FSubScopes[FSubScopeCount];
  11146. FTopScope:=FScopes[FScopeCount];
  11147. FSubScopes[FSubScopeCount]:=nil;
  11148. inc(FScopeCount);
  11149. end;
  11150. end;
  11151. function TPasResolver.GetInheritedExprScope(ErrorEl: TPasElement
  11152. ): TPasProcedureScope;
  11153. var
  11154. Scope: TPasScope;
  11155. i: Integer;
  11156. begin
  11157. i:=ScopeCount;
  11158. repeat
  11159. dec(i);
  11160. if i<0 then
  11161. RaiseMsg(20171006001229,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  11162. Scope:=Scopes[i];
  11163. if Scope is TPasProcedureScope then
  11164. exit(TPasProcedureScope(Scope));
  11165. until false;
  11166. end;
  11167. procedure TPasResolver.SetLastMsg(const id: int64; MsgType: TMessageType;
  11168. MsgNumber: integer; const Fmt: String; Args: array of const;
  11169. PosEl: TPasElement);
  11170. var
  11171. {$IFDEF VerbosePasResolver}
  11172. s: string;
  11173. {$ENDIF}
  11174. Column, Row: integer;
  11175. begin
  11176. FLastMsgId := id;
  11177. FLastMsgType := MsgType;
  11178. FLastMsgNumber := MsgNumber;
  11179. FLastMsgPattern := Fmt;
  11180. FLastMsg := SafeFormat(Fmt,Args);
  11181. FLastElement := PosEl;
  11182. if PosEl=nil then
  11183. FLastSourcePos:=CurrentParser.CurSourcePos
  11184. else
  11185. begin
  11186. FLastSourcePos.FileName:=PosEl.SourceFilename;
  11187. UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
  11188. if Row>=0 then
  11189. FLastSourcePos.Row:=Row
  11190. else
  11191. FLastSourcePos.Row:=0;
  11192. if Column>=0 then
  11193. FLastSourcePos.Column:=Column
  11194. else
  11195. FLastSourcePos.Column:=0;
  11196. end;
  11197. CreateMsgArgs(FLastMsgArgs,Args);
  11198. {$IFDEF VerbosePasResolver}
  11199. write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
  11200. s:='';
  11201. str(MsgType,s);
  11202. write(s);
  11203. writeln(': [',MsgNumber,'] ',FLastMsg);
  11204. {$ENDIF}
  11205. end;
  11206. procedure TPasResolver.RaiseMsg(const Id: int64; MsgNumber: integer;
  11207. const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
  11208. var
  11209. E: EPasResolve;
  11210. begin
  11211. SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  11212. E:=EPasResolve.Create(FLastMsg);
  11213. E.Id:=Id;
  11214. E.MsgType:=mtError;
  11215. E.MsgNumber:=MsgNumber;
  11216. E.MsgPattern:=Fmt;
  11217. E.PasElement:=ErrorPosEl;
  11218. E.Args:=FLastMsgArgs;
  11219. E.SourcePos:=FLastSourcePos;
  11220. raise E;
  11221. end;
  11222. procedure TPasResolver.RaiseNotYetImplemented(id: int64; El: TPasElement;
  11223. Msg: string);
  11224. var
  11225. s: String;
  11226. begin
  11227. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  11228. if Msg<>'' then
  11229. s:=s+' '+Msg;
  11230. {$IFDEF VerbosePasResolver}
  11231. writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  11232. {$ENDIF}
  11233. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  11234. end;
  11235. procedure TPasResolver.RaiseInternalError(id: int64; const Msg: string);
  11236. begin
  11237. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  11238. end;
  11239. procedure TPasResolver.RaiseInvalidScopeForElement(id: int64; El: TPasElement;
  11240. const Msg: string);
  11241. var
  11242. i: Integer;
  11243. s: String;
  11244. begin
  11245. s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
  11246. for i:=0 to ScopeCount-1 do
  11247. begin
  11248. if i>0 then s:=s+',';
  11249. s:=s+Scopes[i].ClassName;
  11250. end;
  11251. if Msg<>'' then
  11252. s:=s+': '+Msg;
  11253. RaiseInternalError(id,s);
  11254. end;
  11255. procedure TPasResolver.RaiseIdentifierNotFound(id: int64; Identifier: string;
  11256. El: TPasElement);
  11257. begin
  11258. {$IFDEF VerbosePasResolver}
  11259. writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
  11260. WriteScopes;
  11261. {$ENDIF}
  11262. RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
  11263. end;
  11264. procedure TPasResolver.RaiseXExpectedButYFound(id: int64; const X, Y: string;
  11265. El: TPasElement);
  11266. begin
  11267. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
  11268. end;
  11269. procedure TPasResolver.RaiseContextXExpectedButYFound(id: int64; const C, X,
  11270. Y: string; El: TPasElement);
  11271. begin
  11272. RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
  11273. end;
  11274. procedure TPasResolver.RaiseContextXInvalidY(id: int64; const X, Y: string;
  11275. El: TPasElement);
  11276. begin
  11277. RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
  11278. end;
  11279. procedure TPasResolver.RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
  11280. begin
  11281. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  11282. end;
  11283. procedure TPasResolver.RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
  11284. begin
  11285. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  11286. end;
  11287. procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
  11288. const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  11289. function GetString(ArgNo: integer): string;
  11290. begin
  11291. if ArgNo>High(Args) then
  11292. exit('invalid param '+IntToStr(ArgNo));
  11293. case Args[ArgNo].VType of
  11294. vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
  11295. else
  11296. Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
  11297. end;
  11298. end;
  11299. begin
  11300. case MsgNumber of
  11301. nIllegalTypeConversionTo:
  11302. RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
  11303. nIncompatibleTypesGotExpected:
  11304. RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
  11305. nIncompatibleTypeArgNo:
  11306. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
  11307. nIncompatibleTypeArgNoVarParamMustMatchExactly:
  11308. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
  11309. [GetString(0),GotDesc,ExpDesc],ErrorEl);
  11310. nResultTypeMismatchExpectedButFound:
  11311. RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
  11312. nXExpectedButYFound:
  11313. RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
  11314. else
  11315. RaiseInternalError(20170329112911);
  11316. end;
  11317. end;
  11318. procedure TPasResolver.RaiseIncompatibleType(id: int64; MsgNumber: integer;
  11319. const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
  11320. var
  11321. DescA, DescB: String;
  11322. begin
  11323. DescA:=GetTypeDescription(GotType);
  11324. DescB:=GetTypeDescription(ExpType);
  11325. if DescA=DescB then
  11326. begin
  11327. DescA:=GetTypeDescription(GotType,true);
  11328. DescB:=GetTypeDescription(ExpType,true);
  11329. end;
  11330. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
  11331. end;
  11332. procedure TPasResolver.RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
  11333. const Args: array of const; const GotType, ExpType: TPasResolverResult;
  11334. ErrorEl: TPasElement);
  11335. var
  11336. GotDesc, ExpDesc: String;
  11337. begin
  11338. {$IFDEF VerbosePasResolver}
  11339. writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  11340. {$ENDIF}
  11341. if GotType.BaseType<>ExpType.BaseType then
  11342. begin
  11343. GotDesc:=GetBaseDescription(GotType);
  11344. if ExpType.BaseType=btNil then
  11345. ExpDesc:=BaseTypeNames[btPointer]
  11346. else
  11347. ExpDesc:=GetBaseDescription(ExpType);
  11348. if GotDesc=ExpDesc then
  11349. begin
  11350. GotDesc:=GetBaseDescription(GotType,true);
  11351. ExpDesc:=GetBaseDescription(ExpType,true);
  11352. end;
  11353. end
  11354. else if (GotType.TypeEl<>nil) and (ExpType.TypeEl<>nil) then
  11355. begin
  11356. GotDesc:=GetTypeDescription(GotType);
  11357. ExpDesc:=GetTypeDescription(ExpType);
  11358. if GotDesc=ExpDesc then
  11359. begin
  11360. GotDesc:=GetTypeDescription(GotType,true);
  11361. ExpDesc:=GetTypeDescription(ExpType,true);
  11362. end;
  11363. end
  11364. else
  11365. begin
  11366. GotDesc:=GetResolverResultDescription(GotType,true);
  11367. ExpDesc:=GetResolverResultDescription(ExpType,true);
  11368. if GotDesc=ExpDesc then
  11369. begin
  11370. GotDesc:=GetResolverResultDescription(GotType,false);
  11371. ExpDesc:=GetResolverResultDescription(ExpType,false);
  11372. end;
  11373. end;
  11374. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  11375. end;
  11376. procedure TPasResolver.RaiseInvalidProcTypeModifier(id: int64;
  11377. ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
  11378. begin
  11379. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[ProcType.ElementTypeName,
  11380. ProcTypeModifiers[ptm]],ErrorEl);
  11381. end;
  11382. procedure TPasResolver.RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
  11383. pm: TProcedureModifier; ErrorEl: TPasElement);
  11384. begin
  11385. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,
  11386. ModifierNames[pm]],ErrorEl);
  11387. end;
  11388. procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
  11389. MsgNumber: integer; const Fmt: String; Args: array of const;
  11390. PosEl: TPasElement);
  11391. begin
  11392. if (FStep<prsFinishingModule)
  11393. and (CurrentParser.Scanner<>nil)
  11394. and (CurrentParser.Scanner.IgnoreMsgType(MsgType)) then
  11395. exit; // during parsing consider directives like $Hints on|off
  11396. SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  11397. if Assigned(OnLog) then
  11398. OnLog(Self,FLastMsg)
  11399. else if Assigned(CurrentParser.OnLog) then
  11400. CurrentParser.OnLog(Self,FLastMsg);
  11401. end;
  11402. function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
  11403. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
  11404. ): integer;
  11405. var
  11406. ProcArgs: TFPList;
  11407. i, ParamCnt, ParamCompatibility: Integer;
  11408. Param: TPasExpr;
  11409. ParamResolved: TPasResolverResult;
  11410. IsVarArgs: Boolean;
  11411. Flags: TPasResolverComputeFlags;
  11412. begin
  11413. Result:=cExact;
  11414. ProcArgs:=ProcType.Args;
  11415. // check args
  11416. ParamCnt:=length(Params.Params);
  11417. IsVarArgs:=false;
  11418. i:=0;
  11419. while i<ParamCnt do
  11420. begin
  11421. Param:=Params.Params[i];
  11422. {$IFDEF VerbosePasResolver}
  11423. writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
  11424. {$ENDIF}
  11425. if i<ProcArgs.Count then
  11426. begin
  11427. ParamCompatibility:=CheckParamCompatibility(Param,
  11428. TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
  11429. if ParamCompatibility=cIncompatible then
  11430. exit(cIncompatible);
  11431. end
  11432. else
  11433. begin
  11434. IsVarArgs:=IsVarArgs or (ptmVarargs in ProcType.Modifiers);
  11435. if IsVarArgs then
  11436. begin
  11437. Flags:=[rcNoImplicitProcType];
  11438. if SetReferenceFlags then
  11439. Flags:=[rcNoImplicitProcType]
  11440. else
  11441. Flags:=[rcNoImplicitProcType,rcSetReferenceFlags];
  11442. ComputeElement(Param,ParamResolved,Flags,Param);
  11443. if not (rrfReadable in ParamResolved.Flags) then
  11444. begin
  11445. if RaiseOnError then
  11446. RaiseMsg(20170318234957,nVariableIdentifierExpected,
  11447. sVariableIdentifierExpected,[],Param);
  11448. exit(cIncompatible);
  11449. end;
  11450. ParamCompatibility:=cExact;
  11451. end
  11452. else
  11453. begin
  11454. // too many arguments
  11455. if RaiseOnError then
  11456. RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
  11457. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
  11458. exit(cIncompatible);
  11459. end;
  11460. end;
  11461. inc(Result,ParamCompatibility);
  11462. inc(i);
  11463. end;
  11464. if (i<ProcArgs.Count) then
  11465. if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
  11466. begin
  11467. // not enough arguments
  11468. if RaiseOnError then
  11469. // ToDo: position cursor on identifier
  11470. RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
  11471. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
  11472. exit(cIncompatible);
  11473. end
  11474. else
  11475. begin
  11476. // the rest are default params
  11477. Result:=cCompatibleWithDefaultParams;
  11478. end;
  11479. end;
  11480. function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
  11481. Params: TParamsExpr; RaiseOnError: boolean): integer;
  11482. var
  11483. PropArg: TPasArgument;
  11484. ArgNo, ParamComp: Integer;
  11485. Param: TPasExpr;
  11486. begin
  11487. Result:=cExact;
  11488. if PropEl.Args.Count<length(Params.Params) then
  11489. begin
  11490. if not RaiseOnError then exit(cIncompatible);
  11491. RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  11492. [PropEl.Name],Params)
  11493. end
  11494. else if PropEl.Args.Count>length(Params.Params) then
  11495. begin
  11496. if not RaiseOnError then exit(cIncompatible);
  11497. RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
  11498. [TPasArgument(PropEl.Args[length(Params.Params)]).Name],Params);
  11499. end;
  11500. for ArgNo:=0 to PropEl.Args.Count-1 do
  11501. begin
  11502. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  11503. Param:=Params.Params[ArgNo];
  11504. ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
  11505. if ParamComp=cIncompatible then
  11506. exit(cIncompatible);
  11507. inc(Result,ParamComp);
  11508. end;
  11509. end;
  11510. function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  11511. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
  11512. var
  11513. ArgNo: Integer;
  11514. Param: TPasExpr;
  11515. ParamResolved: TPasResolverResult;
  11516. procedure GetNextParam;
  11517. begin
  11518. if ArgNo>=length(Params.Params) then
  11519. RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  11520. [],Params);
  11521. Param:=Params.Params[ArgNo];
  11522. ComputeElement(Param,ParamResolved,[]);
  11523. inc(ArgNo);
  11524. end;
  11525. var
  11526. DimNo: integer;
  11527. RangeResolved, OrigRangeResolved, OrigParamResolved: TPasResolverResult;
  11528. bt: TResolverBaseType;
  11529. NextType, TypeEl: TPasType;
  11530. RangeExpr: TPasExpr;
  11531. TypeFits: Boolean;
  11532. ParamValue: TResEvalValue;
  11533. begin
  11534. ArgNo:=0;
  11535. repeat
  11536. if length(ArrayEl.Ranges)=0 then
  11537. begin
  11538. // dynamic/open array -> needs exactly one integer
  11539. GetNextParam;
  11540. if (not (rrfReadable in ParamResolved.Flags))
  11541. or not (ParamResolved.BaseType in btAllInteger) then
  11542. exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
  11543. if EmitHints then
  11544. begin
  11545. ParamValue:=Eval(Param,[refAutoConst]);
  11546. if ParamValue<>nil then
  11547. try // has const value -> check range
  11548. if (ParamValue.Kind<>revkInt)
  11549. or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
  11550. or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
  11551. fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
  11552. DynArrayMinIndex,DynArrayMaxIndex,Param);
  11553. finally
  11554. ReleaseEvalValue(ParamValue);
  11555. end;
  11556. end;
  11557. end
  11558. else
  11559. begin
  11560. // static array
  11561. for DimNo:=0 to length(ArrayEl.Ranges)-1 do
  11562. begin
  11563. GetNextParam;
  11564. RangeExpr:=ArrayEl.Ranges[DimNo];
  11565. ComputeElement(RangeExpr,RangeResolved,[]);
  11566. bt:=RangeResolved.BaseType;
  11567. if not (rrfReadable in ParamResolved.Flags) then
  11568. begin
  11569. if not RaiseOnError then exit(cIncompatible);
  11570. RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
  11571. [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
  11572. end;
  11573. TypeFits:=false;
  11574. OrigRangeResolved:=RangeResolved;
  11575. OrigParamResolved:=ParamResolved;
  11576. if bt=btRange then
  11577. begin
  11578. ConvertRangeToElement(RangeResolved);
  11579. bt:=RangeResolved.BaseType;
  11580. end;
  11581. if ParamResolved.BaseType=btRange then
  11582. begin
  11583. ConvertRangeToElement(ParamResolved);
  11584. end;
  11585. if (bt in btAllBooleans) then
  11586. begin
  11587. if (ParamResolved.BaseType in btAllBooleans) then
  11588. TypeFits:=true;
  11589. end
  11590. else if (bt in btAllInteger) then
  11591. begin
  11592. if (ParamResolved.BaseType in btAllInteger) then
  11593. TypeFits:=true;
  11594. end
  11595. else if (bt in btAllChars) then
  11596. begin
  11597. if (ParamResolved.BaseType in btAllChars) then
  11598. TypeFits:=true;
  11599. end
  11600. else if (bt=btContext) then
  11601. begin
  11602. TypeEl:=ResolveAliasType(RangeResolved.TypeEl);
  11603. if ParamResolved.BaseType=btContext then
  11604. begin
  11605. if (TypeEl.ClassType=TPasEnumType)
  11606. and IsSameType(TypeEl,ParamResolved.TypeEl,true) then
  11607. TypeFits:=true;
  11608. end;
  11609. end;
  11610. if not TypeFits then
  11611. begin
  11612. // incompatible
  11613. if not RaiseOnError then exit(cIncompatible);
  11614. RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
  11615. [IntToStr(ArgNo)],OrigParamResolved,OrigRangeResolved,Param);
  11616. end;
  11617. if EmitHints then
  11618. fExprEvaluator.IsInRange(Param,RangeExpr,true);
  11619. end;
  11620. end;
  11621. if ArgNo=length(Params.Params) then exit(cExact);
  11622. // there are more parameters -> continue in sub array
  11623. NextType:=ResolveAliasType(ArrayEl.ElType);
  11624. if NextType.ClassType<>TPasArrayType then
  11625. RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  11626. [],Params);
  11627. ArrayEl:=TPasArrayType(NextType);
  11628. until false;
  11629. end;
  11630. function TPasResolver.CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure
  11631. ): boolean;
  11632. // returns if number and type of arguments fit
  11633. // does not check calling convention
  11634. var
  11635. ProcArgs1, ProcArgs2: TFPList;
  11636. i: Integer;
  11637. begin
  11638. Result:=false;
  11639. ProcArgs1:=Proc1.ProcType.Args;
  11640. ProcArgs2:=Proc2.ProcType.Args;
  11641. {$IFDEF VerbosePasResolver}
  11642. writeln('TPasResolver.CheckOverloadProcCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
  11643. {$ENDIF}
  11644. // check args
  11645. if ProcArgs1.Count<>ProcArgs2.Count then
  11646. exit;
  11647. for i:=0 to ProcArgs1.Count-1 do
  11648. begin
  11649. {$IFDEF VerbosePasResolver}
  11650. writeln('TPasResolver.CheckOverloadProcCompatibility ',i,'/',ProcArgs1.Count);
  11651. {$ENDIF}
  11652. if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i])) then
  11653. exit;
  11654. end;
  11655. Result:=true;
  11656. end;
  11657. function TPasResolver.CheckProcTypeCompatibility(Proc1,
  11658. Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
  11659. RaiseOnIncompatible: boolean): boolean;
  11660. // if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
  11661. function ModifierError(Modifier: TProcTypeModifier): boolean;
  11662. begin
  11663. Result:=false;
  11664. if not RaiseOnIncompatible then exit;
  11665. RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
  11666. [Proc1.ElementTypeName,ProcTypeModifiers[Modifier]],ErrorEl);
  11667. end;
  11668. var
  11669. ProcArgs1, ProcArgs2: TFPList;
  11670. i: Integer;
  11671. Result1Resolved, Result2Resolved: TPasResolverResult;
  11672. ExpectedArg, ActualArg: TPasArgument;
  11673. begin
  11674. Result:=false;
  11675. if Proc1.ClassType<>Proc2.ClassType then
  11676. begin
  11677. if RaiseOnIncompatible then
  11678. RaiseXExpectedButYFound(20170402112353,Proc1.ElementTypeName,Proc2.ElementTypeName,ErrorEl);
  11679. exit;
  11680. end;
  11681. if Proc1.IsReferenceTo then
  11682. begin
  11683. if IsAssign then
  11684. // aRefTo:=aproc -> any IsNested/OfObject is allowed
  11685. else
  11686. ; // aRefTo = AnyProc -> ok
  11687. end
  11688. else if Proc2.IsReferenceTo then
  11689. begin
  11690. if IsAssign then
  11691. // NonRefTo := aRefTo -> not possible
  11692. exit(ModifierError(ptmReferenceTo))
  11693. else
  11694. ; // AnyProc = aRefTo -> ok
  11695. end
  11696. else
  11697. begin
  11698. // neither Proc1 nor Proc2 is a reference-to -> check isNested and OfObject
  11699. if Proc1.IsNested<>Proc2.IsNested then
  11700. exit(ModifierError(ptmIsNested));
  11701. if Proc1.IsOfObject<>Proc2.IsOfObject then
  11702. begin
  11703. if (proProcTypeWithoutIsNested in Options) then
  11704. exit(ModifierError(ptmOfObject))
  11705. else if Proc1.IsNested then
  11706. // "is nested" can handle both, proc and method.
  11707. else
  11708. exit(ModifierError(ptmOfObject))
  11709. end;
  11710. end;
  11711. if Proc1.CallingConvention<>Proc2.CallingConvention then
  11712. begin
  11713. if RaiseOnIncompatible then
  11714. RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
  11715. [],ErrorEl);
  11716. exit;
  11717. end;
  11718. ProcArgs1:=Proc1.Args;
  11719. ProcArgs2:=Proc2.Args;
  11720. if ProcArgs1.Count<>ProcArgs2.Count then
  11721. begin
  11722. if RaiseOnIncompatible then
  11723. RaiseMsg(20170902142829,nIncompatibleTypesGotParametersExpected,
  11724. sIncompatibleTypesGotParametersExpected,
  11725. [IntToStr(ProcArgs1.Count),IntToStr(ProcArgs2.Count)],ErrorEl);
  11726. exit;
  11727. end;
  11728. for i:=0 to ProcArgs1.Count-1 do
  11729. begin
  11730. {$IFDEF VerbosePasResolver}
  11731. writeln('TPasResolver.CheckProcAssignCompatibility ',i,'/',ProcArgs1.Count);
  11732. {$ENDIF}
  11733. ExpectedArg:=TPasArgument(ProcArgs1[i]);
  11734. ActualArg:=TPasArgument(ProcArgs2[i]);
  11735. if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
  11736. begin
  11737. if RaiseOnIncompatible then
  11738. begin
  11739. if ExpectedArg.Access<>ActualArg.Access then
  11740. RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  11741. [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
  11742. AccessDescriptions[ExpectedArg.Access]],
  11743. ErrorEl);
  11744. RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
  11745. [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
  11746. end;
  11747. exit;
  11748. end;
  11749. end;
  11750. if Proc1 is TPasFunctionType then
  11751. begin
  11752. ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
  11753. ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
  11754. if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
  11755. or not IsSameType(Result1Resolved.TypeEl,Result2Resolved.TypeEl) then
  11756. begin
  11757. if RaiseOnIncompatible then
  11758. RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
  11759. [],Result1Resolved,Result2Resolved,ErrorEl);
  11760. exit;
  11761. end;
  11762. end;
  11763. Result:=true;
  11764. end;
  11765. function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
  11766. begin
  11767. Result:=false;
  11768. // check access: var, const, ...
  11769. if Arg1.Access<>Arg2.Access then exit;
  11770. // check untyped
  11771. if Arg1.ArgType=nil then
  11772. exit(Arg2.ArgType=nil);
  11773. if Arg2.ArgType=nil then exit;
  11774. Result:=CheckProcArgTypeCompatibility(Arg1.ArgType,Arg2.ArgType);
  11775. end;
  11776. function TPasResolver.CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType
  11777. ): boolean;
  11778. var
  11779. Arg1Resolved, Arg2Resolved: TPasResolverResult;
  11780. C: TClass;
  11781. Arr1, Arr2: TPasArrayType;
  11782. begin
  11783. ComputeElement(Arg1,Arg1Resolved,[rcType]);
  11784. ComputeElement(Arg2,Arg2Resolved,[rcType]);
  11785. {$IFDEF VerbosePasResolver}
  11786. //writeln('TPasResolver.CheckProcArgTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
  11787. {$ENDIF}
  11788. if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
  11789. or (Arg1Resolved.TypeEl=nil)
  11790. or (Arg2Resolved.TypeEl=nil) then
  11791. exit(false);
  11792. if (Arg1Resolved.BaseType=Arg2Resolved.BaseType)
  11793. and IsSameType(Arg1Resolved.TypeEl,Arg2Resolved.TypeEl) then
  11794. exit(true);
  11795. C:=Arg1Resolved.TypeEl.ClassType;
  11796. if (C=TPasArrayType) and (Arg2Resolved.TypeEl.ClassType=TPasArrayType) then
  11797. begin
  11798. Arr1:=TPasArrayType(Arg1Resolved.TypeEl);
  11799. Arr2:=TPasArrayType(Arg2Resolved.TypeEl);
  11800. if length(Arr1.Ranges)<>length(Arr2.Ranges) then
  11801. exit(false);
  11802. if length(Arr1.Ranges)>0 then
  11803. RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
  11804. Result:=CheckProcArgTypeCompatibility(Arr1.ElType,Arr2.ElType);
  11805. exit;
  11806. end;
  11807. Result:=false;
  11808. end;
  11809. function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  11810. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  11811. var
  11812. El: TPasElement;
  11813. begin
  11814. Result:=false;
  11815. El:=ResolvedEl.IdentEl;
  11816. if El=nil then
  11817. begin
  11818. if ErrorOnFalse then
  11819. begin
  11820. {$IFDEF VerbosePasResolver}
  11821. writeln('TPasResolver.CheckCanBeLHS ',GetResolverResultDbg(ResolvedEl));
  11822. {$ENDIF}
  11823. if (ResolvedEl.TypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
  11824. RaiseXExpectedButYFound(20170216152727,'identifier',ResolvedEl.TypeEl.ElementTypeName,ResolvedEl.ExprEl)
  11825. else
  11826. RaiseMsg(20170216152426,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  11827. end;
  11828. exit;
  11829. end;
  11830. if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
  11831. exit(true);
  11832. // not writable
  11833. if not ErrorOnFalse then exit;
  11834. if ResolvedEl.IdentEl is TPasProperty then
  11835. RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
  11836. else
  11837. RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  11838. end;
  11839. function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
  11840. RaiseOnIncompatible: boolean): integer;
  11841. var
  11842. LeftResolved, RightResolved: TPasResolverResult;
  11843. Flags: TPasResolverComputeFlags;
  11844. IsProcType: Boolean;
  11845. begin
  11846. ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
  11847. Flags:=[];
  11848. IsProcType:=IsProcedureType(LeftResolved,true);
  11849. if IsProcType then
  11850. if msDelphi in CurrentParser.CurrentModeswitches then
  11851. Include(Flags,rcNoImplicitProc)
  11852. else
  11853. Include(Flags,rcNoImplicitProcType);
  11854. ComputeElement(RHS,RightResolved,Flags);
  11855. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,RHS,RaiseOnIncompatible);
  11856. if RHS is TPasExpr then
  11857. CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
  11858. end;
  11859. procedure TPasResolver.CheckAssignExprRange(
  11860. const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  11861. // if RHS is a constant check if it fits into range LeftResolved
  11862. var
  11863. LRangeValue, RValue: TResEvalValue;
  11864. MinVal, MaxVal: int64;
  11865. RangeExpr: TBinaryExpr;
  11866. Int: MaxPrecInt;
  11867. C: TClass;
  11868. EnumType: TPasEnumType;
  11869. bt: TResolverBaseType;
  11870. w: WideChar;
  11871. LTypeEl: TPasType;
  11872. begin
  11873. if (LeftResolved.TypeEl<>nil) and (LeftResolved.TypeEl.ClassType=TPasArrayType) then
  11874. exit; // arrays are checked by element, not by the whole value
  11875. LTypeEl:=ResolveAliasType(LeftResolved.TypeEl);
  11876. if LTypeEl is TPasClassOfType then
  11877. exit; // class-of are checked only by type, not by value
  11878. RValue:=Eval(RHS,[refAutoConst]);
  11879. if RValue=nil then
  11880. exit; // not a const expression
  11881. {$IFDEF VerbosePasResEval}
  11882. writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
  11883. {$ENDIF}
  11884. LRangeValue:=nil;
  11885. try
  11886. if LeftResolved.BaseType=btCustom then
  11887. CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
  11888. else if LeftResolved.BaseType=btSet then
  11889. begin
  11890. // assign to a set
  11891. C:=LTypeEl.ClassType;
  11892. if C=TPasRangeType then
  11893. begin
  11894. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  11895. LRangeValue:=Eval(RangeExpr,[refConst],false);
  11896. end
  11897. else if C=TPasEnumType then
  11898. begin
  11899. EnumType:=TPasEnumType(LTypeEl);
  11900. LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
  11901. 0,EnumType.Values.Count-1);
  11902. end
  11903. else if C=TPasUnresolvedSymbolRef then
  11904. begin
  11905. // set of basetype
  11906. if LTypeEl.CustomData is TResElDataBaseType then
  11907. begin
  11908. bt:=GetActualBaseType(TResElDataBaseType(LTypeEl.CustomData).BaseType);
  11909. if (bt in (btAllInteger-[btQWord]))
  11910. and GetIntegerRange(bt,MinVal,MaxVal) then
  11911. LRangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
  11912. else if bt=btBoolean then
  11913. LRangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
  11914. else if bt=btAnsiChar then
  11915. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  11916. else if bt=btWideChar then
  11917. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
  11918. else
  11919. RaiseNotYetImplemented(20170714205110,RHS);
  11920. end
  11921. else
  11922. RaiseNotYetImplemented(20170714204803,RHS);
  11923. end
  11924. else
  11925. RaiseNotYetImplemented(20170714193100,RHS);
  11926. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true);
  11927. end
  11928. else if LTypeEl is TPasRangeType then
  11929. begin
  11930. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  11931. LRangeValue:=Eval(RangeExpr,[refConst]);
  11932. if LeftResolved.BaseType=btSet then
  11933. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true)
  11934. else
  11935. fExprEvaluator.IsInRange(RValue,RHS,LRangeValue,RangeExpr,true);
  11936. end
  11937. else if (LeftResolved.BaseType in (btAllInteger-[btQWord]))
  11938. and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
  11939. case RValue.Kind of
  11940. revkInt:
  11941. if (MinVal>TResEvalInt(RValue).Int)
  11942. or (MaxVal<TResEvalInt(RValue).Int) then
  11943. fExprEvaluator.EmitRangeCheckConst(20170530093126,
  11944. IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
  11945. revkUInt:
  11946. if (TResEvalUInt(RValue).UInt>High(MaxPrecInt))
  11947. or (MinVal>MaxPrecInt(TResEvalUInt(RValue).UInt))
  11948. or (MaxVal<MaxPrecInt(TResEvalUInt(RValue).UInt)) then
  11949. fExprEvaluator.EmitRangeCheckConst(20170530093616,
  11950. IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
  11951. revkFloat:
  11952. if TResEvalFloat(RValue).IsInt(Int) then
  11953. begin
  11954. if (MinVal>Int) or (MaxVal<Int) then
  11955. fExprEvaluator.EmitRangeCheckConst(20170802133307,
  11956. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  11957. end
  11958. else
  11959. begin
  11960. {$IFDEF VerbosePasResEval}
  11961. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<MaxPrecFloat(low(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>MaxPrecFloat(high(MaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(MaxPrecInt));
  11962. {$ENDIF}
  11963. RaiseRangeCheck(20170802133750,RHS);
  11964. end;
  11965. else
  11966. {$IFDEF VerbosePasResEval}
  11967. writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
  11968. {$ENDIF}
  11969. RaiseNotYetImplemented(20170530092731,RHS);
  11970. end
  11971. else if LeftResolved.BaseType=btQWord then
  11972. case RValue.Kind of
  11973. revkInt:
  11974. if (TResEvalInt(RValue).Int<0) then
  11975. fExprEvaluator.EmitRangeCheckConst(20170530094316,
  11976. IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
  11977. revkUInt: ;
  11978. else
  11979. RaiseNotYetImplemented(20170530094311,RHS);
  11980. end
  11981. else if RValue.Kind in [revkNil,revkBool] then
  11982. // simple type check is enough
  11983. else if LeftResolved.BaseType in [btSingle,btDouble] then
  11984. // simple type check is enough
  11985. // ToDo: warn if precision loss
  11986. else if LeftResolved.BaseType in btAllChars then
  11987. begin
  11988. case RValue.Kind of
  11989. revkString:
  11990. if length(TResEvalString(RValue).S)<>1 then
  11991. begin
  11992. if fExprEvaluator.GetWideChar(TResEvalString(RValue).S,w) then
  11993. Int:=ord(w)
  11994. else
  11995. RaiseXExpectedButYFound(20170714171352,'char','string',RHS);
  11996. end
  11997. else
  11998. Int:=ord(TResEvalString(RValue).S[1]);
  11999. revkUnicodeString:
  12000. if length(TResEvalUTF16(RValue).S)<>1 then
  12001. RaiseXExpectedButYFound(20170714171534,'char','string',RHS)
  12002. else
  12003. Int:=ord(TResEvalUTF16(RValue).S[1]);
  12004. else
  12005. RaiseNotYetImplemented(20170714171218,RHS);
  12006. end;
  12007. case GetActualBaseType(LeftResolved.BaseType) of
  12008. btAnsiChar: MaxVal:=$ff;
  12009. btWideChar: MaxVal:=$ffff;
  12010. end;
  12011. if (Int>MaxVal) then
  12012. fExprEvaluator.EmitRangeCheckConst(20170714171911,
  12013. '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
  12014. end
  12015. else if LeftResolved.BaseType in btAllStrings then
  12016. // simple type check is enough
  12017. // ToDo: warn if unicode to non-utf8
  12018. else if LeftResolved.BaseType=btContext then
  12019. // simple type check is enough
  12020. else if LeftResolved.BaseType=btRange then
  12021. begin
  12022. if (LeftResolved.ExprEl is TBinaryExpr)
  12023. and (TBinaryExpr(LeftResolved.ExprEl).Kind=pekRange) then
  12024. begin
  12025. LRangeValue:=Eval(LeftResolved.ExprEl,[refConst]);
  12026. try
  12027. case LRangeValue.Kind of
  12028. revkRangeInt:
  12029. case TResEvalRangeInt(LRangeValue).ElKind of
  12030. revskEnum:
  12031. if (RValue.Kind<>revkEnum) then
  12032. RaiseNotYetImplemented(20171009171251,RHS)
  12033. else if (TResEvalEnum(RValue).Index<TResEvalRangeInt(LRangeValue).RangeStart)
  12034. or (TResEvalEnum(RValue).Index>TResEvalRangeInt(LRangeValue).RangeEnd) then
  12035. fExprEvaluator.EmitRangeCheckConst(20171009171442,
  12036. TResEvalEnum(RValue).AsString,
  12037. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeStart),
  12038. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeEnd),
  12039. RHS);
  12040. else
  12041. RaiseNotYetImplemented(20171009165348,LeftResolved.ExprEl);
  12042. end;
  12043. else
  12044. RaiseNotYetImplemented(20171009165326,LeftResolved.ExprEl);
  12045. end;
  12046. finally
  12047. ReleaseEvalValue(LRangeValue);
  12048. end;
  12049. end
  12050. else
  12051. RaiseNotYetImplemented(20171009171005,RHS);
  12052. end
  12053. else
  12054. begin
  12055. {$IFDEF VerbosePasResolver}
  12056. writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
  12057. {$ENDIF}
  12058. RaiseNotYetImplemented(20170530095243,RHS);
  12059. end;
  12060. finally
  12061. ReleaseEvalValue(RValue);
  12062. ReleaseEvalValue(LRangeValue);
  12063. end;
  12064. end;
  12065. procedure TPasResolver.CheckAssignExprRangeToCustom(
  12066. const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
  12067. begin
  12068. if LeftResolved.BaseType<>btCustom then exit;
  12069. if RValue=nil then exit;
  12070. if RHS=nil then ;
  12071. end;
  12072. function TPasResolver.CheckAssignResCompatibility(const LHS,
  12073. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  12074. ): integer;
  12075. var
  12076. TypeEl, RTypeEl: TPasType;
  12077. Handled: Boolean;
  12078. C: TClass;
  12079. LBT, RBT: TResolverBaseType;
  12080. LRange, RValue: TResEvalValue;
  12081. RightSubResolved: TPasResolverResult;
  12082. wc: WideChar;
  12083. begin
  12084. // check if the RHS can be converted to LHS
  12085. {$IFDEF VerbosePasResolver}
  12086. writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  12087. {$ENDIF}
  12088. Result:=-1;
  12089. Handled:=false;
  12090. Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
  12091. if Handled and (Result>=cExact) and (Result<cIncompatible) then
  12092. exit;
  12093. if not Handled then
  12094. begin
  12095. LBT:=GetActualBaseType(LHS.BaseType);
  12096. RBT:=GetActualBaseType(RHS.BaseType);
  12097. if LHS.TypeEl=nil then
  12098. begin
  12099. if LBT=btUntyped then
  12100. begin
  12101. // untyped parameter
  12102. Result:=cTypeConversion;
  12103. end
  12104. else
  12105. RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
  12106. end
  12107. else if LBT=RBT then
  12108. begin
  12109. if LBT=btContext then
  12110. exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
  12111. else
  12112. Result:=cExact; // same base type, maybe not same type name (e.g. longint and integer)
  12113. end
  12114. else if (LBT in btAllBooleans)
  12115. and (RBT in btAllBooleans) then
  12116. Result:=cCompatible
  12117. else if (LBT in btAllChars) then
  12118. begin
  12119. if (RBT in btAllChars) then
  12120. case LBT of
  12121. btAnsiChar:
  12122. Result:=cLossyConversion;
  12123. btWideChar:
  12124. if RBT=btAnsiChar then
  12125. Result:=cCompatible
  12126. else
  12127. Result:=cLossyConversion;
  12128. else
  12129. RaiseNotYetImplemented(20170728132440,ErrorEl,BaseTypeNames[LBT]);
  12130. end
  12131. else if (RBT=btRange) and (RHS.SubType in btAllChars) then
  12132. begin
  12133. if LBT=btWideChar then
  12134. exit(cCompatible);
  12135. // LHS is ansichar
  12136. if GetActualBaseType(RHS.SubType)=btAnsiChar then
  12137. exit(cExact);
  12138. RValue:=Eval(RHS,[refAutoConst]);
  12139. if RValue<>nil then
  12140. try
  12141. // ansichar:=constvalue
  12142. case RValue.Kind of
  12143. revkString:
  12144. if not ExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  12145. exit(cIncompatible);
  12146. revkUnicodeString:
  12147. begin
  12148. if length(TResEvalUTF16(RValue).S)<>1 then
  12149. exit(cIncompatible);
  12150. wc:=TResEvalUTF16(RValue).S[1];
  12151. end;
  12152. else
  12153. RaiseNotYetImplemented(20171108194650,ErrorEl);
  12154. end;
  12155. if ord(wc)>255 then
  12156. exit(cIncompatible);
  12157. exit(cCompatible);
  12158. finally
  12159. ReleaseEvalValue(RValue);
  12160. end;
  12161. // LHS is ansichar, RHS is not a const
  12162. if (RHS.ExprEl is TBinaryExpr) and (TBinaryExpr(RHS.ExprEl).Kind=pekRange) then
  12163. begin
  12164. RValue:=Eval(RHS.ExprEl,[refConst]);
  12165. try
  12166. if RValue.Kind<>revkRangeInt then
  12167. RaiseNotYetImplemented(20171108195035,ErrorEl);
  12168. if TResEvalRangeInt(RValue).RangeStart>255 then
  12169. exit(cIncompatible);
  12170. if TResEvalRangeInt(RValue).RangeEnd>255 then
  12171. exit(cLossyConversion);
  12172. exit(cCompatible);
  12173. finally
  12174. ReleaseEvalValue(RValue);
  12175. end;
  12176. end;
  12177. RaiseNotYetImplemented(20171108195216,ErrorEl);
  12178. end;
  12179. end
  12180. else if (LBT in btAllStrings)
  12181. and (RBT in btAllStringAndChars) then
  12182. case LBT of
  12183. btAnsiString:
  12184. if RBT in [btAnsiChar,btShortString,btRawByteString] then
  12185. Result:=cCompatible
  12186. else
  12187. Result:=cLossyConversion;
  12188. btShortString:
  12189. if RBT=btAnsiChar then
  12190. Result:=cCompatible
  12191. else
  12192. Result:=cLossyConversion;
  12193. btWideString,btUnicodeString:
  12194. Result:=cCompatible;
  12195. btRawByteString:
  12196. if RBT in [btAnsiChar,btAnsiString,btShortString] then
  12197. Result:=cCompatible
  12198. else
  12199. Result:=cLossyConversion;
  12200. else
  12201. RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
  12202. end
  12203. else if (LBT in btAllInteger)
  12204. and (RBT in btAllInteger) then
  12205. begin
  12206. Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
  12207. case LBT of
  12208. btByte,
  12209. btShortInt: inc(Result,cLossyConversion);
  12210. btWord,
  12211. btSmallInt:
  12212. if not (RBT in [btByte,btShortInt]) then
  12213. inc(Result,cLossyConversion);
  12214. btUIntSingle:
  12215. if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
  12216. inc(Result,cLossyConversion);
  12217. btIntSingle:
  12218. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
  12219. inc(Result,cLossyConversion);
  12220. btLongWord,
  12221. btLongint:
  12222. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
  12223. inc(Result,cLossyConversion);
  12224. btUIntDouble:
  12225. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
  12226. inc(Result,cLossyConversion);
  12227. btIntDouble:
  12228. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
  12229. inc(Result,cLossyConversion);
  12230. btQWord,
  12231. btInt64,btComp:
  12232. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
  12233. btLongWord,btLongint,btUIntDouble,btIntDouble]) then
  12234. inc(Result,cLossyConversion);
  12235. else
  12236. RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
  12237. end;
  12238. end
  12239. else if (LBT in btAllFloats)
  12240. and (RBT in (btAllFloats+btAllInteger)) then
  12241. begin
  12242. Result:=cToFloatConversion+ord(LBT)-ord(RBT);
  12243. case LBT of
  12244. btSingle:
  12245. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  12246. btIntSingle,btUIntSingle]) then
  12247. inc(Result,cLossyConversion);
  12248. btDouble:
  12249. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  12250. btIntSingle,btUIntSingle,btSingle,
  12251. btLongWord,btLongint,
  12252. btIntDouble,btUIntDouble]) then
  12253. inc(Result,cLossyConversion);
  12254. btExtended,btCExtended:
  12255. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  12256. btIntSingle,btUIntSingle,btSingle,
  12257. btLongWord,btLongint,
  12258. btInt64,btComp,
  12259. btIntDouble,btUIntDouble,btDouble]) then
  12260. inc(Result,cLossyConversion);
  12261. btCurrency:
  12262. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  12263. btIntSingle,btUIntSingle,
  12264. btLongWord,btLongint]) then
  12265. inc(Result,cLossyConversion);
  12266. else
  12267. RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
  12268. end;
  12269. end
  12270. else if LBT=btNil then
  12271. begin
  12272. if RaiseOnIncompatible then
  12273. RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
  12274. [],ErrorEl);
  12275. exit(cIncompatible);
  12276. end
  12277. else if LBT=btRange then
  12278. begin
  12279. if (LHS.ExprEl is TBinaryExpr) and (TBinaryExpr(LHS.ExprEl).Kind=pekRange) then
  12280. begin
  12281. LRange:=Eval(LHS.ExprEl,[refConst]);
  12282. RValue:=nil;
  12283. try
  12284. {$IFDEF VerbosePasResolver}
  12285. //writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString);
  12286. {$ENDIF}
  12287. case LRange.Kind of
  12288. revkRangeInt:
  12289. case TResEvalRangeInt(LRange).ElKind of
  12290. revskEnum:
  12291. if RHS.BaseType=btContext then
  12292. begin
  12293. if IsSameType(TResEvalRangeInt(LRange).ElType,RHS.TypeEl,true) then
  12294. begin
  12295. // same enum type
  12296. {$IFDEF VerbosePasResolver}
  12297. writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString,' Left.ElType=',GetObjName(TResEvalRangeInt(LRange).ElType),' RHS.TypeEl=',GetObjName(RHS.TypeEl));
  12298. {$ENDIF}
  12299. // ToDo: check if LRange is smaller than Range of RHS (cLossyConversion)
  12300. exit(cExact);
  12301. end;
  12302. end;
  12303. revskInt:
  12304. if RHS.BaseType in btAllInteger then
  12305. begin
  12306. RValue:=Eval(RHS,[refAutoConst]);
  12307. if RValue<>nil then
  12308. begin
  12309. // ToDo: check range
  12310. end;
  12311. exit(cCompatible);
  12312. end;
  12313. revskChar:
  12314. if RHS.BaseType in btAllStringAndChars then
  12315. begin
  12316. RValue:=Eval(RHS,[refAutoConst]);
  12317. if RValue<>nil then
  12318. begin
  12319. case RValue.Kind of
  12320. revkString:
  12321. if not fExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  12322. exit(cIncompatible);
  12323. revkUnicodeString:
  12324. begin
  12325. if length(TResEvalUTF16(RValue).S)<>1 then
  12326. exit(cIncompatible);
  12327. wc:=TResEvalUTF16(RValue).S[1];
  12328. end;
  12329. else
  12330. RaiseNotYetImplemented(20171108192232,ErrorEl);
  12331. end;
  12332. if (ord(wc)<TResEvalRangeInt(LRange).RangeStart)
  12333. or (ord(wc)>TResEvalRangeInt(LRange).RangeEnd) then
  12334. exit(cIncompatible);
  12335. end;
  12336. exit(cCompatible);
  12337. end;
  12338. revskBool:
  12339. if RHS.BaseType=btBoolean then
  12340. begin
  12341. RValue:=Eval(RHS,[refAutoConst]);
  12342. if RValue<>nil then
  12343. begin
  12344. // ToDo: check range
  12345. end;
  12346. exit(cCompatible);
  12347. end;
  12348. end;
  12349. end;
  12350. finally
  12351. ReleaseEvalValue(LRange);
  12352. ReleaseEvalValue(RValue);
  12353. end;
  12354. end;
  12355. end
  12356. else if LBT in [btSet,btModule,btProc] then
  12357. begin
  12358. if RaiseOnIncompatible then
  12359. RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  12360. exit(cIncompatible);
  12361. end
  12362. else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
  12363. begin
  12364. if RaiseOnIncompatible then
  12365. RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  12366. exit(cIncompatible);
  12367. end
  12368. else if RBT=btNil then
  12369. begin
  12370. if LBT=btPointer then
  12371. Result:=cExact
  12372. else if LBT=btContext then
  12373. begin
  12374. TypeEl:=LHS.TypeEl;
  12375. C:=TypeEl.ClassType;
  12376. if (C=TPasClassType)
  12377. or (C=TPasClassOfType)
  12378. or (C=TPasPointerType)
  12379. or C.InheritsFrom(TPasProcedureType)
  12380. or IsDynArray(TypeEl) then
  12381. Result:=cExact;
  12382. end;
  12383. end
  12384. else if RBT=btProc then
  12385. begin
  12386. if (msDelphi in CurrentParser.CurrentModeswitches)
  12387. and (LHS.TypeEl is TPasProcedureType)
  12388. and (RHS.IdentEl is TPasProcedure) then
  12389. begin
  12390. // for example ProcVar:=Proc
  12391. if CheckProcTypeCompatibility(TPasProcedureType(LHS.TypeEl),
  12392. TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
  12393. exit(cExact);
  12394. end;
  12395. end
  12396. else if LBT=btPointer then
  12397. begin
  12398. if RBT=btPointer then
  12399. begin
  12400. if IsBaseType(LHS.TypeEl,btPointer) then
  12401. Result:=cExact // btPointer can take any pointer
  12402. else if IsBaseType(RHS.TypeEl,btPointer) then
  12403. Result:=cTypeConversion // any pointer can take a btPointer
  12404. else if IsSameType(LHS.TypeEl,RHS.TypeEl) then
  12405. Result:=cExact // pointer of same type
  12406. else if (LHS.TypeEl.ClassType=TPasPointerType)
  12407. and (RHS.TypeEl.ClassType=TPasPointerType) then
  12408. Result:=CheckAssignCompatibility(TPasPointerType(LHS.TypeEl).DestType,
  12409. TPasPointerType(RHS.TypeEl).DestType,RaiseOnIncompatible);
  12410. end
  12411. else if IsBaseType(LHS.TypeEl,btPointer) then
  12412. begin
  12413. if RBT=btContext then
  12414. begin
  12415. C:=RHS.TypeEl.ClassType;
  12416. if C=TPasClassType then
  12417. exit(cTypeConversion) // class type or class instance
  12418. else if C=TPasClassOfType then
  12419. Result:=cTypeConversion
  12420. else if C=TPasArrayType then
  12421. begin
  12422. if IsDynArray(RHS.TypeEl) then
  12423. Result:=cTypeConversion;
  12424. end
  12425. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  12426. // pointer:=procvar
  12427. Result:=cLossyConversion;
  12428. end;
  12429. end;
  12430. end
  12431. else if (LBT=btContext) then
  12432. begin
  12433. TypeEl:=ResolveAliasType(LHS.TypeEl);
  12434. if (TypeEl.ClassType=TPasArrayType) then
  12435. Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
  12436. else if TypeEl.ClassType=TPasEnumType then
  12437. begin
  12438. if (RHS.BaseType=btRange) and (RHS.SubType=btContext) then
  12439. begin
  12440. RTypeEl:=ResolveAliasType(RHS.TypeEl);
  12441. if RTypeEl.ClassType=TPasRangeType then
  12442. begin
  12443. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,RightSubResolved,[rcConstant]);
  12444. if (RightSubResolved.BaseType=btContext)
  12445. and IsSameType(TypeEl,RightSubResolved.TypeEl,true) then
  12446. begin
  12447. // enumtype := enumrange
  12448. Result:=cExact;
  12449. end;
  12450. end;
  12451. end;
  12452. end;
  12453. end;
  12454. end;
  12455. if (Result>=0) and (Result<cIncompatible) then
  12456. begin
  12457. // type fits -> check readable
  12458. if not (rrfReadable in RHS.Flags) then
  12459. begin
  12460. if RaiseOnIncompatible then
  12461. begin
  12462. {$IFDEF VerbosePasResolver}
  12463. writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  12464. {$ENDIF}
  12465. RaiseMsg(20170318235637,nVariableIdentifierExpected,
  12466. sVariableIdentifierExpected,[],ErrorEl);
  12467. end;
  12468. exit(cIncompatible);
  12469. end;
  12470. exit;
  12471. end;
  12472. // incompatible
  12473. {$IFDEF VerbosePasResolver}
  12474. writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  12475. {$ENDIF}
  12476. if not RaiseOnIncompatible then
  12477. exit(cIncompatible);
  12478. // create error messages
  12479. RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
  12480. [],RHS,LHS,ErrorEl);
  12481. end;
  12482. function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
  12483. ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
  12484. ): integer;
  12485. // check if the RightResolved is type compatible to LeftResolved
  12486. var
  12487. LFlags, RFlags: TPasResolverComputeFlags;
  12488. LeftResolved, RightResolved: TPasResolverResult;
  12489. LeftErrorEl, RightErrorEl: TPasElement;
  12490. begin
  12491. Result:=cIncompatible;
  12492. // Delphi resolves both sides, so it forbids "if procvar=procvar then"
  12493. // FPC is more clever. It supports "if procvar=@proc then", "function=value"
  12494. if msDelphi in CurrentParser.CurrentModeswitches then
  12495. LFlags:=[]
  12496. else
  12497. LFlags:=[rcNoImplicitProcType];
  12498. if SetReferenceFlags then
  12499. Include(LFlags,rcSetReferenceFlags);
  12500. ComputeElement(Left,LeftResolved,LFlags);
  12501. if (msDelphi in CurrentParser.CurrentModeswitches) then
  12502. RFlags:=LFlags
  12503. else
  12504. begin
  12505. if LeftResolved.BaseType=btNil then
  12506. RFlags:=[rcNoImplicitProcType]
  12507. else if IsProcedureType(LeftResolved,true) then
  12508. RFlags:=[rcNoImplicitProcType]
  12509. else
  12510. RFlags:=[];
  12511. end;
  12512. if SetReferenceFlags then
  12513. Include(RFlags,rcSetReferenceFlags);
  12514. {$IFDEF VerbosePasResolver}
  12515. writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
  12516. {$ENDIF}
  12517. ComputeElement(Right,RightResolved,RFlags);
  12518. if ErrorEl=nil then
  12519. begin
  12520. LeftErrorEl:=Left;
  12521. RightErrorEl:=Right;
  12522. end
  12523. else
  12524. begin
  12525. LeftErrorEl:=ErrorEl;
  12526. RightErrorEl:=ErrorEl;
  12527. end;
  12528. Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
  12529. RaiseOnIncompatible,RightErrorEl);
  12530. end;
  12531. function TPasResolver.CheckEqualResCompatibility(const LHS,
  12532. RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  12533. RErrorEl: TPasElement): integer;
  12534. var
  12535. TypeEl, RTypeEl: TPasType;
  12536. ResolvedEl: TPasResolverResult;
  12537. begin
  12538. Result:=cIncompatible;
  12539. if RErrorEl=nil then RErrorEl:=LErrorEl;
  12540. // check if the RHS is type compatible to LHS
  12541. {$IFDEF VerbosePasResolver}
  12542. writeln('TPasResolver.CheckEqualResCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  12543. {$ENDIF}
  12544. if not (rrfReadable in LHS.Flags) then
  12545. begin
  12546. if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasClassType)
  12547. and (ResolveAliasTypeEl(LHS.IdentEl)=LHS.TypeEl) then
  12548. begin
  12549. if RHS.BaseType=btNil then
  12550. exit(cExact)
  12551. else if (RHS.BaseType=btContext) and (RHS.TypeEl.ClassType=TPasClassOfType)
  12552. and (rrfReadable in RHS.Flags) then
  12553. // for example if TImage=ImageClass then
  12554. exit(cExact);
  12555. end;
  12556. RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
  12557. end;
  12558. if not (rrfReadable in RHS.Flags) then
  12559. begin
  12560. if (RHS.BaseType=btContext) and (RHS.TypeEl.ClassType=TPasClassType)
  12561. and (ResolveAliasTypeEl(RHS.IdentEl)=RHS.TypeEl) then
  12562. begin
  12563. if LHS.BaseType=btNil then
  12564. exit(cExact)
  12565. else if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasClassOfType)
  12566. and (rrfReadable in LHS.Flags) then
  12567. // for example if ImageClass=TImage then
  12568. exit(cExact);
  12569. end;
  12570. RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
  12571. end;
  12572. if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
  12573. begin
  12574. Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
  12575. if (Result=cIncompatible) and RaiseOnIncompatible then
  12576. RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
  12577. [],RHS,LHS,LErrorEl);
  12578. exit;
  12579. end
  12580. else if LHS.BaseType=RHS.BaseType then
  12581. begin
  12582. if LHS.BaseType=btContext then
  12583. exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
  12584. else
  12585. exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
  12586. end
  12587. else if LHS.BaseType in btAllInteger then
  12588. begin
  12589. if RHS.BaseType in btAllInteger+btAllFloats then
  12590. exit(cCompatible)
  12591. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  12592. exit(cCompatible);
  12593. end
  12594. else if LHS.BaseType in btAllFloats then
  12595. begin
  12596. if RHS.BaseType in btAllInteger+btAllFloats then
  12597. exit(cCompatible);
  12598. end
  12599. else if LHS.BaseType in btAllBooleans then
  12600. begin
  12601. if RHS.BaseType in btAllBooleans then
  12602. exit(cCompatible)
  12603. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  12604. exit(cCompatible);
  12605. end
  12606. else if LHS.BaseType in btAllStringAndChars then
  12607. begin
  12608. if RHS.BaseType in btAllStringAndChars then
  12609. exit(cCompatible)
  12610. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  12611. exit(cCompatible);
  12612. end
  12613. else if LHS.BaseType=btNil then
  12614. begin
  12615. if RHS.BaseType in [btPointer,btNil] then
  12616. exit(cExact)
  12617. else if RHS.BaseType=btContext then
  12618. begin
  12619. TypeEl:=RHS.TypeEl;
  12620. if (TypeEl.ClassType=TPasClassType)
  12621. or (TypeEl.ClassType=TPasClassOfType)
  12622. or (TypeEl.ClassType=TPasPointerType)
  12623. or (TypeEl is TPasProcedureType)
  12624. or IsDynArray(TypeEl) then
  12625. exit(cExact);
  12626. end;
  12627. if RaiseOnIncompatible then
  12628. RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
  12629. [],RHS,LHS,RErrorEl)
  12630. else
  12631. exit(cIncompatible);
  12632. end
  12633. else if RHS.BaseType=btNil then
  12634. begin
  12635. if LHS.BaseType=btPointer then
  12636. exit(cExact)
  12637. else if LHS.BaseType=btContext then
  12638. begin
  12639. TypeEl:=LHS.TypeEl;
  12640. if (TypeEl.ClassType=TPasClassType)
  12641. or (TypeEl.ClassType=TPasClassOfType)
  12642. or (TypeEl.ClassType=TPasPointerType)
  12643. or (TypeEl is TPasProcedureType)
  12644. or IsDynArray(TypeEl) then
  12645. exit(cExact);
  12646. end;
  12647. if RaiseOnIncompatible then
  12648. RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
  12649. [],LHS,RHS,LErrorEl)
  12650. else
  12651. exit(cIncompatible);
  12652. end
  12653. else if LHS.BaseType=btSet then
  12654. begin
  12655. if RHS.BaseType=btSet then
  12656. begin
  12657. if LHS.TypeEl=nil then
  12658. exit(cExact); // empty set
  12659. if RHS.TypeEl=nil then
  12660. exit(cExact); // empty set
  12661. if LHS.TypeEl=RHS.TypeEl then
  12662. exit(cExact);
  12663. if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+btAllChars)) then
  12664. exit(cExact);
  12665. if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
  12666. or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
  12667. exit(cCompatible);
  12668. if RaiseOnIncompatible then
  12669. RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  12670. ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
  12671. else
  12672. exit(cIncompatible);
  12673. end;
  12674. end
  12675. else if LHS.BaseType=btRange then
  12676. begin
  12677. if LHS.SubType in btAllInteger then
  12678. begin
  12679. // e.g. 2..4
  12680. if RHS.BaseType in btAllInteger then
  12681. exit(cCompatible)
  12682. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  12683. exit(cCompatible);
  12684. end
  12685. else if LHS.SubType in btAllBooleans then
  12686. begin
  12687. if RHS.BaseType in btAllBooleans then
  12688. exit(cCompatible)
  12689. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  12690. exit(cCompatible);
  12691. end
  12692. else if LHS.SubType in btAllChars then
  12693. begin
  12694. if RHS.BaseType in btAllStringAndChars then
  12695. exit(cCompatible)
  12696. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  12697. exit(cCompatible);
  12698. end
  12699. else if LHS.SubType=btContext then
  12700. begin
  12701. TypeEl:=ResolveAliasType(LHS.TypeEl);
  12702. if TypeEl.ClassType=TPasRangeType then
  12703. begin
  12704. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  12705. if ResolvedEl.BaseType=btContext then
  12706. begin
  12707. TypeEl:=ResolveAliasType(ResolvedEl.TypeEl);
  12708. if TypeEl.ClassType=TPasEnumType then
  12709. begin
  12710. if RHS.BaseType=btContext then
  12711. begin
  12712. RTypeEl:=ResolveAliasType(RHS.TypeEl);
  12713. if (TypeEl=RTypeEl) then
  12714. exit(cCompatible);
  12715. end;
  12716. end;
  12717. end;
  12718. end;
  12719. end;
  12720. end
  12721. else if LHS.BaseType=btContext then
  12722. begin
  12723. TypeEl:=ResolveAliasType(LHS.TypeEl);
  12724. if TypeEl.ClassType=TPasEnumType then
  12725. begin
  12726. if RHS.BaseType=btRange then
  12727. begin
  12728. RTypeEl:=ResolveAliasType(RHS.TypeEl);
  12729. if RTypeEl.ClassType=TPasRangeType then
  12730. begin
  12731. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  12732. if ResolvedEl.BaseType=btContext then
  12733. begin
  12734. RTypeEl:=ResolveAliasType(ResolvedEl.TypeEl);
  12735. if TypeEl=RTypeEl then
  12736. exit(cCompatible);
  12737. end;
  12738. end;
  12739. end;
  12740. end;
  12741. end;
  12742. if RaiseOnIncompatible then
  12743. RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
  12744. [],RHS,LHS,RErrorEl)
  12745. else
  12746. exit(cIncompatible);
  12747. end;
  12748. function TPasResolver.ResolvedElCanBeVarParam(
  12749. const ResolvedEl: TPasResolverResult): boolean;
  12750. begin
  12751. Result:=false;
  12752. if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
  12753. exit;
  12754. if ResolvedEl.IdentEl=nil then exit;
  12755. if ResolvedEl.IdentEl.ClassType=TPasVariable then
  12756. exit(true);
  12757. if (ResolvedEl.IdentEl.ClassType=TPasArgument) then
  12758. begin
  12759. Result:=(TPasArgument(ResolvedEl.IdentEl).Access in [argDefault, argVar, argOut]);
  12760. exit;
  12761. end;
  12762. if ResolvedEl.IdentEl.ClassType=TPasResultElement then
  12763. exit(true);
  12764. if (ResolvedEl.IdentEl.ClassType=TPasConst) then
  12765. begin
  12766. // typed const are writable
  12767. Result:=(TPasConst(ResolvedEl.IdentEl).VarType<>nil);
  12768. exit;
  12769. end;
  12770. if (proPropertyAsVarParam in Options)
  12771. and (ResolvedEl.IdentEl.ClassType=TPasProperty) then
  12772. exit(true);
  12773. end;
  12774. function TPasResolver.ResolvedElIsClassInstance(
  12775. const ResolvedEl: TPasResolverResult): boolean;
  12776. var
  12777. TypeEl: TPasType;
  12778. begin
  12779. Result:=false;
  12780. if ResolvedEl.BaseType<>btContext then exit;
  12781. TypeEl:=ResolvedEl.TypeEl;
  12782. if TypeEl=nil then exit;
  12783. if TypeEl.ClassType<>TPasClassType then exit;
  12784. if TPasClassType(TypeEl).ObjKind<>okClass then exit;
  12785. if (ResolvedEl.IdentEl is TPasVariable)
  12786. or (ResolvedEl.IdentEl.ClassType=TPasArgument)
  12787. or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
  12788. exit(true);
  12789. end;
  12790. function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
  12791. UseName: boolean; AddPaths: boolean): string;
  12792. var
  12793. Args: TFPList;
  12794. i: Integer;
  12795. Arg: TPasArgument;
  12796. begin
  12797. if ProcType=nil then exit('nil');
  12798. Result:=ProcType.TypeName;
  12799. if ProcType.IsReferenceTo then
  12800. Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
  12801. if UseName and (ProcType.Parent is TPasProcedure) then
  12802. begin
  12803. if AddPaths then
  12804. Result:=Result+' '+ProcType.Parent.FullName
  12805. else
  12806. Result:=Result+' '+ProcType.Parent.Name;
  12807. end;
  12808. Args:=ProcType.Args;
  12809. if Args.Count>0 then
  12810. begin
  12811. Result:=Result+'(';
  12812. for i:=0 to Args.Count-1 do
  12813. begin
  12814. if i>0 then Result:=Result+';';
  12815. Arg:=TPasArgument(Args[i]);
  12816. if AccessNames[Arg.Access]<>'' then
  12817. Result:=Result+AccessNames[Arg.Access];
  12818. if Arg.ArgType=nil then
  12819. Result:=Result+'untyped'
  12820. else
  12821. Result:=Result+GetTypeDescription(Arg.ArgType,AddPaths);
  12822. end;
  12823. Result:=Result+')';
  12824. end;
  12825. if ProcType.IsOfObject then
  12826. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  12827. if ProcType.IsNested then
  12828. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  12829. if cCallingConventions[ProcType.CallingConvention]<>'' then
  12830. Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
  12831. end;
  12832. function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
  12833. OnlyType: boolean): string;
  12834. function GetSubTypeName: string;
  12835. begin
  12836. if (T.TypeEl<>nil) and (T.TypeEl.Name<>'') then
  12837. Result:=T.TypeEl.Name
  12838. else
  12839. Result:=BaseTypeNames[T.SubType];
  12840. end;
  12841. var
  12842. ArrayEl: TPasArrayType;
  12843. begin
  12844. case T.BaseType of
  12845. btModule: exit(T.IdentEl.ElementTypeName+' '+T.IdentEl.Name);
  12846. btNil: exit('nil');
  12847. btRange:
  12848. Result:='range of '+GetSubTypeName;
  12849. btSet:
  12850. Result:='set/array literal of '+GetSubTypeName;
  12851. btContext:
  12852. begin
  12853. if T.TypeEl.ClassType=TPasClassOfType then
  12854. Result:='class of '+TPasClassOfType(T.TypeEl).DestType.Name
  12855. else if T.TypeEl.ClassType=TPasAliasType then
  12856. Result:=TPasAliasType(T.TypeEl).DestType.Name
  12857. else if T.TypeEl.ClassType=TPasTypeAliasType then
  12858. Result:='type '+TPasAliasType(T.TypeEl).DestType.Name
  12859. else if T.TypeEl.ClassType=TPasArrayType then
  12860. begin
  12861. ArrayEl:=TPasArrayType(T.TypeEl);
  12862. if length(ArrayEl.Ranges)=0 then
  12863. Result:='array of '+ArrayEl.ElType.Name
  12864. else
  12865. Result:='static array[] of '+ArrayEl.ElType.Name;
  12866. end
  12867. else if T.TypeEl is TPasProcedureType then
  12868. Result:=GetProcTypeDescription(TPasProcedureType(T.TypeEl),false)
  12869. else if T.TypeEl.Name<>'' then
  12870. Result:=T.TypeEl.Name
  12871. else
  12872. Result:=T.TypeEl.ElementTypeName;
  12873. end;
  12874. btCustom:
  12875. Result:=T.TypeEl.Name;
  12876. else
  12877. Result:=BaseTypeNames[T.BaseType];
  12878. end;
  12879. if (not OnlyType) and (T.TypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
  12880. Result:=T.IdentEl.Name+':'+Result;
  12881. end;
  12882. function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
  12883. function GetName: string;
  12884. var
  12885. s: String;
  12886. begin
  12887. Result:=aType.Name;
  12888. if Result='' then
  12889. Result:=aType.ElementTypeName;
  12890. if AddPath then
  12891. begin
  12892. s:=aType.FullPath;
  12893. if (s<>'') and (s<>'.') then
  12894. Result:=s+':'+Result;
  12895. end;
  12896. end;
  12897. var
  12898. C: TClass;
  12899. begin
  12900. if aType=nil then exit('untyped');
  12901. C:=aType.ClassType;
  12902. Result:=GetName;
  12903. if (C=TPasUnresolvedSymbolRef) then
  12904. begin
  12905. if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
  12906. Result:=Result+'()';
  12907. exit;
  12908. end;
  12909. end;
  12910. function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
  12911. AddPath: boolean): string;
  12912. begin
  12913. Result:=GetTypeDescription(R.TypeEl,AddPath);
  12914. if R.IdentEl=R.TypeEl then
  12915. begin
  12916. if R.TypeEl.ElementTypeName<>'' then
  12917. Result:=R.TypeEl.ElementTypeName+' '+Result
  12918. else
  12919. Result:='type '+Result;
  12920. end;
  12921. end;
  12922. function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
  12923. AddPath: boolean): string;
  12924. begin
  12925. if R.BaseType=btContext then
  12926. Result:=GetTypeDescription(R,AddPath)
  12927. else
  12928. Result:=BaseTypeNames[R.BaseType];
  12929. end;
  12930. function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
  12931. begin
  12932. Result:=nil;
  12933. while El<>nil do
  12934. begin
  12935. if El.VarType<>nil then
  12936. exit(El.VarType);
  12937. El:=GetPasPropertyAncestor(El);
  12938. end;
  12939. end;
  12940. function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
  12941. WithRedeclarations: boolean): TPasProperty;
  12942. begin
  12943. Result:=nil;
  12944. if El=nil then exit;
  12945. if (not WithRedeclarations) and (El.VarType<>nil) then exit;
  12946. if El.CustomData=nil then exit;
  12947. Result:=TPasPropertyScope(El.CustomData).AncestorProp;
  12948. end;
  12949. function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
  12950. // search the member variable or getter function of a property
  12951. var
  12952. DeclEl: TPasElement;
  12953. begin
  12954. Result:=nil;
  12955. while El<>nil do
  12956. begin
  12957. if El.ReadAccessor<>nil then
  12958. begin
  12959. DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
  12960. Result:=DeclEl;
  12961. exit;
  12962. end;
  12963. El:=GetPasPropertyAncestor(El);
  12964. end;
  12965. end;
  12966. function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
  12967. // search the member variable or setter procedure of a property
  12968. var
  12969. DeclEl: TPasElement;
  12970. begin
  12971. Result:=nil;
  12972. while El<>nil do
  12973. begin
  12974. if El.WriteAccessor<>nil then
  12975. begin
  12976. DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
  12977. Result:=DeclEl;
  12978. exit;
  12979. end;
  12980. El:=GetPasPropertyAncestor(El);
  12981. end;
  12982. end;
  12983. function TPasResolver.GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  12984. // search the index expression of a property
  12985. begin
  12986. Result:=nil;
  12987. while El<>nil do
  12988. begin
  12989. if El.IndexExpr<>nil then
  12990. begin
  12991. Result:=El.IndexExpr;
  12992. exit;
  12993. end;
  12994. El:=GetPasPropertyAncestor(El);
  12995. end;
  12996. end;
  12997. function TPasResolver.GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  12998. // search the stored expression of a property
  12999. begin
  13000. Result:=nil;
  13001. while El<>nil do
  13002. begin
  13003. if El.StoredAccessor<>nil then
  13004. begin
  13005. Result:=El.StoredAccessor;
  13006. exit;
  13007. end;
  13008. El:=GetPasPropertyAncestor(El);
  13009. end;
  13010. end;
  13011. function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
  13012. Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
  13013. SetReferenceFlags: boolean): integer;
  13014. var
  13015. ExprResolved, ParamResolved: TPasResolverResult;
  13016. NeedVar: Boolean;
  13017. RHSFlags: TPasResolverComputeFlags;
  13018. begin
  13019. Result:=cIncompatible;
  13020. NeedVar:=Param.Access in [argVar, argOut];
  13021. ComputeElement(Param,ParamResolved,[]);
  13022. {$IFDEF VerbosePasResolver}
  13023. writeln('TPasResolver.CheckParamCompatibility Param=',GetTreeDbg(Param,2),' ParamResolved=',GetResolverResultDbg(ParamResolved));
  13024. {$ENDIF}
  13025. if (ParamResolved.TypeEl=nil) and (Param.ArgType<>nil) then
  13026. RaiseInternalError(20160922163628,'GetResolvedType returned TypeEl=nil for '+GetTreeDbg(Param));
  13027. if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  13028. begin
  13029. // passing a const set
  13030. if NeedVar then
  13031. begin
  13032. if RaiseOnError then
  13033. RaiseMsg(20170216152450,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  13034. exit;
  13035. end;
  13036. if ParamResolved.TypeEl is TPasArrayType then
  13037. begin
  13038. Result:=CheckConstArrayCompatibility(TParamsExpr(Expr),ParamResolved,
  13039. RaiseOnError,[],Expr);
  13040. if (Result=cIncompatible) and RaiseOnError then
  13041. RaiseInternalError(20170326211129);
  13042. exit;
  13043. end;
  13044. end;
  13045. RHSFlags:=[];
  13046. if NeedVar then
  13047. Include(RHSFlags,rcNoImplicitProc)
  13048. else if IsProcedureType(ParamResolved,true)
  13049. or (ParamResolved.BaseType=btPointer)
  13050. or (Param.ArgType=nil) then
  13051. Include(RHSFlags,rcNoImplicitProcType);
  13052. if SetReferenceFlags then
  13053. Include(RHSFlags,rcSetReferenceFlags);
  13054. ComputeElement(Expr,ExprResolved,RHSFlags); // ToDo: btArrayLit: if ParamResolved is array then pass ArrType and Dim
  13055. {$IFDEF VerbosePasResolver}
  13056. writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDbg(Expr,2),' ResolvedExpr=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
  13057. {$ENDIF}
  13058. if NeedVar then
  13059. begin
  13060. // Expr must be a variable
  13061. if not ResolvedElCanBeVarParam(ExprResolved) then
  13062. begin
  13063. {$IFDEF VerbosePasResolver}
  13064. writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
  13065. {$ENDIF}
  13066. if RaiseOnError then
  13067. RaiseMsg(20170216152450,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  13068. exit;
  13069. end;
  13070. if (ParamResolved.BaseType=ExprResolved.BaseType) then
  13071. begin
  13072. if IsSameType(ParamResolved.TypeEl,ExprResolved.TypeEl) then
  13073. exit(cExact);
  13074. end;
  13075. if (Param.ArgType=nil) then
  13076. exit(cExact); // untyped argument
  13077. if RaiseOnError then
  13078. RaiseIncompatibleType(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
  13079. [IntToStr(ParamNo+1)],ExprResolved.TypeEl,ParamResolved.TypeEl,
  13080. Expr);
  13081. exit(cIncompatible);
  13082. end;
  13083. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
  13084. if (Result=cIncompatible) and RaiseOnError then
  13085. RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
  13086. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
  13087. end;
  13088. function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
  13089. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  13090. ): integer;
  13091. var
  13092. RTypeEl, LTypeEl: TPasType;
  13093. SrcResolved, DstResolved: TPasResolverResult;
  13094. LArray, RArray: TPasArrayType;
  13095. function RaiseIncompatType: integer;
  13096. begin
  13097. if not RaiseOnIncompatible then exit(cIncompatible);
  13098. RaiseIncompatibleTypeRes(20170216152505,nIncompatibleTypesGotExpected,
  13099. [],RHS,LHS,ErrorEl);
  13100. end;
  13101. begin
  13102. if (RHS.TypeEl=nil) then
  13103. RaiseInternalError(20160922163645);
  13104. if (LHS.TypeEl=nil) then
  13105. RaiseInternalError(20160922163648);
  13106. LTypeEl:=ResolveAliasType(LHS.TypeEl);
  13107. RTypeEl:=ResolveAliasType(RHS.TypeEl);
  13108. if LTypeEl=RTypeEl then
  13109. exit(cExact);
  13110. {$IFDEF VerbosePasResolver}
  13111. writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
  13112. {$ENDIF}
  13113. Result:=-1;
  13114. if LTypeEl.ClassType=TPasClassType then
  13115. begin
  13116. if RHS.BaseType=btNil then
  13117. Result:=cExact
  13118. else if RTypeEl.ClassType=TPasClassType then
  13119. begin
  13120. Result:=CheckSrcIsADstType(RHS,LHS,ErrorEl);
  13121. if (Result=cIncompatible) and RaiseOnIncompatible then
  13122. RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
  13123. [],RTypeEl,LTypeEl,ErrorEl);
  13124. end
  13125. else
  13126. exit(RaiseIncompatType);
  13127. end
  13128. else if LTypeEl.ClassType=TPasClassOfType then
  13129. begin
  13130. if RHS.BaseType=btNil then
  13131. Result:=cExact
  13132. else if (RTypeEl.ClassType=TPasClassOfType) then
  13133. begin
  13134. // e.g. ImageClass:=AnotherImageClass;
  13135. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  13136. TPasClassOfType(LTypeEl).DestType,ErrorEl);
  13137. if (Result=cIncompatible) and RaiseOnIncompatible then
  13138. RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  13139. ['class of '+TPasClassOfType(RTypeEl).DestType.FullName,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
  13140. end
  13141. else if (RHS.IdentEl is TPasClassType)
  13142. or ((RHS.IdentEl is TPasAliasType)
  13143. and (ResolveAliasType(TPasAliasType(RHS.IdentEl)).ClassType=TPasClassType)) then
  13144. begin
  13145. // e.g. ImageClass:=TFPMemoryImage;
  13146. Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType,ErrorEl);
  13147. if (Result=cIncompatible) and RaiseOnIncompatible then
  13148. RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  13149. [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
  13150. // do not check rrfReadable -> exit
  13151. exit;
  13152. end;
  13153. end
  13154. else if LTypeEl is TPasProcedureType then
  13155. begin
  13156. if RHS.BaseType=btNil then
  13157. exit(cExact);
  13158. //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);
  13159. if (LTypeEl.ClassType=RTypeEl.ClassType)
  13160. and (rrfReadable in RHS.Flags) then
  13161. begin
  13162. // e.g. ProcVar1:=ProcVar2
  13163. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  13164. true,ErrorEl,RaiseOnIncompatible) then
  13165. exit(cExact);
  13166. end;
  13167. if RaiseOnIncompatible then
  13168. begin
  13169. if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
  13170. RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  13171. [RTypeEl.ElementTypeName,LTypeEl.ElementTypeName],ErrorEl);
  13172. end;
  13173. end
  13174. else if LTypeEl.ClassType=TPasArrayType then
  13175. begin
  13176. // arrays of different types
  13177. if IsOpenArray(LTypeEl) and (RTypeEl.ClassType=TPasArrayType) then
  13178. begin
  13179. LArray:=TPasArrayType(LTypeEl);
  13180. RArray:=TPasArrayType(RTypeEl);
  13181. if (length(RArray.Ranges)=1)
  13182. or ((proOpenAsDynArrays in Options) and (length(RArray.Ranges)=0))
  13183. or IsOpenArray(RTypeEl) then
  13184. begin
  13185. if CheckProcArgTypeCompatibility(LArray.ElType,RArray.ElType) then
  13186. Result:=cExact
  13187. else if RaiseOnIncompatible then
  13188. RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  13189. ['array of '+LArray.ElType.FullName,
  13190. 'array of '+RArray.ElType.FullName],ErrorEl)
  13191. else
  13192. exit(cIncompatible);
  13193. end;
  13194. end;
  13195. end
  13196. else if LTypeEl.ClassType=TPasRecordType then
  13197. begin
  13198. // records of different type
  13199. end
  13200. else if LTypeEl.ClassType=TPasEnumType then
  13201. begin
  13202. // enums of different type
  13203. end
  13204. else if RTypeEl.ClassType=TPasSetType then
  13205. begin
  13206. // sets of different type are compatible if enum types are compatible
  13207. if LTypeEl.ClassType=TPasSetType then
  13208. begin
  13209. ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
  13210. ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
  13211. if (SrcResolved.TypeEl<>nil)
  13212. and (SrcResolved.TypeEl=DstResolved.TypeEl) then
  13213. Result:=cExact
  13214. else if (SrcResolved.TypeEl.CustomData is TResElDataBaseType)
  13215. and (DstResolved.TypeEl.CustomData is TResElDataBaseType)
  13216. and (CompareText(SrcResolved.TypeEl.Name,DstResolved.TypeEl.Name)=0) then
  13217. Result:=cExact
  13218. else if RaiseOnIncompatible then
  13219. RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
  13220. [],SrcResolved,DstResolved,ErrorEl)
  13221. else
  13222. exit(cIncompatible);
  13223. end
  13224. else
  13225. exit(RaiseIncompatType);
  13226. end
  13227. else
  13228. RaiseNotYetImplemented(20160922163654,ErrorEl);
  13229. if Result=-1 then
  13230. exit(RaiseIncompatType);
  13231. if not (rrfReadable in RHS.Flags) then
  13232. exit(RaiseIncompatType);
  13233. end;
  13234. function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
  13235. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  13236. ): integer;
  13237. procedure Check_ArrayOfChar_String(ArrType: TPasArrayType;
  13238. ArrLength: integer; const ElTypeResolved: TPasResolverResult;
  13239. Expr: TPasExpr; ErrorEl: TPasElement);
  13240. // check if assigning a string to an array of char fits
  13241. var
  13242. Value: TResEvalValue;
  13243. ElBT: TResolverBaseType;
  13244. l: Integer;
  13245. US: UnicodeString;
  13246. S: String;
  13247. begin
  13248. if Expr=nil then exit;
  13249. ElBT:=GetActualBaseType(ElTypeResolved.BaseType);
  13250. if length(ArrType.Ranges)=0 then
  13251. begin
  13252. // dynamic array of char can hold any string
  13253. // ToDo: check if value can be converted without loss
  13254. Result:=cExact;
  13255. exit;
  13256. end;
  13257. // static array -> check length of string
  13258. Value:=Eval(Expr,[refAutoConst]);
  13259. try
  13260. case Value.Kind of
  13261. revkString:
  13262. if ElBT=btAnsiChar then
  13263. l:=length(TResEvalString(Value).S)
  13264. else
  13265. begin
  13266. US:=fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,ErrorEl);
  13267. l:=length(US);
  13268. end;
  13269. revkUnicodeString:
  13270. begin
  13271. if ElBT=btWideChar then
  13272. l:=length(TResEvalUTF16(Value).S)
  13273. else
  13274. begin
  13275. S:=String(TResEvalUTF16(Value).S);
  13276. l:=length(S);
  13277. end;
  13278. end;
  13279. else
  13280. {$IFDEF VerbosePasResolver}
  13281. writeln('Check_ArrayOfChar_String Value=',Value.AsDebugString);
  13282. {$ENDIF}
  13283. exit; // incompatible
  13284. end;
  13285. if ArrLength<>l then
  13286. begin
  13287. {$IFDEF VerbosePasResolver}
  13288. writeln('Check_ArrayOfChar_String ElType=',ElBT,'=',GetResolverResultDbg(ElTypeResolved),' Value=',Value.AsDebugString);
  13289. {$ENDIF}
  13290. RaiseMsg(20170913113216,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  13291. [IntToStr(ArrLength),IntToStr(l)],ErrorEl);
  13292. end;
  13293. Result:=cExact;
  13294. finally
  13295. ReleaseEvalValue(Value);
  13296. end;
  13297. end;
  13298. procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
  13299. Values: TPasResolverResult; ErrorEl: TPasElement);
  13300. var
  13301. Range, Value, Expr: TPasExpr;
  13302. RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
  13303. i, Count: Integer;
  13304. IsLastRange: Boolean;
  13305. ArrayValues: TPasExprArray;
  13306. Impl: TPasElement;
  13307. begin
  13308. Expr:=Values.ExprEl;
  13309. if (Expr=nil) and (Values.IdentEl is TPasVariable) then
  13310. Expr:=TPasVariable(Values.IdentEl).Expr;
  13311. if length(ArrType.Ranges)=0 then
  13312. begin
  13313. // dynamic array
  13314. if (Expr<>nil) then
  13315. begin
  13316. if Expr.ClassType=TArrayValues then
  13317. Count:=length(TArrayValues(Expr).Values)
  13318. else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  13319. Count:=length(TParamsExpr(Expr).Params)
  13320. else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
  13321. begin
  13322. // const a: dynarray = string
  13323. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  13324. if ElTypeResolved.BaseType in btAllChars then
  13325. Result:=cExact;
  13326. exit;
  13327. end
  13328. else
  13329. begin
  13330. // single value
  13331. exit;
  13332. end;
  13333. end;
  13334. IsLastRange:=true;
  13335. end
  13336. else
  13337. begin
  13338. // static array
  13339. Range:=ArrType.Ranges[RangeIndex];
  13340. Count:=GetRangeLength(Range);
  13341. if Count=0 then
  13342. begin
  13343. ComputeElement(Range,RangeResolved,[rcConstant]);
  13344. RaiseNotYetImplemented(20170222232409,Expr,'range '+GetResolverResultDbg(RangeResolved));
  13345. end;
  13346. IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
  13347. end;
  13348. if IsLastRange then
  13349. begin
  13350. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  13351. ElTypeResolved.ExprEl:=Range;
  13352. Include(ElTypeResolved.Flags,rrfWritable);
  13353. end
  13354. else
  13355. ElTypeResolved.BaseType:=btNone;
  13356. if (Expr<>nil) and (Expr.ClassType=TArrayValues) then
  13357. begin
  13358. ArrayValues:=TArrayValues(Expr).Values;
  13359. // check each value
  13360. for i:=0 to Count-1 do
  13361. begin
  13362. if i=length(ArrayValues) then
  13363. begin
  13364. // not enough values
  13365. if length(ArrayValues)>0 then
  13366. ErrorEl:=ArrayValues[length(ArrayValues)-1];
  13367. RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  13368. [IntToStr(Count),IntToStr(length(ArrayValues))],ErrorEl);
  13369. end;
  13370. Value:=ArrayValues[i];
  13371. ComputeElement(Value,ValueResolved,[rcConstant]);
  13372. if IsLastRange then
  13373. begin
  13374. // last dimension -> check element type
  13375. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
  13376. if Result=cIncompatible then
  13377. exit;
  13378. CheckAssignExprRange(ElTypeResolved,Value);
  13379. end
  13380. else
  13381. begin
  13382. // multi dimensional array -> check next range
  13383. CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
  13384. end;
  13385. end;
  13386. if Count<length(ArrayValues) then
  13387. begin
  13388. // too many values
  13389. ErrorEl:=ArrayValues[Count];
  13390. if RaiseOnIncompatible then
  13391. RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  13392. [IntToStr(Count),IntToStr(length(ArrayValues))],ErrorEl);
  13393. exit;
  13394. end;
  13395. end
  13396. else if Values.BaseType=btSet then
  13397. begin
  13398. if ErrorEl.Parent is TPasVariable then
  13399. begin
  13400. // common mistake: const requires () instead of []
  13401. if RaiseOnIncompatible then
  13402. RaiseMsg(20170913181208,nXExpectedButYFound,sXExpectedButYFound,
  13403. ['(','['],ErrorEl);
  13404. exit;
  13405. end;
  13406. Impl:=ErrorEl;
  13407. while (Impl<>nil) and not (Impl is TPasImplBlock) do
  13408. begin
  13409. if Impl is TPasProcedure then
  13410. begin
  13411. Impl:=nil;
  13412. break;
  13413. end;
  13414. Impl:=Impl.Parent;
  13415. end;
  13416. if Impl=nil then
  13417. exit;
  13418. // ToDo: btArrayLit: const array in implblock, e.g. arr:=[1,2,3]
  13419. exit;
  13420. end
  13421. else
  13422. begin
  13423. // single value
  13424. // Note: the parser does not store the difference between (1) and 1
  13425. if not IsLastRange then
  13426. begin
  13427. if RaiseOnIncompatible then
  13428. RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  13429. [IntToStr(Count),'1'],ErrorEl);
  13430. exit;
  13431. end;
  13432. if (Values.BaseType in btAllStrings) and (ElTypeResolved.BaseType in btAllChars) then
  13433. begin
  13434. // e.g. array of char = ''
  13435. Check_ArrayOfChar_String(ArrType,Count,ElTypeResolved,Expr,ErrorEl);
  13436. exit;
  13437. end;
  13438. if (Count>1) then
  13439. begin
  13440. if RaiseOnIncompatible then
  13441. begin
  13442. {$IFDEF VerbosePasResolver}
  13443. writeln('CheckRange Values=',GetResolverResultDbg(Values),' ElTypeResolved=',GetResolverResultDbg(ElTypeResolved));
  13444. {$ENDIF}
  13445. RaiseMsg(20170913103143,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  13446. [IntToStr(Count),'1'],ErrorEl);
  13447. end;
  13448. exit;
  13449. end;
  13450. // check element type
  13451. Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
  13452. if Result=cIncompatible then
  13453. exit;
  13454. if Expr<>nil then
  13455. CheckAssignExprRange(ElTypeResolved,Expr);
  13456. end;
  13457. end;
  13458. var
  13459. LArrType: TPasArrayType;
  13460. begin
  13461. Result:=cIncompatible;
  13462. {$IFDEF VerbosePasResolver}
  13463. writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  13464. {$ENDIF}
  13465. if (LHS.BaseType<>btContext) or (not (LHS.TypeEl is TPasArrayType)) then
  13466. RaiseInternalError(20170222230012);
  13467. if not (rrfReadable in RHS.Flags) then
  13468. exit;
  13469. LArrType:=TPasArrayType(LHS.TypeEl);
  13470. if RHS.ExprEl=nil then
  13471. exit;
  13472. if IsEmptySet(RHS) then
  13473. begin
  13474. if (length(LArrType.Ranges)=0) then
  13475. exit(cExact); // empty set fits open and dyn array
  13476. end;
  13477. CheckRange(LArrType,0,RHS,ErrorEl);
  13478. end;
  13479. function TPasResolver.CheckConstArrayCompatibility(Params: TParamsExpr;
  13480. const ArrayResolved: TPasResolverResult; RaiseOnError: boolean;
  13481. Flags: TPasResolverComputeFlags; StartEl: TPasElement): integer;
  13482. // check that each Param fits the array element type
  13483. var
  13484. i, ParamComp: Integer;
  13485. Param: TPasExpr;
  13486. ArrayType: TPasArrayType;
  13487. ElTypeResolved, ParamResolved: TPasResolverResult;
  13488. ElTypeIsArray: boolean;
  13489. begin
  13490. {$IFDEF VerbosePasResolver}
  13491. writeln('TPasResolver.CheckConstArrayCompatibility Params.length=',length(Params.Params),
  13492. ' ArrayResolved=',GetResolverResultDbg(ArrayResolved),' Flags=',dbgs(Flags));
  13493. {$ENDIF}
  13494. if not (ArrayResolved.TypeEl is TPasArrayType) then
  13495. RaiseInternalError(20170326204957);
  13496. ArrayType:=TPasArrayType(ArrayResolved.TypeEl);
  13497. ComputeElement(ArrayType.ElType,ElTypeResolved,Flags+[rcType]);
  13498. ElTypeIsArray:=ResolveAliasType(ElTypeResolved.TypeEl) is TPasArrayType;
  13499. Result:=cExact;
  13500. for i:=0 to length(Params.Params)-1 do
  13501. begin
  13502. Param:=Params.Params[i];
  13503. if ElTypeIsArray and (Param is TParamsExpr) and (TParamsExpr(Param).Kind=pekSet) then
  13504. ParamComp:=CheckConstArrayCompatibility(TParamsExpr(Param),ElTypeResolved,
  13505. RaiseOnError,Flags,StartEl)
  13506. else
  13507. begin
  13508. ComputeElement(Param,ParamResolved,Flags,StartEl);
  13509. ParamComp:=CheckAssignResCompatibility(ElTypeResolved,ParamResolved,Param,RaiseOnError);
  13510. end;
  13511. if ParamComp=cIncompatible then
  13512. exit(cIncompatible);
  13513. inc(Result,ParamComp);
  13514. end;
  13515. end;
  13516. function TPasResolver.CheckEqualCompatibilityUserType(const TypeA,
  13517. TypeB: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  13518. ): integer;
  13519. var
  13520. ElA, ElB: TPasType;
  13521. AResolved, BResolved: TPasResolverResult;
  13522. function IncompatibleElements: integer;
  13523. begin
  13524. Result:=cIncompatible;
  13525. if not RaiseOnIncompatible then exit;
  13526. RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
  13527. [],ElA,ElB,ErrorEl);
  13528. end;
  13529. begin
  13530. if (TypeA.TypeEl=nil) then
  13531. RaiseInternalError(20161007223118);
  13532. if (TypeB.TypeEl=nil) then
  13533. RaiseInternalError(20161007223119);
  13534. ElA:=TypeA.TypeEl;
  13535. ElB:=TypeB.TypeEl;
  13536. if ElA=ElB then
  13537. exit(cExact);
  13538. if ElA.ClassType=TPasClassType then
  13539. begin
  13540. if TypeA.IdentEl is TPasType then
  13541. begin
  13542. if (TypeB.IdentEl is TPasType) and (ElA=ElB) then
  13543. // e.g. if TFPMemoryImage=TFPMemoryImage then ;
  13544. exit(cExact);
  13545. if ElB.ClassType=TPasClassOfType then
  13546. begin
  13547. // e.g. if TFPMemoryImage=ImageClass then ;
  13548. Result:=CheckClassIsClass(ElA,TPasClassOfType(ElB).DestType,ErrorEl);
  13549. if (Result=cIncompatible) and RaiseOnIncompatible then
  13550. RaiseMsg(20170216152515,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
  13551. exit;
  13552. end;
  13553. end
  13554. else if ElB.ClassType=TPasClassType then
  13555. begin
  13556. // e.g. if Sender=Button1 then
  13557. Result:=CheckSrcIsADstType(TypeA,TypeB,ErrorEl);
  13558. if Result=cIncompatible then
  13559. Result:=CheckSrcIsADstType(TypeB,TypeA,ErrorEl);
  13560. if (Result=cIncompatible) and RaiseOnIncompatible then
  13561. RaiseMsg(20170216152517,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
  13562. exit;
  13563. end;
  13564. exit(IncompatibleElements);
  13565. end
  13566. else if ElA.ClassType=TPasClassOfType then
  13567. begin
  13568. if ElB.ClassType=TPasClassOfType then
  13569. begin
  13570. // for example: if ImageClass=ImageClass then
  13571. Result:=CheckClassIsClass(TPasClassOfType(ElA).DestType,
  13572. TPasClassOfType(ElB).DestType,ErrorEl);
  13573. if Result=cIncompatible then
  13574. Result:=CheckClassIsClass(TPasClassOfType(ElB).DestType,
  13575. TPasClassOfType(ElA).DestType,ErrorEl);
  13576. if (Result=cIncompatible) and RaiseOnIncompatible then
  13577. RaiseMsg(20170216152519,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
  13578. exit;
  13579. end
  13580. else if TypeB.IdentEl is TPasClassType then
  13581. begin
  13582. // for example: if ImageClass=TFPMemoryImage then
  13583. Result:=CheckClassIsClass(TPasClassType(TypeB.IdentEl),
  13584. TPasClassOfType(ElA).DestType,ErrorEl);
  13585. if (Result=cIncompatible) and RaiseOnIncompatible then
  13586. RaiseMsg(20170216152520,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
  13587. exit;
  13588. end;
  13589. exit(IncompatibleElements);
  13590. end
  13591. else if ElA.ClassType=TPasEnumType then
  13592. begin
  13593. // enums of different type
  13594. if not RaiseOnIncompatible then
  13595. exit(cIncompatible);
  13596. if ElB.ClassType=TPasEnumValue then
  13597. RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
  13598. [],TPasEnumType(ElA),TPasEnumType(ElB),ErrorEl)
  13599. else
  13600. exit(IncompatibleElements);
  13601. end
  13602. else if ElA.ClassType=TPasSetType then
  13603. begin
  13604. if ElB.ClassType=TPasSetType then
  13605. begin
  13606. ComputeElement(TPasSetType(ElA).EnumType,AResolved,[]);
  13607. ComputeElement(TPasSetType(ElB).EnumType,BResolved,[]);
  13608. if (AResolved.TypeEl<>nil)
  13609. and (AResolved.TypeEl=BResolved.TypeEl) then
  13610. exit(cExact);
  13611. if (AResolved.TypeEl.CustomData is TResElDataBaseType)
  13612. and (BResolved.TypeEl.CustomData is TResElDataBaseType)
  13613. and (CompareText(AResolved.TypeEl.Name,BResolved.TypeEl.Name)=0) then
  13614. exit(cExact);
  13615. if RaiseOnIncompatible then
  13616. RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
  13617. [],AResolved,BResolved,ErrorEl)
  13618. else
  13619. exit(cIncompatible);
  13620. end
  13621. else
  13622. exit(IncompatibleElements);
  13623. end
  13624. else if (ElA is TPasProcedureType) and (rrfReadable in TypeA.Flags) then
  13625. begin
  13626. if (ElB is TPasProcedureType) and (rrfReadable in TypeB.Flags) then
  13627. begin
  13628. // e.g. ProcVar1 = ProcVar2
  13629. if CheckProcTypeCompatibility(TPasProcedureType(ElA),TPasProcedureType(ElB),
  13630. false,nil,false) then
  13631. exit(cExact);
  13632. end
  13633. else
  13634. exit(IncompatibleElements);
  13635. end;
  13636. exit(IncompatibleElements);
  13637. end;
  13638. function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
  13639. RaiseOnError: boolean): integer;
  13640. // for example if TClassA(AnObject)=nil then ;
  13641. var
  13642. Param: TPasExpr;
  13643. ParamResolved, ResolvedEl: TPasResolverResult;
  13644. begin
  13645. if length(Params.Params)<>1 then
  13646. begin
  13647. if RaiseOnError then
  13648. RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
  13649. sWrongNumberOfParametersForTypeCast,[El.Name],Params);
  13650. exit(cIncompatible);
  13651. end;
  13652. Param:=Params.Params[0];
  13653. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  13654. ComputeElement(El,ResolvedEl,[rcType]);
  13655. Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
  13656. end;
  13657. function TPasResolver.CheckTypeCastRes(const FromResolved,
  13658. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  13659. ): integer;
  13660. var
  13661. ToTypeEl, ToClassType, FromClassType, FromTypeEl: TPasType;
  13662. ToTypeBaseType: TResolverBaseType;
  13663. C: TClass;
  13664. ToProcType, FromProcType: TPasProcedureType;
  13665. begin
  13666. Result:=cIncompatible;
  13667. ToTypeEl:=ResolveAliasType(ToResolved.TypeEl);
  13668. if (ToTypeEl<>nil)
  13669. and (rrfReadable in FromResolved.Flags) then
  13670. begin
  13671. C:=ToTypeEl.ClassType;
  13672. if FromResolved.BaseType=btUntyped then
  13673. begin
  13674. // typecast an untyped parameter
  13675. Result:=cCompatible;
  13676. end
  13677. else if C=TPasUnresolvedSymbolRef then
  13678. begin
  13679. if ToTypeEl.CustomData is TResElDataBaseType then
  13680. begin
  13681. // base type cast, e.g. double(aninteger)
  13682. if ToTypeEl=FromResolved.TypeEl then
  13683. exit(cExact);
  13684. ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
  13685. if ToTypeBaseType=FromResolved.BaseType then
  13686. Result:=cExact
  13687. else if ToTypeBaseType in btAllInteger then
  13688. begin
  13689. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  13690. Result:=cCompatible
  13691. else if FromResolved.BaseType=btContext then
  13692. begin
  13693. FromTypeEl:=ResolveAliasType(FromResolved.TypeEl);
  13694. if FromTypeEl.ClassType=TPasEnumType then
  13695. // e.g. longint(TEnum)
  13696. Result:=cCompatible;
  13697. end;
  13698. end
  13699. else if ToTypeBaseType in btAllFloats then
  13700. begin
  13701. if FromResolved.BaseType in btAllFloats then
  13702. Result:=cCompatible
  13703. else if FromResolved.BaseType in btAllInteger then
  13704. Result:=cCompatible;
  13705. end
  13706. else if ToTypeBaseType in btAllBooleans then
  13707. begin
  13708. if FromResolved.BaseType in btAllBooleans then
  13709. Result:=cCompatible
  13710. else if FromResolved.BaseType in btAllInteger then
  13711. Result:=cCompatible;
  13712. end
  13713. else if ToTypeBaseType in btAllChars then
  13714. begin
  13715. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  13716. Result:=cCompatible
  13717. else if FromResolved.BaseType=btContext then
  13718. begin
  13719. FromTypeEl:=ResolveAliasType(FromResolved.TypeEl);
  13720. if FromTypeEl.ClassType=TPasEnumType then
  13721. // e.g. char(TEnum)
  13722. Result:=cCompatible;
  13723. end;
  13724. end
  13725. else if ToTypeBaseType in btAllStrings then
  13726. begin
  13727. if FromResolved.BaseType in btAllStringAndChars then
  13728. Result:=cCompatible;
  13729. end
  13730. else if ToTypeBaseType=btPointer then
  13731. begin
  13732. if FromResolved.BaseType=btPointer then
  13733. Result:=cExact
  13734. else if FromResolved.BaseType=btContext then
  13735. begin
  13736. FromTypeEl:=ResolveAliasType(FromResolved.TypeEl);
  13737. C:=FromTypeEl.ClassType;
  13738. if (C=TPasClassType)
  13739. or (C=TPasClassOfType)
  13740. or (C=TPasPointerType)
  13741. or ((C=TPasArrayType) and IsDynArray(FromTypeEl)) then
  13742. Result:=cExact
  13743. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  13744. begin
  13745. // from procvar to pointer
  13746. FromProcType:=TPasProcedureType(FromTypeEl);
  13747. if FromProcType.IsOfObject then
  13748. begin
  13749. if proMethodAddrAsPointer in Options then
  13750. Result:=cCompatible
  13751. else if RaiseOnError then
  13752. RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13753. [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject],
  13754. BaseTypeNames[btPointer]],ErrorEl);
  13755. end
  13756. else if FromProcType.IsNested then
  13757. begin
  13758. if RaiseOnError then
  13759. RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13760. [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested],
  13761. BaseTypeNames[btPointer]],ErrorEl);
  13762. end
  13763. else if FromProcType.IsReferenceTo then
  13764. begin
  13765. if proProcTypeWithoutIsNested in Options then
  13766. Result:=cCompatible
  13767. else if RaiseOnError then
  13768. RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13769. [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo],
  13770. BaseTypeNames[btPointer]],ErrorEl);
  13771. end
  13772. else
  13773. Result:=cCompatible;
  13774. end;
  13775. end;
  13776. end;
  13777. end;
  13778. end
  13779. else if C=TPasClassType then
  13780. begin
  13781. // to class
  13782. if FromResolved.BaseType=btContext then
  13783. begin
  13784. if FromResolved.TypeEl.ClassType=TPasClassType then
  13785. begin
  13786. if FromResolved.IdentEl is TPasType then
  13787. RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  13788. // type cast upwards or downwards
  13789. Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
  13790. if Result=cIncompatible then
  13791. Result:=CheckSrcIsADstType(ToResolved,FromResolved,ErrorEl);
  13792. if Result=cIncompatible then
  13793. Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
  13794. end
  13795. end
  13796. else if FromResolved.BaseType=btPointer then
  13797. begin
  13798. if IsBaseType(FromResolved.TypeEl,btPointer) then
  13799. Result:=cExact; // untyped pointer to class instance
  13800. end;
  13801. end
  13802. else if C=TPasClassOfType then
  13803. begin
  13804. //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.TypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
  13805. if FromResolved.BaseType=btContext then
  13806. begin
  13807. if FromResolved.TypeEl.ClassType=TPasClassOfType then
  13808. begin
  13809. if (FromResolved.IdentEl is TPasType) then
  13810. RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  13811. // type cast classof(classof-var) upwards or downwards
  13812. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  13813. FromClassType:=TPasClassOfType(FromResolved.TypeEl).DestType;
  13814. Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
  13815. end;
  13816. end
  13817. else if FromResolved.BaseType=btPointer then
  13818. begin
  13819. if IsBaseType(FromResolved.TypeEl,btPointer) then
  13820. Result:=cExact; // untyped pointer to class-of
  13821. end;
  13822. end
  13823. else if C=TPasRecordType then
  13824. begin
  13825. if FromResolved.BaseType=btContext then
  13826. begin
  13827. if FromResolved.TypeEl.ClassType=TPasRecordType then
  13828. begin
  13829. // typecast record to record
  13830. Result:=cExact;
  13831. end;
  13832. end;
  13833. end
  13834. else if (C=TPasEnumType)
  13835. or (C=TPasRangeType) then
  13836. begin
  13837. if CheckIsOrdinal(FromResolved,ErrorEl,true) then
  13838. Result:=cExact;
  13839. end
  13840. else if C=TPasArrayType then
  13841. begin
  13842. if FromResolved.BaseType=btContext then
  13843. begin
  13844. if FromResolved.TypeEl.ClassType=TPasArrayType then
  13845. Result:=CheckTypeCastArray(TPasArrayType(FromResolved.TypeEl),
  13846. TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
  13847. end
  13848. else if FromResolved.BaseType=btPointer then
  13849. begin
  13850. if IsDynArray(ToResolved.TypeEl)
  13851. and IsBaseType(FromResolved.TypeEl,btPointer) then
  13852. Result:=cExact; // untyped pointer to dynnamic array
  13853. end;
  13854. end
  13855. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  13856. begin
  13857. ToProcType:=TPasProcedureType(ToTypeEl);
  13858. if IsBaseType(FromResolved.TypeEl,btPointer) then
  13859. begin
  13860. // type cast untyped pointer value to proctype
  13861. if ToProcType.IsOfObject then
  13862. begin
  13863. if proMethodAddrAsPointer in Options then
  13864. Result:=cCompatible
  13865. else if RaiseOnError then
  13866. RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13867. [BaseTypeNames[btPointer],
  13868. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
  13869. end
  13870. else if ToProcType.IsNested then
  13871. begin
  13872. if RaiseOnError then
  13873. RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13874. [BaseTypeNames[btPointer],
  13875. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
  13876. end
  13877. else if ToProcType.IsReferenceTo then
  13878. begin
  13879. if proMethodAddrAsPointer in Options then
  13880. Result:=cCompatible
  13881. else if RaiseOnError then
  13882. RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13883. [BaseTypeNames[btPointer],
  13884. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
  13885. end
  13886. else
  13887. Result:=cCompatible;
  13888. end
  13889. else if FromResolved.BaseType=btContext then
  13890. begin
  13891. if FromResolved.TypeEl is TPasProcedureType then
  13892. begin
  13893. // type cast procvar to proctype
  13894. FromProcType:=TPasProcedureType(FromResolved.TypeEl);
  13895. if ToProcType.IsReferenceTo then
  13896. Result:=cCompatible
  13897. else if FromProcType.IsReferenceTo then
  13898. Result:=cCompatible
  13899. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  13900. and not (proMethodAddrAsPointer in Options) then
  13901. begin
  13902. if RaiseOnError then
  13903. RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13904. [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  13905. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  13906. end
  13907. else if FromProcType.IsNested<>ToProcType.IsNested then
  13908. begin
  13909. if RaiseOnError then
  13910. RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  13911. [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  13912. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  13913. end
  13914. else
  13915. Result:=cCompatible;
  13916. end;
  13917. end;
  13918. end;
  13919. end
  13920. else if ToTypeEl<>nil then
  13921. begin
  13922. // FromResolved is not readable
  13923. if FromResolved.BaseType=btContext then
  13924. begin
  13925. if (FromResolved.TypeEl.ClassType=TPasClassType)
  13926. and (FromResolved.TypeEl=FromResolved.IdentEl)
  13927. and (ToResolved.BaseType=btContext)
  13928. and (ToResolved.TypeEl.ClassType=TPasClassOfType)
  13929. and (ToResolved.TypeEl=ToResolved.IdentEl) then
  13930. begin
  13931. // for example class-of(Self) in a class function
  13932. ToClassType:=TPasClassOfType(ToTypeEl).DestType;
  13933. FromClassType:=TPasClassType(FromResolved.TypeEl);
  13934. Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
  13935. end;
  13936. end;
  13937. if (Result=cIncompatible) and RaiseOnError then
  13938. begin
  13939. if FromResolved.IdentEl is TPasType then
  13940. RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  13941. end;
  13942. end;
  13943. if Result=cIncompatible then
  13944. begin
  13945. {$IFDEF VerbosePasResolver}
  13946. writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
  13947. {$ENDIF}
  13948. if RaiseOnError then
  13949. RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
  13950. [],FromResolved,ToResolved,ErrorEl);
  13951. exit;
  13952. end;
  13953. end;
  13954. function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
  13955. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  13956. function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
  13957. out ElTypeResolved: TPasResolverResult): boolean;
  13958. begin
  13959. inc(NextIndex);
  13960. if NextIndex<length(ArrType.Ranges) then
  13961. begin
  13962. ElTypeResolved.BaseType:=btNone;
  13963. exit(true);
  13964. end;
  13965. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  13966. if (ElTypeResolved.BaseType<>btContext)
  13967. or (ElTypeResolved.TypeEl.ClassType<>TPasArrayType) then
  13968. exit(false);
  13969. ArrType:=TPasArrayType(ElTypeResolved.TypeEl);
  13970. NextIndex:=0;
  13971. Result:=true;
  13972. end;
  13973. var
  13974. FromIndex, ToIndex: Integer;
  13975. FromElTypeRes, ToElTypeRes: TPasResolverResult;
  13976. StartFromType, StartToType: TPasArrayType;
  13977. begin
  13978. {$IFDEF VerbosePasResolver}
  13979. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
  13980. {$ENDIF}
  13981. StartFromType:=FromType;
  13982. StartToType:=ToType;
  13983. Result:=cIncompatible;
  13984. // check dimensions
  13985. FromIndex:=0;
  13986. ToIndex:=0;
  13987. repeat
  13988. {$IFDEF VerbosePasResolver}
  13989. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  13990. {$ENDIF}
  13991. if length(ToType.Ranges)=0 then
  13992. // ToType is dynamic/open array -> fits any size
  13993. else
  13994. begin
  13995. // ToType is ranged
  13996. // ToDo: check size of dimension
  13997. end;
  13998. // check next dimension
  13999. if not NextDim(FromType,FromIndex,FromElTypeRes) then
  14000. begin
  14001. // at end of FromType
  14002. if NextDim(ToType,ToIndex,ToElTypeRes) then
  14003. begin
  14004. {$IFDEF VerbosePasResolver}
  14005. writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  14006. {$ENDIF}
  14007. break; // ToType has more dimensions
  14008. end;
  14009. // have same dimension -> check ElType
  14010. {$IFDEF VerbosePasResolver}
  14011. writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
  14012. {$ENDIF}
  14013. Include(FromElTypeRes.Flags,rrfReadable);
  14014. Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
  14015. break;
  14016. end
  14017. else
  14018. begin
  14019. // FromType has more dimensions
  14020. if not NextDim(ToType,ToIndex,ToElTypeRes) then
  14021. begin
  14022. {$IFDEF VerbosePasResolver}
  14023. writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  14024. {$ENDIF}
  14025. break; // ToType has less dimensions
  14026. end;
  14027. end;
  14028. until false;
  14029. if (Result=cIncompatible) and RaiseOnError then
  14030. RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
  14031. [],StartFromType,StartToType,ErrorEl);
  14032. end;
  14033. procedure TPasResolver.ComputeElement(El: TPasElement; out
  14034. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  14035. StartEl: TPasElement);
  14036. procedure ComputeIdentifier(Expr: TPasExpr);
  14037. var
  14038. Ref: TResolvedReference;
  14039. Proc: TPasProcedure;
  14040. ProcType: TPasProcedureType;
  14041. aClass: TPasClassType;
  14042. begin
  14043. Ref:=TResolvedReference(Expr.CustomData);
  14044. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  14045. if rrfConstInherited in Ref.Flags then
  14046. Exclude(ResolvedEl.Flags,rrfWritable);
  14047. {$IFDEF VerbosePasResolver}
  14048. if Expr is TPrimitiveExpr then
  14049. writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
  14050. else
  14051. writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
  14052. {$ENDIF}
  14053. if (ResolvedEl.BaseType=btProc) then
  14054. begin
  14055. // proc
  14056. if [rcNoImplicitProc,rcConstant,rcType]*Flags=[] then
  14057. begin
  14058. // implicit call without params is allowed -> check if possible
  14059. Proc:=ResolvedEl.IdentEl as TPasProcedure;
  14060. if not ProcNeedsParams(Proc.ProcType) then
  14061. begin
  14062. // parameter less proc -> implicit call possible
  14063. if ResolvedEl.IdentEl is TPasFunction then
  14064. begin
  14065. // function => return result
  14066. ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
  14067. ResolvedEl,Flags+[rcType],StartEl);
  14068. Exclude(ResolvedEl.Flags,rrfWritable);
  14069. end
  14070. else if (ResolvedEl.IdentEl.ClassType=TPasConstructor)
  14071. and (rrfNewInstance in Ref.Flags) then
  14072. begin
  14073. // new instance constructor -> return value of type class
  14074. aClass:=GetReference_NewInstanceClass(Ref);
  14075. SetResolverValueExpr(ResolvedEl,btContext,aClass,TPrimitiveExpr(Expr),[rrfReadable]);
  14076. end
  14077. else if ParentNeedsExprResult(Expr) then
  14078. begin
  14079. // a procedure
  14080. exit;
  14081. end;
  14082. if rcSetReferenceFlags in Flags then
  14083. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  14084. Include(ResolvedEl.Flags,rrfCanBeStatement);
  14085. end;
  14086. end;
  14087. end
  14088. else if IsProcedureType(ResolvedEl,true) then
  14089. begin
  14090. // proc type
  14091. if [rcNoImplicitProc,rcNoImplicitProcType,rcConstant,rcType]*Flags=[] then
  14092. begin
  14093. // implicit call without params is allowed -> check if possible
  14094. ProcType:=TPasProcedureType(ResolvedEl.TypeEl);
  14095. if not ProcNeedsParams(ProcType) then
  14096. begin
  14097. // parameter less proc type -> implicit call possible
  14098. if ResolvedEl.TypeEl is TPasFunctionType then
  14099. // function => return result
  14100. ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
  14101. ResolvedEl,Flags+[rcType],StartEl)
  14102. else if ParentNeedsExprResult(Expr) then
  14103. begin
  14104. // a procedure has no result
  14105. exit;
  14106. end;
  14107. if rcSetReferenceFlags in Flags then
  14108. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  14109. Include(ResolvedEl.Flags,rrfCanBeStatement);
  14110. end;
  14111. end;
  14112. end;
  14113. end;
  14114. var
  14115. DeclEl: TPasElement;
  14116. ElClass: TClass;
  14117. bt: TResolverBaseType;
  14118. begin
  14119. if StartEl=nil then StartEl:=El;
  14120. ResolvedEl:=Default(TPasResolverResult);
  14121. {$IFDEF VerbosePasResolver}
  14122. writeln('TPasResolver.ComputeElement El=',GetObjName(El),' SkipTypeAlias=',rcSkipTypeAlias in Flags);
  14123. {$ENDIF}
  14124. if El=nil then
  14125. exit;
  14126. ElClass:=El.ClassType;
  14127. if ElClass=TPrimitiveExpr then
  14128. begin
  14129. case TPrimitiveExpr(El).Kind of
  14130. pekIdent,pekSelf:
  14131. begin
  14132. if not (El.CustomData is TResolvedReference) then
  14133. RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  14134. ComputeIdentifier(TPrimitiveExpr(El));
  14135. end;
  14136. pekNumber:
  14137. if Pos('.',TPrimitiveExpr(El).Value)>0 then
  14138. SetResolverValueExpr(ResolvedEl,BaseTypeExtended,FBaseTypes[BaseTypeExtended],
  14139. TPrimitiveExpr(El),[rrfReadable])
  14140. else
  14141. SetResolverValueExpr(ResolvedEl,btLongint,FBaseTypes[btLongint],TPrimitiveExpr(El),[rrfReadable]);
  14142. pekString:
  14143. begin
  14144. {$IFDEF VerbosePasResolver}
  14145. writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
  14146. {$ENDIF}
  14147. bt:=IsCharLiteral(TPrimitiveExpr(El).Value,El);
  14148. if bt in btAllChars then
  14149. begin
  14150. if bt=BaseTypeChar then
  14151. bt:=btChar;
  14152. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],TPrimitiveExpr(El),[rrfReadable]);
  14153. end
  14154. else
  14155. SetResolverValueExpr(ResolvedEl,btString,FBaseTypes[btString],TPrimitiveExpr(El),[rrfReadable]);
  14156. end;
  14157. pekNil:
  14158. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],TPrimitiveExpr(El),[rrfReadable]);
  14159. pekBoolConst:
  14160. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TPrimitiveExpr(El),[rrfReadable]);
  14161. else
  14162. RaiseNotYetImplemented(20160922163701,El);
  14163. end;
  14164. end
  14165. else if ElClass=TSelfExpr then
  14166. begin
  14167. // self is just an identifier
  14168. if not (El.CustomData is TResolvedReference) then
  14169. RaiseNotYetImplemented(20170216150017,El,' El="'+GetObjName(El)+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  14170. ComputeIdentifier(TSelfExpr(El));
  14171. end
  14172. else if ElClass=TPasUnresolvedSymbolRef then
  14173. begin
  14174. // built-in type
  14175. if El.CustomData is TResElDataBaseType then
  14176. SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
  14177. El,TPasUnresolvedSymbolRef(El),[])
  14178. else if El.CustomData is TResElDataBuiltInProc then
  14179. begin
  14180. SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,TPasUnresolvedSymbolRef(El),[]);
  14181. if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
  14182. Include(ResolvedEl.Flags,rrfCanBeStatement);
  14183. end
  14184. else
  14185. RaiseNotYetImplemented(20160926194756,El);
  14186. end
  14187. else if ElClass=TBoolConstExpr then
  14188. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TBoolConstExpr(El),[rrfReadable])
  14189. else if ElClass=TBinaryExpr then
  14190. ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
  14191. else if ElClass=TUnaryExpr then
  14192. begin
  14193. if TUnaryExpr(El).OpCode in [eopAddress,eopMemAddress] then
  14194. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  14195. else
  14196. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
  14197. {$IFDEF VerbosePasResolver}
  14198. writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
  14199. {$ENDIF}
  14200. case TUnaryExpr(El).OpCode of
  14201. eopAdd, eopSubtract:
  14202. if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
  14203. exit
  14204. else
  14205. RaiseMsg(20170216152532,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
  14206. eopNot:
  14207. if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
  14208. exit
  14209. else
  14210. RaiseMsg(20170216152534,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
  14211. eopAddress:
  14212. if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
  14213. begin
  14214. SetResolverValueExpr(ResolvedEl,btContext,ResolvedEl.TypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  14215. exit;
  14216. end
  14217. else
  14218. RaiseMsg(20170216152535,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
  14219. eopMemAddress:
  14220. begin
  14221. if (ResolvedEl.BaseType=btContext) and (ResolvedEl.TypeEl is TPasProcedureType) then
  14222. exit
  14223. else
  14224. RaiseMsg(20170902145547,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
  14225. end;
  14226. end;
  14227. RaiseNotYetImplemented(20160926142426,El);
  14228. end
  14229. else if ElClass=TParamsExpr then
  14230. case TParamsExpr(El).Kind of
  14231. pekArrayParams:
  14232. ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  14233. pekFuncParams:
  14234. ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  14235. pekSet:
  14236. ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  14237. else
  14238. RaiseNotYetImplemented(20161010184559,El);
  14239. end
  14240. else if ElClass=TInheritedExpr then
  14241. begin
  14242. // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
  14243. if El.CustomData is TResolvedReference then
  14244. begin
  14245. // "inherited;"
  14246. DeclEl:=NoNil(TResolvedReference(El.CustomData).Declaration) as TPasProcedure;
  14247. SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
  14248. TPasProcedure(DeclEl).ProcType,[rrfCanBeStatement]);
  14249. end
  14250. else
  14251. // no ancestor proc
  14252. SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[rrfCanBeStatement]);
  14253. end
  14254. else if ElClass=TPasAliasType then
  14255. begin
  14256. // e.g. 'type a = b' -> compute b
  14257. ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  14258. ResolvedEl.IdentEl:=El;
  14259. end
  14260. else if (ElClass=TPasTypeAliasType) then
  14261. begin
  14262. // e.g. 'type a = type b;' -> compute b
  14263. ComputeElement(TPasTypeAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  14264. if not (rcSkipTypeAlias in Flags) then
  14265. ResolvedEl.IdentEl:=El;
  14266. end
  14267. else if (ElClass=TPasVariable) then
  14268. begin
  14269. // e.g. 'var a:b' -> compute b, use a as IdentEl
  14270. if rcConstant in Flags then
  14271. RaiseConstantExprExp(20170216152737,StartEl);
  14272. ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  14273. ResolvedEl.IdentEl:=El;
  14274. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  14275. end
  14276. else if (ElClass=TPasConst) then
  14277. begin
  14278. // e.g. 'var a:b' -> compute b, use a as IdentEl
  14279. if TPasConst(El).VarType<>nil then
  14280. begin
  14281. // typed const -> just like a var
  14282. if rcConstant in Flags then
  14283. RaiseConstantExprExp(20170216152739,StartEl);
  14284. ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  14285. ResolvedEl.IdentEl:=El;
  14286. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  14287. end
  14288. else
  14289. begin
  14290. // untyped const
  14291. ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
  14292. ResolvedEl.IdentEl:=El;
  14293. ResolvedEl.Flags:=[rrfReadable];
  14294. end;
  14295. end
  14296. else if (ElClass=TPasEnumValue) then
  14297. SetResolverIdentifier(ResolvedEl,btContext,El,NoNil(El.Parent) as TPasEnumType,[rrfReadable])
  14298. else if (ElClass=TPasEnumType) then
  14299. SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),[])
  14300. else if (ElClass=TPasProperty) then
  14301. begin
  14302. if rcConstant in Flags then
  14303. RaiseConstantExprExp(20170216152741,StartEl);
  14304. if TPasProperty(El).Args.Count=0 then
  14305. begin
  14306. ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
  14307. Flags+[rcType],StartEl);
  14308. ResolvedEl.IdentEl:=El;
  14309. ResolvedEl.Flags:=[];
  14310. if GetPasPropertyGetter(TPasProperty(El))<>nil then
  14311. Include(ResolvedEl.Flags,rrfReadable);
  14312. if GetPasPropertySetter(TPasProperty(El))<>nil then
  14313. Include(ResolvedEl.Flags,rrfWritable);
  14314. if IsProcedureType(ResolvedEl,true) then
  14315. Include(ResolvedEl.Flags,rrfCanBeStatement);
  14316. end
  14317. else
  14318. // index property
  14319. SetResolverIdentifier(ResolvedEl,btContext,El,nil,[]);
  14320. end
  14321. else if ElClass=TPasArgument then
  14322. begin
  14323. if rcConstant in Flags then
  14324. RaiseConstantExprExp(20170216152744,StartEl);
  14325. if TPasArgument(El).ArgType=nil then
  14326. // untyped parameter
  14327. SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,[])
  14328. else
  14329. begin
  14330. // typed parameter -> use param as IdentEl, compute type
  14331. ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
  14332. ResolvedEl.IdentEl:=El;
  14333. end;
  14334. ResolvedEl.Flags:=[rrfReadable];
  14335. if TPasArgument(El).Access in [argDefault, argVar, argOut] then
  14336. Include(ResolvedEl.Flags,rrfWritable);
  14337. if IsProcedureType(ResolvedEl,true) then
  14338. Include(ResolvedEl.Flags,rrfCanBeStatement);
  14339. end
  14340. else if ElClass=TPasClassType then
  14341. begin
  14342. if TPasClassType(El).IsForward and (El.CustomData<>nil) then
  14343. begin
  14344. DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
  14345. ResolvedEl.TypeEl:=NoNil(DeclEl) as TPasClassType;
  14346. end
  14347. else
  14348. ResolvedEl.TypeEl:=TPasClassType(El);
  14349. SetResolverIdentifier(ResolvedEl,btContext,
  14350. ResolvedEl.TypeEl,ResolvedEl.TypeEl,[]);
  14351. end
  14352. else if ElClass=TPasClassOfType then
  14353. SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),[])
  14354. else if ElClass=TPasRecordType then
  14355. SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),[])
  14356. else if ElClass=TPasRangeType then
  14357. begin
  14358. ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
  14359. ResolvedEl.IdentEl:=El;
  14360. ResolvedEl.TypeEl:=TPasRangeType(El);
  14361. if ResolvedEl.ExprEl=nil then
  14362. ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
  14363. ResolvedEl.Flags:=[];
  14364. end
  14365. else if ElClass=TPasSetType then
  14366. begin
  14367. ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
  14368. if ResolvedEl.BaseType=btRange then
  14369. begin
  14370. ConvertRangeToElement(ResolvedEl);
  14371. ResolvedEl.TypeEl:=TPasSetType(El).EnumType;
  14372. end;
  14373. ResolvedEl.SubType:=ResolvedEl.BaseType;
  14374. ResolvedEl.BaseType:=btSet;
  14375. ResolvedEl.IdentEl:=El;
  14376. ResolvedEl.Flags:=[];
  14377. end
  14378. else if ElClass=TPasResultElement then
  14379. begin
  14380. if rcConstant in Flags then
  14381. RaiseConstantExprExp(20170216152746,StartEl);
  14382. ComputeElement(TPasResultElement(El).ResultType,ResolvedEl,Flags+[rcType],StartEl);
  14383. ResolvedEl.IdentEl:=El;
  14384. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  14385. end
  14386. else if ElClass=TPasUsesUnit then
  14387. begin
  14388. if TPasUsesUnit(El).Module is TPasModule then
  14389. SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,[])
  14390. else
  14391. RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
  14392. end
  14393. else if El.InheritsFrom(TPasModule) then
  14394. SetResolverIdentifier(ResolvedEl,btModule,El,nil,[])
  14395. else if ElClass=TNilExpr then
  14396. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],TNilExpr(El),[rrfReadable])
  14397. else if El.InheritsFrom(TPasProcedure) then
  14398. begin
  14399. SetResolverIdentifier(ResolvedEl,btProc,El,TPasProcedure(El).ProcType,[rrfCanBeStatement]);
  14400. if El is TPasFunction then
  14401. Include(ResolvedEl.Flags,rrfReadable);
  14402. // Note: the readability of TPasConstructor depends on the context
  14403. // Note: implicit calls are handled in TPrimitiveExpr
  14404. end
  14405. else if El.InheritsFrom(TPasProcedureType) then
  14406. begin
  14407. SetResolverIdentifier(ResolvedEl,btContext,El,TPasProcedureType(El),[rrfCanBeStatement]);
  14408. // Note: implicit calls are handled in TPrimitiveExpr
  14409. end
  14410. else if ElClass=TPasArrayType then
  14411. SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
  14412. else if ElClass=TArrayValues then
  14413. SetResolverValueExpr(ResolvedEl,btSet,nil,TArrayValues(El),[rrfReadable])
  14414. else if ElClass=TPasStringType then
  14415. begin
  14416. SetResolverTypeExpr(ResolvedEl,btShortString,BaseTypes[btShortString],[rrfReadable]);
  14417. if BaseTypes[btShortString]=nil then
  14418. RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
  14419. end
  14420. else if ElClass=TPasResString then
  14421. SetResolverIdentifier(ResolvedEl,btString,El,nil,[rrfReadable])
  14422. else
  14423. RaiseNotYetImplemented(20160922163705,El);
  14424. end;
  14425. function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
  14426. Store: boolean): TResEvalValue;
  14427. // Important: Caller must free result with ReleaseEvalValue(Result)
  14428. begin
  14429. Result:=fExprEvaluator.Eval(Expr,Flags);
  14430. if Result=nil then exit;
  14431. {$IFDEF VerbosePasResEval}
  14432. writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  14433. {$ENDIF}
  14434. if Store
  14435. and (Expr.CustomData=nil)
  14436. and (Result.Element=nil)
  14437. and (not fExprEvaluator.IsSimpleExpr(Expr)) then
  14438. begin
  14439. //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  14440. AddResolveData(Expr,Result,lkModule);
  14441. end;
  14442. end;
  14443. function TPasResolver.Eval(const Value: TPasResolverResult;
  14444. Flags: TResEvalFlags; Store: boolean): TResEvalValue;
  14445. var
  14446. Expr: TPasExpr;
  14447. begin
  14448. Result:=nil;
  14449. if Value.ExprEl<>nil then
  14450. Result:=Eval(Value.ExprEl,Flags,Store)
  14451. else if Value.IdentEl is TPasConst then
  14452. begin
  14453. Expr:=TPasVariable(Value.IdentEl).Expr;
  14454. if Expr=nil then exit;
  14455. Result:=Eval(Expr,Flags,Store)
  14456. end;
  14457. end;
  14458. function TPasResolver.IsSameType(TypeA, TypeB: TPasType; ResolveAlias: boolean
  14459. ): boolean;
  14460. begin
  14461. if (TypeA=nil) or (TypeB=nil) then exit(false);
  14462. if ResolveAlias then
  14463. begin
  14464. TypeA:=ResolveAliasType(TypeA);
  14465. TypeB:=ResolveAliasType(TypeB);
  14466. end;
  14467. if TypeA=TypeB then exit(true);
  14468. if (TypeA.ClassType=TPasUnresolvedSymbolRef)
  14469. and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
  14470. begin
  14471. Result:=CompareText(TypeA.Name,TypeB.Name)=0;
  14472. exit;
  14473. end;
  14474. Result:=false;
  14475. end;
  14476. function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
  14477. SkipAlias: boolean): TPasType;
  14478. var
  14479. DeclEl: TPasElement;
  14480. ClassScope: TPasClassScope;
  14481. begin
  14482. Result:=nil;
  14483. if ClassEl=nil then
  14484. exit;
  14485. if ClassEl.CustomData=nil then
  14486. exit;
  14487. if ClassEl.IsForward then
  14488. begin
  14489. DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
  14490. ClassEl:=NoNil(DeclEl) as TPasClassType;
  14491. Result:=ClassEl;
  14492. end
  14493. else
  14494. begin
  14495. ClassScope:=ClassEl.CustomData as TPasClassScope;
  14496. if not (pcsfAncestorResolved in ClassScope.Flags) then
  14497. exit;
  14498. if SkipAlias then
  14499. begin
  14500. if ClassScope.AncestorScope=nil then
  14501. exit;
  14502. Result:=TPasClassType(ClassScope.AncestorScope.Element);
  14503. end
  14504. else
  14505. Result:=ClassScope.DirectAncestor;
  14506. end;
  14507. end;
  14508. function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
  14509. begin
  14510. while El<>nil do
  14511. begin
  14512. if (El.ClassType=TPasImplRepeatUntil)
  14513. or (El.ClassType=TPasImplWhileDo)
  14514. or (El.ClassType=TPasImplForLoop) then
  14515. exit(TPasImplElement(El));
  14516. El:=El.Parent;
  14517. end;
  14518. Result:=nil;
  14519. end;
  14520. function TPasResolver.ResolveAliasType(aType: TPasType): TPasType;
  14521. var
  14522. C: TClass;
  14523. begin
  14524. Result:=aType;
  14525. while Result<>nil do
  14526. begin
  14527. C:=Result.ClassType;
  14528. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  14529. Result:=TPasAliasType(Result).DestType
  14530. else if (C=TPasClassType) and TPasClassType(Result).IsForward
  14531. and (Result.CustomData is TResolvedReference) then
  14532. Result:=NoNil(TResolvedReference(Result.CustomData).Declaration) as TPasType
  14533. else
  14534. exit;
  14535. end;
  14536. end;
  14537. function TPasResolver.ResolveAliasTypeEl(El: TPasElement): TPasType;
  14538. begin
  14539. if (El is TPasType) then
  14540. Result:=ResolveAliasType(TPasType(El))
  14541. else
  14542. Result:=nil;
  14543. end;
  14544. function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
  14545. { returns true if El is
  14546. a) the last element of an @ operator expression
  14547. e.g. '@p().o[].El' or '@El[]'
  14548. b) mode delphi: the last element of a right side of an assignment
  14549. c) an accessor function, e.g. property P read El;
  14550. }
  14551. var
  14552. Parent: TPasElement;
  14553. Prop: TPasProperty;
  14554. begin
  14555. Result:=false;
  14556. if El=nil then exit;
  14557. if not IsNameExpr(El) then
  14558. exit;
  14559. repeat
  14560. Parent:=El.Parent;
  14561. //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
  14562. if Parent.ClassType=TUnaryExpr then
  14563. begin
  14564. if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
  14565. end
  14566. else if Parent.ClassType=TBinaryExpr then
  14567. begin
  14568. if TBinaryExpr(Parent).right<>El then exit;
  14569. if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
  14570. end
  14571. else if Parent.ClassType=TParamsExpr then
  14572. begin
  14573. if TParamsExpr(Parent).Value<>El then exit;
  14574. end
  14575. else if Parent.ClassType=TPasProperty then
  14576. begin
  14577. Prop:=TPasProperty(Parent);
  14578. Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
  14579. exit;
  14580. end
  14581. else if Parent.ClassType=TPasImplAssign then
  14582. begin
  14583. if TPasImplAssign(Parent).right<>El then exit;
  14584. if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
  14585. exit;
  14586. end
  14587. else
  14588. exit;
  14589. El:=TPasExpr(Parent);
  14590. until false;
  14591. end;
  14592. function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
  14593. var
  14594. C: TClass;
  14595. P: TPasElement;
  14596. begin
  14597. if (El=nil) or (El.Parent=nil) then exit(false);
  14598. Result:=false;
  14599. P:=El.Parent;
  14600. C:=P.ClassType;
  14601. if C=TBinaryExpr then
  14602. begin
  14603. if TBinaryExpr(P).right=El then
  14604. begin
  14605. if (TBinaryExpr(P).OpCode=eopSubIdent)
  14606. or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
  14607. Result:=ParentNeedsExprResult(TBinaryExpr(P))
  14608. else
  14609. Result:=true;
  14610. end
  14611. else
  14612. Result:=true;
  14613. end
  14614. else if C.InheritsFrom(TPasExpr) then
  14615. Result:=true
  14616. else if (C=TPasEnumValue)
  14617. or (C=TPasArgument)
  14618. or (C=TPasVariable)
  14619. or (C=TPasExportSymbol) then
  14620. Result:=true
  14621. else if C=TPasClassType then
  14622. Result:=TPasClassType(P).GUIDExpr=El
  14623. else if C=TPasProperty then
  14624. Result:=(TPasProperty(P).IndexExpr=El)
  14625. or (TPasProperty(P).DispIDExpr=El)
  14626. or (TPasProperty(P).DefaultExpr=El)
  14627. else if C=TPasProcedure then
  14628. Result:=(TPasProcedure(P).LibraryExpr=El)
  14629. or (TPasProcedure(P).DispIDExpr=El)
  14630. else if C=TPasImplRepeatUntil then
  14631. Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
  14632. else if C=TPasImplIfElse then
  14633. Result:=(TPasImplIfElse(P).ConditionExpr=El)
  14634. else if C=TPasImplWhileDo then
  14635. Result:=(TPasImplWhileDo(P).ConditionExpr=El)
  14636. else if C=TPasImplWithDo then
  14637. Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
  14638. else if C=TPasImplCaseOf then
  14639. Result:=(TPasImplCaseOf(P).CaseExpr=El)
  14640. else if C=TPasImplCaseStatement then
  14641. Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
  14642. else if C=TPasImplForLoop then
  14643. Result:=(TPasImplForLoop(P).StartExpr=El)
  14644. or (TPasImplForLoop(P).EndExpr=El)
  14645. else if C=TPasImplAssign then
  14646. Result:=(TPasImplAssign(P).right=El)
  14647. else if C=TPasImplRaise then
  14648. Result:=(TPasImplRaise(P).ExceptAddr=El);
  14649. end;
  14650. function TPasResolver.GetReference_NewInstanceClass(Ref: TResolvedReference
  14651. ): TPasClassType;
  14652. begin
  14653. Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
  14654. end;
  14655. function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
  14656. ): boolean;
  14657. begin
  14658. TypeEl:=ResolveAliasType(TypeEl);
  14659. if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType)
  14660. or (length(TPasArrayType(TypeEl).Ranges)<>0) then
  14661. exit(false);
  14662. if OptionalOpenArray and (proOpenAsDynArrays in Options) then
  14663. Result:=true
  14664. else
  14665. Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
  14666. end;
  14667. function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
  14668. begin
  14669. Result:=(TypeEl<>nil)
  14670. and (TypeEl.ClassType=TPasArrayType)
  14671. and (length(TPasArrayType(TypeEl).Ranges)=0)
  14672. and (TypeEl.Parent<>nil)
  14673. and (TypeEl.Parent.ClassType=TPasArgument);
  14674. end;
  14675. function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
  14676. begin
  14677. TypeEl:=ResolveAliasType(TypeEl);
  14678. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  14679. and (length(TPasArrayType(TypeEl).Ranges)=0);
  14680. end;
  14681. function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
  14682. var
  14683. C: TClass;
  14684. begin
  14685. Result:=false;
  14686. if Expr=nil then exit;
  14687. if Expr.Parent=nil then exit;
  14688. C:=Expr.Parent.ClassType;
  14689. if C.InheritsFrom(TPasVariable) then
  14690. Result:=(TPasVariable(Expr.Parent).Expr=Expr)
  14691. else if C=TPasArgument then
  14692. Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
  14693. end;
  14694. function TPasResolver.IsEmptySet(const ResolvedEl: TPasResolverResult): boolean;
  14695. begin
  14696. Result:=(ResolvedEl.BaseType=btSet) and (ResolvedEl.SubType=btNone);
  14697. end;
  14698. function TPasResolver.IsClassMethod(El: TPasElement): boolean;
  14699. var
  14700. C: TClass;
  14701. begin
  14702. if El=nil then exit(false);
  14703. C:=El.ClassType;;
  14704. Result:=(C=TPasClassConstructor)
  14705. or (C=TPasClassDestructor)
  14706. or (C=TPasClassProcedure)
  14707. or (C=TPasClassFunction)
  14708. or (C=TPasClassOperator);
  14709. end;
  14710. function TPasResolver.IsExternalClassName(aClass: TPasClassType;
  14711. const ExtName: string): boolean;
  14712. var
  14713. AncestorScope: TPasClassScope;
  14714. begin
  14715. Result:=false;
  14716. if aClass=nil then exit;
  14717. while (aClass<>nil) and aClass.IsExternal do
  14718. begin
  14719. if aClass.ExternalName=ExtName then exit(true);
  14720. AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
  14721. if AncestorScope=nil then exit;
  14722. aClass:=NoNil(AncestorScope.Element) as TPasClassType;
  14723. end;
  14724. end;
  14725. function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
  14726. HasValue: boolean): boolean;
  14727. begin
  14728. if (ResolvedEl.BaseType<>btContext) or not (ResolvedEl.TypeEl is TPasProcedureType) then
  14729. exit(false);
  14730. if HasValue and not (rrfReadable in ResolvedEl.Flags) then
  14731. exit(false);
  14732. Result:=true;
  14733. end;
  14734. function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
  14735. ): boolean;
  14736. begin
  14737. Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.TypeEl is TPasArrayType);
  14738. end;
  14739. function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
  14740. var
  14741. Value: TPasExpr;
  14742. Ref: TResolvedReference;
  14743. Decl: TPasElement;
  14744. C: TClass;
  14745. begin
  14746. Result:=false;
  14747. if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
  14748. Value:=Params.Value;
  14749. if not IsNameExpr(Value) then
  14750. exit;
  14751. if not (Value.CustomData is TResolvedReference) then exit;
  14752. Ref:=TResolvedReference(Value.CustomData);
  14753. Decl:=Ref.Declaration;
  14754. C:=Decl.ClassType;
  14755. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  14756. begin
  14757. Decl:=ResolveAliasType(TPasAliasType(Decl));
  14758. C:=Decl.ClassType;
  14759. end;
  14760. if (C=TPasProcedureType)
  14761. or (C=TPasFunctionType) then
  14762. exit(true)
  14763. else if (C=TPasClassType)
  14764. or (C=TPasClassOfType)
  14765. or (C=TPasEnumType) then
  14766. exit(true)
  14767. else if (C=TPasUnresolvedSymbolRef)
  14768. and (Decl.CustomData is TResElDataBaseType) then
  14769. exit(true);
  14770. end;
  14771. function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
  14772. begin
  14773. Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
  14774. end;
  14775. function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
  14776. ): boolean;
  14777. var
  14778. Proc, OverriddenProc: TPasProcedure;
  14779. begin
  14780. Result:=false;
  14781. Proc:=DescendantProc;
  14782. if not Proc.IsOverride then exit;
  14783. if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
  14784. repeat
  14785. OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
  14786. if AncestorProc=OverriddenProc then exit(true);
  14787. Proc:=OverriddenProc;
  14788. until Proc=nil;
  14789. end;
  14790. function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): MaxPrecInt;
  14791. var
  14792. Range: TResEvalValue;
  14793. begin
  14794. Result:=0;
  14795. Range:=Eval(RangeExpr,[refConst]);
  14796. if Range=nil then
  14797. RaiseNotYetImplemented(20170910210416,RangeExpr);
  14798. case Range.Kind of
  14799. revkRangeInt:
  14800. Result:=TResEvalRangeInt(Range).RangeEnd-TResEvalRangeInt(Range).RangeStart+1;
  14801. revkRangeUInt:
  14802. Result:=TResEvalRangeUInt(Range).RangeEnd-TResEvalRangeUInt(Range).RangeStart+1;
  14803. else
  14804. RaiseNotYetImplemented(20170910210554,RangeExpr);
  14805. end;
  14806. {$IFDEF VerbosePasResolver}
  14807. //if Result=0 then
  14808. writeln('TPasResolver.GetRangeLength Result=',Result);
  14809. {$ENDIF}
  14810. end;
  14811. function TPasResolver.EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  14812. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue;
  14813. var
  14814. Range: TResEvalValue;
  14815. EnumType: TPasEnumType;
  14816. begin
  14817. Result:=nil;
  14818. Range:=Eval(RangeExpr,Flags+[refConst]);
  14819. if Range=nil then
  14820. RaiseNotYetImplemented(20170601191258,RangeExpr);
  14821. case Range.Kind of
  14822. revkRangeInt:
  14823. case TResEvalRangeInt(Range).ElKind of
  14824. revskEnum:
  14825. begin
  14826. EnumType:=NoNil(TResEvalRangeInt(Range).ElType) as TPasEnumType;
  14827. if EvalLow then
  14828. Result:=TResEvalEnum.CreateValue(
  14829. TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
  14830. else
  14831. Result:=TResEvalEnum.CreateValue(
  14832. TResEvalRangeInt(Range).RangeEnd,
  14833. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  14834. end;
  14835. revskInt:
  14836. if EvalLow then
  14837. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
  14838. else
  14839. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
  14840. revskChar:
  14841. if EvalLow then
  14842. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
  14843. else if TResEvalRangeInt(Range).RangeEnd<256 then
  14844. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd))
  14845. else
  14846. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
  14847. revskBool:
  14848. if EvalLow then
  14849. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
  14850. else
  14851. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
  14852. else
  14853. RaiseNotYetImplemented(20170601195240,ErrorEl);
  14854. end;
  14855. revkRangeUInt:
  14856. if EvalLow then
  14857. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
  14858. else
  14859. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
  14860. else
  14861. RaiseNotYetImplemented(20170601195336,ErrorEl);
  14862. end;
  14863. end;
  14864. function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags
  14865. ): TResEvalValue;
  14866. var
  14867. C: TClass;
  14868. BaseTypeData: TResElDataBaseType;
  14869. begin
  14870. Result:=nil;
  14871. Decl:=ResolveAliasType(Decl);
  14872. C:=Decl.ClassType;
  14873. if C=TPasRangeType then
  14874. begin
  14875. Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
  14876. if (Result<>nil) and (Result.IdentEl=nil) then
  14877. begin
  14878. Result.IdentEl:=Decl;
  14879. exit;
  14880. end;
  14881. end
  14882. else if C=TPasEnumType then
  14883. begin
  14884. Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
  14885. 0,TPasEnumType(Decl).Values.Count-1);
  14886. Result.IdentEl:=Decl;
  14887. exit;
  14888. end
  14889. else if C=TPasUnresolvedSymbolRef then
  14890. begin
  14891. if (Decl.CustomData is TResElDataBaseType) then
  14892. begin
  14893. BaseTypeData:=TResElDataBaseType(Decl.CustomData);
  14894. case BaseTypeData.BaseType of
  14895. btChar:
  14896. begin
  14897. Result:=TResEvalRangeInt.Create;
  14898. TResEvalRangeInt(Result).ElKind:=revskChar;
  14899. TResEvalRangeInt(Result).RangeStart:=0;
  14900. if BaseTypeChar in [btChar,btAnsiChar] then
  14901. TResEvalRangeInt(Result).RangeEnd:=$ff
  14902. else
  14903. TResEvalRangeInt(Result).RangeEnd:=$ffff;
  14904. end;
  14905. btAnsiChar:
  14906. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  14907. btWideChar:
  14908. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  14909. btBoolean,btByteBool,btWordBool,btQWordBool:
  14910. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
  14911. btByte,
  14912. btShortInt,
  14913. btWord,
  14914. btSmallInt,
  14915. btLongWord,
  14916. btLongint,
  14917. btInt64,
  14918. btComp,
  14919. btIntSingle,
  14920. btUIntSingle,
  14921. btIntDouble,
  14922. btUIntDouble:
  14923. begin
  14924. Result:=TResEvalRangeInt.Create;
  14925. TResEvalRangeInt(Result).ElKind:=revskInt;
  14926. GetIntegerRange(BaseTypeData.BaseType,
  14927. TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
  14928. exit;
  14929. end;
  14930. end;
  14931. end;
  14932. end;
  14933. end;
  14934. function TPasResolver.HasTypeInfo(El: TPasType): boolean;
  14935. begin
  14936. Result:=false;
  14937. if El=nil then exit;
  14938. if El.CustomData is TResElDataBaseType then
  14939. exit(true); // base type
  14940. if El.Parent=nil then exit;
  14941. if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then
  14942. exit;
  14943. Result:=true;
  14944. end;
  14945. function TPasResolver.GetActualBaseType(bt: TResolverBaseType
  14946. ): TResolverBaseType;
  14947. begin
  14948. case bt of
  14949. btChar: Result:=BaseTypeChar;
  14950. btString: Result:=BaseTypeString;
  14951. btExtended: Result:=BaseTypeExtended;
  14952. else Result:=bt;
  14953. end;
  14954. end;
  14955. function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
  14956. ErrorEl: TPasElement): TResolverBaseType;
  14957. begin
  14958. if Bool1=Bool2 then exit(Bool1);
  14959. case Bool1 of
  14960. btBoolean: Result:=Bool2;
  14961. btByteBool: if Bool2<>btBoolean then Result:=Bool2;
  14962. btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
  14963. btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
  14964. btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
  14965. else
  14966. RaiseNotYetImplemented(20170420093805,ErrorEl);
  14967. end;
  14968. end;
  14969. function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
  14970. ErrorEl: TPasElement): TResolverBaseType;
  14971. var
  14972. Precision1, Precision2: word;
  14973. Signed1, Signed2: boolean;
  14974. begin
  14975. if Int1.BaseType=Int2.BaseType then exit;
  14976. GetIntegerProps(Int1.BaseType,Precision1,Signed1);
  14977. GetIntegerProps(Int2.BaseType,Precision2,Signed2);
  14978. if Precision1=Precision2 then
  14979. begin
  14980. if Signed1<>Signed2 then
  14981. Precision1:=Max(Precision1,Precision2)+1;
  14982. end;
  14983. Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
  14984. end;
  14985. procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
  14986. Precision: word; out Signed: boolean);
  14987. begin
  14988. case bt of
  14989. btByte: begin Precision:=8; Signed:=false; end;
  14990. btShortInt: begin Precision:=8; Signed:=true; end;
  14991. btWord: begin Precision:=16; Signed:=false; end;
  14992. btSmallInt: begin Precision:=16; Signed:=true; end;
  14993. btIntSingle: begin Precision:=23; Signed:=true; end;
  14994. btUIntSingle: begin Precision:=22; Signed:=false; end;
  14995. btLongWord: begin Precision:=32; Signed:=false; end;
  14996. btLongint: begin Precision:=32; Signed:=true; end;
  14997. btIntDouble: begin Precision:=53; Signed:=true; end;
  14998. btUIntDouble: begin Precision:=52; Signed:=false; end;
  14999. btQWord: begin Precision:=64; Signed:=false; end;
  15000. btInt64,btComp: begin Precision:=64; Signed:=true; end;
  15001. else
  15002. RaiseInternalError(20170420095727);
  15003. end;
  15004. end;
  15005. function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
  15006. MaxVal: MaxPrecInt): boolean;
  15007. begin
  15008. Result:=true;
  15009. if bt=btExtended then bt:=BaseTypeExtended;
  15010. case bt of
  15011. btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
  15012. btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
  15013. btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
  15014. btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
  15015. btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
  15016. btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
  15017. btInt64,btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
  15018. btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
  15019. btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
  15020. btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
  15021. btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
  15022. btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
  15023. else
  15024. Result:=false;
  15025. end;
  15026. end;
  15027. function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
  15028. ErrorEl: TPasElement): TResolverBaseType;
  15029. begin
  15030. if Precision<=8 then
  15031. begin
  15032. if Signed then
  15033. Result:=btShortInt
  15034. else
  15035. Result:=btByte;
  15036. if BaseTypes[Result]<>nil then exit;
  15037. end;
  15038. if Precision<=16 then
  15039. begin
  15040. if Signed then
  15041. Result:=btSmallInt
  15042. else
  15043. Result:=btWord;
  15044. if BaseTypes[Result]<>nil then exit;
  15045. end;
  15046. if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
  15047. exit(btUIntSingle);
  15048. if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
  15049. exit(btIntSingle);
  15050. if Precision<=32 then
  15051. begin
  15052. if Signed then
  15053. Result:=btLongint
  15054. else
  15055. Result:=btLongWord;
  15056. if BaseTypes[Result]<>nil then exit;
  15057. end;
  15058. if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
  15059. exit(btUIntDouble);
  15060. if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
  15061. exit(btIntDouble);
  15062. if Precision<=64 then
  15063. begin
  15064. if Signed then
  15065. Result:=btInt64
  15066. else
  15067. Result:=btQWord;
  15068. if BaseTypes[Result]<>nil then exit;
  15069. end;
  15070. RaiseRangeCheck(20170420100336,ErrorEl);
  15071. end;
  15072. function TPasResolver.GetSmallestIntegerBaseType(MinVal, MaxVal: MaxPrecInt
  15073. ): TResolverBaseType;
  15074. var
  15075. V: MaxPrecInt;
  15076. begin
  15077. if MinVal>MaxVal then
  15078. MinVal:=MaxVal;
  15079. if MinVal<0 then
  15080. begin
  15081. if MaxVal>-(MinVal+1) then
  15082. V:=MaxVal
  15083. else
  15084. V:=-(MinVal+1);
  15085. if V<=high(ShortInt) then
  15086. Result:=btShortInt
  15087. else if V<=high(SmallInt) then
  15088. Result:=btSmallInt
  15089. else if (BaseTypes[btIntSingle]<>nil) and (V<MaxSafeIntSingle) then
  15090. Result:=btIntSingle
  15091. else if V<=High(Longint) then
  15092. Result:=btLongint
  15093. else if (BaseTypes[btIntDouble]<>nil) and (V<MaxSafeIntDouble) then
  15094. Result:=btIntDouble
  15095. else
  15096. Result:=btInt64;
  15097. end
  15098. else
  15099. begin
  15100. V:=MaxVal;
  15101. if V<=high(Byte) then
  15102. Result:=btByte
  15103. else if V<=high(Word) then
  15104. Result:=btWord
  15105. else if (BaseTypes[btUIntSingle]<>nil) and (V<MaxSafeIntSingle) then
  15106. Result:=btUIntSingle
  15107. else if V<=High(LongWord) then
  15108. Result:=btLongWord
  15109. else if (BaseTypes[btUIntDouble]<>nil) and (V<MaxSafeIntDouble) then
  15110. Result:=btUIntDouble
  15111. else
  15112. Result:=btInt64;
  15113. end;
  15114. end;
  15115. function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
  15116. ErrorEl: TPasElement): TResolverBaseType;
  15117. var
  15118. bt1, bt2: TResolverBaseType;
  15119. begin
  15120. bt1:=GetActualBaseType(Char1.BaseType);
  15121. bt2:=GetActualBaseType(Char2.BaseType);
  15122. if bt1=bt2 then exit(bt1);
  15123. if not (bt1 in btAllChars) then
  15124. RaiseInternalError(20170420103128);
  15125. Result:=btWideChar;
  15126. if Result=BaseTypeChar then
  15127. Result:=btChar;
  15128. if ErrorEl=nil then ;
  15129. end;
  15130. function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
  15131. ErrorEl: TPasElement): TResolverBaseType;
  15132. var
  15133. bt1, bt2: TResolverBaseType;
  15134. begin
  15135. bt1:=GetActualBaseType(Str1.BaseType);
  15136. bt2:=GetActualBaseType(Str2.BaseType);
  15137. if bt1=bt2 then exit(bt1);
  15138. case bt1 of
  15139. btChar,btAnsiChar:
  15140. case bt2 of
  15141. btChar: Result:=btChar;
  15142. btWideChar: Result:=btWideChar;
  15143. else Result:=bt2;
  15144. end;
  15145. btWideChar:
  15146. case bt2 of
  15147. btAnsiChar: Result:=btWideChar;
  15148. btWideString: Result:=btWideString;
  15149. btString,btShortString,btAnsiString,btRawByteString,btUnicodeString: Result:=btUnicodeString;
  15150. else RaiseNotYetImplemented(20170420103808,ErrorEl);
  15151. end;
  15152. btShortString:
  15153. case bt2 of
  15154. btChar,btAnsiChar: Result:=btShortString;
  15155. btString,btAnsiString: Result:=btAnsiString;
  15156. btRawByteString: Result:=btRawByteString;
  15157. btWideChar,btUnicodeString: Result:=btUnicodeString;
  15158. btWideString: Result:=btWideString;
  15159. else RaiseNotYetImplemented(20170420120937,ErrorEl);
  15160. end;
  15161. btString,btAnsiString:
  15162. case bt2 of
  15163. btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
  15164. btWideChar,btUnicodeString: Result:=btUnicodeString;
  15165. btWideString: Result:=btWideString;
  15166. else RaiseNotYetImplemented(20170420121201,ErrorEl);
  15167. end;
  15168. btRawByteString:
  15169. case bt2 of
  15170. btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
  15171. btString,btAnsiString: Result:=btAnsiString;
  15172. btWideChar,btUnicodeString: Result:=btUnicodeString;
  15173. btWideString: Result:=btWideString;
  15174. else RaiseNotYetImplemented(20170420121352,ErrorEl);
  15175. end;
  15176. btWideString:
  15177. case bt2 of
  15178. btChar,btAnsiChar,btWideChar,btShortString,btWideString: Result:=btWideString;
  15179. btString,btAnsiString,btUnicodeString: Result:=btUnicodeString;
  15180. else RaiseNotYetImplemented(20170420121532,ErrorEl);
  15181. end;
  15182. btUnicodeString:
  15183. Result:=btUnicodeString;
  15184. else
  15185. RaiseNotYetImplemented(20170420103153,ErrorEl);
  15186. end;
  15187. if Result=BaseTypeChar then
  15188. Result:=btChar
  15189. else if Result=BaseTypeString then
  15190. Result:=btString;
  15191. end;
  15192. function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
  15193. var
  15194. C: TClass;
  15195. aClass: TPasClassType;
  15196. begin
  15197. while El<>nil do
  15198. begin
  15199. C:=El.ClassType;
  15200. if C.ClassType=TPasClassType then
  15201. begin
  15202. aClass:=TPasClassType(El);
  15203. if aClass.ObjKind=okInterface then
  15204. exit(true);
  15205. end;
  15206. El:=El.Parent;
  15207. end;
  15208. Result:=false;
  15209. end;
  15210. function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
  15211. ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
  15212. // finds distance between classes SrcType and DestType
  15213. begin
  15214. Result:=CheckClassIsClass(ResolvedSrcType.TypeEl,ResolvedDestType.TypeEl,ErrorEl);
  15215. end;
  15216. function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType;
  15217. ErrorEl: TPasElement): integer;
  15218. // check if Src is equal or descends from Dest
  15219. var
  15220. ClassEl: TPasClassType;
  15221. begin
  15222. {$IFDEF VerbosePasResolver}
  15223. writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  15224. {$ENDIF}
  15225. if DestType=nil then exit(cIncompatible);
  15226. DestType:=ResolveAliasType(DestType);
  15227. Result:=cExact;
  15228. while SrcType<>nil do
  15229. begin
  15230. {$IFDEF VerbosePasResolver}
  15231. writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  15232. {$ENDIF}
  15233. if SrcType=DestType then
  15234. exit
  15235. else if SrcType.ClassType=TPasAliasType then
  15236. // alias -> skip
  15237. SrcType:=TPasAliasType(SrcType).DestType
  15238. else if SrcType.ClassType=TPasTypeAliasType then
  15239. begin
  15240. // type alias -> increases distance
  15241. SrcType:=TPasAliasType(SrcType).DestType;
  15242. inc(Result);
  15243. end
  15244. else if SrcType.ClassType=TPasClassType then
  15245. begin
  15246. ClassEl:=TPasClassType(SrcType);
  15247. if ClassEl.IsForward then
  15248. // class forward -> skip
  15249. SrcType:=(ClassEl.CustomData as TResolvedReference).Declaration as TPasType
  15250. else
  15251. begin
  15252. // class ancestor -> increase distance
  15253. SrcType:=(ClassEl.CustomData as TPasClassScope).DirectAncestor;
  15254. inc(Result);
  15255. end;
  15256. end
  15257. else
  15258. exit(cIncompatible);
  15259. end;
  15260. if ErrorEl=nil then ;
  15261. Result:=cIncompatible;
  15262. end;
  15263. function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType;
  15264. ErrorEl: TPasElement): integer;
  15265. begin
  15266. Result:=CheckClassIsClass(TypeA,TypeB,ErrorEl);
  15267. if Result<>cIncompatible then exit;
  15268. Result:=CheckClassIsClass(TypeB,TypeA,ErrorEl);
  15269. end;
  15270. end.