pasresolver.pp 1018 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614761576167617761876197620762176227623762476257626762776287629763076317632763376347635763676377638763976407641764276437644764576467647764876497650765176527653765476557656765776587659766076617662766376647665766676677668766976707671767276737674767576767677767876797680768176827683768476857686768776887689769076917692769376947695769676977698769977007701770277037704770577067707770877097710771177127713771477157716771777187719772077217722772377247725772677277728772977307731773277337734773577367737773877397740774177427743774477457746774777487749775077517752775377547755775677577758775977607761776277637764776577667767776877697770777177727773777477757776777777787779778077817782778377847785778677877788778977907791779277937794779577967797779877997800780178027803780478057806780778087809781078117812781378147815781678177818781978207821782278237824782578267827782878297830783178327833783478357836783778387839784078417842784378447845784678477848784978507851785278537854785578567857785878597860786178627863786478657866786778687869787078717872787378747875787678777878787978807881788278837884788578867887788878897890789178927893789478957896789778987899790079017902790379047905790679077908790979107911791279137914791579167917791879197920792179227923792479257926792779287929793079317932793379347935793679377938793979407941794279437944794579467947794879497950795179527953795479557956795779587959796079617962796379647965796679677968796979707971797279737974797579767977797879797980798179827983798479857986798779887989799079917992799379947995799679977998799980008001800280038004800580068007800880098010801180128013801480158016801780188019802080218022802380248025802680278028802980308031803280338034803580368037803880398040804180428043804480458046804780488049805080518052805380548055805680578058805980608061806280638064806580668067806880698070807180728073807480758076807780788079808080818082808380848085808680878088808980908091809280938094809580968097809880998100810181028103810481058106810781088109811081118112811381148115811681178118811981208121812281238124812581268127812881298130813181328133813481358136813781388139814081418142814381448145814681478148814981508151815281538154815581568157815881598160816181628163816481658166816781688169817081718172817381748175817681778178817981808181818281838184818581868187818881898190819181928193819481958196819781988199820082018202820382048205820682078208820982108211821282138214821582168217821882198220822182228223822482258226822782288229823082318232823382348235823682378238823982408241824282438244824582468247824882498250825182528253825482558256825782588259826082618262826382648265826682678268826982708271827282738274827582768277827882798280828182828283828482858286828782888289829082918292829382948295829682978298829983008301830283038304830583068307830883098310831183128313831483158316831783188319832083218322832383248325832683278328832983308331833283338334833583368337833883398340834183428343834483458346834783488349835083518352835383548355835683578358835983608361836283638364836583668367836883698370837183728373837483758376837783788379838083818382838383848385838683878388838983908391839283938394839583968397839883998400840184028403840484058406840784088409841084118412841384148415841684178418841984208421842284238424842584268427842884298430843184328433843484358436843784388439844084418442844384448445844684478448844984508451845284538454845584568457845884598460846184628463846484658466846784688469847084718472847384748475847684778478847984808481848284838484848584868487848884898490849184928493849484958496849784988499850085018502850385048505850685078508850985108511851285138514851585168517851885198520852185228523852485258526852785288529853085318532853385348535853685378538853985408541854285438544854585468547854885498550855185528553855485558556855785588559856085618562856385648565856685678568856985708571857285738574857585768577857885798580858185828583858485858586858785888589859085918592859385948595859685978598859986008601860286038604860586068607860886098610861186128613861486158616861786188619862086218622862386248625862686278628862986308631863286338634863586368637863886398640864186428643864486458646864786488649865086518652865386548655865686578658865986608661866286638664866586668667866886698670867186728673867486758676867786788679868086818682868386848685868686878688868986908691869286938694869586968697869886998700870187028703870487058706870787088709871087118712871387148715871687178718871987208721872287238724872587268727872887298730873187328733873487358736873787388739874087418742874387448745874687478748874987508751875287538754875587568757875887598760876187628763876487658766876787688769877087718772877387748775877687778778877987808781878287838784878587868787878887898790879187928793879487958796879787988799880088018802880388048805880688078808880988108811881288138814881588168817881888198820882188228823882488258826882788288829883088318832883388348835883688378838883988408841884288438844884588468847884888498850885188528853885488558856885788588859886088618862886388648865886688678868886988708871887288738874887588768877887888798880888188828883888488858886888788888889889088918892889388948895889688978898889989008901890289038904890589068907890889098910891189128913891489158916891789188919892089218922892389248925892689278928892989308931893289338934893589368937893889398940894189428943894489458946894789488949895089518952895389548955895689578958895989608961896289638964896589668967896889698970897189728973897489758976897789788979898089818982898389848985898689878988898989908991899289938994899589968997899889999000900190029003900490059006900790089009901090119012901390149015901690179018901990209021902290239024902590269027902890299030903190329033903490359036903790389039904090419042904390449045904690479048904990509051905290539054905590569057905890599060906190629063906490659066906790689069907090719072907390749075907690779078907990809081908290839084908590869087908890899090909190929093909490959096909790989099910091019102910391049105910691079108910991109111911291139114911591169117911891199120912191229123912491259126912791289129913091319132913391349135913691379138913991409141914291439144914591469147914891499150915191529153915491559156915791589159916091619162916391649165916691679168916991709171917291739174917591769177917891799180918191829183918491859186918791889189919091919192919391949195919691979198919992009201920292039204920592069207920892099210921192129213921492159216921792189219922092219222922392249225922692279228922992309231923292339234923592369237923892399240924192429243924492459246924792489249925092519252925392549255925692579258925992609261926292639264926592669267926892699270927192729273927492759276927792789279928092819282928392849285928692879288928992909291929292939294929592969297929892999300930193029303930493059306930793089309931093119312931393149315931693179318931993209321932293239324932593269327932893299330933193329333933493359336933793389339934093419342934393449345934693479348934993509351935293539354935593569357935893599360936193629363936493659366936793689369937093719372937393749375937693779378937993809381938293839384938593869387938893899390939193929393939493959396939793989399940094019402940394049405940694079408940994109411941294139414941594169417941894199420942194229423942494259426942794289429943094319432943394349435943694379438943994409441944294439444944594469447944894499450945194529453945494559456945794589459946094619462946394649465946694679468946994709471947294739474947594769477947894799480948194829483948494859486948794889489949094919492949394949495949694979498949995009501950295039504950595069507950895099510951195129513951495159516951795189519952095219522952395249525952695279528952995309531953295339534953595369537953895399540954195429543954495459546954795489549955095519552955395549555955695579558955995609561956295639564956595669567956895699570957195729573957495759576957795789579958095819582958395849585958695879588958995909591959295939594959595969597959895999600960196029603960496059606960796089609961096119612961396149615961696179618961996209621962296239624962596269627962896299630963196329633963496359636963796389639964096419642964396449645964696479648964996509651965296539654965596569657965896599660966196629663966496659666966796689669967096719672967396749675967696779678967996809681968296839684968596869687968896899690969196929693969496959696969796989699970097019702970397049705970697079708970997109711971297139714971597169717971897199720972197229723972497259726972797289729973097319732973397349735973697379738973997409741974297439744974597469747974897499750975197529753975497559756975797589759976097619762976397649765976697679768976997709771977297739774977597769777977897799780978197829783978497859786978797889789979097919792979397949795979697979798979998009801980298039804980598069807980898099810981198129813981498159816981798189819982098219822982398249825982698279828982998309831983298339834983598369837983898399840984198429843984498459846984798489849985098519852985398549855985698579858985998609861986298639864986598669867986898699870987198729873987498759876987798789879988098819882988398849885988698879888988998909891989298939894989598969897989898999900990199029903990499059906990799089909991099119912991399149915991699179918991999209921992299239924992599269927992899299930993199329933993499359936993799389939994099419942994399449945994699479948994999509951995299539954995599569957995899599960996199629963996499659966996799689969997099719972997399749975997699779978997999809981998299839984998599869987998899899990999199929993999499959996999799989999100001000110002100031000410005100061000710008100091001010011100121001310014100151001610017100181001910020100211002210023100241002510026100271002810029100301003110032100331003410035100361003710038100391004010041100421004310044100451004610047100481004910050100511005210053100541005510056100571005810059100601006110062100631006410065100661006710068100691007010071100721007310074100751007610077100781007910080100811008210083100841008510086100871008810089100901009110092100931009410095100961009710098100991010010101101021010310104101051010610107101081010910110101111011210113101141011510116101171011810119101201012110122101231012410125101261012710128101291013010131101321013310134101351013610137101381013910140101411014210143101441014510146101471014810149101501015110152101531015410155101561015710158101591016010161101621016310164101651016610167101681016910170101711017210173101741017510176101771017810179101801018110182101831018410185101861018710188101891019010191101921019310194101951019610197101981019910200102011020210203102041020510206102071020810209102101021110212102131021410215102161021710218102191022010221102221022310224102251022610227102281022910230102311023210233102341023510236102371023810239102401024110242102431024410245102461024710248102491025010251102521025310254102551025610257102581025910260102611026210263102641026510266102671026810269102701027110272102731027410275102761027710278102791028010281102821028310284102851028610287102881028910290102911029210293102941029510296102971029810299103001030110302103031030410305103061030710308103091031010311103121031310314103151031610317103181031910320103211032210323103241032510326103271032810329103301033110332103331033410335103361033710338103391034010341103421034310344103451034610347103481034910350103511035210353103541035510356103571035810359103601036110362103631036410365103661036710368103691037010371103721037310374103751037610377103781037910380103811038210383103841038510386103871038810389103901039110392103931039410395103961039710398103991040010401104021040310404104051040610407104081040910410104111041210413104141041510416104171041810419104201042110422104231042410425104261042710428104291043010431104321043310434104351043610437104381043910440104411044210443104441044510446104471044810449104501045110452104531045410455104561045710458104591046010461104621046310464104651046610467104681046910470104711047210473104741047510476104771047810479104801048110482104831048410485104861048710488104891049010491104921049310494104951049610497104981049910500105011050210503105041050510506105071050810509105101051110512105131051410515105161051710518105191052010521105221052310524105251052610527105281052910530105311053210533105341053510536105371053810539105401054110542105431054410545105461054710548105491055010551105521055310554105551055610557105581055910560105611056210563105641056510566105671056810569105701057110572105731057410575105761057710578105791058010581105821058310584105851058610587105881058910590105911059210593105941059510596105971059810599106001060110602106031060410605106061060710608106091061010611106121061310614106151061610617106181061910620106211062210623106241062510626106271062810629106301063110632106331063410635106361063710638106391064010641106421064310644106451064610647106481064910650106511065210653106541065510656106571065810659106601066110662106631066410665106661066710668106691067010671106721067310674106751067610677106781067910680106811068210683106841068510686106871068810689106901069110692106931069410695106961069710698106991070010701107021070310704107051070610707107081070910710107111071210713107141071510716107171071810719107201072110722107231072410725107261072710728107291073010731107321073310734107351073610737107381073910740107411074210743107441074510746107471074810749107501075110752107531075410755107561075710758107591076010761107621076310764107651076610767107681076910770107711077210773107741077510776107771077810779107801078110782107831078410785107861078710788107891079010791107921079310794107951079610797107981079910800108011080210803108041080510806108071080810809108101081110812108131081410815108161081710818108191082010821108221082310824108251082610827108281082910830108311083210833108341083510836108371083810839108401084110842108431084410845108461084710848108491085010851108521085310854108551085610857108581085910860108611086210863108641086510866108671086810869108701087110872108731087410875108761087710878108791088010881108821088310884108851088610887108881088910890108911089210893108941089510896108971089810899109001090110902109031090410905109061090710908109091091010911109121091310914109151091610917109181091910920109211092210923109241092510926109271092810929109301093110932109331093410935109361093710938109391094010941109421094310944109451094610947109481094910950109511095210953109541095510956109571095810959109601096110962109631096410965109661096710968109691097010971109721097310974109751097610977109781097910980109811098210983109841098510986109871098810989109901099110992109931099410995109961099710998109991100011001110021100311004110051100611007110081100911010110111101211013110141101511016110171101811019110201102111022110231102411025110261102711028110291103011031110321103311034110351103611037110381103911040110411104211043110441104511046110471104811049110501105111052110531105411055110561105711058110591106011061110621106311064110651106611067110681106911070110711107211073110741107511076110771107811079110801108111082110831108411085110861108711088110891109011091110921109311094110951109611097110981109911100111011110211103111041110511106111071110811109111101111111112111131111411115111161111711118111191112011121111221112311124111251112611127111281112911130111311113211133111341113511136111371113811139111401114111142111431114411145111461114711148111491115011151111521115311154111551115611157111581115911160111611116211163111641116511166111671116811169111701117111172111731117411175111761117711178111791118011181111821118311184111851118611187111881118911190111911119211193111941119511196111971119811199112001120111202112031120411205112061120711208112091121011211112121121311214112151121611217112181121911220112211122211223112241122511226112271122811229112301123111232112331123411235112361123711238112391124011241112421124311244112451124611247112481124911250112511125211253112541125511256112571125811259112601126111262112631126411265112661126711268112691127011271112721127311274112751127611277112781127911280112811128211283112841128511286112871128811289112901129111292112931129411295112961129711298112991130011301113021130311304113051130611307113081130911310113111131211313113141131511316113171131811319113201132111322113231132411325113261132711328113291133011331113321133311334113351133611337113381133911340113411134211343113441134511346113471134811349113501135111352113531135411355113561135711358113591136011361113621136311364113651136611367113681136911370113711137211373113741137511376113771137811379113801138111382113831138411385113861138711388113891139011391113921139311394113951139611397113981139911400114011140211403114041140511406114071140811409114101141111412114131141411415114161141711418114191142011421114221142311424114251142611427114281142911430114311143211433114341143511436114371143811439114401144111442114431144411445114461144711448114491145011451114521145311454114551145611457114581145911460114611146211463114641146511466114671146811469114701147111472114731147411475114761147711478114791148011481114821148311484114851148611487114881148911490114911149211493114941149511496114971149811499115001150111502115031150411505115061150711508115091151011511115121151311514115151151611517115181151911520115211152211523115241152511526115271152811529115301153111532115331153411535115361153711538115391154011541115421154311544115451154611547115481154911550115511155211553115541155511556115571155811559115601156111562115631156411565115661156711568115691157011571115721157311574115751157611577115781157911580115811158211583115841158511586115871158811589115901159111592115931159411595115961159711598115991160011601116021160311604116051160611607116081160911610116111161211613116141161511616116171161811619116201162111622116231162411625116261162711628116291163011631116321163311634116351163611637116381163911640116411164211643116441164511646116471164811649116501165111652116531165411655116561165711658116591166011661116621166311664116651166611667116681166911670116711167211673116741167511676116771167811679116801168111682116831168411685116861168711688116891169011691116921169311694116951169611697116981169911700117011170211703117041170511706117071170811709117101171111712117131171411715117161171711718117191172011721117221172311724117251172611727117281172911730117311173211733117341173511736117371173811739117401174111742117431174411745117461174711748117491175011751117521175311754117551175611757117581175911760117611176211763117641176511766117671176811769117701177111772117731177411775117761177711778117791178011781117821178311784117851178611787117881178911790117911179211793117941179511796117971179811799118001180111802118031180411805118061180711808118091181011811118121181311814118151181611817118181181911820118211182211823118241182511826118271182811829118301183111832118331183411835118361183711838118391184011841118421184311844118451184611847118481184911850118511185211853118541185511856118571185811859118601186111862118631186411865118661186711868118691187011871118721187311874118751187611877118781187911880118811188211883118841188511886118871188811889118901189111892118931189411895118961189711898118991190011901119021190311904119051190611907119081190911910119111191211913119141191511916119171191811919119201192111922119231192411925119261192711928119291193011931119321193311934119351193611937119381193911940119411194211943119441194511946119471194811949119501195111952119531195411955119561195711958119591196011961119621196311964119651196611967119681196911970119711197211973119741197511976119771197811979119801198111982119831198411985119861198711988119891199011991119921199311994119951199611997119981199912000120011200212003120041200512006120071200812009120101201112012120131201412015120161201712018120191202012021120221202312024120251202612027120281202912030120311203212033120341203512036120371203812039120401204112042120431204412045120461204712048120491205012051120521205312054120551205612057120581205912060120611206212063120641206512066120671206812069120701207112072120731207412075120761207712078120791208012081120821208312084120851208612087120881208912090120911209212093120941209512096120971209812099121001210112102121031210412105121061210712108121091211012111121121211312114121151211612117121181211912120121211212212123121241212512126121271212812129121301213112132121331213412135121361213712138121391214012141121421214312144121451214612147121481214912150121511215212153121541215512156121571215812159121601216112162121631216412165121661216712168121691217012171121721217312174121751217612177121781217912180121811218212183121841218512186121871218812189121901219112192121931219412195121961219712198121991220012201122021220312204122051220612207122081220912210122111221212213122141221512216122171221812219122201222112222122231222412225122261222712228122291223012231122321223312234122351223612237122381223912240122411224212243122441224512246122471224812249122501225112252122531225412255122561225712258122591226012261122621226312264122651226612267122681226912270122711227212273122741227512276122771227812279122801228112282122831228412285122861228712288122891229012291122921229312294122951229612297122981229912300123011230212303123041230512306123071230812309123101231112312123131231412315123161231712318123191232012321123221232312324123251232612327123281232912330123311233212333123341233512336123371233812339123401234112342123431234412345123461234712348123491235012351123521235312354123551235612357123581235912360123611236212363123641236512366123671236812369123701237112372123731237412375123761237712378123791238012381123821238312384123851238612387123881238912390123911239212393123941239512396123971239812399124001240112402124031240412405124061240712408124091241012411124121241312414124151241612417124181241912420124211242212423124241242512426124271242812429124301243112432124331243412435124361243712438124391244012441124421244312444124451244612447124481244912450124511245212453124541245512456124571245812459124601246112462124631246412465124661246712468124691247012471124721247312474124751247612477124781247912480124811248212483124841248512486124871248812489124901249112492124931249412495124961249712498124991250012501125021250312504125051250612507125081250912510125111251212513125141251512516125171251812519125201252112522125231252412525125261252712528125291253012531125321253312534125351253612537125381253912540125411254212543125441254512546125471254812549125501255112552125531255412555125561255712558125591256012561125621256312564125651256612567125681256912570125711257212573125741257512576125771257812579125801258112582125831258412585125861258712588125891259012591125921259312594125951259612597125981259912600126011260212603126041260512606126071260812609126101261112612126131261412615126161261712618126191262012621126221262312624126251262612627126281262912630126311263212633126341263512636126371263812639126401264112642126431264412645126461264712648126491265012651126521265312654126551265612657126581265912660126611266212663126641266512666126671266812669126701267112672126731267412675126761267712678126791268012681126821268312684126851268612687126881268912690126911269212693126941269512696126971269812699127001270112702127031270412705127061270712708127091271012711127121271312714127151271612717127181271912720127211272212723127241272512726127271272812729127301273112732127331273412735127361273712738127391274012741127421274312744127451274612747127481274912750127511275212753127541275512756127571275812759127601276112762127631276412765127661276712768127691277012771127721277312774127751277612777127781277912780127811278212783127841278512786127871278812789127901279112792127931279412795127961279712798127991280012801128021280312804128051280612807128081280912810128111281212813128141281512816128171281812819128201282112822128231282412825128261282712828128291283012831128321283312834128351283612837128381283912840128411284212843128441284512846128471284812849128501285112852128531285412855128561285712858128591286012861128621286312864128651286612867128681286912870128711287212873128741287512876128771287812879128801288112882128831288412885128861288712888128891289012891128921289312894128951289612897128981289912900129011290212903129041290512906129071290812909129101291112912129131291412915129161291712918129191292012921129221292312924129251292612927129281292912930129311293212933129341293512936129371293812939129401294112942129431294412945129461294712948129491295012951129521295312954129551295612957129581295912960129611296212963129641296512966129671296812969129701297112972129731297412975129761297712978129791298012981129821298312984129851298612987129881298912990129911299212993129941299512996129971299812999130001300113002130031300413005130061300713008130091301013011130121301313014130151301613017130181301913020130211302213023130241302513026130271302813029130301303113032130331303413035130361303713038130391304013041130421304313044130451304613047130481304913050130511305213053130541305513056130571305813059130601306113062130631306413065130661306713068130691307013071130721307313074130751307613077130781307913080130811308213083130841308513086130871308813089130901309113092130931309413095130961309713098130991310013101131021310313104131051310613107131081310913110131111311213113131141311513116131171311813119131201312113122131231312413125131261312713128131291313013131131321313313134131351313613137131381313913140131411314213143131441314513146131471314813149131501315113152131531315413155131561315713158131591316013161131621316313164131651316613167131681316913170131711317213173131741317513176131771317813179131801318113182131831318413185131861318713188131891319013191131921319313194131951319613197131981319913200132011320213203132041320513206132071320813209132101321113212132131321413215132161321713218132191322013221132221322313224132251322613227132281322913230132311323213233132341323513236132371323813239132401324113242132431324413245132461324713248132491325013251132521325313254132551325613257132581325913260132611326213263132641326513266132671326813269132701327113272132731327413275132761327713278132791328013281132821328313284132851328613287132881328913290132911329213293132941329513296132971329813299133001330113302133031330413305133061330713308133091331013311133121331313314133151331613317133181331913320133211332213323133241332513326133271332813329133301333113332133331333413335133361333713338133391334013341133421334313344133451334613347133481334913350133511335213353133541335513356133571335813359133601336113362133631336413365133661336713368133691337013371133721337313374133751337613377133781337913380133811338213383133841338513386133871338813389133901339113392133931339413395133961339713398133991340013401134021340313404134051340613407134081340913410134111341213413134141341513416134171341813419134201342113422134231342413425134261342713428134291343013431134321343313434134351343613437134381343913440134411344213443134441344513446134471344813449134501345113452134531345413455134561345713458134591346013461134621346313464134651346613467134681346913470134711347213473134741347513476134771347813479134801348113482134831348413485134861348713488134891349013491134921349313494134951349613497134981349913500135011350213503135041350513506135071350813509135101351113512135131351413515135161351713518135191352013521135221352313524135251352613527135281352913530135311353213533135341353513536135371353813539135401354113542135431354413545135461354713548135491355013551135521355313554135551355613557135581355913560135611356213563135641356513566135671356813569135701357113572135731357413575135761357713578135791358013581135821358313584135851358613587135881358913590135911359213593135941359513596135971359813599136001360113602136031360413605136061360713608136091361013611136121361313614136151361613617136181361913620136211362213623136241362513626136271362813629136301363113632136331363413635136361363713638136391364013641136421364313644136451364613647136481364913650136511365213653136541365513656136571365813659136601366113662136631366413665136661366713668136691367013671136721367313674136751367613677136781367913680136811368213683136841368513686136871368813689136901369113692136931369413695136961369713698136991370013701137021370313704137051370613707137081370913710137111371213713137141371513716137171371813719137201372113722137231372413725137261372713728137291373013731137321373313734137351373613737137381373913740137411374213743137441374513746137471374813749137501375113752137531375413755137561375713758137591376013761137621376313764137651376613767137681376913770137711377213773137741377513776137771377813779137801378113782137831378413785137861378713788137891379013791137921379313794137951379613797137981379913800138011380213803138041380513806138071380813809138101381113812138131381413815138161381713818138191382013821138221382313824138251382613827138281382913830138311383213833138341383513836138371383813839138401384113842138431384413845138461384713848138491385013851138521385313854138551385613857138581385913860138611386213863138641386513866138671386813869138701387113872138731387413875138761387713878138791388013881138821388313884138851388613887138881388913890138911389213893138941389513896138971389813899139001390113902139031390413905139061390713908139091391013911139121391313914139151391613917139181391913920139211392213923139241392513926139271392813929139301393113932139331393413935139361393713938139391394013941139421394313944139451394613947139481394913950139511395213953139541395513956139571395813959139601396113962139631396413965139661396713968139691397013971139721397313974139751397613977139781397913980139811398213983139841398513986139871398813989139901399113992139931399413995139961399713998139991400014001140021400314004140051400614007140081400914010140111401214013140141401514016140171401814019140201402114022140231402414025140261402714028140291403014031140321403314034140351403614037140381403914040140411404214043140441404514046140471404814049140501405114052140531405414055140561405714058140591406014061140621406314064140651406614067140681406914070140711407214073140741407514076140771407814079140801408114082140831408414085140861408714088140891409014091140921409314094140951409614097140981409914100141011410214103141041410514106141071410814109141101411114112141131411414115141161411714118141191412014121141221412314124141251412614127141281412914130141311413214133141341413514136141371413814139141401414114142141431414414145141461414714148141491415014151141521415314154141551415614157141581415914160141611416214163141641416514166141671416814169141701417114172141731417414175141761417714178141791418014181141821418314184141851418614187141881418914190141911419214193141941419514196141971419814199142001420114202142031420414205142061420714208142091421014211142121421314214142151421614217142181421914220142211422214223142241422514226142271422814229142301423114232142331423414235142361423714238142391424014241142421424314244142451424614247142481424914250142511425214253142541425514256142571425814259142601426114262142631426414265142661426714268142691427014271142721427314274142751427614277142781427914280142811428214283142841428514286142871428814289142901429114292142931429414295142961429714298142991430014301143021430314304143051430614307143081430914310143111431214313143141431514316143171431814319143201432114322143231432414325143261432714328143291433014331143321433314334143351433614337143381433914340143411434214343143441434514346143471434814349143501435114352143531435414355143561435714358143591436014361143621436314364143651436614367143681436914370143711437214373143741437514376143771437814379143801438114382143831438414385143861438714388143891439014391143921439314394143951439614397143981439914400144011440214403144041440514406144071440814409144101441114412144131441414415144161441714418144191442014421144221442314424144251442614427144281442914430144311443214433144341443514436144371443814439144401444114442144431444414445144461444714448144491445014451144521445314454144551445614457144581445914460144611446214463144641446514466144671446814469144701447114472144731447414475144761447714478144791448014481144821448314484144851448614487144881448914490144911449214493144941449514496144971449814499145001450114502145031450414505145061450714508145091451014511145121451314514145151451614517145181451914520145211452214523145241452514526145271452814529145301453114532145331453414535145361453714538145391454014541145421454314544145451454614547145481454914550145511455214553145541455514556145571455814559145601456114562145631456414565145661456714568145691457014571145721457314574145751457614577145781457914580145811458214583145841458514586145871458814589145901459114592145931459414595145961459714598145991460014601146021460314604146051460614607146081460914610146111461214613146141461514616146171461814619146201462114622146231462414625146261462714628146291463014631146321463314634146351463614637146381463914640146411464214643146441464514646146471464814649146501465114652146531465414655146561465714658146591466014661146621466314664146651466614667146681466914670146711467214673146741467514676146771467814679146801468114682146831468414685146861468714688146891469014691146921469314694146951469614697146981469914700147011470214703147041470514706147071470814709147101471114712147131471414715147161471714718147191472014721147221472314724147251472614727147281472914730147311473214733147341473514736147371473814739147401474114742147431474414745147461474714748147491475014751147521475314754147551475614757147581475914760147611476214763147641476514766147671476814769147701477114772147731477414775147761477714778147791478014781147821478314784147851478614787147881478914790147911479214793147941479514796147971479814799148001480114802148031480414805148061480714808148091481014811148121481314814148151481614817148181481914820148211482214823148241482514826148271482814829148301483114832148331483414835148361483714838148391484014841148421484314844148451484614847148481484914850148511485214853148541485514856148571485814859148601486114862148631486414865148661486714868148691487014871148721487314874148751487614877148781487914880148811488214883148841488514886148871488814889148901489114892148931489414895148961489714898148991490014901149021490314904149051490614907149081490914910149111491214913149141491514916149171491814919149201492114922149231492414925149261492714928149291493014931149321493314934149351493614937149381493914940149411494214943149441494514946149471494814949149501495114952149531495414955149561495714958149591496014961149621496314964149651496614967149681496914970149711497214973149741497514976149771497814979149801498114982149831498414985149861498714988149891499014991149921499314994149951499614997149981499915000150011500215003150041500515006150071500815009150101501115012150131501415015150161501715018150191502015021150221502315024150251502615027150281502915030150311503215033150341503515036150371503815039150401504115042150431504415045150461504715048150491505015051150521505315054150551505615057150581505915060150611506215063150641506515066150671506815069150701507115072150731507415075150761507715078150791508015081150821508315084150851508615087150881508915090150911509215093150941509515096150971509815099151001510115102151031510415105151061510715108151091511015111151121511315114151151511615117151181511915120151211512215123151241512515126151271512815129151301513115132151331513415135151361513715138151391514015141151421514315144151451514615147151481514915150151511515215153151541515515156151571515815159151601516115162151631516415165151661516715168151691517015171151721517315174151751517615177151781517915180151811518215183151841518515186151871518815189151901519115192151931519415195151961519715198151991520015201152021520315204152051520615207152081520915210152111521215213152141521515216152171521815219152201522115222152231522415225152261522715228152291523015231152321523315234152351523615237152381523915240152411524215243152441524515246152471524815249152501525115252152531525415255152561525715258152591526015261152621526315264152651526615267152681526915270152711527215273152741527515276152771527815279152801528115282152831528415285152861528715288152891529015291152921529315294152951529615297152981529915300153011530215303153041530515306153071530815309153101531115312153131531415315153161531715318153191532015321153221532315324153251532615327153281532915330153311533215333153341533515336153371533815339153401534115342153431534415345153461534715348153491535015351153521535315354153551535615357153581535915360153611536215363153641536515366153671536815369153701537115372153731537415375153761537715378153791538015381153821538315384153851538615387153881538915390153911539215393153941539515396153971539815399154001540115402154031540415405154061540715408154091541015411154121541315414154151541615417154181541915420154211542215423154241542515426154271542815429154301543115432154331543415435154361543715438154391544015441154421544315444154451544615447154481544915450154511545215453154541545515456154571545815459154601546115462154631546415465154661546715468154691547015471154721547315474154751547615477154781547915480154811548215483154841548515486154871548815489154901549115492154931549415495154961549715498154991550015501155021550315504155051550615507155081550915510155111551215513155141551515516155171551815519155201552115522155231552415525155261552715528155291553015531155321553315534155351553615537155381553915540155411554215543155441554515546155471554815549155501555115552155531555415555155561555715558155591556015561155621556315564155651556615567155681556915570155711557215573155741557515576155771557815579155801558115582155831558415585155861558715588155891559015591155921559315594155951559615597155981559915600156011560215603156041560515606156071560815609156101561115612156131561415615156161561715618156191562015621156221562315624156251562615627156281562915630156311563215633156341563515636156371563815639156401564115642156431564415645156461564715648156491565015651156521565315654156551565615657156581565915660156611566215663156641566515666156671566815669156701567115672156731567415675156761567715678156791568015681156821568315684156851568615687156881568915690156911569215693156941569515696156971569815699157001570115702157031570415705157061570715708157091571015711157121571315714157151571615717157181571915720157211572215723157241572515726157271572815729157301573115732157331573415735157361573715738157391574015741157421574315744157451574615747157481574915750157511575215753157541575515756157571575815759157601576115762157631576415765157661576715768157691577015771157721577315774157751577615777157781577915780157811578215783157841578515786157871578815789157901579115792157931579415795157961579715798157991580015801158021580315804158051580615807158081580915810158111581215813158141581515816158171581815819158201582115822158231582415825158261582715828158291583015831158321583315834158351583615837158381583915840158411584215843158441584515846158471584815849158501585115852158531585415855158561585715858158591586015861158621586315864158651586615867158681586915870158711587215873158741587515876158771587815879158801588115882158831588415885158861588715888158891589015891158921589315894158951589615897158981589915900159011590215903159041590515906159071590815909159101591115912159131591415915159161591715918159191592015921159221592315924159251592615927159281592915930159311593215933159341593515936159371593815939159401594115942159431594415945159461594715948159491595015951159521595315954159551595615957159581595915960159611596215963159641596515966159671596815969159701597115972159731597415975159761597715978159791598015981159821598315984159851598615987159881598915990159911599215993159941599515996159971599815999160001600116002160031600416005160061600716008160091601016011160121601316014160151601616017160181601916020160211602216023160241602516026160271602816029160301603116032160331603416035160361603716038160391604016041160421604316044160451604616047160481604916050160511605216053160541605516056160571605816059160601606116062160631606416065160661606716068160691607016071160721607316074160751607616077160781607916080160811608216083160841608516086160871608816089160901609116092160931609416095160961609716098160991610016101161021610316104161051610616107161081610916110161111611216113161141611516116161171611816119161201612116122161231612416125161261612716128161291613016131161321613316134161351613616137161381613916140161411614216143161441614516146161471614816149161501615116152161531615416155161561615716158161591616016161161621616316164161651616616167161681616916170161711617216173161741617516176161771617816179161801618116182161831618416185161861618716188161891619016191161921619316194161951619616197161981619916200162011620216203162041620516206162071620816209162101621116212162131621416215162161621716218162191622016221162221622316224162251622616227162281622916230162311623216233162341623516236162371623816239162401624116242162431624416245162461624716248162491625016251162521625316254162551625616257162581625916260162611626216263162641626516266162671626816269162701627116272162731627416275162761627716278162791628016281162821628316284162851628616287162881628916290162911629216293162941629516296162971629816299163001630116302163031630416305163061630716308163091631016311163121631316314163151631616317163181631916320163211632216323163241632516326163271632816329163301633116332163331633416335163361633716338163391634016341163421634316344163451634616347163481634916350163511635216353163541635516356163571635816359163601636116362163631636416365163661636716368163691637016371163721637316374163751637616377163781637916380163811638216383163841638516386163871638816389163901639116392163931639416395163961639716398163991640016401164021640316404164051640616407164081640916410164111641216413164141641516416164171641816419164201642116422164231642416425164261642716428164291643016431164321643316434164351643616437164381643916440164411644216443164441644516446164471644816449164501645116452164531645416455164561645716458164591646016461164621646316464164651646616467164681646916470164711647216473164741647516476164771647816479164801648116482164831648416485164861648716488164891649016491164921649316494164951649616497164981649916500165011650216503165041650516506165071650816509165101651116512165131651416515165161651716518165191652016521165221652316524165251652616527165281652916530165311653216533165341653516536165371653816539165401654116542165431654416545165461654716548165491655016551165521655316554165551655616557165581655916560165611656216563165641656516566165671656816569165701657116572165731657416575165761657716578165791658016581165821658316584165851658616587165881658916590165911659216593165941659516596165971659816599166001660116602166031660416605166061660716608166091661016611166121661316614166151661616617166181661916620166211662216623166241662516626166271662816629166301663116632166331663416635166361663716638166391664016641166421664316644166451664616647166481664916650166511665216653166541665516656166571665816659166601666116662166631666416665166661666716668166691667016671166721667316674166751667616677166781667916680166811668216683166841668516686166871668816689166901669116692166931669416695166961669716698166991670016701167021670316704167051670616707167081670916710167111671216713167141671516716167171671816719167201672116722167231672416725167261672716728167291673016731167321673316734167351673616737167381673916740167411674216743167441674516746167471674816749167501675116752167531675416755167561675716758167591676016761167621676316764167651676616767167681676916770167711677216773167741677516776167771677816779167801678116782167831678416785167861678716788167891679016791167921679316794167951679616797167981679916800168011680216803168041680516806168071680816809168101681116812168131681416815168161681716818168191682016821168221682316824168251682616827168281682916830168311683216833168341683516836168371683816839168401684116842168431684416845168461684716848168491685016851168521685316854168551685616857168581685916860168611686216863168641686516866168671686816869168701687116872168731687416875168761687716878168791688016881168821688316884168851688616887168881688916890168911689216893168941689516896168971689816899169001690116902169031690416905169061690716908169091691016911169121691316914169151691616917169181691916920169211692216923169241692516926169271692816929169301693116932169331693416935169361693716938169391694016941169421694316944169451694616947169481694916950169511695216953169541695516956169571695816959169601696116962169631696416965169661696716968169691697016971169721697316974169751697616977169781697916980169811698216983169841698516986169871698816989169901699116992169931699416995169961699716998169991700017001170021700317004170051700617007170081700917010170111701217013170141701517016170171701817019170201702117022170231702417025170261702717028170291703017031170321703317034170351703617037170381703917040170411704217043170441704517046170471704817049170501705117052170531705417055170561705717058170591706017061170621706317064170651706617067170681706917070170711707217073170741707517076170771707817079170801708117082170831708417085170861708717088170891709017091170921709317094170951709617097170981709917100171011710217103171041710517106171071710817109171101711117112171131711417115171161711717118171191712017121171221712317124171251712617127171281712917130171311713217133171341713517136171371713817139171401714117142171431714417145171461714717148171491715017151171521715317154171551715617157171581715917160171611716217163171641716517166171671716817169171701717117172171731717417175171761717717178171791718017181171821718317184171851718617187171881718917190171911719217193171941719517196171971719817199172001720117202172031720417205172061720717208172091721017211172121721317214172151721617217172181721917220172211722217223172241722517226172271722817229172301723117232172331723417235172361723717238172391724017241172421724317244172451724617247172481724917250172511725217253172541725517256172571725817259172601726117262172631726417265172661726717268172691727017271172721727317274172751727617277172781727917280172811728217283172841728517286172871728817289172901729117292172931729417295172961729717298172991730017301173021730317304173051730617307173081730917310173111731217313173141731517316173171731817319173201732117322173231732417325173261732717328173291733017331173321733317334173351733617337173381733917340173411734217343173441734517346173471734817349173501735117352173531735417355173561735717358173591736017361173621736317364173651736617367173681736917370173711737217373173741737517376173771737817379173801738117382173831738417385173861738717388173891739017391173921739317394173951739617397173981739917400174011740217403174041740517406174071740817409174101741117412174131741417415174161741717418174191742017421174221742317424174251742617427174281742917430174311743217433174341743517436174371743817439174401744117442174431744417445174461744717448174491745017451174521745317454174551745617457174581745917460174611746217463174641746517466174671746817469174701747117472174731747417475174761747717478174791748017481174821748317484174851748617487174881748917490174911749217493174941749517496174971749817499175001750117502175031750417505175061750717508175091751017511175121751317514175151751617517175181751917520175211752217523175241752517526175271752817529175301753117532175331753417535175361753717538175391754017541175421754317544175451754617547175481754917550175511755217553175541755517556175571755817559175601756117562175631756417565175661756717568175691757017571175721757317574175751757617577175781757917580175811758217583175841758517586175871758817589175901759117592175931759417595175961759717598175991760017601176021760317604176051760617607176081760917610176111761217613176141761517616176171761817619176201762117622176231762417625176261762717628176291763017631176321763317634176351763617637176381763917640176411764217643176441764517646176471764817649176501765117652176531765417655176561765717658176591766017661176621766317664176651766617667176681766917670176711767217673176741767517676176771767817679176801768117682176831768417685176861768717688176891769017691176921769317694176951769617697176981769917700177011770217703177041770517706177071770817709177101771117712177131771417715177161771717718177191772017721177221772317724177251772617727177281772917730177311773217733177341773517736177371773817739177401774117742177431774417745177461774717748177491775017751177521775317754177551775617757177581775917760177611776217763177641776517766177671776817769177701777117772177731777417775177761777717778177791778017781177821778317784177851778617787177881778917790177911779217793177941779517796177971779817799178001780117802178031780417805178061780717808178091781017811178121781317814178151781617817178181781917820178211782217823178241782517826178271782817829178301783117832178331783417835178361783717838178391784017841178421784317844178451784617847178481784917850178511785217853178541785517856178571785817859178601786117862178631786417865178661786717868178691787017871178721787317874178751787617877178781787917880178811788217883178841788517886178871788817889178901789117892178931789417895178961789717898178991790017901179021790317904179051790617907179081790917910179111791217913179141791517916179171791817919179201792117922179231792417925179261792717928179291793017931179321793317934179351793617937179381793917940179411794217943179441794517946179471794817949179501795117952179531795417955179561795717958179591796017961179621796317964179651796617967179681796917970179711797217973179741797517976179771797817979179801798117982179831798417985179861798717988179891799017991179921799317994179951799617997179981799918000180011800218003180041800518006180071800818009180101801118012180131801418015180161801718018180191802018021180221802318024180251802618027180281802918030180311803218033180341803518036180371803818039180401804118042180431804418045180461804718048180491805018051180521805318054180551805618057180581805918060180611806218063180641806518066180671806818069180701807118072180731807418075180761807718078180791808018081180821808318084180851808618087180881808918090180911809218093180941809518096180971809818099181001810118102181031810418105181061810718108181091811018111181121811318114181151811618117181181811918120181211812218123181241812518126181271812818129181301813118132181331813418135181361813718138181391814018141181421814318144181451814618147181481814918150181511815218153181541815518156181571815818159181601816118162181631816418165181661816718168181691817018171181721817318174181751817618177181781817918180181811818218183181841818518186181871818818189181901819118192181931819418195181961819718198181991820018201182021820318204182051820618207182081820918210182111821218213182141821518216182171821818219182201822118222182231822418225182261822718228182291823018231182321823318234182351823618237182381823918240182411824218243182441824518246182471824818249182501825118252182531825418255182561825718258182591826018261182621826318264182651826618267182681826918270182711827218273182741827518276182771827818279182801828118282182831828418285182861828718288182891829018291182921829318294182951829618297182981829918300183011830218303183041830518306183071830818309183101831118312183131831418315183161831718318183191832018321183221832318324183251832618327183281832918330183311833218333183341833518336183371833818339183401834118342183431834418345183461834718348183491835018351183521835318354183551835618357183581835918360183611836218363183641836518366183671836818369183701837118372183731837418375183761837718378183791838018381183821838318384183851838618387183881838918390183911839218393183941839518396183971839818399184001840118402184031840418405184061840718408184091841018411184121841318414184151841618417184181841918420184211842218423184241842518426184271842818429184301843118432184331843418435184361843718438184391844018441184421844318444184451844618447184481844918450184511845218453184541845518456184571845818459184601846118462184631846418465184661846718468184691847018471184721847318474184751847618477184781847918480184811848218483184841848518486184871848818489184901849118492184931849418495184961849718498184991850018501185021850318504185051850618507185081850918510185111851218513185141851518516185171851818519185201852118522185231852418525185261852718528185291853018531185321853318534185351853618537185381853918540185411854218543185441854518546185471854818549185501855118552185531855418555185561855718558185591856018561185621856318564185651856618567185681856918570185711857218573185741857518576185771857818579185801858118582185831858418585185861858718588185891859018591185921859318594185951859618597185981859918600186011860218603186041860518606186071860818609186101861118612186131861418615186161861718618186191862018621186221862318624186251862618627186281862918630186311863218633186341863518636186371863818639186401864118642186431864418645186461864718648186491865018651186521865318654186551865618657186581865918660186611866218663186641866518666186671866818669186701867118672186731867418675186761867718678186791868018681186821868318684186851868618687186881868918690186911869218693186941869518696186971869818699187001870118702187031870418705187061870718708187091871018711187121871318714187151871618717187181871918720187211872218723187241872518726187271872818729187301873118732187331873418735187361873718738187391874018741187421874318744187451874618747187481874918750187511875218753187541875518756187571875818759187601876118762187631876418765187661876718768187691877018771187721877318774187751877618777187781877918780187811878218783187841878518786187871878818789187901879118792187931879418795187961879718798187991880018801188021880318804188051880618807188081880918810188111881218813188141881518816188171881818819188201882118822188231882418825188261882718828188291883018831188321883318834188351883618837188381883918840188411884218843188441884518846188471884818849188501885118852188531885418855188561885718858188591886018861188621886318864188651886618867188681886918870188711887218873188741887518876188771887818879188801888118882188831888418885188861888718888188891889018891188921889318894188951889618897188981889918900189011890218903189041890518906189071890818909189101891118912189131891418915189161891718918189191892018921189221892318924189251892618927189281892918930189311893218933189341893518936189371893818939189401894118942189431894418945189461894718948189491895018951189521895318954189551895618957189581895918960189611896218963189641896518966189671896818969189701897118972189731897418975189761897718978189791898018981189821898318984189851898618987189881898918990189911899218993189941899518996189971899818999190001900119002190031900419005190061900719008190091901019011190121901319014190151901619017190181901919020190211902219023190241902519026190271902819029190301903119032190331903419035190361903719038190391904019041190421904319044190451904619047190481904919050190511905219053190541905519056190571905819059190601906119062190631906419065190661906719068190691907019071190721907319074190751907619077190781907919080190811908219083190841908519086190871908819089190901909119092190931909419095190961909719098190991910019101191021910319104191051910619107191081910919110191111911219113191141911519116191171911819119191201912119122191231912419125191261912719128191291913019131191321913319134191351913619137191381913919140191411914219143191441914519146191471914819149191501915119152191531915419155191561915719158191591916019161191621916319164191651916619167191681916919170191711917219173191741917519176191771917819179191801918119182191831918419185191861918719188191891919019191191921919319194191951919619197191981919919200192011920219203192041920519206192071920819209192101921119212192131921419215192161921719218192191922019221192221922319224192251922619227192281922919230192311923219233192341923519236192371923819239192401924119242192431924419245192461924719248192491925019251192521925319254192551925619257192581925919260192611926219263192641926519266192671926819269192701927119272192731927419275192761927719278192791928019281192821928319284192851928619287192881928919290192911929219293192941929519296192971929819299193001930119302193031930419305193061930719308193091931019311193121931319314193151931619317193181931919320193211932219323193241932519326193271932819329193301933119332193331933419335193361933719338193391934019341193421934319344193451934619347193481934919350193511935219353193541935519356193571935819359193601936119362193631936419365193661936719368193691937019371193721937319374193751937619377193781937919380193811938219383193841938519386193871938819389193901939119392193931939419395193961939719398193991940019401194021940319404194051940619407194081940919410194111941219413194141941519416194171941819419194201942119422194231942419425194261942719428194291943019431194321943319434194351943619437194381943919440194411944219443194441944519446194471944819449194501945119452194531945419455194561945719458194591946019461194621946319464194651946619467194681946919470194711947219473194741947519476194771947819479194801948119482194831948419485194861948719488194891949019491194921949319494194951949619497194981949919500195011950219503195041950519506195071950819509195101951119512195131951419515195161951719518195191952019521195221952319524195251952619527195281952919530195311953219533195341953519536195371953819539195401954119542195431954419545195461954719548195491955019551195521955319554195551955619557195581955919560195611956219563195641956519566195671956819569195701957119572195731957419575195761957719578195791958019581195821958319584195851958619587195881958919590195911959219593195941959519596195971959819599196001960119602196031960419605196061960719608196091961019611196121961319614196151961619617196181961919620196211962219623196241962519626196271962819629196301963119632196331963419635196361963719638196391964019641196421964319644196451964619647196481964919650196511965219653196541965519656196571965819659196601966119662196631966419665196661966719668196691967019671196721967319674196751967619677196781967919680196811968219683196841968519686196871968819689196901969119692196931969419695196961969719698196991970019701197021970319704197051970619707197081970919710197111971219713197141971519716197171971819719197201972119722197231972419725197261972719728197291973019731197321973319734197351973619737197381973919740197411974219743197441974519746197471974819749197501975119752197531975419755197561975719758197591976019761197621976319764197651976619767197681976919770197711977219773197741977519776197771977819779197801978119782197831978419785197861978719788197891979019791197921979319794197951979619797197981979919800198011980219803198041980519806198071980819809198101981119812198131981419815198161981719818198191982019821198221982319824198251982619827198281982919830198311983219833198341983519836198371983819839198401984119842198431984419845198461984719848198491985019851198521985319854198551985619857198581985919860198611986219863198641986519866198671986819869198701987119872198731987419875198761987719878198791988019881198821988319884198851988619887198881988919890198911989219893198941989519896198971989819899199001990119902199031990419905199061990719908199091991019911199121991319914199151991619917199181991919920199211992219923199241992519926199271992819929199301993119932199331993419935199361993719938199391994019941199421994319944199451994619947199481994919950199511995219953199541995519956199571995819959199601996119962199631996419965199661996719968199691997019971199721997319974199751997619977199781997919980199811998219983199841998519986199871998819989199901999119992199931999419995199961999719998199992000020001200022000320004200052000620007200082000920010200112001220013200142001520016200172001820019200202002120022200232002420025200262002720028200292003020031200322003320034200352003620037200382003920040200412004220043200442004520046200472004820049200502005120052200532005420055200562005720058200592006020061200622006320064200652006620067200682006920070200712007220073200742007520076200772007820079200802008120082200832008420085200862008720088200892009020091200922009320094200952009620097200982009920100201012010220103201042010520106201072010820109201102011120112201132011420115201162011720118201192012020121201222012320124201252012620127201282012920130201312013220133201342013520136201372013820139201402014120142201432014420145201462014720148201492015020151201522015320154201552015620157201582015920160201612016220163201642016520166201672016820169201702017120172201732017420175201762017720178201792018020181201822018320184201852018620187201882018920190201912019220193201942019520196201972019820199202002020120202202032020420205202062020720208202092021020211202122021320214202152021620217202182021920220202212022220223202242022520226202272022820229202302023120232202332023420235202362023720238202392024020241202422024320244202452024620247202482024920250202512025220253202542025520256202572025820259202602026120262202632026420265202662026720268202692027020271202722027320274202752027620277202782027920280202812028220283202842028520286202872028820289202902029120292202932029420295202962029720298202992030020301203022030320304203052030620307203082030920310203112031220313203142031520316203172031820319203202032120322203232032420325203262032720328203292033020331203322033320334203352033620337203382033920340203412034220343203442034520346203472034820349203502035120352203532035420355203562035720358203592036020361203622036320364203652036620367203682036920370203712037220373203742037520376203772037820379203802038120382203832038420385203862038720388203892039020391203922039320394203952039620397203982039920400204012040220403204042040520406204072040820409204102041120412204132041420415204162041720418204192042020421204222042320424204252042620427204282042920430204312043220433204342043520436204372043820439204402044120442204432044420445204462044720448204492045020451204522045320454204552045620457204582045920460204612046220463204642046520466204672046820469204702047120472204732047420475204762047720478204792048020481204822048320484204852048620487204882048920490204912049220493204942049520496204972049820499205002050120502205032050420505205062050720508205092051020511205122051320514205152051620517205182051920520205212052220523205242052520526205272052820529205302053120532205332053420535205362053720538205392054020541205422054320544205452054620547205482054920550205512055220553205542055520556205572055820559205602056120562205632056420565205662056720568205692057020571205722057320574205752057620577205782057920580205812058220583205842058520586205872058820589205902059120592205932059420595205962059720598205992060020601206022060320604206052060620607206082060920610206112061220613206142061520616206172061820619206202062120622206232062420625206262062720628206292063020631206322063320634206352063620637206382063920640206412064220643206442064520646206472064820649206502065120652206532065420655206562065720658206592066020661206622066320664206652066620667206682066920670206712067220673206742067520676206772067820679206802068120682206832068420685206862068720688206892069020691206922069320694206952069620697206982069920700207012070220703207042070520706207072070820709207102071120712207132071420715207162071720718207192072020721207222072320724207252072620727207282072920730207312073220733207342073520736207372073820739207402074120742207432074420745207462074720748207492075020751207522075320754207552075620757207582075920760207612076220763207642076520766207672076820769207702077120772207732077420775207762077720778207792078020781207822078320784207852078620787207882078920790207912079220793207942079520796207972079820799208002080120802208032080420805208062080720808208092081020811208122081320814208152081620817208182081920820208212082220823208242082520826208272082820829208302083120832208332083420835208362083720838208392084020841208422084320844208452084620847208482084920850208512085220853208542085520856208572085820859208602086120862208632086420865208662086720868208692087020871208722087320874208752087620877208782087920880208812088220883208842088520886208872088820889208902089120892208932089420895208962089720898208992090020901209022090320904209052090620907209082090920910209112091220913209142091520916209172091820919209202092120922209232092420925209262092720928209292093020931209322093320934209352093620937209382093920940209412094220943209442094520946209472094820949209502095120952209532095420955209562095720958209592096020961209622096320964209652096620967209682096920970209712097220973209742097520976209772097820979209802098120982209832098420985209862098720988209892099020991209922099320994209952099620997209982099921000210012100221003210042100521006210072100821009210102101121012210132101421015210162101721018210192102021021210222102321024210252102621027210282102921030210312103221033210342103521036210372103821039210402104121042210432104421045210462104721048210492105021051210522105321054210552105621057210582105921060210612106221063210642106521066210672106821069210702107121072210732107421075210762107721078210792108021081210822108321084210852108621087210882108921090210912109221093210942109521096210972109821099211002110121102211032110421105211062110721108211092111021111211122111321114211152111621117211182111921120211212112221123211242112521126211272112821129211302113121132211332113421135211362113721138211392114021141211422114321144211452114621147211482114921150211512115221153211542115521156211572115821159211602116121162211632116421165211662116721168211692117021171211722117321174211752117621177211782117921180211812118221183211842118521186211872118821189211902119121192211932119421195211962119721198211992120021201212022120321204212052120621207212082120921210212112121221213212142121521216212172121821219212202122121222212232122421225212262122721228212292123021231212322123321234212352123621237212382123921240212412124221243212442124521246212472124821249212502125121252212532125421255212562125721258212592126021261212622126321264212652126621267212682126921270212712127221273212742127521276212772127821279212802128121282212832128421285212862128721288212892129021291212922129321294212952129621297212982129921300213012130221303213042130521306213072130821309213102131121312213132131421315213162131721318213192132021321213222132321324213252132621327213282132921330213312133221333213342133521336213372133821339213402134121342213432134421345213462134721348213492135021351213522135321354213552135621357213582135921360213612136221363213642136521366213672136821369213702137121372213732137421375213762137721378213792138021381213822138321384213852138621387213882138921390213912139221393213942139521396213972139821399214002140121402214032140421405214062140721408214092141021411214122141321414214152141621417214182141921420214212142221423214242142521426214272142821429214302143121432214332143421435214362143721438214392144021441214422144321444214452144621447214482144921450214512145221453214542145521456214572145821459214602146121462214632146421465214662146721468214692147021471214722147321474214752147621477214782147921480214812148221483214842148521486214872148821489214902149121492214932149421495214962149721498214992150021501215022150321504215052150621507215082150921510215112151221513215142151521516215172151821519215202152121522215232152421525215262152721528215292153021531215322153321534215352153621537215382153921540215412154221543215442154521546215472154821549215502155121552215532155421555215562155721558215592156021561215622156321564215652156621567215682156921570215712157221573215742157521576215772157821579215802158121582215832158421585215862158721588215892159021591215922159321594215952159621597215982159921600216012160221603216042160521606216072160821609216102161121612216132161421615216162161721618216192162021621216222162321624216252162621627216282162921630216312163221633216342163521636216372163821639216402164121642216432164421645216462164721648216492165021651216522165321654216552165621657216582165921660216612166221663216642166521666216672166821669216702167121672216732167421675216762167721678216792168021681216822168321684216852168621687216882168921690216912169221693216942169521696216972169821699217002170121702217032170421705217062170721708217092171021711217122171321714217152171621717217182171921720217212172221723217242172521726217272172821729217302173121732217332173421735217362173721738217392174021741217422174321744217452174621747217482174921750217512175221753217542175521756217572175821759217602176121762217632176421765217662176721768217692177021771217722177321774217752177621777217782177921780217812178221783217842178521786217872178821789217902179121792217932179421795217962179721798217992180021801218022180321804218052180621807218082180921810218112181221813218142181521816218172181821819218202182121822218232182421825218262182721828218292183021831218322183321834218352183621837218382183921840218412184221843218442184521846218472184821849218502185121852218532185421855218562185721858218592186021861218622186321864218652186621867218682186921870218712187221873218742187521876218772187821879218802188121882218832188421885218862188721888218892189021891218922189321894218952189621897218982189921900219012190221903219042190521906219072190821909219102191121912219132191421915219162191721918219192192021921219222192321924219252192621927219282192921930219312193221933219342193521936219372193821939219402194121942219432194421945219462194721948219492195021951219522195321954219552195621957219582195921960219612196221963219642196521966219672196821969219702197121972219732197421975219762197721978219792198021981219822198321984219852198621987219882198921990219912199221993219942199521996219972199821999220002200122002220032200422005220062200722008220092201022011220122201322014220152201622017220182201922020220212202222023220242202522026220272202822029220302203122032220332203422035220362203722038220392204022041220422204322044220452204622047220482204922050220512205222053220542205522056220572205822059220602206122062220632206422065220662206722068220692207022071220722207322074220752207622077220782207922080220812208222083220842208522086220872208822089220902209122092220932209422095220962209722098220992210022101221022210322104221052210622107221082210922110221112211222113221142211522116221172211822119221202212122122221232212422125221262212722128221292213022131221322213322134221352213622137221382213922140221412214222143221442214522146221472214822149221502215122152221532215422155221562215722158221592216022161221622216322164221652216622167221682216922170221712217222173221742217522176221772217822179221802218122182221832218422185221862218722188221892219022191221922219322194221952219622197221982219922200222012220222203222042220522206222072220822209222102221122212222132221422215222162221722218222192222022221222222222322224222252222622227222282222922230222312223222233222342223522236222372223822239222402224122242222432224422245222462224722248222492225022251222522225322254222552225622257222582225922260222612226222263222642226522266222672226822269222702227122272222732227422275222762227722278222792228022281222822228322284222852228622287222882228922290222912229222293222942229522296222972229822299223002230122302223032230422305223062230722308223092231022311223122231322314223152231622317223182231922320223212232222323223242232522326223272232822329223302233122332223332233422335223362233722338223392234022341223422234322344223452234622347223482234922350223512235222353223542235522356223572235822359223602236122362223632236422365223662236722368223692237022371223722237322374223752237622377223782237922380223812238222383223842238522386223872238822389223902239122392223932239422395223962239722398223992240022401224022240322404224052240622407224082240922410224112241222413224142241522416224172241822419224202242122422224232242422425224262242722428224292243022431224322243322434224352243622437224382243922440224412244222443224442244522446224472244822449224502245122452224532245422455224562245722458224592246022461224622246322464224652246622467224682246922470224712247222473224742247522476224772247822479224802248122482224832248422485224862248722488224892249022491224922249322494224952249622497224982249922500225012250222503225042250522506225072250822509225102251122512225132251422515225162251722518225192252022521225222252322524225252252622527225282252922530225312253222533225342253522536225372253822539225402254122542225432254422545225462254722548225492255022551225522255322554225552255622557225582255922560225612256222563225642256522566225672256822569225702257122572225732257422575225762257722578225792258022581225822258322584225852258622587225882258922590225912259222593225942259522596225972259822599226002260122602226032260422605226062260722608226092261022611226122261322614226152261622617226182261922620226212262222623226242262522626226272262822629226302263122632226332263422635226362263722638226392264022641226422264322644226452264622647226482264922650226512265222653226542265522656226572265822659226602266122662226632266422665226662266722668226692267022671226722267322674226752267622677226782267922680226812268222683226842268522686226872268822689226902269122692226932269422695226962269722698226992270022701227022270322704227052270622707227082270922710227112271222713227142271522716227172271822719227202272122722227232272422725227262272722728227292273022731227322273322734227352273622737227382273922740227412274222743227442274522746227472274822749227502275122752227532275422755227562275722758227592276022761227622276322764227652276622767227682276922770227712277222773227742277522776227772277822779227802278122782227832278422785227862278722788227892279022791227922279322794227952279622797227982279922800228012280222803228042280522806228072280822809228102281122812228132281422815228162281722818228192282022821228222282322824228252282622827228282282922830228312283222833228342283522836228372283822839228402284122842228432284422845228462284722848228492285022851228522285322854228552285622857228582285922860228612286222863228642286522866228672286822869228702287122872228732287422875228762287722878228792288022881228822288322884228852288622887228882288922890228912289222893228942289522896228972289822899229002290122902229032290422905229062290722908229092291022911229122291322914229152291622917229182291922920229212292222923229242292522926229272292822929229302293122932229332293422935229362293722938229392294022941229422294322944229452294622947229482294922950229512295222953229542295522956229572295822959229602296122962229632296422965229662296722968229692297022971229722297322974229752297622977229782297922980229812298222983229842298522986229872298822989229902299122992229932299422995229962299722998229992300023001230022300323004230052300623007230082300923010230112301223013230142301523016230172301823019230202302123022230232302423025230262302723028230292303023031230322303323034230352303623037230382303923040230412304223043230442304523046230472304823049230502305123052230532305423055230562305723058230592306023061230622306323064230652306623067230682306923070230712307223073230742307523076230772307823079230802308123082230832308423085230862308723088230892309023091230922309323094230952309623097230982309923100231012310223103231042310523106231072310823109231102311123112231132311423115231162311723118231192312023121231222312323124231252312623127231282312923130231312313223133231342313523136231372313823139231402314123142231432314423145231462314723148231492315023151231522315323154231552315623157231582315923160231612316223163231642316523166231672316823169231702317123172231732317423175231762317723178231792318023181231822318323184231852318623187231882318923190231912319223193231942319523196231972319823199232002320123202232032320423205232062320723208232092321023211232122321323214232152321623217232182321923220232212322223223232242322523226232272322823229232302323123232232332323423235232362323723238232392324023241232422324323244232452324623247232482324923250232512325223253232542325523256232572325823259232602326123262232632326423265232662326723268232692327023271232722327323274232752327623277232782327923280232812328223283232842328523286232872328823289232902329123292232932329423295232962329723298232992330023301233022330323304233052330623307233082330923310233112331223313233142331523316233172331823319233202332123322233232332423325233262332723328233292333023331233322333323334233352333623337233382333923340233412334223343233442334523346233472334823349233502335123352233532335423355233562335723358233592336023361233622336323364233652336623367233682336923370233712337223373233742337523376233772337823379233802338123382233832338423385233862338723388233892339023391233922339323394233952339623397233982339923400234012340223403234042340523406234072340823409234102341123412234132341423415234162341723418234192342023421234222342323424234252342623427234282342923430234312343223433234342343523436234372343823439234402344123442234432344423445234462344723448234492345023451234522345323454234552345623457234582345923460234612346223463234642346523466234672346823469234702347123472234732347423475234762347723478234792348023481234822348323484234852348623487234882348923490234912349223493234942349523496234972349823499235002350123502235032350423505235062350723508235092351023511235122351323514235152351623517235182351923520235212352223523235242352523526235272352823529235302353123532235332353423535235362353723538235392354023541235422354323544235452354623547235482354923550235512355223553235542355523556235572355823559235602356123562235632356423565235662356723568235692357023571235722357323574235752357623577235782357923580235812358223583235842358523586235872358823589235902359123592235932359423595235962359723598235992360023601236022360323604236052360623607236082360923610236112361223613236142361523616236172361823619236202362123622236232362423625236262362723628236292363023631236322363323634236352363623637236382363923640236412364223643236442364523646236472364823649236502365123652236532365423655236562365723658236592366023661236622366323664236652366623667236682366923670236712367223673236742367523676236772367823679236802368123682236832368423685236862368723688236892369023691236922369323694236952369623697236982369923700237012370223703237042370523706237072370823709237102371123712237132371423715237162371723718237192372023721237222372323724237252372623727237282372923730237312373223733237342373523736237372373823739237402374123742237432374423745237462374723748237492375023751237522375323754237552375623757237582375923760237612376223763237642376523766237672376823769237702377123772237732377423775237762377723778237792378023781237822378323784237852378623787237882378923790237912379223793237942379523796237972379823799238002380123802238032380423805238062380723808238092381023811238122381323814238152381623817238182381923820238212382223823238242382523826238272382823829238302383123832238332383423835238362383723838238392384023841238422384323844238452384623847238482384923850238512385223853238542385523856238572385823859238602386123862238632386423865238662386723868238692387023871238722387323874238752387623877238782387923880238812388223883238842388523886238872388823889238902389123892238932389423895238962389723898238992390023901239022390323904239052390623907239082390923910239112391223913239142391523916239172391823919239202392123922239232392423925239262392723928239292393023931239322393323934239352393623937239382393923940239412394223943239442394523946239472394823949239502395123952239532395423955239562395723958239592396023961239622396323964239652396623967239682396923970239712397223973239742397523976239772397823979239802398123982239832398423985239862398723988239892399023991239922399323994239952399623997239982399924000240012400224003240042400524006240072400824009240102401124012240132401424015240162401724018240192402024021240222402324024240252402624027240282402924030240312403224033240342403524036240372403824039240402404124042240432404424045240462404724048240492405024051240522405324054240552405624057240582405924060240612406224063240642406524066240672406824069240702407124072240732407424075240762407724078240792408024081240822408324084240852408624087240882408924090240912409224093240942409524096240972409824099241002410124102241032410424105241062410724108241092411024111241122411324114241152411624117241182411924120241212412224123241242412524126241272412824129241302413124132241332413424135241362413724138241392414024141241422414324144241452414624147241482414924150241512415224153241542415524156241572415824159241602416124162241632416424165241662416724168241692417024171241722417324174241752417624177241782417924180241812418224183241842418524186241872418824189241902419124192241932419424195241962419724198241992420024201242022420324204242052420624207242082420924210242112421224213242142421524216242172421824219242202422124222242232422424225242262422724228242292423024231242322423324234242352423624237242382423924240242412424224243242442424524246242472424824249242502425124252242532425424255242562425724258242592426024261242622426324264242652426624267242682426924270242712427224273242742427524276242772427824279242802428124282242832428424285242862428724288242892429024291242922429324294242952429624297242982429924300243012430224303243042430524306243072430824309243102431124312243132431424315243162431724318243192432024321243222432324324243252432624327243282432924330243312433224333243342433524336243372433824339243402434124342243432434424345243462434724348243492435024351243522435324354243552435624357243582435924360243612436224363243642436524366243672436824369243702437124372243732437424375243762437724378243792438024381243822438324384243852438624387243882438924390243912439224393243942439524396243972439824399244002440124402244032440424405244062440724408244092441024411244122441324414244152441624417244182441924420244212442224423244242442524426244272442824429244302443124432244332443424435244362443724438244392444024441244422444324444244452444624447244482444924450244512445224453244542445524456244572445824459244602446124462244632446424465244662446724468244692447024471244722447324474244752447624477244782447924480244812448224483244842448524486244872448824489244902449124492244932449424495244962449724498244992450024501245022450324504245052450624507245082450924510245112451224513245142451524516245172451824519245202452124522245232452424525245262452724528245292453024531245322453324534245352453624537245382453924540245412454224543245442454524546245472454824549245502455124552245532455424555245562455724558245592456024561245622456324564245652456624567245682456924570245712457224573245742457524576245772457824579245802458124582245832458424585245862458724588245892459024591245922459324594245952459624597245982459924600246012460224603246042460524606246072460824609246102461124612246132461424615246162461724618246192462024621246222462324624246252462624627246282462924630246312463224633246342463524636246372463824639246402464124642246432464424645246462464724648246492465024651246522465324654246552465624657246582465924660246612466224663246642466524666246672466824669246702467124672246732467424675246762467724678246792468024681246822468324684246852468624687246882468924690246912469224693246942469524696246972469824699247002470124702247032470424705247062470724708247092471024711247122471324714247152471624717247182471924720247212472224723247242472524726247272472824729247302473124732247332473424735247362473724738247392474024741247422474324744247452474624747247482474924750247512475224753247542475524756247572475824759247602476124762247632476424765247662476724768247692477024771247722477324774247752477624777247782477924780247812478224783247842478524786247872478824789247902479124792247932479424795247962479724798247992480024801248022480324804248052480624807248082480924810248112481224813248142481524816248172481824819248202482124822248232482424825248262482724828248292483024831248322483324834248352483624837248382483924840248412484224843248442484524846248472484824849248502485124852248532485424855248562485724858248592486024861248622486324864248652486624867248682486924870248712487224873248742487524876248772487824879248802488124882248832488424885248862488724888248892489024891248922489324894248952489624897248982489924900249012490224903249042490524906249072490824909249102491124912249132491424915249162491724918249192492024921249222492324924249252492624927249282492924930249312493224933249342493524936249372493824939249402494124942249432494424945249462494724948249492495024951249522495324954249552495624957249582495924960249612496224963249642496524966249672496824969249702497124972249732497424975249762497724978249792498024981249822498324984249852498624987249882498924990249912499224993249942499524996249972499824999250002500125002250032500425005250062500725008250092501025011250122501325014250152501625017250182501925020250212502225023250242502525026250272502825029250302503125032250332503425035250362503725038250392504025041250422504325044250452504625047250482504925050250512505225053250542505525056250572505825059250602506125062250632506425065250662506725068250692507025071250722507325074250752507625077250782507925080250812508225083250842508525086250872508825089250902509125092250932509425095250962509725098250992510025101251022510325104251052510625107251082510925110251112511225113251142511525116251172511825119251202512125122251232512425125251262512725128251292513025131251322513325134251352513625137251382513925140251412514225143251442514525146251472514825149251502515125152251532515425155251562515725158251592516025161251622516325164251652516625167251682516925170251712517225173251742517525176251772517825179251802518125182251832518425185251862518725188251892519025191251922519325194251952519625197251982519925200252012520225203252042520525206252072520825209252102521125212252132521425215252162521725218252192522025221252222522325224252252522625227252282522925230252312523225233252342523525236252372523825239252402524125242252432524425245252462524725248252492525025251252522525325254252552525625257252582525925260252612526225263252642526525266252672526825269252702527125272252732527425275252762527725278252792528025281252822528325284252852528625287252882528925290252912529225293252942529525296252972529825299253002530125302253032530425305253062530725308253092531025311253122531325314253152531625317253182531925320253212532225323253242532525326253272532825329253302533125332253332533425335253362533725338253392534025341253422534325344253452534625347253482534925350253512535225353253542535525356253572535825359253602536125362253632536425365253662536725368253692537025371253722537325374253752537625377253782537925380253812538225383253842538525386253872538825389253902539125392253932539425395253962539725398253992540025401254022540325404254052540625407254082540925410254112541225413254142541525416254172541825419254202542125422254232542425425254262542725428254292543025431254322543325434254352543625437254382543925440254412544225443254442544525446254472544825449254502545125452254532545425455254562545725458254592546025461254622546325464254652546625467254682546925470254712547225473254742547525476254772547825479254802548125482254832548425485254862548725488254892549025491254922549325494254952549625497254982549925500255012550225503255042550525506255072550825509255102551125512255132551425515255162551725518255192552025521255222552325524255252552625527255282552925530255312553225533255342553525536255372553825539255402554125542255432554425545255462554725548255492555025551255522555325554255552555625557255582555925560255612556225563255642556525566255672556825569255702557125572255732557425575255762557725578255792558025581255822558325584255852558625587255882558925590255912559225593255942559525596255972559825599256002560125602256032560425605256062560725608256092561025611256122561325614256152561625617256182561925620256212562225623256242562525626256272562825629256302563125632256332563425635256362563725638256392564025641256422564325644256452564625647256482564925650256512565225653256542565525656256572565825659256602566125662256632566425665256662566725668256692567025671256722567325674256752567625677256782567925680256812568225683256842568525686256872568825689256902569125692256932569425695256962569725698256992570025701257022570325704257052570625707257082570925710257112571225713257142571525716257172571825719257202572125722257232572425725257262572725728257292573025731257322573325734257352573625737257382573925740257412574225743257442574525746257472574825749257502575125752257532575425755257562575725758257592576025761257622576325764257652576625767257682576925770257712577225773257742577525776257772577825779257802578125782257832578425785257862578725788257892579025791257922579325794257952579625797257982579925800258012580225803258042580525806258072580825809258102581125812258132581425815258162581725818258192582025821258222582325824258252582625827258282582925830258312583225833258342583525836258372583825839258402584125842258432584425845258462584725848258492585025851258522585325854258552585625857258582585925860258612586225863258642586525866258672586825869258702587125872258732587425875258762587725878258792588025881258822588325884258852588625887258882588925890258912589225893258942589525896258972589825899259002590125902259032590425905259062590725908259092591025911259122591325914259152591625917259182591925920259212592225923259242592525926259272592825929259302593125932259332593425935259362593725938259392594025941259422594325944259452594625947259482594925950259512595225953259542595525956259572595825959259602596125962259632596425965259662596725968259692597025971259722597325974259752597625977259782597925980259812598225983259842598525986259872598825989259902599125992259932599425995259962599725998259992600026001260022600326004260052600626007260082600926010260112601226013260142601526016260172601826019260202602126022260232602426025260262602726028260292603026031260322603326034260352603626037260382603926040260412604226043260442604526046260472604826049260502605126052260532605426055260562605726058260592606026061260622606326064260652606626067260682606926070260712607226073260742607526076260772607826079260802608126082260832608426085260862608726088260892609026091260922609326094260952609626097260982609926100261012610226103261042610526106261072610826109261102611126112261132611426115261162611726118261192612026121261222612326124261252612626127261282612926130261312613226133261342613526136261372613826139261402614126142261432614426145261462614726148261492615026151261522615326154261552615626157261582615926160261612616226163261642616526166261672616826169261702617126172261732617426175261762617726178261792618026181261822618326184261852618626187261882618926190261912619226193261942619526196261972619826199262002620126202262032620426205262062620726208262092621026211262122621326214262152621626217262182621926220262212622226223262242622526226262272622826229262302623126232262332623426235262362623726238262392624026241262422624326244262452624626247262482624926250262512625226253262542625526256262572625826259262602626126262262632626426265262662626726268262692627026271262722627326274262752627626277262782627926280262812628226283262842628526286262872628826289262902629126292262932629426295262962629726298262992630026301263022630326304263052630626307263082630926310263112631226313263142631526316263172631826319263202632126322263232632426325263262632726328263292633026331263322633326334263352633626337263382633926340263412634226343263442634526346263472634826349263502635126352263532635426355263562635726358263592636026361263622636326364263652636626367263682636926370263712637226373263742637526376263772637826379263802638126382263832638426385263862638726388263892639026391263922639326394263952639626397263982639926400264012640226403264042640526406264072640826409264102641126412264132641426415264162641726418264192642026421264222642326424264252642626427264282642926430264312643226433264342643526436264372643826439264402644126442264432644426445264462644726448264492645026451264522645326454264552645626457264582645926460264612646226463264642646526466264672646826469264702647126472264732647426475264762647726478264792648026481264822648326484264852648626487264882648926490264912649226493264942649526496264972649826499265002650126502265032650426505265062650726508265092651026511265122651326514265152651626517265182651926520265212652226523265242652526526265272652826529265302653126532265332653426535265362653726538265392654026541265422654326544265452654626547265482654926550265512655226553265542655526556265572655826559265602656126562265632656426565265662656726568265692657026571265722657326574265752657626577265782657926580265812658226583265842658526586265872658826589265902659126592265932659426595265962659726598265992660026601266022660326604266052660626607266082660926610266112661226613266142661526616266172661826619266202662126622266232662426625266262662726628266292663026631266322663326634266352663626637266382663926640266412664226643266442664526646266472664826649266502665126652266532665426655266562665726658266592666026661266622666326664266652666626667266682666926670266712667226673266742667526676266772667826679266802668126682266832668426685266862668726688266892669026691266922669326694266952669626697266982669926700267012670226703267042670526706267072670826709267102671126712267132671426715267162671726718267192672026721267222672326724267252672626727267282672926730267312673226733267342673526736267372673826739267402674126742267432674426745267462674726748267492675026751267522675326754267552675626757267582675926760267612676226763267642676526766267672676826769267702677126772267732677426775267762677726778267792678026781267822678326784267852678626787267882678926790267912679226793267942679526796267972679826799268002680126802268032680426805268062680726808268092681026811268122681326814268152681626817268182681926820268212682226823268242682526826268272682826829268302683126832268332683426835268362683726838268392684026841268422684326844268452684626847268482684926850268512685226853268542685526856268572685826859268602686126862268632686426865268662686726868268692687026871268722687326874268752687626877268782687926880268812688226883268842688526886268872688826889268902689126892268932689426895268962689726898268992690026901269022690326904269052690626907269082690926910269112691226913269142691526916269172691826919269202692126922269232692426925269262692726928269292693026931269322693326934269352693626937269382693926940269412694226943269442694526946269472694826949269502695126952269532695426955269562695726958269592696026961269622696326964269652696626967269682696926970269712697226973269742697526976269772697826979269802698126982269832698426985269862698726988269892699026991269922699326994269952699626997269982699927000270012700227003270042700527006270072700827009270102701127012270132701427015270162701727018270192702027021270222702327024270252702627027270282702927030270312703227033270342703527036270372703827039270402704127042270432704427045270462704727048270492705027051270522705327054270552705627057270582705927060270612706227063270642706527066270672706827069270702707127072270732707427075270762707727078270792708027081270822708327084270852708627087270882708927090270912709227093270942709527096270972709827099271002710127102271032710427105271062710727108271092711027111271122711327114271152711627117271182711927120271212712227123271242712527126271272712827129271302713127132271332713427135271362713727138271392714027141271422714327144271452714627147271482714927150271512715227153271542715527156271572715827159271602716127162271632716427165271662716727168271692717027171271722717327174271752717627177271782717927180271812718227183271842718527186271872718827189271902719127192271932719427195271962719727198271992720027201272022720327204272052720627207272082720927210272112721227213272142721527216272172721827219272202722127222272232722427225272262722727228272292723027231272322723327234272352723627237272382723927240272412724227243272442724527246272472724827249272502725127252272532725427255272562725727258272592726027261272622726327264272652726627267272682726927270272712727227273272742727527276272772727827279272802728127282272832728427285272862728727288272892729027291272922729327294272952729627297272982729927300273012730227303273042730527306273072730827309273102731127312273132731427315273162731727318273192732027321273222732327324273252732627327273282732927330273312733227333273342733527336273372733827339273402734127342273432734427345273462734727348273492735027351273522735327354273552735627357273582735927360273612736227363273642736527366273672736827369273702737127372273732737427375273762737727378273792738027381273822738327384273852738627387273882738927390273912739227393273942739527396273972739827399274002740127402274032740427405274062740727408274092741027411274122741327414274152741627417274182741927420274212742227423274242742527426274272742827429274302743127432274332743427435274362743727438274392744027441274422744327444274452744627447274482744927450274512745227453274542745527456274572745827459274602746127462274632746427465274662746727468274692747027471274722747327474274752747627477274782747927480274812748227483274842748527486274872748827489274902749127492274932749427495274962749727498274992750027501275022750327504275052750627507275082750927510275112751227513275142751527516275172751827519275202752127522275232752427525275262752727528275292753027531275322753327534275352753627537275382753927540275412754227543275442754527546275472754827549275502755127552275532755427555275562755727558275592756027561275622756327564275652756627567275682756927570275712757227573275742757527576275772757827579275802758127582275832758427585275862758727588275892759027591275922759327594275952759627597275982759927600276012760227603276042760527606276072760827609276102761127612276132761427615276162761727618276192762027621276222762327624276252762627627276282762927630276312763227633276342763527636276372763827639276402764127642276432764427645276462764727648276492765027651276522765327654276552765627657276582765927660276612766227663276642766527666276672766827669276702767127672276732767427675276762767727678276792768027681276822768327684276852768627687276882768927690276912769227693276942769527696276972769827699277002770127702277032770427705277062770727708277092771027711277122771327714277152771627717277182771927720277212772227723277242772527726277272772827729277302773127732277332773427735277362773727738277392774027741277422774327744277452774627747277482774927750277512775227753277542775527756277572775827759277602776127762277632776427765277662776727768277692777027771277722777327774277752777627777277782777927780277812778227783277842778527786277872778827789277902779127792277932779427795277962779727798277992780027801278022780327804278052780627807278082780927810278112781227813278142781527816278172781827819278202782127822278232782427825278262782727828278292783027831278322783327834278352783627837278382783927840278412784227843278442784527846278472784827849278502785127852278532785427855278562785727858278592786027861278622786327864278652786627867278682786927870278712787227873278742787527876278772787827879278802788127882278832788427885278862788727888278892789027891278922789327894278952789627897278982789927900279012790227903279042790527906279072790827909279102791127912279132791427915279162791727918279192792027921279222792327924279252792627927279282792927930279312793227933279342793527936279372793827939279402794127942279432794427945279462794727948279492795027951279522795327954279552795627957279582795927960279612796227963279642796527966279672796827969279702797127972279732797427975279762797727978279792798027981279822798327984279852798627987279882798927990279912799227993279942799527996279972799827999280002800128002280032800428005280062800728008280092801028011280122801328014280152801628017280182801928020280212802228023280242802528026280272802828029280302803128032280332803428035280362803728038280392804028041280422804328044280452804628047280482804928050280512805228053280542805528056280572805828059280602806128062280632806428065280662806728068280692807028071280722807328074280752807628077280782807928080280812808228083280842808528086280872808828089280902809128092280932809428095280962809728098280992810028101281022810328104281052810628107281082810928110281112811228113281142811528116281172811828119281202812128122281232812428125281262812728128281292813028131281322813328134281352813628137281382813928140281412814228143281442814528146281472814828149281502815128152281532815428155281562815728158281592816028161281622816328164281652816628167281682816928170281712817228173281742817528176281772817828179281802818128182281832818428185281862818728188281892819028191281922819328194281952819628197281982819928200282012820228203282042820528206282072820828209282102821128212282132821428215282162821728218282192822028221282222822328224282252822628227282282822928230282312823228233282342823528236282372823828239282402824128242282432824428245282462824728248282492825028251282522825328254282552825628257282582825928260282612826228263282642826528266282672826828269282702827128272282732827428275282762827728278282792828028281282822828328284282852828628287282882828928290282912829228293282942829528296282972829828299283002830128302283032830428305283062830728308283092831028311283122831328314283152831628317283182831928320283212832228323283242832528326283272832828329283302833128332283332833428335283362833728338283392834028341283422834328344283452834628347283482834928350283512835228353283542835528356283572835828359283602836128362283632836428365283662836728368283692837028371283722837328374283752837628377283782837928380283812838228383283842838528386283872838828389283902839128392283932839428395283962839728398283992840028401284022840328404284052840628407284082840928410284112841228413284142841528416284172841828419284202842128422284232842428425284262842728428284292843028431284322843328434284352843628437284382843928440284412844228443284442844528446284472844828449284502845128452284532845428455284562845728458284592846028461284622846328464284652846628467284682846928470284712847228473284742847528476284772847828479284802848128482284832848428485284862848728488284892849028491284922849328494284952849628497284982849928500285012850228503285042850528506285072850828509285102851128512285132851428515285162851728518285192852028521285222852328524285252852628527285282852928530285312853228533285342853528536285372853828539285402854128542285432854428545285462854728548285492855028551285522855328554285552855628557285582855928560285612856228563285642856528566285672856828569285702857128572285732857428575285762857728578285792858028581285822858328584285852858628587285882858928590285912859228593285942859528596285972859828599286002860128602286032860428605286062860728608286092861028611286122861328614286152861628617286182861928620286212862228623286242862528626286272862828629286302863128632286332863428635286362863728638286392864028641286422864328644286452864628647286482864928650286512865228653286542865528656286572865828659286602866128662286632866428665286662866728668286692867028671286722867328674286752867628677286782867928680286812868228683286842868528686286872868828689286902869128692286932869428695286962869728698286992870028701287022870328704287052870628707287082870928710287112871228713287142871528716287172871828719287202872128722287232872428725287262872728728287292873028731287322873328734287352873628737287382873928740287412874228743287442874528746287472874828749287502875128752287532875428755287562875728758287592876028761287622876328764287652876628767287682876928770287712877228773287742877528776287772877828779287802878128782287832878428785287862878728788287892879028791287922879328794287952879628797287982879928800288012880228803288042880528806288072880828809288102881128812288132881428815288162881728818288192882028821288222882328824288252882628827288282882928830288312883228833288342883528836288372883828839288402884128842288432884428845288462884728848288492885028851288522885328854288552885628857288582885928860288612886228863288642886528866288672886828869288702887128872288732887428875288762887728878288792888028881288822888328884288852888628887288882888928890288912889228893288942889528896288972889828899289002890128902289032890428905289062890728908289092891028911289122891328914289152891628917289182891928920289212892228923289242892528926289272892828929289302893128932289332893428935289362893728938289392894028941289422894328944289452894628947289482894928950289512895228953289542895528956289572895828959289602896128962289632896428965289662896728968289692897028971289722897328974289752897628977289782897928980289812898228983289842898528986289872898828989289902899128992289932899428995289962899728998289992900029001290022900329004290052900629007290082900929010290112901229013290142901529016290172901829019290202902129022290232902429025290262902729028290292903029031290322903329034290352903629037290382903929040290412904229043290442904529046290472904829049290502905129052290532905429055290562905729058290592906029061290622906329064290652906629067290682906929070290712907229073290742907529076290772907829079290802908129082290832908429085290862908729088290892909029091290922909329094290952909629097290982909929100291012910229103291042910529106291072910829109291102911129112291132911429115291162911729118291192912029121291222912329124291252912629127291282912929130291312913229133291342913529136291372913829139291402914129142291432914429145291462914729148291492915029151291522915329154291552915629157291582915929160291612916229163291642916529166291672916829169291702917129172291732917429175291762917729178291792918029181291822918329184291852918629187291882918929190291912919229193291942919529196291972919829199292002920129202292032920429205292062920729208292092921029211292122921329214292152921629217292182921929220292212922229223292242922529226292272922829229292302923129232292332923429235292362923729238292392924029241292422924329244292452924629247292482924929250292512925229253292542925529256292572925829259292602926129262292632926429265292662926729268292692927029271292722927329274292752927629277292782927929280292812928229283292842928529286292872928829289292902929129292292932929429295292962929729298292992930029301293022930329304293052930629307293082930929310293112931229313293142931529316293172931829319293202932129322293232932429325293262932729328293292933029331293322933329334293352933629337293382933929340293412934229343293442934529346293472934829349293502935129352293532935429355293562935729358293592936029361293622936329364293652936629367293682936929370293712937229373293742937529376293772937829379293802938129382293832938429385293862938729388293892939029391293922939329394293952939629397293982939929400294012940229403294042940529406294072940829409294102941129412294132941429415294162941729418294192942029421294222942329424294252942629427294282942929430294312943229433294342943529436294372943829439294402944129442294432944429445294462944729448294492945029451294522945329454294552945629457294582945929460294612946229463294642946529466294672946829469294702947129472294732947429475294762947729478294792948029481294822948329484294852948629487294882948929490294912949229493294942949529496294972949829499295002950129502295032950429505295062950729508295092951029511295122951329514295152951629517295182951929520295212952229523295242952529526295272952829529295302953129532295332953429535295362953729538295392954029541295422954329544295452954629547295482954929550295512955229553295542955529556295572955829559295602956129562295632956429565295662956729568295692957029571295722957329574295752957629577295782957929580295812958229583295842958529586295872958829589295902959129592295932959429595295962959729598295992960029601296022960329604296052960629607296082960929610296112961229613296142961529616296172961829619296202962129622296232962429625296262962729628296292963029631296322963329634296352963629637296382963929640296412964229643296442964529646296472964829649296502965129652296532965429655296562965729658296592966029661296622966329664296652966629667296682966929670296712967229673296742967529676296772967829679296802968129682296832968429685296862968729688296892969029691296922969329694296952969629697296982969929700297012970229703297042970529706297072970829709297102971129712297132971429715297162971729718297192972029721297222972329724297252972629727297282972929730297312973229733297342973529736297372973829739297402974129742297432974429745297462974729748297492975029751297522975329754297552975629757297582975929760297612976229763297642976529766297672976829769297702977129772297732977429775297762977729778297792978029781297822978329784297852978629787297882978929790297912979229793297942979529796297972979829799298002980129802298032980429805298062980729808298092981029811298122981329814298152981629817298182981929820298212982229823298242982529826298272982829829298302983129832298332983429835298362983729838298392984029841298422984329844298452984629847298482984929850298512985229853298542985529856298572985829859
  1. {
  2. This file is part of the Free Component Library
  3. Pascal resolver
  4. Copyright (c) 2020 Mattias Gaertner [email protected]
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************
  11. Abstract:
  12. Resolves references by setting TPasElement.CustomData as TResolvedReference.
  13. Creates search scopes for elements with sub identifiers by setting
  14. TPasElement.CustomData as TPasScope: unit, program, library, interface,
  15. implementation, procs
  16. Works:
  17. - built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
  18. - references in statements, error if not found
  19. - interface and implementation types, vars, const
  20. - params, local types, vars, const
  21. - nested procedures
  22. - nested forward procs, nested must be resolved before proc body
  23. - program/library/implementation forward procs
  24. - search in used units
  25. - unitname.identifier
  26. - alias types, 'type a=b'
  27. - type alias type 'type a=type b'
  28. - choose the most compatible overloaded procedure
  29. - while..do
  30. - repeat..until
  31. - if..then..else
  32. - binary operators
  33. - case..of
  34. - check duplicate values
  35. - try..finally..except, on, else, raise
  36. - for loop
  37. - fail to write a loop var inside the loop
  38. - spot duplicates
  39. - type cast base types
  40. - char
  41. - ord(), chr()
  42. - record
  43. - variants
  44. - const param makes children const too
  45. - const TRecordValues
  46. - function default(record type): record
  47. - advanced records:
  48. - $modeswitch AdvancedRecords
  49. - visibility public, private, strict private
  50. - sub type
  51. - const, var, class var
  52. - function/procedure/class function/class procedure
  53. - property, class property, default property
  54. - constructor
  55. - RTTI
  56. - class:
  57. - forward declaration
  58. - instance.a
  59. - find ancestor, search in ancestors
  60. - virtual, abstract, override
  61. - method body
  62. - Self
  63. - inherited
  64. - property
  65. - read var, read function
  66. - write var, write function
  67. - stored function
  68. - defaultexpr
  69. - is and as operator
  70. - nil
  71. - constructor result type, rrfNewInstance
  72. - destructor call type: rrfFreeInstance
  73. - type cast
  74. - class of
  75. - class method, property, var, const
  76. - class-of.constructor
  77. - class-of typecast upwards/downwards
  78. - class-of option to allow is-operator
  79. - typecast Self in class method upwards/downwards
  80. - property with params
  81. - default property
  82. - visibility, override: warn and fix if lower
  83. - events, proc type of object
  84. - sealed
  85. - $M+ / $TYPEINFO use visPublished as default visibility
  86. - note: constructing class with abstract method
  87. - with..do
  88. - enums - TPasEnumType, TPasEnumValue
  89. - propagate to parent scopes
  90. - function ord(): integer
  91. - function low(ordinal): ordinal
  92. - function high(ordinal): ordinal
  93. - function pred(ordinal): ordinal
  94. - function high(ordinal): ordinal
  95. - cast integer to enum, enum to integer
  96. - $ScopedEnums
  97. - sets - TPasSetType
  98. - set of char
  99. - set of integer
  100. - set of boolean
  101. - set of enum
  102. - ranges 'a'..'z' 2..5
  103. - operators: +, -, *, ><, <=, >=
  104. - in-operator
  105. - assign operators: +=, -=, *=
  106. - include(), exclude()
  107. - typed const: check expr type
  108. - function length(const array or string): integer
  109. - procedure setlength(var array or string; newlength: integer)
  110. - ranges TPasRangeType
  111. - procedure exit, procedure exit(const function result)
  112. - check if types only refer types+const
  113. - check const expression types, e.g. bark on "const c:string=3;"
  114. - procedure inc/dec(var ordinal; decr: ordinal = 1)
  115. - function Assigned(Pointer or Class or Class-Of): boolean
  116. - arrays TPasArrayType
  117. - TPasEnumType, char, integer, range
  118. - low, high, length, setlength, assigned
  119. - function concat(array1,array2,...): array
  120. - function copy(array): array, copy(a,start), copy(a,start,end)
  121. - insert(item; var array; index: integer)
  122. - delete(var array; start, count: integer)
  123. - element
  124. - multi dimensional
  125. - const
  126. - open array, override, pass array literal, pass var
  127. - type cast array to arrays with same dimensions and compatible element type
  128. - static array range checking
  129. - const array of char = string
  130. - a:=[...] // assignation using constant array
  131. - a:=[[...],[...]]
  132. - a:=[...]+[...] a+[] []+a modeswitch arrayoperators
  133. - delphi: var a: dynarray = []; // square bracket initialization
  134. - check if var initexpr fits vartype: var a: type = expr;
  135. - built-in functions high, low for range types
  136. - procedure type
  137. - call
  138. - as function result
  139. - as parameter
  140. - Delphi without @
  141. - @@ operator
  142. - FPC equal and not equal
  143. - "is nested"
  144. - bark on arguments access mismatch
  145. - function without params: mark if call or address, rrfImplicitCallWithoutParams
  146. - procedure break, procedure continue
  147. - built-in functions pred, succ for range type and enums
  148. - untyped parameters
  149. - built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
  150. - built-in procedure writestr(var s: string; Args: arguments...); varargs
  151. - pointer TPasPointerType
  152. - nil, assigned(), typecast, class, classref, dynarray, procvar
  153. - forward declaration
  154. - cycle detection
  155. - TypedPointer^, (@Some)^
  156. - = operator: TypedPointer, @Some, UntypedPointer
  157. - TypedPointer:=TypedPointer
  158. - TypedPointer:=@Some
  159. - pointer[index], (@i)[index]
  160. - dispose(pointerofrecord), new(pointerofrecord)
  161. - $PointerMath on|off
  162. - emit hints
  163. - platform, deprecated, experimental, library, unimplemented
  164. - hiding ancestor method
  165. - hiding other unit identifier
  166. - dotted unitnames
  167. - eval:
  168. - nil, true, false
  169. - range checking:
  170. - integer ranges
  171. - boolean ranges
  172. - enum ranges
  173. - char ranges
  174. - +, -, *, div, mod, /, shl, shr, or, and, xor, in, ^^, ><
  175. - =, <>, <, <=, >, >=
  176. - ord(), low(), high(), pred(), succ(), length()
  177. - string[index]
  178. - call(param)
  179. - a:=value
  180. - arr[index]
  181. - resourcestrings
  182. - custom ranges
  183. - enum: low(), high(), pred(), succ(), ord(), rg(int), int(rg), enum:=rg,
  184. rg:=rg, rg1:=rg2, rg:=enum, =, <>, in
  185. array[rg], low(array), high(array)
  186. - for..in..do :
  187. - type boolean, char, byte, shortint, word, smallint, longword, longint
  188. - type enum range, char range, integer range
  189. - type/var set of: enum, enum range, integer, integer range, char, char range
  190. - array var
  191. - function: enumerator
  192. - class
  193. - var modifier 'absolute'
  194. - Assert(bool[,string])
  195. - interfaces
  196. - $interfaces com|corba|default
  197. - root interface for com: delphi: IInterface, objfpc: IUnknown
  198. - method resolution
  199. - delegation via property implements: intftype, classtype
  200. - IntfVar as IntfType, intfvar as classtype, ObjVar as IntfType
  201. - IntfVar is IntfType, intfvar is classtype, ObjVar is IntfType
  202. - intftype(ObjVar), classtype(IntfVar)
  203. - default property
  204. - visibility public
  205. - $M+
  206. - class interfaces, check duplicates
  207. - assigned()
  208. - IntfVar:=nil, IntfVar:=IntfVar, IntfVar:=ObjVar, ObjVar:=IntfVar
  209. - IntfVar=IntfVar2
  210. - currency
  211. - eval type TResEvalCurrency
  212. - eval +, -, *, /, ^^
  213. - float*currency and currency*float computes to currency
  214. - type alias type overloads
  215. - $writeableconst off $J-
  216. - $warn identifier ON|off|error|default
  217. - anonymous methods:
  218. - assign in proc and program begin and initialization p:=procedure begin end
  219. - pass as arg doit(procedure begin end)
  220. - modifiers assembler varargs cdecl
  221. - typecast
  222. - with
  223. - self
  224. - built-in procedure Val(const s: string; var e: enumtype; out Code: integertype);
  225. - intrinsic functions Lo and Hi, depending on $mode (ObjFPC or Delphi):
  226. - In $MODE DELPHI:
  227. function Lo/Hi(i: <any integer type>): Byte
  228. - In $MODE OBJFPC:
  229. function Lo/Hi(i: Byte/ShortInt/Word/SmallInt): Byte
  230. function Lo/Hi(i: LongWord/LongInt/UIntSingle/IntSingle): Word
  231. function Lo/Hi(i: QWord/Int64/UIntDouble/IntDouble): LongWord
  232. - helpers:
  233. - class
  234. - record
  235. - type helper for simple type variables
  236. - InterfaceHelpers for fast gathering of helpers from uses sections
  237. - "inherited" and "inherited name" for Delphi and ObjFPC
  238. - for i in typehelped
  239. - nested: type, const, class var
  240. - visibility
  241. - property
  242. - helper method, Self as var argument
  243. - generics
  244. - array of const
  245. - attributes
  246. ToDo:
  247. - operator overload
  248. - operator enumerator
  249. - binaryexpr
  250. - advanced records
  251. - Include/Exclude for set of int/char/bool
  252. - error if property method resolution is not used
  253. - $H-hintpos$H+
  254. - $pop, $push
  255. - $RTTI inherited|explicit
  256. - range checking:
  257. - property defaultvalue
  258. - IntSet:=[-1]
  259. - CharSet:=[#13]
  260. - proc: check if forward and impl default values match
  261. - call array of proc without ()
  262. - generics, nested param lists
  263. - object
  264. - futures
  265. - TPasFileType
  266. - labels
  267. - $zerobasedstrings on|off
  268. - FOR_LOOP_VAR_VARPAR passing a loop var to a var parameter gives a warning
  269. - FOR_VARIABLE warning if using a global var as loop var
  270. - COMPARISON_FALSE COMPARISON_TRUE Comparison always evaluates to False
  271. - USE_BEFORE_DEF Variable '%s' might not have been initialized
  272. - FOR_LOOP_VAR_UNDEF FOR-Loop variable '%s' may be undefined after loop
  273. - TYPEINFO_IMPLICITLY_ADDED Published caused RTTI ($M+) to be added to type '%s'
  274. - IMPLICIT_STRING_CAST Implicit string cast from '%s' to '%s'
  275. - IMPLICIT_STRING_CAST_LOSS Implicit string cast with potential data loss from '%s' to '%s'
  276. - off by default: EXPLICIT_STRING_CAST Explicit string cast from '%s' to '%s'
  277. - off by default: EXPLICIT_STRING_CAST_LOSS Explicit string cast with potential data loss from '%s' to '%s'
  278. - IMPLICIT_INTEGER_CAST_LOSS Implicit integer cast with potential data loss from '%s' to '%s'
  279. - IMPLICIT_CONVERSION_LOSS Implicit conversion may lose significant digits from '%s' to '%s'
  280. - COMBINING_SIGNED_UNSIGNED64 Combining signed type and unsigned 64-bit type - treated as an unsigned type
  281. -
  282. Debug flags: -d<x>
  283. VerbosePasResolver
  284. Notes:
  285. Functions and function types without parameters:
  286. property P read f; // use function f, not its result
  287. f. // implicit resolve f once if param less function or function type
  288. f[] // implicit resolve f once if a param less function or function type
  289. @f; use function f, not its result
  290. @p.f; @ operator applies to f, not p
  291. @f(); @ operator applies to result of f
  292. f(); use f's result
  293. FuncVar:=Func; if mode=objfpc: incompatible
  294. if mode=delphi: implicit addr of function f
  295. if f=g then : can implicit resolve each side once
  296. p(f), f as var parameter: can implicit
  297. }
  298. unit PasResolver;
  299. {$i fcl-passrc.inc}
  300. {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
  301. {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
  302. interface
  303. uses
  304. {$ifdef pas2js}
  305. js,
  306. {$IFDEF NODEJS}
  307. Node.FS,
  308. {$ENDIF}
  309. {$endif}
  310. Classes, SysUtils, Math, Types, contnrs,
  311. PasTree, PScanner, PParser, PasResolveEval;
  312. const
  313. ParserMaxEmbeddedColumn = 2048;
  314. ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
  315. po_Resolver = [
  316. po_ResolveStandardTypes,
  317. po_NoOverloadedProcs,
  318. po_KeepClassForward,
  319. po_ArrayRangeExpr,
  320. po_CheckCondFunction];
  321. type
  322. TResolverBaseType = (
  323. btNone, // undefined
  324. btCustom, // provided by descendant resolver
  325. btContext, // any source declared type with LoTypeEl/HiTypeEl
  326. btModule,
  327. btUntyped, // TPasArgument without ArgType
  328. btChar, // char
  329. {$ifdef FPC_HAS_CPSTRING}
  330. btAnsiChar, // ansichar
  331. {$endif}
  332. btWideChar, // widechar
  333. btString, // string
  334. {$ifdef FPC_HAS_CPSTRING}
  335. btAnsiString, // ansistring
  336. btShortString, // shortstring
  337. btRawByteString, // rawbytestring
  338. {$endif}
  339. btWideString, // widestring
  340. btUnicodeString,// unicodestring
  341. btSingle, // single 1.5E-45..3.4E38, digits 7-8, bytes 4
  342. btDouble, // double 5.0E-324..1.7E308, digits 15-16, bytes 8
  343. btExtended, // extended platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
  344. btCExtended, // cextended
  345. btCurrency, // as int64 div 10000, float, not ordinal
  346. btBoolean, // boolean
  347. btByteBool, // bytebool true=not zero
  348. btWordBool, // wordbool true=not zero
  349. btLongBool, // longbool true=not zero
  350. {$ifdef HasInt64}
  351. btQWordBool, // qwordbool true=not zero
  352. {$endif}
  353. btByte, // byte 0..255
  354. btShortInt, // shortint -128..127
  355. btWord, // word unsigned 2 bytes
  356. btSmallInt, // smallint signed 2 bytes
  357. btUIntSingle, // unsigned integer range of single 22bit
  358. btIntSingle, // integer range of single 23bit
  359. btLongWord, // longword unsigned 4 bytes
  360. btLongint, // longint signed 4 bytes
  361. btUIntDouble, // unsigned integer range of double 52bit
  362. btIntDouble, // integer range of double 53bit
  363. {$ifdef HasInt64}
  364. btQWord, // qword 0..18446744073709551615, bytes 8
  365. btInt64, // int64 -9223372036854775808..9223372036854775807, bytes 8
  366. btComp, // as Int64, not ordinal
  367. {$endif}
  368. btPointer, // pointer or canonical pointer (e.g. @something)
  369. {$ifdef fpc}
  370. btFile, // file
  371. btText, // text
  372. btVariant, // variant
  373. {$endif}
  374. btNil, // nil = pointer, class, procedure, method, ...
  375. btProc, // TPasProcedure
  376. btBuiltInProc, // TPasUnresolvedSymbolRef with CustomData is TResElDataBuiltInProc
  377. btArrayProperty,// IdentEl is TPasProperty with Args.Count>0, LoTypeEl=nil
  378. btSet, // set of '', see SubType
  379. btArrayLit, // [] array literal (TParamsExpr, TArrayValues, TBinaryExpr), see SubType
  380. btArrayOrSet, // [] can be set or array literal, see SubType
  381. btRange // a..b see SubType
  382. );
  383. TResolveBaseTypes = set of TResolverBaseType;
  384. const
  385. btIntMax = {$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  386. btUIntMax = {$ifdef HasInt64}btQWord{$else}btUIntDouble{$endif};
  387. btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
  388. btLongWord,btLongint,btIntDouble,btUIntDouble
  389. {$ifdef HasInt64}
  390. ,btQWord,btInt64,btComp
  391. {$endif}];
  392. btAllIntegerNoQWord = btAllInteger{$ifdef HasInt64}-[btQWord]{$endif};
  393. btAllSignedInteger = [btShortInt,btSmallInt,btIntSingle,btLongint,btIntDouble
  394. {$ifdef HasInt64}
  395. ,btInt64,btComp
  396. {$endif}];
  397. btAllChars = [btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar];
  398. btAllStrings = [btString,
  399. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btShortString,btRawByteString,{$endif}
  400. btWideString,btUnicodeString];
  401. btAllStringAndChars = btAllStrings+btAllChars;
  402. btAllStringPointer = [btString,
  403. {$ifdef FPC_HAS_CPSTRING}btAnsiString,btRawByteString,{$endif}
  404. btWideString,btUnicodeString];
  405. btAllFloats = [btSingle,btDouble,
  406. btExtended,btCExtended,btCurrency];
  407. btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool
  408. {$ifdef HasInt64},btQWordBool{$endif}];
  409. btArrayRangeTypes = btAllChars+btAllBooleans+btAllInteger;
  410. btAllRanges = btArrayRangeTypes+[btRange];
  411. btAllWithSubType = [btSet, btArrayLit, btArrayOrSet, btRange];
  412. btAllIntrinsicTypes = btAllInteger+btAllStringAndChars+btAllFloats+btAllBooleans;
  413. btAllFPCTypes = [
  414. btChar,
  415. {$ifdef FPC_HAS_CPSTRING}
  416. btAnsiChar,
  417. {$endif}
  418. btWideChar,
  419. btString,
  420. {$ifdef FPC_HAS_CPSTRING}
  421. btAnsiString,
  422. btShortString,
  423. btRawByteString,
  424. {$endif}
  425. btWideString,
  426. btUnicodeString,
  427. btSingle,
  428. btDouble,
  429. btExtended,
  430. btCExtended,
  431. btCurrency,
  432. btBoolean,
  433. btByteBool,
  434. btWordBool,
  435. btLongBool,
  436. {$ifdef HasInt64}
  437. btQWordBool,
  438. {$endif}
  439. btByte,
  440. btShortInt,
  441. btWord,
  442. btSmallInt,
  443. btLongWord,
  444. btLongint,
  445. {$ifdef HasInt64}
  446. btQWord,
  447. btInt64,
  448. btComp,
  449. {$endif}
  450. btPointer
  451. {$ifdef fpc}
  452. ,btFile,
  453. btText,
  454. btVariant
  455. {$endif}
  456. ];
  457. ResBaseTypeNames: array[TResolverBaseType] of string =(
  458. 'None',
  459. 'Custom',
  460. 'Context',
  461. 'Module',
  462. 'Untyped',
  463. 'Char',
  464. {$ifdef FPC_HAS_CPSTRING}
  465. 'AnsiChar',
  466. {$endif}
  467. 'WideChar',
  468. 'String',
  469. {$ifdef FPC_HAS_CPSTRING}
  470. 'AnsiString',
  471. 'ShortString',
  472. 'RawByteString',
  473. {$endif}
  474. 'WideString',
  475. 'UnicodeString',
  476. 'Single',
  477. 'Double',
  478. 'Extended',
  479. 'CExtended',
  480. 'Currency',
  481. 'Boolean',
  482. 'ByteBool',
  483. 'WordBool',
  484. 'LongBool',
  485. {$ifdef HasInt64}
  486. 'QWordBool',
  487. {$endif}
  488. 'Byte',
  489. 'ShortInt',
  490. 'Word',
  491. 'SmallInt',
  492. 'UIntSingle',
  493. 'IntSingle',
  494. 'LongWord',
  495. 'Longint',
  496. 'UIntDouble',
  497. 'IntDouble',
  498. {$ifdef HasInt64}
  499. 'QWord',
  500. 'Int64',
  501. 'Comp',
  502. {$endif}
  503. 'Pointer',
  504. {$ifdef fpc}
  505. 'File',
  506. 'Text',
  507. 'Variant',
  508. {$endif}
  509. 'Nil',
  510. 'Procedure/Function',
  511. 'BuiltInProc',
  512. 'array property',
  513. 'set',
  514. 'array',
  515. 'set or array literal',
  516. 'range..'
  517. );
  518. type
  519. TResolverBuiltInProc = (
  520. bfCustom,
  521. bfLength,
  522. bfSetLength,
  523. bfInclude,
  524. bfExclude,
  525. bfBreak,
  526. bfContinue,
  527. bfExit,
  528. bfInc,
  529. bfDec,
  530. bfAssigned,
  531. bfChr,
  532. bfOrd,
  533. bfLow,
  534. bfHigh,
  535. bfPred,
  536. bfSucc,
  537. bfStrProc,
  538. bfStrFunc,
  539. bfWriteStr,
  540. bfVal,
  541. bfLo,
  542. bfHi,
  543. bfConcatArray,
  544. bfConcatString,
  545. bfCopyArray,
  546. bfInsertArray,
  547. bfDeleteArray,
  548. bfTypeInfo,
  549. bfGetTypeKind,
  550. bfAssert,
  551. bfNew,
  552. bfDispose,
  553. bfDefault
  554. );
  555. TResolverBuiltInProcs = set of TResolverBuiltInProc;
  556. const
  557. ResolverBuiltInProcNames: array[TResolverBuiltInProc] of string = (
  558. 'Custom',
  559. 'Length',
  560. 'SetLength',
  561. 'Include',
  562. 'Exclude',
  563. 'Break',
  564. 'Continue',
  565. 'Exit',
  566. 'Inc',
  567. 'Dec',
  568. 'Assigned',
  569. 'Chr',
  570. 'Ord',
  571. 'Low',
  572. 'High',
  573. 'Pred',
  574. 'Succ',
  575. 'Str',
  576. 'Str',
  577. 'WriteStr',
  578. 'Val',
  579. 'Lo',
  580. 'Hi',
  581. 'Concat',
  582. 'Concat',
  583. 'Copy',
  584. 'Insert',
  585. 'Delete',
  586. 'TypeInfo',
  587. 'GetTypeKind',
  588. 'Assert',
  589. 'New',
  590. 'Dispose',
  591. 'Default'
  592. );
  593. bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
  594. const
  595. ResolverResultVar = 'Result';
  596. {$IFDEF CheckPasTreeRefCount}
  597. RefIdInferenceParamsExpr = 'InferenceParamsExpr';
  598. {$ENDIF}
  599. type
  600. {$ifdef pas2js}
  601. TPasResIterate = procedure(Item, Arg: pointer) of object;
  602. { TPasResHashList }
  603. TPasResHashList = class
  604. private
  605. FItems: TJSObject;
  606. public
  607. constructor Create; reintroduce;
  608. procedure Add(const aName: string; Item: Pointer);
  609. function Find(const aName: string): Pointer;
  610. procedure ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  611. procedure Clear;
  612. procedure Remove(const aName: string);
  613. end;
  614. {$else}
  615. TPasResHashList = TFPHashList;
  616. {$endif}
  617. type
  618. { EPasResolve }
  619. EPasResolve = class(Exception)
  620. private
  621. FPasElement: TPasElement;
  622. procedure SetPasElement(AValue: TPasElement);
  623. public
  624. Id: TMaxPrecInt;
  625. MsgType: TMessageType;
  626. MsgNumber: integer;
  627. MsgPattern: String;
  628. Args: TMessageArgs;
  629. SourcePos: TPasSourcePos;
  630. destructor Destroy; override;
  631. property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
  632. end;
  633. type
  634. { TUnresolvedPendingRef }
  635. TUnresolvedPendingRef = class(TPasUnresolvedSymbolRef)
  636. public
  637. Element: TPasType; // TPasClassOfType or TPasPointerType
  638. end;
  639. { TPasSpecializeTypeData - CustomData of TPasSpecializeType
  640. for the generic type see TPasSpecializeType(Element).DestType }
  641. TPasSpecializeTypeData = Class(TResolveData)
  642. public
  643. SpecializedType: TPasGenericType;
  644. end;
  645. TPRSpecializeStep = (
  646. prssNone,
  647. prssInterfaceBuilding,
  648. prssInterfaceFinished,
  649. prssImplementationBuilding,
  650. prssImplementationFinished
  651. );
  652. { TPRSpecializedItem }
  653. TPRSpecializedItem = class
  654. private
  655. FSpecializedEl: TPasElement;
  656. public
  657. GenericEl: TPasElement;
  658. Index: integer;
  659. Step: TPRSpecializeStep; // how much of the specialized element has been created
  660. FirstSpecialize: TPasElement;
  661. Params: TPasTypeArray;
  662. SpecializedConstraints: TPasElementArray;
  663. destructor Destroy; override;
  664. property SpecializedEl: TPasElement read FSpecializedEl;
  665. end;
  666. { TPRSpecializedTypeItem }
  667. TPRSpecializedTypeItem = class(TPRSpecializedItem)
  668. private
  669. FSpecializedType: TPasGenericType;
  670. procedure SetSpecializedType(AValue: TPasGenericType);
  671. public
  672. HeaderScope: TObject; // TPasScope
  673. ImplProcs: TFPList; // list of TPasProcedure
  674. destructor Destroy; override;
  675. property SpecializedType: TPasGenericType read FSpecializedType write SetSpecializedType;
  676. end;
  677. { TPRSpecializedProcItem }
  678. TPRSpecializedProcItem = class(TPRSpecializedItem)
  679. private
  680. FSpecializedProc: TPasProcedure;
  681. procedure SetSpecializedProc(const AValue: TPasProcedure);
  682. public
  683. ImplProc: TPasProcedure; // <>SpecializedProc, can be nil
  684. destructor Destroy; override;
  685. property SpecializedProc: TPasProcedure read FSpecializedProc write SetSpecializedProc;
  686. end;
  687. TPSRefAccess = (
  688. psraNone,
  689. psraRead,
  690. psraWrite,
  691. psraReadWrite,
  692. psraWriteRead,
  693. psraTypeInfo
  694. );
  695. { TPasScopeReference }
  696. TPasScopeReference = class
  697. private
  698. FElement: TPasElement;
  699. procedure SetElement(const AValue: TPasElement);
  700. public
  701. {$IFDEF VerbosePasResolver}
  702. Owner: TObject;
  703. {$ENDIF}
  704. Access: TPSRefAccess;
  705. NextSameName: TPasScopeReference;
  706. destructor Destroy; override;
  707. property Element: TPasElement read FElement write SetElement;
  708. end;
  709. TPasScope = class;
  710. { TPasScopeReferences - used by TPasAnalyzer to store references of a proc or initialization section }
  711. TPasScopeReferences = class
  712. private
  713. FScope: TPasScope;
  714. procedure OnClearItem(Item, Dummy: pointer);
  715. procedure OnCollectItem(Item, aList: pointer);
  716. public
  717. References: TPasResHashList; // hash list of TPasScopeReference
  718. constructor Create(aScope: TPasScope);
  719. destructor Destroy; override;
  720. procedure Clear;
  721. function Add(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  722. function Find(const aName: string): TPasScopeReference;
  723. function GetList: TFPList;
  724. property Scope: TPasScope read FScope;
  725. end;
  726. TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
  727. Data: Pointer; var Abort: boolean) of object;
  728. { TPasScope -
  729. Elements like TPasClassType use TPasScope descendants as CustomData for
  730. their sub identifiers.
  731. TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
  732. }
  733. TPasScope = Class(TResolveData)
  734. public
  735. VisibilityContext: TPasElement; // used to check if the current context
  736. // is allowed to access a private/protected element
  737. class function IsStoredInElement: boolean; virtual;
  738. class function FreeOnPop: boolean; virtual;
  739. procedure IterateElements(const aName: string; StartScope: TPasScope;
  740. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  741. var Abort: boolean); virtual;
  742. procedure WriteIdentifiers(Prefix: string); virtual;
  743. end;
  744. TPasScopeClass = class of TPasScope;
  745. TPasScopeArray = array of TPasScope;
  746. TPasModuleScopeFlag = (
  747. pmsfAssertSearched, // assert constructors searched
  748. pmsfRangeErrorNeeded, // somewhere is range checking on
  749. pmsfRangeErrorSearched // ERangeError constructor searched
  750. );
  751. TPasModuleScopeFlags = set of TPasModuleScopeFlag;
  752. { TPasModuleScope }
  753. TPasModuleScope = class(TPasScope)
  754. private
  755. FAssertClass: TPasClassType;
  756. FAssertDefConstructor: TPasConstructor;
  757. FAssertMsgConstructor: TPasConstructor;
  758. FRangeErrorClass: TPasClassType;
  759. FRangeErrorConstructor: TPasConstructor;
  760. FSystemTVarRec: TPasRecordType;
  761. procedure SetAssertClass(const AValue: TPasClassType);
  762. procedure SetAssertDefConstructor(const AValue: TPasConstructor);
  763. procedure SetAssertMsgConstructor(const AValue: TPasConstructor);
  764. procedure SetRangeErrorClass(const AValue: TPasClassType);
  765. procedure SetRangeErrorConstructor(const AValue: TPasConstructor);
  766. procedure SetSystemTVarRec(const AValue: TPasRecordType);
  767. public
  768. FirstName: string; // the 'unit1' in 'unit1', or 'ns' in 'ns.unit1'
  769. PendingResolvers: TFPList; // list of TPasResolver waiting for the unit interface
  770. Flags: TPasModuleScopeFlags;
  771. BoolSwitches: TBoolSwitches;
  772. constructor Create; override;
  773. destructor Destroy; override;
  774. procedure IterateElements(const aName: string; StartScope: TPasScope;
  775. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  776. var Abort: boolean); override;
  777. property AssertClass: TPasClassType read FAssertClass write SetAssertClass;
  778. property AssertDefConstructor: TPasConstructor read FAssertDefConstructor write SetAssertDefConstructor;
  779. property AssertMsgConstructor: TPasConstructor read FAssertMsgConstructor write SetAssertMsgConstructor;
  780. property RangeErrorClass: TPasClassType read FRangeErrorClass write SetRangeErrorClass;
  781. property RangeErrorConstructor: TPasConstructor read FRangeErrorConstructor write SetRangeErrorConstructor;
  782. property SystemTVarRec: TPasRecordType read FSystemTVarRec write SetSystemTVarRec;
  783. end;
  784. TPasModuleScopeClass = class of TPasModuleScope;
  785. TPasIdentifierKind = (
  786. pikNone, // not yet initialized
  787. pikBaseType, // e.g. longint
  788. pikBuiltInProc, // e.g. High(), SetLength()
  789. pikSimple, // simple vars, consts, types, enums
  790. pikProc, // may need parameter list with round brackets
  791. pikNamespace
  792. );
  793. TPasIdentifierKinds = set of TPasIdentifierKind;
  794. { TPasIdentifier }
  795. TPasIdentifier = Class(TObject)
  796. private
  797. FElement: TPasElement;
  798. procedure SetElement(AValue: TPasElement);
  799. public
  800. {$IFDEF VerbosePasResolver}
  801. Owner: TObject;
  802. {$ENDIF}
  803. Identifier: String;
  804. NextSameIdentifier: TPasIdentifier; // next identifier with same name
  805. Kind: TPasIdentifierKind;
  806. destructor Destroy; override;
  807. property Element: TPasElement read FElement write SetElement;
  808. end;
  809. TPasIdentifierArray = array of TPasIdentifier;
  810. { TPasIdentifierScope - elements with a list of sub identifiers }
  811. TPasIdentifierScope = Class(TPasScope)
  812. private
  813. FItems: TPasResHashList; // hashlist of TPasIdentifier
  814. procedure InternalAdd(Item: TPasIdentifier);
  815. procedure OnClearItem(Item, Dummy: pointer);
  816. procedure OnCollectItem(Item, List: pointer);
  817. protected
  818. procedure OnWriteItem(Item, Dummy: pointer);
  819. public
  820. constructor Create; override;
  821. destructor Destroy; override;
  822. function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
  823. function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
  824. function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
  825. function AddIdentifier(const Identifier: String; El: TPasElement;
  826. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  827. function FindElement(const aName: string): TPasElement;
  828. procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
  829. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  830. var Abort: boolean);
  831. procedure IterateElements(const aName: string; StartScope: TPasScope;
  832. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  833. var Abort: boolean); override;
  834. procedure WriteIdentifiers(Prefix: string); override;
  835. procedure WriteLocalIdentifiers(Prefix: string); virtual;
  836. function GetLocalIdentifiers: TFPList; virtual;
  837. end;
  838. TPasIdentifierScopeArray = array of TPasIdentifierScope;
  839. { TPasDefaultScope - root scope }
  840. TPasDefaultScope = class(TPasIdentifierScope)
  841. public
  842. class function IsStoredInElement: boolean; override;
  843. end;
  844. { TPasIterateFilterData }
  845. TPasIterateFilterData = record
  846. OnIterate: TIterateScopeElement;
  847. Data: Pointer;
  848. end;
  849. PPasIterateFilterData = ^TPasIterateFilterData;
  850. { TPRHelperEntry }
  851. TPRHelperEntry = class
  852. public
  853. Added: integer; // Added is bigger when it was added later to the list
  854. HelperForType: TPasType; // alias resolved
  855. Helper: TPasClassType;
  856. end;
  857. TPRHelperEntryArray = array of TPRHelperEntry;
  858. { TPasSectionScope - e.g. interface, implementation, program, library }
  859. TPasSectionScope = Class(TPasIdentifierScope)
  860. private
  861. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  862. Data: Pointer; var Abort: boolean);
  863. public
  864. UsesScopes: TFPList; // list of TPasSectionScope
  865. UsesFinished: boolean;
  866. Finished: boolean;
  867. BoolSwitches: TBoolSwitches;
  868. ModeSwitches: TModeSwitches;
  869. Helpers: TPRHelperEntryArray; // only created for interface. Sorted ascending ComparePRHelperEntries
  870. constructor Create; override;
  871. destructor Destroy; override;
  872. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  873. procedure IterateElements(const aName: string; StartScope: TPasScope;
  874. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  875. var Abort: boolean); override;
  876. procedure WriteIdentifiers(Prefix: string); override;
  877. end;
  878. TPasSectionScopeClass = class of TPasSectionScope;
  879. { TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
  880. TPasInitialFinalizationScope = Class(TPasScope)
  881. public
  882. References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
  883. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  884. destructor Destroy; override;
  885. end;
  886. TPasInitialFinalizationScopeClass = class of TPasInitialFinalizationScope;
  887. { TPasEnumTypeScope }
  888. TPasEnumTypeScope = Class(TPasIdentifierScope)
  889. public
  890. CanonicalSet: TPasSetType;
  891. destructor Destroy; override;
  892. end;
  893. { TPasGenericParamsScope - used during parsing TPasGenericTemplateType(s) }
  894. TPasGenericParamsScope = Class(TPasIdentifierScope)
  895. public
  896. GenericType: TPasGenericType;
  897. end;
  898. TPSGenericStep = (
  899. psgsNone,
  900. psgsInterfaceParsed,
  901. psgsImplementationParsed
  902. );
  903. { TPasGenericScope }
  904. TPasGenericScope = Class(TPasIdentifierScope)
  905. public
  906. // for generic type:
  907. SpecializedItems: TObjectList; // list of TPRSpecializedItem
  908. GenericStep: TPSGenericStep; // how much of the generic was parsed
  909. // for specialized type:
  910. SpecializedFromItem: TPRSpecializedItem;
  911. destructor Destroy; override;
  912. end;
  913. { TPasArrayScope }
  914. TPasArrayScope = Class(TPasGenericScope)
  915. public
  916. end;
  917. TPasArrayScopeClass = class of TPasArrayScope;
  918. { TPasProcTypeScope }
  919. TPasProcTypeScope = Class(TPasGenericScope)
  920. public
  921. end;
  922. TPasProcTypeScopeClass = class of TPasProcTypeScope;
  923. { TPasClassOrRecordScope }
  924. TPasClassOrRecordScope = Class(TPasGenericScope)
  925. public
  926. DefaultProperty: TPasProperty;
  927. ClassConstructor: TPasClassConstructor;
  928. ClassDestructor: TPasClassDestructor;
  929. end;
  930. { TPasRecordScope }
  931. TPasRecordScope = Class(TPasClassOrRecordScope)
  932. end;
  933. TPasRecordScopeClass = class of TPasRecordScope;
  934. TPasClassScopeFlag = (
  935. pcsfAncestorResolved,
  936. pcsfSealed,
  937. pcsfPublished // default visibility is published due to $M directive
  938. );
  939. TPasClassScopeFlags = set of TPasClassScopeFlag;
  940. { TPasClassIntfMap }
  941. TPasClassIntfMap = class
  942. public
  943. Element: TPasElement;
  944. Intf: TPasClassType;
  945. Procs: TFPList;// maps Interface-member-index to TPasProcedure
  946. AncestorMap: TPasClassIntfMap;// AncestorMap.Element=Element, AncestorMap.Intf=DirectAncestor
  947. destructor Destroy; override;
  948. end;
  949. { TPasClassScope }
  950. TPasClassScope = Class(TPasClassOrRecordScope)
  951. public
  952. AncestorScope: TPasClassScope;
  953. CanonicalClassOf: TPasClassOfType;
  954. DirectAncestor: TPasType; // TPasClassType or TPasAliasType, see GetPasClassAncestor
  955. // Note: TPasClassType.AncestorType might be nil and DirectAncestor is "TObject"
  956. Flags: TPasClassScopeFlags;
  957. AbstractProcs: TArrayOfPasProcedure;
  958. Interfaces: TFPList; // list corresponds to TPasClassType(Element).Interfaces,
  959. // elements: TPasProperty for 'implements', or TPasClassIntfMap
  960. destructor Destroy; override;
  961. end;
  962. TPasClassScopeClass = class of TPasClassScope;
  963. { TPasGroupScope }
  964. TPasGroupScope = Class(TPasIdentifierScope)
  965. public
  966. Scopes: TPasIdentifierScopeArray;
  967. Count: integer;
  968. OnlyTypeMembers: boolean;
  969. procedure Add(Scope: TPasIdentifierScope);
  970. destructor Destroy; override;
  971. function GetFirstNonHelperScope: TPasIdentifierScope;
  972. class function IsStoredInElement: boolean; override;
  973. function FindAncestorIdentifier(const Identifier: String): TPasIdentifier;
  974. function FindAncestorElement(const Identifier: String): TPasElement;
  975. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  976. procedure IterateElements(const aName: string; StartScope: TPasScope;
  977. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  978. var Abort: boolean); override;
  979. procedure WriteIdentifiers(Prefix: string); override;
  980. end;
  981. TPasProcedureScopeFlag = (
  982. ppsfIsGroupOverload, // mode objfpc: one overload is enough for all procs in same scope
  983. ppsfIsSpecialized
  984. );
  985. TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
  986. { TPasProcedureScope }
  987. TPasProcedureScope = Class(TPasGenericScope)
  988. public
  989. DeclarationProc: TPasProcedure; // the corresponding forward declaration
  990. ImplProc: TPasProcedure; // the corresponding proc with Body
  991. OverriddenProc: TPasProcedure; // the ancestor proc with same signature
  992. ClassRecScope: TPasClassOrRecordScope;
  993. GroupScope: TPasGroupScope; // set during parsing a method body
  994. NestedMembersScope: TPasGroupScope; // set during parsing a method body of a nested class
  995. SelfArg: TPasArgument;
  996. Flags: TPasProcedureScopeFlags;
  997. BoolSwitches: TBoolSwitches; // if Body<>nil then body start, otherwise when FinishProc
  998. ModeSwitches: TModeSwitches; // at proc start
  999. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1000. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1001. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1002. var Abort: boolean); override;
  1003. function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
  1004. procedure WriteIdentifiers(Prefix: string); override;
  1005. destructor Destroy; override;
  1006. public
  1007. References: TPasScopeReferences; // created by TPasAnalyzer in DeclrationProc
  1008. function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
  1009. function GetReferences: TFPList;
  1010. end;
  1011. TPasProcedureScopeClass = class of TPasProcedureScope;
  1012. { TPasPropertyScope }
  1013. TPasPropertyScope = Class(TPasIdentifierScope)
  1014. public
  1015. AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
  1016. otherwise it is a redeclaration }
  1017. destructor Destroy; override;
  1018. end;
  1019. { TPasExceptOnScope }
  1020. TPasExceptOnScope = Class(TPasIdentifierScope)
  1021. end;
  1022. TPasWithScope = class;
  1023. TPasWithExprScopeFlag = (
  1024. wesfNeedTmpVar,
  1025. wesfOnlyTypeMembers,
  1026. wesfIsClassOf,
  1027. wesfConstParent // not writable
  1028. );
  1029. TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
  1030. { TPasWithExprScope }
  1031. TPasWithExprScope = Class(TPasScope)
  1032. public
  1033. WithScope: TPasWithScope; // owner
  1034. Index: integer;
  1035. Expr: TPasExpr;
  1036. Scope: TPasGroupScope;
  1037. ClassRecScope: TPasClassOrRecordScope;
  1038. Flags: TPasWithExprScopeFlags;
  1039. class function IsStoredInElement: boolean; override;
  1040. class function FreeOnPop: boolean; override;
  1041. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1042. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1043. var Abort: boolean); override;
  1044. procedure WriteIdentifiers(Prefix: string); override;
  1045. destructor Destroy; override;
  1046. end;
  1047. TPasWithExprScopeClass = class of TPasWithExprScope;
  1048. { TPasWithScope }
  1049. TPasWithScope = Class(TPasScope)
  1050. public
  1051. // Element is the TPasImplWithDo
  1052. ExpressionScopes: TObjectList; // list of TPasWithExprScope
  1053. constructor Create; override;
  1054. destructor Destroy; override;
  1055. end;
  1056. { TPasForLoopScope }
  1057. TPasForLoopScope = Class(TPasScope)
  1058. public
  1059. GetEnumerator: TPasFunction;
  1060. MoveNext: TPasFunction;
  1061. Current: TPasProperty;
  1062. end;
  1063. { TPasSubExprScope - base class for sub scopes aka dotted scopes }
  1064. TPasSubExprScope = Class(TPasIdentifierScope)
  1065. public
  1066. class function IsStoredInElement: boolean; override;
  1067. end;
  1068. { TPasDotBaseScope }
  1069. TPasDotBaseScope = Class(TPasSubExprScope)
  1070. public
  1071. GroupScope: TPasGroupScope;
  1072. OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
  1073. ConstParent: boolean;
  1074. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1075. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1076. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1077. var Abort: boolean); override;
  1078. procedure WriteIdentifiers(Prefix: string); override;
  1079. destructor Destroy; override;
  1080. end;
  1081. { TPasModuleDotScope - scope for searching unitname.<identifier> }
  1082. TPasModuleDotScope = Class(TPasDotBaseScope)
  1083. private
  1084. FModule: TPasModule;
  1085. procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
  1086. Data: Pointer; var Abort: boolean);
  1087. procedure SetModule(AValue: TPasModule);
  1088. public
  1089. ImplementationScope: TPasSectionScope;
  1090. InterfaceScope: TPasSectionScope;
  1091. SystemScope: TPasDefaultScope;
  1092. destructor Destroy; override;
  1093. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1094. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1095. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1096. var Abort: boolean); override;
  1097. procedure WriteIdentifiers(Prefix: string); override;
  1098. property Module: TPasModule read FModule write SetModule;
  1099. end;
  1100. { TPasDotEnumTypeScope - used for EnumType.EnumValue }
  1101. TPasDotEnumTypeScope = Class(TPasDotBaseScope)
  1102. public
  1103. EnumScope: TPasEnumTypeScope;
  1104. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1105. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1106. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1107. var Abort: boolean); override;
  1108. procedure WriteIdentifiers(Prefix: string); override;
  1109. end;
  1110. { TPasDotClassOrRecordScope }
  1111. TPasDotClassOrRecordScope = Class(TPasDotBaseScope)
  1112. public
  1113. ClassRecScope: TPasClassOrRecordScope;
  1114. end;
  1115. { TPasDotClassScope - used for aClass.subidentifier }
  1116. TPasDotClassScope = Class(TPasDotClassOrRecordScope)
  1117. public
  1118. IsClassOf: boolean; // true if aClassOf.
  1119. end;
  1120. { TPasInheritedScope - used for inherited; and inherited Name() }
  1121. TPasInheritedScope = Class(TPasDotClassOrRecordScope)
  1122. public
  1123. AncestorScope: TPasClassScope;
  1124. function FindIdentifier(const Identifier: String): TPasIdentifier; override;
  1125. procedure IterateElements(const aName: string; StartScope: TPasScope;
  1126. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1127. var Abort: boolean); override;
  1128. procedure WriteIdentifiers(Prefix: string); override;
  1129. end;
  1130. { TPasDotHelperScope }
  1131. TPasDotHelperScope = class(TPasDotBaseScope)
  1132. end;
  1133. TResolvedReferenceFlag = (
  1134. rrfDotScope, // found reference via a dot scope (TPasDotBaseScope)
  1135. rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
  1136. rrfNoImplicitCallWithoutParams, // a TPrimitiveExpr is not an implicit call
  1137. rrfNewInstance, // constructor call (without it call constructor as normal method)
  1138. rrfFreeInstance, // destructor call (without it call destructor as normal method)
  1139. rrfVMT, // use VMT for call
  1140. rrfConstInherited // parent is const and this child is too
  1141. );
  1142. TResolvedReferenceFlags = set of TResolvedReferenceFlag;
  1143. type
  1144. { TResolvedRefContext }
  1145. TResolvedRefContext = Class
  1146. end;
  1147. TResolvedRefAccess = (
  1148. rraNone,
  1149. rraRead, // expression is read
  1150. rraAssign, // expression is LHS assign
  1151. rraReadAndAssign, // expression is LHS +=, -=, *=, /=
  1152. rraVarParam, // expression is passed to a var parameter
  1153. rraOutParam, // expression is passed to an out parameter
  1154. rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
  1155. // will later be changed to rraRead, rraVarParam, rraOutParam
  1156. );
  1157. TPRResolveVarAccesses = set of TResolvedRefAccess;
  1158. const
  1159. rraAllRead = [rraRead,rraReadAndAssign,rraVarParam];
  1160. rraAllWrite = [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam];
  1161. ResolvedToPSRefAccess: array[TResolvedRefAccess] of TPSRefAccess = (
  1162. psraNone, // rraNone
  1163. psraRead, // rraRead
  1164. psraWrite, // rraAssign
  1165. psraReadWrite, // rraReadAndAssign
  1166. psraReadWrite, // rraVarParam
  1167. psraWrite, // rraOutParam
  1168. psraNone // rraParamToUnknownProc
  1169. );
  1170. type
  1171. { TResolvedReference - CustomData for normal references }
  1172. TResolvedReference = Class(TResolveData)
  1173. private
  1174. FDeclaration: TPasElement;
  1175. procedure SetDeclaration(AValue: TPasElement);
  1176. public
  1177. Flags: TResolvedReferenceFlags;
  1178. Access: TResolvedRefAccess;
  1179. Context: TResolvedRefContext;
  1180. WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
  1181. destructor Destroy; override;
  1182. property Declaration: TPasElement read FDeclaration write SetDeclaration;
  1183. end;
  1184. { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
  1185. TResolvedRefCtxConstructor = Class(TResolvedRefContext)
  1186. public
  1187. Typ: TPasType;
  1188. end;
  1189. { TResolvedRefCtxAttrProc - constructor of an attribute }
  1190. TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
  1191. public
  1192. Proc: TPasConstructor;
  1193. end;
  1194. TPasResolverResultFlag = (
  1195. rrfReadable,
  1196. rrfWritable,
  1197. rrfAssignable, // not writable in general, e.g. aString[1]:=
  1198. rrfCanBeStatement
  1199. );
  1200. TPasResolverResultFlags = set of TPasResolverResultFlag;
  1201. type
  1202. { TPasResolverResult }
  1203. TPasResolverResult = record
  1204. BaseType: TResolverBaseType;
  1205. SubType: TResolverBaseType; // for btSet, btArrayLit, btArrayOrSet, btRange
  1206. IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
  1207. LoTypeEl: TPasType; // can be nil for const expression, all alias resolved
  1208. HiTypeEl: TPasType; // same as LoTypeEl, except alias types are not resolved
  1209. ExprEl: TPasExpr;
  1210. Flags: TPasResolverResultFlags;
  1211. end;
  1212. PPasResolverResult = ^TPasResolverResult;
  1213. TPasResolverResultArray = array of TPasResolverResult;
  1214. type
  1215. TPasResolverComputeFlag = (
  1216. rcSetReferenceFlags, // set flags of references while computing type, used by Resolve* methods
  1217. rcNoImplicitProc, // do not call a function without params, includes rcNoImplicitProcType
  1218. rcNoImplicitProcType, // do not call a proc type without params
  1219. rcConstant, // resolve a constant expression, error if not computable
  1220. rcType, // resolve a type expression
  1221. rcCall // resolve result type of a function call
  1222. );
  1223. TPasResolverComputeFlags = set of TPasResolverComputeFlag;
  1224. TResElDataBuiltInSymbol = Class(TResolveData)
  1225. public
  1226. end;
  1227. { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
  1228. TResElDataBaseType = Class(TResElDataBuiltInSymbol)
  1229. public
  1230. BaseType: TResolverBaseType;
  1231. end;
  1232. TResElDataBaseTypeClass = class of TResElDataBaseType;
  1233. TResElDataBuiltInProc = Class;
  1234. TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
  1235. Exp: TPasExpr; RaiseOnError: boolean): integer of object;
  1236. TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1237. out ResolvedEl: TPasResolverResult) of object;
  1238. TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1239. Flags: TResEvalFlags; out Evaluated: TResEvalValue) of object;
  1240. TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
  1241. Params: TParamsExpr) of object;
  1242. TBuiltInProcFlag = (
  1243. bipfCanBeStatement // a call is enough for a simple statement
  1244. );
  1245. TBuiltInProcFlags = set of TBuiltInProcFlag;
  1246. { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
  1247. TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
  1248. public
  1249. Proc: TPasUnresolvedSymbolRef;
  1250. Signature: string;
  1251. BuiltIn: TResolverBuiltInProc;
  1252. GetCallCompatibility: TOnGetCallCompatibility;
  1253. GetCallResult: TOnGetCallResult;
  1254. Eval: TOnEvalBIFunction;
  1255. FinishParamsExpression: TOnFinishParamsExpr;
  1256. Flags: TBuiltInProcFlags;
  1257. destructor Destroy; override;
  1258. end;
  1259. { TPRFindData }
  1260. TPRFindData = record
  1261. ErrorPosEl: TPasElement;
  1262. Found: TPasElement;
  1263. ElScope: TPasScope; // Where Found was found
  1264. StartScope: TPasScope; // where the search started
  1265. SkipGenerics: boolean;
  1266. end;
  1267. PPRFindData = ^TPRFindData;
  1268. TPRFindGenericData = record
  1269. Find: TPRFindData;
  1270. TemplateCount: integer;
  1271. end;
  1272. PPRFindGenericData = ^TPRFindGenericData;
  1273. TPasResolverOption = (
  1274. proFixCaseOfOverrides, // fix Name of overriding proc/property to the overriden proc/property
  1275. proClassPropertyNonStatic, // class property accessors can be non static
  1276. proPropertyAsVarParam, // allows to pass a property as a var/out argument
  1277. proClassOfIs, // class-of supports is and as operator
  1278. proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
  1279. proOpenAsDynArrays, // open arrays work like dynamic arrays
  1280. //ToDo: proStaticArrayCopy, // copy works with static arrays, returning a dynamic array
  1281. //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array
  1282. proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
  1283. proMethodAddrAsPointer, // can assign @method to a pointer
  1284. proSafecallAllowsDefault // allow assigning a default calling convention to a SafeCall proc
  1285. );
  1286. TPasResolverOptions = set of TPasResolverOption;
  1287. { TPasResolverHub }
  1288. TPasResolverHub = class
  1289. private
  1290. FOwner: TObject;
  1291. public
  1292. FinishedInterfaceCount: integer;
  1293. constructor Create(TheOwner: TObject); virtual;
  1294. procedure Reset; virtual;
  1295. property Owner: TObject read FOwner;
  1296. end;
  1297. TPasResolverHubClass = class of TPasResolverHub;
  1298. TPasResolverStep = (
  1299. prsInit,
  1300. prsParsing,
  1301. prsFinishingModule,
  1302. prsFinishedModule
  1303. );
  1304. TPasResolverSteps = set of TPasResolverStep;
  1305. TPRResolveAlias = (
  1306. prraNone, // do not resolve alias
  1307. prraSimple, // resolve alias, but not type alias
  1308. prraAlias // resolve alias and type alias
  1309. );
  1310. TPRProcTypeDescFlag = (
  1311. prptdUseName, // add name if available
  1312. prptdAddPaths, // add full paths to types
  1313. prptdResolveSimpleAlias
  1314. );
  1315. TPRProcTypeDescFlags = set of TPRProcTypeDescFlag;
  1316. TPRParentParams = record
  1317. InlineSpec: TInlineSpecializeExpr;
  1318. Params: TParamsExpr;
  1319. end;
  1320. TPRTemplateCompOp = (
  1321. prtcoAssignToTempl,
  1322. prtcoAssignFromTempl,
  1323. prtcoEqual
  1324. );
  1325. { TPasResolver }
  1326. TPasResolver = Class(TPasTreeContainer)
  1327. private
  1328. type
  1329. TResolveDataListKind = (lkBuiltIn,lkModule);
  1330. function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
  1331. function GetScopes(Index: integer): TPasScope; inline;
  1332. private
  1333. FActiveHelpers: TPRHelperEntryArray; // sorted ascending ComparePRHelperEntries
  1334. FAnonymousElTypePostfix: String;
  1335. FBaseTypeChar: TResolverBaseType;
  1336. FBaseTypeExtended: TResolverBaseType;
  1337. FBaseTypeLength: TResolverBaseType;
  1338. FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
  1339. FBaseTypeString: TResolverBaseType;
  1340. FBuiltInProcs: array[TResolverBuiltInProc] of TResElDataBuiltInProc;
  1341. FDefaultNameSpace: String;
  1342. FDefaultScope: TPasDefaultScope;
  1343. FDynArrayMaxIndex: TMaxPrecInt;
  1344. FDynArrayMinIndex: TMaxPrecInt;
  1345. FFinishedInterfaceIndex: integer;
  1346. FHub: TPasResolverHub;
  1347. FLastCreatedData: array[TResolveDataListKind] of TResolveData;
  1348. FLastElement: TPasElement;
  1349. FLastMsg: string;
  1350. FLastMsgArgs: TMessageArgs;
  1351. FLastMsgElement: TPasElement;
  1352. FLastMsgId: TMaxPrecInt;
  1353. FLastMsgNumber: integer;
  1354. FLastMsgPattern: string;
  1355. FLastMsgType: TMessageType;
  1356. FLastSourcePos: TPasSourcePos;
  1357. FOptions: TPasResolverOptions;
  1358. FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
  1359. FRootElement: TPasModule;
  1360. FScopeClass_Array: TPasArrayScopeClass;
  1361. FScopeClass_Class: TPasClassScopeClass;
  1362. FScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass;
  1363. FScopeClass_Module: TPasModuleScopeClass;
  1364. FScopeClass_Proc: TPasProcedureScopeClass;
  1365. FScopeClass_ProcType: TPasProcTypeScopeClass;
  1366. FScopeClass_Record: TPasRecordScopeClass;
  1367. FScopeClass_Section: TPasSectionScopeClass;
  1368. FScopeClass_WithExpr: TPasWithExprScopeClass;
  1369. FScopeCount: integer;
  1370. FScopes: TPasScopeArray; // stack of scopes
  1371. FStep: TPasResolverStep;
  1372. FStoreSrcColumns: boolean;
  1373. FStashScopeCount: integer;
  1374. FStashScopes: TPasScopeArray; // stack of scopes
  1375. FTopScope: TPasScope;
  1376. procedure ClearResolveDataList(Kind: TResolveDataListKind);
  1377. function GetBaseTypeNames(bt: TResolverBaseType): string;
  1378. function GetBuiltInProcs(bp: TResolverBuiltInProc): TResElDataBuiltInProc;
  1379. protected
  1380. const
  1381. cExact = 0;
  1382. cGenericExact = cExact+1;
  1383. cAliasExact = cGenericExact+1;
  1384. cCompatible = cAliasExact+1;
  1385. cIntToIntConversion = ord(High(TResolverBaseType));
  1386. cFloatToFloatConversion = 2*cIntToIntConversion;
  1387. cTypeConversion = cExact+10000; // e.g. TObject to Pointer
  1388. cLossyConversion = cExact+100000;
  1389. cIntToFloatConversion = cExact+400000; // int to float is worse than bigint to smallint
  1390. cIncompatible = High(integer);
  1391. var
  1392. cTGUIDToString: integer;
  1393. cStringToTGUID: integer;
  1394. cInterfaceToTGUID: integer;
  1395. cInterfaceToString: integer;
  1396. type
  1397. TFindCallElData = record
  1398. Params: TParamsExpr;
  1399. TemplCnt: integer;
  1400. Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
  1401. LastProc: TPasProcedure;
  1402. ElScope, StartScope: TPasScope;
  1403. Distance: integer; // compatibility distance
  1404. Count: integer;
  1405. List: TFPList; // if not nil then collect all found elements here
  1406. end;
  1407. PFindCallElData = ^TFindCallElData;
  1408. TFindProcKind = (
  1409. fpkProcDeclaration, // search declaration for a body
  1410. fpkProc, // check overloads for a proc
  1411. fpkMethod // check overloads for a method
  1412. );
  1413. TFindProcData = record
  1414. Proc: TPasProcedure;
  1415. Args: TFPList; // List of TPasArgument objects
  1416. Kind: TFindProcKind;
  1417. FoundOverloadModifier: boolean;
  1418. FoundInSameScope: integer;
  1419. Found: TPasProcedure;
  1420. ElScope, StartScope: TPasScope;
  1421. FoundNonProc: TPasElement;
  1422. end;
  1423. PFindProcData = ^TFindProcData;
  1424. procedure OnFindFirst_PreferNoParams(El: TPasElement; ElScope, StartScope: TPasScope;
  1425. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1426. procedure OnFindFirst(El: TPasElement; ElScope, StartScope: TPasScope;
  1427. FindFirstElementData: Pointer; var Abort: boolean); virtual;
  1428. procedure OnFindFirst_GenericEl(El: TPasElement; ElScope, StartScope: TPasScope;
  1429. FindFirstGenericData: Pointer; var Abort: boolean); virtual;
  1430. procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
  1431. FindCallElData: Pointer; var Abort: boolean); virtual; // find candidates for Name(params)
  1432. procedure OnFindProc(El: TPasElement; ElScope, StartScope: TPasScope;
  1433. FindProcData: Pointer; var Abort: boolean); virtual;
  1434. procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
  1435. FindProcData: Pointer; var Abort: boolean); virtual;
  1436. function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
  1437. function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
  1438. Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
  1439. protected
  1440. procedure SetCurrentParser(AValue: TPasParser); override;
  1441. procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
  1442. State: TWarnMsgState; var Handled: boolean); virtual;
  1443. procedure SetRootElement(const AValue: TPasModule); virtual;
  1444. procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
  1445. function AddIdentifier(Scope: TPasIdentifierScope;
  1446. const aName: String; El: TPasElement;
  1447. const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
  1448. procedure AddModule(El: TPasModule); virtual;
  1449. procedure AddSection(El: TPasSection); virtual;
  1450. procedure AddInitialFinalizationSection(El: TPasImplBlock); virtual;
  1451. procedure AddType(El: TPasType); virtual;
  1452. procedure AddArrayType(El: TPasArrayType; TypeParams: TFPList); virtual;
  1453. procedure AddRecordType(El: TPasRecordType; TypeParams: TFPList); virtual;
  1454. procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual;
  1455. procedure AddVariable(El: TPasVariable); virtual;
  1456. procedure AddResourceString(El: TPasResString); virtual;
  1457. procedure AddEnumType(El: TPasEnumType); virtual;
  1458. procedure AddEnumValue(El: TPasEnumValue); virtual;
  1459. procedure AddProperty(El: TPasProperty); virtual;
  1460. procedure AddProcedureType(El: TPasProcedureType; TypeParams: TFPList); virtual;
  1461. procedure AddProcedure(El: TPasProcedure; TypeParams: TFPList); virtual;
  1462. procedure AddProcedureBody(El: TProcedureBody); virtual;
  1463. procedure AddArgument(El: TPasArgument); virtual;
  1464. procedure AddFunctionResult(El: TPasResultElement); virtual;
  1465. procedure AddGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1466. procedure AddExceptOn(El: TPasImplExceptOn); virtual;
  1467. procedure AddWithDo(El: TPasImplWithDo); virtual;
  1468. procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
  1469. procedure ResolveImplElement(El: TPasImplElement); virtual;
  1470. procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
  1471. procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
  1472. procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
  1473. procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
  1474. procedure ResolveImplAssign(El: TPasImplAssign); virtual;
  1475. procedure ResolveImplSimple(El: TPasImplSimple); virtual;
  1476. procedure ResolveImplRaise(El: TPasImplRaise); virtual;
  1477. procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
  1478. procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
  1479. procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
  1480. procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
  1481. procedure ResolveInheritedName(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1482. procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1483. procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
  1484. procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1485. procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
  1486. procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1487. procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; TemplParams: TFPList;
  1488. Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string = ''); virtual;
  1489. procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1490. procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
  1491. procedure ResolveArrayParamsArgs(Params: TParamsExpr;
  1492. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
  1493. function ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  1494. const ResolvedValue: TPasResolverResult;
  1495. Access: TResolvedRefAccess): boolean; virtual;
  1496. procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
  1497. procedure ResolveArrayValues(El: TArrayValues); virtual;
  1498. procedure ResolveRecordValues(El: TRecordValues); virtual;
  1499. procedure ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr; Access: TResolvedRefAccess); virtual;
  1500. function ResolveAccessor(Expr: TPasExpr): TPasElement;
  1501. procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
  1502. Access: TResolvedRefAccess); virtual;
  1503. procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
  1504. function MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType): boolean; virtual;
  1505. procedure MarkArrayExprRecursive(Expr: TPasExpr; ArrType: TPasArrayType); virtual;
  1506. procedure FinishModule(CurModule: TPasModule); virtual;
  1507. procedure FinishUsesClause; virtual;
  1508. procedure FinishSection(Section: TPasSection); virtual;
  1509. procedure FinishInterfaceSection(Section: TPasSection); virtual;
  1510. procedure FinishTypeSection(El: TPasElement); virtual;
  1511. procedure FinishTypeSectionEl(El: TPasType); virtual;
  1512. procedure FinishTypeDef(El: TPasType); virtual;
  1513. procedure FinishEnumType(El: TPasEnumType); virtual;
  1514. procedure FinishSetType(El: TPasSetType); virtual;
  1515. procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
  1516. procedure FinishRangeType(El: TPasRangeType); virtual;
  1517. procedure FinishConstRangeExpr(RangeExpr: TBinaryExpr;
  1518. out LeftResolved, RightResolved: TPasResolverResult);
  1519. procedure FinishRecordType(El: TPasRecordType); virtual;
  1520. procedure FinishClassType(El: TPasClassType); virtual;
  1521. procedure FinishClassOfType(El: TPasClassOfType); virtual;
  1522. procedure FinishPointerType(El: TPasPointerType); virtual;
  1523. procedure FinishArrayType(El: TPasArrayType); virtual;
  1524. procedure FinishAliasType(El: TPasAliasType); virtual;
  1525. procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
  1526. procedure FinishSpecializeType(El: TPasSpecializeType); virtual;
  1527. procedure FinishResourcestring(El: TPasResString); virtual;
  1528. procedure FinishProcedure(Proc: TPasProcedure); virtual;
  1529. procedure FinishProcedureType(El: TPasProcedureType); virtual;
  1530. procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
  1531. procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
  1532. procedure FinishExceptOnExpr; virtual;
  1533. procedure FinishExceptOnStatement; virtual;
  1534. procedure FinishWithDo(El: TPasImplWithDo); virtual;
  1535. procedure FinishForLoopHeader(Loop: TPasImplForLoop); virtual;
  1536. procedure FinishDeclaration(El: TPasElement); virtual;
  1537. procedure FinishVariable(El: TPasVariable); virtual;
  1538. procedure FinishProperty(PropEl: TPasProperty); virtual;
  1539. procedure FinishArgument(El: TPasArgument); virtual;
  1540. procedure FinishAncestors(aClass: TPasClassType); virtual;
  1541. procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
  1542. procedure FinishAttributes(El: TPasAttributes); virtual;
  1543. procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
  1544. procedure FinishPropertyParamAccess(Params: TParamsExpr;
  1545. Prop: TPasProperty); virtual;
  1546. procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess); virtual;
  1547. procedure FinishInitialFinalization(El: TPasImplBlock); virtual;
  1548. procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
  1549. function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
  1550. procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  1551. procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
  1552. function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
  1553. procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
  1554. procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
  1555. IsOverride: boolean);
  1556. procedure CheckPendingForwardProcs(El: TPasElement);
  1557. procedure CheckPointerCycle(El: TPasPointerType);
  1558. procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
  1559. procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
  1560. Flags: TPasResolverComputeFlags); virtual;
  1561. procedure ComputeBinaryExpr(Bin: TBinaryExpr;
  1562. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1563. StartEl: TPasElement);
  1564. procedure ComputeBinaryExprRes(Bin: TBinaryExpr;
  1565. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1566. var LeftResolved, RightResolved: TPasResolverResult); virtual;
  1567. function ComputeAddStringRes(
  1568. const LeftResolved, RightResolved: TPasResolverResult; ExprEl: TPasExpr;
  1569. out ResolvedEl: TPasResolverResult): boolean; virtual;
  1570. procedure ComputeArgumentAndExpr(
  1571. Arg: TPasArgument; out ArgResolved: TPasResolverResult;
  1572. Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  1573. SetReferenceFlags: boolean);
  1574. procedure ComputeArgumentExpr(const ArgResolved: TPasResolverResult;
  1575. Access: TArgumentAccess; Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  1576. SetReferenceFlags: boolean);
  1577. procedure ComputeArrayParams(Params: TParamsExpr;
  1578. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1579. StartEl: TPasElement);
  1580. procedure ComputeArrayParams_Class(Params: TParamsExpr;
  1581. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  1582. Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
  1583. procedure ComputeFuncParams(Params: TParamsExpr;
  1584. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1585. StartEl: TPasElement);
  1586. procedure ComputeTypeCast(ToLoType, ToHiType: TPasType;
  1587. Param: TPasExpr; const ParamResolved: TPasResolverResult;
  1588. out ResolvedEl: TPasResolverResult;
  1589. Flags: TPasResolverComputeFlags); virtual;
  1590. procedure ComputeSetParams(Params: TParamsExpr;
  1591. out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  1592. StartEl: TPasElement);
  1593. procedure ComputeDereference(El: TUnaryExpr; var ResolvedEl: TPasResolverResult);
  1594. procedure ComputeArrayValuesExpectedType(El: TArrayValues; out ResolvedEl: TPasResolverResult;
  1595. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1596. procedure ComputeRecordValues(El: TRecordValues; out ResolvedEl: TPasResolverResult;
  1597. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  1598. procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
  1599. function CheckTypeCastClassInstanceToClass(
  1600. const FromClassRes, ToClassRes: TPasResolverResult;
  1601. ErrorEl: TPasElement): integer; virtual; // type cast not related classes
  1602. procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
  1603. const LHS, RHS: TPasResolverResult);
  1604. function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
  1605. ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
  1606. procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
  1607. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  1608. procedure ConvertRangeToElement(var ResolvedEl: TPasResolverResult);
  1609. function IsCharLiteral(const Value: string; ErrorPos: TPasElement): TResolverBaseType; virtual;
  1610. function CheckForIn(Loop: TPasImplForLoop;
  1611. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1612. function CheckForInClassOrRec(Loop: TPasImplForLoop;
  1613. const VarResolved, InResolved: TPasResolverResult): boolean; virtual;
  1614. function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
  1615. MinCount: integer; RaiseOnError: boolean): boolean;
  1616. function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
  1617. MaxCount: integer; RaiseOnError: boolean; Signature: string = ''): integer;
  1618. function CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer; Param: TPasExpr;
  1619. const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
  1620. function FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
  1621. function FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
  1622. procedure FinishAssertCall(Proc: TResElDataBuiltInProc;
  1623. Params: TParamsExpr); virtual;
  1624. function FindSystemIdentifier(const aUnitName, aName: string;
  1625. ErrorEl: TPasElement): TPasElement; virtual;
  1626. function FindSystemClassType(const aUnitName, aClassName: string;
  1627. ErrorEl: TPasElement): TPasClassType; virtual;
  1628. function FindSystemClassTypeAndConstructor(const aUnitName, aClassName: string;
  1629. out aClass: TPasClassType; out aConstructor: TPasConstructor;
  1630. ErrorEl: TPasElement): boolean; virtual;
  1631. procedure FindAssertExceptionConstructors(ErrorEl: TPasElement); virtual;
  1632. procedure FindRangeErrorConstructors(ErrorEl: TPasElement); virtual;
  1633. function FindTVarRec(ErrorEl: TPasElement): TPasRecordType; virtual;
  1634. function GetTVarRec(El: TPasArrayType): TPasRecordType; virtual;
  1635. function FindDefaultConstructor(aClass: TPasClassType): TPasConstructor; virtual;
  1636. function GetTypeInfoParamType(Param: TPasExpr;
  1637. out ParamResolved: TPasResolverResult; LoType: boolean): TPasType; virtual; // returns type of param in typeinfo(param)
  1638. protected
  1639. // constant evaluation
  1640. fExprEvaluator: TResExprEvaluator;
  1641. procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: TMaxPrecInt;
  1642. MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
  1643. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); virtual;
  1644. function OnExprEvalIdentifier(Sender: TResExprEvaluator;
  1645. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1646. function OnExprEvalParams(Sender: TResExprEvaluator;
  1647. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
  1648. procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
  1649. var MsgType: TMessageType); virtual;
  1650. function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
  1651. protected
  1652. // generic/specialize
  1653. type
  1654. TScopeStashState = record
  1655. ScopeCount: integer;
  1656. StashCount: integer;
  1657. end;
  1658. procedure AddGenericTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1659. Scope: TPasIdentifierScope);
  1660. procedure AddSpecializedTemplateIdentifiers(GenericTemplateTypes: TFPList;
  1661. SpecializedItem: TPRSpecializedItem; Scope: TPasIdentifierScope;
  1662. CheckConstraints: boolean);
  1663. function CreateInferenceTypesForCall(Params: TParamsExpr;
  1664. TargetProc: TPasProcedure): TFPList;
  1665. function CheckGenericConstraintFitsParam(ParamType: TPasType;
  1666. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1667. TemplType: TPasGenericTemplateType; ConEl: TPasElement;
  1668. Operation: TPRTemplateCompOp;
  1669. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1670. ): integer;
  1671. function CheckTemplateFitsParam(ParamType: TPasType;
  1672. GenTempl: TPasGenericTemplateType;
  1673. SpecializedItem: TPRSpecializedItem; // set to specialize constraints
  1674. Operation: TPRTemplateCompOp;
  1675. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1676. ): integer;
  1677. function CheckTemplateFitsParamRes(GenTempl: TPasGenericTemplateType;
  1678. const ResolvedEl: TPasResolverResult;
  1679. Operation: TPRTemplateCompOp;
  1680. ErrorPos: TPasElement // can be nil to get a compatibility Result
  1681. ): integer;
  1682. procedure CheckTemplateFitsTemplate(ParamTemplType,
  1683. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  1684. function CreateSpecializedItem(El: TPasElement; GenericEl: TPasElement;
  1685. const ParamsResolved: TPasTypeArray): TPRSpecializedItem; virtual;
  1686. function CreateSpecializedTypeName(Item: TPRSpecializedItem): string; virtual;
  1687. procedure InitSpecializeScopes(El: TPasElement; out State: TScopeStashState); virtual;
  1688. procedure RestoreSpecializeScopes(const State: TScopeStashState); virtual;
  1689. procedure SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem); virtual;
  1690. procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem); virtual;
  1691. procedure SpecializeMembers(GenMembersType, SpecMembersType: TPasMembersType); virtual;
  1692. procedure SpecializeMembersImpl(GenericType, SpecType: TPasMembersType;
  1693. SpecializedItem: TPRSpecializedTypeItem); virtual;
  1694. procedure SpecializeGenImplProc(GenDeclProc, SpecDeclProc: TPasProcedure;
  1695. SpecializedItem: TPRSpecializedItem); virtual;
  1696. procedure SpecializeElement(GenEl, SpecEl: TPasElement);
  1697. procedure SpecializePasElementProperties(GenEl, SpecEl: TPasElement);
  1698. procedure SpecializeVariable(GenEl, SpecEl: TPasVariable; Finish: boolean);
  1699. procedure SpecializeConst(GenEl, SpecEl: TPasConst);
  1700. procedure SpecializeProperty(GenEl, SpecEl: TPasProperty);
  1701. function SpecializeTypeRef(GenEl, SpecEl: TPasElement; GenTypeRef: TPasType): TPasType;
  1702. procedure SpecializeElType(GenEl, SpecEl: TPasElement;
  1703. GenElType: TPasType; var SpecElType: TPasType);
  1704. procedure SpecializeElExpr(GenEl, SpecEl: TPasElement;
  1705. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  1706. procedure SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  1707. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  1708. procedure SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  1709. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  1710. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1711. procedure SpecializeElList(GenEl, SpecEl: TPasElement;
  1712. GenList, SpecList: TFPList; AllowReferences: boolean
  1713. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1714. procedure SpecializeElArray(GenEl, SpecEl: TPasElement;
  1715. GenList: TPasElementArray; var SpecList: TPasElementArray; AllowReferences: boolean
  1716. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  1717. procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure; SpecializedItem: TPRSpecializedItem);
  1718. procedure SpecializeOperator(GenEl, SpecEl: TPasOperator);
  1719. procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  1720. procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  1721. procedure SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  1722. procedure SpecializeSpecializeType(GenEl, SpecEl: TPasSpecializeType);
  1723. procedure SpecializeGenericTemplateType(GenEl, SpecEl: TPasGenericTemplateType);
  1724. procedure SpecializeArgument(GenEl, SpecEl: TPasArgument);
  1725. procedure SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  1726. procedure SpecializeImplAsmStatement(GenEl, SpecEl: TPasImplAsmStatement);
  1727. procedure SpecializeImplRepeatUntil(GenEl, SpecEl: TPasImplRepeatUntil);
  1728. procedure SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  1729. procedure SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  1730. procedure SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  1731. procedure SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  1732. procedure SpecializeImplCaseStatement(GenEl, SpecEl: TPasImplCaseStatement);
  1733. procedure SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  1734. procedure SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  1735. procedure SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  1736. procedure SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  1737. procedure SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  1738. procedure SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  1739. procedure SpecializeExpr(GenEl, SpecEl: TPasExpr);
  1740. procedure SpecializeExprArray(GenEl, SpecEl: TPasElement;
  1741. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  1742. procedure SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  1743. procedure SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  1744. procedure SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  1745. procedure SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  1746. procedure SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  1747. procedure SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  1748. procedure SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  1749. procedure SpecializeInlineSpecializeExpr(GenEl, SpecEl: TInlineSpecializeExpr);
  1750. procedure SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  1751. procedure SpecializeResString(GenEl, SpecEl: TPasResString);
  1752. procedure SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  1753. procedure SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  1754. procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  1755. procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType; SpecializedItem: TPRSpecializedTypeItem);
  1756. procedure SpecializeRecordType(GenEl, SpecEl: TPasRecordType; SpecializedItem: TPRSpecializedTypeItem);
  1757. procedure SpecializeClassType(GenEl, SpecEl: TPasClassType; SpecializedItem: TPRSpecializedTypeItem);
  1758. procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  1759. procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  1760. procedure SpecializeSetType(GenEl, SpecEl: TPasSetType);
  1761. procedure SpecializeVariant(GenEl, SpecEl: TPasVariant);
  1762. procedure SpecializeStringType(GenEl, SpecEl: TPasStringType);
  1763. procedure SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  1764. procedure SpecializeMethodResolution(GenEl, SpecEl: TPasMethodResolution);
  1765. protected
  1766. // custom types (added by descendant resolvers)
  1767. function CheckAssignCompatibilityCustom(
  1768. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1769. RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
  1770. function CheckEqualCompatibilityCustomType(
  1771. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  1772. RaiseOnIncompatible: boolean): integer; virtual;
  1773. protected
  1774. // built-in functions
  1775. function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1776. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1777. procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1778. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1779. procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  1780. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1781. function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1782. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1783. procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1784. Params: TParamsExpr); virtual;
  1785. function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1786. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1787. procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1788. Params: TParamsExpr); virtual;
  1789. function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1790. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1791. function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1792. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1793. function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1794. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1795. function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1796. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1797. procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1798. Params: TParamsExpr); virtual;
  1799. function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1800. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1801. procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1802. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1803. procedure BI_Assigned_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1804. Params: TParamsExpr); virtual;
  1805. function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1806. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1807. procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1808. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1809. procedure BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  1810. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1811. function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1812. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1813. procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1814. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1815. procedure BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  1816. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1817. function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1818. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1819. procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1820. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1821. procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  1822. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1823. function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1824. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1825. procedure BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1826. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1827. procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  1828. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1829. function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  1830. const ParamResolved: TPasResolverResult; ArgNo: integer;
  1831. RaiseOnError: boolean): integer;
  1832. function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1833. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1834. procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1835. Params: TParamsExpr); virtual;
  1836. function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1837. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1838. procedure BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1839. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1840. procedure BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  1841. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1842. function BI_WriteStrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1843. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1844. procedure BI_WriteStrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1845. Params: TParamsExpr); virtual;
  1846. function BI_Val_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1847. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1848. procedure BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1849. Params: TParamsExpr); virtual;
  1850. function BI_LoHi_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1851. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1852. procedure BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1853. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1854. procedure BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  1855. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1856. function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1857. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1858. procedure BI_ConcatArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1859. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1860. function BI_ConcatString_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1861. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1862. procedure BI_ConcatString_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1863. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1864. procedure BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  1865. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1866. function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1867. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1868. procedure BI_CopyArray_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1869. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1870. function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1871. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1872. procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1873. Params: TParamsExpr); virtual;
  1874. function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1875. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1876. procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1877. Params: TParamsExpr); virtual;
  1878. function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1879. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1880. procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1881. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1882. function BI_GetTypeKind_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1883. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1884. procedure BI_GetTypeKind_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1885. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1886. procedure BI_GetTypeKind_OnEval(Proc: TResElDataBuiltInProc;
  1887. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1888. function BI_Assert_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1889. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1890. procedure BI_Assert_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1891. Params: TParamsExpr); virtual;
  1892. function BI_New_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1893. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1894. procedure BI_New_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1895. Params: TParamsExpr); virtual;
  1896. function BI_Dispose_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1897. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1898. procedure BI_Dispose_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  1899. Params: TParamsExpr); virtual;
  1900. function BI_Default_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  1901. Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
  1902. procedure BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  1903. Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
  1904. procedure BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  1905. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue); virtual;
  1906. public
  1907. constructor Create;
  1908. destructor Destroy; override;
  1909. procedure Clear; virtual; // does not free built-in identifiers
  1910. // overrides of TPasTreeContainer
  1911. function CreateElement(AClass: TPTreeElement; const AName: String;
  1912. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1913. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1914. overload; override;
  1915. function CreateElement(AClass: TPTreeElement; const AName: String;
  1916. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1917. const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
  1918. overload; override;
  1919. function FindModule(const AName: String; NameExpr, InFileExpr: TPasExpr): TPasModule; override;
  1920. function FindUnit(const AName, InFilename: String;
  1921. NameExpr, InFileExpr: TPasExpr): TPasModule; virtual; abstract;
  1922. function FindElement(const aName: String): TPasElement; override; // used by TPasParser
  1923. function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser
  1924. function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
  1925. NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  1926. function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
  1927. ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  1928. function FindFirstEl(const AName: String; out Data: TPRFindData;
  1929. ErrorPosEl: TPasElement): TPasElement;
  1930. procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  1931. function FindGenericEl(const AName: string; TemplateCount: integer;
  1932. out Find: TPRFindData; ErrorPosEl: TPasElement): TPasElement; virtual;
  1933. procedure IterateElements(const aName: string;
  1934. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  1935. var Abort: boolean); virtual;
  1936. procedure CheckFoundElement(const FindData: TPRFindData;
  1937. Ref: TResolvedReference); virtual;
  1938. procedure CheckFoundElementVisibility(const FindData: TPRFindData;
  1939. Ref: TResolvedReference); virtual;
  1940. function GetVisibilityContext: TPasElement;
  1941. procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1942. procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
  1943. procedure FinishTypeAlias(var NewType: TPasType); override;
  1944. function IsUnitIntfFinished(AModule: TPasModule): boolean;
  1945. procedure NotifyPendingUsedInterfaces; virtual;
  1946. function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
  1947. function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
  1948. procedure UsedInterfacesFinished(Section: TPasSection); virtual;
  1949. function NeedArrayValues(El: TPasElement): boolean; override;
  1950. function GetDefaultClassVisibility(AClass: TPasClassType
  1951. ): TPasMemberVisibility; override;
  1952. procedure ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  1953. Before: boolean; var Handled: boolean); override;
  1954. // built in types and functions
  1955. procedure ClearBuiltInIdentifiers; virtual;
  1956. procedure AddObjFPCBuiltInIdentifiers(
  1957. const TheBaseTypes: TResolveBaseTypes = btAllFPCTypes;
  1958. const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
  1959. function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
  1960. function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  1961. function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
  1962. function AddBuiltInProc(const aName: string; Signature: string;
  1963. const GetCallCompatibility: TOnGetCallCompatibility;
  1964. const GetCallResult: TOnGetCallResult;
  1965. const EvalConst: TOnEvalBIFunction = nil;
  1966. const FinishParamsExpr: TOnFinishParamsExpr = nil;
  1967. const BuiltIn: TResolverBuiltInProc = bfCustom;
  1968. const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
  1969. // add extra TResolveData (E.CustomData) to free list
  1970. procedure AddResolveData(El: TPasElement; Data: TResolveData;
  1971. Kind: TResolveDataListKind);
  1972. function CreateReference(DeclEl, RefEl: TPasElement;
  1973. Access: TResolvedRefAccess;
  1974. FindData: PPRFindData = nil): TResolvedReference; virtual;
  1975. // scopes
  1976. function GetLocalScope: TPasScope; inline;
  1977. function GetParentLocalScope: TPasScope; inline;
  1978. function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
  1979. function CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean = true): TPasGroupScope; virtual;
  1980. procedure GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope; HiType: TPasType; WithTopHelpers: boolean = true);
  1981. procedure PopScope;
  1982. procedure PopWithScope(El: TPasImplWithDo);
  1983. procedure PopGenericParamScope(El: TPasGenericType); virtual;
  1984. procedure PushScope(Scope: TPasScope); overload;
  1985. function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
  1986. function PushGroupScope(HiType: TPasType): TPasGroupScope;
  1987. function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  1988. function PushClassDotScope(var CurClassType: TPasClassType; WithTopHelpers: boolean = true): TPasDotClassScope;
  1989. function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  1990. function PushInheritedScope(ClassOrRec: TPasMembersType;
  1991. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  1992. function PushEnumDotScope(HiType: TPasType; EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  1993. function PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  1994. function PushTemplateDotScope(TemplType: TPasGenericTemplateType; ErrorEl: TPasElement): TPasDotBaseScope;
  1995. function PushDotScope(HiType: TPasType): TPasDotBaseScope;
  1996. function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  1997. function StashScopes(NewScopeCnt: integer): integer; // returns old StashDepth
  1998. function StashSubExprScopes: integer; // returns old StashDepth
  1999. procedure RestoreStashedScopes(StashDepth: integer);
  2000. procedure DeleteScope(Index: integer); virtual;
  2001. procedure InsertScope(Scope: TPasScope; Index: integer); virtual;
  2002. function GetCurrentProcScope(ErrorEl: TPasElement): TPasProcedureScope;
  2003. function GetProcScope(El: TPasElement): TPasProcedureScope;
  2004. function GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  2005. function GetSelfScope(El: TPasElement): TPasProcedureScope;
  2006. procedure AddHelper(Helper: TPasClassType; var List: TPRHelperEntryArray);
  2007. procedure AddActiveHelper(Helper: TPasClassType); virtual;
  2008. // log and messages
  2009. class function MangleSourceLineNumber(Line, Column: integer): integer;
  2010. class procedure UnmangleSourceLineNumber(LineNumber: integer;
  2011. out Line, Column: integer);
  2012. class function GetDbgSourcePosStr(El: TPasElement): string;
  2013. function GetElementSourcePosStr(El: TPasElement): string;
  2014. procedure SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  2015. Const Fmt : String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2016. PosEl: TPasElement);
  2017. procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  2018. const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2019. PosEl: TPasElement); overload;
  2020. class function GetWarnIdentifierNumbers(Identifier: string;
  2021. out MsgNumbers: TIntegerDynArray): boolean; virtual;
  2022. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasResolverResult;
  2023. out GotDesc, ExpDesc: String); overload;
  2024. procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
  2025. out GotDesc, ExpDesc: String); overload;
  2026. procedure GetIncompatibleProcParamsDesc(GotType, ExpType: TPasProcedureType;
  2027. out GotDesc, ExpDesc: string);
  2028. procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
  2029. Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2030. ErrorPosEl: TPasElement); virtual;
  2031. procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
  2032. procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
  2033. procedure RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement; const Msg: string = '');
  2034. procedure RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string; El: TPasElement);
  2035. procedure RaiseXExpectedButYFound(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  2036. procedure RaiseXExpectedButTypeYFound(id: TMaxPrecInt; const X: string; Y: TPasType; El: TPasElement);
  2037. procedure RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C,X,Y: string; El: TPasElement);
  2038. procedure RaiseContextXInvalidY(id: TMaxPrecInt; const X,Y: string; El: TPasElement);
  2039. procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  2040. procedure RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement; IdentEl: TPasElement);
  2041. procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  2042. procedure RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  2043. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2044. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  2045. procedure RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  2046. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2047. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  2048. procedure RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  2049. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  2050. const GotType, ExpType: TPasResolverResult;
  2051. ErrorEl: TPasElement);
  2052. procedure RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt; ErrorEl: TPasElement);
  2053. procedure RaiseInvalidProcTypeModifier(id: TMaxPrecInt; ProcType: TPasProcedureType;
  2054. ptm: TProcTypeModifier; ErrorEl: TPasElement);
  2055. procedure RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  2056. pm: TProcedureModifier; ErrorEl: TPasElement);
  2057. procedure WriteScopes;
  2058. procedure WriteScopesShort(Title: string);
  2059. // find value and type of an element
  2060. procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
  2061. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
  2062. procedure ComputeResultElement(El: TPasResultElement; out ResolvedEl: TPasResolverResult;
  2063. Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil); virtual;
  2064. function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2065. function Eval(const Value: TPasResolverResult; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue; overload;
  2066. // checking compatibilility
  2067. function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same
  2068. function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
  2069. function IndexOfGenericParam(Params: TPasExprArray): integer;
  2070. procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  2071. ErrorEl: TPasElement);
  2072. function CheckCallProcCompatibility(ProcType: TPasProcedureType;
  2073. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  2074. function CheckCallPropertyCompatibility(PropEl: TPasProperty;
  2075. Params: TParamsExpr; RaiseOnError: boolean): integer;
  2076. function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  2077. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
  2078. function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
  2079. ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
  2080. function CheckParamResCompatibility(Expr: TPasExpr; const ExprResolved,
  2081. ParamResolved: TPasResolverResult; ParamNo: integer; RaiseOnError: boolean;
  2082. SetReferenceFlags: boolean): integer;
  2083. function CheckAssignCompatibilityUserType(
  2084. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2085. RaiseOnIncompatible: boolean): integer;
  2086. function CheckAssignCompatibilityArrayType(
  2087. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2088. RaiseOnIncompatible: boolean): integer;
  2089. function CheckAssignCompatibilityPointerType(LTypeEl, RTypeEl: TPasType;
  2090. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2091. function CheckEqualCompatibilityUserType(
  2092. const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
  2093. RaiseOnIncompatible: boolean): integer; virtual; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  2094. function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
  2095. function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
  2096. ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
  2097. function CheckTypeCastArray(FromType, ToType: TPasArrayType;
  2098. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  2099. function CheckSrcIsADstType(
  2100. const ResolvedSrcType, ResolvedDestType: TPasResolverResult): integer;
  2101. function CheckClassIsClass(SrcType, DestType: TPasType): integer; virtual;
  2102. function CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  2103. function CheckAssignCompatibilityClasses(LType, RType: TPasClassType): integer; virtual; // not related classes
  2104. function GetClassImplementsIntf(ClassEl, Intf: TPasClassType): TPasClassType;
  2105. function CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  2106. function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
  2107. IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
  2108. function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): integer;
  2109. function CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  2110. ResolveAlias: TPRResolveAlias): integer;
  2111. function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  2112. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  2113. function CheckAssignCompatibility(const LHS, RHS: TPasElement;
  2114. RaiseOnIncompatible: boolean = true; ErrorEl: TPasElement = nil): integer;
  2115. procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  2116. procedure CheckAssignExprRangeToCustom(const LeftResolved: TPasResolverResult;
  2117. RValue: TResEvalValue; RHS: TPasExpr); virtual;
  2118. function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
  2119. ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
  2120. function CheckEqualElCompatibility(Left, Right: TPasElement;
  2121. ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2122. SetReferenceFlags: boolean = false): integer;
  2123. function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
  2124. LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  2125. RErrorEl: TPasElement = nil): integer;
  2126. function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
  2127. function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
  2128. PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
  2129. function ResolvedElIsClassOrRecordInstance(const ResolvedEl: TPasResolverResult): boolean;
  2130. // utility functions
  2131. function GetResolver(El: TPasElement): TPasResolver;
  2132. function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
  2133. function GetElModeSwitches(El: TPasElement): TModeSwitches;
  2134. function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
  2135. function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  2136. function GetProcTypeDescription(ProcType: TPasProcedureType;
  2137. Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
  2138. function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
  2139. function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
  2140. function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2141. function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
  2142. function GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  2143. function GetProcTemplateTypes(Proc: TPasProcedure): TFPList; // list of TPasGenericTemplateType
  2144. function GetProcName(Proc: TPasProcedure; WithTemplates: boolean = true): string;
  2145. function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
  2146. function GetPasPropertyType(El: TPasProperty): TPasType;
  2147. function GetPasPropertyArgs(El: TPasProperty): TFPList;
  2148. function GetPasPropertyGetter(El: TPasProperty): TPasElement;
  2149. function GetPasPropertySetter(El: TPasProperty): TPasElement;
  2150. function GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  2151. function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  2152. function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  2153. function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
  2154. function GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
  2155. function GetParentProcBody(El: TPasElement): TProcedureBody;
  2156. function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
  2157. function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
  2158. function GetLoop(El: TPasElement): TPasImplElement;
  2159. function ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean = true): TPasType;
  2160. function ResolveAliasTypeEl(El: TPasElement): TPasType; inline;
  2161. function ExprIsAddrTarget(El: TPasExpr): boolean;
  2162. function IsNameExpr(El: TPasExpr): boolean; inline; // TPrimitiveExpr with Kind=pekIdent
  2163. function GetNameExprValue(El: TPasExpr): string; // TPrimitiveExpr with Kind=pekIdent
  2164. function GetNextDottedExpr(El: TPasExpr): TPasExpr;
  2165. function GetLeftMostExpr(El: TPasExpr): TPasExpr;
  2166. function GetRightMostExpr(El: TPasExpr): TPasExpr;
  2167. procedure GetParamsOfNameExpr(El: TPasExpr; out ParentParams: TPRParentParams);
  2168. function GetInlineSpecOfNameExpr(El: TPasExpr): TInlineSpecializeExpr;
  2169. function GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  2170. function GetPathStart(El: TPasExpr): TPasExpr;
  2171. function GetPathEndIdent(El: TPasExpr; AllowCall: boolean): TPasExpr;
  2172. function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  2173. function ParentNeedsExprResult(El: TPasExpr): boolean;
  2174. function GetReference_ConstructorType(Ref: TResolvedReference; Expr: TPasExpr): TPasResolverResult;
  2175. function GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  2176. function GetSetType(const ResolvedSet: TPasResolverResult): TPasSetType;
  2177. function IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean = true): boolean;
  2178. function IsOpenArray(TypeEl: TPasType): boolean;
  2179. function IsDynOrOpenArray(TypeEl: TPasType): boolean;
  2180. function IsArrayOfConst(TypeEl: TPasType): boolean;
  2181. function GetArrayElType(ArrType: TPasArrayType): TPasType;
  2182. function IsVarInit(Expr: TPasExpr): boolean;
  2183. function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  2184. function IsClassMethod(El: TPasElement): boolean;
  2185. function IsClassField(El: TPasElement): boolean;
  2186. function GetFunctionType(El: TPasElement): TPasFunctionType;
  2187. function MethodIsStatic(El: TPasProcedure): boolean;
  2188. function IsMethod(El: TPasProcedure): boolean;
  2189. function IsHelperMethod(El: TPasElement): boolean; virtual;
  2190. function IsHelper(El: TPasElement): boolean;
  2191. function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
  2192. function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
  2193. function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
  2194. function IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  2195. function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  2196. function IsTypeCast(Params: TParamsExpr): boolean;
  2197. function IsGenericTemplType(const ResolvedEl: TPasResolverResult): boolean;
  2198. function GetTypeParameterCount(aType: TPasGenericType): integer;
  2199. function GetGenericConstraintKeyword(El: TPasElement): TToken;
  2200. function GetGenericConstraintErrorEl(ConstraintEl, TemplType: TPasElement): TPasElement;
  2201. function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  2202. Params: TFPList): TPasElement; virtual;
  2203. procedure FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope); virtual;
  2204. procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
  2205. function IsSpecialized(El: TPasGenericType): boolean; overload;
  2206. function IsFullySpecialized(El: TPasGenericType): boolean; overload;
  2207. function IsFullySpecialized(Proc: TPasProcedure): boolean; overload;
  2208. function IsInterfaceType(const ResolvedEl: TPasResolverResult;
  2209. IntfType: TPasClassInterfaceType): boolean; overload;
  2210. function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
  2211. function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
  2212. function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
  2213. function IsCustomAttribute(El: TPasElement): boolean; virtual;
  2214. function IsSystemUnit(El: TPasModule): boolean; virtual;
  2215. function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
  2216. function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
  2217. function ProcNeedsParams(El: TPasProcedureType): boolean;
  2218. function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
  2219. function GetTopLvlProc(El: TPasElement): TPasProcedure;
  2220. function GetParentProc(El: TPasElement; GetDeclProc: boolean): TPasProcedure;
  2221. function GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  2222. function EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  2223. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
  2224. function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
  2225. function HasTypeInfo(El: TPasType): boolean; virtual;
  2226. function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
  2227. function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2228. function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2229. procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
  2230. function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: TMaxPrecInt): boolean;
  2231. function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
  2232. function GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt): TResolverBaseType; // returns BaseTypeExtended if too big
  2233. function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2234. function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2235. function GetCombinedBaseType(const A, B: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
  2236. function IsElementSkipped(El: TPasElement): boolean; virtual;
  2237. function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
  2238. function GetFirstSection(WithUnitImpl: boolean): TPasSection;
  2239. function GetLastSection: TPasSection;
  2240. function GetParentSection(El: TPasElement): TPasSection;
  2241. function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit;
  2242. function FirstSectionUsesUnit(aModule: TPasModule): boolean;
  2243. function ImplementationUsesUnit(aModule: TPasModule; NotInIntf: boolean = true): boolean;
  2244. function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  2245. isLoFunc: Boolean; out Mask: LongWord): Integer;
  2246. public
  2247. property Hub: TPasResolverHub read FHub write FHub;
  2248. // options
  2249. property Options: TPasResolverOptions read FOptions write FOptions;
  2250. property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
  2251. write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
  2252. property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
  2253. property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
  2254. property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
  2255. property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
  2256. property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
  2257. property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
  2258. property BuiltInProcs[bp: TResolverBuiltInProc]: TResElDataBuiltInProc read GetBuiltInProcs;
  2259. property ExprEvaluator: TResExprEvaluator read fExprEvaluator;
  2260. property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex;
  2261. property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex;
  2262. property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
  2263. If true Line and Column is mangled together in TPasElement.SourceLineNumber.
  2264. Use method UnmangleSourceLineNumber to extract. }
  2265. // parsed values
  2266. property DefaultNameSpace: String read FDefaultNameSpace;
  2267. property RootElement: TPasModule read FRootElement write SetRootElement;
  2268. property Step: TPasResolverStep read FStep;
  2269. property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers;
  2270. property FinishedInterfaceIndex: integer read FFinishedInterfaceIndex;
  2271. // scopes
  2272. property Scopes[Index: integer]: TPasScope read GetScopes;
  2273. property ScopeCount: integer read FScopeCount;
  2274. property TopScope: TPasScope read FTopScope;
  2275. property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
  2276. property ScopeClass_Array: TPasArrayScopeClass read FScopeClass_Array write FScopeClass_Array;
  2277. property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
  2278. property ScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass read FScopeClass_InitialFinalization write FScopeClass_InitialFinalization;
  2279. property ScopeClass_Module: TPasModuleScopeClass read FScopeClass_Module write FScopeClass_Module;
  2280. property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
  2281. property ScopeClass_ProcType: TPasProcTypeScopeClass read FScopeClass_ProcType write FScopeClass_ProcType;
  2282. property ScopeClass_Record: TPasRecordScopeClass read FScopeClass_Record write FScopeClass_Record;
  2283. property ScopeClass_Section: TPasSectionScopeClass read FScopeClass_Section write FScopeClass_Section;
  2284. property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
  2285. // last element
  2286. property LastElement: TPasElement read FLastElement;
  2287. property LastMsg: string read FLastMsg write FLastMsg;
  2288. property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
  2289. property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
  2290. property LastMsgId: TMaxPrecInt read FLastMsgId write FLastMsgId;
  2291. property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
  2292. property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
  2293. property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
  2294. property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
  2295. end;
  2296. function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
  2297. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2298. function GetClassAncestorsDbg(El: TPasClassType): string;
  2299. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2300. function GetElementTypeName(El: TPasElement): string; overload;
  2301. function GetElementTypeName(C: TPasElementBaseClass): string; overload;
  2302. function GetElementDbgPath(El: TPasElement): string; overload;
  2303. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2304. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2305. BaseType: TResolverBaseType; IdentEl: TPasElement;
  2306. LoTypeEl, HiTypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
  2307. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2308. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2309. Flags: TPasResolverResultFlags); overload;
  2310. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2311. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2312. Flags: TPasResolverResultFlags); overload;
  2313. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2314. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2315. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2316. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2317. function ChompDottedIdentifier(const Identifier: string): string;
  2318. function FirstDottedIdentifier(const Identifier: string): string; // without <>
  2319. function LastDottedIdentifier(const Identifier: string): string; // without <>
  2320. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2321. function GetFirstDotPos(const Identifier: string): integer;
  2322. function GetLastDotPos(const Identifier: string): integer;
  2323. {$IF FPC_FULLVERSION<30101}
  2324. function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
  2325. {$ENDIF}
  2326. function DotExprToName(Expr: TPasExpr): string;
  2327. function NoNil(o: TObject): TObject;
  2328. function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
  2329. function dbgs(const a: TResolvedRefAccess): string; overload;
  2330. function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
  2331. function dbgs(const a: TPSRefAccess): string; overload;
  2332. implementation
  2333. function GetTreeDbg(El: TPasElement; Indent: integer): string;
  2334. procedure LineBreak(SubIndent: integer);
  2335. begin
  2336. Inc(Indent,SubIndent);
  2337. Result:=Result+LineEnding+StringOfChar(' ',Indent);
  2338. end;
  2339. var
  2340. i, l: Integer;
  2341. begin
  2342. if El=nil then exit('nil');
  2343. Result:=El.Name+':'+El.ClassName+'=';
  2344. if El is TPasExpr then
  2345. begin
  2346. if El.ClassType<>TBinaryExpr then
  2347. Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
  2348. if El.ClassType=TUnaryExpr then
  2349. Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
  2350. else if El.ClassType=TBinaryExpr then
  2351. Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
  2352. +OpcodeStrings[TPasExpr(El).OpCode]
  2353. +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
  2354. else if El.ClassType=TPrimitiveExpr then
  2355. Result:=Result+TPrimitiveExpr(El).Value
  2356. else if El.ClassType=TBoolConstExpr then
  2357. Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
  2358. else if El.ClassType=TNilExpr then
  2359. Result:=Result+'nil'
  2360. else if El.ClassType=TInheritedExpr then
  2361. Result:=Result+'inherited'
  2362. else if El.ClassType=TSelfExpr then
  2363. Result:=Result+'Self'
  2364. else if El.ClassType=TParamsExpr then
  2365. begin
  2366. LineBreak(2);
  2367. Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
  2368. l:=length(TParamsExpr(El).Params);
  2369. if l>0 then
  2370. begin
  2371. inc(Indent,2);
  2372. for i:=0 to l-1 do
  2373. begin
  2374. LineBreak(0);
  2375. Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
  2376. if i<l-1 then
  2377. Result:=Result+','
  2378. end;
  2379. dec(Indent,2);
  2380. end;
  2381. Result:=Result+')';
  2382. end
  2383. else if El.ClassType=TRecordValues then
  2384. begin
  2385. Result:=Result+'(';
  2386. l:=length(TRecordValues(El).Fields);
  2387. if l>0 then
  2388. begin
  2389. inc(Indent,2);
  2390. for i:=0 to l-1 do
  2391. begin
  2392. LineBreak(0);
  2393. Result:=Result+TRecordValues(El).Fields[i].Name+':'
  2394. +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
  2395. if i<l-1 then
  2396. Result:=Result+','
  2397. end;
  2398. dec(Indent,2);
  2399. end;
  2400. Result:=Result+')';
  2401. end
  2402. else if El.ClassType=TArrayValues then
  2403. begin
  2404. Result:=Result+'[';
  2405. l:=length(TArrayValues(El).Values);
  2406. if l>0 then
  2407. begin
  2408. inc(Indent,2);
  2409. for i:=0 to l-1 do
  2410. begin
  2411. LineBreak(0);
  2412. Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
  2413. if i<l-1 then
  2414. Result:=Result+','
  2415. end;
  2416. dec(Indent,2);
  2417. end;
  2418. Result:=Result+']';
  2419. end;
  2420. end
  2421. else if El is TPasProcedure then
  2422. begin
  2423. Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
  2424. end
  2425. else if El is TPasProcedureType then
  2426. begin
  2427. if TPasProcedureType(El).IsReferenceTo then
  2428. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2429. Result:=Result+'(';
  2430. l:=TPasProcedureType(El).Args.Count;
  2431. if l>0 then
  2432. begin
  2433. inc(Indent,2);
  2434. for i:=0 to l-1 do
  2435. begin
  2436. LineBreak(0);
  2437. Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
  2438. if i<l-1 then
  2439. Result:=Result+';'
  2440. end;
  2441. dec(Indent,2);
  2442. end;
  2443. Result:=Result+')';
  2444. if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
  2445. Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
  2446. if TPasProcedureType(El).IsOfObject then
  2447. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  2448. if TPasProcedureType(El).IsNested then
  2449. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  2450. if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
  2451. Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
  2452. end
  2453. else if El.ClassType=TPasResultElement then
  2454. Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
  2455. else if El.ClassType=TPasArgument then
  2456. begin
  2457. if AccessNames[TPasArgument(El).Access]<>'' then
  2458. Result:=Result+AccessNames[TPasArgument(El).Access];
  2459. if TPasArgument(El).ArgType=nil then
  2460. Result:=Result+'untyped'
  2461. else
  2462. Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
  2463. end
  2464. else if El.ClassType=TPasUnresolvedSymbolRef then
  2465. begin
  2466. if El.CustomData is TResElDataBuiltInProc then
  2467. Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
  2468. end;
  2469. end;
  2470. function GetResolverResultDbg(const T: TPasResolverResult): string;
  2471. var
  2472. HiTypeEl: TPasType;
  2473. begin
  2474. Result:='[bt='+ResBaseTypeNames[T.BaseType];
  2475. if T.SubType<>btNone then
  2476. Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
  2477. Result:=Result
  2478. +' Ident='+GetObjName(T.IdentEl);
  2479. HiTypeEl:=ResolveSimpleAliasType(T.HiTypeEl);
  2480. if HiTypeEl<>T.LoTypeEl then
  2481. Result:=Result+' LoType='+GetObjName(T.LoTypeEl)+' HiTypeEl='+GetObjName(HiTypeEl)
  2482. else
  2483. Result:=Result+' Type='+GetObjName(T.LoTypeEl);
  2484. Result:=Result
  2485. +' Expr='+GetObjName(T.ExprEl)
  2486. +' Flags='+ResolverResultFlagsToStr(T.Flags)
  2487. +']';
  2488. end;
  2489. function GetClassAncestorsDbg(El: TPasClassType): string;
  2490. function GetClassDesc(C: TPasClassType): string;
  2491. var
  2492. Module: TPasModule;
  2493. begin
  2494. if C.IsExternal then
  2495. Result:='class external '
  2496. else
  2497. Result:='class ';
  2498. Module:=C.GetModule;
  2499. if Module<>nil then
  2500. Result:=Result+Module.Name+'.';
  2501. Result:=Result+GetElementDbgPath(C);
  2502. end;
  2503. var
  2504. Scope, AncestorScope: TPasClassScope;
  2505. AncestorEl: TPasClassType;
  2506. begin
  2507. if El=nil then exit('nil');
  2508. Result:=GetClassDesc(El);
  2509. if El.CustomData is TPasClassScope then
  2510. begin
  2511. Scope:=TPasClassScope(El.CustomData);
  2512. AncestorScope:=Scope.AncestorScope;
  2513. while AncestorScope<>nil do
  2514. begin
  2515. Result:=Result+LineEnding+' ';
  2516. AncestorEl:=NoNil(AncestorScope.Element) as TPasClassType;
  2517. Result:=Result+GetClassDesc(AncestorEl);
  2518. AncestorScope:=AncestorScope.AncestorScope;
  2519. end;
  2520. end;
  2521. end;
  2522. function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
  2523. var
  2524. f: TPasResolverResultFlag;
  2525. s: string;
  2526. begin
  2527. Result:='';
  2528. for f in Flags do
  2529. begin
  2530. if Result<>'' then Result:=Result+',';
  2531. str(f,s);
  2532. Result:=Result+s;
  2533. end;
  2534. Result:='['+Result+']';
  2535. end;
  2536. function GetElementTypeName(El: TPasElement): string;
  2537. var
  2538. C: TClass;
  2539. begin
  2540. if El=nil then
  2541. exit('?');
  2542. C:=El.ClassType;
  2543. if C=TPrimitiveExpr then
  2544. Result:=ExprKindNames[TPrimitiveExpr(El).Kind]
  2545. else if C=TUnaryExpr then
  2546. Result:='unary '+OpcodeStrings[TUnaryExpr(El).OpCode]
  2547. else if C=TBinaryExpr then
  2548. Result:=ExprKindNames[TBinaryExpr(El).Kind]
  2549. else if C=TPasClassType then
  2550. Result:=ObjKindNames[TPasClassType(El).ObjKind]
  2551. else if C=TPasUnresolvedSymbolRef then
  2552. Result:=El.Name
  2553. else
  2554. begin
  2555. Result:=GetElementTypeName(TPasElementBaseClass(C));
  2556. if Result='' then
  2557. Result:=El.ElementTypeName;
  2558. end;
  2559. end;
  2560. function GetElementTypeName(C: TPasElementBaseClass): string;
  2561. begin
  2562. if C=nil then
  2563. exit('nil');
  2564. if C=TPrimitiveExpr then
  2565. Result:='primitive expression'
  2566. else if C=TUnaryExpr then
  2567. Result:='unary expression'
  2568. else if C=TBinaryExpr then
  2569. Result:='binary expression'
  2570. else if C=TBoolConstExpr then
  2571. Result:='boolean const'
  2572. else if C=TNilExpr then
  2573. Result:='nil'
  2574. else if C=TPasAliasType then
  2575. Result:='alias'
  2576. else if C=TPasPointerType then
  2577. Result:='pointer'
  2578. else if C=TPasTypeAliasType then
  2579. Result:='type alias'
  2580. else if C=TPasClassOfType then
  2581. Result:='class of'
  2582. else if C=TPasSpecializeType then
  2583. Result:='specialize'
  2584. else if C=TInlineSpecializeExpr then
  2585. Result:='inline-specialize'
  2586. else if C=TPasRangeType then
  2587. Result:='range'
  2588. else if C=TPasArrayType then
  2589. Result:='array'
  2590. else if C=TPasFileType then
  2591. Result:='file'
  2592. else if C=TPasEnumValue then
  2593. Result:='enum value'
  2594. else if C=TPasEnumType then
  2595. Result:='enum type'
  2596. else if C=TPasSetType then
  2597. Result:='set'
  2598. else if C=TPasRecordType then
  2599. Result:='record'
  2600. else if C=TPasClassType then
  2601. Result:='class'
  2602. else if C=TPasArgument then
  2603. Result:='parameter'
  2604. else if C=TPasProcedureType then
  2605. Result:='procedural type'
  2606. else if C=TPasResultElement then
  2607. Result:='function result'
  2608. else if C=TPasFunctionType then
  2609. Result:='functional type'
  2610. else if C=TPasStringType then
  2611. Result:='string[]'
  2612. else if C=TPasVariable then
  2613. Result:='var'
  2614. else if C=TPasExportSymbol then
  2615. Result:='export'
  2616. else if C=TPasConst then
  2617. Result:='const'
  2618. else if C=TPasProperty then
  2619. Result:='property'
  2620. else if C=TPasProcedure then
  2621. Result:='procedure'
  2622. else if C=TPasFunction then
  2623. Result:='function'
  2624. else if C=TPasOperator then
  2625. Result:='operator'
  2626. else if C=TPasClassOperator then
  2627. Result:='class operator'
  2628. else if C=TPasConstructor then
  2629. Result:='constructor'
  2630. else if C=TPasClassConstructor then
  2631. Result:='class constructor'
  2632. else if C=TPasDestructor then
  2633. Result:='destructor'
  2634. else if C=TPasClassDestructor then
  2635. Result:='class destructor'
  2636. else if C=TPasClassProcedure then
  2637. Result:='class procedure'
  2638. else if C=TPasClassFunction then
  2639. Result:='class function'
  2640. else if C=TPasAnonymousProcedure then
  2641. Result:='anonymous procedure'
  2642. else if C=TPasAnonymousFunction then
  2643. Result:='anonymous function'
  2644. else if C=TPasMethodResolution then
  2645. Result:='method resolution'
  2646. else if C=TInterfaceSection then
  2647. Result:='interfacesection'
  2648. else if C=TImplementationSection then
  2649. Result:='implementation'
  2650. else if C=TProgramSection then
  2651. Result:='program section'
  2652. else if C=TLibrarySection then
  2653. Result:='library section'
  2654. else
  2655. Result:=C.ClassName;
  2656. end;
  2657. function GetElementDbgPath(El: TPasElement): string;
  2658. begin
  2659. if El=nil then exit('nil');
  2660. Result:='';
  2661. while El<>nil do
  2662. begin
  2663. if Result<>'' then Result:='.'+Result;
  2664. if El.Name<>'' then
  2665. Result:=El.Name+Result
  2666. else
  2667. Result:=GetElementTypeName(El)+Result;
  2668. El:=El.Parent;
  2669. end;
  2670. end;
  2671. function ResolveSimpleAliasType(aType: TPasType): TPasType;
  2672. var
  2673. C: TClass;
  2674. begin
  2675. while aType<>nil do
  2676. begin
  2677. C:=aType.ClassType;
  2678. if (C=TPasAliasType) then
  2679. aType:=TPasAliasType(aType).DestType
  2680. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  2681. and (aType.CustomData is TResolvedReference) then
  2682. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  2683. else
  2684. exit(aType);
  2685. end;
  2686. Result:=nil;
  2687. end;
  2688. procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
  2689. BaseType: TResolverBaseType; IdentEl: TPasElement; LoTypeEl,
  2690. HiTypeEl: TPasType; Flags: TPasResolverResultFlags);
  2691. begin
  2692. if IdentEl is TPasExpr then
  2693. raise Exception.Create('20170729101017');
  2694. ResolvedType.BaseType:=BaseType;
  2695. ResolvedType.SubType:=btNone;
  2696. ResolvedType.IdentEl:=IdentEl;
  2697. ResolvedType.HiTypeEl:=HiTypeEl;
  2698. ResolvedType.LoTypeEl:=LoTypeEl;
  2699. ResolvedType.ExprEl:=nil;
  2700. ResolvedType.Flags:=Flags;
  2701. end;
  2702. procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
  2703. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType;
  2704. Flags: TPasResolverResultFlags);
  2705. begin
  2706. ResolvedType.BaseType:=BaseType;
  2707. ResolvedType.SubType:=btNone;
  2708. ResolvedType.IdentEl:=nil;
  2709. ResolvedType.HiTypeEl:=HiTypeEl;
  2710. ResolvedType.LoTypeEl:=LoTypeEl;
  2711. ResolvedType.ExprEl:=nil;
  2712. ResolvedType.Flags:=Flags;
  2713. end;
  2714. procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
  2715. BaseType: TResolverBaseType; LoTypeEl, HiTypeEl: TPasType; ExprEl: TPasExpr;
  2716. Flags: TPasResolverResultFlags);
  2717. begin
  2718. ResolvedType.BaseType:=BaseType;
  2719. ResolvedType.SubType:=btNone;
  2720. ResolvedType.IdentEl:=nil;
  2721. ResolvedType.HiTypeEl:=HiTypeEl;
  2722. ResolvedType.LoTypeEl:=LoTypeEl;
  2723. ResolvedType.ExprEl:=ExprEl;
  2724. ResolvedType.Flags:=Flags;
  2725. end;
  2726. function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
  2727. begin
  2728. Result:=true;
  2729. if Proc.IsExternal then exit(false);
  2730. if Proc.IsForward then exit;
  2731. if Proc.Parent.ClassType=TInterfaceSection then exit;
  2732. if Proc.Parent.ClassType=TPasClassType then
  2733. begin
  2734. // a method declaration
  2735. if not Proc.IsAbstract then exit;
  2736. end;
  2737. Result:=false;
  2738. end;
  2739. function ProcNeedsBody(Proc: TPasProcedure): boolean;
  2740. var
  2741. C: TClass;
  2742. begin
  2743. if Proc.IsForward or Proc.IsExternal then exit(false);
  2744. C:=Proc.Parent.ClassType;
  2745. if (C=TInterfaceSection) or C.InheritsFrom(TPasClassType) then exit(false);
  2746. Result:=true;
  2747. end;
  2748. function ProcHasGroupOverload(Proc: TPasProcedure): boolean;
  2749. var
  2750. Data: TObject;
  2751. begin
  2752. if Proc.IsOverload then
  2753. exit(true);
  2754. Data:=Proc.CustomData;
  2755. Result:=(Data is TPasProcedureScope)
  2756. and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
  2757. end;
  2758. procedure ClearHelperList(var List: TPRHelperEntryArray);
  2759. var
  2760. i: Integer;
  2761. begin
  2762. if length(List)=0 then exit;
  2763. for i:=0 to length(List)-1 do
  2764. TPRHelperEntry(List[i]).Free;
  2765. List:=nil;
  2766. end;
  2767. function ChompDottedIdentifier(const Identifier: string): string;
  2768. var
  2769. p, Lvl: Integer;
  2770. begin
  2771. Result:=Identifier;
  2772. p:=length(Identifier);
  2773. Lvl:=0;
  2774. while (p>0) do
  2775. begin
  2776. case Identifier[p] of
  2777. '.': if Lvl=0 then break;
  2778. '>': inc(Lvl);
  2779. '<': dec(Lvl);
  2780. end;
  2781. dec(p);
  2782. end;
  2783. Result:=LeftStr(Identifier,p-1);
  2784. end;
  2785. function FirstDottedIdentifier(const Identifier: string): string;
  2786. var
  2787. p, l: SizeInt;
  2788. begin
  2789. p:=1;
  2790. l:=length(Identifier);
  2791. repeat
  2792. if p>l then
  2793. exit(Identifier)
  2794. else if Identifier[p] in ['<','.'] then
  2795. exit(LeftStr(Identifier,p-1))
  2796. else
  2797. inc(p);
  2798. until false;
  2799. end;
  2800. function LastDottedIdentifier(const Identifier: string): string;
  2801. var
  2802. p, Lvl, EndP: Integer;
  2803. begin
  2804. p:=length(Identifier);
  2805. EndP:=p;
  2806. Lvl:=0;
  2807. while (p>0) do
  2808. begin
  2809. case Identifier[p] of
  2810. '.': if Lvl=0 then break;
  2811. '>': inc(Lvl);
  2812. '<':
  2813. begin
  2814. dec(Lvl);
  2815. EndP:=p-1;
  2816. end;
  2817. end;
  2818. dec(p);
  2819. end;
  2820. Result:=copy(Identifier,p+1,EndP-p);
  2821. end;
  2822. function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
  2823. var
  2824. l: Integer;
  2825. begin
  2826. l:=length(Prefix);
  2827. if (l>length(Identifier))
  2828. or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
  2829. exit(false);
  2830. Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
  2831. end;
  2832. function GetFirstDotPos(const Identifier: string): integer;
  2833. var
  2834. l: SizeInt;
  2835. Lvl: Integer;
  2836. begin
  2837. Result:=1;
  2838. l:=length(Identifier);
  2839. Lvl:=0;
  2840. repeat
  2841. if Result>l then
  2842. exit(-1);
  2843. case Identifier[Result] of
  2844. '.': if Lvl=0 then exit;
  2845. '<': inc(Lvl);
  2846. '>': dec(Lvl);
  2847. end;
  2848. inc(Result);
  2849. until false;
  2850. end;
  2851. function GetLastDotPos(const Identifier: string): integer;
  2852. var
  2853. Lvl: Integer;
  2854. begin
  2855. Result:=length(Identifier);
  2856. Lvl:=0;
  2857. while (Result>0) do
  2858. begin
  2859. case Identifier[Result] of
  2860. '.': if Lvl=0 then exit;
  2861. '>': inc(Lvl);
  2862. '<': dec(Lvl);
  2863. end;
  2864. dec(Result);
  2865. end;
  2866. end;
  2867. function DotExprToName(Expr: TPasExpr): string;
  2868. var
  2869. C: TClass;
  2870. Prim: TPrimitiveExpr;
  2871. Bin: TBinaryExpr;
  2872. s: String;
  2873. begin
  2874. Result:='';
  2875. if Expr=nil then exit;
  2876. C:=Expr.ClassType;
  2877. if C=TPrimitiveExpr then
  2878. begin
  2879. Prim:=TPrimitiveExpr(Expr);
  2880. case Prim.Kind of
  2881. pekIdent,pekString: Result:=Prim.Value;
  2882. pekSelf: Result:='Self';
  2883. else
  2884. EPasResolve.Create('[20180309155400] DotExprToName '+GetObjName(Prim)+' '+ExprKindNames[Prim.Kind]);
  2885. end;
  2886. end
  2887. else if C=TBinaryExpr then
  2888. begin
  2889. Bin:=TBinaryExpr(Expr);
  2890. if Bin.OpCode=eopSubIdent then
  2891. begin
  2892. Result:=DotExprToName(Bin.left);
  2893. if Result='' then exit;
  2894. s:=DotExprToName(Bin.right);
  2895. if s='' then exit('');
  2896. Result:=Result+'.'+s;
  2897. end;
  2898. end;
  2899. end;
  2900. function NoNil(o: TObject): TObject;
  2901. begin
  2902. if o=nil then
  2903. raise Exception.Create('');
  2904. Result:=o;
  2905. end;
  2906. {$IF FPC_FULLVERSION<30101}
  2907. function IsValidIdent(const Ident: string; AllowDots: Boolean;
  2908. StrictDots: Boolean): Boolean;
  2909. const
  2910. Alpha = ['A'..'Z', 'a'..'z', '_'];
  2911. AlphaNum = Alpha + ['0'..'9'];
  2912. Dot = '.';
  2913. var
  2914. First: Boolean;
  2915. I, Len: Integer;
  2916. begin
  2917. Len := Length(Ident);
  2918. if Len < 1 then
  2919. Exit(False);
  2920. First := True;
  2921. for I := 1 to Len do
  2922. begin
  2923. if First then
  2924. begin
  2925. Result := Ident[I] in Alpha;
  2926. First := False;
  2927. end
  2928. else if AllowDots and (Ident[I] = Dot) then
  2929. begin
  2930. if StrictDots then
  2931. begin
  2932. Result := I < Len;
  2933. First := True;
  2934. end;
  2935. end
  2936. else
  2937. Result := Ident[I] in AlphaNum;
  2938. if not Result then
  2939. Break;
  2940. end;
  2941. end;
  2942. {$ENDIF}
  2943. function dbgs(const Flags: TPasResolverComputeFlags): string;
  2944. var
  2945. s: string;
  2946. f: TPasResolverComputeFlag;
  2947. begin
  2948. Result:='';
  2949. for f in Flags do
  2950. if f in Flags then
  2951. begin
  2952. if Result<>'' then Result:=Result+',';
  2953. str(f,s);
  2954. Result:=Result+s;
  2955. end;
  2956. Result:='['+Result+']';
  2957. end;
  2958. function dbgs(const a: TResolvedRefAccess): string;
  2959. begin
  2960. str(a,Result);
  2961. end;
  2962. function dbgs(const Flags: TResolvedReferenceFlags): string;
  2963. var
  2964. s: string;
  2965. f: TResolvedReferenceFlag;
  2966. begin
  2967. Result:='';
  2968. for f in Flags do
  2969. if f in Flags then
  2970. begin
  2971. if Result<>'' then Result:=Result+',';
  2972. str(f,s);
  2973. Result:=Result+s;
  2974. end;
  2975. Result:='['+Result+']';
  2976. end;
  2977. function dbgs(const a: TPSRefAccess): string;
  2978. begin
  2979. str(a,Result);
  2980. end;
  2981. { TPasResolverHub }
  2982. constructor TPasResolverHub.Create(TheOwner: TObject);
  2983. begin
  2984. FOwner:=TheOwner;
  2985. end;
  2986. procedure TPasResolverHub.Reset;
  2987. begin
  2988. FinishedInterfaceCount:=0;
  2989. end;
  2990. { TPRSpecializedItem }
  2991. destructor TPRSpecializedItem.Destroy;
  2992. var
  2993. i: Integer;
  2994. begin
  2995. for i:=0 to length(SpecializedConstraints)-1 do
  2996. SpecializedConstraints[i].Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  2997. SetLength(SpecializedConstraints,0);
  2998. inherited Destroy;
  2999. end;
  3000. { TPRSpecializedTypeItem }
  3001. procedure TPRSpecializedTypeItem.SetSpecializedType(AValue: TPasGenericType);
  3002. begin
  3003. if FSpecializedType=AValue then Exit;
  3004. if FSpecializedType<>nil then
  3005. FSpecializedType.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  3006. FSpecializedEl:=AValue;
  3007. FSpecializedType:=AValue;
  3008. if FSpecializedType<>nil then
  3009. FSpecializedType.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedTypeItem.SpecializedType'){$ENDIF};
  3010. end;
  3011. destructor TPRSpecializedTypeItem.Destroy;
  3012. var
  3013. i: Integer;
  3014. begin
  3015. if ImplProcs<>nil then
  3016. begin
  3017. for i:=0 to ImplProcs.Count-1 do
  3018. TPasElement(ImplProcs[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  3019. ImplProcs.Free;
  3020. ImplProcs:=nil;
  3021. end;
  3022. HeaderScope.Free;
  3023. HeaderScope:=nil;
  3024. SpecializedType:=nil;
  3025. inherited Destroy;
  3026. end;
  3027. { TPRSpecializedProcItem }
  3028. procedure TPRSpecializedProcItem.SetSpecializedProc(const AValue: TPasProcedure
  3029. );
  3030. begin
  3031. if FSpecializedProc=AValue then Exit;
  3032. if FSpecializedProc<>nil then
  3033. FSpecializedProc.Release{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  3034. FSpecializedEl:=AValue;
  3035. FSpecializedProc:=AValue;
  3036. if FSpecializedProc<>nil then
  3037. FSpecializedProc.AddRef{$IFDEF CheckPasTreeRefCount}('TPRSpecializedProcItem.SpecializedProc'){$ENDIF};
  3038. end;
  3039. destructor TPRSpecializedProcItem.Destroy;
  3040. begin
  3041. if ImplProc<>nil then
  3042. begin
  3043. ImplProc.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  3044. ImplProc:=nil;
  3045. end;
  3046. SpecializedProc:=nil;
  3047. inherited Destroy;
  3048. end;
  3049. { TPasGenericScope }
  3050. destructor TPasGenericScope.Destroy;
  3051. begin
  3052. if SpecializedItems<>nil then
  3053. begin
  3054. SpecializedItems.Free;
  3055. SpecializedItems:=nil;
  3056. end;
  3057. inherited Destroy;
  3058. end;
  3059. { TPasInheritedScope }
  3060. function TPasInheritedScope.FindIdentifier(const Identifier: String
  3061. ): TPasIdentifier;
  3062. var
  3063. aClassScope: TPasClassScope;
  3064. begin
  3065. Result:=inherited FindIdentifier(Identifier);
  3066. if Result<>nil then exit;
  3067. aClassScope:=AncestorScope;
  3068. while aClassScope<>nil do
  3069. begin
  3070. Result:=aClassScope.FindIdentifier(Identifier);
  3071. if Result<>nil then exit;
  3072. aClassScope:=aClassScope.AncestorScope;
  3073. end;
  3074. end;
  3075. procedure TPasInheritedScope.IterateElements(const aName: string;
  3076. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3077. Data: Pointer; var Abort: boolean);
  3078. var
  3079. aClassScope: TPasClassScope;
  3080. begin
  3081. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3082. if Abort then exit;
  3083. aClassScope:=AncestorScope;
  3084. while aClassScope<>nil do
  3085. begin
  3086. aClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3087. if Abort then exit;
  3088. aClassScope:=aClassScope.AncestorScope;
  3089. end;
  3090. end;
  3091. procedure TPasInheritedScope.WriteIdentifiers(Prefix: string);
  3092. var
  3093. aClassScope: TPasClassScope;
  3094. begin
  3095. inherited WriteIdentifiers(Prefix);
  3096. aClassScope:=AncestorScope;
  3097. while aClassScope<>nil do
  3098. begin
  3099. aClassScope.WriteIdentifiers(Prefix);
  3100. aClassScope:=aClassScope.AncestorScope;
  3101. end;
  3102. end;
  3103. { TPasDotEnumTypeScope }
  3104. function TPasDotEnumTypeScope.FindIdentifier(const Identifier: String
  3105. ): TPasIdentifier;
  3106. begin
  3107. Result:=EnumScope.FindLocalIdentifier(Identifier);
  3108. if Result<>nil then exit;
  3109. Result:=inherited FindIdentifier(Identifier);
  3110. end;
  3111. procedure TPasDotEnumTypeScope.IterateElements(const aName: string;
  3112. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3113. Data: Pointer; var Abort: boolean);
  3114. begin
  3115. EnumScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3116. if Abort then exit;
  3117. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3118. end;
  3119. procedure TPasDotEnumTypeScope.WriteIdentifiers(Prefix: string);
  3120. begin
  3121. EnumScope.WriteIdentifiers(Prefix);
  3122. inherited WriteIdentifiers(Prefix);
  3123. end;
  3124. { TPasGroupScope }
  3125. procedure TPasGroupScope.Add(Scope: TPasIdentifierScope);
  3126. var
  3127. i: Integer;
  3128. begin
  3129. for i:=0 to Count-1 do
  3130. if Scopes[i]=Scope then exit; // already added
  3131. if Scope.FreeOnPop then
  3132. raise Exception.Create('TPasGroupScope.Add '+GetObjName(Scope)+' '+GetObjName(Scope.Element));
  3133. if Count=length(Scopes) then
  3134. SetLength(Scopes,Count*2+4);
  3135. Scopes[Count]:=Scope;
  3136. inc(Count);
  3137. end;
  3138. destructor TPasGroupScope.Destroy;
  3139. begin
  3140. Scopes:=nil;
  3141. Count:=0;
  3142. inherited Destroy;
  3143. end;
  3144. function TPasGroupScope.GetFirstNonHelperScope: TPasIdentifierScope;
  3145. var
  3146. i: Integer;
  3147. Scope: TPasIdentifierScope;
  3148. begin
  3149. for i:=0 to Count-1 do
  3150. begin
  3151. Scope:=Scopes[i];
  3152. if (Scope.ClassType<>TPasClassScope)
  3153. or (TPasClassType(Scope.Element).HelperForType=nil) then
  3154. exit(Scope);
  3155. end;
  3156. Result:=nil;
  3157. end;
  3158. class function TPasGroupScope.IsStoredInElement: boolean;
  3159. begin
  3160. Result:=false;
  3161. end;
  3162. function TPasGroupScope.FindAncestorIdentifier(const Identifier: String
  3163. ): TPasIdentifier;
  3164. var
  3165. i: Integer;
  3166. begin
  3167. for i:=1 to Count-1 do
  3168. begin
  3169. Result:=Scopes[i].FindIdentifier(Identifier);
  3170. if Result<>nil then exit;
  3171. end;
  3172. Result:=nil;
  3173. end;
  3174. function TPasGroupScope.FindAncestorElement(const Identifier: String
  3175. ): TPasElement;
  3176. var
  3177. Item: TPasIdentifier;
  3178. begin
  3179. Item:=FindAncestorIdentifier(Identifier);
  3180. if Item<>nil then
  3181. Result:=Item.Element
  3182. else
  3183. Result:=nil;
  3184. end;
  3185. function TPasGroupScope.FindIdentifier(const Identifier: String
  3186. ): TPasIdentifier;
  3187. var
  3188. i: Integer;
  3189. begin
  3190. for i:=0 to Count-1 do
  3191. begin
  3192. Result:=Scopes[i].FindIdentifier(Identifier);
  3193. if Result<>nil then exit;
  3194. end;
  3195. Result:=nil;
  3196. end;
  3197. procedure TPasGroupScope.IterateElements(const aName: string;
  3198. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3199. Data: Pointer; var Abort: boolean);
  3200. var
  3201. i: Integer;
  3202. begin
  3203. for i:=0 to Count-1 do
  3204. begin
  3205. Scopes[i].IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
  3206. if Abort then exit;
  3207. end;
  3208. end;
  3209. procedure TPasGroupScope.WriteIdentifiers(Prefix: string);
  3210. var
  3211. i: Integer;
  3212. begin
  3213. for i:=0 to Count-1 do
  3214. Scopes[i].WriteIdentifiers(Prefix+'Group['+IntToStr(i)+'/'+IntToStr(Count)+']');
  3215. end;
  3216. {$ifdef pas2js}
  3217. { TPasResHashList }
  3218. constructor TPasResHashList.Create;
  3219. begin
  3220. FItems:=TJSObject.new;
  3221. end;
  3222. procedure TPasResHashList.Add(const aName: string; Item: Pointer);
  3223. begin
  3224. FItems['%'+aName]:=Item;
  3225. end;
  3226. function TPasResHashList.Find(const aName: string): Pointer;
  3227. begin
  3228. if FItems.hasOwnProperty('%'+aName) then
  3229. Result:=Pointer(FItems['%'+aName])
  3230. else
  3231. Result:=nil;
  3232. end;
  3233. procedure TPasResHashList.ForEachCall(const Proc: TPasResIterate; Arg: Pointer);
  3234. var
  3235. key: string;
  3236. begin
  3237. for key in FItems do
  3238. if FItems.hasOwnProperty(key) then
  3239. Proc(Pointer(FItems[key]),Arg);
  3240. end;
  3241. procedure TPasResHashList.Clear;
  3242. begin
  3243. FItems:=TJSObject.new;
  3244. end;
  3245. procedure TPasResHashList.Remove(const aName: string);
  3246. begin
  3247. if FItems.hasOwnProperty('%'+aName) then
  3248. JSDelete(FItems,'%'+aName);
  3249. end;
  3250. {$endif}
  3251. { TResElDataBuiltInProc }
  3252. destructor TResElDataBuiltInProc.Destroy;
  3253. begin
  3254. ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TResElDataBuiltInProc.Proc'{$ENDIF});
  3255. inherited Destroy;
  3256. end;
  3257. { TPasClassIntfMap }
  3258. destructor TPasClassIntfMap.Destroy;
  3259. begin
  3260. Element:=nil;
  3261. Intf:=nil;
  3262. FreeAndNil(Procs);
  3263. FreeAndNil(AncestorMap);
  3264. inherited Destroy;
  3265. end;
  3266. { TPasInitialFinalizationScope }
  3267. function TPasInitialFinalizationScope.AddReference(El: TPasElement;
  3268. Access: TPSRefAccess): TPasScopeReference;
  3269. begin
  3270. if References=nil then
  3271. References:=TPasScopeReferences.Create(Self);
  3272. Result:=References.Add(El,Access);
  3273. end;
  3274. destructor TPasInitialFinalizationScope.Destroy;
  3275. begin
  3276. FreeAndNil(References);
  3277. inherited Destroy;
  3278. end;
  3279. { TPasScopeReference }
  3280. procedure TPasScopeReference.SetElement(const AValue: TPasElement);
  3281. begin
  3282. if FElement=AValue then Exit;
  3283. if FElement<>nil then
  3284. FElement.Release{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3285. FElement:=AValue;
  3286. if FElement<>nil then
  3287. FElement.AddRef{$IFDEF CheckPasTreeRefCount}('TPasScopeReference.SetElement'){$ENDIF};
  3288. end;
  3289. destructor TPasScopeReference.Destroy;
  3290. begin
  3291. {$IFDEF VerbosePasResolverMem}
  3292. writeln('TPasProcScopeReference.Destroy START ',ClassName,' "',GetObjName(Element),'"');
  3293. {$ENDIF}
  3294. Element:=nil;
  3295. inherited Destroy;
  3296. {$IFDEF VerbosePasResolverMem}
  3297. writeln('TPasProcScopeReference.Destroy END ',ClassName);
  3298. {$ENDIF}
  3299. end;
  3300. { TPasScopeReferences }
  3301. procedure TPasScopeReferences.OnClearItem(Item, Dummy: pointer);
  3302. var
  3303. Ref: TPasScopeReference absolute Item;
  3304. Ref2: TPasScopeReference;
  3305. begin
  3306. if Dummy=nil then ;
  3307. //writeln('TPasProcedureScope.OnClearReferenceItem ',GetObjName(Ref.Element));
  3308. while Ref<>nil do
  3309. begin
  3310. Ref2:=Ref;
  3311. Ref:=Ref.NextSameName;
  3312. Ref2.Free;
  3313. end;
  3314. end;
  3315. procedure TPasScopeReferences.OnCollectItem(Item, aList: pointer);
  3316. var
  3317. Ref: TPasScopeReference absolute Item;
  3318. List: TFPList absolute aList;
  3319. begin
  3320. while Ref<>nil do
  3321. begin
  3322. List.Add(Ref);
  3323. Ref:=Ref.NextSameName;
  3324. end;
  3325. end;
  3326. constructor TPasScopeReferences.Create(aScope: TPasScope);
  3327. begin
  3328. References:=TPasResHashList.Create;
  3329. FScope:=aScope;
  3330. end;
  3331. destructor TPasScopeReferences.Destroy;
  3332. begin
  3333. Clear;
  3334. {$ifdef pas2js}
  3335. References:=nil;
  3336. {$else}
  3337. FreeAndNil(References);
  3338. {$endif}
  3339. inherited Destroy;
  3340. end;
  3341. procedure TPasScopeReferences.Clear;
  3342. begin
  3343. if References=nil then exit;
  3344. References.ForEachCall(@OnClearItem,nil);
  3345. References.Clear;
  3346. end;
  3347. function TPasScopeReferences.Add(El: TPasElement; Access: TPSRefAccess
  3348. ): TPasScopeReference;
  3349. var
  3350. LoName: String;
  3351. OldItem, Item, LastItem: TPasScopeReference;
  3352. begin
  3353. LoName:=lowercase(El.Name);
  3354. OldItem:=TPasScopeReference(References.Find(LoName));
  3355. Item:=OldItem;
  3356. LastItem:=nil;
  3357. while Item<>nil do
  3358. begin
  3359. if Item.Element=El then
  3360. begin
  3361. // already marked as used -> combine access
  3362. case Access of
  3363. psraNone: ;
  3364. psraRead:
  3365. case Item.Access of
  3366. psraNone: Item.Access:=Access;
  3367. //psraRead: ;
  3368. psraWrite: Item.Access:=psraWriteRead;
  3369. //psraReadWrite: ;
  3370. //psraWriteRead: ;
  3371. //psraTypeInfo: ;
  3372. end;
  3373. psraWrite:
  3374. case Item.Access of
  3375. psraNone: Item.Access:=Access;
  3376. psraRead: Item.Access:=psraReadWrite;
  3377. //psraWrite: ;
  3378. //psraReadWrite: ;
  3379. //psraWriteRead: ;
  3380. //psraTypeInfo: ;
  3381. end;
  3382. psraReadWrite:
  3383. case Item.Access of
  3384. psraNone: Item.Access:=Access;
  3385. psraRead: Item.Access:=psraReadWrite;
  3386. psraWrite: Item.Access:=psraWriteRead;
  3387. //psraReadWrite: ;
  3388. //psraWriteRead: ;
  3389. //psraTypeInfo: ;
  3390. end;
  3391. psraWriteRead:
  3392. case Item.Access of
  3393. psraNone: Item.Access:=Access;
  3394. psraRead: Item.Access:=psraReadWrite;
  3395. psraWrite: Item.Access:=psraWriteRead;
  3396. //psraReadWrite: ;
  3397. //psraWriteRead: ;
  3398. //psraTypeInfo: ;
  3399. end;
  3400. psraTypeInfo: Item.Access:=psraTypeInfo;
  3401. else
  3402. raise EPasResolve.Create(GetObjName(El)+' unknown Access');
  3403. end;
  3404. exit(Item);
  3405. end;
  3406. LastItem:=Item;
  3407. Item:=Item.NextSameName;
  3408. end;
  3409. // new reference
  3410. Item:=TPasScopeReference.Create;
  3411. Item.Element:=El;
  3412. Item.Access:=Access;
  3413. if LastItem=nil then
  3414. begin
  3415. References.Add(LoName,Item);
  3416. {$IFDEF VerbosePCUFiler}
  3417. if TPasScopeReference(References.Find(LoName))<>Item then
  3418. raise EPasResolve.Create('20180219230028');
  3419. {$ENDIF}
  3420. end
  3421. else
  3422. LastItem.NextSameName:=Item;
  3423. Result:=Item;
  3424. end;
  3425. function TPasScopeReferences.Find(const aName: string): TPasScopeReference;
  3426. var
  3427. LoName: String;
  3428. begin
  3429. if References=nil then exit(nil);
  3430. LoName:=lowercase(aName);
  3431. Result:=TPasScopeReference(References.Find(LoName));
  3432. end;
  3433. function TPasScopeReferences.GetList: TFPList;
  3434. begin
  3435. Result:=TFPList.Create;
  3436. if References=nil then exit;
  3437. References.ForEachCall(@OnCollectItem,Result);
  3438. end;
  3439. { TPasPropertyScope }
  3440. destructor TPasPropertyScope.Destroy;
  3441. begin
  3442. {$IFDEF VerbosePasResolverMem}
  3443. writeln('TPasPropertyScope.Destroy START ',ClassName);
  3444. {$ENDIF}
  3445. AncestorProp:=nil;
  3446. inherited Destroy;
  3447. {$IFDEF VerbosePasResolverMem}
  3448. writeln('TPasPropertyScope.Destroy END',ClassName);
  3449. {$ENDIF}
  3450. end;
  3451. { TPasEnumTypeScope }
  3452. destructor TPasEnumTypeScope.Destroy;
  3453. begin
  3454. {$IFDEF VerbosePasResolverMem}
  3455. writeln('TPasEnumTypeScope.Destroy START ',ClassName);
  3456. {$ENDIF}
  3457. ReleaseAndNil(TPasElement(CanonicalSet){$IFDEF CheckPasTreeRefCount},'TPasEnumTypeScope.CanonicalSet'{$ENDIF});
  3458. inherited Destroy;
  3459. {$IFDEF VerbosePasResolverMem}
  3460. writeln('TPasEnumTypeScope.Destroy END ',ClassName);
  3461. {$ENDIF}
  3462. end;
  3463. { TPasDotBaseScope }
  3464. function TPasDotBaseScope.FindIdentifier(const Identifier: String
  3465. ): TPasIdentifier;
  3466. begin
  3467. Result:=GroupScope.FindIdentifier(Identifier);
  3468. end;
  3469. procedure TPasDotBaseScope.IterateElements(const aName: string;
  3470. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3471. Data: Pointer; var Abort: boolean);
  3472. begin
  3473. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3474. end;
  3475. procedure TPasDotBaseScope.WriteIdentifiers(Prefix: string);
  3476. begin
  3477. GroupScope.WriteIdentifiers(Prefix);
  3478. end;
  3479. destructor TPasDotBaseScope.Destroy;
  3480. begin
  3481. FreeAndNil(GroupScope);
  3482. inherited Destroy;
  3483. end;
  3484. { TPasWithExprScope }
  3485. class function TPasWithExprScope.IsStoredInElement: boolean;
  3486. begin
  3487. Result:=false;
  3488. end;
  3489. class function TPasWithExprScope.FreeOnPop: boolean;
  3490. begin
  3491. Result:=false;
  3492. end;
  3493. procedure TPasWithExprScope.IterateElements(const aName: string;
  3494. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3495. Data: Pointer; var Abort: boolean);
  3496. begin
  3497. Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3498. end;
  3499. procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
  3500. begin
  3501. {AllowWriteln}
  3502. writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
  3503. Scope.WriteIdentifiers(Prefix);
  3504. {AllowWriteln-}
  3505. end;
  3506. destructor TPasWithExprScope.Destroy;
  3507. begin
  3508. FreeAndNil(Scope);
  3509. inherited Destroy;
  3510. end;
  3511. { TPasWithScope }
  3512. constructor TPasWithScope.Create;
  3513. begin
  3514. inherited Create;
  3515. ExpressionScopes:=TObjectList.Create(true);
  3516. end;
  3517. destructor TPasWithScope.Destroy;
  3518. begin
  3519. {$IFDEF VerbosePasResolverMem}
  3520. writeln('TPasWithScope.Destroy START ',ClassName);
  3521. {$ENDIF}
  3522. FreeAndNil(ExpressionScopes);
  3523. inherited Destroy;
  3524. {$IFDEF VerbosePasResolverMem}
  3525. writeln('TPasWithScope.Destroy END ',ClassName);
  3526. {$ENDIF}
  3527. end;
  3528. { TPasProcedureScope }
  3529. function TPasProcedureScope.FindIdentifier(const Identifier: String
  3530. ): TPasIdentifier;
  3531. begin
  3532. Result:=inherited FindIdentifier(Identifier);
  3533. if (Result<>nil) or (GroupScope=nil) then exit;
  3534. Result:=GroupScope.FindIdentifier(Identifier);
  3535. end;
  3536. procedure TPasProcedureScope.IterateElements(const aName: string;
  3537. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3538. Data: Pointer; var Abort: boolean);
  3539. begin
  3540. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3541. if Abort then exit;
  3542. if GroupScope=nil then exit;
  3543. GroupScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3544. end;
  3545. function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
  3546. var
  3547. Proc: TPasProcedure;
  3548. El: TPasElement;
  3549. begin
  3550. Result:=Self;
  3551. repeat
  3552. if Result.ClassRecScope<>nil then exit;
  3553. Proc:=TPasProcedure(Result.Element);
  3554. El:=Proc.Parent;
  3555. repeat
  3556. if El=nil then exit(nil);
  3557. if El is TProcedureBody then break;
  3558. El:=El.Parent;
  3559. until false;
  3560. Proc:=El.Parent as TPasProcedure;
  3561. Result:=TPasProcedureScope(Proc.CustomData);
  3562. until false;
  3563. end;
  3564. procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
  3565. begin
  3566. inherited WriteIdentifiers(Prefix);
  3567. if GroupScope<>nil then
  3568. GroupScope.WriteIdentifiers(Prefix+'GS ');
  3569. end;
  3570. destructor TPasProcedureScope.Destroy;
  3571. begin
  3572. {$IFDEF VerbosePasResolverMem}
  3573. writeln('TPasProcedureScope.Destroy START ',ClassName);
  3574. {$ENDIF}
  3575. FreeAndNil(References);
  3576. FreeAndNil(GroupScope);
  3577. NestedMembersScope:=nil; // NestedMembersScope is auto freed
  3578. inherited Destroy;
  3579. ReleaseAndNil(TPasElement(SelfArg){$IFDEF CheckPasTreeRefCount},'TPasProcedureScope.SelfArg'{$ENDIF});
  3580. {$IFDEF VerbosePasResolverMem}
  3581. writeln('TPasProcedureScope.Destroy END ',ClassName);
  3582. {$ENDIF}
  3583. end;
  3584. function TPasProcedureScope.AddReference(El: TPasElement; Access: TPSRefAccess
  3585. ): TPasScopeReference;
  3586. begin
  3587. if References=nil then
  3588. References:=TPasScopeReferences.Create(Self);
  3589. Result:=References.Add(El,Access);
  3590. end;
  3591. function TPasProcedureScope.GetReferences: TFPList;
  3592. begin
  3593. if References=nil then
  3594. Result:=TFPList.Create
  3595. else
  3596. Result:=References.GetList;
  3597. end;
  3598. { TPasClassScope }
  3599. destructor TPasClassScope.Destroy;
  3600. var
  3601. i: Integer;
  3602. o: TObject;
  3603. begin
  3604. if Interfaces<>nil then
  3605. begin
  3606. for i:=0 to Interfaces.Count-1 do
  3607. begin
  3608. o:=TObject(Interfaces[i]);
  3609. if o=nil then
  3610. else if o is TPasProperty then
  3611. else if o is TPasClassIntfMap then
  3612. o.Free
  3613. else
  3614. raise Exception.Create('[20180322132757] '+GetElementDbgPath(Element)+' i='+IntToStr(i)+' '+GetObjName(o));
  3615. end;
  3616. FreeAndNil(Interfaces);
  3617. end;
  3618. if CanonicalClassOf<>nil then
  3619. begin
  3620. CanonicalClassOf.Parent:=nil;
  3621. ReleaseAndNil(TPasElement(CanonicalClassOf){$IFDEF CheckPasTreeRefCount},'TPasClassScope.CanonicalClassOf'{$ENDIF});
  3622. end;
  3623. inherited Destroy;
  3624. end;
  3625. { TPasIdentifier }
  3626. procedure TPasIdentifier.SetElement(AValue: TPasElement);
  3627. begin
  3628. if FElement=AValue then Exit;
  3629. if Element<>nil then
  3630. Element.Release{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3631. FElement:=AValue;
  3632. if Element<>nil then
  3633. Element.AddRef{$IFDEF CheckPasTreeRefCount}('TPasIdentifier.SetElement'){$ENDIF};
  3634. end;
  3635. destructor TPasIdentifier.Destroy;
  3636. begin
  3637. {$IFDEF VerbosePasResolverMem}
  3638. writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
  3639. {$ENDIF}
  3640. Element:=nil;
  3641. inherited Destroy;
  3642. {$IFDEF VerbosePasResolverMem}
  3643. writeln('TPasIdentifier.Destroy END ',ClassName);
  3644. {$ENDIF}
  3645. end;
  3646. { EPasResolve }
  3647. procedure EPasResolve.SetPasElement(AValue: TPasElement);
  3648. begin
  3649. if FPasElement=AValue then Exit;
  3650. if PasElement<>nil then
  3651. PasElement.Release{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3652. FPasElement:=AValue;
  3653. if PasElement<>nil then
  3654. PasElement.AddRef{$IFDEF CheckPasTreeRefCount}('EPasResolve.SetPasElement'){$ENDIF};
  3655. end;
  3656. destructor EPasResolve.Destroy;
  3657. begin
  3658. {$IFDEF VerbosePasResolverMem}
  3659. writeln('EPasResolve.Destroy START ',ClassName);
  3660. {$ENDIF}
  3661. PasElement:=nil;
  3662. inherited Destroy;
  3663. {$IFDEF VerbosePasResolverMem}
  3664. writeln('EPasResolve.Destroy END ',ClassName);
  3665. {$ENDIF}
  3666. end;
  3667. { TResolvedReference }
  3668. procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
  3669. begin
  3670. if FDeclaration=AValue then Exit;
  3671. if Declaration<>nil then
  3672. Declaration.Release{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3673. FDeclaration:=AValue;
  3674. if Declaration<>nil then
  3675. Declaration.AddRef{$IFDEF CheckPasTreeRefCount}('TResolvedReference.SetDeclaration'){$ENDIF};
  3676. end;
  3677. destructor TResolvedReference.Destroy;
  3678. begin
  3679. {$IFDEF VerbosePasResolverMem}
  3680. writeln('TResolvedReference.Destroy START ',ClassName);
  3681. {$ENDIF}
  3682. Declaration:=nil;
  3683. FreeAndNil(Context);
  3684. inherited Destroy;
  3685. {$IFDEF VerbosePasResolverMem}
  3686. writeln('TResolvedReference.Destroy END ',ClassName);
  3687. {$ENDIF}
  3688. end;
  3689. { TPasSubExprScope }
  3690. class function TPasSubExprScope.IsStoredInElement: boolean;
  3691. begin
  3692. Result:=false;
  3693. end;
  3694. { TPasModuleDotScope }
  3695. procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
  3696. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3697. var
  3698. FilterData: PPasIterateFilterData absolute Data;
  3699. begin
  3700. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3701. exit; // skip used units
  3702. // call the original iterator
  3703. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3704. end;
  3705. procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
  3706. begin
  3707. if FModule=AValue then Exit;
  3708. if Module<>nil then
  3709. Module.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3710. FModule:=AValue;
  3711. if Module<>nil then
  3712. Module.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleDotScope.SetModule'){$ENDIF};
  3713. end;
  3714. destructor TPasModuleDotScope.Destroy;
  3715. begin
  3716. {$IFDEF VerbosePasResolverMem}
  3717. writeln('TPasSubModuleScope.Destroy START ',ClassName);
  3718. {$ENDIF}
  3719. Module:=nil;
  3720. inherited Destroy;
  3721. {$IFDEF VerbosePasResolverMem}
  3722. writeln('TPasSubModuleScope.Destroy END ',ClassName);
  3723. {$ENDIF}
  3724. end;
  3725. function TPasModuleDotScope.FindIdentifier(const Identifier: String
  3726. ): TPasIdentifier;
  3727. function Find(Scope: TPasIdentifierScope): boolean;
  3728. var
  3729. Found: TPasIdentifier;
  3730. C: TClass;
  3731. begin
  3732. if Scope=nil then exit(false);
  3733. Found:=Scope.FindLocalIdentifier(Identifier);
  3734. FindIdentifier:=Found;
  3735. if Found=nil then exit(false);
  3736. C:=Found.Element.ClassType;
  3737. Result:=(C<>TPasModule) and (C<>TPasUsesUnit);
  3738. end;
  3739. begin
  3740. Result:=nil;
  3741. if Find(ImplementationScope) then exit;
  3742. if Find(InterfaceScope) then exit;
  3743. Find(SystemScope);
  3744. end;
  3745. procedure TPasModuleDotScope.IterateElements(const aName: string;
  3746. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3747. Data: Pointer; var Abort: boolean);
  3748. var
  3749. FilterData: TPasIterateFilterData;
  3750. function Iterate(Scope: TPasIdentifierScope): boolean;
  3751. begin
  3752. if Scope=nil then exit(false);
  3753. Scope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3754. Result:=Abort;
  3755. end;
  3756. begin
  3757. FilterData.OnIterate:=OnIterateElement;
  3758. FilterData.Data:=Data;
  3759. if Iterate(ImplementationScope) then exit;
  3760. if Iterate(InterfaceScope) then exit;
  3761. Iterate(SystemScope);
  3762. end;
  3763. procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
  3764. begin
  3765. if ImplementationScope<>nil then
  3766. ImplementationScope.WriteIdentifiers(Prefix+' ');
  3767. if InterfaceScope<>nil then
  3768. InterfaceScope.WriteIdentifiers(Prefix+' ');
  3769. if SystemScope<>nil then
  3770. SystemScope.WriteIdentifiers(Prefix+' ');
  3771. end;
  3772. { TPasSectionScope }
  3773. procedure TPasSectionScope.OnInternalIterate(El: TPasElement; ElScope,
  3774. StartScope: TPasScope; Data: Pointer; var Abort: boolean);
  3775. var
  3776. FilterData: PPasIterateFilterData absolute Data;
  3777. begin
  3778. if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
  3779. exit; // skip used units
  3780. // call the original iterator
  3781. FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
  3782. end;
  3783. constructor TPasSectionScope.Create;
  3784. begin
  3785. inherited Create;
  3786. UsesScopes:=TFPList.Create;
  3787. end;
  3788. destructor TPasSectionScope.Destroy;
  3789. begin
  3790. {$IFDEF VerbosePasResolverMem}
  3791. writeln('TPasSectionScope.Destroy START ',ClassName);
  3792. {$ENDIF}
  3793. ClearHelperList(Helpers);
  3794. FreeAndNil(UsesScopes);
  3795. inherited Destroy;
  3796. {$IFDEF VerbosePasResolverMem}
  3797. writeln('TPasSectionScope.Destroy END ',ClassName);
  3798. {$ENDIF}
  3799. end;
  3800. function TPasSectionScope.FindIdentifier(const Identifier: String
  3801. ): TPasIdentifier;
  3802. var
  3803. i: Integer;
  3804. UsesScope: TPasIdentifierScope;
  3805. C: TClass;
  3806. begin
  3807. Result:=inherited FindIdentifier(Identifier);
  3808. if Result<>nil then
  3809. exit;
  3810. for i:=UsesScopes.Count-1 downto 0 do
  3811. begin
  3812. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3813. {$IFDEF VerbosePasResolver}
  3814. writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
  3815. {$ENDIF}
  3816. Result:=UsesScope.FindLocalIdentifier(Identifier);
  3817. if Result<>nil then
  3818. begin
  3819. C:=Result.Element.ClassType;
  3820. if (C<>TPasModule) and (C<>TPasUsesUnit) then
  3821. exit;
  3822. end;
  3823. end;
  3824. end;
  3825. procedure TPasSectionScope.IterateElements(const aName: string;
  3826. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3827. Data: Pointer; var Abort: boolean);
  3828. var
  3829. i: Integer;
  3830. UsesScope: TPasSectionScope;
  3831. FilterData: TPasIterateFilterData;
  3832. begin
  3833. inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
  3834. if Abort then exit;
  3835. FilterData.OnIterate:=OnIterateElement;
  3836. FilterData.Data:=Data;
  3837. for i:=UsesScopes.Count-1 downto 0 do
  3838. begin
  3839. UsesScope:=TPasSectionScope(UsesScopes[i]);
  3840. {$IFDEF VerbosePasResolver}
  3841. writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',UsesScope.Element.ParentPath,':',GetObjName(UsesScope.Element));
  3842. {$ENDIF}
  3843. UsesScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
  3844. if Abort then exit;
  3845. end;
  3846. end;
  3847. procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
  3848. var
  3849. i: Integer;
  3850. UsesScope: TPasIdentifierScope;
  3851. SubPrefix: String;
  3852. begin
  3853. {AllowWriteln}
  3854. inherited WriteIdentifiers(Prefix);
  3855. SubPrefix:=Prefix+' ';
  3856. for i:=UsesScopes.Count-1 downto 0 do
  3857. begin
  3858. UsesScope:=TPasIdentifierScope(UsesScopes[i]);
  3859. writeln(Prefix+' Uses: '+GetObjName(UsesScope.Element)+' "'+UsesScope.Element.GetModule.Name+'"');
  3860. UsesScope.FItems.ForEachCall(@OnWriteItem,Pointer(SubPrefix));
  3861. end;
  3862. {AllowWriteln-}
  3863. end;
  3864. { TPasModuleScope }
  3865. procedure TPasModuleScope.SetAssertClass(const AValue: TPasClassType);
  3866. begin
  3867. if FAssertClass=AValue then Exit;
  3868. if FAssertClass<>nil then
  3869. FAssertClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3870. FAssertClass:=AValue;
  3871. if FAssertClass<>nil then
  3872. FAssertClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertClass'){$ENDIF};
  3873. end;
  3874. procedure TPasModuleScope.SetAssertDefConstructor(const AValue: TPasConstructor
  3875. );
  3876. begin
  3877. if FAssertDefConstructor=AValue then Exit;
  3878. if FAssertDefConstructor<>nil then
  3879. FAssertDefConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3880. FAssertDefConstructor:=AValue;
  3881. if FAssertDefConstructor<>nil then
  3882. FAssertDefConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertDefConstructor'){$ENDIF};
  3883. end;
  3884. procedure TPasModuleScope.SetAssertMsgConstructor(const AValue: TPasConstructor
  3885. );
  3886. begin
  3887. if FAssertMsgConstructor=AValue then Exit;
  3888. if FAssertMsgConstructor<>nil then
  3889. FAssertMsgConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3890. FAssertMsgConstructor:=AValue;
  3891. if FAssertMsgConstructor<>nil then
  3892. FAssertMsgConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetAssertMsgConstructor'){$ENDIF};
  3893. end;
  3894. procedure TPasModuleScope.SetRangeErrorClass(const AValue: TPasClassType);
  3895. begin
  3896. if FRangeErrorClass=AValue then Exit;
  3897. if FRangeErrorClass<>nil then
  3898. FRangeErrorClass.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3899. FRangeErrorClass:=AValue;
  3900. if FRangeErrorClass<>nil then
  3901. FRangeErrorClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorClass'){$ENDIF};
  3902. end;
  3903. procedure TPasModuleScope.SetRangeErrorConstructor(const AValue: TPasConstructor
  3904. );
  3905. begin
  3906. if FRangeErrorConstructor=AValue then Exit;
  3907. if FRangeErrorConstructor<>nil then
  3908. FRangeErrorConstructor.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3909. FRangeErrorConstructor:=AValue;
  3910. if FRangeErrorConstructor<>nil then
  3911. FRangeErrorConstructor.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetRangeErrorConstructor'){$ENDIF};
  3912. end;
  3913. procedure TPasModuleScope.SetSystemTVarRec(const AValue: TPasRecordType);
  3914. begin
  3915. if FSystemTVarRec=AValue then Exit;
  3916. if FSystemTVarRec<>nil then
  3917. FSystemTVarRec.Release{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3918. FSystemTVarRec:=AValue;
  3919. if FSystemTVarRec<>nil then
  3920. FSystemTVarRec.AddRef{$IFDEF CheckPasTreeRefCount}('TPasModuleScope.SetSystemTVarRec'){$ENDIF};
  3921. end;
  3922. constructor TPasModuleScope.Create;
  3923. begin
  3924. inherited Create;
  3925. PendingResolvers:=TFPList.Create;
  3926. end;
  3927. destructor TPasModuleScope.Destroy;
  3928. begin
  3929. AssertClass:=nil;
  3930. AssertDefConstructor:=nil;
  3931. AssertMsgConstructor:=nil;
  3932. RangeErrorClass:=nil;
  3933. RangeErrorConstructor:=nil;
  3934. SystemTVarRec:=nil;
  3935. FreeAndNil(PendingResolvers);
  3936. inherited Destroy;
  3937. end;
  3938. procedure TPasModuleScope.IterateElements(const aName: string;
  3939. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  3940. Data: Pointer; var Abort: boolean);
  3941. begin
  3942. if CompareText(aName,FirstName)<>0 then exit;
  3943. OnIterateElement(Element,Self,StartScope,Data,Abort);
  3944. end;
  3945. { TPasDefaultScope }
  3946. class function TPasDefaultScope.IsStoredInElement: boolean;
  3947. begin
  3948. Result:=false;
  3949. end;
  3950. { TPasScope }
  3951. class function TPasScope.IsStoredInElement: boolean;
  3952. begin
  3953. Result:=true;
  3954. end;
  3955. class function TPasScope.FreeOnPop: boolean;
  3956. begin
  3957. Result:=not IsStoredInElement;
  3958. end;
  3959. procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
  3960. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  3961. var Abort: boolean);
  3962. begin
  3963. if aName='' then ;
  3964. if StartScope=nil then ;
  3965. if Data=nil then ;
  3966. if OnIterateElement=nil then ;
  3967. if Abort then ;
  3968. end;
  3969. procedure TPasScope.WriteIdentifiers(Prefix: string);
  3970. begin
  3971. {AllowWriteln}
  3972. writeln(Prefix,'(',ClassName,') Element: ',GetObjName(Element));
  3973. {AllowWriteln-}
  3974. end;
  3975. { TPasIdentifierScope }
  3976. // inline
  3977. function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
  3978. ): TPasIdentifier;
  3979. begin
  3980. Result:=TPasIdentifier(FItems.Find(lowercase(Identifier)));
  3981. end;
  3982. procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
  3983. var
  3984. PasIdentifier: TPasIdentifier absolute Item;
  3985. Ident: TPasIdentifier;
  3986. begin
  3987. if Dummy=nil then ;
  3988. //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
  3989. while PasIdentifier<>nil do
  3990. begin
  3991. Ident:=PasIdentifier;
  3992. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  3993. Ident.Free;
  3994. end;
  3995. end;
  3996. procedure TPasIdentifierScope.OnCollectItem(Item, List: pointer);
  3997. var
  3998. PasIdentifier: TPasIdentifier absolute Item;
  3999. FPList: TFPList absolute List;
  4000. begin
  4001. FPList.Add(PasIdentifier);
  4002. end;
  4003. procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
  4004. var
  4005. PasIdentifier: TPasIdentifier absolute Item;
  4006. Prefix: String;
  4007. begin
  4008. {AllowWriteln}
  4009. Prefix:=String(Dummy);
  4010. while PasIdentifier<>nil do
  4011. begin
  4012. writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
  4013. PasIdentifier:=PasIdentifier.NextSameIdentifier;
  4014. end;
  4015. {AllowWriteln-}
  4016. end;
  4017. procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
  4018. var
  4019. OldItem: TPasIdentifier;
  4020. LoName: string;
  4021. {$ifdef pas2js}
  4022. {$ELSE}
  4023. Index: Integer;
  4024. {$ENDIF}
  4025. begin
  4026. LoName:=lowercase(Item.Identifier);
  4027. {$ifdef pas2js}
  4028. OldItem:=TPasIdentifier(FItems.Find(LoName));
  4029. if OldItem<>nil then
  4030. begin
  4031. // insert LIFO - last in, first out
  4032. Item.NextSameIdentifier:=OldItem;
  4033. end;
  4034. FItems.Add(LoName,Item);
  4035. {$IFDEF VerbosePasResolver}
  4036. if Item.Owner<>nil then
  4037. raise Exception.Create('20160925184110');
  4038. Item.Owner:=Self;
  4039. {$ENDIF}
  4040. {$IFDEF VerbosePasResolver}
  4041. if FindIdentifier(Item.Identifier)<>Item then
  4042. raise Exception.Create('20181018173201');
  4043. {$ENDIF}
  4044. {$else}
  4045. Index:=FItems.FindIndexOf(LoName);
  4046. {$IFDEF VerbosePasResolver}
  4047. if Item.Owner<>nil then
  4048. raise Exception.Create('20160925184110');
  4049. Item.Owner:=Self;
  4050. {$ENDIF}
  4051. //writeln(' Index=',Index);
  4052. if Index>=0 then
  4053. begin
  4054. // insert LIFO - last in, first out
  4055. OldItem:=TPasIdentifier(FItems.List^[Index].Data);
  4056. {$IFDEF VerbosePasResolver}
  4057. if lowercase(OldItem.Identifier)<>LoName then
  4058. raise Exception.Create('20160925183438');
  4059. {$ENDIF}
  4060. Item.NextSameIdentifier:=OldItem;
  4061. FItems.List^[Index].Data:=Item;
  4062. end
  4063. else
  4064. begin
  4065. FItems.Add(LoName, Item);
  4066. {$IFDEF VerbosePasResolver}
  4067. if FindIdentifier(Item.Identifier)<>Item then
  4068. raise Exception.Create('20160925183849');
  4069. {$ENDIF}
  4070. end;
  4071. {$endif}
  4072. end;
  4073. constructor TPasIdentifierScope.Create;
  4074. begin
  4075. FItems:=TPasResHashList.Create;
  4076. end;
  4077. destructor TPasIdentifierScope.Destroy;
  4078. begin
  4079. {$IFDEF VerbosePasResolverMem}
  4080. writeln('TPasIdentifierScope.Destroy START ',ClassName);
  4081. {$ENDIF}
  4082. FItems.ForEachCall(@OnClearItem,nil);
  4083. {$ifdef pas2js}
  4084. FItems:=nil;
  4085. {$else}
  4086. FItems.Clear;
  4087. FreeAndNil(FItems);
  4088. {$endif}
  4089. inherited Destroy;
  4090. {$IFDEF VerbosePasResolverMem}
  4091. writeln('TPasIdentifierScope.Destroy END ',ClassName);
  4092. {$ENDIF}
  4093. end;
  4094. function TPasIdentifierScope.FindIdentifier(const Identifier: String
  4095. ): TPasIdentifier;
  4096. begin
  4097. Result:=FindLocalIdentifier(Identifier);
  4098. {$IFDEF VerbosePasResolver}
  4099. {AllowWriteln}
  4100. if (Result<>nil) and (Result.Owner<>Self) then
  4101. begin
  4102. writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
  4103. raise Exception.Create('20160925184159');
  4104. end;
  4105. {AllowWriteln-}
  4106. {$ENDIF}
  4107. end;
  4108. function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
  4109. var
  4110. Identifier, PrevIdentifier: TPasIdentifier;
  4111. LoName: string;
  4112. begin
  4113. LoName:=lowercase(El.Name);
  4114. Identifier:=TPasIdentifier(FItems.Find(LoName));
  4115. FindLocalIdentifier(El.Name);
  4116. PrevIdentifier:=nil;
  4117. Result:=false;
  4118. while Identifier<>nil do
  4119. begin
  4120. {$IFDEF VerbosePasResolver}
  4121. if (Identifier.Owner<>Self) then
  4122. raise Exception.Create('20160925184159');
  4123. {$ENDIF}
  4124. if Identifier.Element=El then
  4125. begin
  4126. if PrevIdentifier<>nil then
  4127. begin
  4128. PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
  4129. Identifier.Free;
  4130. Identifier:=PrevIdentifier.NextSameIdentifier;
  4131. end
  4132. else
  4133. begin
  4134. FItems.Remove({$ifdef pas2js}LoName{$else}Identifier{$endif});
  4135. PrevIdentifier:=Identifier;
  4136. Identifier:=Identifier.NextSameIdentifier;
  4137. PrevIdentifier.Free;
  4138. PrevIdentifier:=nil;
  4139. if Identifier<>nil then
  4140. FItems.Add(LoName,Identifier);
  4141. end;
  4142. Result:=true;
  4143. continue;
  4144. end;
  4145. PrevIdentifier:=Identifier;
  4146. Identifier:=Identifier.NextSameIdentifier;
  4147. end;
  4148. end;
  4149. function TPasIdentifierScope.AddIdentifier(const Identifier: String;
  4150. El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
  4151. var
  4152. Item: TPasIdentifier;
  4153. begin
  4154. //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
  4155. Item:=TPasIdentifier.Create;
  4156. Item.Identifier:=Identifier;
  4157. Item.Element:=El;
  4158. Item.Kind:=Kind;
  4159. InternalAdd(Item);
  4160. //writeln('TPasIdentifierScope.AddIdentifier END');
  4161. Result:=Item;
  4162. end;
  4163. function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
  4164. var
  4165. Item: TPasIdentifier;
  4166. begin
  4167. //writeln('TPasIdentifierScope.FindElement "',aName,'"');
  4168. Item:=FindIdentifier(aName);
  4169. if Item=nil then
  4170. Result:=nil
  4171. else
  4172. Result:=Item.Element;
  4173. //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
  4174. end;
  4175. procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
  4176. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4177. Data: Pointer; var Abort: boolean);
  4178. var
  4179. Item: TPasIdentifier;
  4180. {$IFDEF VerbosePasResolver}
  4181. OldElement: TPasElement;
  4182. {$ENDIF}
  4183. begin
  4184. Item:=FindLocalIdentifier(aName);
  4185. while Item<>nil do
  4186. begin
  4187. //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
  4188. {$IFDEF VerbosePasResolver}
  4189. OldElement:=Item.Element;
  4190. {$ENDIF}
  4191. OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
  4192. {$IFDEF VerbosePasResolver}
  4193. if OldElement<>Item.Element then
  4194. raise Exception.Create('20160925183503');
  4195. {$ENDIF}
  4196. if Abort then exit;
  4197. Item:=Item.NextSameIdentifier;
  4198. end;
  4199. end;
  4200. procedure TPasIdentifierScope.IterateElements(const aName: string;
  4201. StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
  4202. Data: Pointer; var Abort: boolean);
  4203. begin
  4204. IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
  4205. end;
  4206. procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
  4207. begin
  4208. inherited WriteIdentifiers(Prefix);
  4209. WriteLocalIdentifiers(Prefix+' ');
  4210. end;
  4211. procedure TPasIdentifierScope.WriteLocalIdentifiers(Prefix: string);
  4212. begin
  4213. FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
  4214. end;
  4215. function TPasIdentifierScope.GetLocalIdentifiers: TFPList;
  4216. begin
  4217. Result:=TFPList.Create;
  4218. FItems.ForEachCall(@OnCollectItem,Result);
  4219. end;
  4220. { TPasResolver }
  4221. // inline
  4222. function TPasResolver.GetBaseTypes(bt: TResolverBaseType
  4223. ): TPasUnresolvedSymbolRef;
  4224. begin
  4225. Result:=FBaseTypes[bt];
  4226. end;
  4227. // inline
  4228. function TPasResolver.GetScopes(Index: integer): TPasScope;
  4229. begin
  4230. Result:=FScopes[Index];
  4231. end;
  4232. // inline
  4233. function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
  4234. begin
  4235. Result:=(El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent);
  4236. end;
  4237. // inline
  4238. function TPasResolver.IsGenericTemplType(const ResolvedEl: TPasResolverResult
  4239. ): boolean;
  4240. begin
  4241. Result:=(ResolvedEl.BaseType=btContext)
  4242. and (ResolvedEl.LoTypeEl.ClassType=TPasGenericTemplateType);
  4243. end;
  4244. // inline
  4245. function TPasResolver.GetLocalScope: TPasScope;
  4246. begin
  4247. Result:=TopScope;
  4248. if Result.ClassType=TPasGroupScope then
  4249. Result:=TPasGroupScope(Result).Scopes[0];
  4250. end;
  4251. // inline
  4252. function TPasResolver.GetParentLocalScope: TPasScope;
  4253. begin
  4254. Result:=Scopes[ScopeCount-2];
  4255. if Result.ClassType=TPasGroupScope then
  4256. Result:=TPasGroupScope(Result).Scopes[0];
  4257. end;
  4258. function TPasResolver.GetNameExprValue(El: TPasExpr): string;
  4259. begin
  4260. if El=nil then
  4261. Result:=''
  4262. else if El.ClassType=TPrimitiveExpr then
  4263. begin
  4264. if TPrimitiveExpr(El).Kind=pekIdent then
  4265. Result:=TPrimitiveExpr(El).Value
  4266. else
  4267. Result:='';
  4268. end
  4269. else
  4270. Result:='';
  4271. end;
  4272. function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
  4273. // returns TPrimitiveExpr (Kind=pekIdent)
  4274. var
  4275. Bin: TBinaryExpr;
  4276. C: TClass;
  4277. begin
  4278. Result:=nil;
  4279. if El=nil then exit;
  4280. repeat
  4281. if not (El.Parent is TBinaryExpr) then exit;
  4282. Bin:=TBinaryExpr(El.Parent);
  4283. if Bin.OpCode<>eopSubIdent then exit;
  4284. if El=Bin.right then
  4285. El:=Bin
  4286. else
  4287. begin
  4288. El:=Bin.right;
  4289. // find left most
  4290. repeat
  4291. C:=El.ClassType;
  4292. if C=TPrimitiveExpr then
  4293. begin
  4294. if TPrimitiveExpr(El).Kind<>pekIdent then
  4295. RaiseNotYetImplemented(20170502163825,El);
  4296. exit(El);
  4297. end
  4298. else if C=TBinaryExpr then
  4299. begin
  4300. if TBinaryExpr(El).OpCode<>eopSubIdent then
  4301. RaiseNotYetImplemented(20170502163718,El);
  4302. El:=TBinaryExpr(El).left;
  4303. end
  4304. else if C=TParamsExpr then
  4305. begin
  4306. if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
  4307. RaiseNotYetImplemented(20170502163908,El);
  4308. El:=TParamsExpr(El).Value;
  4309. end;
  4310. until El=nil;
  4311. RaiseNotYetImplemented(20170502163953,Bin);
  4312. end;
  4313. until false;
  4314. end;
  4315. function TPasResolver.GetLeftMostExpr(El: TPasExpr): TPasExpr;
  4316. var
  4317. C: TClass;
  4318. begin
  4319. Result:=El;
  4320. while Result<>nil do
  4321. begin
  4322. El:=Result;
  4323. C:=Result.ClassType;
  4324. if C=TBinaryExpr then
  4325. begin
  4326. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4327. exit;
  4328. Result:=TBinaryExpr(Result).left;
  4329. end
  4330. else if C=TParamsExpr then
  4331. begin
  4332. if not (TParamsExpr(Result).Kind in [pekFuncParams,pekArrayParams]) then
  4333. exit;
  4334. Result:=TParamsExpr(Result).Value;
  4335. end
  4336. else
  4337. exit;
  4338. end;
  4339. end;
  4340. function TPasResolver.GetRightMostExpr(El: TPasExpr): TPasExpr;
  4341. var
  4342. C: TClass;
  4343. begin
  4344. Result:=El;
  4345. while Result<>nil do
  4346. begin
  4347. El:=Result;
  4348. C:=Result.ClassType;
  4349. if C=TBinaryExpr then
  4350. begin
  4351. if TBinaryExpr(Result).OpCode<>eopSubIdent then
  4352. exit;
  4353. Result:=TBinaryExpr(Result).right;
  4354. end
  4355. else
  4356. exit;
  4357. end;
  4358. end;
  4359. procedure TPasResolver.GetParamsOfNameExpr(El: TPasExpr; out
  4360. ParentParams: TPRParentParams);
  4361. // Checks is El is the name expression of a call or array access
  4362. // For example: a.b.El() a.El[]
  4363. // Note: TPasParser guarantees that there is at most one TBinaryExpr
  4364. // and one TInlineSpecializeExpr between El and TParamsExpr
  4365. var
  4366. Parent: TPasElement;
  4367. Bin: TBinaryExpr;
  4368. Params: TParamsExpr;
  4369. InlineSpec: TInlineSpecializeExpr;
  4370. begin
  4371. ParentParams.InlineSpec:=nil;
  4372. ParentParams.Params:=nil;
  4373. if not IsNameExpr(El) then exit;
  4374. Parent:=El.Parent;
  4375. if Parent=nil then exit;
  4376. if Parent.ClassType=TBinaryExpr then
  4377. begin
  4378. Bin:=TBinaryExpr(Parent);
  4379. if (Bin.OpCode<>eopSubIdent) or (Bin.right<>El) then
  4380. exit;
  4381. El:=Bin;
  4382. Parent:=El.Parent;
  4383. end;
  4384. if Parent.ClassType=TInlineSpecializeExpr then
  4385. begin
  4386. InlineSpec:=TInlineSpecializeExpr(Parent);
  4387. if InlineSpec.NameExpr<>El then exit;
  4388. ParentParams.InlineSpec:=InlineSpec;
  4389. El:=InlineSpec;
  4390. Parent:=El.Parent;
  4391. if Parent=nil then exit;
  4392. end;
  4393. if Parent.ClassType<>TParamsExpr then exit;
  4394. Params:=TParamsExpr(Parent);
  4395. if Params.Value<>El then exit;
  4396. if not (Params.Kind in [pekFuncParams,pekArrayParams]) then exit;
  4397. ParentParams.Params:=Params;
  4398. end;
  4399. function TPasResolver.GetInlineSpecOfNameExpr(El: TPasExpr
  4400. ): TInlineSpecializeExpr;
  4401. var
  4402. Parent: TPasElement;
  4403. begin
  4404. Result:=nil;
  4405. if not IsNameExpr(El) then exit;
  4406. Parent:=El.Parent;
  4407. if Parent=nil then exit;
  4408. if Parent is TBinaryExpr then
  4409. begin
  4410. if (TBinaryExpr(Parent).OpCode<>eopSubIdent)
  4411. or (TBinaryExpr(Parent).right<>El) then
  4412. exit;
  4413. El:=TBinaryExpr(Parent); // continue
  4414. Parent:=El.Parent;
  4415. end;
  4416. if Parent.ClassType<>TInlineSpecializeExpr then exit;
  4417. Result:=TInlineSpecializeExpr(Parent);
  4418. if Result.NameExpr<>El then
  4419. Result:=nil;
  4420. end;
  4421. function TPasResolver.GetUsesUnitInFilename(InFileExpr: TPasExpr): string;
  4422. var
  4423. Value: TResEvalValue;
  4424. begin
  4425. if not (InFileExpr is TPrimitiveExpr) then
  4426. RaiseXExpectedButYFound(20180221234828,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4427. Value:=ExprEvaluator.Eval(TPrimitiveExpr(InFileExpr),[refConst]);
  4428. try
  4429. if (Value=nil) then
  4430. RaiseXExpectedButYFound(20180222000004,'string literal',GetElementTypeName(InFileExpr),InFileExpr);
  4431. case Value.Kind of
  4432. {$ifdef FPC_HAS_CPSTRING}
  4433. revkString:
  4434. Result:=ExprEvaluator.GetUTF8Str(TResEvalString(Value).S,InFileExpr);
  4435. revkUnicodeString:
  4436. Result:=UTF8Encode(TResEvalUTF16(Value).S);
  4437. {$else}
  4438. revkUnicodeString:
  4439. Result:=TResEvalUTF16(Value).S;
  4440. {$endif}
  4441. else
  4442. RaiseXExpectedButYFound(20180222000122,'string literal',Value.AsDebugString,InFileExpr);
  4443. end;
  4444. finally
  4445. ReleaseEvalValue(Value);
  4446. end;
  4447. end;
  4448. function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
  4449. // get leftmost name element (e.g. TPrimitiveExpr)
  4450. // nil if not found
  4451. var
  4452. C: TClass;
  4453. begin
  4454. Result:=nil;
  4455. while El<>nil do
  4456. begin
  4457. C:=El.ClassType;
  4458. if C=TPrimitiveExpr then
  4459. exit(El)
  4460. else if C=TBinaryExpr then
  4461. begin
  4462. if TBinaryExpr(El).OpCode=eopSubIdent then
  4463. El:=TBinaryExpr(El).left
  4464. else
  4465. exit;
  4466. end
  4467. else if C=TParamsExpr then
  4468. El:=TParamsExpr(El).Value
  4469. else
  4470. exit;
  4471. end;
  4472. end;
  4473. function TPasResolver.GetPathEndIdent(El: TPasExpr; AllowCall: boolean
  4474. ): TPasExpr;
  4475. // a -> a
  4476. // a.b -> b
  4477. // a.b() -> b
  4478. // a()() -> nil
  4479. // a[] -> nil
  4480. var
  4481. Bin: TBinaryExpr;
  4482. begin
  4483. Result:=nil;
  4484. if AllowCall and (El is TParamsExpr) then
  4485. El:=TParamsExpr(El).Value;
  4486. while El is TBinaryExpr do
  4487. begin
  4488. Bin:=TBinaryExpr(El);
  4489. if Bin.OpCode=eopSubIdent then
  4490. El:=Bin.right;
  4491. end;
  4492. if (El is TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent) then
  4493. Result:=El;
  4494. end;
  4495. function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
  4496. // if the expression is a constructor newinstance call,
  4497. // return the element referring the constructor
  4498. // else nil
  4499. var
  4500. C: TClass;
  4501. begin
  4502. Result:=nil;
  4503. while El<>nil do
  4504. begin
  4505. if (El.CustomData is TResolvedReference)
  4506. and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
  4507. exit(El);
  4508. C:=El.ClassType;
  4509. if C=TBinaryExpr then
  4510. begin
  4511. if TBinaryExpr(El).OpCode=eopSubIdent then
  4512. El:=TBinaryExpr(El).right
  4513. else
  4514. exit;
  4515. end
  4516. else if C=TParamsExpr then
  4517. El:=TParamsExpr(El).Value
  4518. else
  4519. exit;
  4520. end;
  4521. end;
  4522. procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
  4523. var
  4524. El: TPasElement;
  4525. RData: TResolveData;
  4526. begin
  4527. // clear CustomData
  4528. while FLastCreatedData[Kind]<>nil do
  4529. begin
  4530. RData:=FLastCreatedData[Kind];
  4531. El:=RData.Element;
  4532. El.CustomData:=nil;
  4533. FLastCreatedData[Kind]:=RData.Next;
  4534. RData.Free;
  4535. end;
  4536. end;
  4537. function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
  4538. begin
  4539. if FBaseTypes[bt]<>nil then
  4540. Result:=FBaseTypes[bt].Name
  4541. else
  4542. Result:=ResBaseTypeNames[bt];
  4543. end;
  4544. function TPasResolver.GetBuiltInProcs(bp: TResolverBuiltInProc
  4545. ): TResElDataBuiltInProc;
  4546. begin
  4547. Result:=FBuiltInProcs[bp];
  4548. end;
  4549. procedure TPasResolver.SetRootElement(const AValue: TPasModule);
  4550. begin
  4551. if FRootElement=AValue then Exit;
  4552. FRootElement:=AValue;
  4553. end;
  4554. procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope,
  4555. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4556. var
  4557. Data: PPRFindData absolute FindFirstElementData;
  4558. ok: Boolean;
  4559. Proc: TPasProcedure;
  4560. Templates: TFPList;
  4561. begin
  4562. ok:=true;
  4563. if (El is TPasProcedure) then
  4564. begin
  4565. Proc:=TPasProcedure(El);
  4566. if Data^.SkipGenerics then
  4567. begin
  4568. Templates:=GetProcTemplateTypes(Proc);
  4569. if (Templates<>nil) and (Templates.Count>0) then
  4570. ok:=false;
  4571. end;
  4572. if ok and ProcNeedsParams(Proc.ProcType) then
  4573. // found a proc, but it needs parameters -> remember the first and continue
  4574. ok:=false;
  4575. end
  4576. else if Data^.SkipGenerics then
  4577. begin
  4578. if El is TPasGenericType then
  4579. begin
  4580. if GetTypeParameterCount(TPasGenericType(El))>0 then
  4581. ok:=false;
  4582. end;
  4583. end;
  4584. if ok or (Data^.Found=nil) then
  4585. begin
  4586. Data^.Found:=El;
  4587. Data^.ElScope:=ElScope;
  4588. Data^.StartScope:=StartScope;
  4589. end;
  4590. if ok then
  4591. Abort:=true;
  4592. end;
  4593. procedure TPasResolver.OnFindFirst(El: TPasElement; ElScope,
  4594. StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
  4595. var
  4596. Data: PPRFindData absolute FindFirstElementData;
  4597. begin
  4598. Data^.Found:=El;
  4599. Data^.ElScope:=ElScope;
  4600. Data^.StartScope:=StartScope;
  4601. Abort:=true;
  4602. end;
  4603. procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
  4604. StartScope: TPasScope; FindFirstGenericData: Pointer; var Abort: boolean);
  4605. var
  4606. Data: PPRFindGenericData absolute FindFirstGenericData;
  4607. GenericTemplateTypes: TFPList;
  4608. begin
  4609. if El is TPasGenericType then
  4610. GenericTemplateTypes:=TPasGenericType(El).GenericTemplateTypes
  4611. else if El is TPasProcedure then
  4612. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(El))
  4613. else
  4614. exit;
  4615. if GenericTemplateTypes=nil then exit;
  4616. if GenericTemplateTypes.Count<>Data^.TemplateCount then
  4617. exit;
  4618. Data^.Find.Found:=El;
  4619. Data^.Find.ElScope:=ElScope;
  4620. Data^.Find.StartScope:=StartScope;
  4621. Abort:=true;
  4622. end;
  4623. procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
  4624. StartScope: TPasScope; FindCallElData: Pointer; var Abort: boolean);
  4625. var
  4626. Data: PFindCallElData absolute FindCallElData;
  4627. Proc, PrevProc: TPasProcedure;
  4628. Distance: integer;
  4629. BuiltInProc: TResElDataBuiltInProc;
  4630. CandidateFound: Boolean;
  4631. VarType, TypeEl: TPasType;
  4632. C: TClass;
  4633. ProcScope: TPasProcedureScope;
  4634. Templates: TFPList;
  4635. begin
  4636. {$IFDEF VerbosePasResolver}
  4637. writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
  4638. {$ENDIF}
  4639. CandidateFound:=false;
  4640. if (El is TPasProcedure) then
  4641. begin
  4642. // identifier is a proc
  4643. Proc:=TPasProcedure(El);
  4644. PrevProc:=nil;
  4645. if Data^.Found=Proc then
  4646. begin
  4647. // this proc was already found. This happens when this is the forward
  4648. // declaration or a previously found implementation.
  4649. exit;
  4650. end;
  4651. ProcScope:=Proc.CustomData as TPasProcedureScope;
  4652. if ProcScope.DeclarationProc<>nil then
  4653. begin
  4654. // this proc has a forward declaration -> use that instead
  4655. Proc:=ProcScope.DeclarationProc;
  4656. El:=Proc;
  4657. end;
  4658. if Data^.Found is TPasProcedure then
  4659. begin
  4660. // there is already a previous proc
  4661. PrevProc:=TPasProcedure(Data^.Found);
  4662. if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
  4663. begin
  4664. if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
  4665. begin
  4666. Abort:=true;
  4667. exit;
  4668. end;
  4669. end
  4670. else
  4671. begin
  4672. // mode objfpc
  4673. if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
  4674. // mode objfpc: procs in same context have implicit overload
  4675. else
  4676. begin
  4677. // mode objfpc, different context
  4678. if not ProcHasGroupOverload(Data^.LastProc) then
  4679. begin
  4680. Abort:=true;
  4681. exit;
  4682. end;
  4683. end;
  4684. end;
  4685. if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
  4686. and (PrevProc.Parent.ClassType=TPasClassType) then
  4687. begin
  4688. // there was already a perfect proc in a descendant
  4689. Abort:=true;
  4690. exit;
  4691. end;
  4692. // check if previous found proc is override of found proc
  4693. if IsProcOverride(Proc,PrevProc) then
  4694. begin
  4695. // previous found proc is override of found proc -> skip
  4696. exit;
  4697. end;
  4698. end;
  4699. if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
  4700. Abort:=true; // stop searching after this proc
  4701. CandidateFound:=true;
  4702. if Data^.TemplCnt>0 then
  4703. begin
  4704. // proc must have templates
  4705. Templates:=GetProcTemplateTypes(Proc);
  4706. if (Templates=nil) or (Templates.Count<>Data^.TemplCnt) then
  4707. Distance:=cIncompatible
  4708. else
  4709. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4710. end
  4711. else
  4712. Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
  4713. {$IFDEF VerbosePasResolver}
  4714. writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
  4715. ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',Data^.Distance,
  4716. ' Signature={',GetProcTypeDescription(Proc.ProcType,[prptdUseName,prptdAddPaths]),'}',
  4717. ' Abort=',Abort);
  4718. {$ENDIF}
  4719. Data^.LastProc:=Proc;
  4720. end
  4721. else if El is TPasType then
  4722. begin
  4723. TypeEl:=ResolveAliasType(TPasType(El));
  4724. C:=TypeEl.ClassType;
  4725. if Data^.TemplCnt<>0 then
  4726. begin
  4727. if (not C.InheritsFrom(TPasGenericType))
  4728. or (GetTypeParameterCount(TPasGenericType(TypeEl))<>Data^.TemplCnt)
  4729. then
  4730. exit;
  4731. end;
  4732. if C=TPasUnresolvedSymbolRef then
  4733. begin
  4734. if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
  4735. begin
  4736. // call of built-in proc
  4737. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  4738. if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
  4739. and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
  4740. begin
  4741. // str function can only be used within an expression
  4742. // str procedure can only be used outside an expression
  4743. {$IFDEF VerbosePasResolver}
  4744. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
  4745. {$ENDIF}
  4746. exit;
  4747. end;
  4748. Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
  4749. {$IFDEF VerbosePasResolver}
  4750. writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
  4751. {$ENDIF}
  4752. CandidateFound:=true;
  4753. end
  4754. else if TypeEl.CustomData is TResElDataBaseType then
  4755. begin
  4756. // type cast to base type
  4757. Abort:=true; // can't be overloaded
  4758. if Data^.Found<>nil then exit;
  4759. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4760. {$IFDEF VerbosePasResolver}
  4761. writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
  4762. {$ENDIF}
  4763. CandidateFound:=true;
  4764. end;
  4765. end
  4766. else if (C=TPasClassType)
  4767. or (C=TPasClassOfType)
  4768. or (C=TPasPointerType)
  4769. or (C=TPasRecordType)
  4770. or (C=TPasEnumType)
  4771. or (C=TPasProcedureType)
  4772. or (C=TPasFunctionType)
  4773. or (C=TPasArrayType)
  4774. or (C=TPasRangeType)
  4775. or (C=TPasGenericTemplateType) then
  4776. begin
  4777. // type cast to user type
  4778. Abort:=true; // can't be overloaded
  4779. if Data^.Found<>nil then exit;
  4780. Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
  4781. {$IFDEF VerbosePasResolver}
  4782. writeln('TPasResolver.OnFindCallElements type cast to "',GetObjName(El),'" Distance=',Distance);
  4783. {$ENDIF}
  4784. CandidateFound:=true;
  4785. end;
  4786. end
  4787. else if El is TPasVariable then
  4788. begin
  4789. Abort:=true; // can't be overloaded
  4790. if Data^.Found<>nil then exit;
  4791. if Data^.TemplCnt<>0 then exit;
  4792. if El.ClassType=TPasProperty then
  4793. VarType:=GetPasPropertyType(TPasProperty(El))
  4794. else
  4795. VarType:=TPasVariable(El).VarType;
  4796. VarType:=ResolveAliasType(VarType);
  4797. if VarType is TPasProcedureType then
  4798. begin
  4799. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4800. {$IFDEF VerbosePasResolver}
  4801. writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
  4802. {$ENDIF}
  4803. CandidateFound:=true;
  4804. end;
  4805. end
  4806. else if El.ClassType=TPasArgument then
  4807. begin
  4808. Abort:=true; // can't be overloaded
  4809. if Data^.Found<>nil then exit;
  4810. if Data^.TemplCnt<>0 then exit;
  4811. VarType:=ResolveAliasType(TPasArgument(El).ArgType);
  4812. if VarType is TPasProcedureType then
  4813. begin
  4814. Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
  4815. {$IFDEF VerbosePasResolver}
  4816. writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
  4817. {$ENDIF}
  4818. CandidateFound:=true;
  4819. end;
  4820. end;
  4821. if not CandidateFound then
  4822. begin
  4823. // El does not support the () operator
  4824. Abort:=true;
  4825. if Data^.Found=nil then
  4826. begin
  4827. // El is the first element found -> raise error
  4828. // ToDo: use the ( as error position
  4829. RaiseMsg(20170216151525,nIllegalQualifierAfter,sIllegalQualifierAfter,
  4830. ['(',El.ElementTypeName],Data^.Params);
  4831. end;
  4832. exit;
  4833. end;
  4834. // El is a candidate (might be incompatible)
  4835. if (Data^.Found=nil)
  4836. or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
  4837. begin
  4838. {$IFDEF VerbosePasResolver}
  4839. writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
  4840. {$ENDIF}
  4841. Data^.Found:=El;
  4842. Data^.ElScope:=ElScope;
  4843. Data^.StartScope:=StartScope;
  4844. Data^.Distance:=Distance;
  4845. Data^.Count:=1;
  4846. if Data^.List<>nil then
  4847. begin
  4848. Data^.List.Clear;
  4849. Data^.List.Add(El);
  4850. end;
  4851. end
  4852. else if Distance=cIncompatible then
  4853. // another candidate, but it is incompatible -> ignore
  4854. {$IFDEF VerbosePasResolver}
  4855. writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
  4856. {$ENDIF}
  4857. else if (Data^.Distance=Distance)
  4858. or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)
  4859. and ((Distance>=cIntToFloatConversion)=(Data^.Distance>=cIntToFloatConversion))) then
  4860. begin
  4861. // found another similar compatible one -> collect
  4862. // Note: cLossyConversion is better than cIntToFloatConversion, not similar
  4863. {$IFDEF VerbosePasResolver}
  4864. writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
  4865. {$ENDIF}
  4866. inc(Data^.Count);
  4867. if (Data^.List<>nil) then
  4868. begin
  4869. if (Data^.List.IndexOf(El)>=0) then
  4870. begin
  4871. {$IFDEF VerbosePasResolver}
  4872. writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
  4873. ' ',GetElementSourcePosStr(El),
  4874. ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
  4875. ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
  4876. );
  4877. {$ENDIF}
  4878. RaiseInternalError(20160924230805);
  4879. end;
  4880. Data^.List.Add(El);
  4881. end;
  4882. end
  4883. else if (Distance<Data^.Distance) then
  4884. begin
  4885. // found a better one
  4886. {$IFDEF VerbosePasResolver}
  4887. writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4888. {$ENDIF}
  4889. if (Distance<cLossyConversion)
  4890. or ((Distance>=cIntToFloatConversion)<>(Data^.Distance>=cIntToFloatConversion)) then
  4891. begin
  4892. // found a good one
  4893. {$IFDEF VerbosePasResolver}
  4894. writeln('TPasResolver.OnFindCallElements Found a good candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4895. {$ENDIF}
  4896. Data^.Count:=1;
  4897. if Data^.List<>nil then
  4898. Data^.List.Clear;
  4899. end
  4900. else
  4901. begin
  4902. // found another lossy one
  4903. // -> collect them
  4904. {$IFDEF VerbosePasResolver}
  4905. writeln('TPasResolver.OnFindCallElements Found another lossy candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
  4906. {$ENDIF}
  4907. inc(Data^.Count);
  4908. end;
  4909. Data^.Found:=El;
  4910. Data^.ElScope:=ElScope;
  4911. Data^.StartScope:=StartScope;
  4912. Data^.Distance:=Distance;
  4913. if Data^.List<>nil then
  4914. Data^.List.Add(El);
  4915. end
  4916. else
  4917. begin
  4918. // found a worse one
  4919. end;
  4920. end;
  4921. procedure TPasResolver.OnFindProc(El: TPasElement; ElScope,
  4922. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  4923. var
  4924. Data: PFindProcData absolute FindProcData;
  4925. Proc: TPasProcedure;
  4926. Store, SameScope: Boolean;
  4927. ProcScope: TPasProcedureScope;
  4928. CurResolver: TPasResolver;
  4929. procedure CountProcInSameScope;
  4930. begin
  4931. inc(Data^.FoundInSameScope);
  4932. if Proc.IsOverload then
  4933. Data^.FoundOverloadModifier:=true;
  4934. end;
  4935. begin
  4936. //writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  4937. if not (El is TPasProcedure) then
  4938. begin
  4939. // identifier is not a proc
  4940. if (El is TPasVariable) then
  4941. begin
  4942. if TPasVariable(El).Visibility=visStrictPrivate then
  4943. exit; // not visible
  4944. if (TPasVariable(El).Visibility=visPrivate)
  4945. and (El.GetModule<>StartScope.Element.GetModule) then
  4946. exit; // not visible
  4947. end;
  4948. Data^.FoundNonProc:=El;
  4949. Abort:=true;
  4950. if (El.CustomData is TResElDataBuiltInProc) then
  4951. begin
  4952. if Data^.FoundOverloadModifier or Data^.Proc.IsOverload then
  4953. exit; // no hint
  4954. end;
  4955. case Data^.Kind of
  4956. fpkProc:
  4957. // proc hides a non proc
  4958. if (Data^.Proc.GetModule=El.GetModule) then
  4959. // forbidden within same module
  4960. RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
  4961. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType)
  4962. else
  4963. begin
  4964. // give a hint
  4965. if Data^.Proc.Parent is TPasMembersType then
  4966. begin
  4967. if El.Visibility=visStrictPrivate then
  4968. else if (El.Visibility=visPrivate) and (El.GetModule<>Data^.Proc.GetModule) then
  4969. else
  4970. LogMsg(20171118205344,mtHint,nFunctionHidesIdentifier_NonProc,sFunctionHidesIdentifier,
  4971. [GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4972. end;
  4973. end;
  4974. fpkMethod:
  4975. // method hides a non proc
  4976. begin
  4977. ProcScope:=TPasProcedureScope(Data^.Proc.CustomData);
  4978. CurResolver:=ProcScope.Owner as TPasResolver;
  4979. if msDelphi in CurResolver.CurrentParser.CurrentModeswitches then
  4980. // ok in delphi
  4981. else
  4982. RaiseMsg(20171118232543,nDuplicateIdentifier,sDuplicateIdentifier,
  4983. [El.Name,GetElementSourcePosStr(El)],Data^.Proc.ProcType);
  4984. end;
  4985. end;
  4986. exit;
  4987. end;
  4988. // identifier is a proc
  4989. Proc:=TPasProcedure(El);
  4990. if El=Data^.Proc then
  4991. begin
  4992. // found itself -> this is normal when searching for overloads
  4993. CountProcInSameScope;
  4994. exit;
  4995. end;
  4996. {$IFDEF VerbosePasResolver}
  4997. writeln('TPasResolver.OnFindProc ',GetTreeDbg(El,2));
  4998. {$ENDIF}
  4999. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  5000. case Data^.Kind of
  5001. fpkProc:
  5002. SameScope:=Data^.Proc.GetModule=Proc.GetModule;
  5003. fpkMethod:
  5004. SameScope:=Data^.Proc.Parent=Proc.Parent;
  5005. else
  5006. // use OnFindProcDeclaration instead
  5007. RaiseNotYetImplemented(20191010123525,Data^.Proc);
  5008. end;
  5009. if SameScope then
  5010. begin
  5011. // same scope
  5012. if (msObjfpc in CurrentParser.CurrentModeswitches) then
  5013. begin
  5014. if ProcHasGroupOverload(Data^.Proc) then
  5015. Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
  5016. else if ProcHasGroupOverload(Proc) then
  5017. Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
  5018. end;
  5019. if Store then
  5020. begin
  5021. // same scope, same signature
  5022. // Note: forward declaration was already handled in FinishProcedureHeader
  5023. RaiseMsg(20171118221821,nDuplicateIdentifier,sDuplicateIdentifier,
  5024. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5025. end
  5026. else
  5027. begin
  5028. // same scope, different signature
  5029. if (msDelphi in CurrentParser.CurrentModeswitches) then
  5030. begin
  5031. // Delphi does not allow different procs without 'overload' in a scope
  5032. if not Proc.IsOverload then
  5033. RaiseMsg(20171118222112,nPreviousDeclMissesOverload,sPreviousDeclMissesOverload,
  5034. [Proc.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  5035. else if not Data^.Proc.IsOverload then
  5036. RaiseMsg(20171118222147,nOverloadedProcMissesOverload,sOverloadedProcMissesOverload,
  5037. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5038. end
  5039. else
  5040. begin
  5041. // ObjFPC allows different procs without 'overload' modifier
  5042. end;
  5043. CountProcInSameScope;
  5044. end;
  5045. end
  5046. else
  5047. begin
  5048. // different scopes
  5049. if Data^.Proc.IsOverride then
  5050. else if Data^.Proc.IsReintroduced then
  5051. else
  5052. begin
  5053. if Store
  5054. or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
  5055. and not ProcHasGroupOverload(Data^.Proc)) then
  5056. begin
  5057. if (Data^.Kind=fpkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
  5058. // give a hint, that method hides a virtual method in ancestor
  5059. LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
  5060. sMethodHidesMethodOfBaseType,
  5061. [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
  5062. else
  5063. begin
  5064. // Delphi/FPC do not give a message when hiding a non virtual method
  5065. // -> emit Hint with other message id
  5066. if (Data^.Proc.Parent is TPasMembersType) then
  5067. begin
  5068. ProcScope:=Proc.CustomData as TPasProcedureScope;
  5069. if (Proc.Visibility=visStrictPrivate)
  5070. or ((Proc.Visibility=visPrivate)
  5071. and (Proc.GetModule<>Data^.Proc.GetModule)) then
  5072. // a private private is hidden by definition -> no hint
  5073. else if (ProcScope.ImplProc<>nil) // not abstract, external
  5074. and (not ProcHasImplElements(ProcScope.ImplProc)) then
  5075. // hidden method has implementation, but no statements -> useless
  5076. // -> do not give a hint for hiding this useless method
  5077. // Note: if this happens in the same unit, the body was not yet parsed
  5078. else if (Proc is TPasConstructor)
  5079. and (Data^.Proc.ClassType=Proc.ClassType) then
  5080. // do not give a hint for hiding a constructor
  5081. else if Store then
  5082. begin
  5083. // method hides ancestor method with same signature
  5084. LogMsg(20190316152656,mtHint,
  5085. nMethodHidesNonVirtualMethodExactly,sMethodHidesNonVirtualMethodExactly,
  5086. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5087. end
  5088. else
  5089. begin
  5090. //writeln('TPasResolver.OnFindProc Proc=',Proc.PathName,' Data^.Proc=',Data^.Proc.PathName,' ',Proc.Visibility);
  5091. LogMsg(20171118214523,mtHint,
  5092. nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
  5093. [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
  5094. end;
  5095. end;
  5096. end;
  5097. Abort:=true;
  5098. end;
  5099. end;
  5100. end;
  5101. if Store then
  5102. begin
  5103. Data^.Found:=Proc;
  5104. Data^.ElScope:=ElScope;
  5105. Data^.StartScope:=StartScope;
  5106. Abort:=true;
  5107. end;
  5108. end;
  5109. procedure TPasResolver.OnFindProcDeclaration(El: TPasElement; ElScope,
  5110. StartScope: TPasScope; FindProcData: Pointer; var Abort: boolean);
  5111. var
  5112. Data: PFindProcData absolute FindProcData;
  5113. Proc: TPasProcedure;
  5114. Store: Boolean;
  5115. begin
  5116. //writeln('TPasResolver.OnFindProcDeclaration START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
  5117. if not (El is TPasProcedure) then
  5118. begin
  5119. // identifier is not a proc
  5120. Data^.FoundNonProc:=El;
  5121. Abort:=true;
  5122. exit;
  5123. end;
  5124. if El=Data^.Proc then
  5125. // found itself -> this is normal when searching for overloads
  5126. exit;
  5127. // identifier is a proc
  5128. Proc:=TPasProcedure(El);
  5129. {$IFDEF VerbosePasResolver}
  5130. writeln('TPasResolver.OnFindProcDeclaration ',GetTreeDbg(El,2));
  5131. {$ENDIF}
  5132. Store:=CheckProcOverloadCompatibility(Data^.Proc,Proc);
  5133. if Store then
  5134. begin
  5135. Data^.Found:=Proc;
  5136. Data^.ElScope:=ElScope;
  5137. Data^.StartScope:=StartScope;
  5138. Abort:=true;
  5139. end;
  5140. end;
  5141. function TPasResolver.IsSameProcContext(ProcParentA, ProcParentB: TPasElement
  5142. ): boolean;
  5143. begin
  5144. if ProcParentA=ProcParentB then exit(true);
  5145. if (ProcParentA.ClassType=TInterfaceSection) then
  5146. begin
  5147. if (ProcParentB.ClassType=TImplementationSection)
  5148. and (ProcParentB.Parent=ProcParentA.Parent) then
  5149. exit(true);
  5150. end
  5151. else if (ProcParentB.ClassType=TInterfaceSection) then
  5152. begin
  5153. if (ProcParentA.ClassType=TImplementationSection)
  5154. and (ProcParentA.Parent=ProcParentB.Parent) then
  5155. exit(true);
  5156. end;
  5157. Result:=false;
  5158. end;
  5159. function TPasResolver.FindProcSameSignature(const ProcName: string;
  5160. Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
  5161. ): TPasProcedure;
  5162. var
  5163. FindData: TFindProcData;
  5164. Abort: boolean;
  5165. begin
  5166. FindData:=Default(TFindProcData);
  5167. FindData.Proc:=Proc;
  5168. FindData.Args:=Proc.ProcType.Args;
  5169. FindData.Kind:=fpkProcDeclaration;
  5170. Abort:=false;
  5171. //writeln('TPasResolver.FindProcSameSignature ',ProcName,' OnlyLocal=',OnlyLocal);
  5172. if OnlyLocal then
  5173. Scope.IterateLocalElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort)
  5174. else
  5175. Scope.IterateElements(ProcName,Scope,@OnFindProcDeclaration,@FindData,Abort);
  5176. Result:=FindData.Found;
  5177. end;
  5178. procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
  5179. var
  5180. Scanner: TPascalScanner;
  5181. begin
  5182. //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
  5183. if AValue=CurrentParser then exit;
  5184. Clear;
  5185. inherited SetCurrentParser(AValue);
  5186. if CurrentParser<>nil then
  5187. begin
  5188. CurrentParser.Options:=CurrentParser.Options+po_Resolver;
  5189. if CurrentParser.Scanner<>nil then
  5190. begin
  5191. Scanner:=CurrentParser.Scanner;
  5192. if (Scanner.OnWarnDirective=nil) then
  5193. Scanner.OnWarnDirective:=@ScannerWarnDirective;
  5194. Scanner.SetNonToken(tkself);
  5195. end;
  5196. end;
  5197. end;
  5198. procedure TPasResolver.ScannerWarnDirective(Sender: TObject;
  5199. Identifier: string; State: TWarnMsgState; var Handled: boolean);
  5200. var
  5201. MsgNumbers: TIntegerDynArray;
  5202. i: Integer;
  5203. begin
  5204. if not GetWarnIdentifierNumbers(Identifier,MsgNumbers) then exit;
  5205. Handled:=true;
  5206. for i:=0 to length(MsgNumbers)-1 do
  5207. TPascalScanner(Sender).WarnMsgState[MsgNumbers[i]]:=State;
  5208. end;
  5209. procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
  5210. AllowDescendants: boolean);
  5211. var
  5212. Scope: TPasScope;
  5213. begin
  5214. Scope:=TopScope;
  5215. if Scope=nil then
  5216. RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
  5217. if Scope.ClassType<>ExpectedClass then
  5218. if (not AllowDescendants) or (not Scope.InheritsFrom(ExpectedClass)) then
  5219. RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+Scope.ClassName);
  5220. end;
  5221. function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
  5222. const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
  5223. ): TPasIdentifier;
  5224. function SkipGenericTypes(Identifier: TPasIdentifier;
  5225. TypeParamCnt: integer): TPasIdentifier;
  5226. var
  5227. CurEl: TPasElement;
  5228. begin
  5229. while Identifier<>nil do
  5230. begin
  5231. CurEl:=Identifier.Element;
  5232. if CurEl is TPasGenericType then
  5233. begin
  5234. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
  5235. break;
  5236. end
  5237. else
  5238. begin
  5239. if TypeParamCnt=0 then
  5240. break;
  5241. end;
  5242. Identifier:=Identifier.NextSameIdentifier;
  5243. end;
  5244. Result:=Identifier;
  5245. end;
  5246. var
  5247. Group: TPasGroupScope;
  5248. Identifier, OlderIdentifier: TPasIdentifier;
  5249. OlderEl: TPasElement;
  5250. C: TClass;
  5251. i, TypeParamCnt: Integer;
  5252. OtherScope: TPasIdentifierScope;
  5253. ParentScope: TPasScope;
  5254. IsGeneric, IsDelphi: Boolean;
  5255. begin
  5256. if aName='' then exit(nil);
  5257. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  5258. if Scope is TPasGroupScope then
  5259. begin
  5260. Group:=TPasGroupScope(Scope);
  5261. Scope:=Group.Scopes[0];
  5262. end
  5263. else
  5264. Group:=nil;
  5265. if El is TPasGenericType then
  5266. begin
  5267. IsGeneric:=true;
  5268. TypeParamCnt:=GetTypeParameterCount(TPasGenericType(El));
  5269. end
  5270. else
  5271. begin
  5272. IsGeneric:=false;
  5273. TypeParamCnt:=0;
  5274. end;
  5275. if (El.Visibility=visPublished) then
  5276. begin
  5277. C:=El.ClassType;
  5278. if (C=TPasProperty) or (C=TPasVariable) then
  5279. // Note: VarModifiers are not yet set
  5280. else if (C=TPasProcedure) or (C=TPasFunction) then
  5281. // ok
  5282. else
  5283. RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  5284. end;
  5285. if (Kind=pikSimple) and (Group<>nil) and (El.ClassType<>TPasProperty)
  5286. and not IsDelphi then
  5287. begin
  5288. // check duplicate in ancestors and helpers
  5289. for i:=1 to Group.Count-1 do
  5290. begin
  5291. OtherScope:=Group.Scopes[i];
  5292. OlderIdentifier:=OtherScope.FindLocalIdentifier(aName);
  5293. if IsGeneric then
  5294. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5295. while OlderIdentifier<>nil do
  5296. begin
  5297. OlderEl:=OlderIdentifier.Element;
  5298. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  5299. if OlderEl is TPasVariable then
  5300. begin
  5301. if TPasVariable(OlderEl).Visibility=visStrictPrivate then
  5302. continue; // OlderEl is hidden
  5303. if (TPasVariable(OlderEl).Visibility=visPrivate)
  5304. and (OlderEl.GetModule<>El.GetModule) then
  5305. continue; // OlderEl is hidden
  5306. end;
  5307. RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
  5308. [aName,GetElementSourcePosStr(OlderEl)],El);
  5309. end;
  5310. end;
  5311. end;
  5312. Identifier:=Scope.AddIdentifier(aName,El,Kind);
  5313. // check duplicate in current scope
  5314. OlderIdentifier:=Identifier.NextSameIdentifier;
  5315. if IsGeneric and IsDelphi then
  5316. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5317. if OlderIdentifier<>nil then
  5318. begin
  5319. OlderEl:=OlderIdentifier.Element;
  5320. if (OlderEl.ClassType=TPasEnumValue)
  5321. and (OlderEl.Parent.Parent<>Scope.Element) then
  5322. begin
  5323. // this enum was propagated from a sub type -> remove enum from this scope
  5324. if OlderIdentifier.NextSameIdentifier<>nil then
  5325. RaiseNotYetImplemented(20190807114726,El,GetElementSourcePosStr(OlderEl));
  5326. Scope.RemoveLocalIdentifier(OlderEl);
  5327. OlderIdentifier:=nil;
  5328. OlderEl:=nil;
  5329. end
  5330. else if (El.Visibility=visPublished) and (El is TPasProcedure)
  5331. and (OlderEl is TPasProcedure) then
  5332. // published method bites method in same scope
  5333. RaiseMsg(20190626175432,nDuplicatePublishedMethodXAtY,
  5334. sDuplicatePublishedMethodXAtY,
  5335. [aName,GetElementSourcePosStr(OlderEl)],El)
  5336. else if (Identifier.Kind=pikSimple)
  5337. or (OlderIdentifier.Kind=pikSimple) then
  5338. // duplicate identifier
  5339. RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
  5340. [aName,GetElementSourcePosStr(OlderEl)],El);
  5341. end;
  5342. if (Scope=TopScope) and (Scope is TPasSectionScope) then
  5343. begin
  5344. ParentScope:=Scopes[ScopeCount-2];
  5345. if ParentScope is TPasSectionScope then
  5346. begin
  5347. // check unit interface and implementation duplicates
  5348. OlderIdentifier:=TPasSectionScope(ParentScope).FindLocalIdentifier(aName);
  5349. repeat
  5350. if IsGeneric then
  5351. OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
  5352. if OlderIdentifier=nil then break;
  5353. OlderEl:=OlderIdentifier.Element;
  5354. if (Identifier.Kind=pikNamespace)
  5355. or (OlderIdentifier.Kind=pikNamespace) then
  5356. else if (Identifier.Kind=pikSimple)
  5357. or (OlderIdentifier.Kind=pikSimple) then
  5358. RaiseMsg(20190818141630,nDuplicateIdentifier,sDuplicateIdentifier,
  5359. [aName,GetElementSourcePosStr(OlderEl)],El);
  5360. OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
  5361. until OlderIdentifier=nil;
  5362. end;
  5363. end;
  5364. Result:=Identifier;
  5365. end;
  5366. procedure TPasResolver.FinishModule(CurModule: TPasModule);
  5367. var
  5368. CurModuleClass: TClass;
  5369. i: Integer;
  5370. ModScope: TPasModuleScope;
  5371. begin
  5372. {$IFDEF VerbosePasResolver}
  5373. writeln('TPasResolver.FinishModule START ',CurModule.Name);
  5374. {$ENDIF}
  5375. FStep:=prsFinishingModule;
  5376. CurModuleClass:=CurModule.ClassType;
  5377. ModScope:=CurModule.CustomData as TPasModuleScope;
  5378. if bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches then
  5379. begin
  5380. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  5381. FindRangeErrorConstructors(nil);
  5382. end;
  5383. if (CurModuleClass=TPasProgram) then
  5384. begin
  5385. FinishSection(TPasProgram(CurModule).ProgramSection);
  5386. // resolve begin..end block
  5387. ResolveImplBlock(CurModule.InitializationSection);
  5388. end
  5389. else if (CurModuleClass=TPasLibrary) then
  5390. begin
  5391. FinishSection(TPasLibrary(CurModule).LibrarySection);
  5392. // resolve begin..end block
  5393. ResolveImplBlock(CurModule.InitializationSection);
  5394. end
  5395. else if (CurModuleClass=TPasModule) then
  5396. begin
  5397. // unit
  5398. FinishSection(CurModule.InterfaceSection);
  5399. FinishSection(CurModule.ImplementationSection);
  5400. if CurModule.FinalizationSection<>nil then
  5401. // finalization section finished -> resolve
  5402. ResolveImplBlock(CurModule.FinalizationSection);
  5403. if CurModule.InitializationSection<>nil then
  5404. // initialization section finished -> resolve
  5405. ResolveImplBlock(CurModule.InitializationSection);
  5406. end
  5407. else
  5408. RaiseInternalError(20160922163327); // unknown module
  5409. // check all methods have bodies
  5410. // and all forward classes and pointers are resolved
  5411. for i:=0 to FPendingForwardProcs.Count-1 do
  5412. CheckPendingForwardProcs(TPasElement(FPendingForwardProcs[i]));
  5413. FPendingForwardProcs.Clear;
  5414. // close all sections
  5415. while (TopScope<>nil) and (TopScope.ClassType=ScopeClass_Section) do
  5416. PopScope;
  5417. CheckTopScope(FScopeClass_Module);
  5418. PopScope;
  5419. FStep:=prsFinishedModule;
  5420. if (CurrentParser<>nil) and (CurrentParser.Scanner<>nil) then
  5421. begin
  5422. CurrentParser.NextToken;
  5423. if CurrentParser.Scanner.CurToken<>tkEOF then
  5424. LogMsg(20180628131456,mtHint,nTextAfterFinalIgnored,sTextAfterFinalIgnored,
  5425. [],nil);
  5426. end;
  5427. {$IFDEF VerbosePasResolver}
  5428. writeln('TPasResolver.FinishModule END ',CurModule.Name);
  5429. {$ENDIF}
  5430. end;
  5431. procedure TPasResolver.FinishUsesClause;
  5432. var
  5433. Section: TPasSection;
  5434. i, j: Integer;
  5435. PublicEl, UseModule: TPasElement;
  5436. Scope: TPasSectionScope;
  5437. UsesScope: TPasSectionScope;
  5438. UseUnit: TPasUsesUnit;
  5439. FirstName: String;
  5440. p: SizeInt;
  5441. OldIdentifier: TPasIdentifier;
  5442. IntfHelpers: TPRHelperEntryArray;
  5443. begin
  5444. CheckTopScope(ScopeClass_Section);
  5445. Scope:=TPasSectionScope(TopScope);
  5446. Section:=TPasSection(Scope.Element);
  5447. {$IFDEF VerbosePasResolver}
  5448. writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
  5449. {$ENDIF}
  5450. if Scope.UsesFinished then
  5451. RaiseInternalError(20180305145220);
  5452. Scope.UsesFinished:=true;
  5453. for i:=0 to Section.UsesList.Count-1 do
  5454. begin
  5455. UseUnit:=Section.UsesClause[i];
  5456. {$IFDEF VerbosePasResolver}
  5457. writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
  5458. {$ENDIF}
  5459. UseModule:=UseUnit.Module;
  5460. // check used unit
  5461. PublicEl:=nil;
  5462. if (UseModule.ClassType=TPasLibrary) then
  5463. PublicEl:=TPasLibrary(UseModule).LibrarySection
  5464. else if (UseModule.ClassType=TPasModule) then
  5465. PublicEl:=TPasModule(UseModule).InterfaceSection
  5466. else
  5467. RaiseXExpectedButYFound(20170503004803,'unit',GetElementTypeName(UseModule),UseUnit);
  5468. if PublicEl=nil then
  5469. RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
  5470. if PublicEl.CustomData=nil then
  5471. RaiseInternalError(20160922163358,'uses element has no resolver data: '
  5472. +UseUnit.Name+'->'+GetObjName(PublicEl));
  5473. if not (PublicEl.CustomData is TPasSectionScope) then
  5474. RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
  5475. +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
  5476. UsesScope:=TPasSectionScope(PublicEl.CustomData);
  5477. // add full uses name
  5478. AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
  5479. // add scope
  5480. {$IFDEF VerbosePasResolver}
  5481. writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
  5482. {$ENDIF}
  5483. Scope.UsesScopes.Add(UsesScope);
  5484. // add helpers
  5485. IntfHelpers:=UsesScope.Helpers;
  5486. for j:=0 to length(IntfHelpers)-1 do
  5487. AddActiveHelper(TPRHelperEntry(IntfHelpers[j]).Helper);
  5488. EmitElementHints(Section,UseUnit);
  5489. end;
  5490. // Add first name of dotted unitname (top level subnamespace) as identifier
  5491. for i:=Section.UsesList.Count-1 downto 0 do
  5492. begin
  5493. UseUnit:=Section.UsesClause[i];
  5494. FirstName:=UseUnit.Name;
  5495. p:=Pos('.',FirstName);
  5496. if p<1 then continue;
  5497. FirstName:=LeftStr(FirstName,p-1);
  5498. OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
  5499. if (OldIdentifier=nil) then
  5500. AddIdentifier(Scope,FirstName,UseUnit,pikNamespace);
  5501. end;
  5502. // Note: a sub identifier (e.g. a class member) hides all unitnames starting
  5503. // with this identifier
  5504. end;
  5505. procedure TPasResolver.FinishSection(Section: TPasSection);
  5506. // Note: can be called multiple times for a section
  5507. var
  5508. Scope: TPasSectionScope;
  5509. begin
  5510. Scope:=Section.CustomData as TPasSectionScope;
  5511. if Scope.Finished then exit;
  5512. Scope.Finished:=true;
  5513. if Section is TInterfaceSection then
  5514. FinishInterfaceSection(Section);
  5515. end;
  5516. procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
  5517. begin
  5518. {$IFDEF VerboseUnitQueue}
  5519. writeln('TPasResolver.FinishInterfaceSection ',GetObjName(RootElement));
  5520. {$ENDIF}
  5521. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  5522. if not IsUnitIntfFinished(Section.GetModule) then
  5523. RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+RootElement.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
  5524. {$ENDIF}
  5525. inc(Hub.FinishedInterfaceCount);
  5526. FFinishedInterfaceIndex:=Hub.FinishedInterfaceCount;
  5527. NotifyPendingUsedInterfaces;
  5528. if Section=nil then ;
  5529. end;
  5530. procedure TPasResolver.FinishTypeSection(El: TPasElement);
  5531. procedure FinishDeclarations(El: TPasDeclarations);
  5532. var
  5533. i: Integer;
  5534. Decl: TPasElement;
  5535. begin
  5536. for i:=0 to El.Declarations.Count-1 do
  5537. begin
  5538. Decl:=TPasElement(El.Declarations[i]);
  5539. if Decl is TPasType then
  5540. FinishTypeSectionEl(TPasType(Decl));
  5541. end;
  5542. end;
  5543. procedure FinishMembersType(El: TPasMembersType);
  5544. var
  5545. i: Integer;
  5546. Decl: TPasElement;
  5547. begin
  5548. for i:=0 to El.Members.Count-1 do
  5549. begin
  5550. Decl:=TPasElement(El.Members[i]);
  5551. if Decl is TPasType then
  5552. FinishTypeSectionEl(TPasType(Decl));
  5553. end;
  5554. end;
  5555. begin
  5556. // resolve pending forwards
  5557. if El is TPasDeclarations then
  5558. FinishDeclarations(TPasDeclarations(El))
  5559. else if El is TPasMembersType then
  5560. FinishMembersType(TPasMembersType(El))
  5561. else
  5562. RaiseNotYetImplemented(20181226105933,El);
  5563. end;
  5564. procedure TPasResolver.FinishTypeSectionEl(El: TPasType);
  5565. function ReplaceDestType(Decl: TPasType; var DestType: TPasType;
  5566. const DestName: string; MustExist: boolean; ErrorEl: TPasElement
  5567. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF}): boolean;
  5568. // returns true if replaces
  5569. var
  5570. Abort: boolean;
  5571. Data: TPRFindData;
  5572. OldDestType: TPasType;
  5573. begin
  5574. Abort:=false;
  5575. Data:=Default(TPRFindData);
  5576. Data.ErrorPosEl:=ErrorEl;
  5577. (TopScope as TPasIdentifierScope).IterateElements(DestName,
  5578. TopScope,@OnFindFirst,@Data,Abort);
  5579. //writeln('ReplaceDestType ',GetObjName(El),' DestType=',GetObjName(DestType),' DestType.Parent=',GetObjName(DestType.Parent),' RefCount=',DestType.RefCount);
  5580. if Data.Found=nil then
  5581. if MustExist then
  5582. begin
  5583. RaiseIdentifierNotFound(20170216151543,DestName,ErrorEl);
  5584. end
  5585. else
  5586. exit(false);
  5587. if Data.Found=DestType then exit;
  5588. if Decl is TPasClassOfType then
  5589. begin
  5590. if (Data.Found.ClassType<>TPasClassType)
  5591. or (TPasClassType(Data.Found).ObjKind<>okClass) then
  5592. RaiseXExpectedButYFound(20170216151548,'class',GetElementTypeName(Data.Found),ErrorEl);
  5593. end;
  5594. // replace unresolved
  5595. OldDestType:=DestType;
  5596. DestType:=TPasType(Data.Found);
  5597. DestType.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5598. OldDestType.Release{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  5599. CheckUseAsType(DestType,20190123100649,El);
  5600. // check cycles
  5601. if Decl is TPasPointerType then
  5602. CheckPointerCycle(TPasPointerType(Decl));
  5603. Result:=true;
  5604. end;
  5605. var
  5606. C: TClass;
  5607. ClassOfEl: TPasClassOfType;
  5608. TypeEl: TPasType;
  5609. UnresolvedEl: TUnresolvedPendingRef;
  5610. OldClassType: TPasClassType;
  5611. PtrType: TPasPointerType;
  5612. begin
  5613. C:=El.ClassType;
  5614. if C=TPasClassType then
  5615. begin
  5616. if TPasClassType(El).IsForward
  5617. and not (TPasClassType(El).CustomData is TResolvedReference) then
  5618. RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[El.Name],El);
  5619. end
  5620. else if (C=TPasClassOfType) then
  5621. begin
  5622. ClassOfEl:=TPasClassOfType(El);
  5623. TypeEl:=ResolveAliasType(ClassOfEl.DestType);
  5624. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5625. begin
  5626. // forward class-of -> resolve now
  5627. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5628. {$IFDEF VerbosePasResolver}
  5629. writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',TypeEl.Name,'"');
  5630. {$ENDIF}
  5631. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,TypeEl.Name,true,UnresolvedEl
  5632. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5633. end
  5634. else if TypeEl.ClassType=TPasClassType then
  5635. begin
  5636. // class-of has found a type
  5637. // another later in the same type section has priority -> check
  5638. OldClassType:=TypeEl as TPasClassType;
  5639. if OldClassType.Parent=ClassOfEl.Parent then
  5640. exit; // class in same type section -> ok
  5641. // class not in same type section -> check
  5642. {$IFDEF VerbosePasResolver}
  5643. writeln('TPasResolver.FinishTypeSection improving "',ClassOfEl.Name,'" = class of resolved "',TypeEl.Name,'"');
  5644. {$ENDIF}
  5645. ReplaceDestType(ClassOfEl,ClassOfEl.DestType,ClassOfEl.DestType.Name,false,ClassOfEl
  5646. {$IFDEF CheckPasTreeRefCount},'TPasAliasType.DestType'{$ENDIF});
  5647. end;
  5648. end
  5649. else if C=TPasPointerType then
  5650. begin
  5651. PtrType:=TPasPointerType(El);
  5652. TypeEl:=ResolveAliasType(PtrType.DestType);
  5653. if (TypeEl.ClassType=TUnresolvedPendingRef) then
  5654. begin
  5655. // forward pointer -> resolve now
  5656. UnresolvedEl:=TUnresolvedPendingRef(TypeEl);
  5657. {$IFDEF VerbosePasResolver}
  5658. writeln('TPasResolver.FinishTypeSection resolving "',PtrType.Name,'" = pointer of unresolved "',TypeEl.Name,'"');
  5659. {$ENDIF}
  5660. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,true,UnresolvedEl
  5661. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5662. end
  5663. else
  5664. begin
  5665. // pointer-of has found a type
  5666. // another later in the same type section has priority -> check
  5667. if TypeEl.Parent=PtrType.Parent then
  5668. exit; // class in same type section -> ok
  5669. // dest not in same type section -> check
  5670. {$IFDEF VerbosePasResolver}
  5671. writeln('TPasResolver.FinishTypeSection improving "',PtrType.Name,'" = pointer of resolved "',TypeEl.Name,'"');
  5672. {$ENDIF}
  5673. ReplaceDestType(PtrType,PtrType.DestType,TypeEl.Name,false,PtrType
  5674. {$IFDEF CheckPasTreeRefCount},'TPasPointerType.DestType'{$ENDIF});
  5675. end;
  5676. end;
  5677. end;
  5678. procedure TPasResolver.FinishTypeDef(El: TPasType);
  5679. var
  5680. C: TClass;
  5681. begin
  5682. {$IFDEF VerbosePasResolver}
  5683. //writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
  5684. {$ENDIF}
  5685. C:=El.ClassType;
  5686. if C=TPasEnumType then
  5687. FinishEnumType(TPasEnumType(El))
  5688. else if C=TPasSetType then
  5689. FinishSetType(TPasSetType(El))
  5690. else if C=TPasRangeType then
  5691. FinishRangeType(TPasRangeType(El))
  5692. else if C=TPasRecordType then
  5693. FinishRecordType(TPasRecordType(El))
  5694. else if C=TPasClassType then
  5695. FinishClassType(TPasClassType(El))
  5696. else if C=TPasClassOfType then
  5697. FinishClassOfType(TPasClassOfType(El))
  5698. else if C=TPasPointerType then
  5699. FinishPointerType(TPasPointerType(El))
  5700. else if C=TPasArrayType then
  5701. FinishArrayType(TPasArrayType(El))
  5702. else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  5703. FinishAliasType(TPasAliasType(El))
  5704. else if (C=TPasPointerType) then
  5705. EmitTypeHints(El,TPasPointerType(El).DestType)
  5706. else if C=TPasGenericTemplateType then
  5707. FinishGenericTemplateType(TPasGenericTemplateType(El))
  5708. else if C=TPasSpecializeType then
  5709. FinishSpecializeType(TPasSpecializeType(El));
  5710. end;
  5711. procedure TPasResolver.FinishEnumType(El: TPasEnumType);
  5712. begin
  5713. if TopScope.Element=El then
  5714. PopScope;
  5715. end;
  5716. procedure TPasResolver.FinishSetType(El: TPasSetType);
  5717. function GetEnumTypePosEl: TPasElement;
  5718. begin
  5719. Result:=El.EnumType;
  5720. if Result.Parent<>El then
  5721. Result:=El;
  5722. end;
  5723. var
  5724. BaseTypeData: TResElDataBaseType;
  5725. StartResolved, EndResolved: TPasResolverResult;
  5726. RangeExpr: TBinaryExpr;
  5727. C: TClass;
  5728. EnumType: TPasType;
  5729. begin
  5730. EnumType:=ResolveAliasType(El.EnumType);
  5731. C:=EnumType.ClassType;
  5732. if C=TPasEnumType then
  5733. begin
  5734. FinishSubElementType(El,EnumType);
  5735. exit;
  5736. end
  5737. else if C=TPasRangeType then
  5738. begin
  5739. RangeExpr:=TPasRangeType(EnumType).RangeExpr;
  5740. if (RangeExpr.Parent=El) and (RangeExpr.CustomData=nil) then
  5741. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5742. FinishSubElementType(El,EnumType);
  5743. exit;
  5744. end
  5745. else if C=TPasUnresolvedSymbolRef then
  5746. begin
  5747. if EnumType.CustomData is TResElDataBaseType then
  5748. begin
  5749. BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
  5750. if BaseTypeData.BaseType in (btAllChars+[btBoolean,btByte]) then
  5751. exit;
  5752. RaiseXExpectedButYFound(20170216151553,'char or boolean',
  5753. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5754. end;
  5755. end;
  5756. RaiseXExpectedButYFound(20170216151557,'enum type',
  5757. GetElementTypeName(EnumType),GetEnumTypePosEl);
  5758. end;
  5759. procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
  5760. var
  5761. Decl: TPasDeclarations;
  5762. EnumScope: TPasEnumTypeScope;
  5763. begin
  5764. EmitTypeHints(Parent,El);
  5765. if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
  5766. if Parent.Name='' then
  5767. RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5768. if not (Parent.Parent is TPasDeclarations) then
  5769. RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[GetElementTypeName(El)],El);
  5770. if El.Parent<>Parent then
  5771. RaiseNotYetImplemented(20190215085011,Parent);
  5772. // give anonymous sub type a name
  5773. El.Name:=Parent.Name+AnonymousElTypePostfix;
  5774. {$IFDEF VerbosePasResolver}
  5775. writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
  5776. {$ENDIF}
  5777. Decl:=TPasDeclarations(Parent.Parent);
  5778. Decl.Declarations.Add(El);
  5779. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Declarations'){$ENDIF};
  5780. El.Parent:=Decl;
  5781. Decl.Types.Add(El);
  5782. if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
  5783. begin
  5784. // anonymous enumtype
  5785. EnumScope:=TPasEnumTypeScope(El.CustomData);
  5786. if EnumScope.CanonicalSet<>Parent then
  5787. begin
  5788. // When a TPasEnumType is created a CanonicalSet is created.
  5789. // Release the autocreated CanonicalSet and use the parent.
  5790. if EnumScope.CanonicalSet<>nil then
  5791. EnumScope.CanonicalSet.Release{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5792. EnumScope.CanonicalSet:=TPasSetType(Parent);
  5793. Parent.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  5794. end;
  5795. end;
  5796. end;
  5797. procedure TPasResolver.FinishRangeType(El: TPasRangeType);
  5798. var
  5799. RangeExpr: TBinaryExpr;
  5800. StartResolved, EndResolved: TPasResolverResult;
  5801. begin
  5802. RangeExpr:=El.RangeExpr;
  5803. ResolveExpr(RangeExpr.left,rraRead);
  5804. ResolveExpr(RangeExpr.right,rraRead);
  5805. FinishConstRangeExpr(RangeExpr,StartResolved,EndResolved);
  5806. end;
  5807. procedure TPasResolver.FinishConstRangeExpr(RangeExpr: TBinaryExpr; out
  5808. LeftResolved, RightResolved: TPasResolverResult);
  5809. // for example Left..Right
  5810. var
  5811. RgValue: TResEvalValue;
  5812. Left, Right: TPasExpr;
  5813. begin
  5814. Left:=RangeExpr.left;
  5815. Right:=RangeExpr.right;
  5816. {$IFDEF VerbosePasResEval}
  5817. writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
  5818. {$ENDIF}
  5819. // check type compatibility
  5820. ComputeElement(Left,LeftResolved,[rcConstant]);
  5821. ComputeElement(Right,RightResolved,[rcConstant]);
  5822. CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
  5823. RgValue:=Eval(RangeExpr,[refConst]);
  5824. ReleaseEvalValue(RgValue);
  5825. end;
  5826. procedure TPasResolver.FinishRecordType(El: TPasRecordType);
  5827. var
  5828. Scope: TPasRecordScope;
  5829. begin
  5830. if TopScope.Element<>El then
  5831. RaiseNotYetImplemented(20190801232042,El);
  5832. PopScope;
  5833. Scope:=El.CustomData as TPasRecordScope;
  5834. FinishSpecializedClassOrRecIntf(Scope);
  5835. end;
  5836. procedure TPasResolver.FinishClassType(El: TPasClassType);
  5837. type
  5838. TMethResolution = record
  5839. InterfaceIndex: integer;
  5840. ProcClassType: TPasProcedureClass;
  5841. InterfaceName: string;
  5842. ImplementName: string;
  5843. ResolutionEl: TPasMethodResolution;
  5844. Count: integer; // needed to check if method resolution is used
  5845. end;
  5846. var
  5847. ClassScope: TPasClassScope;
  5848. i, j, k: Integer;
  5849. IntfType: TPasClassType;
  5850. Resolutions: array of TMethResolution;
  5851. Map: TPasClassIntfMap;
  5852. o: TObject;
  5853. Member, Parent: TPasElement;
  5854. IntfProc: TPasProcedure;
  5855. FindData: TFindProcData;
  5856. Abort: boolean;
  5857. MethRes: TPasMethodResolution;
  5858. ResolvedEl: TPasResolverResult;
  5859. ProcName, IntfProcName: String;
  5860. Expr: TPasExpr;
  5861. SectionScope: TPasSectionScope;
  5862. begin
  5863. Resolutions:=nil;
  5864. ClassScope:=nil;
  5865. if not El.IsForward then
  5866. begin
  5867. if TopScope.Element<>El then
  5868. RaiseInternalError(20180322142534,GetObjName(El)+'<>'+GetObjName(TopScope.Element));
  5869. ClassScope:=El.CustomData as TPasClassScope;
  5870. if ClassScope=nil then
  5871. RaiseNotYetImplemented(20190803204709,El);
  5872. if El.ObjKind=okClass then
  5873. begin
  5874. if (El.Interfaces.Count>0) then
  5875. begin
  5876. if (ClassScope.Interfaces=nil) then
  5877. RaiseInternalError(20180408162725,'');
  5878. if (ClassScope.Interfaces.Count<>El.Interfaces.Count) then
  5879. RaiseInternalError(20180408162746,'');
  5880. end
  5881. else if ClassScope.Interfaces<>nil then
  5882. RaiseInternalError(20180408162803,'');
  5883. // check explicit method resolutions, e.g. procedure intf.intfproc = implproc
  5884. for i:=0 to El.Members.Count-1 do
  5885. begin
  5886. Member:=TPasElement(El.Members[i]);
  5887. if not (Member is TPasMethodResolution) then continue;
  5888. MethRes:=TPasMethodResolution(Member);
  5889. // get interface
  5890. ComputeElement(MethRes.InterfaceName,ResolvedEl,[rcNoImplicitProc]);
  5891. if not (ResolvedEl.IdentEl is TPasType) then
  5892. RaiseInternalError(20180323135729,GetResolverResultDbg(ResolvedEl));
  5893. j:=El.Interfaces.IndexOf(ResolvedEl.IdentEl);
  5894. if j<0 then
  5895. RaiseInternalError(20180323135900,GetResolverResultDbg(ResolvedEl));
  5896. // get class-interface-map, check delegations
  5897. o:=TObject(ClassScope.Interfaces[j]);
  5898. if o is TPasProperty then
  5899. RaiseMsg(20180323140046,nCannotMixMethodResolutionAndDelegationAtX,
  5900. sCannotMixMethodResolutionAndDelegationAtX,
  5901. [GetElementSourcePosStr(TPasProperty(o))],MethRes.InterfaceName);
  5902. if o=nil then
  5903. o:=CreateClassIntfMap(El,j);
  5904. Map:=TPasClassIntfMap(o);
  5905. // get interface proc name
  5906. Expr:=MethRes.InterfaceProc;
  5907. if not (Expr is TPrimitiveExpr) then
  5908. RaiseXExpectedButYFound(20180327162230,'method name',GetElementTypeName(Expr),Expr);
  5909. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5910. RaiseXExpectedButYFound(20180327162236,'method name',GetElementTypeName(Expr),Expr);
  5911. IntfProcName:=TPrimitiveExpr(Expr).Value;
  5912. // get implementation proc name
  5913. Expr:=MethRes.ImplementationProc;
  5914. if not (Expr is TPrimitiveExpr) then
  5915. RaiseXExpectedButYFound(20180327152115,'method name',GetElementTypeName(Expr),Expr);
  5916. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  5917. RaiseXExpectedButYFound(20180327152157,'method name',GetElementTypeName(Expr),Expr);
  5918. ProcName:=TPrimitiveExpr(Expr).Value;
  5919. for k:=0 to length(Resolutions)-1 do
  5920. with Resolutions[k] do
  5921. if (InterfaceIndex=j) and (ProcClassType=MethRes.ProcClass)
  5922. and (InterfaceName=IntfProcName) then
  5923. RaiseMsg(20180327164626,nDuplicateIdentifier,sDuplicateIdentifier,
  5924. [GetElementTypeName(ProcClassType)+' '+Map.Intf.Name+'.'+InterfaceName,
  5925. GetElementSourcePosStr(ResolutionEl)],MethRes.InterfaceProc);
  5926. // add resolution
  5927. k:=length(Resolutions);
  5928. SetLength(Resolutions,k+1);
  5929. with Resolutions[k] do
  5930. begin
  5931. InterfaceIndex:=j;
  5932. ProcClassType:=MethRes.ProcClass;
  5933. InterfaceName:=IntfProcName;
  5934. ImplementName:=ProcName;
  5935. ResolutionEl:=MethRes;
  5936. Count:=0;
  5937. end;
  5938. end;
  5939. // method resolution
  5940. for i:=0 to El.Interfaces.Count-1 do
  5941. begin
  5942. o:=TObject(ClassScope.Interfaces[i]);
  5943. //writeln('TPasResolver.FinishClassType class=',GetObjName(El),' i=',i,' Intf=',GetObjName(TObject(El.Interfaces[i])),' Map=',GetObjName(o));
  5944. if o is TPasProperty then
  5945. continue; // interface implemented via a property
  5946. if o=nil then
  5947. o:=CreateClassIntfMap(El,i);
  5948. Map:=TPasClassIntfMap(o);
  5949. while Map<>nil do
  5950. begin
  5951. IntfType:=Map.Intf;
  5952. //writeln('TPasResolver.FinishClassType ',GetObjName(Map),' ',GetObjName(IntfType),' Count=',IntfType.Members.Count);
  5953. for j:=0 to IntfType.Members.Count-1 do
  5954. begin
  5955. Member:=TPasElement(IntfType.Members[j]);
  5956. if not (Member is TPasProcedure) then continue;
  5957. IntfProc:=TPasProcedure(Member);
  5958. ProcName:=IntfProc.Name;
  5959. // check resolutions
  5960. for k:=0 to length(Resolutions)-1 do
  5961. with Resolutions[k] do
  5962. begin
  5963. if (InterfaceIndex=i) and (ProcClassType=IntfProc.ClassType)
  5964. and SameText(InterfaceName,IntfProc.Name) then
  5965. begin
  5966. ProcName:=ImplementName;
  5967. inc(Count);
  5968. end;
  5969. end;
  5970. // search interface method in class
  5971. FindData:=Default(TFindProcData);
  5972. FindData.Proc:=IntfProc;
  5973. FindData.Args:=IntfProc.ProcType.Args;
  5974. FindData.Kind:=fpkProcDeclaration;
  5975. Abort:=false;
  5976. IterateElements(ProcName,@OnFindProcDeclaration,@FindData,Abort);
  5977. if FindData.Found=nil then
  5978. RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
  5979. sNoMatchingImplForIntfMethodXFound,
  5980. [GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
  5981. Map.Procs[j]:=FindData.Found;
  5982. end;
  5983. Map:=Map.AncestorMap;
  5984. end;
  5985. end;
  5986. // ToDo: hint if method resolution is not used
  5987. end;
  5988. if El.ObjKind in okAllHelpers then
  5989. begin
  5990. // activate helper
  5991. AddActiveHelper(El);
  5992. // cache helpers in interface, so other modules don't have to search
  5993. Parent:=El.Parent;
  5994. while Parent<>nil do
  5995. begin
  5996. if Parent.ClassType=TInterfaceSection then
  5997. begin
  5998. SectionScope:=Parent.CustomData as TPasSectionScope;
  5999. AddHelper(El,SectionScope.Helpers);
  6000. break;
  6001. end;
  6002. Parent:=Parent.Parent;
  6003. end;
  6004. end;
  6005. end;
  6006. if TopScope.Element=El then
  6007. PopScope // pop TPasClassScope
  6008. else
  6009. ; // e.g. class forward
  6010. if TopScope is TPasGenericParamsScope then
  6011. PopGenericParamScope(El);
  6012. if not El.IsForward then
  6013. FinishSpecializedClassOrRecIntf(ClassScope);
  6014. end;
  6015. procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
  6016. var
  6017. TypeEl: TPasType;
  6018. begin
  6019. TypeEl:=ResolveAliasType(El.DestType);
  6020. if TypeEl is TUnresolvedPendingRef then
  6021. begin
  6022. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  6023. exit;
  6024. end;
  6025. if (TypeEl is TPasClassType) and (TPasClassType(TypeEl).ObjKind=okClass) then exit;
  6026. RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  6027. [El.DestType.Name,'class'],El);
  6028. end;
  6029. procedure TPasResolver.FinishPointerType(El: TPasPointerType);
  6030. var
  6031. TypeEl: TPasType;
  6032. begin
  6033. TypeEl:=ResolveAliasType(El.DestType);
  6034. if TypeEl is TUnresolvedPendingRef then
  6035. begin
  6036. TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  6037. exit;
  6038. end;
  6039. if El.DestType.Parent=El then
  6040. RaiseMsg(20180429094237,nNotYetImplemented,sNotYetImplemented,['pointer of anonymous type'], El.DestType);
  6041. CheckUseAsType(El.DestType,20190123095118,El);
  6042. CheckPointerCycle(El);
  6043. end;
  6044. procedure TPasResolver.FinishArrayType(El: TPasArrayType);
  6045. var
  6046. i: Integer;
  6047. Expr: TPasExpr;
  6048. RangeResolved: TPasResolverResult;
  6049. TypeEl: TPasType;
  6050. Parent: TPasArrayType;
  6051. Scope: TPasArrayScope;
  6052. begin
  6053. // check cycles
  6054. Parent:=El;
  6055. repeat
  6056. if Parent=El.ElType then
  6057. RaiseMsg(20190807104630,nIllegalExpression,sIllegalExpression,[],El);
  6058. if Parent.Parent is TPasArrayType then
  6059. Parent:=TPasArrayType(Parent.Parent)
  6060. else
  6061. break;
  6062. until false;
  6063. for i:=0 to length(El.Ranges)-1 do
  6064. begin
  6065. Expr:=El.Ranges[i];
  6066. ResolveExpr(Expr,rraRead);
  6067. ComputeElement(Expr,RangeResolved,[rcConstant]);
  6068. if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
  6069. begin
  6070. {$IFDEF VerbosePasResolver}
  6071. writeln('TPasResolver.FinishArrayType ',GetResolverResultDbg(RangeResolved));
  6072. {$ENDIF}
  6073. RaiseXExpectedButYFound(20170216151607,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6074. end;
  6075. if (RangeResolved.BaseType=btRange) then
  6076. begin
  6077. if (RangeResolved.SubType in btArrayRangeTypes) then
  6078. // range, e.g. 1..2
  6079. else if RangeResolved.SubType=btContext then
  6080. begin
  6081. TypeEl:=RangeResolved.LoTypeEl;
  6082. if TypeEl is TPasRangeType then
  6083. // custom range
  6084. else if TypeEl is TPasEnumType then
  6085. // anonymous enum range
  6086. else
  6087. RaiseXExpectedButYFound(20171009193629,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6088. end
  6089. else
  6090. RaiseXExpectedButYFound(20171009193514,'range',GetElementTypeName(RangeResolved.IdentEl),Expr);
  6091. end
  6092. else if RangeResolved.BaseType in btArrayRangeTypes then
  6093. // full range, e.g. array[char]
  6094. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasEnumType) then
  6095. // e.g. array[enumtype]
  6096. else if (RangeResolved.BaseType=btContext) and (RangeResolved.LoTypeEl is TPasGenericTemplateType) then
  6097. // e.g. Tarr<T> = array[T] of ...
  6098. else if RangeResolved.IdentEl<>nil then
  6099. RaiseXExpectedButYFound(20170216151609,'range',GetElementTypeName(RangeResolved.IdentEl),Expr)
  6100. else
  6101. RaiseXExpectedButYFound(20190830215123,'range',GetResolverResultDescription(RangeResolved),Expr);
  6102. end;
  6103. if El.ElType=nil then
  6104. begin
  6105. // array of const
  6106. if length(El.Ranges)>0 then
  6107. RaiseNotYetImplemented(20190215102529,El);
  6108. FindTVarRec(El);
  6109. end
  6110. else
  6111. begin
  6112. CheckUseAsType(El.ElType,20190123095401,El);
  6113. FinishSubElementType(El,El.ElType);
  6114. end;
  6115. if El.CustomData is TPasArrayScope then
  6116. begin
  6117. Scope:=TPasArrayScope(El.CustomData);
  6118. Scope.GenericStep:=psgsImplementationParsed;
  6119. end;
  6120. if TopScope.Element=El then
  6121. PopScope;
  6122. end;
  6123. procedure TPasResolver.FinishAliasType(El: TPasAliasType);
  6124. var
  6125. aType: TPasType;
  6126. begin
  6127. aType:=ResolveAliasType(El);
  6128. if (aType is TPasMembersType) and (aType.CustomData=nil) then
  6129. exit;
  6130. if (aType is TPasGenericType)
  6131. and (GetTypeParameterCount(TPasGenericType(aType))>0) then
  6132. RaiseMsg(20190818135830,nXExpectedButYFound,sXExpectedButYFound,
  6133. ['type',GetTypeDescription(aType)],El);
  6134. EmitTypeHints(El,TPasAliasType(El).DestType);
  6135. end;
  6136. procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
  6137. var
  6138. ConEl: TPasElement;
  6139. procedure RaiseCannotBeTogether(const Id: TMaxPrecInt; const X,Y: string);
  6140. begin
  6141. RaiseMsg(Id,nConstraintXAndConstraintYCannotBeTogether,
  6142. sConstraintXAndConstraintYCannotBeTogether,[X,Y],
  6143. GetGenericConstraintErrorEl(ConEl,El));
  6144. end;
  6145. procedure RaiseXIsNotAValidConstraint(const Id: TMaxPrecInt; const X: string);
  6146. begin
  6147. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[X],
  6148. GetGenericConstraintErrorEl(ConEl,El));
  6149. end;
  6150. var
  6151. i: Integer;
  6152. IsClass, IsRecord, IsConstructor: Boolean;
  6153. LastType: TPasType;
  6154. MemberType: TPasMembersType;
  6155. aClass: TPasClassType;
  6156. ConToken: TToken;
  6157. ResolvedEl: TPasResolverResult;
  6158. begin
  6159. {$IFDEF VerbosePasResolver}
  6160. writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
  6161. {$ENDIF}
  6162. IsClass:=false;
  6163. IsRecord:=false;
  6164. IsConstructor:=false;
  6165. LastType:=nil;
  6166. for i:=0 to length(El.Constraints)-1 do
  6167. begin
  6168. ConEl:=El.Constraints[i];
  6169. ConToken:=GetGenericConstraintKeyword(ConEl);
  6170. case ConToken of
  6171. tkclass:
  6172. begin
  6173. if IsClass then
  6174. RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
  6175. sConstraintXSpecifiedMoreThanOnce,['class'],ConEl);
  6176. if IsRecord then
  6177. RaiseCannotBeTogether(20190720202516,'record','class');
  6178. if LastType<>nil then
  6179. RaiseCannotBeTogether(20190720205708,LastType.Name,'class');
  6180. IsClass:=true;
  6181. end;
  6182. tkrecord:
  6183. begin
  6184. if IsRecord then
  6185. RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
  6186. sConstraintXSpecifiedMoreThanOnce,['record'],ConEl);
  6187. if IsClass then
  6188. RaiseCannotBeTogether(20190720203039,'class','record');
  6189. if IsConstructor then
  6190. RaiseCannotBeTogether(20190720203056,'constructor','record');
  6191. if LastType<>nil then
  6192. RaiseCannotBeTogether(20190720205938,LastType.Name,'record');
  6193. IsRecord:=true;
  6194. end;
  6195. tkconstructor:
  6196. begin
  6197. if IsConstructor then
  6198. RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
  6199. sConstraintXSpecifiedMoreThanOnce,['constructor'],ConEl);
  6200. if IsRecord then
  6201. RaiseCannotBeTogether(20190720203148,'record','constructor');
  6202. if LastType<>nil then
  6203. RaiseCannotBeTogether(20190720210005,LastType.Name,'constructor');
  6204. IsConstructor:=true;
  6205. end;
  6206. else
  6207. if not (ConEl is TPasType) then
  6208. RaiseXIsNotAValidConstraint(20190912215619,GetElementTypeName(ConEl));
  6209. // type identifier: class, record or interface
  6210. ComputeElement(ConEl,ResolvedEl,[rcType]);
  6211. if ResolvedEl.BaseType<>btContext then
  6212. RaiseXIsNotAValidConstraint(20190914105144,GetElementTypeName(ConEl));
  6213. if IsRecord then
  6214. RaiseCannotBeTogether(20190720210130,'record',ResolvedEl.HiTypeEl.Name);
  6215. if IsClass then
  6216. RaiseCannotBeTogether(20190720210202,'class',ResolvedEl.HiTypeEl.Name);
  6217. if IsConstructor then
  6218. RaiseCannotBeTogether(20190720210244,'constructor',ResolvedEl.HiTypeEl.Name);
  6219. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  6220. begin
  6221. if ResolvedEl.LoTypeEl=El then
  6222. RaiseMsg(20200820185313,nTypeCycleFound,sTypeCycleFound,[],
  6223. GetGenericConstraintErrorEl(ConEl,El));
  6224. // ok
  6225. if length(El.Constraints)>1 then
  6226. RaiseXIsNotAValidConstraint(20190831213645,ResolvedEl.HiTypeEl.Name);
  6227. end
  6228. else if ResolvedEl.LoTypeEl is TPasMembersType then
  6229. begin
  6230. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  6231. if MemberType is TPasClassType then
  6232. begin
  6233. aClass:=TPasClassType(MemberType);
  6234. case aClass.ObjKind of
  6235. okClass:
  6236. begin
  6237. // there can be at most one classtype constraint
  6238. if LastType<>nil then
  6239. RaiseCannotBeTogether(20190720210351,LastType.Name,MemberType.Name);
  6240. end;
  6241. okInterface:
  6242. begin
  6243. if LastType<>nil then
  6244. begin
  6245. // there can be multiple interfacetype constraint
  6246. if not (LastType is TPasClassType) then
  6247. RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name);
  6248. if TPasClassType(LastType).ObjKind<>okInterface then
  6249. RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name);
  6250. end;
  6251. end;
  6252. else
  6253. RaiseXIsNotAValidConstraint(20190720210919,MemberType.Name);
  6254. end;
  6255. end
  6256. else
  6257. RaiseXIsNotAValidConstraint(20190720210809,MemberType.Name);
  6258. end
  6259. else
  6260. RaiseXIsNotAValidConstraint(20190720204604,GetResolverResultDescription(ResolvedEl,true));
  6261. LastType:=ResolvedEl.LoTypeEl;
  6262. end; // end of case
  6263. end; // end of for
  6264. end;
  6265. procedure TPasResolver.FinishSpecializeType(El: TPasSpecializeType);
  6266. var
  6267. Params, GenericTemplateList: TFPList;
  6268. P: TPasElement;
  6269. DestType: TPasType;
  6270. i, ScopeDepth: Integer;
  6271. GenType: TPasGenericType;
  6272. begin
  6273. {$IFDEF VerbosePasResolver}
  6274. //writeln('TPasResolver.FinishSpecializeType ');
  6275. {$ENDIF}
  6276. // resolve Params
  6277. ScopeDepth:=StashSubExprScopes;
  6278. Params:=El.Params;
  6279. if Params.Count=0 then
  6280. RaiseMsg(20190724114416,nMissingParameterX,sMissingParameterX,['type'],El);
  6281. for i:=0 to Params.Count-1 do
  6282. begin
  6283. P:=TPasElement(Params[i]);
  6284. if P is TPasExpr then
  6285. ResolveExpr(TPasExpr(P),rraRead)
  6286. else if P is TPasType then
  6287. else
  6288. RaiseMsg(20190728113336,nXExpectedButYFound,sXExpectedButYFound,['type identifier',GetObjName(P)+' parameter '+IntToStr(i+1)],El);
  6289. end;
  6290. RestoreStashedScopes(ScopeDepth);
  6291. // check DestType
  6292. DestType:=El.DestType;
  6293. if DestType=nil then
  6294. RaiseMsg(20190725184734,nIdentifierNotFound,sIdentifierNotFound,['specialize type'],El)
  6295. else if not (DestType is TPasGenericType) then
  6296. RaiseMsg(20190725193552,nXExpectedButYFound,sXExpectedButYFound,['generic type',DestType.Name],El);
  6297. GenType:=TPasGenericType(DestType);
  6298. // Note: there can be TBird, TBird<T> and TBird<T,U>
  6299. GenericTemplateList:=GenType.GenericTemplateTypes;
  6300. if GenericTemplateList=nil then
  6301. RaiseMsg(20190725194222,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6302. ['type '+DestType.Name],El);
  6303. if GenericTemplateList.Count<>Params.Count then
  6304. RaiseMsg(20190801222656,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  6305. ['type '+DestType.Name],El);
  6306. GetSpecializedEl(El,GenType,Params);
  6307. end;
  6308. procedure TPasResolver.FinishResourcestring(El: TPasResString);
  6309. var
  6310. ResolvedEl: TPasResolverResult;
  6311. begin
  6312. ResolveExpr(El.Expr,rraRead);
  6313. ComputeElement(El.Expr,ResolvedEl,[rcConstant]);
  6314. if not (ResolvedEl.BaseType in btAllStringAndChars) then
  6315. RaiseXExpectedButYFound(20171004135753,'string',GetTypeDescription(ResolvedEl),El.Expr);
  6316. end;
  6317. procedure TPasResolver.FinishProcedure(Proc: TPasProcedure);
  6318. var
  6319. i: Integer;
  6320. Body: TProcedureBody;
  6321. SubEl: TPasElement;
  6322. SubProcScope, ProcScope, DeclProcScope: TPasProcedureScope;
  6323. SpecializedItem: TPRSpecializedItem;
  6324. begin
  6325. {$IFDEF VerbosePasResolver}
  6326. writeln('TPasResolver.FinishProcedure START');
  6327. {$ENDIF}
  6328. CheckTopScope(FScopeClass_Proc);
  6329. ProcScope:=TPasProcedureScope(TopScope);
  6330. if ProcScope.Element<>Proc then
  6331. RaiseInternalError(20170220163043);
  6332. SpecializedItem:=ProcScope.SpecializedFromItem;
  6333. if SpecializedItem<>nil then
  6334. begin
  6335. if SpecializedItem.Step<prssImplementationBuilding then
  6336. RaiseNotYetImplemented(20190920184908,Proc);
  6337. if SpecializedItem.Step>prssImplementationBuilding then
  6338. RaiseNotYetImplemented(20190920185123,Proc);
  6339. end;
  6340. Body:=Proc.Body;
  6341. if Body<>nil then
  6342. begin
  6343. StoreScannerFlagsInProc(ProcScope);
  6344. if Body.Body is TPasImplAsmStatement then
  6345. Proc.Modifiers:=Proc.Modifiers+[pmAssembler];
  6346. ResolveImplBlock(Body.Body);
  6347. // check if all nested forward procs are resolved
  6348. for i:=0 to Body.Declarations.Count-1 do
  6349. begin
  6350. SubEl:=TPasElement(Body.Declarations[i]);
  6351. if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
  6352. begin
  6353. SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
  6354. if SubProcScope.ImplProc=nil then
  6355. RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
  6356. [GetElementTypeName(SubEl),SubEl.Name],SubEl);
  6357. end;
  6358. end;
  6359. if ProcScope.GroupScope<>nil then
  6360. begin
  6361. ProcScope.GroupScope.Free;
  6362. ProcScope.GroupScope:=nil;
  6363. if ProcScope.NestedMembersScope<>nil then
  6364. begin
  6365. for i:=0 to ScopeCount-1 do
  6366. if Scopes[i]=ProcScope.NestedMembersScope then
  6367. begin
  6368. DeleteScope(i);
  6369. break;
  6370. end;
  6371. ProcScope.NestedMembersScope.Free;
  6372. ProcScope.NestedMembersScope:=nil;
  6373. end;
  6374. end;
  6375. ProcScope.GenericStep:=psgsImplementationParsed;
  6376. if ProcScope.DeclarationProc<>nil then
  6377. begin
  6378. DeclProcScope:=ProcScope.DeclarationProc.CustomData as TPasProcedureScope;
  6379. DeclProcScope.GenericStep:=psgsImplementationParsed;
  6380. end;
  6381. end;
  6382. if ProcScope.GroupScope<>nil then
  6383. RaiseNotYetImplemented(20190122142142,Proc);
  6384. if ProcScope.NestedMembersScope<>nil then
  6385. RaiseNotYetImplemented(20191014233200,Proc);
  6386. if TopScope.Element<>Proc then
  6387. RaiseInternalError(20190806094032);
  6388. PopScope;
  6389. if ProcScope.GenericStep=psgsImplementationParsed then
  6390. begin
  6391. if ProcScope.DeclarationProc<>nil then
  6392. ProcScope:=TPasProcedureScope(ProcScope.DeclarationProc.CustomData);
  6393. if ProcScope.SpecializedItems<>nil then
  6394. FinishSpecializations(ProcScope);
  6395. end;
  6396. end;
  6397. procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
  6398. var
  6399. ProcName: String;
  6400. FindData: TFindProcData;
  6401. DeclProc, Proc, ParentProc: TPasProcedure;
  6402. Abort, HasDots, IsClassConDestructor: boolean;
  6403. DeclProcScope, ProcScope: TPasProcedureScope;
  6404. ParentScope: TPasIdentifierScope;
  6405. pm: TProcedureModifier;
  6406. ptm: TProcTypeModifier;
  6407. ObjKind: TPasObjKind;
  6408. ParentBody: TProcedureBody;
  6409. HelperForType: TPasType;
  6410. Args, TemplTypes: TFPList;
  6411. Arg: TPasArgument;
  6412. ProcTypeScope: TPasProcTypeScope;
  6413. C: TClass;
  6414. begin
  6415. if TopScope.Element=El then
  6416. begin
  6417. ProcTypeScope:=El.CustomData as TPasProcTypeScope;
  6418. ProcTypeScope.GenericStep:=psgsImplementationParsed;
  6419. PopScope;
  6420. end;
  6421. if El.Parent is TPasProcedure then
  6422. Proc:=TPasProcedure(El.Parent)
  6423. else
  6424. Proc:=nil;
  6425. if (Proc<>nil) and (Proc.ProcType=El) then
  6426. begin
  6427. // finished header of a procedure declaration
  6428. CheckTopScope(FScopeClass_Proc);
  6429. {$IFDEF VerbosePasResolver}
  6430. writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
  6431. {$ENDIF}
  6432. ProcName:=Proc.Name;
  6433. ProcScope:=Proc.CustomData as TPasProcedureScope;
  6434. TemplTypes:=GetProcTemplateTypes(Proc);
  6435. if (TemplTypes<>nil) then
  6436. begin
  6437. // Proc is parametrized
  6438. if (Proc is TPasConstructor) or (Proc is TPasDestructor) then
  6439. RaiseMsg(20190911104114,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6440. [Proc.ElementTypeName],Proc);
  6441. if Proc.IsVirtual or Proc.IsDynamic or Proc.IsMessage or Proc.IsOverride then
  6442. RaiseMsg(20190911112925,nXMethodsCannotHaveTypeParams,
  6443. sXMethodsCannotHaveTypeParams,['virtual, dynamic or message'],El);
  6444. if Proc.IsOverride then
  6445. RaiseMsg(20191016174218,nXMethodsCannotHaveTypeParams,
  6446. sXMethodsCannotHaveTypeParams,['override'],El);
  6447. if not (Proc.Visibility in [visDefault,visPrivate,visStrictPrivate,visProtected,visStrictProtected,visPublic]) then
  6448. RaiseMsg(20191016174327,nXMethodsCannotHaveTypeParams,
  6449. sXMethodsCannotHaveTypeParams,[VisibilityNames[Proc.Visibility]],El);
  6450. end;
  6451. if El is TPasFunctionType then
  6452. CheckUseAsType(TPasFunctionType(El).ResultEl.ResultType,20190123095743,TPasFunctionType(El).ResultEl);
  6453. if (proProcTypeWithoutIsNested in Options) and El.IsNested then
  6454. RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
  6455. ParentBody:=GetParentProcBody(Proc.Parent);
  6456. if (ParentBody<>nil) then
  6457. begin
  6458. // nested sub proc
  6459. if TemplTypes<>nil then
  6460. RaiseMsg(20190912173450,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  6461. ['nested '+Proc.ElementTypeName],Proc);
  6462. if not (proProcTypeWithoutIsNested in Options) then
  6463. El.IsNested:=true;
  6464. // inherit 'of Object'
  6465. ParentProc:=ParentBody.Parent as TPasProcedure;
  6466. if ParentProc.ProcType.IsOfObject then
  6467. El.IsOfObject:=true;
  6468. end;
  6469. if El.IsReferenceTo then
  6470. begin
  6471. if El.IsNested then
  6472. RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
  6473. if El.IsOfObject then
  6474. RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
  6475. end;
  6476. if Proc.IsExternal then
  6477. begin
  6478. for pm in Proc.Modifiers do
  6479. if not (pm in [pmVirtual, pmDynamic, pmOverride,
  6480. pmOverload, pmMessage, pmReintroduce,
  6481. pmExternal, pmDispId,
  6482. pmfar]) then
  6483. RaiseMsg(20170216151616,nInvalidXModifierY,
  6484. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ModifierNames[pm]],Proc);
  6485. for ptm in Proc.ProcType.Modifiers do
  6486. if not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo,ptmAsync]) then
  6487. RaiseMsg(20170411171224,nInvalidXModifierY,
  6488. sInvalidXModifierY,[GetElementTypeName(Proc),'external, '+ProcTypeModifiers[ptm]],Proc);
  6489. end;
  6490. if El.IsAsync then
  6491. begin
  6492. // async procedure
  6493. C:=Proc.ClassType;
  6494. if (C<>TPasProcedure)
  6495. and (C<>TPasFunction)
  6496. and (C<>TPasClassProcedure)
  6497. and (C<>TPasClassFunction)
  6498. and (C<>TPasAnonymousProcedure)
  6499. and (C<>TPasAnonymousFunction) then
  6500. RaiseMsg(20200524105449,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'async'],Proc);
  6501. end;
  6502. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6503. or (Proc.ClassType=TPasClassDestructor);
  6504. if IsClassConDestructor then
  6505. begin
  6506. // class constructor/destructor
  6507. if Proc.IsVirtual then
  6508. RaiseMsg(20181231150237,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual'],Proc);
  6509. if Proc.IsOverride then
  6510. RaiseMsg(20181231150305,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'override'],Proc);
  6511. if Proc.IsDynamic then
  6512. RaiseMsg(20181231150319,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'dynamic'],Proc);
  6513. if Proc.IsStatic then
  6514. RaiseMsg(20190216214651,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6515. if El.Args.Count>0 then
  6516. RaiseMsg(20181231150404,nXCannotHaveParameters,sXCannotHaveParameters,[GetElementTypeName(Proc)],Proc);
  6517. end;
  6518. HasDots:=GetFirstDotPos(ProcName)>0;
  6519. if Proc.Parent is TPasClassType then
  6520. begin
  6521. // method declaration
  6522. ObjKind:=TPasClassType(Proc.Parent).ObjKind;
  6523. case ObjKind of
  6524. okInterface,okDispInterface:
  6525. begin
  6526. if Proc.IsVirtual then
  6527. RaiseMsg(20180321234324,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6528. if Proc.IsOverride then
  6529. RaiseMsg(20180321234551,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6530. if TemplTypes<>nil then
  6531. RaiseMsg(20190912153024,nXMethodsCannotHaveTypeParams,sXMethodsCannotHaveTypeParams,['interface'],Proc);
  6532. end;
  6533. okClassHelper,okRecordHelper,okTypeHelper:
  6534. begin
  6535. if Proc.IsAbstract then
  6536. RaiseMsg(20190116215744,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'abstract'],Proc);
  6537. {if msDelphi in CurrentParser.CurrentModeswitches then
  6538. begin
  6539. // Delphi allows virtual/override in class helpers
  6540. // But using them crashes in Delphi 10.3
  6541. // -> do not support them
  6542. end
  6543. }
  6544. if Proc.IsVirtual then
  6545. RaiseMsg(20190116215823,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'virtual'],Proc);
  6546. if Proc.IsOverride then
  6547. RaiseMsg(20190116215825,nInvalidXModifierY,sInvalidXModifierY,[ObjKindNames[ObjKind]+' '+GetElementTypeName(Proc),'override'],Proc);
  6548. HelperForType:=ResolveAliasType(TPasClassType(Proc.Parent).HelperForType);
  6549. if (not Proc.IsStatic) and IsClassMethod(Proc) and not IsClassConDestructor then
  6550. begin
  6551. // non static class methods require a class
  6552. if (not (HelperForType.ClassType=TPasClassType))
  6553. or (TPasClassType(HelperForType).ObjKind<>okClass) then
  6554. RaiseMsg(20190201153831,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,[ObjKindNames[ObjKind]],Proc);
  6555. end;
  6556. if Proc.ClassType=TPasDestructor then
  6557. RaiseMsg(20190302151019,nXIsNotSupported,sXIsNotSupported,['destructor'],Proc);
  6558. if (Proc.ClassType=TPasConstructor)
  6559. and (HelperForType.ClassType=TPasClassType)
  6560. and (TPasClassType(HelperForType).ObjKind<>okClass) then
  6561. RaiseMsg(20190302151514,nXIsNotSupported,sXIsNotSupported,['constructor'],Proc);
  6562. end;
  6563. end;
  6564. if Proc.IsAbstract then
  6565. begin
  6566. if not Proc.IsVirtual then
  6567. RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract without virtual'],Proc);
  6568. if Proc.IsOverride then
  6569. RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'abstract, override'],Proc);
  6570. end;
  6571. if Proc.IsVirtual and Proc.IsOverride then
  6572. RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'virtual, override'],Proc);
  6573. if Proc.IsReintroduced and Proc.IsOverride then
  6574. RaiseMsg(20171119111845,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'reintroduce, override'],Proc);
  6575. if Proc.IsForward then
  6576. RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'forward'],Proc);
  6577. if Proc.IsStatic then
  6578. if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
  6579. RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6580. end
  6581. else if Proc.Parent is TPasRecordType then
  6582. begin
  6583. if (Proc.ClassType=TPasConstructor)
  6584. and ((El.Args.Count=0)
  6585. or (TPasArgument(El.Args[0]).ValueExpr<>nil)) then
  6586. RaiseMsg(20181226231333,nParameterlessConstructorsNotAllowedInRecords,
  6587. sParameterlessConstructorsNotAllowedInRecords,[],El);
  6588. if Proc.IsReintroduced then
  6589. RaiseMsg(20181218195735,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'reintroduce'],Proc);
  6590. if Proc.IsVirtual then
  6591. RaiseMsg(20181218195431,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'virtual'],Proc);
  6592. if Proc.IsOverride then
  6593. RaiseMsg(20181218195437,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'override'],Proc);
  6594. if Proc.IsAbstract then
  6595. RaiseMsg(20181218195552,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'abstract'],Proc);
  6596. if Proc.IsForward then
  6597. RaiseMsg(20181218195514,nInvalidXModifierY,sInvalidXModifierY,['record '+GetElementTypeName(Proc),'forward'],Proc);
  6598. if IsClassMethod(Proc) and not IsClassConDestructor then
  6599. begin
  6600. // Note: class constructor/destructor must not be static
  6601. if not Proc.IsStatic then
  6602. RaiseMsg(20190106121503,nClassMethodsMustBeStaticInX,sClassMethodsMustBeStaticInX,['records'],Proc);
  6603. end
  6604. else if Proc.IsStatic then
  6605. RaiseMsg(20190206150922,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),'static'],Proc);
  6606. end
  6607. else
  6608. begin
  6609. // intf proc, forward proc, proc body, method body, anonymous proc
  6610. if Proc.IsAbstract then
  6611. RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
  6612. if Proc.IsVirtual then
  6613. RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
  6614. if Proc.IsOverride then
  6615. RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
  6616. if Proc.IsMessage then
  6617. RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
  6618. if Proc.IsStatic and not HasDots then
  6619. RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
  6620. if (not HasDots)
  6621. and (Proc.GetProcTypeEnum in [
  6622. ptClassOperator,
  6623. ptConstructor, ptDestructor,
  6624. ptClassProcedure, ptClassFunction,
  6625. ptClassConstructor, ptClassDestructor
  6626. ]) then
  6627. RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
  6628. end;
  6629. ProcScope.GenericStep:=psgsInterfaceParsed;
  6630. if HasDots then
  6631. begin
  6632. FinishMethodImplHeader(Proc);
  6633. exit;
  6634. end;
  6635. // finish interface/implementation/nested procedure/method declaration
  6636. if (ProcName='')
  6637. and not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction]) then
  6638. RaiseNotYetImplemented(20160922163407,El);
  6639. if (El is TPasFunctionType) and not (ppsfIsSpecialized in ProcScope.Flags) then
  6640. EmitTypeHints(TPasFunctionType(El).ResultEl,TPasFunctionType(El).ResultEl.ResultType);
  6641. if Proc.PublicName<>nil then
  6642. ResolveExpr(Proc.PublicName,rraRead);
  6643. if Proc.LibraryExpr<>nil then
  6644. ResolveExpr(Proc.LibraryExpr,rraRead);
  6645. if Proc.LibrarySymbolName<>nil then
  6646. ResolveExpr(Proc.LibrarySymbolName,rraRead);
  6647. if Proc.DispIDExpr<>nil then
  6648. ResolveExpr(Proc.DispIDExpr,rraRead);
  6649. if Proc.MessageExpr<>nil then
  6650. begin
  6651. // message modifier
  6652. ResolveExpr(Proc.MessageExpr,rraRead);
  6653. Args:=Proc.ProcType.Args;
  6654. if Args.Count<>1 then
  6655. RaiseMsg(20190303223701,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6656. Arg:=TPasArgument(Args[0]);
  6657. if not (Arg.Access in [argVar,argOut]) then
  6658. RaiseMsg(20190303223834,nMessageHandlersInvalidParams,sMessageHandlersInvalidParams,[],El);
  6659. if (Proc.ClassType<>TPasProcedure)
  6660. and (Proc.ClassType<>TPasFunction) then
  6661. RaiseMsg(20190303224128,nXExpectedButYFound,sXExpectedButYFound,['procedure name(var Msg);message id;',GetElementTypeName(El)],El);
  6662. end;
  6663. if Proc.Parent is TPasMembersType then
  6664. begin
  6665. FinishMethodDeclHeader(Proc);
  6666. exit;
  6667. end;
  6668. // finish interface/implementation/nested procedure
  6669. if (ProcName<>'') and ProcNeedsBody(Proc) then
  6670. begin
  6671. if ppsfIsSpecialized in ProcScope.Flags then
  6672. begin
  6673. if ProcScope.DeclarationProc<>nil then
  6674. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6675. end
  6676. else
  6677. begin
  6678. // check if there is a forward declaration
  6679. //writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2]));
  6680. ParentScope:=GetParentLocalScope as TPasIdentifierScope;
  6681. //writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc));
  6682. DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true);
  6683. //writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
  6684. //if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc));
  6685. if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
  6686. DeclProc:=FindProcSameSignature(ProcName,Proc,
  6687. (Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true);
  6688. //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
  6689. if (DeclProc<>nil) then
  6690. begin
  6691. if ProcNeedsImplProc(DeclProc) then
  6692. begin
  6693. // found forward declaration
  6694. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6695. if DeclProcScope.ImplProc<>nil then
  6696. RaiseMsg(20180318222430,nDuplicateIdentifier,sDuplicateIdentifier,
  6697. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],Proc);
  6698. // connect
  6699. {$IFDEF VerbosePasResolver}
  6700. writeln('TPasResolver.FinishProcedureHeader forward found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
  6701. {$ENDIF}
  6702. CheckProcSignatureMatch(DeclProc,Proc,false);
  6703. DeclProcScope.ImplProc:=Proc;
  6704. if DeclProc.IsAssembler then
  6705. Proc.Modifiers:=Proc.Modifiers+[pmAssembler];
  6706. ProcScope.DeclarationProc:=DeclProc;
  6707. // remove ImplProc from scope
  6708. ParentScope.RemoveLocalIdentifier(Proc);
  6709. // replace arguments with declaration arguments
  6710. ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
  6711. exit;
  6712. end
  6713. else
  6714. RaiseMsg(20180318220543,nDuplicateIdentifier,sDuplicateIdentifier,
  6715. [DeclProc.Name,GetElementSourcePosStr(DeclProc)],Proc);
  6716. end;
  6717. end;
  6718. end
  6719. else
  6720. begin
  6721. // forward declaration
  6722. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6723. StoreScannerFlagsInProc(ProcScope);
  6724. end;
  6725. if ProcName<>'' then
  6726. begin
  6727. // check for invalid overloads
  6728. FindData:=Default(TFindProcData);
  6729. FindData.Proc:=Proc;
  6730. FindData.Args:=Proc.ProcType.Args;
  6731. FindData.Kind:=fpkProc;
  6732. Abort:=false;
  6733. IterateElements(ProcName,@OnFindProc,@FindData,Abort);
  6734. end;
  6735. end
  6736. else if El.Name<>'' then
  6737. begin
  6738. // finished proc type, e.g. type TProcedure = procedure;
  6739. end
  6740. else
  6741. RaiseNotYetImplemented(20160922163411,El.Parent,'anonymous procedure type');
  6742. end;
  6743. procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
  6744. procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
  6745. begin
  6746. LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
  6747. sVirtualMethodXHasLowerVisibility,[Proc.Name,
  6748. VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
  6749. VisibilityNames[OverloadProc.Visibility]],Proc);
  6750. Proc.Visibility:=OverloadProc.Visibility;
  6751. end;
  6752. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  6753. procedure Delete(var A: TArrayOfPasProcedure; Index, Count: integer); overload;
  6754. var
  6755. i: Integer;
  6756. begin
  6757. if Index<0 then
  6758. RaiseInternalError(20171227121538);
  6759. if Index+Count>length(A) then
  6760. RaiseInternalError(20171227121156);
  6761. for i:=Index+Count to length(A)-1 do
  6762. A[i-Count]:=A[i];
  6763. SetLength(A,length(A)-Count);
  6764. end;
  6765. procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
  6766. var
  6767. i: Integer;
  6768. begin
  6769. if Index<0 then
  6770. RaiseInternalError(20171227121544);
  6771. if Index>length(A) then
  6772. RaiseInternalError(20171227121558);
  6773. SetLength(A,length(A)+1);
  6774. for i:=length(A)-1 downto Index+1 do
  6775. A[i]:=A[i-1];
  6776. A[Index]:=Item;
  6777. end;
  6778. {$ENDIF}
  6779. var
  6780. Abort, IsClassConDestructor: boolean;
  6781. ClassOrRecScope: TPasClassOrRecordScope;
  6782. FindData: TFindProcData;
  6783. OverloadProc: TPasProcedure;
  6784. ProcScope: TPasProcedureScope;
  6785. i: Integer;
  6786. ParentScope: TPasScope;
  6787. TemplTypes: TFPList;
  6788. begin
  6789. if not (ptmStatic in Proc.ProcType.Modifiers) then
  6790. Proc.ProcType.IsOfObject:=true;
  6791. ProcScope:=TopScope as TPasProcedureScope;
  6792. ParentScope:=Scopes[ScopeCount-2];
  6793. // ToDo: store the scanner flags *before* it has parsed the token after the proc
  6794. StoreScannerFlagsInProc(ProcScope);
  6795. ClassOrRecScope:=Proc.Parent.CustomData as TPasClassOrRecordScope;
  6796. ProcScope.ClassRecScope:=ClassOrRecScope;
  6797. TemplTypes:=GetProcTemplateTypes(Proc);
  6798. FindData:=Default(TFindProcData);
  6799. IsClassConDestructor:=(Proc.ClassType=TPasClassConstructor)
  6800. or (Proc.ClassType=TPasClassDestructor);
  6801. if IsClassConDestructor then
  6802. begin
  6803. if TemplTypes<>nil then
  6804. RaiseNotYetImplemented(20190911105953,Proc);
  6805. end
  6806. else
  6807. begin
  6808. FindData.Proc:=Proc;
  6809. FindData.Args:=Proc.ProcType.Args;
  6810. FindData.Kind:=fpkMethod;
  6811. Abort:=false;
  6812. ParentScope.IterateElements(Proc.Name,ClassOrRecScope,
  6813. @OnFindProc,@FindData,Abort);
  6814. end;
  6815. if FindData.Found=nil then
  6816. begin
  6817. // no overload
  6818. if Proc.IsOverride then
  6819. RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
  6820. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6821. end
  6822. else
  6823. begin
  6824. // overload found
  6825. OverloadProc:=FindData.Found;
  6826. // Note: 'inherited;' needs the OverriddenProc, even without 'override' modifier
  6827. ProcScope.OverriddenProc:=OverloadProc;
  6828. if Proc.IsOverride then
  6829. begin
  6830. if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
  6831. // the OverloadProc fits the signature, but is not virtual
  6832. RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
  6833. sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
  6834. // override a virtual method
  6835. CheckProcSignatureMatch(OverloadProc,Proc,true);
  6836. // check visibility
  6837. if Proc.Visibility<>OverloadProc.Visibility then
  6838. case Proc.Visibility of
  6839. visPrivate,visStrictPrivate:
  6840. if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
  6841. VisibilityLowered(Proc,OverloadProc);
  6842. visProtected,visStrictProtected:
  6843. if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
  6844. VisibilityLowered(Proc,OverloadProc);
  6845. visPublic:
  6846. if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
  6847. VisibilityLowered(Proc,OverloadProc);
  6848. visPublished: ;
  6849. else
  6850. RaiseNotYetImplemented(20170325003315,Proc,'visibility');
  6851. end;
  6852. // check name case
  6853. if proFixCaseOfOverrides in Options then
  6854. Proc.Name:=OverloadProc.Name;
  6855. // remove abstract
  6856. if OverloadProc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6857. for i:=length(TPasClassScope(ClassOrRecScope).AbstractProcs)-1 downto 0 do
  6858. if TPasClassScope(ClassOrRecScope).AbstractProcs[i]=OverloadProc then
  6859. Delete(TPasClassScope(ClassOrRecScope).AbstractProcs,i,1);
  6860. end;
  6861. end;
  6862. // add abstract
  6863. if Proc.IsAbstract and (ClassOrRecScope is TPasClassScope) then
  6864. Insert(Proc,TPasClassScope(ClassOrRecScope).AbstractProcs,
  6865. length(TPasClassScope(ClassOrRecScope).AbstractProcs));
  6866. end;
  6867. procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
  6868. var
  6869. ProcName: String;
  6870. ClassRecType: TPasMembersType;
  6871. ImplProcScope, DeclProcScope: TPasProcedureScope;
  6872. DeclProc: TPasProcedure;
  6873. ClassOrRecScope: TPasClassOrRecordScope;
  6874. SelfArg: TPasArgument;
  6875. SelfType, LoSelfType: TPasType;
  6876. LastNamePart: TProcedureNamePart;
  6877. begin
  6878. if ImplProc.IsExternal then
  6879. RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'external'],ImplProc);
  6880. if ImplProc.IsExported then
  6881. RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ImplProc),'export'],ImplProc);
  6882. ProcName:=ImplProc.Name;
  6883. ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
  6884. ClassOrRecScope:=ImplProcScope.ClassRecScope;
  6885. if ClassOrRecScope=nil then
  6886. RaiseInternalError(20161013172346);
  6887. ClassRecType:=NoNil(ClassOrRecScope.Element) as TPasMembersType;
  6888. if ImplProcScope.GroupScope=nil then
  6889. RaiseInternalError(20190120135017);
  6890. if ImplProc.NameParts<>nil then
  6891. begin
  6892. LastNamePart:=TProcedureNamePart(ImplProc.NameParts[ImplProc.NameParts.Count-1]);
  6893. ProcName:=LastNamePart.Name;
  6894. end
  6895. else
  6896. begin
  6897. // remove path from ProcName
  6898. ProcName:=LastDottedIdentifier(ProcName);
  6899. end;
  6900. if ImplProcScope.DeclarationProc=nil then
  6901. begin
  6902. {$IFDEF VerbosePasResolver}
  6903. writeln('TPasResolver.FinishMethodImplHeader searching declaration "',ImplProc.Name,'" ...');
  6904. {$ENDIF}
  6905. // search ImplProc in class
  6906. if not IsValidIdent(ProcName) then
  6907. RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
  6908. // search proc in class/record
  6909. if ImplProc.ClassType=TPasClassConstructor then
  6910. DeclProc:=ClassOrRecScope.ClassConstructor
  6911. else if ImplProc.ClassType=TPasClassDestructor then
  6912. DeclProc:=ClassOrRecScope.ClassDestructor
  6913. else
  6914. DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
  6915. if DeclProc=nil then
  6916. RaiseIdentifierNotFound(20170216151720,GetProcName(ImplProc),ImplProc.ProcType);
  6917. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6918. ImplProc.ProcType.IsOfObject:=DeclProc.ProcType.IsOfObject;
  6919. // connect method declaration and body
  6920. if DeclProcScope.ImplProc<>nil then
  6921. RaiseMsg(20180212094546,nDuplicateIdentifier,sDuplicateIdentifier,
  6922. [DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],
  6923. ImplProc);
  6924. if DeclProc.IsAbstract then
  6925. RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
  6926. if DeclProc.IsExternal then
  6927. RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
  6928. CheckProcSignatureMatch(DeclProc,ImplProc,false);
  6929. if DeclProc.IsAssembler then
  6930. ImplProc.Modifiers:=ImplProc.Modifiers+[pmAssembler];
  6931. ImplProcScope.DeclarationProc:=DeclProc;
  6932. DeclProcScope.ImplProc:=ImplProc;
  6933. // replace arguments in scope with declaration arguments
  6934. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  6935. end
  6936. else if ppsfIsSpecialized in ImplProcScope.Flags then
  6937. begin
  6938. {$IFDEF VerbosePasResolver}
  6939. writeln('TPasResolver.FinishMethodImplHeader specialized "',ImplProc.Name,'" ...');
  6940. {$ENDIF}
  6941. DeclProc:=ImplProcScope.DeclarationProc;
  6942. DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
  6943. if DeclProcScope.ImplProc<>ImplProc then
  6944. RaiseNotYetImplemented(20190804182220,ImplProc);
  6945. // replace arguments in scope with declaration arguments
  6946. ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
  6947. end
  6948. else
  6949. RaiseNotYetImplemented(20190804181222,ImplProc);
  6950. if not DeclProc.IsStatic then
  6951. begin
  6952. // add 'Self'
  6953. if (DeclProc.ClassType=TPasClassConstructor)
  6954. or (DeclProc.ClassType=TPasClassDestructor) then
  6955. // actually class constructor/destructor are static
  6956. else if (DeclProc.ClassType=TPasClassProcedure)
  6957. or (DeclProc.ClassType=TPasClassFunction) then
  6958. begin
  6959. if (ClassOrRecScope is TPasClassScope)
  6960. and (TPasClassScope(ClassOrRecScope).CanonicalClassOf<>nil) then
  6961. begin
  6962. // 'Self' in a class method is the hidden classtype argument
  6963. // Note: this is true in classes, adv records and helpers
  6964. SelfArg:=TPasArgument.Create('Self',DeclProc);
  6965. ImplProcScope.SelfArg:=SelfArg;
  6966. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  6967. SelfArg.Access:=argConst;
  6968. SelfArg.ArgType:=TPasClassScope(ClassOrRecScope).CanonicalClassOf;
  6969. SelfArg.ArgType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  6970. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  6971. end
  6972. else
  6973. RaiseInternalError(20190106121745);
  6974. end
  6975. else
  6976. begin
  6977. // 'Self' in a method is the hidden instance argument
  6978. SelfArg:=TPasArgument.Create('Self',DeclProc);
  6979. ImplProcScope.SelfArg:=SelfArg;
  6980. {$IFDEF CheckPasTreeRefCount}SelfArg.RefIds.Add('TPasProcedureScope.SelfArg');{$ENDIF}
  6981. SelfType:=ClassRecType;
  6982. if (SelfType.ClassType=TPasClassType)
  6983. and (TPasClassType(SelfType).HelperForType<>nil) then
  6984. begin
  6985. // in a helper Self is a var argument of the helped variable
  6986. SelfType:=TPasClassType(SelfType).HelperForType;
  6987. end;
  6988. LoSelfType:=ResolveAliasType(SelfType);
  6989. if (LoSelfType is TPasClassType)
  6990. and (TPasClassType(LoSelfType).ObjKind=okClass) then
  6991. SelfArg.Access:=argConst
  6992. else
  6993. SelfArg.Access:=argVar;
  6994. SelfArg.ArgType:=SelfType;
  6995. SelfType.AddRef{$IFDEF CheckPasTreeRefCount}('TPasArgument.ArgType'){$ENDIF};
  6996. AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
  6997. end;
  6998. end;
  6999. {$IFDEF VerbosePasResolver}
  7000. writeln('TPasResolver.FinishMethodImplHeader END "',ImplProc.Name,'" ...');
  7001. {$ENDIF}
  7002. end;
  7003. procedure TPasResolver.FinishExceptOnExpr;
  7004. var
  7005. El: TPasImplExceptOn;
  7006. ResolvedType: TPasResolverResult;
  7007. begin
  7008. CheckTopScope(TPasExceptOnScope);
  7009. El:=TPasImplExceptOn(FTopScope.Element);
  7010. ComputeElement(El.TypeEl,ResolvedType,[rcType]);
  7011. CheckIsClass(El.TypeEl,ResolvedType);
  7012. end;
  7013. procedure TPasResolver.FinishExceptOnStatement;
  7014. begin
  7015. //writeln('TPasResolver.FinishExceptOnStatement START');
  7016. CheckTopScope(TPasExceptOnScope);
  7017. ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
  7018. PopScope;
  7019. end;
  7020. procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
  7021. begin
  7022. PopWithScope(El);
  7023. end;
  7024. procedure TPasResolver.FinishForLoopHeader(Loop: TPasImplForLoop);
  7025. var
  7026. VarResolved, StartResolved, EndResolved,
  7027. OrigStartResolved: TPasResolverResult;
  7028. EnumeratorFound, HasInValues: Boolean;
  7029. InRange, VarRange: TResEvalValue;
  7030. InRangeInt, VarRangeInt: TResEvalRangeInt;
  7031. bt: TResolverBaseType;
  7032. TypeEl, ElType: TPasType;
  7033. C: TClass;
  7034. begin
  7035. CreateScope(Loop,TPasForLoopScope);
  7036. // loop var
  7037. ResolveExpr(Loop.VariableName,rraReadAndAssign);
  7038. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  7039. if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
  7040. RaiseVarExpected(20170216151955,Loop.VariableName,VarResolved.IdentEl);
  7041. // resolve start expression
  7042. ResolveExpr(Loop.StartExpr,rraRead);
  7043. ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
  7044. case Loop.LoopType of
  7045. ltNormal,ltDown:
  7046. begin
  7047. // start value
  7048. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  7049. RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
  7050. [],StartResolved,VarResolved,Loop.StartExpr);
  7051. CheckAssignExprRange(VarResolved,Loop.StartExpr);
  7052. // end value
  7053. ResolveExpr(Loop.EndExpr,rraRead);
  7054. ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
  7055. if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
  7056. RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
  7057. [],EndResolved,VarResolved,Loop.EndExpr);
  7058. CheckAssignExprRange(VarResolved,Loop.EndExpr);
  7059. end;
  7060. ltIn:
  7061. begin
  7062. // check range
  7063. EnumeratorFound:=CheckForIn(Loop,VarResolved,StartResolved);
  7064. if (not EnumeratorFound)
  7065. and not (StartResolved.IdentEl is TPasType)
  7066. and (rrfReadable in StartResolved.Flags) then
  7067. begin
  7068. EnumeratorFound:=CheckForInClassOrRec(Loop,VarResolved,StartResolved);
  7069. end;
  7070. if not EnumeratorFound then
  7071. begin
  7072. VarRange:=nil;
  7073. InRange:=nil;
  7074. try
  7075. OrigStartResolved:=StartResolved;
  7076. if StartResolved.IdentEl is TPasType then
  7077. begin
  7078. // e.g. for e in TEnum do
  7079. TypeEl:=StartResolved.LoTypeEl;
  7080. if TypeEl is TPasArrayType then
  7081. begin
  7082. if length(TPasArrayType(TypeEl).Ranges)=1 then
  7083. InRange:=Eval(TPasArrayType(TypeEl).Ranges[0],[refConst]);
  7084. end;
  7085. if InRange=nil then
  7086. InRange:=EvalTypeRange(TypeEl,[]);
  7087. {$IFDEF VerbosePasResolver}
  7088. {AllowWriteln}
  7089. if InRange<>nil then
  7090. writeln('TPasResolver.ResolveImplForLoop in type: InRange=',InRange.AsDebugString)
  7091. else
  7092. writeln('TPasResolver.ResolveImplForLoop in type: InRange=nil');
  7093. {AllowWriteln-}
  7094. {$ENDIF}
  7095. end
  7096. else if rrfReadable in StartResolved.Flags then
  7097. begin
  7098. // value (variable or expression)
  7099. bt:=StartResolved.BaseType;
  7100. if bt in [btSet,btArrayOrSet] then
  7101. begin
  7102. if (StartResolved.IdentEl=nil) and (StartResolved.ExprEl<>nil) then
  7103. InRange:=Eval(StartResolved.ExprEl,[]);
  7104. if InRange=nil then
  7105. InRange:=EvalTypeRange(StartResolved.LoTypeEl,[]);
  7106. end
  7107. else if bt=btContext then
  7108. begin
  7109. TypeEl:=StartResolved.LoTypeEl;
  7110. C:=TypeEl.ClassType;
  7111. if C=TPasArrayType then
  7112. begin
  7113. ElType:=GetArrayElType(TPasArrayType(TypeEl));
  7114. ComputeElement(ElType,StartResolved,[rcType]);
  7115. StartResolved.Flags:=OrigStartResolved.Flags*[rrfReadable,rrfWritable];
  7116. if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
  7117. RaiseIncompatibleTypeRes(20171112210138,nIncompatibleTypesGotExpected,
  7118. [],StartResolved,VarResolved,Loop.StartExpr);
  7119. EnumeratorFound:=true;
  7120. end;
  7121. end
  7122. else
  7123. begin
  7124. bt:=GetActualBaseType(bt);
  7125. case bt of
  7126. {$ifdef FPC_HAS_CPSTRING}
  7127. btAnsiString:
  7128. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  7129. {$endif}
  7130. btUnicodeString:
  7131. InRange:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  7132. end;
  7133. end;
  7134. end;
  7135. if (not EnumeratorFound) and (InRange<>nil) then
  7136. begin
  7137. // for v in <constant> do
  7138. // -> check if same type
  7139. VarRange:=EvalTypeRange(VarResolved.LoTypeEl,[]);
  7140. if VarRange=nil then
  7141. RaiseXExpectedButYFound(20171109191528,'range',
  7142. GetResolverResultDescription(VarResolved),Loop.VariableName);
  7143. //writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  7144. //writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString,' ElType=',GetResolverResultDbg(StartResolved));
  7145. case InRange.Kind of
  7146. revkRangeInt,revkSetOfInt:
  7147. begin
  7148. InRangeInt:=TResEvalRangeInt(InRange);
  7149. case VarRange.Kind of
  7150. revkRangeInt:
  7151. begin
  7152. VarRangeInt:=TResEvalRangeInt(VarRange);
  7153. HasInValues:=(InRange.Kind<>revkSetOfInt) or (length(TResEvalSet(InRange).Ranges)>0);
  7154. case InRangeInt.ElKind of
  7155. revskEnum:
  7156. if (VarRangeInt.ElKind<>revskEnum)
  7157. or not IsSameType(InRangeInt.ElType,VarRangeInt.ElType,prraAlias) then
  7158. RaiseXExpectedButYFound(20171109200752,GetTypeDescription(InRangeInt.ElType),
  7159. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7160. revskInt:
  7161. if VarRangeInt.ElKind<>revskInt then
  7162. RaiseXExpectedButYFound(20171109200752,'integer',
  7163. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7164. revskChar:
  7165. if VarRangeInt.ElKind<>revskChar then
  7166. RaiseXExpectedButYFound(20171109200753,'char',
  7167. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7168. revskBool:
  7169. if VarRangeInt.ElKind<>revskBool then
  7170. RaiseXExpectedButYFound(20171109200754,'boolean',
  7171. GetResolverResultDescription(VarResolved,true),loop.VariableName);
  7172. else
  7173. if HasInValues then
  7174. RaiseNotYetImplemented(20171109200954,Loop.StartExpr);
  7175. end;
  7176. if HasInValues then
  7177. begin
  7178. if (VarRangeInt.RangeStart>InRangeInt.RangeStart) then
  7179. begin
  7180. {$IFDEF VerbosePasResolver}
  7181. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  7182. {$ENDIF}
  7183. fExprEvaluator.EmitRangeCheckConst(20171109201428,
  7184. InRangeInt.ElementAsString(InRangeInt.RangeStart),
  7185. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  7186. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  7187. end;
  7188. if (VarRangeInt.RangeEnd<InRangeInt.RangeEnd) then
  7189. begin
  7190. {$IFDEF VerbosePasResolver}
  7191. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRangeInt.AsDebugString,' ',InRangeInt.AsDebugString);
  7192. {$ENDIF}
  7193. fExprEvaluator.EmitRangeCheckConst(20171109201429,
  7194. InRangeInt.ElementAsString(InRangeInt.RangeEnd),
  7195. VarRangeInt.ElementAsString(VarRangeInt.RangeStart),
  7196. VarRangeInt.ElementAsString(VarRangeInt.RangeEnd),Loop.VariableName,mtError);
  7197. end;
  7198. end;
  7199. EnumeratorFound:=true;
  7200. end;
  7201. else
  7202. {$IFDEF VerbosePasResolver}
  7203. writeln('TPasResolver.ResolveImplForLoop ForIn VarRange=',VarRange.AsDebugString);
  7204. {$ENDIF}
  7205. end;
  7206. end;
  7207. else
  7208. {$IFDEF VerbosePasResolver}
  7209. writeln('TPasResolver.ResolveImplForLoop ForIn InRange=',InRange.AsDebugString);
  7210. {$ENDIF}
  7211. end;
  7212. end;
  7213. if not EnumeratorFound then
  7214. begin
  7215. {$IFDEF VerbosePasResolver}
  7216. {AllowWriteln}
  7217. writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved));
  7218. if VarRange<>nil then
  7219. writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString);
  7220. {AllowWriteln-}
  7221. {$ENDIF}
  7222. RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  7223. [GetBaseDescription(OrigStartResolved)],Loop.StartExpr);
  7224. end;
  7225. finally
  7226. ReleaseEvalValue(VarRange);
  7227. ReleaseEvalValue(InRange);
  7228. end;
  7229. end;
  7230. end;
  7231. else
  7232. RaiseNotYetImplemented(20171108221334,Loop);
  7233. end;
  7234. end;
  7235. procedure TPasResolver.FinishDeclaration(El: TPasElement);
  7236. var
  7237. C: TClass;
  7238. begin
  7239. C:=El.ClassType;
  7240. if (C=TPasVariable) or (C=TPasConst) then
  7241. FinishVariable(TPasVariable(El))
  7242. else if C=TPasProperty then
  7243. FinishProperty(TPasProperty(El))
  7244. else if C=TPasArgument then
  7245. FinishArgument(TPasArgument(El))
  7246. else if C=TPasMethodResolution then
  7247. FinishMethodResolution(TPasMethodResolution(El))
  7248. else if C=TPasAttributes then
  7249. FinishAttributes(TPasAttributes(El))
  7250. else
  7251. begin
  7252. {$IFDEF VerbosePasResolver}
  7253. writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
  7254. {$ENDIF}
  7255. RaiseNotYetImplemented(20180127121557,El);
  7256. end;
  7257. end;
  7258. procedure TPasResolver.FinishVariable(El: TPasVariable);
  7259. var
  7260. ResolvedAbs: TPasResolverResult;
  7261. C: TClass;
  7262. Value: TResEvalValue;
  7263. begin
  7264. if (El.Visibility=visPublished) then
  7265. begin
  7266. if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
  7267. RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
  7268. end;
  7269. if El.Expr<>nil then
  7270. ResolveExpr(El.Expr,rraRead);
  7271. if El.VarType<>nil then
  7272. begin
  7273. if (El.Parent is TPasRecordType) and (El.VarType=El.Parent) then
  7274. RaiseMsg(20181218173631,nTypeXIsNotYetCompletelyDefined,
  7275. sTypeXIsNotYetCompletelyDefined,[El.VarType.Name],El);
  7276. CheckUseAsType(El.VarType,20190123095916,El);
  7277. if El.Expr<>nil then
  7278. CheckAssignCompatibility(El,El.Expr,true);
  7279. end
  7280. else if El.Expr<>nil then
  7281. begin
  7282. // no VarType, has Expr, e.g. const a = Expr
  7283. Value:=Eval(El.Expr,[refConstExt]); // e.g. const Tau = 2*PI
  7284. ReleaseEvalValue(Value);
  7285. end;
  7286. if El.AbsoluteExpr<>nil then
  7287. begin
  7288. if El.ClassType=TPasConst then
  7289. RaiseMsg(20180201225530,nXModifierMismatchY,sXModifierMismatchY,
  7290. ['absolute','const'],El.AbsoluteExpr);
  7291. if El.VarType=nil then
  7292. RaiseMsg(20171225235125,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7293. if vmExternal in El.VarModifiers then
  7294. RaiseMsg(20171226104221,nXModifierMismatchY,sXModifierMismatchY,
  7295. ['absolute','external'],El.AbsoluteExpr);
  7296. {$IFDEF VerbosePasResolver}
  7297. writeln('TPasResolver.FinishVariable El=',GetObjName(El),' Absolute="',GetObjName(El.AbsoluteExpr),'"');
  7298. {$ENDIF}
  7299. ResolveExpr(El.AbsoluteExpr,rraRead);
  7300. ComputeElement(El.AbsoluteExpr,ResolvedAbs,[rcNoImplicitProc]);
  7301. if (not (rrfReadable in ResolvedAbs.Flags))
  7302. or (ResolvedAbs.IdentEl=nil) then
  7303. RaiseVarExpected(20171225234734,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7304. C:=ResolvedAbs.IdentEl.ClassType;
  7305. if (C=TPasVariable)
  7306. or (C=TPasArgument)
  7307. or ((C=TPasConst) and (TPasConst(ResolvedAbs.IdentEl).VarType<>nil)) then
  7308. else
  7309. RaiseMsg(20171225235203,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7310. if not (rrfReadable in ResolvedAbs.Flags) then
  7311. RaiseVarExpected(20171225235249,El.AbsoluteExpr,ResolvedAbs.IdentEl);
  7312. // check for cycles
  7313. if ResolvedAbs.IdentEl=El then
  7314. RaiseMsg(20171226000703,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El.AbsoluteExpr);
  7315. end;
  7316. if El.VarType<>nil then
  7317. EmitTypeHints(El,El.VarType);
  7318. end;
  7319. procedure TPasResolver.FinishProperty(PropEl: TPasProperty);
  7320. var
  7321. PropType: TPasType;
  7322. ClassOrRecScope: TPasClassOrRecordScope;
  7323. ClassScope: TPasClassScope;
  7324. AncestorProp: TPasProperty;
  7325. IndexExpr: TPasExpr;
  7326. procedure GetPropType;
  7327. var
  7328. AncEl: TPasElement;
  7329. GroupScope: TPasGroupScope;
  7330. begin
  7331. if PropType<>nil then exit;
  7332. AncEl:=nil;
  7333. if (ClassScope<>nil) and (ClassScope.AncestorScope<>nil) then
  7334. begin
  7335. CheckTopScope(TPasGroupScope);
  7336. GroupScope:=TPasGroupScope(TopScope);
  7337. AncEl:=GroupScope.FindAncestorElement(PropEl.Name);
  7338. end;
  7339. if AncEl is TPasProperty then
  7340. begin
  7341. // override or redeclaration property
  7342. AncestorProp:=TPasProperty(AncEl);
  7343. TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncestorProp;
  7344. if proFixCaseOfOverrides in Options then
  7345. PropEl.Name:=AncestorProp.Name;
  7346. end
  7347. else
  7348. AncestorProp:=nil;
  7349. if PropEl.VarType<>nil then
  7350. begin
  7351. // new property or redeclaration
  7352. PropType:=PropEl.VarType;
  7353. CheckUseAsType(PropEl.VarType,20190123100011,PropEl);
  7354. end
  7355. else
  7356. begin
  7357. // property override
  7358. if AncestorProp=nil then
  7359. RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
  7360. // check property versus class property
  7361. if PropEl.ClassType<>AncestorProp.ClassType then
  7362. RaiseXExpectedButYFound(20170216151744,GetElementTypeName(AncestorProp),GetElementTypeName(PropEl),PropEl);
  7363. // get inherited type
  7364. PropType:=GetPasPropertyType(AncestorProp);
  7365. // update DefaultProperty
  7366. if ClassScope=nil then
  7367. RaiseNotYetImplemented(20181231130642,PropEl);
  7368. if ClassScope.DefaultProperty=AncestorProp then
  7369. ClassScope.DefaultProperty:=PropEl;
  7370. end;
  7371. end;
  7372. function CheckClassAccessorStatic(ProcIsStatic: boolean): boolean;
  7373. begin
  7374. if ClassScope=nil then
  7375. // record: class getter/setter must be static
  7376. Result:=ProcIsStatic=true
  7377. else if proClassPropertyNonStatic in Options then
  7378. Result:=true // both allowed
  7379. else
  7380. Result:=ProcIsStatic=true;
  7381. end;
  7382. procedure CheckIndexArg(ArgNo: integer; const IndexResolved: TPasResolverResult;
  7383. ProcArg: TPasArgument; ErrorEl: TPasElement);
  7384. var
  7385. ProcArgResolved: TPasResolverResult;
  7386. begin
  7387. // check access: const, ...
  7388. if not (ProcArg.Access in [argDefault,argConst]) then
  7389. RaiseMsg(20170924202437,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7390. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7391. AccessDescriptions[argConst]],ErrorEl);
  7392. // check argument type
  7393. if ProcArg.ArgType=nil then
  7394. RaiseMsg(20170924202531,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7395. [IntToStr(ArgNo),'untyped',GetTypeDescription(IndexResolved)],ErrorEl)
  7396. else
  7397. begin
  7398. if CheckParamCompatibility(IndexExpr,ProcArg,ArgNo,true)=cIncompatible then
  7399. begin
  7400. ComputeElement(ProcArg.ArgType,ProcArgResolved,[rcType]);
  7401. RaiseIncompatibleTypeRes(20170924203829,nIncompatibleTypeArgNo,
  7402. [IntToStr(ArgNo)],ProcArgResolved,IndexResolved,ErrorEl);
  7403. end;
  7404. end;
  7405. end;
  7406. procedure CheckArgs(Proc: TPasProcedure; const IndexVal: TResEvalValue;
  7407. const IndexResolved: TPasResolverResult; ErrorEl: TPasElement);
  7408. var
  7409. ArgNo: Integer;
  7410. PropArg, ProcArg: TPasArgument;
  7411. PropArgResolved, ProcArgResolved: TPasResolverResult;
  7412. NeedCheckingAccess: Boolean;
  7413. begin
  7414. ArgNo:=0;
  7415. while ArgNo<PropEl.Args.Count do
  7416. begin
  7417. if ArgNo>=Proc.ProcType.Args.Count then
  7418. RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
  7419. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7420. PropArg:=TPasArgument(PropEl.Args[ArgNo]);
  7421. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7422. inc(ArgNo);
  7423. // check access: var, const, ...
  7424. NeedCheckingAccess:=false;
  7425. if PropArg.Access<>ProcArg.Access then
  7426. begin
  7427. if (PropArg.Access in [argDefault, argConst])
  7428. and (ProcArg.Access in [argDefault, argConst]) then
  7429. begin
  7430. // passing an arg as default to const or const to default
  7431. if (PropArg.ArgType<>nil)
  7432. and (ProcArg.ArgType<>nil) then
  7433. NeedCheckingAccess:=true;
  7434. end;
  7435. if not NeedCheckingAccess then
  7436. RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7437. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7438. AccessDescriptions[PropArg.Access]],ErrorEl);
  7439. end;
  7440. // check argument type
  7441. if PropArg.ArgType=nil then
  7442. begin
  7443. if ProcArg.ArgType<>nil then
  7444. RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7445. [IntToStr(ArgNo),GetElementTypeName(ProcArg.ArgType),'untyped'],ErrorEl);
  7446. end
  7447. else if ProcArg.ArgType=nil then
  7448. RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7449. [IntToStr(ArgNo),'untyped',GetElementTypeName(PropArg.ArgType)],ErrorEl)
  7450. else
  7451. begin
  7452. ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
  7453. ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
  7454. if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
  7455. RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7456. [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
  7457. if PropArgResolved.LoTypeEl=nil then
  7458. RaiseInternalError(20161010125255);
  7459. if ProcArgResolved.LoTypeEl=nil then
  7460. RaiseInternalError(20161010125304);
  7461. if not IsSameType(PropArgResolved.HiTypeEl,ProcArgResolved.HiTypeEl,prraSimple) then
  7462. RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
  7463. [IntToStr(ArgNo)],ProcArgResolved.HiTypeEl,PropArgResolved.HiTypeEl,ErrorEl);
  7464. end;
  7465. if NeedCheckingAccess then
  7466. begin
  7467. // passing an arg as default to const or const to default
  7468. // e.g.
  7469. // function GetItems(const i: integer): byte;
  7470. // property Items[i: integer]: byte read GetItems;
  7471. // => allowed for simple types
  7472. if not (PropArgResolved.BaseType in (btAllBooleans+btAllInteger+btAllStringAndChars+btAllFloats)) then
  7473. RaiseMsg(20181007181647,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7474. [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
  7475. AccessDescriptions[PropArg.Access]],ErrorEl);
  7476. end;
  7477. end;
  7478. if IndexVal<>nil then
  7479. begin
  7480. if ArgNo>=Proc.ProcType.Args.Count then
  7481. RaiseMsg(20170924202334,nWrongNumberOfParametersForCallTo,
  7482. sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
  7483. ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
  7484. CheckIndexArg(ArgNo,IndexResolved,ProcArg,ErrorEl);
  7485. end;
  7486. end;
  7487. procedure CheckImplements;
  7488. var
  7489. i, j: Integer;
  7490. Expr: TPasExpr;
  7491. ResolvedEl: TPasResolverResult;
  7492. aClass, PropClassType: TPasClassType;
  7493. IntfType, OrigIntfType, PropTypeRes: TPasType;
  7494. o: TObject;
  7495. begin
  7496. if not (PropEl.Parent is TPasClassType) then
  7497. RaiseInternalError(20180323172125,GetElementDbgPath(PropEl));
  7498. aClass:=TPasClassType(PropEl.Parent);
  7499. if PropEl.Args.Count>0 then
  7500. RaiseMsg(20180323170952,nImplementsDoesNotSupportArrayProperty,
  7501. sImplementsDoesNotSupportArrayProperty,[],PropEl.Implements[0]);
  7502. if IndexExpr<>nil then
  7503. RaiseMsg(20180323171354,nImplementsDoesNotSupportIndex,
  7504. sImplementsDoesNotSupportIndex,[],PropEl.Implements[0]);
  7505. if GetPasPropertyGetter(PropEl)=nil then
  7506. RaiseMsg(20180323221322,nImplPropMustHaveReadSpec,
  7507. sImplPropMustHaveReadSpec,[],PropEl.Implements[0]);
  7508. for i:=0 to length(PropEl.Implements)-1 do
  7509. begin
  7510. // resolve expression
  7511. Expr:=PropEl.Implements[i];
  7512. ResolveExpr(Expr,rraRead);
  7513. // check expr is an interface type
  7514. ComputeElement(Expr,ResolvedEl,[rcType,rcNoImplicitProc]);
  7515. if not (ResolvedEl.IdentEl is TPasType) then
  7516. if ResolvedEl.IdentEl=nil then
  7517. RaiseXExpectedButYFound(20180323171911,'interface',
  7518. GetElementTypeName(ResolvedEl.LoTypeEl),Expr)
  7519. else
  7520. RaiseXExpectedButYFound(20180323224846,'interface',
  7521. GetElementTypeName(ResolvedEl.IdentEl),Expr);
  7522. OrigIntfType:=TPasType(ResolvedEl.IdentEl);
  7523. IntfType:=ResolveAliasType(OrigIntfType);
  7524. if (not (IntfType is TPasClassType))
  7525. or (TPasClassType(IntfType).ObjKind<>okInterface) then
  7526. RaiseXExpectedButYFound(20180323172904,'interface',
  7527. GetElementTypeName(OrigIntfType),Expr);
  7528. // check it is one of the current implemented interfaces (not of ancestors)
  7529. j:=IndexOfImplementedInterface(aClass,IntfType);
  7530. if j<0 then
  7531. RaiseMsg(20180323172420,nImplementsUsedOnUnimplIntf,sImplementsUsedOnUnimplIntf,
  7532. [OrigIntfType.Name],Expr);
  7533. // check property type fits
  7534. PropTypeRes:=ResolveAliasType(PropType);
  7535. if not (PropTypeRes is TPasClassType) then
  7536. RaiseMsg(20180323222334,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7537. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7538. PropClassType:=TPasClassType(PropTypeRes);
  7539. case PropClassType.ObjKind of
  7540. okClass:
  7541. // e.g. property Obj: ClassType read Getter implements IntfType
  7542. // check ClassType or ancestors implements IntfType
  7543. if GetClassImplementsIntf(PropClassType,TPasClassType(IntfType))=nil then
  7544. RaiseMsg(20180323223324,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7545. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7546. okInterface:
  7547. // e.g. property IntfVar: IntfType read Getter implements IntfType2
  7548. // check that IntfType is IntfType2
  7549. if CheckClassIsClass(PropType,IntfType)=cIncompatible then
  7550. RaiseIncompatibleType(20180323173746,nIncompatibleTypesGotExpected,
  7551. [],OrigIntfType,PropType,Expr);
  7552. else
  7553. RaiseMsg(20180323222821,nDoesNotImplementInterface,sDoesNotImplementInterface,
  7554. [GetElementTypeName(PropType),GetElementTypeName(OrigIntfType)],Expr);
  7555. end;
  7556. // map
  7557. o:=TObject(ClassScope.Interfaces[j]);
  7558. if o is TPasProperty then
  7559. RaiseMsg(20180323174240,nDuplicateImplementsForIntf,sDuplicateImplementsForIntf,
  7560. [OrigIntfType.Name,GetElementSourcePosStr(TPasProperty(o))],Expr)
  7561. else if o is TPasClassIntfMap then
  7562. begin
  7563. // properties are checked before method resolutions
  7564. RaiseInternalError(20180323175919,GetElementDbgPath(PropEl));
  7565. end
  7566. else if o<>nil then
  7567. RaiseInternalError(20180323174342,GetObjName(o))
  7568. else
  7569. ClassScope.Interfaces[j]:=PropEl;
  7570. end;
  7571. end;
  7572. procedure CheckStoredAccessor(Expr: TPasExpr; const IndexVal: TResEvalValue;
  7573. const IndexResolved: TPasResolverResult);
  7574. var
  7575. ResolvedEl: TPasResolverResult;
  7576. Value: TResEvalValue;
  7577. Proc: TPasProcedure;
  7578. ResultType, TypeEl: TPasType;
  7579. aVar: TPasVariable;
  7580. IdentEl: TPasElement;
  7581. ExpArgCnt: Integer;
  7582. ProcArg: TPasArgument;
  7583. begin
  7584. ResolveExpr(Expr,rraRead);
  7585. ComputeElement(Expr,ResolvedEl,[rcNoImplicitProc]);
  7586. IdentEl:=ResolvedEl.IdentEl;
  7587. if IdentEl is TPasProcedure then
  7588. begin
  7589. // function
  7590. Proc:=TPasProcedure(IdentEl);
  7591. // check if member
  7592. if not (Expr is TPrimitiveExpr) then
  7593. RaiseXExpectedButYFound(20170923202002,'member function','foreign '+GetElementTypeName(Proc),Expr);
  7594. if Proc.ClassType<>TPasFunction then
  7595. RaiseXExpectedButYFound(20170216151925,'function',GetElementTypeName(Proc),Expr);
  7596. // check function result type
  7597. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7598. if not IsBaseType(ResultType,btBoolean,true) then
  7599. RaiseXExpectedButYFound(20170923200836,'function: boolean',
  7600. 'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
  7601. if Proc.IsAsync then
  7602. RaiseInvalidProcTypeModifier(20200524104719,Proc.ProcType,ptmAsync,Expr);
  7603. // check arg count
  7604. ExpArgCnt:=0;
  7605. if IndexVal<>nil then
  7606. inc(ExpArgCnt);
  7607. if Proc.ProcType.Args.Count<>ExpArgCnt then
  7608. RaiseMsg(20170923200840,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7609. [Proc.Name],Expr);
  7610. if IndexVal<>nil then
  7611. begin
  7612. // check arg type
  7613. ProcArg:=TPasArgument(Proc.ProcType.Args[0]);
  7614. CheckIndexArg(1,IndexResolved,ProcArg,Expr);
  7615. end;
  7616. exit;
  7617. end;
  7618. if (IdentEl<>nil)
  7619. and ((IdentEl.ClassType=TPasVariable)
  7620. or ((IdentEl.ClassType=TPasConst) and not TPasConst(IdentEl).IsConst)) then
  7621. begin
  7622. // field
  7623. aVar:=TPasVariable(IdentEl);
  7624. // check if member
  7625. if not (Expr is TPrimitiveExpr) then
  7626. RaiseXExpectedButYFound(20170923202003,'member variable','foreign '+GetElementTypeName(aVar),Expr);
  7627. // check type boolean
  7628. TypeEl:=aVar.VarType;
  7629. TypeEl:=ResolveAliasType(TypeEl);
  7630. if not IsBaseType(TypeEl,btBoolean,true) then
  7631. RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
  7632. [],TypeEl,BaseTypes[btBoolean],Expr);
  7633. // check class var
  7634. if (vmClass in PropEl.VarModifiers)<>(vmClass in aVar.VarModifiers) then
  7635. if vmClass in PropEl.VarModifiers then
  7636. RaiseXExpectedButYFound(20170409214351,'class var','var',Expr)
  7637. else
  7638. RaiseXExpectedButYFound(20170409214359,'var','class var',Expr);
  7639. exit;
  7640. end;
  7641. if (ResolvedEl.BaseType=btBoolean) and (ResolvedEl.ExprEl<>nil) then
  7642. begin
  7643. // try evaluating const boolean
  7644. Value:=Eval(Expr,[refConst]);
  7645. if Value<>nil then
  7646. try
  7647. if Value.Kind<>revkBool then
  7648. RaiseXExpectedButYFound(20170923200256,'boolean',GetResolverResultDescription(ResolvedEl),Expr);
  7649. exit;
  7650. finally
  7651. ReleaseEvalValue(Value);
  7652. end;
  7653. end;
  7654. RaiseXExpectedButYFound(20170923194234,'identifier',GetResolverResultDescription(ResolvedEl),Expr);
  7655. end;
  7656. var
  7657. ResultType, aType: TPasType;
  7658. MembersType: TPasMembersType;
  7659. AccEl: TPasElement;
  7660. Proc: TPasProcedure;
  7661. Arg: TPasArgument;
  7662. PropArgCount, NeedArgCnt: Integer;
  7663. PropTypeResolved, DefaultResolved, IndexResolved,
  7664. AncIndexResolved: TPasResolverResult;
  7665. m: TVariableModifier;
  7666. IndexVal: TResEvalValue;
  7667. AncIndexExpr, ErrorEl: TPasExpr;
  7668. CurClass: TPasClassType;
  7669. begin
  7670. CheckTopScope(TPasPropertyScope);
  7671. PopScope;
  7672. if PropEl.Visibility=visPublished then
  7673. for m in PropEl.VarModifiers do
  7674. if not (m in [vmExternal]) then
  7675. RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
  7676. ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
  7677. PropType:=nil;
  7678. MembersType:=PropEl.Parent as TPasMembersType;
  7679. ClassOrRecScope:=NoNil(MembersType.CustomData) as TPasClassOrRecordScope;
  7680. ClassScope:=nil;
  7681. CurClass:=nil;
  7682. if ClassOrRecScope is TPasClassScope then
  7683. begin
  7684. ClassScope:=TPasClassScope(ClassOrRecScope);
  7685. CurClass:=TPasClassType(MembersType);
  7686. end;
  7687. AncestorProp:=nil;
  7688. GetPropType;
  7689. IndexVal:=nil;
  7690. try
  7691. if PropEl.IndexExpr<>nil then
  7692. begin
  7693. // index specifier
  7694. // -> check if simple value
  7695. IndexExpr:=PropEl.IndexExpr;
  7696. ResolveExpr(IndexExpr,rraRead);
  7697. end
  7698. else
  7699. IndexExpr:=GetPasPropertyIndex(PropEl);
  7700. if IndexExpr<>nil then
  7701. begin
  7702. ComputeElement(IndexExpr,IndexResolved,[rcConstant]);
  7703. IndexVal:=Eval(IndexExpr,[refConst]);
  7704. case IndexVal.Kind of
  7705. revkBool,
  7706. revkInt, revkUInt,
  7707. revkFloat,
  7708. revkCurrency,
  7709. {$ifdef FPC_HAS_CPSTRING}
  7710. revkString,
  7711. {$endif}
  7712. revkUnicodeString,
  7713. revkEnum: ; // ok
  7714. else
  7715. RaiseXExpectedButYFound(20170924202837,'ordinal',GetTypeDescription(IndexResolved),PropEl.IndexExpr);
  7716. end;
  7717. if (PropEl.IndexExpr<>nil) and (PropEl.VarType=nil) then
  7718. begin
  7719. // check if index is compatible to ancestor index specifier
  7720. AncIndexExpr:=GetPasPropertyIndex(AncestorProp);
  7721. if AncIndexExpr=nil then
  7722. begin
  7723. // ancestor had no index specifier
  7724. if PropEl.ReadAccessor=nil then
  7725. begin
  7726. AccEl:=GetPasPropertyGetter(AncestorProp);
  7727. if AccEl is TPasProcedure then
  7728. RaiseMsg(20171002144103,nAddingIndexSpecifierRequiresNewX,
  7729. sAddingIndexSpecifierRequiresNewX,['read'],IndexExpr);
  7730. end;
  7731. if PropEl.WriteAccessor=nil then
  7732. begin
  7733. AccEl:=GetPasPropertySetter(AncestorProp);
  7734. if AccEl is TPasProcedure then
  7735. RaiseMsg(20171002144419,nAddingIndexSpecifierRequiresNewX,
  7736. sAddingIndexSpecifierRequiresNewX,['write'],IndexExpr);
  7737. end;
  7738. if PropEl.StoredAccessor=nil then
  7739. begin
  7740. AccEl:=GetPasPropertyStoredExpr(AncestorProp);
  7741. if AccEl<>nil then
  7742. begin
  7743. ComputeElement(AccEl,AncIndexResolved,[rcNoImplicitProc]);
  7744. if AncIndexResolved.IdentEl is TPasProcedure then
  7745. RaiseMsg(20171002144644,nAddingIndexSpecifierRequiresNewX,
  7746. sAddingIndexSpecifierRequiresNewX,['stored'],IndexExpr);
  7747. end;
  7748. end;
  7749. end
  7750. else
  7751. // ancestor had already an index specifier -> check same type
  7752. CheckEqualElCompatibility(PropEl.IndexExpr,AncIndexExpr,PropEl.IndexExpr,true);
  7753. end;
  7754. end;
  7755. if PropEl.ReadAccessor<>nil then
  7756. begin
  7757. // check compatibility
  7758. ErrorEl:=PropEl.ReadAccessor;
  7759. AccEl:=ResolveAccessor(PropEl.ReadAccessor);
  7760. if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
  7761. begin
  7762. if (PropEl.Args.Count>0) then
  7763. RaiseXExpectedButYFound(20170216151823,'function',GetElementTypeName(AccEl),ErrorEl);
  7764. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7765. RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
  7766. [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
  7767. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7768. if vmClass in PropEl.VarModifiers then
  7769. RaiseXExpectedButYFound(20170216151828,'class var','var',ErrorEl)
  7770. else
  7771. RaiseXExpectedButYFound(20170216151831,'var','class var',ErrorEl);
  7772. end
  7773. else if AccEl is TPasProcedure then
  7774. begin
  7775. // check function
  7776. Proc:=TPasProcedure(AccEl);
  7777. if (vmClass in PropEl.VarModifiers) then
  7778. begin
  7779. if Proc.ClassType<>TPasClassFunction then
  7780. RaiseXExpectedButYFound(20170216151834,'class function',GetElementTypeName(Proc),ErrorEl);
  7781. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7782. if Proc.IsStatic then
  7783. RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
  7784. else
  7785. RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
  7786. end
  7787. else
  7788. begin
  7789. if Proc.ClassType<>TPasFunction then
  7790. RaiseXExpectedButYFound(20170216151842,'function',GetElementTypeName(Proc),ErrorEl);
  7791. end;
  7792. // check function result type
  7793. ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
  7794. if not IsSameType(ResultType,PropType,prraAlias) then
  7795. RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
  7796. GetTypeDescription(ResultType,true),ErrorEl);
  7797. if Proc.IsAsync then
  7798. RaiseMsg(20200526101546,nInvalidXModifierY,sInvalidXModifierY,['property getter',
  7799. ProcTypeModifiers[ptmAsync]],ErrorEl);
  7800. // check args
  7801. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.ReadAccessor);
  7802. NeedArgCnt:=PropEl.Args.Count;
  7803. if IndexVal<>nil then
  7804. inc(NeedArgCnt);
  7805. if Proc.ProcType.Args.Count<>NeedArgCnt then
  7806. RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7807. [Proc.Name],ErrorEl);
  7808. end
  7809. else
  7810. RaiseXExpectedButYFound(20170216151850,'variable',GetElementTypeName(AccEl),ErrorEl);
  7811. end;
  7812. if PropEl.WriteAccessor<>nil then
  7813. begin
  7814. // check compatibility
  7815. ErrorEl:=PropEl.WriteAccessor;
  7816. AccEl:=ResolveAccessor(PropEl.WriteAccessor);
  7817. if (AccEl.ClassType=TPasVariable)
  7818. or ((AccEl.ClassType=TPasConst) and (not TPasConst(AccEl).IsConst)) then
  7819. begin
  7820. if (PropEl.Args.Count>0) then
  7821. RaiseXExpectedButYFound(20170216151852,'procedure',GetElementTypeName(AccEl),ErrorEl);
  7822. if not IsSameType(TPasVariable(AccEl).VarType,PropType,prraAlias) then
  7823. RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
  7824. [],PropType,TPasVariable(AccEl).VarType,ErrorEl);
  7825. if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
  7826. if vmClass in PropEl.VarModifiers then
  7827. RaiseXExpectedButYFound(20170216151858,'class var','var',ErrorEl)
  7828. else
  7829. RaiseXExpectedButYFound(20170216151900,'var','class var',ErrorEl);
  7830. end
  7831. else if AccEl is TPasProcedure then
  7832. begin
  7833. // check procedure
  7834. Proc:=TPasProcedure(AccEl);
  7835. if (vmClass in PropEl.VarModifiers) then
  7836. begin
  7837. if Proc.ClassType<>TPasClassProcedure then
  7838. RaiseXExpectedButYFound(20170216151903,'class procedure',GetElementTypeName(Proc),ErrorEl);
  7839. if not CheckClassAccessorStatic(Proc.IsStatic) then
  7840. if Proc.IsStatic then
  7841. RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],ErrorEl)
  7842. else
  7843. RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],ErrorEl);
  7844. end
  7845. else
  7846. begin
  7847. if Proc.ClassType<>TPasProcedure then
  7848. RaiseXExpectedButYFound(20170216151910,'procedure',GetElementTypeName(Proc),ErrorEl);
  7849. end;
  7850. if Proc.IsAsync then
  7851. RaiseMsg(20200526101635,nInvalidXModifierY,sInvalidXModifierY,['property setter',
  7852. ProcTypeModifiers[ptmAsync]],ErrorEl);
  7853. // check args
  7854. CheckArgs(Proc,IndexVal,IndexResolved,PropEl.WriteAccessor);
  7855. // check write arg
  7856. PropArgCount:=PropEl.Args.Count;
  7857. if IndexVal<>nil then
  7858. inc(PropArgCount);
  7859. if Proc.ProcType.Args.Count<>PropArgCount+1 then
  7860. RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  7861. [Proc.Name],ErrorEl);
  7862. Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
  7863. if not (Arg.Access in [argDefault,argConst]) then
  7864. RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  7865. [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
  7866. AccessDescriptions[argConst]],ErrorEl);
  7867. if not IsSameType(Arg.ArgType,PropType,prraAlias) then
  7868. RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
  7869. [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,ErrorEl);
  7870. end
  7871. else
  7872. RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),ErrorEl);
  7873. end
  7874. else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
  7875. RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
  7876. if length(PropEl.Implements)>0 then
  7877. CheckImplements;
  7878. if PropEl.StoredAccessor<>nil then
  7879. begin
  7880. // check compatibility
  7881. CheckStoredAccessor(PropEl.StoredAccessor,IndexVal,IndexResolved);
  7882. end;
  7883. if PropEl.DefaultExpr<>nil then
  7884. begin
  7885. // check compatibility with type
  7886. ResolveExpr(PropEl.DefaultExpr,rraRead);
  7887. ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
  7888. ComputeElement(PropType,PropTypeResolved,[rcType]);
  7889. PropTypeResolved.IdentEl:=PropEl;
  7890. PropTypeResolved.Flags:=[rrfReadable];
  7891. CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
  7892. end;
  7893. if PropEl.IsDefault then
  7894. begin
  7895. if (CurClass<>nil) and (CurClass.HelperForType<>nil) then
  7896. begin
  7897. aType:=ResolveAliasType(CurClass.HelperForType);
  7898. if not (aType is TPasMembersType) then
  7899. RaiseMsg(20190117125004,nDefaultPropertyNotAllowedInHelperForX,
  7900. sDefaultPropertyNotAllowedInHelperForX,
  7901. [GetTypeDescription(CurClass.HelperForType)],PropEl);
  7902. end;
  7903. // set default array property
  7904. if (ClassOrRecScope.DefaultProperty<>nil)
  7905. and (ClassOrRecScope.DefaultProperty.Parent=PropEl.Parent) then
  7906. RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
  7907. ClassOrRecScope.DefaultProperty:=PropEl;
  7908. end;
  7909. EmitTypeHints(PropEl,PropEl.VarType);
  7910. finally
  7911. ReleaseEvalValue(IndexVal);
  7912. end;
  7913. end;
  7914. procedure TPasResolver.FinishArgument(El: TPasArgument);
  7915. procedure CheckHasGenTemplRef(Arg: TPasArgument);
  7916. procedure Check(Parent: TPasElement; Cur: TPasType; TemplTypes: TFPList);
  7917. var
  7918. C: TClass;
  7919. Arr: TPasArrayType;
  7920. begin
  7921. if Cur=nil then exit;
  7922. C:=Cur.ClassType;
  7923. if C=TPasGenericTemplateType then
  7924. begin
  7925. if TemplTypes.IndexOf(Cur)>=0 then
  7926. RaiseMsg(20191007213121,nParamOfThisTypeCannotHaveDefVal,sParamOfThisTypeCannotHaveDefVal,[],El);
  7927. end
  7928. else if Cur.Parent<>Parent then
  7929. exit
  7930. else if C=TPasArrayType then
  7931. begin
  7932. Arr:=TPasArrayType(Cur);
  7933. Check(Arr,Arr.ElType,TemplTypes);
  7934. end;
  7935. end;
  7936. var
  7937. Proc: TPasProcedure;
  7938. TemplTypes: TFPList;
  7939. begin
  7940. if Arg.ArgType=nil then exit;
  7941. if not (Arg.Parent is TPasProcedureType) then exit;
  7942. if not (Arg.Parent.Parent is TPasProcedure) then exit;
  7943. Proc:=TPasProcedure(Arg.Parent.Parent);
  7944. TemplTypes:=GetProcTemplateTypes(Proc);
  7945. if TemplTypes=nil then exit;
  7946. Check(Arg,Arg.ArgType,TemplTypes);
  7947. end;
  7948. var
  7949. IsDelphi: Boolean;
  7950. begin
  7951. if not (El.Access in [argDefault,argConst,argVar,argOut,argConstRef]) then
  7952. RaiseMsg(20191018235644,nNotYetImplemented,sNotYetImplemented,[AccessDescriptions[El.Access]],El);
  7953. if El.ArgType<>nil then
  7954. CheckUseAsType(El.ArgType,20190123100049,El);
  7955. if El.ValueExpr<>nil then
  7956. begin
  7957. ResolveExpr(El.ValueExpr,rraRead);
  7958. if El.ArgType<>nil then
  7959. begin
  7960. CheckAssignCompatibility(El,El.ValueExpr,true);
  7961. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  7962. if IsDelphi then
  7963. CheckHasGenTemplRef(El);
  7964. end;
  7965. end;
  7966. EmitTypeHints(El,El.ArgType);
  7967. end;
  7968. procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
  7969. // called when the ancestor and interface list of a class has been parsed,
  7970. // before parsing the class elements
  7971. var
  7972. DirectAncestor: TPasType; // e.g. TPasAliasType or TPasClassType
  7973. AncestorClassEl: TPasClassType;
  7974. function IsDefaultAncestor(c: TPasClassType; const DefAncestorName: string): boolean;
  7975. begin
  7976. Result:=SameText(c.Name,DefAncestorName)
  7977. and (c.Parent is TPasSection);
  7978. end;
  7979. procedure FindDefaultAncestor(const DefAncestorName, Expected: string);
  7980. var
  7981. CurEl: TPasElement;
  7982. begin
  7983. AncestorClassEl:=nil;
  7984. if SameText(aClass.Name,DefAncestorName) then
  7985. begin
  7986. if IsDefaultAncestor(aClass,DefAncestorName) then exit;
  7987. RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
  7988. end;
  7989. CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false,true);
  7990. if not (CurEl is TPasType) then
  7991. RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
  7992. DirectAncestor:=TPasType(CurEl);
  7993. CurEl:=ResolveAliasType(DirectAncestor);
  7994. if not (CurEl is TPasClassType) then
  7995. RaiseXExpectedButYFound(20170216151941,Expected,GetElementTypeName(DirectAncestor),aClass);
  7996. AncestorClassEl:=TPasClassType(CurEl);
  7997. end;
  7998. var
  7999. ClassScope, AncestorClassScope: TPasClassScope;
  8000. AncestorType, El: TPasType;
  8001. i: Integer;
  8002. aModifier, DefAncestorName: String;
  8003. IsSealed, IsDelphi: Boolean;
  8004. CanonicalSelf: TPasClassOfType;
  8005. Decl: TPasElement;
  8006. j, TypeParamCnt: integer;
  8007. IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
  8008. ResIntfList, Members: TFPList;
  8009. GroupScope: TPasGroupScope;
  8010. C: TClass;
  8011. begin
  8012. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  8013. if aClass.IsForward then
  8014. begin
  8015. PopGenericParamScope(aClass);
  8016. // check for duplicate forwards
  8017. C:=aClass.Parent.ClassType;
  8018. if C.InheritsFrom(TPasDeclarations) then
  8019. Members:=TPasDeclarations(aClass.Parent).Declarations
  8020. else if (C=TPasClassType) or (C=TPasRecordType) then
  8021. Members:=TPasMembersType(aClass.Parent).Members
  8022. else
  8023. RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
  8024. TypeParamCnt:=GetTypeParameterCount(aClass);
  8025. for i:=0 to Members.Count-1 do
  8026. begin
  8027. Decl:=TPasElement(Members[i]);
  8028. if (CompareText(Decl.Name,aClass.Name)<>0)
  8029. or (Decl=aClass) then continue;
  8030. if (Decl is TPasGenericType)
  8031. and (GetTypeParameterCount(TPasGenericType(Decl))<>TypeParamCnt) then
  8032. continue;
  8033. RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
  8034. [Decl.Name,GetElementSourcePosStr(Decl)],aClass);
  8035. end;
  8036. if TypeParamCnt>0 then
  8037. begin
  8038. // A generic forward needs TPasClassScope to store the specialized types.
  8039. // Will later be transferred to the actual class.
  8040. CreateScope(aClass,ScopeClass_Class);
  8041. end;
  8042. exit;
  8043. end;
  8044. // not forward, actual declaration ...
  8045. case aClass.ObjKind of
  8046. okClass:
  8047. begin
  8048. AncestorType:=ResolveAliasType(aClass.AncestorType);
  8049. if (AncestorType is TPasClassType)
  8050. and (TPasClassType(AncestorType).ObjKind=okInterface)
  8051. and not isDelphi then
  8052. begin
  8053. // e.g. type c = class(intf)
  8054. // ObjFPC allows to omit TObject as default ancestor, Delphi does not
  8055. aClass.Interfaces.Insert(0,aClass.AncestorType);
  8056. aClass.AncestorType:=nil;
  8057. end;
  8058. end;
  8059. okInterface:
  8060. begin
  8061. if aClass.IsExternal then
  8062. RaiseMsg(20180321115831,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8063. if not (aClass.InterfaceType in [citCom,citCorba]) then
  8064. RaiseMsg(20180321143613,nIllegalQualifier,sIllegalQualifier,
  8065. [CurrentParser.Scanner.CurrentValueSwitch[vsInterfaces]],aClass);
  8066. end;
  8067. okClassHelper,okRecordHelper,okTypeHelper:
  8068. begin
  8069. if aClass.IsExternal then
  8070. RaiseMsg(20190116192722,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8071. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8072. if HelperForType=nil then
  8073. RaiseNotYetImplemented(20191016125557,aClass);
  8074. if (aClass=HelperForType) or (aClass.HasParent(HelperForType)) then
  8075. RaiseMsg(20190118190935,nTypeXIsNotYetCompletelyDefined,
  8076. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8077. case aClass.ObjKind of
  8078. okClassHelper:
  8079. begin
  8080. if not (HelperForType is TPasClassType) then
  8081. RaiseXExpectedButYFound(20190116194751,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  8082. if TPasClassType(HelperForType).ObjKind<>okClass then
  8083. RaiseXExpectedButYFound(20190116194855,'class type',GetTypeDescription(aClass.HelperForType),aClass);
  8084. if TPasClassType(HelperForType).IsForward then
  8085. RaiseMsg(20190116194931,nTypeXIsNotYetCompletelyDefined,
  8086. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8087. end;
  8088. okRecordHelper:
  8089. if isDelphi then
  8090. begin
  8091. if (HelperForType.ClassType=TPasRecordType)
  8092. or (HelperForType.ClassType=TPasArrayType)
  8093. or (HelperForType.ClassType=TPasSetType)
  8094. or (HelperForType.ClassType=TPasEnumType)
  8095. or (HelperForType.ClassType=TPasRangeType)
  8096. then
  8097. // ok
  8098. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  8099. and (HelperForType.CustomData is TResElDataBaseType)) then
  8100. else
  8101. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByARecordHelper,
  8102. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  8103. end
  8104. else
  8105. begin
  8106. // mode objfpc
  8107. if (HelperForType.ClassType=TPasRecordType) then
  8108. else
  8109. RaiseMsg(20190116200519,nTypeXCannotBeExtendedByARecordHelper,
  8110. sTypeXCannotBeExtendedByARecordHelper,[GetTypeDescription(HelperForType)],aClass);
  8111. end;
  8112. okTypeHelper:
  8113. begin
  8114. if (HelperForType.ClassType=TPasRecordType)
  8115. or (HelperForType.ClassType=TPasArrayType)
  8116. or (HelperForType.ClassType=TPasSetType)
  8117. or (HelperForType.ClassType=TPasEnumType)
  8118. or (HelperForType.ClassType=TPasRangeType)
  8119. then
  8120. // ok
  8121. else if ((HelperForType.ClassType=TPasUnresolvedSymbolRef)
  8122. and (HelperForType.CustomData is TResElDataBaseType)) then
  8123. else if (HelperForType.ClassType=TPasClassType)
  8124. and (TPasClassType(HelperForType).ObjKind in [okClass,okInterface]) then
  8125. begin
  8126. if TPasClassType(HelperForType).IsForward then
  8127. RaiseMsg(20190116200940,nTypeXIsNotYetCompletelyDefined,
  8128. sTypeXIsNotYetCompletelyDefined,[HelperForType.Name],aClass);
  8129. end
  8130. else
  8131. RaiseMsg(20190116200304,nTypeXCannotBeExtendedByATypeHelper,
  8132. sTypeXCannotBeExtendedByATypeHelper,[GetTypeDescription(HelperForType)],aClass);
  8133. end;
  8134. end;
  8135. end
  8136. else
  8137. RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
  8138. end;
  8139. IsSealed:=false;
  8140. for i:=0 to aClass.Modifiers.Count-1 do
  8141. begin
  8142. aModifier:=lowercase(aClass.Modifiers[i]);
  8143. case aModifier of
  8144. 'sealed': IsSealed:=true;
  8145. 'abstract': ;
  8146. else
  8147. RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
  8148. end;
  8149. end;
  8150. AncestorClassEl:=nil;
  8151. DirectAncestor:=aClass.AncestorType;
  8152. AncestorType:=ResolveAliasType(DirectAncestor);
  8153. if AncestorType=nil then
  8154. begin
  8155. if DirectAncestor<>nil then
  8156. RaiseInternalError(20180321151851,GetObjName(DirectAncestor));
  8157. // use default ancestor
  8158. DefAncestorName:='';
  8159. case aClass.ObjKind of
  8160. okClass:
  8161. begin
  8162. DefAncestorName:='TObject';
  8163. if aClass.IsExternal or IsDefaultAncestor(aClass,DefAncestorName) then
  8164. begin
  8165. // ok, no ancestor
  8166. AncestorClassEl:=nil;
  8167. end
  8168. else
  8169. begin
  8170. // search default ancestor TObject
  8171. FindDefaultAncestor(DefAncestorName,'class type');
  8172. if TPasClassType(AncestorClassEl).ObjKind<>okClass then
  8173. RaiseXExpectedButYFound(20180321145626,'class type',GetElementTypeName(AncestorClassEl),aClass);
  8174. end;
  8175. end;
  8176. okInterface:
  8177. begin
  8178. if aClass.InterfaceType=citCom then
  8179. begin
  8180. if isDelphi then
  8181. DefAncestorName:='IInterface'
  8182. else
  8183. DefAncestorName:='IUnknown';
  8184. if IsDefaultAncestor(aClass,DefAncestorName) then
  8185. AncestorClassEl:=nil
  8186. else
  8187. begin
  8188. // search default ancestor interface
  8189. FindDefaultAncestor(DefAncestorName,'interface type');
  8190. if TPasClassType(AncestorClassEl).ObjKind<>okInterface then
  8191. RaiseXExpectedButYFound(20180321145725,'interface type',
  8192. GetElementTypeName(AncestorClassEl),aClass);
  8193. end;
  8194. end;
  8195. end;
  8196. okClassHelper,okRecordHelper,okTypeHelper: ; // no root ancestor
  8197. end;
  8198. end
  8199. else if AncestorType.ClassType<>TPasClassType then
  8200. RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
  8201. else if aClass=AncestorType then
  8202. RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
  8203. else
  8204. begin
  8205. AncestorClassEl:=TPasClassType(AncestorType);
  8206. if AncestorClassEl.ObjKind<>aClass.ObjKind then
  8207. RaiseXExpectedButYFound(20180321152107,GetElementTypeName(aClass)+' type',
  8208. GetElementTypeName(AncestorClassEl)+' type',aClass);
  8209. if aClass.ObjKind in okAllHelpers then
  8210. begin
  8211. HelperForType:=ResolveAliasType(aClass.HelperForType);
  8212. AncestorHelperFor:=ResolveAliasType(AncestorClassEl.HelperForType);
  8213. if IsSameType(HelperForType,AncestorHelperFor,prraNone) then
  8214. // helper for same type as ancestor helper -> ok
  8215. else if (HelperForType is TPasClassType)
  8216. and (AncestorHelperFor is TPasClassType)
  8217. and (CheckClassIsClass(HelperForType,AncestorHelperFor)<>cIncompatible) then
  8218. // helper for descendant class of ancestor helper for -> ok
  8219. else
  8220. RaiseMsg(20190116203931,nDerivedXMustExtendASubClassY,sDerivedXMustExtendASubClassY,
  8221. [GetElementTypeName(aClass),AncestorClassEl.HelperForType.Name],aClass);
  8222. end;
  8223. EmitTypeHints(aClass,AncestorClassEl);
  8224. end;
  8225. AncestorClassScope:=nil;
  8226. if AncestorClassEl=nil then
  8227. begin
  8228. // root class e.g. TObject, IUnknown, helper
  8229. end
  8230. else
  8231. begin
  8232. // inherited class
  8233. if AncestorClassEl.IsForward then
  8234. RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
  8235. sCantUseForwardDeclarationAsAncestor,[AncestorClassEl.Name],aClass);
  8236. if aClass.IsExternal and not AncestorClassEl.IsExternal then
  8237. RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
  8238. [AncestorClassEl.Name],aClass);
  8239. AncestorClassScope:=AncestorClassEl.CustomData as TPasClassScope;
  8240. if pcsfSealed in AncestorClassScope.Flags then
  8241. RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedXY,
  8242. sCannotCreateADescendantOfTheSealedXY,
  8243. [GetElementTypeName(AncestorClassEl),AncestorClassEl.Name],aClass);
  8244. // check for cycle
  8245. El:=AncestorClassEl;
  8246. repeat
  8247. if El=aClass then
  8248. RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
  8249. if (El.ClassType=TPasAliasType)
  8250. or (El.ClassType=TPasTypeAliasType)
  8251. or (El.ClassType=TPasSpecializeType)
  8252. then
  8253. El:=TPasAliasType(El).DestType
  8254. else if El.ClassType=TPasClassType then
  8255. El:=TPasClassType(El).AncestorType
  8256. else
  8257. RaiseNotYetImplemented(20190825195203,aClass,GetObjName(El));
  8258. until El=nil;
  8259. end;
  8260. if TopScope is TPasGenericParamsScope then
  8261. PopGenericParamScope(aClass);
  8262. // start scope for members
  8263. {$IFDEF VerbosePasResolver}
  8264. //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
  8265. {$ENDIF}
  8266. if aClass.CustomData=nil then
  8267. ClassScope:=TPasClassScope(CreateScope(aClass,ScopeClass_Class))
  8268. else
  8269. begin
  8270. // has already the scope, e.g. scope moved from a generic forward
  8271. ClassScope:=aClass.CustomData as TPasClassScope;
  8272. if pcsfAncestorResolved in ClassScope.Flags then
  8273. RaiseNotYetImplemented(20190803203715,aClass);
  8274. end;
  8275. Include(ClassScope.Flags,pcsfAncestorResolved);
  8276. if IsSealed then
  8277. Include(ClassScope.Flags,pcsfSealed);
  8278. AddGenericTemplateIdentifiers(aClass.GenericTemplateTypes,ClassScope);
  8279. ClassScope.DirectAncestor:=DirectAncestor;
  8280. if AncestorClassEl<>nil then
  8281. begin
  8282. ClassScope.AncestorScope:=AncestorClassScope;
  8283. ClassScope.DefaultProperty:=AncestorClassScope.DefaultProperty;
  8284. if pcsfPublished in AncestorClassScope.Flags then
  8285. Include(ClassScope.Flags,pcsfPublished);
  8286. ClassScope.AbstractProcs:=copy(AncestorClassScope.AbstractProcs);
  8287. end;
  8288. if bsTypeInfo in CurrentParser.Scanner.CurrentBoolSwitches then
  8289. Include(ClassScope.Flags,pcsfPublished);
  8290. if aClass.ObjKind in ([okClass]+okAllHelpers) then
  8291. begin
  8292. // create canonical class-of for the "Self" in non static class functions
  8293. CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
  8294. ClassScope.CanonicalClassOf:=CanonicalSelf;
  8295. {$IFDEF CheckPasTreeRefCount}CanonicalSelf.RefIds.Add('TPasClassScope.CanonicalClassOf');{$ENDIF}
  8296. CanonicalSelf.DestType:=aClass;
  8297. aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasAliasType.DestType'){$ENDIF};
  8298. CanonicalSelf.Visibility:=visStrictPrivate;
  8299. CanonicalSelf.SourceFilename:=aClass.SourceFilename;
  8300. CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
  8301. end;
  8302. // push scope (must be done after setting aClass.AncestorScope)
  8303. GroupScope:=PushGroupScope(aClass);
  8304. GroupScope.VisibilityContext:=aClass;
  8305. // check interfaces
  8306. if aClass.Interfaces.Count>0 then
  8307. begin
  8308. if not (aClass.ObjKind in [okClass]) then
  8309. RaiseXExpectedButYFound(20180322001341,'one ancestor',
  8310. IntToStr(1+aClass.Interfaces.Count),aClass);
  8311. if aClass.IsExternal then
  8312. RaiseMsg(20180324183641,nIllegalQualifier,sIllegalQualifier,['external'],aClass);
  8313. ResIntfList:=TFPList.Create;
  8314. try
  8315. for i:=0 to aClass.Interfaces.Count-1 do
  8316. begin
  8317. IntfType:=TPasType(aClass.Interfaces[i]);
  8318. IntfTypeRes:=ResolveAliasType(IntfType);
  8319. if IntfTypeRes=nil then
  8320. RaiseMsg(20180322140044,nCantUseForwardDeclarationAsAncestor,
  8321. sCantUseForwardDeclarationAsAncestor,[IntfType.Name],aClass);
  8322. if not (IntfTypeRes is TPasClassType) then
  8323. RaiseXExpectedButYFound(20180322001051,'interface type',
  8324. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8325. if TPasClassType(IntfTypeRes).ObjKind<>okInterface then
  8326. RaiseXExpectedButYFound(20180322001143,'interface type',
  8327. GetElementTypeName(IntfTypeRes)+' type',aClass);
  8328. j:=ResIntfList.IndexOf(IntfTypeRes);
  8329. if j>=0 then
  8330. RaiseMsg(20180322001505,nDuplicateIdentifier,sDuplicateIdentifier,
  8331. [IntfType.Name,IntToStr(j+1)],aClass); // todo: jump to interface list
  8332. ResIntfList.Add(IntfTypeRes);
  8333. end;
  8334. finally
  8335. ResIntfList.Free;
  8336. end;
  8337. // create interfaces maps
  8338. ClassScope.Interfaces:=TFPList.Create;
  8339. ClassScope.Interfaces.Count:=aClass.Interfaces.Count;
  8340. end;
  8341. end;
  8342. procedure TPasResolver.FinishMethodResolution(El: TPasMethodResolution);
  8343. var
  8344. ResolvedEl: TPasResolverResult;
  8345. aClass, IntfType: TPasClassType;
  8346. i: Integer;
  8347. IntfProc: TPasProcedure;
  8348. Expr: TPasExpr;
  8349. ProcName: String;
  8350. IntfScope: TPasClassScope;
  8351. Identifier: TPasIdentifier;
  8352. begin
  8353. // procedure InterfaceName.InterfaceProc = ...
  8354. // check InterfaceName
  8355. ResolveExpr(El.InterfaceName,rraRead);
  8356. ComputeElement(El.InterfaceName,ResolvedEl,[rcType,rcNoImplicitProc]);
  8357. if not (ResolvedEl.IdentEl is TPasType) then
  8358. RaiseXExpectedButYFound(20180323132601,'interface type',
  8359. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8360. aClass:=El.Parent as TPasClassType;
  8361. i:=IndexOfImplementedInterface(aClass,TPasType(ResolvedEl.IdentEl));
  8362. if i<0 then
  8363. RaiseXExpectedButYFound(20180323133055,'interface type',
  8364. GetResolverResultDescription(ResolvedEl),El.InterfaceName);
  8365. IntfType:=TPasClassType(ResolveAliasType(TPasClassType(aClass.Interfaces[i])));
  8366. // check InterfaceProc
  8367. Expr:=El.InterfaceProc;
  8368. if not (Expr is TPrimitiveExpr) then
  8369. RaiseXExpectedButYFound(20180327152808,'method name',GetElementTypeName(Expr),Expr);
  8370. if TPrimitiveExpr(Expr).Kind<>pekIdent then
  8371. RaiseXExpectedButYFound(20180327152841,'method name',GetElementTypeName(Expr),Expr);
  8372. ProcName:=TPrimitiveExpr(Expr).Value;
  8373. IntfScope:=IntfType.CustomData as TPasClassScope;
  8374. IntfProc:=nil;
  8375. while IntfScope<>nil do
  8376. begin
  8377. Identifier:=IntfScope.FindLocalIdentifier(ProcName);
  8378. while Identifier<>nil do
  8379. begin
  8380. if not (Identifier.Element is TPasProcedure) then
  8381. RaiseXExpectedButYFound(20180327153110,'interface method',GetElementTypeName(Identifier.Element),Expr);
  8382. IntfProc:=TPasProcedure(Identifier.Element);
  8383. if IntfProc.ClassType=El.ProcClass then
  8384. break;
  8385. Identifier:=Identifier.NextSameIdentifier;
  8386. end;
  8387. IntfScope:=IntfScope.AncestorScope;
  8388. end;
  8389. if IntfProc=nil then
  8390. RaiseIdentifierNotFound(20180327153044,ProcName,Expr);
  8391. CreateReference(IntfProc,Expr,rraRead);
  8392. if IntfProc.ClassType<>El.ProcClass then
  8393. RaiseXExpectedButYFound(20180323144107,GetElementTypeName(El.ProcClass),GetElementTypeName(IntfProc),El.InterfaceProc);
  8394. // Note: do not create map here. CheckImplements in FinishProperty must be called before.
  8395. // El.ImplementationProc is resolved in FinishClassType
  8396. end;
  8397. procedure TPasResolver.FinishAttributes(El: TPasAttributes);
  8398. var
  8399. i, j: Integer;
  8400. NameExpr, Expr: TPasExpr;
  8401. Bin: TBinaryExpr;
  8402. LeftResolved, ParamResolved: TPasResolverResult;
  8403. aModule: TPasModule;
  8404. LTypeEl: TPasType;
  8405. AttrName: String;
  8406. Data: TPRFindData;
  8407. CurEl, DeclEl: TPasElement;
  8408. ClassEl: TPasClassType;
  8409. aConstructor: TPasConstructor;
  8410. Args: TFPList;
  8411. AttrRef, ParamRef: TResolvedReference;
  8412. DotScope: TPasDotBaseScope;
  8413. Params: TPasExprArray;
  8414. begin
  8415. for i:=0 to length(El.Calls)-1 do
  8416. begin
  8417. NameExpr:=El.Calls[i];
  8418. {$IFDEF VerbosePasResolver}
  8419. //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
  8420. {$ENDIF}
  8421. if NameExpr is TParamsExpr then
  8422. NameExpr:=TParamsExpr(NameExpr).Value;
  8423. DotScope:=nil;
  8424. if NameExpr is TBinaryExpr then
  8425. begin
  8426. Bin:=TBinaryExpr(NameExpr);
  8427. ResolveExpr(Bin.left,rraRead);
  8428. ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
  8429. if LeftResolved.BaseType=btModule then
  8430. begin
  8431. // e.g. unitname.identifier
  8432. // => search in interface and if this is our module in the implementation
  8433. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  8434. DotScope:=PushModuleDotScope(aModule);
  8435. end
  8436. else if (LeftResolved.BaseType=btContext)
  8437. and (LeftResolved.IdentEl is TPasType)
  8438. and (LeftResolved.LoTypeEl is TPasMembersType) then
  8439. begin
  8440. // classtype.identifier or recordtype.identifier
  8441. LTypeEl:=LeftResolved.LoTypeEl;
  8442. if LTypeEl.ClassType=TPasClassType then
  8443. begin
  8444. DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
  8445. DotScope.OnlyTypeMembers:=true;
  8446. end
  8447. else if LTypeEl.ClassType=TPasRecordType then
  8448. begin
  8449. DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
  8450. DotScope.OnlyTypeMembers:=true;
  8451. end
  8452. else
  8453. RaiseNotYetImplemented(20190221124930,Bin);
  8454. end
  8455. else
  8456. RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
  8457. ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
  8458. NameExpr:=Bin.right;
  8459. end;
  8460. // find attribute class
  8461. if not IsNameExpr(NameExpr) then
  8462. RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
  8463. ['identifier',GetElementTypeName(Bin)],NameExpr);
  8464. AttrName:=TPrimitiveExpr(NameExpr).Value;
  8465. CurEl:=nil;
  8466. if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
  8467. begin
  8468. // first search AttrName+'Attibute'
  8469. CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
  8470. end;
  8471. // then search the name
  8472. if CurEl=nil then
  8473. CurEl:=FindFirstEl(AttrName,Data,NameExpr);
  8474. if DotScope<>nil then
  8475. PopScope;
  8476. {$IFDEF VerbosePasResolver}
  8477. writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
  8478. {$ENDIF}
  8479. // check if found element is a TCustomAttribute
  8480. if CurEl=nil then
  8481. begin
  8482. LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
  8483. [AttrName],NameExpr);
  8484. continue;
  8485. end;
  8486. if not IsCustomAttribute(CurEl) then
  8487. RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  8488. [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
  8489. ClassEl:=TPasClassType(CurEl);
  8490. AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
  8491. if ClassEl.IsAbstract then
  8492. // Delphi silently skips attributes using abstract classes/methods
  8493. LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8494. sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
  8495. // search constructor "Create" using the params
  8496. DotScope:=PushClassDotScope(ClassEl);
  8497. DotScope.OnlyTypeMembers:=true;
  8498. Expr:=El.Calls[i];
  8499. if Expr is TParamsExpr then
  8500. begin
  8501. // attribute with params
  8502. if Expr.Kind<>pekFuncParams then
  8503. begin
  8504. {$IFDEF VerbosePasResolver}
  8505. writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
  8506. {$ENDIF}
  8507. RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
  8508. ['(','['],Expr);
  8509. end;
  8510. // first resolve params
  8511. ResolveParamsExprParams(TParamsExpr(Expr));
  8512. // then resolve call 'Create'
  8513. ResolveFuncParamsExprName(Expr,nil,TParamsExpr(Expr),rraRead,'Create');
  8514. // then check that each parameter is a constant expression
  8515. Params:=TParamsExpr(Expr).Params;
  8516. for j:=0 to length(Params)-1 do
  8517. ComputeElement(Params[j],ParamResolved,[rcConstant]);
  8518. // check if call is constructor
  8519. ParamRef:=Expr.CustomData as TResolvedReference;
  8520. DeclEl:=ParamRef.Declaration;
  8521. if DeclEl.ClassType<>TPasConstructor then
  8522. RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
  8523. aConstructor:=TPasConstructor(DeclEl);
  8524. end
  8525. else
  8526. begin
  8527. // attribute without params
  8528. // -> resolve call 'Create'
  8529. DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false,true);
  8530. if DeclEl=nil then
  8531. RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
  8532. // check call is constructor
  8533. if DeclEl.ClassType<>TPasConstructor then
  8534. RaiseXExpectedButYFound(20190221145003,'constructor Create',
  8535. GetElementTypeName(DeclEl),NameExpr);
  8536. aConstructor:=TPasConstructor(DeclEl);
  8537. // check constructor without needed args
  8538. Args:=aConstructor.ProcType.Args;
  8539. if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
  8540. RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
  8541. sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
  8542. end;
  8543. if aConstructor.IsAbstract then
  8544. LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
  8545. sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
  8546. // store reference to constructor in NameExpr
  8547. if AttrRef.Context<>nil then
  8548. RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
  8549. AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
  8550. TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
  8551. PopScope;
  8552. end;
  8553. end;
  8554. procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
  8555. Params: TParamsExpr);
  8556. var
  8557. ParamAccess: TResolvedRefAccess;
  8558. i: Integer;
  8559. ArrParams: TPasExprArray;
  8560. begin
  8561. ArrParams:=Params.Params;
  8562. for i:=0 to length(ArrParams)-1 do
  8563. begin
  8564. ParamAccess:=rraRead;
  8565. if i<ProcType.Args.Count then
  8566. case TPasArgument(ProcType.Args[i]).Access of
  8567. argVar: ParamAccess:=rraVarParam;
  8568. argOut: ParamAccess:=rraOutParam;
  8569. end;
  8570. AccessExpr(ArrParams[i],ParamAccess);
  8571. end;
  8572. CheckCallProcCompatibility(ProcType,Params,false,true);
  8573. end;
  8574. procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
  8575. Prop: TPasProperty);
  8576. var
  8577. i: Integer;
  8578. ParamAccess: TResolvedRefAccess;
  8579. begin
  8580. for i:=0 to length(Params.Params)-1 do
  8581. begin
  8582. ParamAccess:=rraRead;
  8583. if i<Prop.Args.Count then
  8584. case TPasArgument(Prop.Args[i]).Access of
  8585. argVar: ParamAccess:=rraVarParam;
  8586. argOut: ParamAccess:=rraOutParam;
  8587. end;
  8588. FinishCallArgAccess(Params.Params[i],ParamAccess);
  8589. end;
  8590. end;
  8591. procedure TPasResolver.FinishCallArgAccess(Expr: TPasExpr;
  8592. Access: TResolvedRefAccess);
  8593. var
  8594. ResolvedEl: TPasResolverResult;
  8595. Flags: TPasResolverComputeFlags;
  8596. begin
  8597. AccessExpr(Expr,Access);
  8598. Flags:=[rcSetReferenceFlags];
  8599. if Access<>rraRead then
  8600. Include(Flags,rcNoImplicitProc);
  8601. ComputeElement(Expr,ResolvedEl,Flags);
  8602. end;
  8603. procedure TPasResolver.FinishInitialFinalization(El: TPasImplBlock);
  8604. begin
  8605. if El=nil then ;
  8606. CheckTopScope(ScopeClass_InitialFinalization);
  8607. PopScope;
  8608. end;
  8609. procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
  8610. begin
  8611. while aType<>nil do
  8612. begin
  8613. if EmitElementHints(PosEl,aType) then
  8614. exit; // give only hints for the nearest
  8615. if aType.InheritsFrom(TPasAliasType) then
  8616. aType:=TPasAliasType(aType).DestType
  8617. else if aType.ClassType=TPasPointerType then
  8618. aType:=TPasPointerType(aType).DestType
  8619. else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
  8620. and (aType.CustomData is TResolvedReference) then
  8621. aType:=TPasType(TResolvedReference(aType.CustomData).Declaration)
  8622. else
  8623. exit;
  8624. end;
  8625. end;
  8626. function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
  8627. begin
  8628. if IsElementSkipped(El) then
  8629. RaiseNotYetImplemented(20170927160030,PosEl,GetObjName(El));
  8630. if El.Hints=[] then exit(false);
  8631. Result:=true;
  8632. if hDeprecated in El.Hints then
  8633. begin
  8634. if El.HintMessage<>'' then
  8635. LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
  8636. [El.Name,El.HintMessage],PosEl)
  8637. else
  8638. LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
  8639. [El.Name],PosEl);
  8640. end;
  8641. if hLibrary in El.Hints then
  8642. LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
  8643. [El.Name],PosEl);
  8644. if hPlatform in El.Hints then
  8645. LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
  8646. [El.Name],PosEl);
  8647. if hExperimental in El.Hints then
  8648. LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
  8649. [El.Name],PosEl);
  8650. if hUnimplemented in El.Hints then
  8651. LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
  8652. [El.Name],PosEl);
  8653. end;
  8654. procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
  8655. var
  8656. ModScope: TPasModuleScope;
  8657. begin
  8658. if ppsfIsSpecialized in ProcScope.Flags then exit;
  8659. ProcScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  8660. if bsRangeChecks in ProcScope.BoolSwitches then
  8661. begin
  8662. ModScope:=RootElement.CustomData as TPasModuleScope;
  8663. Include(ModScope.Flags,pmsfRangeErrorNeeded);
  8664. end;
  8665. end;
  8666. procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
  8667. ImplProcScope: TPasProcedureScope);
  8668. var
  8669. DeclProc, ImplProc: TPasProcedure;
  8670. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8671. i, j: Integer;
  8672. DeclArg, ImplArg: TPasArgument;
  8673. Identifier: TPasIdentifier;
  8674. ImplNameParts: TProcedureNameParts;
  8675. ImplNamePart: TProcedureNamePart;
  8676. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8677. begin
  8678. ImplProc:=ImplProcScope.Element as TPasProcedure;
  8679. DeclProc:=ImplProcScope.DeclarationProc;
  8680. // redirect impl generic template types with declaration types
  8681. ImplNameParts:=ImplProc.NameParts;
  8682. if ImplNameParts<>nil then
  8683. begin
  8684. // For example: "procedure TA<T>.Fly<U>;"
  8685. // The generic type templates (e.g. "T") are in the class
  8686. // -> remove generic type templates from proc scope
  8687. for i:=0 to ImplNameParts.Count-2 do
  8688. begin
  8689. ImplNamePart:=TProcedureNamePart(ImplNameParts[i]);
  8690. ImplTemplates:=ImplNamePart.Templates;
  8691. if ImplTemplates=nil then continue;
  8692. for j:=0 to ImplTemplates.Count-1 do
  8693. begin
  8694. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[j]);
  8695. ImplProcScope.RemoveLocalIdentifier(ImplTemplType);
  8696. end;
  8697. end;
  8698. // redirect implproc parameters to declproc parameters
  8699. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8700. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8701. if ImplTemplates<>nil then
  8702. begin
  8703. if (DeclTemplates=nil) or (ImplTemplates.Count<>DeclTemplates.Count) then
  8704. RaiseNotYetImplemented(20190912153602,ImplProc); // inconsistency
  8705. for i:=0 to ImplTemplates.Count-1 do
  8706. begin
  8707. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8708. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8709. Identifier:=ImplProcScope.FindLocalIdentifier(ImplTemplType.Name);
  8710. if Identifier.Element<>ImplTemplType then
  8711. RaiseInternalError(20190912154009,GetObjName(DeclTemplType)+' '+GetObjName(ImplTemplType));
  8712. Identifier.Element:=DeclTemplType;
  8713. Identifier.Identifier:=DeclTemplType.Name;
  8714. end;
  8715. end
  8716. else if DeclTemplates<>nil then
  8717. // declproc is parametrized, implproc is not
  8718. RaiseNotYetImplemented(20190912153439,ImplProc); // inconsistency
  8719. end;
  8720. // redirect impl arguments to declaration args
  8721. ImplArgs:=ImplProc.ProcType.Args;
  8722. DeclArgs:=DeclProc.ProcType.Args;
  8723. for i:=0 to DeclArgs.Count-1 do
  8724. begin
  8725. DeclArg:=TPasArgument(DeclArgs[i]);
  8726. if i<ImplArgs.Count then
  8727. begin
  8728. ImplArg:=TPasArgument(ImplArgs[i]);
  8729. Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
  8730. //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
  8731. if Identifier.Element<>ImplArg then
  8732. RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
  8733. Identifier.Element:=DeclArg;
  8734. Identifier.Identifier:=DeclArg.Name;
  8735. end
  8736. else
  8737. RaiseNotYetImplemented(20170203161826,ImplProc);
  8738. end;
  8739. if DeclProc.ProcType is TPasFunctionType then
  8740. begin
  8741. // redirect implementation 'Result' to declaration FuncType.ResultEl
  8742. Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
  8743. if Identifier.Element is TPasResultElement then
  8744. Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
  8745. end;
  8746. end;
  8747. function TPasResolver.CreateClassIntfMap(El: TPasClassType; Index: integer
  8748. ): TPasClassIntfMap;
  8749. var
  8750. IntfType: TPasClassType;
  8751. Map: TPasClassIntfMap;
  8752. ClassScope: TPasClassScope;
  8753. begin
  8754. ClassScope:=El.CustomData as TPasClassScope;
  8755. if ClassScope.Interfaces[Index]<>nil then
  8756. RaiseInternalError(20180322141916,GetElementDbgPath(El)+' '+IntToStr(Index)+' '+GetObjName(TObject(ClassScope.Interfaces[Index])));
  8757. IntfType:=TPasClassType(ResolveAliasType(TPasType(El.Interfaces[Index])));
  8758. Map:=nil;
  8759. while IntfType<>nil do
  8760. begin
  8761. if Map=nil then
  8762. begin
  8763. Map:=TPasClassIntfMap.Create;
  8764. Map.Element:=El;
  8765. Result:=Map;
  8766. ClassScope.Interfaces[Index]:=Map;
  8767. end
  8768. else
  8769. begin
  8770. Map.AncestorMap:=TPasClassIntfMap.Create;
  8771. Map:=Map.AncestorMap;
  8772. Map.Element:=El;
  8773. end;
  8774. Map.Intf:=IntfType;
  8775. Map.Procs:=TFPList.Create;
  8776. Map.Procs.Count:=IntfType.Members.Count;
  8777. IntfType:=GetPasClassAncestor(IntfType,true) as TPasClassType;
  8778. end;
  8779. end;
  8780. procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
  8781. const ResolvedEl: TPasResolverResult);
  8782. begin
  8783. if ResolvedEl.BaseType=btBoolean then exit;
  8784. if IsGenericTemplType(ResolvedEl) then exit;
  8785. RaiseXExpectedButYFound(20170216152135,
  8786. BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
  8787. end;
  8788. procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
  8789. ImplProc: TPasProcedure; IsOverride: boolean);
  8790. var
  8791. i: Integer;
  8792. DeclArgs, ImplArgs, ImplTemplates, DeclTemplates: TFPList;
  8793. DeclName, ImplName: String;
  8794. ImplResult, DeclResult: TPasType;
  8795. ImplTemplType, DeclTemplType: TPasGenericTemplateType;
  8796. NewImplPTMods: TProcTypeModifiers;
  8797. ptm: TProcTypeModifier;
  8798. NewImplProcMods: TProcedureModifiers;
  8799. pm: TProcedureModifier;
  8800. begin
  8801. if ImplProc.ClassType<>DeclProc.ClassType then
  8802. RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
  8803. DeclArgs:=DeclProc.ProcType.Args;
  8804. ImplArgs:=ImplProc.ProcType.Args;
  8805. if DeclArgs.Count<>ImplArgs.Count then
  8806. RaiseNotYetImplemented(20190912110642,ImplProc);
  8807. DeclTemplates:=GetProcTemplateTypes(DeclProc);
  8808. ImplTemplates:=GetProcTemplateTypes(ImplProc);
  8809. if DeclTemplates<>nil then
  8810. begin
  8811. // DeclProc has templates
  8812. if IsOverride then
  8813. RaiseNotYetImplemented(20190912113857,ImplProc); // inconsistency
  8814. if ImplTemplates=nil then
  8815. RaiseMsg(20190912144529,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8816. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8817. // declaration proc has template type aka is parametrized
  8818. // -> check template types
  8819. if ImplTemplates.Count<>DeclTemplates.Count then
  8820. RaiseMsg(20190912145320,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8821. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplates[0]))],ImplProc);
  8822. for i:=0 to DeclTemplates.Count-1 do
  8823. begin
  8824. DeclTemplType:=TPasGenericTemplateType(DeclTemplates[i]);
  8825. ImplTemplType:=TPasGenericTemplateType(ImplTemplates[i]);
  8826. if not SameText(DeclTemplType.Name,ImplTemplType.Name) then
  8827. RaiseMsg(20190912150311,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8828. [GetProcName(ImplProc),GetElementSourcePosStr(TPasElement(DeclTemplType))],ImplTemplType);
  8829. if length(ImplTemplType.Constraints)>0 then
  8830. RaiseMsg(20190912150739,nImplMustNotRepeatConstraints,sImplMustNotRepeatConstraints,[],ImplTemplType);
  8831. end;
  8832. end
  8833. else if ImplTemplates<>nil then
  8834. begin
  8835. // ImplProc has templates, DeclProc does not
  8836. RaiseMsg(20190912113857,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  8837. [GetProcName(ImplProc),GetElementSourcePosStr(DeclProc)],ImplProc);
  8838. end;
  8839. if not IsOverride then
  8840. begin
  8841. // check argument names
  8842. for i:=0 to DeclArgs.Count-1 do
  8843. begin
  8844. DeclName:=TPasArgument(DeclArgs[i]).Name;
  8845. ImplName:=TPasArgument(ImplArgs[i]).Name;
  8846. if CompareText(DeclName,ImplName)<>0 then
  8847. RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
  8848. sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
  8849. end;
  8850. end;
  8851. if ImplProc.ProcType is TPasFunctionType then
  8852. begin
  8853. // check result type
  8854. ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
  8855. DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
  8856. if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
  8857. RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
  8858. [],DeclResult,ImplResult,ImplProc);
  8859. if ImplProc.IsAsync<>DeclProc.IsAsync then
  8860. RaiseMsg(20200524111856,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ImplProc);
  8861. end;
  8862. // calling convention
  8863. if ImplProc.CallingConvention<>DeclProc.CallingConvention then
  8864. RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
  8865. // proc modifiers
  8866. NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
  8867. if not IsOverride then
  8868. begin
  8869. // implementation proc must not add modifiers, except "assembler"
  8870. if NewImplProcMods<>[] then
  8871. for pm in NewImplProcMods do
  8872. RaiseMsg(20200518182445,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
  8873. [ModifierNames[pm]],ImplProc.ProcType);
  8874. end;
  8875. // proc type modifiers
  8876. NewImplPTMods:=ImplProc.ProcType.Modifiers-DeclProc.ProcType.Modifiers;
  8877. // implementation proc must not add modifiers
  8878. if NewImplPTMods<>[] then
  8879. for ptm in NewImplPTMods do
  8880. RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
  8881. [ProcTypeModifiers[ptm]],ImplProc.ProcType);
  8882. end;
  8883. procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
  8884. var
  8885. i: Integer;
  8886. begin
  8887. if Block=nil then exit;
  8888. for i:=0 to Block.Elements.Count-1 do
  8889. ResolveImplElement(TPasImplElement(Block.Elements[i]));
  8890. end;
  8891. procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
  8892. var
  8893. C: TClass;
  8894. begin
  8895. //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
  8896. if El=nil then exit;
  8897. C:=El.ClassType;
  8898. if C=TPasImplBeginBlock then
  8899. ResolveImplBlock(TPasImplBeginBlock(El))
  8900. else if C=TPasImplAssign then
  8901. ResolveImplAssign(TPasImplAssign(El))
  8902. else if C=TPasImplSimple then
  8903. ResolveImplSimple(TPasImplSimple(El))
  8904. else if C=TPasImplBlock then
  8905. ResolveImplBlock(TPasImplBlock(El))
  8906. else if C=TPasImplRepeatUntil then
  8907. begin
  8908. ResolveImplBlock(TPasImplBlock(El));
  8909. ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
  8910. end
  8911. else if C=TPasImplIfElse then
  8912. begin
  8913. ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
  8914. ResolveImplElement(TPasImplIfElse(El).IfBranch);
  8915. ResolveImplElement(TPasImplIfElse(El).ElseBranch);
  8916. end
  8917. else if C=TPasImplWhileDo then
  8918. begin
  8919. ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
  8920. ResolveImplElement(TPasImplWhileDo(El).Body);
  8921. end
  8922. else if C=TPasImplCaseOf then
  8923. ResolveImplCaseOf(TPasImplCaseOf(El))
  8924. else if C=TPasImplLabelMark then
  8925. ResolveImplLabelMark(TPasImplLabelMark(El))
  8926. else if C=TPasImplForLoop then
  8927. // the header was already resolved
  8928. ResolveImplElement(TPasImplForLoop(El).Body)
  8929. else if C=TPasImplTry then
  8930. begin
  8931. ResolveImplBlock(TPasImplTry(El));
  8932. ResolveImplBlock(TPasImplTry(El).FinallyExcept);
  8933. ResolveImplBlock(TPasImplTry(El).ElseBranch);
  8934. end
  8935. else if C=TPasImplExceptOn then
  8936. // handled in FinishExceptOnStatement
  8937. else if C=TPasImplRaise then
  8938. ResolveImplRaise(TPasImplRaise(El))
  8939. else if C=TPasImplCommand then
  8940. begin
  8941. if TPasImplCommand(El).Command<>'' then
  8942. RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
  8943. end
  8944. else if C=TPasImplAsmStatement then
  8945. ResolveImplAsm(TPasImplAsmStatement(El))
  8946. else if C=TPasImplWithDo then
  8947. ResolveImplWithDo(TPasImplWithDo(El))
  8948. else
  8949. RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
  8950. end;
  8951. procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
  8952. type
  8953. TRangeItem = record
  8954. RangeStart, RangeEnd: TMaxPrecInt;
  8955. Expr: TPasExpr;
  8956. aString: UnicodeString;
  8957. // Note: for case-of-string:
  8958. // single values are stored in aString and RangeStart=1, RangeEnd=0
  8959. // ranges are stored as aString='', RangeStart, RangeEnd
  8960. end;
  8961. PRangeItem = ^TRangeItem;
  8962. function CreateValues(const ResolvedEl: TPasResolverResult;
  8963. var ValueSet: TResEvalSet): boolean;
  8964. var
  8965. CaseExprType: TPasType;
  8966. bt: TResolverBaseType;
  8967. ElTypeResolved: TPasResolverResult;
  8968. begin
  8969. Result:=false;
  8970. bt:=ResolvedEl.BaseType;
  8971. if bt in btAllStrings then
  8972. exit(true)
  8973. else if bt=btRange then
  8974. bt:=ResolvedEl.SubType;
  8975. if bt in btAllInteger then
  8976. begin
  8977. ValueSet:=TResEvalSet.CreateEmpty(revskInt);
  8978. Result:=true;
  8979. end
  8980. else if bt in btAllBooleans then
  8981. begin
  8982. ValueSet:=TResEvalSet.CreateEmpty(revskBool);
  8983. Result:=true;
  8984. end
  8985. else if bt in btAllChars then
  8986. begin
  8987. ValueSet:=TResEvalSet.CreateEmpty(revskChar);
  8988. Result:=true;
  8989. end
  8990. else if bt=btContext then
  8991. begin
  8992. CaseExprType:=ResolvedEl.LoTypeEl;
  8993. if CaseExprType.ClassType=TPasEnumType then
  8994. begin
  8995. ValueSet:=TResEvalSet.CreateEmpty(revskEnum,CaseExprType);
  8996. Result:=true;
  8997. end
  8998. else if CaseExprType.ClassType=TPasRangeType then
  8999. begin
  9000. ComputeElement(TPasRangeType(CaseExprType).RangeExpr.left,ElTypeResolved,[rcConstant]);
  9001. Result:=CreateValues(ElTypeResolved,ValueSet);
  9002. end;
  9003. end;
  9004. end;
  9005. function AddRangeItem(Values: TFPList; const RangeStart, RangeEnd: TMaxPrecInt;
  9006. Expr: TPasExpr): PRangeItem;
  9007. begin
  9008. New(Result);
  9009. Result^.RangeStart:=RangeStart;
  9010. Result^.RangeEnd:=RangeEnd;
  9011. Result^.Expr:=Expr;
  9012. Values.Add(Result);
  9013. end;
  9014. function AddValue(Value: TResEvalValue; Values: TFPList; ValueSet: TResEvalSet;
  9015. Expr: TPasExpr): boolean;
  9016. function AddString(const s: UnicodeString): boolean;
  9017. var
  9018. Dupl: TPasExpr;
  9019. i, o: Integer;
  9020. Item: PRangeItem;
  9021. begin
  9022. if length(s)=1 then
  9023. o:=ord(s[1])
  9024. else
  9025. o:=-1;
  9026. for i:=0 to Values.Count-1 do
  9027. begin
  9028. Item:=PRangeItem(Values[i]);
  9029. if (Item^.aString=s)
  9030. or ((o>=Item^.RangeStart) and (o<=Item^.RangeEnd)) then
  9031. begin
  9032. Dupl:=PRangeItem(Values[i])^.Expr;
  9033. RaiseMsg(20180424220139,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9034. ['string',GetElementSourcePosStr(Dupl)],Expr);
  9035. end;
  9036. end;
  9037. Item:=AddRangeItem(Values,1,0,Expr);
  9038. Item^.aString:=s;
  9039. Result:=true;
  9040. end;
  9041. function AddStringRange(CharStart, CharEnd: TMaxPrecInt): boolean;
  9042. var
  9043. i, o: Integer;
  9044. s: UnicodeString;
  9045. Item: PRangeItem;
  9046. Dupl: TPasExpr;
  9047. begin
  9048. if CharEnd>$ffff then
  9049. RaiseNotYetImplemented(20180501221359,Expr,Value.AsDebugString);
  9050. for i:=0 to Values.Count-1 do
  9051. begin
  9052. Item:=PRangeItem(Values[i]);
  9053. s:=Item^.aString;
  9054. if length(s)=1 then
  9055. o:=ord(s[1])
  9056. else
  9057. o:=-1;
  9058. if ((o>=CharStart) and (o<=CharEnd))
  9059. or ((Item^.RangeStart<=CharEnd) and (Item^.RangeEnd>=CharStart)) then
  9060. begin
  9061. Dupl:=PRangeItem(Values[i])^.Expr;
  9062. RaiseMsg(20180501223914,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9063. ['string',GetElementSourcePosStr(Dupl)],Expr);
  9064. end;
  9065. end;
  9066. AddRangeItem(Values,CharStart,CharEnd,Expr);
  9067. Result:=true;
  9068. end;
  9069. var
  9070. RangeStart, RangeEnd: TMaxPrecInt;
  9071. i: Integer;
  9072. Item: PRangeItem;
  9073. begin
  9074. {$IFDEF VerbosePasResolver}
  9075. //writeln('TPasResolver.ResolveImplCaseOf.AddValue Value={',Value.AsDebugString,'} Values.Count=',Values.Count);
  9076. {$ENDIF}
  9077. Result:=true;
  9078. case Value.Kind of
  9079. revkBool:
  9080. begin
  9081. RangeStart:=ord(TResEvalBool(Value).B);
  9082. RangeEnd:=RangeStart;
  9083. end;
  9084. revkInt:
  9085. begin
  9086. RangeStart:=TResEvalInt(Value).Int;
  9087. RangeEnd:=RangeStart;
  9088. end;
  9089. revkUInt:
  9090. begin
  9091. // Note: when FPC compares int64 with qword it converts the qword to an int64
  9092. if TResEvalUInt(Value).UInt>HighIntAsUInt then
  9093. ExprEvaluator.EmitRangeCheckConst(20180424212414,Value.AsString,
  9094. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  9095. RangeStart:=TResEvalUInt(Value).UInt;
  9096. RangeEnd:=RangeStart;
  9097. end;
  9098. {$ifdef FPC_HAS_CPSTRING}
  9099. revkString:
  9100. if ValueSet=nil then
  9101. exit(AddString(ExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Expr)))
  9102. else
  9103. begin
  9104. RangeStart:=fExprEvaluator.StringToOrd(Value,nil);
  9105. if RangeStart>$ffff then
  9106. exit(false);
  9107. RangeEnd:=RangeStart;
  9108. end;
  9109. {$endif}
  9110. revkUnicodeString:
  9111. if ValueSet=nil then
  9112. exit(AddString(TResEvalUTF16(Value).S))
  9113. else
  9114. begin
  9115. if length(TResEvalUTF16(Value).S)<>1 then
  9116. exit(false);
  9117. RangeStart:=ord(TResEvalUTF16(Value).S[1]);
  9118. RangeEnd:=RangeStart;
  9119. end;
  9120. revkEnum:
  9121. begin
  9122. RangeStart:=TResEvalEnum(Value).Index;
  9123. RangeEnd:=RangeStart;
  9124. end;
  9125. revkRangeInt:
  9126. if ValueSet=nil then
  9127. exit(AddStringRange(TResEvalRangeInt(Value).RangeStart,TResEvalRangeInt(Value).RangeEnd))
  9128. else
  9129. begin
  9130. RangeStart:=TResEvalRangeInt(Value).RangeStart;
  9131. RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
  9132. end;
  9133. revkRangeUInt:
  9134. begin
  9135. // Note: when FPC compares int64 with qword it converts the qword to an int64
  9136. if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
  9137. ExprEvaluator.EmitRangeCheckConst(20180424212648,Value.AsString,
  9138. '0',IntToStr(High(TMaxPrecInt)),Expr,mtError);
  9139. RangeStart:=TResEvalRangeUInt(Value).RangeStart;
  9140. RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
  9141. end;
  9142. else
  9143. Result:=false;
  9144. end;
  9145. if ValueSet=nil then
  9146. RaiseNotYetImplemented(20180424215728,Expr,Value.AsDebugString);
  9147. i:=ValueSet.Intersects(RangeStart,RangeEnd);
  9148. if i<0 then
  9149. begin
  9150. ValueSet.Add(RangeStart,RangeEnd);
  9151. AddRangeItem(Values,RangeStart,RangeEnd,Expr);
  9152. exit(true);
  9153. end;
  9154. // duplicate value -> show where
  9155. for i:=0 to Values.Count-1 do
  9156. begin
  9157. Item:=PRangeItem(Values[i]);
  9158. if (Item^.RangeStart>RangeEnd) or (Item^.RangeEnd<RangeStart) then continue;
  9159. RaiseMsg(20180424214305,nDuplicateCaseValueXatY,sDuplicateCaseValueXatY,
  9160. [Value.AsString,GetElementSourcePosStr(Item^.Expr)],Expr);
  9161. end;
  9162. Result:=false;
  9163. end;
  9164. var
  9165. i, j: Integer;
  9166. El: TPasElement;
  9167. Stat: TPasImplCaseStatement;
  9168. CaseExprResolved, OfExprResolved: TPasResolverResult;
  9169. OfExpr: TPasExpr;
  9170. ok: Boolean;
  9171. Values: TFPList; // list of PRangeItem
  9172. ValueSet: TResEvalSet;
  9173. Value: TResEvalValue;
  9174. Item: PRangeItem;
  9175. begin
  9176. ResolveExpr(CaseOf.CaseExpr,rraRead);
  9177. ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
  9178. ok:=false;
  9179. Values:=TFPList.Create;
  9180. ValueSet:=nil;
  9181. Value:=nil;
  9182. try
  9183. if (rrfReadable in CaseExprResolved.Flags) then
  9184. ok:=CreateValues(CaseExprResolved,ValueSet);
  9185. if not ok then
  9186. begin
  9187. if not IsGenericTemplType(CaseExprResolved) then
  9188. RaiseXExpectedButYFound(20170216151952,'ordinal expression',
  9189. GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
  9190. end;
  9191. for i:=0 to CaseOf.Elements.Count-1 do
  9192. begin
  9193. El:=TPasElement(CaseOf.Elements[i]);
  9194. if El.ClassType=TPasImplCaseStatement then
  9195. begin
  9196. Stat:=TPasImplCaseStatement(El);
  9197. for j:=0 to Stat.Expressions.Count-1 do
  9198. begin
  9199. //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
  9200. OfExpr:=TPasExpr(Stat.Expressions[j]);
  9201. ResolveExpr(OfExpr,rraRead);
  9202. ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
  9203. if OfExprResolved.BaseType=btRange then
  9204. ConvertRangeToElement(OfExprResolved);
  9205. if not ok then
  9206. continue;
  9207. CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
  9208. Value:=Eval(OfExpr,[refConstExt]);
  9209. if Value<>nil then
  9210. begin
  9211. if Value.Kind=revkExternal then
  9212. begin
  9213. // external const
  9214. end
  9215. else if not AddValue(Value,Values,ValueSet,OfExpr) then
  9216. RaiseIncompatibleTypeRes(20180424210815,nIncompatibleTypesGotExpected,
  9217. [],OfExprResolved,CaseExprResolved,OfExpr);
  9218. ReleaseEvalValue(Value);
  9219. end
  9220. else
  9221. RaiseMsg(20180518102047,nConstantExpressionExpected,sConstantExpressionExpected,[],OfExpr);
  9222. end;
  9223. ResolveImplElement(Stat.Body);
  9224. end
  9225. else if El.ClassType=TPasImplCaseElse then
  9226. ResolveImplBlock(TPasImplCaseElse(El))
  9227. else
  9228. RaiseNotYetImplemented(20160922163448,El);
  9229. end;
  9230. // Note: CaseOf.ElseBranch was already resolved via Elements
  9231. finally
  9232. ReleaseEvalValue(Value);
  9233. ValueSet.Free;
  9234. for i:=0 to Values.Count-1 do
  9235. begin
  9236. Item:=PRangeItem(Values[i]);
  9237. Dispose(Item);
  9238. end;
  9239. Values.Free;
  9240. end;
  9241. end;
  9242. procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
  9243. begin
  9244. RaiseNotYetImplemented(20161014141636,Mark);
  9245. end;
  9246. procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
  9247. // Note: the expressions were already resolved during parsing
  9248. // and the scopes were already stored in a TPasWithScope.
  9249. // -> simply push them onto the scope stack
  9250. var
  9251. i: Integer;
  9252. WithScope: TPasWithScope;
  9253. ExprScope: TPasWithExprScope;
  9254. begin
  9255. if not (El.CustomData is TPasWithScope) then
  9256. RaiseInternalError(20181210175349);
  9257. WithScope:=TPasWithScope(El.CustomData);
  9258. PushScope(WithScope);
  9259. for i:=0 to WithScope.ExpressionScopes.Count-1 do
  9260. begin
  9261. ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
  9262. PushScope(ExprScope);
  9263. end;
  9264. ResolveImplElement(El.Body);
  9265. PopWithScope(El);
  9266. end;
  9267. procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
  9268. begin
  9269. if El=nil then ;
  9270. end;
  9271. procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
  9272. var
  9273. LeftResolved, RightResolved: TPasResolverResult;
  9274. Flags: TPasResolverComputeFlags;
  9275. Access: TResolvedRefAccess;
  9276. Value: TResEvalValue;
  9277. begin
  9278. if El.Kind=akDefault then
  9279. Access:=rraAssign
  9280. else
  9281. Access:=rraReadAndAssign;
  9282. ResolveExpr(El.left,Access);
  9283. {$IFDEF VerbosePasResolver}
  9284. writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
  9285. {$ENDIF}
  9286. // check LHS can be assigned
  9287. ComputeElement(El.left,LeftResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
  9288. CheckCanBeLHS(LeftResolved,true,GetRightMostExpr(El.left));
  9289. // compute RHS
  9290. ResolveExpr(El.right,rraRead);
  9291. Flags:=[rcSetReferenceFlags];
  9292. if IsProcedureType(LeftResolved,true) then
  9293. begin
  9294. if (msDelphi in CurrentParser.CurrentModeswitches) then
  9295. Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
  9296. else
  9297. Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
  9298. end;
  9299. {$IFDEF VerbosePasResolver}
  9300. writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
  9301. {$ENDIF}
  9302. ComputeElement(El.right,RightResolved,Flags);
  9303. {$IFDEF VerbosePasResolver}
  9304. writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
  9305. {$ENDIF}
  9306. case El.Kind of
  9307. akDefault:
  9308. begin
  9309. CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
  9310. CheckAssignExprRange(LeftResolved,El.right);
  9311. if (LeftResolved.BaseType=btContext) and (LeftResolved.LoTypeEl.ClassType=TPasArrayType) then
  9312. MarkArrayExprRecursive(El.right,TPasArrayType(LeftResolved.LoTypeEl));
  9313. end;
  9314. akAdd, akMinus,akMul,akDivision:
  9315. begin
  9316. if (LeftResolved.BaseType in btAllInteger) and (El.Kind in [akAdd,akMinus,akMul]) then
  9317. begin
  9318. if (not (rrfReadable in RightResolved.Flags))
  9319. or not (RightResolved.BaseType in btAllInteger) then
  9320. RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9321. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9322. end
  9323. else if (LeftResolved.BaseType in btAllStrings) and (El.Kind=akAdd) then
  9324. begin
  9325. if (not (rrfReadable in RightResolved.Flags))
  9326. or not (RightResolved.BaseType in btAllStringAndChars) then
  9327. RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9328. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9329. end
  9330. else if (LeftResolved.BaseType in btAllFloats)
  9331. and (El.Kind in [akAdd,akMinus,akMul,akDivision]) then
  9332. begin
  9333. if (not (rrfReadable in RightResolved.Flags))
  9334. or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  9335. RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9336. [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
  9337. end
  9338. else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
  9339. begin
  9340. if (not (rrfReadable in RightResolved.Flags))
  9341. or not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  9342. RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9343. [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9344. if (LeftResolved.SubType=RightResolved.SubType)
  9345. or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
  9346. or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
  9347. then
  9348. else
  9349. RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  9350. ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
  9351. end
  9352. else if LeftResolved.BaseType=btContext then
  9353. begin
  9354. if (LeftResolved.LoTypeEl.ClassType=TPasArrayType) and (El.Kind=akAdd)
  9355. and (rrfReadable in RightResolved.Flags)
  9356. and IsDynArray(LeftResolved.LoTypeEl) then
  9357. begin
  9358. // DynArr+=...
  9359. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,El,true);
  9360. exit;
  9361. end
  9362. else
  9363. RaiseIncompatibleTypeRes(20180615235749,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9364. end
  9365. else
  9366. RaiseIncompatibleTypeRes(20180208115707,nOperatorIsNotOverloadedAOpB,[AssignKindNames[El.Kind]],LeftResolved,RightResolved,El);
  9367. // store const expression result
  9368. Value:=Eval(El.right,[]);
  9369. ReleaseEvalValue(Value);
  9370. end;
  9371. else
  9372. RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
  9373. end;
  9374. end;
  9375. procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
  9376. var
  9377. ExprResolved: TPasResolverResult;
  9378. Expr: TPasExpr;
  9379. begin
  9380. Expr:=El.expr;
  9381. ResolveExpr(Expr,rraRead);
  9382. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  9383. if (rrfCanBeStatement in ExprResolved.Flags) then
  9384. exit;
  9385. {$IFDEF VerbosePasResolver}
  9386. writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  9387. {$ENDIF}
  9388. RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
  9389. end;
  9390. procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
  9391. var
  9392. ResolvedEl: TPasResolverResult;
  9393. begin
  9394. if El.ExceptObject<>nil then
  9395. begin
  9396. ResolveExpr(El.ExceptObject,rraRead);
  9397. ComputeElement(El.ExceptObject,ResolvedEl,[rcSetReferenceFlags]);
  9398. CheckIsClass(El.ExceptObject,ResolvedEl);
  9399. if ResolvedEl.IdentEl<>nil then
  9400. begin
  9401. if (ResolvedEl.IdentEl is TPasVariable)
  9402. or (ResolvedEl.IdentEl is TPasArgument)
  9403. or (ResolvedEl.IdentEl is TPasResultElement) then
  9404. else
  9405. begin
  9406. {$IFDEF VerbosePasResolver}
  9407. writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
  9408. {$ENDIF}
  9409. RaiseXExpectedButYFound(20170216152133,
  9410. 'variable',GetElementTypeName(ResolvedEl.IdentEl),El.ExceptObject);
  9411. end;
  9412. end
  9413. else if ResolvedEl.ExprEl<>nil then
  9414. else
  9415. RaiseXExpectedButYFound(201702303145230,
  9416. 'variable',GetResolverResultDbg(ResolvedEl),El.ExceptObject);
  9417. if not (rrfReadable in ResolvedEl.Flags) then
  9418. RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
  9419. end;
  9420. if El.ExceptAddr<>nil then
  9421. ResolveExpr(El.ExceptAddr,rraRead);
  9422. end;
  9423. procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
  9424. var
  9425. Primitive: TPrimitiveExpr;
  9426. ElClass: TClass;
  9427. begin
  9428. {$IFDEF VerbosePasResolver}
  9429. writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
  9430. {$ENDIF}
  9431. if El=nil then
  9432. RaiseNotYetImplemented(20160922163453,El);
  9433. ElClass:=El.ClassType;
  9434. if ElClass=TPrimitiveExpr then
  9435. begin
  9436. Primitive:=TPrimitiveExpr(El);
  9437. case Primitive.Kind of
  9438. pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
  9439. pekNumber: ;
  9440. pekString: ;
  9441. pekNil,pekBoolConst: ;
  9442. else
  9443. RaiseNotYetImplemented(20160922163451,El);
  9444. end;
  9445. end
  9446. else if ElClass=TUnaryExpr then
  9447. ResolveExpr(TUnaryExpr(El).Operand,Access)
  9448. else if ElClass=TBinaryExpr then
  9449. ResolveBinaryExpr(TBinaryExpr(El),Access)
  9450. else if ElClass=TParamsExpr then
  9451. ResolveParamsExpr(TParamsExpr(El),Access)
  9452. else if ElClass=TBoolConstExpr then
  9453. else if ElClass=TNilExpr then
  9454. else if ElClass=TInheritedExpr then
  9455. ResolveInherited(TInheritedExpr(El),Access)
  9456. else if ElClass=TArrayValues then
  9457. begin
  9458. if Access<>rraRead then
  9459. RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9460. [],El);
  9461. ResolveArrayValues(TArrayValues(El));
  9462. end
  9463. else if ElClass=TRecordValues then
  9464. begin
  9465. if Access<>rraRead then
  9466. RaiseMsg(20180429103024,nVariableIdentifierExpected,sVariableIdentifierExpected,
  9467. [],El);
  9468. ResolveRecordValues(TRecordValues(El));
  9469. end
  9470. else if ElClass=TProcedureExpr then
  9471. // resolved by FinishScope(stProcedure)
  9472. else if ElClass=TInlineSpecializeExpr then
  9473. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(El),Access)
  9474. else
  9475. RaiseNotYetImplemented(20170222184329,El);
  9476. if El.format1<>nil then
  9477. ResolveExpr(El.format1,rraRead);
  9478. if El.format2<>nil then
  9479. ResolveExpr(El.format2,rraRead);
  9480. end;
  9481. procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
  9482. var
  9483. ResolvedCond: TPasResolverResult;
  9484. begin
  9485. ResolveExpr(El,rraRead);
  9486. ComputeElement(El,ResolvedCond,[rcSetReferenceFlags]);
  9487. CheckConditionExpr(El,ResolvedCond);
  9488. end;
  9489. procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
  9490. Access: TResolvedRefAccess);
  9491. var
  9492. FindData: TPRFindData;
  9493. DeclEl: TPasElement;
  9494. Proc, ImplProc: TPasProcedure;
  9495. Ref: TResolvedReference;
  9496. BuiltInProc: TResElDataBuiltInProc;
  9497. p: SizeInt;
  9498. DottedName: String;
  9499. Bin: TBinaryExpr;
  9500. ProcScope: TPasProcedureScope;
  9501. ParentParams: TPRParentParams;
  9502. TypeCnt: Integer;
  9503. InlParams, TemplTypes: TFPList;
  9504. begin
  9505. {$IFDEF VerbosePasResolver}
  9506. writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
  9507. {$ENDIF}
  9508. GetParamsOfNameExpr(El,ParentParams);
  9509. if ParentParams.InlineSpec<>nil then
  9510. InlParams:=ParentParams.InlineSpec.Params
  9511. else
  9512. InlParams:=nil;
  9513. //writeln('TPasResolver.ResolveNameExpr Inline=',GetObjName(ParentParams.InlineSpec),' Params=',GetObjName(ParentParams.Params),' ',GetObjPath(El));
  9514. if ParentParams.Params<>nil then
  9515. begin
  9516. case ParentParams.Params.Kind of
  9517. pekFuncParams:
  9518. ResolveFuncParamsExprName(El,InlParams,ParentParams.Params,Access);
  9519. pekArrayParams:
  9520. ResolveArrayParamsExprName(El,ParentParams.Params,Access);
  9521. else
  9522. RaiseNotYetImplemented(20190912190428,El,GetObjPath(ParentParams.Params));
  9523. end;
  9524. exit;
  9525. end;
  9526. if ParentParams.InlineSpec<>nil then
  9527. begin
  9528. TypeCnt:=InlParams.Count;
  9529. // ToDo: generic functions without params
  9530. DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
  9531. if DeclEl<>nil then
  9532. begin
  9533. // GenType<params> -> create specialize type/proc
  9534. DeclEl:=GetSpecializedEl(ParentParams.InlineSpec,DeclEl,InlParams);
  9535. end
  9536. else
  9537. RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El);
  9538. end
  9539. else
  9540. DeclEl:=FindElementWithoutParams(aName,FindData,El,false,false);
  9541. if DeclEl.ClassType=TPasUsesUnit then
  9542. begin
  9543. // the first name of a unit matches -> find unit with longest match
  9544. FindLongestUnitName(DeclEl,El);
  9545. FindData.Found:=DeclEl;
  9546. end;
  9547. Ref:=CreateReference(DeclEl,El,Access,@FindData);
  9548. CheckFoundElement(FindData,Ref);
  9549. if DeclEl is TPasProcedure then
  9550. begin
  9551. // identifier is a proc and args brackets are missing
  9552. Proc:=TPasProcedure(DeclEl);
  9553. if ParentParams.InlineSpec=nil then
  9554. begin
  9555. TemplTypes:=GetProcTemplateTypes(Proc);
  9556. if (TemplTypes<>nil) then
  9557. // implicit function specialization without bracket
  9558. RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
  9559. sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
  9560. end;
  9561. if El.Parent.ClassType=TPasProperty then
  9562. // a property accessor does not need args -> ok
  9563. // Note: the detailed tests are in FinishProperty
  9564. else
  9565. begin
  9566. // examples: funca or @proca or a.funca or @a.funca ...
  9567. if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
  9568. and (El.ClassType=TPrimitiveExpr)
  9569. and (El.Parent.ClassType=TPasImplAssign)
  9570. and (TPasImplAssign(El.Parent).left=El) then
  9571. begin
  9572. // e.g. funcname:=
  9573. ProcScope:=Proc.CustomData as TPasProcedureScope;
  9574. ImplProc:=ProcScope.ImplProc;
  9575. if ImplProc=nil then
  9576. ImplProc:=Proc;
  9577. if El.HasParent(ImplProc) then
  9578. begin
  9579. // "FuncA:=" within FuncA -> redirect to ResultEl
  9580. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  9581. exit;
  9582. end;
  9583. end;
  9584. if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
  9585. begin
  9586. {$IFDEF VerbosePasResolver}
  9587. writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
  9588. {$ENDIF}
  9589. RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
  9590. sWrongNumberOfParametersForCallTo,[Proc.Name],El);
  9591. end;
  9592. end;
  9593. end
  9594. else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  9595. begin
  9596. if DeclEl.CustomData is TResElDataBuiltInProc then
  9597. begin
  9598. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  9599. BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
  9600. end;
  9601. end
  9602. else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
  9603. begin
  9604. // unit reference
  9605. // dotted unit name needs a ref for each expression identifier
  9606. // Note: El is the first TPrimitiveExpr of the dotted unit name reference
  9607. DottedName:=DeclEl.Name;
  9608. repeat
  9609. p:=Pos('.',DottedName);
  9610. if p<1 then break;
  9611. Delete(DottedName,1,p);
  9612. El:=GetNextDottedExpr(El);
  9613. if El=nil then
  9614. RaiseInternalError(20170503002012);
  9615. CreateReference(DeclEl,El,Access);
  9616. if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
  9617. begin
  9618. Bin:=TBinaryExpr(El.Parent);
  9619. while Bin.OpCode=eopSubIdent do
  9620. begin
  9621. CreateReference(DeclEl,Bin,Access);
  9622. if not (Bin.Parent is TBinaryExpr) then break;
  9623. if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
  9624. Bin:=TBinaryExpr(Bin.Parent);
  9625. end;
  9626. end;
  9627. until false;
  9628. end;
  9629. end;
  9630. procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
  9631. Access: TResolvedRefAccess);
  9632. var
  9633. SelfScope: TPasProcedureScope;
  9634. AncestorScope: TPasClassScope;
  9635. ClassRecScope: TPasClassOrRecordScope;
  9636. DeclProc, AncestorProc: TPasProcedure;
  9637. aClass: TPasClassType;
  9638. HelperForType: TPasType;
  9639. InhScope: TPasInheritedScope;
  9640. begin
  9641. {$IFDEF VerbosePasResolver}
  9642. writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
  9643. {$ENDIF}
  9644. if (El.Parent.ClassType=TBinaryExpr)
  9645. and (TBinaryExpr(El.Parent).OpCode=eopNone) then
  9646. begin
  9647. // e.g. 'inherited Proc;'
  9648. ResolveInheritedName(TBinaryExpr(El.Parent),Access);
  9649. exit;
  9650. end;
  9651. // 'inherited;' without expression
  9652. SelfScope:=GetCurrentSelfScope(El);
  9653. if SelfScope=nil then
  9654. RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9655. DeclProc:=SelfScope.DeclarationProc;
  9656. if DeclProc=nil then
  9657. RaiseNotYetImplemented(20190121172251,El);
  9658. ClassRecScope:=SelfScope.ClassRecScope;
  9659. if not (ClassRecScope is TPasClassScope) then
  9660. begin
  9661. // inherited in record method
  9662. RaiseMsg(20181218194022,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9663. ['inherited'],El);
  9664. end;
  9665. AncestorProc:=nil;
  9666. // inherited in class/interface/helper method
  9667. aClass:=ClassRecScope.Element as TPasClassType;
  9668. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9669. //writeln('TPasResolver.ResolveInherited aClass=',GetObjName(aClass),' HelperForType=',GetObjName(HelperForType));
  9670. if HelperForType is TPasMembersType then
  9671. begin
  9672. // inherited; inside helper -> skip helper ancestors and search in HelperForType
  9673. if msDelphi in CurrentParser.CurrentModeswitches then
  9674. begin
  9675. // Delphi skips ancestors and HelperForType
  9676. if not (HelperForType is TPasClassType) then
  9677. // 'inherited;' without ancestor class is silently ignored
  9678. exit;
  9679. AncestorScope:=TPasClassScope(HelperForType.CustomData).AncestorScope;
  9680. if AncestorScope=nil then
  9681. // 'inherited;' without ancestor class is silently ignored
  9682. exit;
  9683. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9684. end
  9685. else
  9686. begin
  9687. // ObjFPC searches first in HelperForType and its ancestors, then in
  9688. // own ancestors
  9689. AncestorScope:=TPasClassScope(aClass.CustomData).AncestorScope;
  9690. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9691. AncestorScope);
  9692. end;
  9693. end
  9694. else
  9695. begin
  9696. // inherited; inside class/interface method
  9697. // -> search in ancestor and its helper(s)
  9698. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9699. if AncestorScope=nil then
  9700. // 'inherited;' without ancestor class is silently ignored
  9701. exit;
  9702. InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
  9703. end;
  9704. AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
  9705. PopScope;
  9706. if AncestorProc=nil then
  9707. // 'inherited;' without ancestor DeclProc is silently ignored
  9708. exit;
  9709. if not (AncestorProc.Parent is TPasMembersType) then
  9710. RaiseNotYetImplemented(20190121181234,El); // inconsistency
  9711. CreateReference(AncestorProc,El,Access);
  9712. if AncestorProc.IsAbstract then
  9713. RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
  9714. sAbstractMethodsCannotBeCalledDirectly,[],El);
  9715. end;
  9716. procedure TPasResolver.ResolveInheritedName(El: TBinaryExpr;
  9717. Access: TResolvedRefAccess);
  9718. // El.OpCode=eopNone
  9719. // El.left is TInheritedExpr
  9720. // El.right is the identifier and/or paramexpr
  9721. var
  9722. SelfScope: TPasProcedureScope;
  9723. ClassRecScope: TPasClassOrRecordScope;
  9724. AncestorClass, aClass: TPasClassType;
  9725. HelperForType: TPasType;
  9726. OnlyTypeMembers: Boolean;
  9727. Proc: TPasProcedure;
  9728. AncestorScope: TPasClassScope;
  9729. InhScope: TPasInheritedScope;
  9730. begin
  9731. {$IFDEF VerbosePasResolver}
  9732. writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El),' Access=',Access);
  9733. {$ENDIF}
  9734. SelfScope:=GetCurrentSelfScope(El);
  9735. if SelfScope=nil then
  9736. RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
  9737. ClassRecScope:=SelfScope.ClassRecScope;
  9738. if not (ClassRecScope is TPasClassScope) then
  9739. // inherited in a method of a record
  9740. RaiseMsg(20181218194436,nTheUseOfXisNotAllowedInARecord,sTheUseOfXisNotAllowedInARecord,
  9741. ['inherited'],El);
  9742. Proc:=TPasProcedure(SelfScope.Element);
  9743. OnlyTypeMembers:=IsClassMethod(Proc);
  9744. // inherited in a method of a class/interface/helper
  9745. aClass:=TPasClassType(ClassRecScope.Element);
  9746. AncestorScope:=TPasClassScope(ClassRecScope).AncestorScope;
  9747. if aClass.ObjKind in okAllHelpers then
  9748. begin
  9749. HelperForType:=ResolveAliasType(aClass.HelperForType);
  9750. if HelperForType is TPasMembersType then
  9751. begin
  9752. // record helper(ancestor) for aRecord
  9753. // or class helper(ancestor) for aClass
  9754. // -> search in helperfortype, then in ancestors
  9755. InhScope:=PushInheritedScope(TPasMembersType(HelperForType),false,
  9756. AncestorScope);
  9757. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9758. ResolveExpr(El.right,Access);
  9759. PopScope;
  9760. exit;
  9761. end
  9762. else
  9763. begin
  9764. // type helper(ancestortype) for simpletype -> search in ancestortype
  9765. end;
  9766. end
  9767. else
  9768. begin
  9769. // class or interface -> search in ancestor and its helpers
  9770. end;
  9771. // search in ancestor and its helpers
  9772. if AncestorScope=nil then
  9773. RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
  9774. // search call in ancestor
  9775. AncestorClass:=TPasClassType(AncestorScope.Element);
  9776. InhScope:=PushInheritedScope(AncestorClass,true,nil);
  9777. InhScope.OnlyTypeMembers:=OnlyTypeMembers;
  9778. ResolveExpr(El.right,Access);
  9779. PopScope;
  9780. end;
  9781. procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
  9782. Access: TResolvedRefAccess);
  9783. begin
  9784. {$IFDEF VerbosePasResolver}
  9785. //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
  9786. {$ENDIF}
  9787. case El.OpCode of
  9788. eopNone:
  9789. case El.Kind of
  9790. pekRange:
  9791. begin
  9792. ResolveExpr(El.left,rraRead);
  9793. if El.right=nil then exit;
  9794. ResolveExpr(El.right,rraRead);
  9795. end;
  9796. else
  9797. if El.left.ClassType=TInheritedExpr then
  9798. begin
  9799. ResolveExpr(El.left,Access);
  9800. end
  9801. else
  9802. begin
  9803. {$IFDEF VerbosePasResolver}
  9804. writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
  9805. {$ENDIF}
  9806. RaiseNotYetImplemented(20160922163456,El);
  9807. end;
  9808. end;
  9809. eopAdd,
  9810. eopSubtract,
  9811. eopMultiply,
  9812. eopDivide,
  9813. eopDiv,
  9814. eopMod,
  9815. eopPower,
  9816. eopShr,
  9817. eopShl,
  9818. eopNot,
  9819. eopAnd,
  9820. eopOr,
  9821. eopXor,
  9822. eopEqual,
  9823. eopNotEqual,
  9824. eopLessThan,
  9825. eopGreaterThan,
  9826. eopLessthanEqual,
  9827. eopGreaterThanEqual,
  9828. eopIn,
  9829. eopIs,
  9830. eopAs,
  9831. eopSymmetricaldifference:
  9832. begin
  9833. ResolveExpr(El.left,rraRead);
  9834. if El.right=nil then exit;
  9835. ResolveExpr(El.right,rraRead);
  9836. end;
  9837. eopSubIdent:
  9838. begin
  9839. ResolveExpr(El.left,rraRead);
  9840. if El.right=nil then exit;
  9841. ResolveSubIdent(El,Access);
  9842. end;
  9843. else
  9844. RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
  9845. end;
  9846. end;
  9847. procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
  9848. Access: TResolvedRefAccess);
  9849. procedure ResolveRight; inline;
  9850. begin
  9851. ResolveExpr(El.right,Access);
  9852. PopScope;
  9853. end;
  9854. function SearchInTypeHelpers(HiType: TPasType; IdentEl: TPasElement): boolean;
  9855. var
  9856. DotScope: TPasDotBaseScope;
  9857. begin
  9858. if HiType=nil then exit(false);
  9859. DotScope:=PushHelperDotScope(HiType);
  9860. if DotScope=nil then exit(false);
  9861. if IdentEl is TPasType then
  9862. // e.g. TFlag.HelperProc
  9863. DotScope.OnlyTypeMembers:=true;
  9864. ResolveRight;
  9865. Result:=true;
  9866. end;
  9867. var
  9868. aModule: TPasModule;
  9869. ClassEl: TPasClassType;
  9870. ClassScope: TPasDotClassScope;
  9871. LeftResolved: TPasResolverResult;
  9872. Left: TPasExpr;
  9873. RecordEl: TPasRecordType;
  9874. RecordScope: TPasDotClassOrRecordScope;
  9875. LLoTypeEl, LHiTypeEl: TPasType;
  9876. DotScope: TPasDotBaseScope;
  9877. SetType: TPasSetType;
  9878. begin
  9879. if El.CustomData is TResolvedReference then
  9880. exit; // for example, when a.b has a dotted unit name
  9881. Left:=El.left;
  9882. //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
  9883. ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
  9884. if LeftResolved.BaseType=btModule then
  9885. begin
  9886. // e.g. unitname.identifier
  9887. // => search in interface and if this is our module in the implementation
  9888. aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
  9889. PushModuleDotScope(aModule);
  9890. ResolveRight;
  9891. exit;
  9892. end
  9893. else if LeftResolved.LoTypeEl=nil then
  9894. begin
  9895. // illegal qualifier, see below
  9896. end
  9897. else
  9898. begin
  9899. LHiTypeEl:=LeftResolved.HiTypeEl;
  9900. LLoTypeEl:=LeftResolved.LoTypeEl;
  9901. if (LLoTypeEl.ClassType=TPasPointerType)
  9902. and ElHasModeSwitch(El,msAutoDeref)
  9903. and (rrfReadable in LeftResolved.Flags)
  9904. then
  9905. begin
  9906. // a.b -> a^.b
  9907. LHiTypeEl:=TPasPointerType(LLoTypeEl).DestType;
  9908. LLoTypeEl:=ResolveAliasType(LHiTypeEl);
  9909. Include(LeftResolved.Flags,rrfWritable);
  9910. end;
  9911. //writeln('TPasResolver.ResolveSubIdent ',GetObjPath(El),' ',GetObjPath(LLoTypeEl));
  9912. if LLoTypeEl.ClassType=TPasClassType then
  9913. begin
  9914. ClassEl:=TPasClassType(LLoTypeEl);
  9915. if ClassEl.HelperForType<>nil then
  9916. RaiseHelpersCannotBeUsedAsType(20190123093438,El);
  9917. ClassScope:=PushClassDotScope(ClassEl);
  9918. if LeftResolved.IdentEl is TPasType then
  9919. // e.g. TFPMemoryImage.FindHandlerFromExtension()
  9920. ClassScope.OnlyTypeMembers:=true
  9921. else
  9922. // e.g. Image.Width
  9923. ClassScope.OnlyTypeMembers:=false;
  9924. ResolveRight;
  9925. exit;
  9926. end
  9927. else if LLoTypeEl.ClassType=TPasClassOfType then
  9928. begin
  9929. // e.g. ImageClass.FindHandlerFromExtension()
  9930. ClassEl:=ResolveAliasType(TPasClassOfType(LLoTypeEl).DestType) as TPasClassType;
  9931. ClassScope:=PushClassDotScope(ClassEl);
  9932. ClassScope.OnlyTypeMembers:=true;
  9933. ClassScope.IsClassOf:=true;
  9934. ResolveRight;
  9935. exit;
  9936. end
  9937. else if LLoTypeEl.ClassType=TPasRecordType then
  9938. begin
  9939. RecordEl:=TPasRecordType(LLoTypeEl);
  9940. RecordScope:=PushRecordDotScope(RecordEl);
  9941. RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
  9942. if LeftResolved.IdentEl is TPasType then
  9943. // e.g. TPoint.PointInCircle
  9944. RecordScope.OnlyTypeMembers:=true
  9945. else
  9946. begin
  9947. // e.g. aPoint.X
  9948. AccessExpr(El.left,Access);
  9949. RecordScope.OnlyTypeMembers:=false;
  9950. end;
  9951. ResolveRight;
  9952. exit;
  9953. end
  9954. else if LLoTypeEl.ClassType=TPasEnumType then
  9955. begin
  9956. if (LeftResolved.IdentEl is TPasType)
  9957. and (ResolveAliasType(TPasType(LeftResolved.IdentEl)).ClassType=TPasEnumType) then
  9958. begin
  9959. // e.g. TShiftState.ssAlt
  9960. DotScope:=PushEnumDotScope(LHiTypeEl,TPasEnumType(LLoTypeEl));
  9961. DotScope.OnlyTypeMembers:=true;
  9962. ResolveRight;
  9963. exit;
  9964. end;
  9965. end
  9966. else if LLoTypeEl.ClassType=TPasGenericTemplateType then
  9967. begin
  9968. DotScope:=PushTemplateDotScope(TPasGenericTemplateType(LLoTypeEl),El);
  9969. if DotScope<>nil then
  9970. begin
  9971. if LeftResolved.IdentEl is TPasType then
  9972. // e.g. T.Member
  9973. DotScope.OnlyTypeMembers:=true
  9974. else
  9975. // e.g. VarOfTypeT.Member
  9976. DotScope.OnlyTypeMembers:=false;
  9977. ResolveRight;
  9978. exit;
  9979. end;
  9980. end;
  9981. // default: search for type helpers
  9982. if (LeftResolved.BaseType in btAllIntrinsicTypes)
  9983. or (LeftResolved.BaseType=btContext)
  9984. or (LeftResolved.BaseType=btCustom) then
  9985. begin
  9986. if SearchInTypeHelpers(LeftResolved.HiTypeEl,LeftResolved.IdentEl) then exit;
  9987. end
  9988. else if LeftResolved.BaseType=btSet then
  9989. begin
  9990. SetType:=GetSetType(LeftResolved);
  9991. if SearchInTypeHelpers(SetType,LeftResolved.IdentEl) then exit;
  9992. end;
  9993. end;
  9994. {$IFDEF VerbosePasResolver}
  9995. writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
  9996. {$ENDIF}
  9997. RaiseMsg(20170216152157,nIllegalQualifierAfter,sIllegalQualifierAfter,
  9998. ['.',GetResolverResultDescription(LeftResolved)],El);
  9999. end;
  10000. procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
  10001. Access: TResolvedRefAccess);
  10002. begin
  10003. if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
  10004. begin
  10005. {$IFDEF VerbosePasResolver}
  10006. writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
  10007. {$ENDIF}
  10008. RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10009. end;
  10010. // first resolve params
  10011. ResolveParamsExprParams(Params);
  10012. // then resolve the call, typecast, array, set
  10013. if (Params.Kind=pekFuncParams) then
  10014. ResolveFuncParamsExpr(Params,Access)
  10015. else if (Params.Kind=pekArrayParams) then
  10016. ResolveArrayParamsExpr(Params,Access)
  10017. else if (Params.Kind=pekSet) then
  10018. ResolveSetParamsExpr(Params)
  10019. else
  10020. RaiseNotYetImplemented(20160922163501,Params);
  10021. end;
  10022. procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
  10023. var
  10024. ScopeDepth, i: integer;
  10025. ParamAccess: TResolvedRefAccess;
  10026. Pars: TPasExprArray;
  10027. begin
  10028. ScopeDepth:=StashSubExprScopes;
  10029. if Params.Kind in [pekFuncParams,pekArrayParams] then
  10030. ParamAccess:=rraParamToUnknownProc
  10031. else
  10032. ParamAccess:=rraRead;
  10033. Pars:=Params.Params;
  10034. for i:=0 to length(Pars)-1 do
  10035. ResolveExpr(Pars[i],ParamAccess);
  10036. RestoreStashedScopes(ScopeDepth);
  10037. end;
  10038. procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
  10039. Access: TResolvedRefAccess);
  10040. var
  10041. Value: TPasExpr;
  10042. SubParams: TParamsExpr;
  10043. ResolvedEl: TPasResolverResult;
  10044. begin
  10045. Value:=Params.Value;
  10046. if Value is TBinaryExpr then
  10047. begin
  10048. // Note: a.b() is the same as (a.b)()
  10049. // Note: a.b().c is stored as
  10050. // TBinaryExpr eopSubIdent
  10051. // / \
  10052. // left = TParamsExpr right = TPrimitiveExpr 'c'
  10053. // Value = TBinaryExpr
  10054. // / \
  10055. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  10056. if (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) then
  10057. Value:=TBinaryExpr(Value).right;
  10058. if IsNameExpr(Value) then
  10059. begin
  10060. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10061. if not (Value.CustomData is TResolvedReference) then
  10062. RaiseNotYetImplemented(20190115140557,Params);
  10063. // already resolved
  10064. exit;
  10065. end
  10066. else if Value.ClassType=TInlineSpecializeExpr then
  10067. begin
  10068. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10069. // already resolved
  10070. exit;
  10071. end;
  10072. // ToDo: (a+b)()
  10073. //ResolveBinaryExpr(TBinaryExpr(Params.Value),rraRead);
  10074. RaiseNotYetImplemented(20190115140809,Params);
  10075. end
  10076. else if IsNameExpr(Value) then
  10077. ResolveFuncParamsExprName(Value,nil,Params,Access)
  10078. else if Value.ClassType=TInlineSpecializeExpr then
  10079. begin
  10080. // e.g. Name<>()
  10081. ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),rraRead);
  10082. end
  10083. else if Value.ClassType=TParamsExpr then
  10084. begin
  10085. SubParams:=TParamsExpr(Value);
  10086. if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
  10087. begin
  10088. // e.g. Name()() or Name[]()
  10089. ResolveParamsExpr(SubParams,rraRead);
  10090. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10091. if IsProcedureType(ResolvedEl,true) then
  10092. begin
  10093. CreateReference(TPasProcedureType(ResolvedEl.LoTypeEl),Value,Access);
  10094. FinishProcParamAccess(TPasProcedureType(ResolvedEl.LoTypeEl),Params);
  10095. exit;
  10096. end
  10097. end;
  10098. RaiseMsg(20170216152202,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10099. ['(',SubParams.ElementTypeName],Params);
  10100. end
  10101. else
  10102. RaiseNotYetImplemented(20161014085118,Params.Value);
  10103. end;
  10104. procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
  10105. TemplParams: TFPList; Params: TParamsExpr; Access: TResolvedRefAccess;
  10106. CallName: string);
  10107. procedure RaiseMultiFit;
  10108. var
  10109. FindCallData: TFindCallElData;
  10110. Msg: String;
  10111. i: Integer;
  10112. El: TPasElement;
  10113. Abort: boolean;
  10114. begin
  10115. FindCallData:=Default(TFindCallElData);
  10116. FindCallData.Params:=Params;
  10117. FindCallData.List:=TFPList.Create;
  10118. try
  10119. Abort:=false;
  10120. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  10121. Msg:='';
  10122. for i:=0 to FindCallData.List.Count-1 do
  10123. begin
  10124. El:=TPasElement(FindCallData.List[i]);
  10125. {$IFDEF VerbosePasResolver}
  10126. writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
  10127. {$ENDIF}
  10128. // emit a hint for each candidate
  10129. if El is TPasProcedure then
  10130. LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
  10131. [GetProcTypeDescription(TPasProcedure(El).ProcType,
  10132. [prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
  10133. Msg:=Msg+', '+GetElementSourcePosStr(El);
  10134. end;
  10135. finally
  10136. FindCallData.List.Free;
  10137. end;
  10138. RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
  10139. sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
  10140. end;
  10141. procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
  10142. var
  10143. i: Integer;
  10144. begin
  10145. if ParamAccess=rraParamToUnknownProc then exit;
  10146. for i:=0 to length(Params.Params)-1 do
  10147. FinishCallArgAccess(Params.Params[i],ParamAccess);
  10148. end;
  10149. procedure CheckTemplParams(GenTemplates, TemplParams: TFPList);
  10150. var
  10151. i: Integer;
  10152. Param, PosEl: TPasElement;
  10153. ResolvedEl: TPasResolverResult;
  10154. begin
  10155. for i:=0 to TemplParams.Count-1 do
  10156. begin
  10157. Param:=TPasElement(TemplParams[i]);
  10158. ComputeElement(Param,ResolvedEl,[rcType]);
  10159. if Param is TPasExpr then
  10160. PosEl:=Param
  10161. else
  10162. PosEl:=Params;
  10163. if CheckTemplateFitsParamRes(TPasGenericTemplateType(GenTemplates[i]),
  10164. ResolvedEl,prtcoAssignToTempl,PosEl)=cIncompatible then
  10165. // should have raise error
  10166. RaiseNotYetImplemented(20190919095604,PosEl,GetResolverResultDbg(ResolvedEl));
  10167. end;
  10168. end;
  10169. var
  10170. FindCallData: TFindCallElData;
  10171. Abort: boolean;
  10172. FoundEl: TPasElement;
  10173. Ref: TResolvedReference;
  10174. FindData: TPRFindData;
  10175. BuiltInProc: TResElDataBuiltInProc;
  10176. ResolvedEl: TPasResolverResult;
  10177. TypeEl: TPasType;
  10178. C: TClass;
  10179. TemplParamsCnt: Integer;
  10180. GenTemplates, InferenceParams: TFPList;
  10181. begin
  10182. // e.g. Name() -> find compatible
  10183. {$IFDEF VerbosePasResolver}
  10184. //writeln('TPasResolver.ResolveFuncParamsExprName NameExpr=',GetObjName(NameExpr),' TemplParams=',TemplParams<>nil,' CallName="',CallName,'"');
  10185. {$ENDIF}
  10186. if CallName<>'' then
  10187. else if NameExpr.ClassType=TPrimitiveExpr then
  10188. CallName:=TPrimitiveExpr(NameExpr).Value
  10189. else
  10190. RaiseNotYetImplemented(20190115143539,NameExpr);
  10191. FindCallData:=Default(TFindCallElData);
  10192. FindCallData.Params:=Params;
  10193. if TemplParams<>nil then
  10194. begin
  10195. TemplParamsCnt:=TemplParams.Count;
  10196. FindCallData.TemplCnt:=TemplParamsCnt;
  10197. end
  10198. else
  10199. TemplParamsCnt:=0;
  10200. Abort:=false;
  10201. IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
  10202. FoundEl:=FindCallData.Found;
  10203. if FoundEl=nil then
  10204. RaiseIdentifierNotFound(20170216152544,CallName,NameExpr);
  10205. if FindCallData.Distance=cIncompatible then
  10206. begin
  10207. // FoundEl one element, but it was incompatible => raise error
  10208. {$IFDEF VerbosePasResolver}
  10209. writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
  10210. WriteScopes;
  10211. {$ENDIF}
  10212. if FoundEl is TPasProcedure then
  10213. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true)
  10214. else if FoundEl is TPasProcedureType then
  10215. CheckTypeCast(TPasProcedureType(FoundEl),Params,true)
  10216. else if FoundEl.ClassType=TPasUnresolvedSymbolRef then
  10217. begin
  10218. if FoundEl.CustomData is TResElDataBuiltInProc then
  10219. begin
  10220. BuiltInProc:=TResElDataBuiltInProc(FoundEl.CustomData);
  10221. BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
  10222. RaiseNotYetImplemented(20200525124749,FoundEl,'missing exception, Found=['+BuiltInProc.Signature+']');
  10223. end
  10224. else if FoundEl.CustomData is TResElDataBaseType then
  10225. CheckTypeCast(TPasUnresolvedSymbolRef(FoundEl),Params,true)
  10226. else
  10227. RaiseNotYetImplemented(20161006132825,FoundEl);
  10228. end
  10229. else if FoundEl is TPasType then
  10230. // Note: check TPasType after TPasUnresolvedSymbolRef
  10231. CheckTypeCast(TPasType(FoundEl),Params,true)
  10232. else if FoundEl is TPasVariable then
  10233. begin
  10234. TypeEl:=ResolveAliasType(TPasVariable(FoundEl).VarType);
  10235. if TypeEl is TPasProcedureType then
  10236. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  10237. else
  10238. RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10239. ['(',TypeEl.ElementTypeName],Params);
  10240. end
  10241. else if FoundEl is TPasArgument then
  10242. begin
  10243. TypeEl:=ResolveAliasType(TPasArgument(FoundEl).ArgType);
  10244. if TypeEl is TPasProcedureType then
  10245. CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
  10246. else
  10247. RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10248. ['(',TypeEl.ElementTypeName],Params);
  10249. end
  10250. else
  10251. RaiseNotYetImplemented(20161003134755,FoundEl);
  10252. // missing raise exception
  10253. RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FoundEl));
  10254. end;
  10255. if FindCallData.Count>1 then
  10256. begin
  10257. // multiple overloads fit
  10258. if (FoundEl is TPasProcedure)
  10259. and (IndexOfGenericParam(Params.Params)>=0) then
  10260. // generic params -> ignore ambiguity
  10261. else
  10262. // => search again and list the candidates
  10263. RaiseMultiFit;
  10264. end;
  10265. // check template params
  10266. if FoundEl is TPasProcedure then
  10267. GenTemplates:=GetProcTemplateTypes(TPasProcedure(FoundEl))
  10268. else if FoundEl is TPasGenericType then
  10269. GenTemplates:=TPasGenericType(FoundEl).GenericTemplateTypes
  10270. else
  10271. GenTemplates:=nil;
  10272. if TemplParamsCnt>0 then
  10273. begin
  10274. // check template types
  10275. if GenTemplates=nil then
  10276. RaiseMsg(20190919100922,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  10277. [FoundEl.Name],NameExpr);
  10278. if TemplParamsCnt<>GenTemplates.Count then
  10279. RaiseMsg(20190919101051,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10280. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10281. CheckTemplParams(GenTemplates,TemplParams);
  10282. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,TemplParams);
  10283. if FoundEl is TPasProcedure then
  10284. begin
  10285. // check if params fit the implicit specialized function
  10286. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
  10287. end;
  10288. end
  10289. else if (GenTemplates<>nil) and (GenTemplates.Count>0) then
  10290. begin
  10291. if (FoundEl is TPasProcedure)
  10292. and (msImplicitFunctionSpec in CurrentParser.CurrentModeswitches) then
  10293. begin
  10294. // GenericProc() -> create template types by inference
  10295. InferenceParams:=CreateInferenceTypesForCall(Params,TPasProcedure(FoundEl));
  10296. try
  10297. CheckTemplParams(GenTemplates,InferenceParams);
  10298. FoundEl:=GetSpecializedEl(NameExpr,FoundEl,InferenceParams);
  10299. // check if params fit the implicit specialized function
  10300. CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
  10301. finally
  10302. ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
  10303. FreeAndNil(InferenceParams);
  10304. end;
  10305. end
  10306. else
  10307. // GenericType() -> missing type params
  10308. RaiseMsg(20190919120728,nWrongNumberOfParametersForGenericX,sWrongNumberOfParametersForGenericX,
  10309. [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
  10310. end;
  10311. if FoundEl is TPasType then
  10312. begin
  10313. // typecast
  10314. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  10315. C:=TypeEl.ClassType;
  10316. if C=TPasUnresolvedSymbolRef then
  10317. begin
  10318. // typecast to built-in type
  10319. if TypeEl.CustomData is TResElDataBaseType then
  10320. CheckTypeCast(TypeEl,Params,true); // emit warnings
  10321. end
  10322. else
  10323. begin
  10324. // typecast to user type
  10325. CheckTypeCast(TypeEl,Params,true); // emit warnings
  10326. end;
  10327. end;
  10328. // FoundEl compatible element -> create reference
  10329. Ref:=CreateReference(FoundEl,NameExpr,rraRead);
  10330. if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
  10331. Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
  10332. FindData:=Default(TPRFindData);
  10333. FindData.ErrorPosEl:=NameExpr;
  10334. FindData.StartScope:=FindCallData.StartScope;
  10335. FindData.ElScope:=FindCallData.ElScope;
  10336. FindData.Found:=FoundEl;
  10337. CheckFoundElement(FindData,Ref);
  10338. // set param expression Access flags
  10339. if FoundEl is TPasProcedure then
  10340. begin
  10341. // now it is known which overloaded proc to call
  10342. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10343. begin
  10344. {$IFDEF VerbosePasResolver}
  10345. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10346. {$ENDIF}
  10347. RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10348. end;
  10349. FinishProcParamAccess(TPasProcedure(FoundEl).ProcType,Params);
  10350. end
  10351. else if FoundEl is TPasType then
  10352. begin
  10353. TypeEl:=ResolveAliasType(TPasType(FoundEl));
  10354. C:=TypeEl.ClassType;
  10355. if (C=TPasClassType)
  10356. or (C=TPasClassOfType)
  10357. or (C=TPasRecordType)
  10358. or (C=TPasEnumType)
  10359. or (C=TPasSetType)
  10360. or (C=TPasPointerType)
  10361. or (C=TPasArrayType)
  10362. or (C=TPasRangeType)
  10363. or (C=TPasGenericTemplateType) then
  10364. begin
  10365. // type cast
  10366. FinishUntypedParams(Access);
  10367. end
  10368. else if (C=TPasProcedureType)
  10369. or (C=TPasFunctionType) then
  10370. begin
  10371. // type cast to proc type
  10372. AccessExpr(Params.Params[0],Access);
  10373. end
  10374. else if C=TPasUnresolvedSymbolRef then
  10375. begin
  10376. if TypeEl.CustomData is TResElDataBuiltInProc then
  10377. begin
  10378. // call built-in proc
  10379. BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
  10380. if Assigned(BuiltInProc.FinishParamsExpression) then
  10381. BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
  10382. else
  10383. FinishUntypedParams(rraRead);
  10384. end
  10385. else if TypeEl.CustomData is TResElDataBaseType then
  10386. begin
  10387. // type cast to base type
  10388. FinishUntypedParams(Access);
  10389. end
  10390. else
  10391. begin
  10392. {$IFDEF VerbosePasResolver}
  10393. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10394. {$ENDIF}
  10395. RaiseNotYetImplemented(20170325145720,Params);
  10396. end;
  10397. end
  10398. else
  10399. begin
  10400. {$IFDEF VerbosePasResolver}
  10401. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
  10402. {$ENDIF}
  10403. RaiseMsg(20170306121908,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10404. ['(',TypeEl.ElementTypeName],Params);
  10405. end;
  10406. end
  10407. else
  10408. begin
  10409. // FoundEl is not a type, maybe a var
  10410. ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10411. TypeEl:=ResolvedEl.LoTypeEl;
  10412. if TypeEl is TPasProcedureType then
  10413. begin
  10414. if not (Access in [rraRead,rraParamToUnknownProc]) then
  10415. begin
  10416. {$IFDEF VerbosePasResolver}
  10417. writeln('TPasResolver.ResolveFuncParamsExprName Params=',GetObjName(Params),' NameExpr=',GetObjName(NameExpr),' Access=',Access);
  10418. {$ENDIF}
  10419. RaiseMsg(20190215195439,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
  10420. end;
  10421. FinishProcParamAccess(TPasProcedureType(TypeEl),Params);
  10422. exit;
  10423. end;
  10424. {$IFDEF VerbosePasResolver}
  10425. writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
  10426. {$ENDIF}
  10427. RaiseMsg(20170306104301,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10428. ['(',TypeEl.ElementTypeName],Params);
  10429. end;
  10430. end;
  10431. procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
  10432. Access: TResolvedRefAccess);
  10433. var
  10434. ResolvedEl: TPasResolverResult;
  10435. Value: TPasExpr;
  10436. SubParams: TParamsExpr;
  10437. begin
  10438. Value:=Params.Value;
  10439. if Value=nil then
  10440. RaiseInternalError(20180423093120,GetObjName(Params));
  10441. if IsNameExpr(Value) then
  10442. begin
  10443. // e.g. Name[]
  10444. ResolveArrayParamsExprName(Value,Params,Access);
  10445. exit;
  10446. end
  10447. else if Value.ClassType=TParamsExpr then
  10448. begin
  10449. SubParams:=TParamsExpr(Value);
  10450. // e.g. Name()[] or Name[][] or [][]
  10451. ResolveExpr(SubParams,rraRead);
  10452. ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
  10453. if Value.CustomData=nil then
  10454. CreateReference(ResolvedEl.LoTypeEl,Value,Access);
  10455. ResolvedEl.IdentEl:=nil;
  10456. end
  10457. else if Value.InheritsFrom(TUnaryExpr) then
  10458. begin
  10459. ResolveExpr(TUnaryExpr(Value).Operand,Access);
  10460. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  10461. end
  10462. else if Value is TBinaryExpr then
  10463. begin
  10464. // Note: a.b[] is the same as (a.b)[]
  10465. // Note: a.b[].c is stored as
  10466. // TBinaryExpr eopSubIdent
  10467. // / \
  10468. // left = TParamsExpr right = TPrimitiveExpr 'c'
  10469. // Value = TBinaryExpr
  10470. // / \
  10471. // left = TPrimitiveExpr 'a' right = TPrimitiveExpr 'b'
  10472. while (Value is TBinaryExpr) and (TBinaryExpr(Value).OpCode=eopSubIdent) do
  10473. Value:=TBinaryExpr(Value).right;
  10474. if IsNameExpr(Value) then
  10475. begin
  10476. ResolveBinaryExpr(TBinaryExpr(Params.Value),Access);
  10477. if not (Value.CustomData is TResolvedReference) then
  10478. RaiseNotYetImplemented(20190115144534,Params);
  10479. // already resolved via ResolveNameExpr, which calls ResolveArrayParamsExprName
  10480. exit;
  10481. end
  10482. else
  10483. begin
  10484. // For example (a+b)[] or (a as b)[]
  10485. Value:=Params.Value;
  10486. ResolveBinaryExpr(TBinaryExpr(Value),rraRead);
  10487. ComputeElement(Value,ResolvedEl,[rcSetReferenceFlags]);
  10488. end;
  10489. end
  10490. else
  10491. RaiseNotYetImplemented(20160927212610,Value);
  10492. {$IFDEF VerbosePasResolver}
  10493. writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
  10494. {$ENDIF}
  10495. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10496. end;
  10497. procedure TPasResolver.ResolveArrayParamsExprName(NameExpr: TPasExpr;
  10498. Params: TParamsExpr; Access: TResolvedRefAccess);
  10499. // e.g. a.NameExpr[]
  10500. var
  10501. ArrayName: String;
  10502. FindData: TPRFindData;
  10503. Ref: TResolvedReference;
  10504. DeclEl: TPasElement;
  10505. Proc, ImplProc: TPasProcedure;
  10506. ProcScope: TPasProcedureScope;
  10507. ResolvedEl: TPasResolverResult;
  10508. begin
  10509. if (NameExpr.ClassType=TPrimitiveExpr)
  10510. and (TPrimitiveExpr(NameExpr).Kind=pekIdent) then
  10511. // e.g. Name[]
  10512. ArrayName:=TPrimitiveExpr(NameExpr).Value
  10513. else if NameExpr.ClassType=TInlineSpecializeExpr then
  10514. RaiseMsg(20190912190518,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10515. ['[','inline specialize'],Params)
  10516. else
  10517. RaiseNotYetImplemented(20190131154557,NameExpr);
  10518. DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true,true);
  10519. Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData);
  10520. CheckFoundElement(FindData,Ref);
  10521. if DeclEl is TPasProcedure then
  10522. begin
  10523. Proc:=TPasProcedure(DeclEl);
  10524. if (Access=rraAssign)
  10525. and (Proc.ProcType is TPasFunctionType)
  10526. and (Params.Parent.ClassType=TPasImplAssign)
  10527. and (TPasImplAssign(Params.Parent).left=Params) then
  10528. begin
  10529. // e.g. funcname[]:=
  10530. ProcScope:=Proc.CustomData as TPasProcedureScope;
  10531. ImplProc:=ProcScope.ImplProc;
  10532. if ImplProc=nil then
  10533. ImplProc:=Proc;
  10534. if Params.HasParent(ImplProc) then
  10535. begin
  10536. // "FuncA[]:=" within FuncA -> redirect to ResultEl
  10537. Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
  10538. end;
  10539. end;
  10540. end;
  10541. ComputeElement(NameExpr,ResolvedEl,[rcSetReferenceFlags]);
  10542. {$IFDEF VerbosePasResolver}
  10543. writeln('TPasResolver.ResolveArrayParamsExprName NameExp=',GetObjName(NameExpr),' ',GetResolverResultDbg(ResolvedEl));
  10544. {$ENDIF}
  10545. ResolveArrayParamsArgs(Params,ResolvedEl,Access);
  10546. end;
  10547. procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
  10548. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
  10549. procedure ReadAccessParamValue;
  10550. var
  10551. Left: TPasExpr;
  10552. Ref: TResolvedReference;
  10553. begin
  10554. if Access=rraAssign then
  10555. begin
  10556. // ArrayStringPointer[]:=
  10557. // -> writing the element needs reading the value
  10558. Left:=Params.Value;
  10559. if (Left is TBinaryExpr) and (TBinaryExpr(Left).OpCode=eopSubIdent) then
  10560. Left:=TBinaryExpr(Left).right;
  10561. if Left.CustomData is TResolvedReference then
  10562. begin
  10563. Ref:=TResolvedReference(Left.CustomData);
  10564. if Ref.Access=rraAssign then
  10565. Ref.Access:=rraReadAndAssign;
  10566. end;
  10567. end;
  10568. end;
  10569. function CheckStringOrPointerIndex(IsStringIndex: boolean): boolean;
  10570. var
  10571. ArgExp: TPasExpr;
  10572. ResolvedArg: TPasResolverResult;
  10573. begin
  10574. ReadAccessParamValue;
  10575. if not IsStringIndex then
  10576. begin
  10577. // pointer
  10578. if not ElHasBoolSwitch(Params,bsPointerMath) then
  10579. exit(false);
  10580. end;
  10581. Result:=true;
  10582. if not (rrfReadable in ResolvedValue.Flags) then
  10583. RaiseXExpectedButYFound(20170216152548,'index',GetElementTypeName(ResolvedValue.LoTypeEl),Params);
  10584. // check single argument
  10585. if length(Params.Params)<1 then
  10586. RaiseMsg(20170216152204,nMissingParameterX,
  10587. sMissingParameterX,[BoolToStr(IsStringIndex,'character index','index')],Params)
  10588. else if length(Params.Params)>1 then
  10589. RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
  10590. // check argument is integer
  10591. ArgExp:=Params.Params[0];
  10592. ComputeElement(ArgExp,ResolvedArg,[rcSetReferenceFlags]);
  10593. if not (ResolvedArg.BaseType in btAllInteger) then
  10594. RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10595. [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
  10596. if not (rrfReadable in ResolvedArg.Flags) then
  10597. RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  10598. ['type','value'],ArgExp);
  10599. AccessExpr(ArgExp,rraRead);
  10600. end;
  10601. var
  10602. PropEl: TPasProperty;
  10603. i: Integer;
  10604. TypeEl: TPasType;
  10605. C: TClass;
  10606. begin
  10607. if ResolvedValue.BaseType in btAllStrings then
  10608. begin
  10609. // string -> check that ResolvedValue is not merely a type, but has a value
  10610. if CheckStringOrPointerIndex(true) then
  10611. exit;
  10612. end
  10613. else if (ResolvedValue.IdentEl is TPasProperty)
  10614. and (GetPasPropertyArgs(TPasProperty(ResolvedValue.IdentEl)).Count>0) then
  10615. begin
  10616. PropEl:=TPasProperty(ResolvedValue.IdentEl);
  10617. CheckCallPropertyCompatibility(PropEl,Params,true);
  10618. FinishPropertyParamAccess(Params,PropEl);
  10619. exit;
  10620. end
  10621. else if ResolvedValue.BaseType=btPointer then
  10622. begin
  10623. if CheckStringOrPointerIndex(false) then
  10624. exit;
  10625. end
  10626. else if ResolvedValue.BaseType=btContext then
  10627. begin
  10628. TypeEl:=ResolvedValue.LoTypeEl;
  10629. C:=TypeEl.ClassType;
  10630. if (C=TPasClassType)
  10631. or (C=TPasRecordType)
  10632. or (C=TPasClassOfType) then
  10633. begin
  10634. if ResolveBracketOperatorClassOrRec(Params,ResolvedValue,Access) then
  10635. exit;
  10636. end
  10637. else if C=TPasArrayType then
  10638. begin
  10639. if ResolvedValue.IdentEl is TPasType then
  10640. RaiseMsg(20170216152215,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10641. ['[',ResolvedValue.IdentEl.ElementTypeName],Params);
  10642. ReadAccessParamValue;
  10643. CheckCallArrayCompatibility(TPasArrayType(TypeEl),Params,true,true);
  10644. for i:=0 to length(Params.Params)-1 do
  10645. AccessExpr(Params.Params[i],rraRead);
  10646. exit;
  10647. end
  10648. else if C=TPasPointerType then
  10649. begin
  10650. if CheckStringOrPointerIndex(false) then exit;
  10651. end;
  10652. end;
  10653. RaiseMsg(20170216152217,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10654. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10655. end;
  10656. function TPasResolver.ResolveBracketOperatorClassOrRec(Params: TParamsExpr;
  10657. const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess): boolean;
  10658. var
  10659. PropEl: TPasProperty;
  10660. Value: TPasExpr;
  10661. Group: TPasGroupScope;
  10662. i: Integer;
  10663. Scope: TPasIdentifierScope;
  10664. HiType, LoType: TPasType;
  10665. IsClassOf: Boolean;
  10666. begin
  10667. HiType:=ResolvedValue.HiTypeEl;
  10668. LoType:=ResolvedValue.LoTypeEl;
  10669. IsClassOf:=LoType.ClassType=TPasClassOfType;
  10670. if IsClassOf then
  10671. begin
  10672. HiType:=TPasClassOfType(LoType).DestType;
  10673. LoType:=ResolveAliasType(LoType);
  10674. end;
  10675. Group:=CreateGroupScope(HiType);
  10676. PropEl:=nil;
  10677. for i:=0 to Group.Count-1 do
  10678. begin
  10679. Scope:=Group.Scopes[i];
  10680. if Scope is TPasClassOrRecordScope then
  10681. begin
  10682. PropEl:=TPasClassOrRecordScope(Scope).DefaultProperty;
  10683. if PropEl<>nil then break;
  10684. end;
  10685. end;
  10686. Group.Free;
  10687. if PropEl=nil then exit(false);
  10688. // class/record/interface has default property
  10689. if (IsClassOf or (ResolvedValue.IdentEl is TPasType)) and (not PropEl.IsClass) then
  10690. RaiseMsg(20170216152213,nIllegalQualifierAfter,sIllegalQualifierAfter,
  10691. ['[',GetResolverResultDescription(ResolvedValue,true)],Params);
  10692. Value:=Params.Value;
  10693. if Value.CustomData is TResolvedReference then
  10694. SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
  10695. CreateReference(PropEl,Params,Access);
  10696. CheckCallPropertyCompatibility(PropEl,Params,true);
  10697. FinishPropertyParamAccess(Params,PropEl);
  10698. Result:=true;
  10699. end;
  10700. procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
  10701. // e.g. resolving '[1,2..3]'
  10702. var
  10703. i: Integer;
  10704. Param: TPasExpr;
  10705. ParamResolved: TPasResolverResult;
  10706. begin
  10707. {$IFDEF VerbosePasResolver}
  10708. writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
  10709. {$ENDIF}
  10710. if Params.Value<>nil then
  10711. RaiseNotYetImplemented(20160930135910,Params);
  10712. for i:=0 to length(Params.Params)-1 do
  10713. begin
  10714. Param:=Params.Params[i];
  10715. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType,rcSetReferenceFlags]);
  10716. end;
  10717. end;
  10718. procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
  10719. var
  10720. i: Integer;
  10721. begin
  10722. for i:=0 to length(El.Values)-1 do
  10723. ResolveExpr(El.Values[i],rraRead);
  10724. end;
  10725. procedure TPasResolver.ResolveRecordValues(El: TRecordValues);
  10726. function GetMember(RecType: TPasRecordType; const aName: string): TPasElement;
  10727. var
  10728. i: Integer;
  10729. begin
  10730. for i:=0 to RecType.Members.Count-1 do
  10731. begin
  10732. Result:=TPasElement(RecType.Members[i]);
  10733. if SameText(Result.Name,aName) then
  10734. exit;
  10735. end;
  10736. if RecType.VariantEl is TPasVariable then
  10737. begin
  10738. Result:=TPasVariable(RecType.VariantEl);
  10739. if SameText(Result.Name,aName) then
  10740. exit;
  10741. end;
  10742. if RecType.Variants<>nil then
  10743. for i:=0 to RecType.Variants.Count-1 do
  10744. begin
  10745. Result:=GetMember(TPasVariant(RecType.Variants[i]).Members,aName);
  10746. if Result<>nil then
  10747. exit;
  10748. end;
  10749. Result:=nil;
  10750. end;
  10751. var
  10752. i, j: Integer;
  10753. Member: TPasElement;
  10754. RecType: TPasRecordType;
  10755. Field: PRecordValuesItem;
  10756. s: String;
  10757. ResolvedEl: TPasResolverResult;
  10758. begin
  10759. {$IFDEF VerbosePasResolver}
  10760. writeln('TPasResolver.ResolveRecordValues ',El.Fields[0].Name,' ',GetObjName(El.Parent),' ',GetObjName(El.Parent.Parent));
  10761. {$ENDIF}
  10762. ComputeElement(El,ResolvedEl,[]);
  10763. if (ResolvedEl.BaseType<>btContext)
  10764. or (ResolvedEl.LoTypeEl.ClassType<>TPasRecordType) then
  10765. begin
  10766. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  10767. [],'record value',GetTypeDescription(ResolvedEl),El);
  10768. end;
  10769. RecType:=TPasRecordType(ResolvedEl.LoTypeEl);
  10770. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(El.Parent),' ',GetObjName(RecType));
  10771. for i:=0 to length(El.Fields)-1 do
  10772. begin
  10773. Field:[email protected][i];
  10774. // check member exists
  10775. Member:=GetMember(RecType,Field^.Name);
  10776. if Member=nil then
  10777. RaiseIdentifierNotFound(20180429104703,Field^.Name,Field^.NameExp);
  10778. if Member.ClassType<>TPasVariable then
  10779. RaiseMsg(20180429121933,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10780. [],Field^.ValueExp);
  10781. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10782. RaiseMsg(20190105221450,nIdentifierXIsNotAnInstanceField,sIdentifierXIsNotAnInstanceField,
  10783. ['record assignment'],Field^.ValueExp);
  10784. CreateReference(Member,Field^.NameExp,rraAssign);
  10785. // check duplicates
  10786. for j:=0 to i-1 do
  10787. if SameText(Field^.Name,El.Fields[j].Name) then
  10788. RaiseMsg(20180429104942,nDuplicateIdentifier,sDuplicateIdentifier,
  10789. [Field^.Name,GetElementSourcePosStr(El.Fields[j].NameExp)],Field^.NameExp);
  10790. // resolve expression
  10791. ResolveExpr(El.Fields[i].ValueExp,rraRead);
  10792. // check compatible
  10793. CheckAssignCompatibility(Member,Field^.ValueExp);
  10794. end;
  10795. // hint for missing fields
  10796. s:='';
  10797. for i:=0 to RecType.Members.Count-1 do
  10798. begin
  10799. Member:=TPasElement(RecType.Members[i]);
  10800. if Member.ClassType<>TPasVariable then continue;
  10801. if TPasVariable(Member).VarModifiers*[vmClass,vmStatic]<>[] then
  10802. continue;
  10803. j:=length(El.Fields)-1;
  10804. while (j>=0) and not SameText(Member.Name,El.Fields[j].Name) do
  10805. dec(j);
  10806. //writeln('TPasResolver.ResolveRecordValues ',GetObjName(Member),' ',j);
  10807. if j<0 then
  10808. begin
  10809. if s<>'' then s:=s+', ';
  10810. if length(s)>30 then
  10811. begin
  10812. s:=s+'...';
  10813. break;
  10814. end;
  10815. s:=s+Member.Name;
  10816. end;
  10817. end;
  10818. // ToDo: hint for missing variants
  10819. if s<>'' then
  10820. LogMsg(20180429121127,mtHint,nMissingFieldsX,sMissingFieldsX,[s],El);
  10821. end;
  10822. procedure TPasResolver.ResolveInlineSpecializeExpr(El: TInlineSpecializeExpr;
  10823. Access: TResolvedRefAccess);
  10824. begin
  10825. // params are TPasTypes and already resolved
  10826. if El.Params.Count=0 then
  10827. RaiseMsg(20190916155014,nMissingParameterX,sMissingParameterX,['type'],El);
  10828. // resolve name
  10829. // Note: ResolveNameExpr considers the params
  10830. ResolveExpr(El.NameExpr,Access);
  10831. end;
  10832. function TPasResolver.ResolveAccessor(Expr: TPasExpr): TPasElement;
  10833. function SubResolvePrimitive(Prim: TPrimitiveExpr): TPasElement;
  10834. var
  10835. FindData: TPRFindData;
  10836. Ref: TResolvedReference;
  10837. Scope: TPasScope;
  10838. Abort: boolean;
  10839. begin
  10840. if Prim.Kind<>pekIdent then
  10841. RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
  10842. // search in class and ancestors, not in unit interface
  10843. Scope:=TopScope;
  10844. FindData:=Default(TPRFindData);
  10845. FindData.ErrorPosEl:=Expr;
  10846. Abort:=false;
  10847. Scope.IterateElements(Prim.Value,Scope,@OnFindFirst,@FindData,Abort);
  10848. Result:=FindData.Found;
  10849. if Result=nil then
  10850. RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
  10851. Ref:=CreateReference(Result,Prim,rraRead);
  10852. CheckFoundElementVisibility(FindData,Ref);
  10853. end;
  10854. var
  10855. Prim: TPrimitiveExpr;
  10856. DeclEl: TPasElement;
  10857. begin
  10858. if Expr.ClassType=TBinaryExpr then
  10859. begin
  10860. DeclEl:=nil;
  10861. if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
  10862. begin
  10863. Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
  10864. DeclEl:=SubResolvePrimitive(Prim);
  10865. if not (DeclEl is TPasMembersType) then
  10866. RaiseXExpectedButYFound(20170216151752,'class',GetElementTypeName(DeclEl),Prim);
  10867. end
  10868. else
  10869. RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10870. if TBinaryExpr(Expr).OpCode<>eopSubIdent then
  10871. RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10872. if DeclEl.ClassType=TPasClassType then
  10873. PushClassDotScope(TPasClassType(DeclEl))
  10874. else if DeclEl.ClassType=TPasRecordType then
  10875. PushRecordDotScope(TPasRecordType(DeclEl))
  10876. else
  10877. RaiseMsg(20190123145559,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
  10878. Expr:=TBinaryExpr(Expr).right;
  10879. Result:=ResolveAccessor(Expr);
  10880. PopScope;
  10881. end
  10882. else if Expr.ClassType=TPrimitiveExpr then
  10883. begin
  10884. Prim:=TPrimitiveExpr(Expr);
  10885. Result:=SubResolvePrimitive(Prim);
  10886. end
  10887. else
  10888. RaiseNotYetImplemented(20160922163436,Expr);
  10889. end;
  10890. procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
  10891. Ref: TResolvedReference; Access: TResolvedRefAccess);
  10892. begin
  10893. if (Ref.Access=Access) then exit;
  10894. if Access in [rraNone,rraParamToUnknownProc] then
  10895. exit;
  10896. if Expr=nil then ;
  10897. case Ref.Access of
  10898. rraNone,rraParamToUnknownProc:
  10899. Ref.Access:=Access;
  10900. rraRead:
  10901. if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
  10902. Ref.Access:=rraReadAndAssign
  10903. else
  10904. exit;
  10905. rraAssign,rraOutParam:
  10906. if Access in [rraRead,rraReadAndAssign,rraVarParam] then
  10907. Ref.Access:=rraReadAndAssign
  10908. else
  10909. exit;
  10910. rraReadAndAssign: exit;
  10911. rraVarParam: exit;
  10912. else
  10913. RaiseInternalError(20170403163727);
  10914. end;
  10915. end;
  10916. procedure TPasResolver.AccessExpr(Expr: TPasExpr;
  10917. Access: TResolvedRefAccess);
  10918. // called after a call target was found, called for each element
  10919. // to change the rraParamToUnknownProc value to Access
  10920. var
  10921. Ref: TResolvedReference;
  10922. Bin: TBinaryExpr;
  10923. Params: TParamsExpr;
  10924. ValueResolved: TPasResolverResult;
  10925. C: TClass;
  10926. begin
  10927. if (Expr.CustomData is TResolvedReference) then
  10928. begin
  10929. Ref:=TResolvedReference(Expr.CustomData);
  10930. SetResolvedRefAccess(Expr,Ref,Access);
  10931. end;
  10932. C:=Expr.ClassType;
  10933. if C=TBinaryExpr then
  10934. begin
  10935. Bin:=TBinaryExpr(Expr);
  10936. if Bin.OpCode in [eopSubIdent,eopNone] then
  10937. AccessExpr(Bin.right,Access);
  10938. end
  10939. else if C=TParamsExpr then
  10940. begin
  10941. Params:=TParamsExpr(Expr);
  10942. case Params.Kind of
  10943. pekFuncParams:
  10944. if IsTypeCast(Params) then
  10945. FinishCallArgAccess(Params.Params[0],Access)
  10946. else
  10947. AccessExpr(Params.Value,Access);
  10948. pekArrayParams:
  10949. begin
  10950. ComputeElement(Params.Value,ValueResolved,[]);
  10951. if IsDynArray(ValueResolved.LoTypeEl,false)
  10952. or (ValueResolved.BaseType=btPointer) then
  10953. // when accessing an element of a dynamic array the array is read
  10954. AccessExpr(Params.Value,rraRead)
  10955. else
  10956. AccessExpr(Params.Value,Access);
  10957. // Note: an element of an open or static array or a string is connected to the variable
  10958. end;
  10959. pekSet:
  10960. if Access<>rraRead then
  10961. RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
  10962. else
  10963. RaiseNotYetImplemented(20170403173831,Params);
  10964. end;
  10965. end
  10966. else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
  10967. // ok
  10968. else if (Access in [rraRead,rraParamToUnknownProc])
  10969. and ((C=TPrimitiveExpr)
  10970. or (C=TNilExpr)
  10971. or (C=TBoolConstExpr)
  10972. or (C=TInheritedExpr)
  10973. or (C=TProcedureExpr))
  10974. or (C=TInlineSpecializeExpr) then
  10975. // ok
  10976. else if C=TUnaryExpr then
  10977. AccessExpr(TUnaryExpr(Expr).Operand,Access)
  10978. else
  10979. begin
  10980. {$IFDEF VerbosePasResolver}
  10981. writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
  10982. {$ENDIF}
  10983. RaiseNotYetImplemented(20170306102158,Expr);
  10984. end;
  10985. end;
  10986. function TPasResolver.MarkArrayExpr(Expr: TParamsExpr; ArrayType: TPasArrayType
  10987. ): boolean;
  10988. var
  10989. Ref: TResolvedReference;
  10990. begin
  10991. if Expr.CustomData=nil then
  10992. begin
  10993. // mark set expression as array
  10994. CreateReference(ArrayType,Expr,rraRead);
  10995. Result:=true;
  10996. end
  10997. else if Expr.CustomData is TResolvedReference then
  10998. begin
  10999. // already set
  11000. Result:=false;
  11001. // check consistency
  11002. Ref:=TResolvedReference(Expr.CustomData);
  11003. if not (Ref.Declaration is TPasArrayType) then
  11004. begin
  11005. {$IFDEF VerbosePasResolver}
  11006. writeln('TPasResolver.MarkArrayExpr Expr=',GetObjName(Expr),' Ref.Declaration=',GetObjName(Ref.Declaration),' ',Ref.Declaration.ParentPath);
  11007. {$ENDIF}
  11008. RaiseNotYetImplemented(20180618102230,Expr,GetObjName(Ref.Declaration));
  11009. end;
  11010. end
  11011. else
  11012. // already set with something else
  11013. RaiseNotYetImplemented(20180618102408,Expr,GetObjName(Expr.CustomData));
  11014. end;
  11015. procedure TPasResolver.MarkArrayExprRecursive(Expr: TPasExpr;
  11016. ArrType: TPasArrayType);
  11017. procedure Traverse(CurExpr: TPasExpr; ArrayType: TPasArrayType; RgIndex: integer);
  11018. var
  11019. Params: TPasExprArray;
  11020. i: Integer;
  11021. ResolvedElType: TPasResolverResult;
  11022. ParamsExpr: TParamsExpr;
  11023. BuiltInProc: TResElDataBuiltInProc;
  11024. Ref: TResolvedReference;
  11025. begin
  11026. if IsArrayOperatorAdd(CurExpr) then
  11027. begin
  11028. Traverse(TBinaryExpr(CurExpr).left,ArrayType,RgIndex);
  11029. Traverse(TBinaryExpr(CurExpr).right,ArrayType,RgIndex);
  11030. end
  11031. else if CurExpr.ClassType=TParamsExpr then
  11032. begin
  11033. ParamsExpr:=TParamsExpr(CurExpr);
  11034. Params:=ParamsExpr.Params;
  11035. if CurExpr.Kind=pekSet then
  11036. begin
  11037. MarkArrayExpr(ParamsExpr,ArrayType);
  11038. // traverse into nested expressions, e.g. [ A, B ]
  11039. if length(Params)=0 then exit;
  11040. inc(RgIndex);
  11041. if RgIndex>length(ArrayType.Ranges) then
  11042. begin
  11043. if ArrayType.ElType=nil then
  11044. exit; // elements are not arrays
  11045. ComputeElement(ArrayType.ElType,ResolvedElType,[rcType]);
  11046. if (ResolvedElType.BaseType=btContext)
  11047. and (ResolvedElType.LoTypeEl is TPasArrayType) then
  11048. begin
  11049. ArrayType:=TPasArrayType(ResolvedElType.LoTypeEl);
  11050. RgIndex:=0;
  11051. end
  11052. else
  11053. exit; // elements are not arrays
  11054. end;
  11055. for i:=0 to length(Params)-1 do
  11056. Traverse(Params[i],ArrayType,RgIndex);
  11057. end
  11058. else if CurExpr.Kind=pekFuncParams then
  11059. begin
  11060. if TParamsExpr(CurExpr).Value.CustomData is TResolvedReference then
  11061. begin
  11062. Ref:=TResolvedReference(TParamsExpr(CurExpr).Value.CustomData);
  11063. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  11064. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  11065. begin
  11066. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  11067. if BuiltInProc.BuiltIn=bfConcatArray then
  11068. begin
  11069. // concat(array1,array2,...)
  11070. for i:=0 to length(Params)-1 do
  11071. Traverse(Params[i],ArrayType,RgIndex);
  11072. end
  11073. else if BuiltInProc.BuiltIn=bfCopyArray then
  11074. // copy(array,...)
  11075. Traverse(Params[0],ArrayType,RgIndex);
  11076. end;
  11077. end;
  11078. end;
  11079. end;
  11080. end;
  11081. begin
  11082. Traverse(Expr,ArrType,0);
  11083. end;
  11084. procedure TPasResolver.CheckPendingForwardProcs(El: TPasElement);
  11085. var
  11086. i: Integer;
  11087. DeclEl: TPasElement;
  11088. Proc: TPasProcedure;
  11089. aClassOrRec: TPasMembersType;
  11090. ClassOrRecScope: TPasClassOrRecordScope;
  11091. begin
  11092. if IsElementSkipped(El) then exit;
  11093. if El is TPasDeclarations then
  11094. begin
  11095. for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
  11096. begin
  11097. DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
  11098. if DeclEl is TPasProcedure then
  11099. begin
  11100. Proc:=TPasProcedure(DeclEl);
  11101. if ProcNeedsImplProc(Proc)
  11102. and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
  11103. RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
  11104. [GetElementTypeName(Proc),Proc.Name],Proc);
  11105. end;
  11106. end;
  11107. end
  11108. else if El is TPasMembersType then
  11109. begin
  11110. aClassOrRec:=TPasMembersType(El);
  11111. if (aClassOrRec is TPasClassType) then
  11112. begin
  11113. if (TPasClassType(aClassOrRec).ObjKind in [okInterface,okDispInterface]) then
  11114. exit;
  11115. if TPasClassType(aClassOrRec).IsForward then
  11116. exit;
  11117. if TPasClassType(aClassOrRec).IsExternal then
  11118. exit;
  11119. end;
  11120. ClassOrRecScope:=aClassOrRec.CustomData as TPasClassOrRecordScope;
  11121. if ClassOrRecScope.SpecializedFromItem<>nil then
  11122. exit;
  11123. // finish implementation of (generic) class/record
  11124. if ClassOrRecScope.GenericStep<>psgsInterfaceParsed then
  11125. RaiseNotYetImplemented(20190804115324,El);
  11126. for i:=0 to aClassOrRec.Members.Count-1 do
  11127. begin
  11128. DeclEl:=TPasElement(aClassOrRec.Members[i]);
  11129. if DeclEl is TPasProcedure then
  11130. begin
  11131. Proc:=TPasProcedure(DeclEl);
  11132. if Proc.IsAbstract or Proc.IsExternal then continue;
  11133. if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
  11134. begin
  11135. {$IFDEF VerbosePasResolver}
  11136. writeln('TPasResolver.CheckPendingForwardProcs Proc.ParentPath=',Proc.PathName);
  11137. {$ENDIF}
  11138. RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
  11139. [GetElementTypeName(Proc),Proc.Name],Proc);
  11140. end;
  11141. end;
  11142. end;
  11143. ClassOrRecScope.GenericStep:=psgsImplementationParsed;
  11144. if ClassOrRecScope.SpecializedItems<>nil then
  11145. FinishSpecializations(ClassOrRecScope);
  11146. end;
  11147. end;
  11148. procedure TPasResolver.CheckPointerCycle(El: TPasPointerType);
  11149. var
  11150. C: TClass;
  11151. CurEl, Dest: TPasType;
  11152. begin
  11153. CurEl:=El;
  11154. while CurEl<>nil do
  11155. begin
  11156. C:=CurEl.ClassType;
  11157. if C=TPasPointerType then
  11158. Dest:=TPasPointerType(CurEl).DestType
  11159. else if C.InheritsFrom(TPasAliasType) then
  11160. Dest:=TPasAliasType(CurEl).DestType
  11161. else
  11162. exit;
  11163. if Dest=El then
  11164. RaiseMsg(20180422165758,nTypeCycleFound,sTypeCycleFound,[],El);
  11165. CurEl:=Dest;
  11166. end;
  11167. end;
  11168. procedure TPasResolver.CheckGenericTemplateTypes(El: TPasGenericType);
  11169. var
  11170. GenTemplates: TFPList;
  11171. i: Integer;
  11172. TemplType: TPasGenericTemplateType;
  11173. begin
  11174. GenTemplates:=El.GenericTemplateTypes;
  11175. if (GenTemplates=nil) or (GenTemplates.Count=0) then
  11176. RaiseNotYetImplemented(20190726184902,El,'empty generic template list');
  11177. // template names must differ from generic type name
  11178. for i:=0 to GenTemplates.Count-1 do
  11179. begin
  11180. TemplType:=TPasGenericTemplateType(GenTemplates[i]);
  11181. if SameText(TemplType.Name,El.Name) then
  11182. RaiseMsg(20190801101444,nDuplicateIdentifier,sDuplicateIdentifier,[
  11183. TemplType.Name,GetElementSourcePosStr(El)],TemplType);
  11184. end;
  11185. end;
  11186. procedure TPasResolver.ComputeUnaryNot(El: TUnaryExpr;
  11187. var ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  11188. begin
  11189. RaiseMsg(20180208121532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  11190. [OpcodeStrings[El.OpCode],GetResolverResultDescription(ResolvedEl)],El);
  11191. if Flags=[] then ;
  11192. end;
  11193. procedure TPasResolver.AddModule(El: TPasModule);
  11194. var
  11195. C: TClass;
  11196. ModScope: TPasModuleScope;
  11197. begin
  11198. if Hub=nil then
  11199. RaiseNotYetImplemented(20200815182122,El);
  11200. if TopScope<>DefaultScope then
  11201. RaiseInvalidScopeForElement(20160922163504,El);
  11202. ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module));
  11203. ModScope.VisibilityContext:=El;
  11204. ModScope.FirstName:=FirstDottedIdentifier(El.Name);
  11205. C:=El.ClassType;
  11206. if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
  11207. FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
  11208. else
  11209. FDefaultNameSpace:='';
  11210. ModScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11211. end;
  11212. procedure TPasResolver.AddSection(El: TPasSection);
  11213. // TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
  11214. // Note: implementation scope is within the interface scope
  11215. var
  11216. Scope: TPasSectionScope;
  11217. begin
  11218. if TopScope is TPasSectionScope then
  11219. FinishSection(TPasSectionScope(TopScope).Element as TPasSection);
  11220. if TopScope is TPasModuleScope then
  11221. TPasModuleScope(TopScope).BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11222. {$IFDEF VerbosePasResolver}
  11223. if FPendingForwardProcs.IndexOf(El)=0 then
  11224. RaiseNotYetImplemented(20190804114718,El);
  11225. {$ENDIF}
  11226. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11227. Scope:=TPasSectionScope(PushScope(El,ScopeClass_Section));
  11228. Scope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  11229. Scope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  11230. end;
  11231. procedure TPasResolver.AddInitialFinalizationSection(El: TPasImplBlock);
  11232. begin
  11233. PushScope(El,ScopeClass_InitialFinalization);
  11234. end;
  11235. procedure TPasResolver.AddType(El: TPasType);
  11236. begin
  11237. if (El.Name='') then exit; // sub type
  11238. {$IFDEF VerbosePasResolver}
  11239. writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
  11240. {$ENDIF}
  11241. if not (TopScope is TPasIdentifierScope) then
  11242. RaiseInvalidScopeForElement(20160922163506,El);
  11243. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11244. end;
  11245. procedure TPasResolver.AddArrayType(El: TPasArrayType; TypeParams: TFPList);
  11246. var
  11247. Scope: TPasArrayScope;
  11248. begin
  11249. {$IFDEF VerbosePasResolver}
  11250. writeln('TPasResolver.AddArrayType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11251. {$ENDIF}
  11252. if TypeParams<>nil then
  11253. begin
  11254. El.SetGenericTemplates(TypeParams);
  11255. TypeParams:=El.GenericTemplateTypes;
  11256. CheckGenericTemplateTypes(El);
  11257. end;
  11258. PopGenericParamScope(El);
  11259. if El.Name<>'' then begin
  11260. if not (TopScope is TPasIdentifierScope) then
  11261. RaiseInvalidScopeForElement(20190812215622,El);
  11262. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11263. if TypeParams<>nil then
  11264. begin
  11265. Scope:=TPasArrayScope(PushScope(El,ScopeClass_Array));
  11266. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11267. end;
  11268. end else if TypeParams<>nil then
  11269. RaiseNotYetImplemented(20190812215851,El); // anonymous generic array type
  11270. end;
  11271. procedure TPasResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList);
  11272. var
  11273. Scope: TPasRecordScope;
  11274. begin
  11275. {$IFDEF VerbosePasResolver}
  11276. writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11277. {$ENDIF}
  11278. if TypeParams<>nil then
  11279. begin
  11280. El.SetGenericTemplates(TypeParams);
  11281. TypeParams:=El.GenericTemplateTypes;
  11282. CheckGenericTemplateTypes(El);
  11283. end;
  11284. PopGenericParamScope(El);
  11285. if not (TopScope is TPasIdentifierScope) then
  11286. RaiseInvalidScopeForElement(20160922163508,El);
  11287. if El.Name<>'' then begin
  11288. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11289. {$IFDEF VerbosePasResolver}
  11290. if FPendingForwardProcs.IndexOf(El)=0 then
  11291. RaiseNotYetImplemented(20190804114737,El);
  11292. {$ENDIF}
  11293. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11294. end;
  11295. if El.Parent.ClassType<>TPasVariant then
  11296. begin
  11297. Scope:=TPasRecordScope(PushScope(El,ScopeClass_Record));
  11298. Scope.VisibilityContext:=El;
  11299. if TypeParams<>nil then
  11300. begin
  11301. // generic array
  11302. if El.Name='' then
  11303. RaiseNotYetImplemented(20190812220821,El);
  11304. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11305. end;
  11306. end;
  11307. end;
  11308. procedure TPasResolver.AddClassType(El: TPasClassType; TypeParams: TFPList);
  11309. // Note: IsForward is not yet set!
  11310. var
  11311. Duplicate: TPasIdentifier;
  11312. ForwardDecl: TPasClassType;
  11313. CurScope, LocalScope: TPasIdentifierScope;
  11314. GenTemplCnt, i, j: Integer;
  11315. ClassScope: TPasClassScope;
  11316. ForwGenTempl, ActGenTempl: TPasGenericTemplateType;
  11317. ForwConstraints, ActConstraints: TPasElementArray;
  11318. DuplEl, ForwConstraint, ActConstraint: TPasElement;
  11319. ForwToken, ActToken: TToken;
  11320. ForwConstraintResolved, ActConstraintResolved: TPasResolverResult;
  11321. begin
  11322. // Beware: El.ObjKind is not yet set!
  11323. {$IFDEF VerbosePasResolver}
  11324. //writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
  11325. {$ENDIF}
  11326. if not (TopScope is TPasIdentifierScope) then
  11327. RaiseInvalidScopeForElement(20160922163510,El);
  11328. if TypeParams=nil then
  11329. begin
  11330. GenTemplCnt:=0;
  11331. if TopScope is TPasGenericParamsScope then
  11332. RaiseNotYetImplemented(20190831205006,El,GetObjName(TopScope));
  11333. CurScope:=TPasIdentifierScope(TopScope);
  11334. end
  11335. else
  11336. begin
  11337. if not (TopScope is TPasGenericParamsScope) then
  11338. RaiseInvalidScopeForElement(20190831205038,El,GetObjName(TopScope));
  11339. CurScope:=TPasIdentifierScope(Scopes[ScopeCount-2]);
  11340. GenTemplCnt:=TypeParams.Count;
  11341. El.SetGenericTemplates(TypeParams);
  11342. TypeParams:=El.GenericTemplateTypes;
  11343. CheckGenericTemplateTypes(El);
  11344. end;
  11345. if CurScope is TPasGroupScope then
  11346. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11347. else
  11348. LocalScope:=CurScope;
  11349. Duplicate:=LocalScope.FindLocalIdentifier(El.Name);
  11350. while Duplicate<>nil do
  11351. begin
  11352. DuplEl:=Duplicate.Element;
  11353. if (DuplEl is TPasGenericType)
  11354. and (GetTypeParameterCount(TPasGenericType(DuplEl))=GenTemplCnt) then
  11355. break;
  11356. Duplicate:=Duplicate.NextSameIdentifier;
  11357. end;
  11358. //if Duplicate<>nil then
  11359. //writeln(' Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
  11360. if (Duplicate<>nil)
  11361. and (Duplicate.Element is TPasClassType)
  11362. and TPasClassType(Duplicate.Element).IsForward
  11363. and (Duplicate.Element.Parent=El.Parent)
  11364. then
  11365. begin
  11366. // forward declaration found
  11367. ForwardDecl:=TPasClassType(Duplicate.Element);
  11368. {$IFDEF VerbosePasResolver}
  11369. writeln(' Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
  11370. {$ENDIF}
  11371. if GenTemplCnt>0 then
  11372. begin
  11373. // check generic constraints match exactly
  11374. for i:=0 to GenTemplCnt-1 do
  11375. begin
  11376. ForwGenTempl:=TPasGenericTemplateType(ForwardDecl.GenericTemplateTypes[i]);
  11377. ActGenTempl:=TPasGenericTemplateType(TypeParams[i]);
  11378. if not SameText(ForwGenTempl.Name,ActGenTempl.Name) then
  11379. RaiseMsg(20190814114811,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11380. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11381. ForwConstraints:=ForwGenTempl.Constraints;
  11382. ActConstraints:=ActGenTempl.Constraints;
  11383. if length(ForwConstraints)<>length(ActConstraints) then
  11384. RaiseMsg(20190814121031,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11385. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
  11386. for j:=0 to length(ForwConstraints)-1 do
  11387. begin
  11388. ForwConstraint:=ForwConstraints[j];
  11389. ActConstraint:=ActConstraints[j];
  11390. ForwToken:=GetGenericConstraintKeyword(ForwConstraint);
  11391. ActToken:=GetGenericConstraintKeyword(ActConstraint);
  11392. if ForwToken<>ActToken then
  11393. RaiseMsg(20190814121139,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11394. [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwConstraint)],
  11395. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11396. if ForwToken=tkEOF then
  11397. begin
  11398. ComputeElement(ForwConstraint,ForwConstraintResolved,[rcType]);
  11399. ComputeElement(ActConstraint,ActConstraintResolved,[rcType]);
  11400. if CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,
  11401. ActConstraintResolved.LoTypeEl,prraNone)<>cExact then
  11402. RaiseMsg(20190814121509,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
  11403. [GetTypeDescription(ActGenTempl),
  11404. GetElementSourcePosStr(GetGenericConstraintErrorEl(ForwConstraint,ForwGenTempl))],
  11405. GetGenericConstraintErrorEl(ActConstraint,ActGenTempl));
  11406. end;
  11407. end;
  11408. end;
  11409. end;
  11410. if ForwardDecl.CustomData<>nil then
  11411. begin
  11412. // move the classscope to the real declaration
  11413. ClassScope:=ForwardDecl.CustomData as TPasClassScope;
  11414. if El.CustomData<>nil then
  11415. RaiseInternalError(20190803202959,'real class has already customdata');
  11416. ForwardDecl.CustomData:=nil;
  11417. El.CustomData:=ClassScope;
  11418. ClassScope.Element:=El;
  11419. end;
  11420. // create a ref from the forward to the real declaration
  11421. CreateReference(El,ForwardDecl,rraRead);
  11422. // change the cache item
  11423. Duplicate.Element:=El;
  11424. end
  11425. else
  11426. AddIdentifier(CurScope,El.Name,El,pikSimple);
  11427. if TypeParams<>nil then
  11428. begin
  11429. // Parsing the ancestor+interface list requires the type params.
  11430. // AddGenericTemplateIdentifiers not needed, already in TPasGenericParamsScope
  11431. end;
  11432. {$IFDEF VerbosePasResolver}
  11433. if FPendingForwardProcs.IndexOf(El)>=0 then
  11434. RaiseNotYetImplemented(20190804114746,El);
  11435. {$ENDIF}
  11436. FPendingForwardProcs.Add(El); // check forward declarations at the end
  11437. end;
  11438. procedure TPasResolver.AddVariable(El: TPasVariable);
  11439. begin
  11440. if (El.Name='') then exit; // anonymous var
  11441. {$IFDEF VerbosePasResolver}
  11442. writeln('TPasResolver.AddVariable ',GetObjName(El));
  11443. {$ENDIF}
  11444. if not (TopScope is TPasIdentifierScope) then
  11445. RaiseInvalidScopeForElement(20160929205730,El);
  11446. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11447. end;
  11448. procedure TPasResolver.AddResourceString(El: TPasResString);
  11449. var
  11450. C: TClass;
  11451. begin
  11452. {$IFDEF VerbosePasResolver}
  11453. writeln('TPasResolver.AddResourceString ',GetObjName(El));
  11454. {$ENDIF}
  11455. if not (TopScope is TPasIdentifierScope) then
  11456. RaiseInvalidScopeForElement(20171004092114,El);
  11457. C:=El.Parent.ClassType;
  11458. if not C.InheritsFrom(TPasSection) then
  11459. RaiseNotYetImplemented(20171004092518,El);
  11460. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11461. end;
  11462. procedure TPasResolver.AddEnumType(El: TPasEnumType);
  11463. var
  11464. CanonicalSet: TPasSetType;
  11465. EnumScope: TPasEnumTypeScope;
  11466. begin
  11467. {$IFDEF VerbosePasResolver}
  11468. writeln('TPasResolver.AddEnumType ',GetObjName(El));
  11469. {$ENDIF}
  11470. if not (TopScope is TPasIdentifierScope) then
  11471. RaiseInvalidScopeForElement(20160929205732,El);
  11472. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11473. EnumScope:=TPasEnumTypeScope(PushScope(El,TPasEnumTypeScope));
  11474. // add canonical set
  11475. if El.Parent is TPasSetType then
  11476. begin
  11477. // anonymous enumtype, e.g. "set of ()"
  11478. CanonicalSet:=TPasSetType(El.Parent);
  11479. CanonicalSet.AddRef{$IFDEF CheckPasTreeRefCount}('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11480. end
  11481. else
  11482. begin
  11483. CanonicalSet:=TPasSetType.Create('',El);
  11484. {$IFDEF CheckPasTreeRefCount}CanonicalSet.RefIds.Add('TPasEnumTypeScope.CanonicalSet'){$ENDIF};
  11485. CanonicalSet.EnumType:=El;
  11486. El.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSetType.EnumType'){$ENDIF};
  11487. end;
  11488. EnumScope.CanonicalSet:=CanonicalSet;
  11489. end;
  11490. procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
  11491. var
  11492. i: Integer;
  11493. Scope: TPasScope;
  11494. Old: TPasIdentifier;
  11495. ClassOrRec: TPasMembersType;
  11496. begin
  11497. {$IFDEF VerbosePasResolver}
  11498. writeln('TPasResolver.AddEnumValue ',GetObjName(El));
  11499. {$ENDIF}
  11500. if not (TopScope is TPasEnumTypeScope) then
  11501. RaiseInvalidScopeForElement(20160929205736,El);
  11502. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11503. // propagate enum to parent scopes
  11504. // TEnum = (red, green); -> dot not propagate
  11505. // TFlags = set of (red,blue); -> propagate
  11506. if (bsScopedEnums in CurrentParser.Scanner.CurrentBoolSwitches)
  11507. and not (El.Parent.Parent is TPasSetType) then
  11508. exit;
  11509. for i:=ScopeCount-2 downto 0 do
  11510. begin
  11511. Scope:=Scopes[i];
  11512. if Scope is TPasGroupScope then
  11513. Scope:=TPasGroupScope(Scope).Scopes[0];
  11514. if Scope is TPasClassOrRecordScope then
  11515. begin
  11516. // class or record: add if not duplicate
  11517. Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
  11518. if Old=nil then
  11519. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11520. ClassOrRec:=Scope.Element as TPasMembersType;
  11521. if GetTypeParameterCount(ClassOrRec)>0 then
  11522. break; // enums in generics do not propagate
  11523. end
  11524. else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
  11525. begin
  11526. // procedure or section: check for duplicate and add
  11527. Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
  11528. if Old<>nil then
  11529. RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
  11530. [El.Name,GetElementSourcePosStr(Old.Element)],El);
  11531. TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
  11532. break;
  11533. end
  11534. else
  11535. break;
  11536. end;
  11537. end;
  11538. procedure TPasResolver.AddProperty(El: TPasProperty);
  11539. begin
  11540. if (El.Name='') then
  11541. RaiseNotYetImplemented(20160922163518,El);
  11542. {$IFDEF VerbosePasResolver}
  11543. writeln('TPasResolver.AddProperty ',GetObjName(El));
  11544. {$ENDIF}
  11545. if not (GetLocalScope is TPasClassOrRecordScope) then
  11546. RaiseInvalidScopeForElement(20160922163520,El);
  11547. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11548. PushScope(El,TPasPropertyScope);
  11549. end;
  11550. procedure TPasResolver.AddProcedureType(El: TPasProcedureType;
  11551. TypeParams: TFPList);
  11552. var
  11553. Scope: TPasProcTypeScope;
  11554. begin
  11555. if El.Name<>'' then begin
  11556. {$IFDEF VerbosePasResolver}
  11557. writeln('TPasResolver.AddProcedureType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
  11558. {$ENDIF}
  11559. if El.Parent is TPasProcedure then
  11560. RaiseNotYetImplemented(20190911102852,El,GetObjPath(El.Parent));
  11561. if TypeParams<>nil then
  11562. begin
  11563. El.SetGenericTemplates(TypeParams);
  11564. TypeParams:=El.GenericTemplateTypes;
  11565. CheckGenericTemplateTypes(El);
  11566. end;
  11567. PopGenericParamScope(El);
  11568. if not (TopScope is TPasIdentifierScope) then
  11569. RaiseInvalidScopeForElement(20190813193703,El);
  11570. AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
  11571. if TypeParams<>nil then
  11572. begin
  11573. Scope:=TPasProcTypeScope(PushScope(El,ScopeClass_ProcType));
  11574. AddGenericTemplateIdentifiers(TypeParams,Scope);
  11575. end;
  11576. end else if TypeParams<>nil then
  11577. RaiseNotYetImplemented(20190813193745,El);
  11578. end;
  11579. procedure TPasResolver.AddProcedure(El: TPasProcedure; TypeParams: TFPList);
  11580. procedure AddClassConDestructor(ClassOrRecordScope: TPasClassOrRecordScope;
  11581. var Field: TPasProcedure);
  11582. begin
  11583. if Field<>nil then
  11584. RaiseMsg(20181231144353,nMultipleXinTypeYNameZCAandB,
  11585. sMultipleXinTypeYNameZCAandB,[GetElementTypeName(El),
  11586. GetElementTypeName(ClassOrRecordScope.Element),
  11587. ClassOrRecordScope.Element.Name,Field.Name,El.Name],El);
  11588. Field:=El;
  11589. end;
  11590. function FindBestMembersType(const ClassOrRecName: string;
  11591. TypeParamCnt: integer; Scope: TPasIdentifierScope;
  11592. var Best: TPasMembersType; ErrorPos: TPasElement): integer;
  11593. // returns number of candidates
  11594. var
  11595. Identifier: TPasIdentifier;
  11596. CurEl: TPasElement;
  11597. begin
  11598. Result:=0;
  11599. Identifier:=Scope.FindLocalIdentifier(ClassOrRecName);
  11600. while Identifier<>nil do
  11601. begin
  11602. CurEl:=Identifier.Element;
  11603. if not (CurEl is TPasMembersType) then
  11604. RaiseXExpectedButYFound(20170216152557,
  11605. 'class',CurEl.Name+':'+GetElementTypeName(CurEl),ErrorPos);
  11606. inc(Result);
  11607. if Best=nil then
  11608. Best:=TPasMembersType(CurEl);
  11609. if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
  11610. begin
  11611. // fits
  11612. Best:=TPasMembersType(CurEl);
  11613. exit;
  11614. end;
  11615. Identifier:=Identifier.NextSameIdentifier;
  11616. end;
  11617. end;
  11618. function FindMembersType(Scope: TPasIdentifierScope;
  11619. const ClassOrRecName: string; TypeParamCnt: integer; IsDelphi: boolean;
  11620. ErrorPos: TPasElement): TPasMembersType;
  11621. var
  11622. Found: integer;
  11623. begin
  11624. Result:=nil;
  11625. if Scope<>nil then
  11626. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,Scope,Result,ErrorPos)
  11627. else if TopScope is TPasIdentifierScope then
  11628. begin
  11629. Found:=FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11630. TPasIdentifierScope(TopScope),Result,ErrorPos);
  11631. if (Result=nil) or (TypeParamCnt<>GetTypeParameterCount(Result)) then
  11632. begin
  11633. if (TopScope is TPasSectionScope)
  11634. and (ScopeCount>1) and (Scopes[ScopeCount-2] is TPasSectionScope) then
  11635. // search in unit interface too
  11636. Found:=Found+FindBestMembersType(ClassOrRecName,TypeParamCnt,
  11637. TPasIdentifierScope(Scopes[ScopeCount-2]),Result,ErrorPos);
  11638. end;
  11639. end;
  11640. if Result=nil then
  11641. RaiseMsg(20190818112356,nClassXNotFoundInThisModule,sClassXNotFoundInThisModule,
  11642. [ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11643. if TypeParamCnt=GetTypeParameterCount(Result) then
  11644. exit; // fits perfectly
  11645. if (not IsDelphi) and (TypeParamCnt=0) and (Found=1) then
  11646. exit; // in objfpc type params can be omitted if there is only one type
  11647. // found one or more, but type param count do not fit
  11648. RaiseMsg(20190818112856,nXExpectedButYFound,sXExpectedButYFound,
  11649. [Result.Name+GetGenericParamCommas(GetTypeParameterCount(Result)),
  11650. ClassOrRecName+GetGenericParamCommas(TypeParamCnt)],ErrorPos);
  11651. end;
  11652. procedure CheckTemplateNames;
  11653. var
  11654. i, j: Integer;
  11655. NamePart: TProcedureNamePart;
  11656. TemplTypes: TFPList;
  11657. TemplType: TPasGenericTemplateType;
  11658. begin
  11659. for i:=0 to TypeParams.Count-1 do
  11660. begin
  11661. NamePart:=TProcedureNamePart(TypeParams[i]);
  11662. TemplTypes:=NamePart.Templates;
  11663. if TemplTypes=nil then continue;
  11664. for j:=0 to TemplTypes.Count-1 do
  11665. begin
  11666. TemplType:=TPasGenericTemplateType(TemplTypes[j]);
  11667. if SameText(TemplType.Name,El.Name) then
  11668. RaiseMsg(20190912174817,nDuplicateIdentifier,sDuplicateIdentifier,
  11669. [],TemplType);
  11670. end;
  11671. end;
  11672. end;
  11673. var
  11674. ProcName, aClassName: String;
  11675. p: SizeInt;
  11676. ClassOrRecType: TPasMembersType;
  11677. ProcScope: TPasProcedureScope;
  11678. HasDot, IsClassConDestructor, IsDelphi: Boolean;
  11679. ClassOrRecScope: TPasClassOrRecordScope;
  11680. C: TClass;
  11681. CurScope: TPasScope;
  11682. LocalScope: TPasScope;
  11683. Level, TypeParamCount, i: Integer;
  11684. NamePart: TProcedureNamePart;
  11685. TemplType, FoundTemplType: TPasGenericTemplateType;
  11686. NestedMembersScope: TPasGroupScope;
  11687. begin
  11688. {$IFDEF VerbosePasResolver}
  11689. writeln('TPasResolver.AddProcedure ',GetObjName(El));
  11690. {$ENDIF}
  11691. if TypeParams<>nil then
  11692. begin
  11693. // move type param elements to El
  11694. El.SetNameParts(TypeParams);
  11695. TypeParams:=El.NameParts;
  11696. if TopScope is TPasGenericParamsScope then
  11697. PopScope;
  11698. CheckTemplateNames;
  11699. end;
  11700. CurScope:=TopScope;
  11701. if CurScope.ClassType=TPasGroupScope then
  11702. LocalScope:=TPasGroupScope(CurScope).Scopes[0]
  11703. else
  11704. LocalScope:=CurScope;
  11705. ProcName:=El.Name;
  11706. if El.Name<>'' then
  11707. begin
  11708. // named proc
  11709. if not (LocalScope is TPasIdentifierScope) then
  11710. RaiseInvalidScopeForElement(20160922163522,El);
  11711. end
  11712. else
  11713. begin
  11714. // anonymous proc
  11715. if TypeParams<>nil then
  11716. RaiseNotYetImplemented(20190818101856,El);
  11717. C:=LocalScope.ClassType;
  11718. if (C=ScopeClass_InitialFinalization)
  11719. or C.InheritsFrom(TPasProcedureScope)
  11720. or (C=TPasWithScope)
  11721. or (C=ScopeClass_WithExpr)
  11722. or (C=TPasExceptOnScope)
  11723. or (C=TPasForLoopScope) then
  11724. // ok
  11725. else
  11726. RaiseInvalidScopeForElement(20181210173134,El);
  11727. end;
  11728. // Note: El.ProcType is nil ! It is parsed later.
  11729. HasDot:=GetFirstDotPos(ProcName)>1;
  11730. if (TypeParams<>nil) then
  11731. if HasDot<>(TypeParams.Count>1) then
  11732. RaiseNotYetImplemented(20190818093923,El);
  11733. IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
  11734. or (El.ClassType=TPasClassDestructor);
  11735. ClassOrRecType:=nil;
  11736. if El.CustomData is TPasProcedureScope then
  11737. begin
  11738. // adding a specialized implementation proc
  11739. ProcScope:=TPasProcedureScope(El.CustomData);
  11740. if ProcScope.DeclarationProc<>nil then
  11741. TypeParams:=ProcScope.DeclarationProc.NameParts;
  11742. ClassOrRecScope:=ProcScope.ClassRecScope;
  11743. if ClassOrRecScope<>nil then
  11744. begin
  11745. ClassOrRecType:=TPasMembersType(ClassOrRecScope.Element);
  11746. if GetTypeParameterCount(ClassOrRecType)>0 then
  11747. RaiseNotYetImplemented(20190804175518,El);
  11748. if ProcScope.GroupScope<>nil then
  11749. RaiseNotYetImplemented(20190804175451,El);
  11750. if (not HasDot) and IsClassConDestructor then
  11751. begin
  11752. if El.ClassType=TPasClassConstructor then
  11753. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11754. else
  11755. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11756. end;
  11757. end;
  11758. PushScope(ProcScope);
  11759. end
  11760. else
  11761. begin
  11762. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  11763. if (not HasDot) and IsClassConDestructor then
  11764. begin
  11765. if ProcName='' then
  11766. RaiseNotYetImplemented(20181231145302,El);
  11767. if not (LocalScope is TPasClassOrRecordScope) then
  11768. RaiseInvalidScopeForElement(20181231143831,El);
  11769. ClassOrRecScope:=TPasClassOrRecordScope(LocalScope);
  11770. if El.ClassType=TPasClassConstructor then
  11771. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassConstructor))
  11772. else
  11773. AddClassConDestructor(ClassOrRecScope,TPasProcedure(ClassOrRecScope.ClassDestructor));
  11774. if TypeParams<>nil then
  11775. RaiseMsg(20190818094753,nTypeParamsNotAllowedOnX,sTypeParamsNotAllowedOnX,
  11776. [El.ElementTypeName],El);
  11777. end;
  11778. if (not HasDot) and (ProcName<>'')
  11779. and not IsClassConDestructor // the name of a class con/destructor is irrelevant and cannot be referenced
  11780. then
  11781. begin
  11782. // add proc name to scope
  11783. AddIdentifier(TPasIdentifierScope(CurScope),ProcName,El,pikProc);
  11784. end;
  11785. ProcScope:=TPasProcedureScope(CreateScope(El,FScopeClass_Proc));
  11786. ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
  11787. if HasDot then
  11788. begin
  11789. // method implementation -> search class
  11790. {$IFDEF VerbosePasResolver}
  11791. writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
  11792. {$ENDIF}
  11793. ClassOrRecType:=nil;
  11794. Level:=0;
  11795. repeat
  11796. inc(Level);
  11797. p:=GetFirstDotPos(ProcName);
  11798. if p<1 then
  11799. begin
  11800. if ClassOrRecType=nil then
  11801. RaiseInternalError(20161013170829);
  11802. break;
  11803. end;
  11804. aClassName:=FirstDottedIdentifier(ProcName);
  11805. Delete(ProcName,1,p);
  11806. TypeParamCount:=0;
  11807. if TypeParams<>nil then
  11808. begin
  11809. // e.g. aclassname<T>.
  11810. if Level>TypeParams.Count then
  11811. RaiseNotYetImplemented(20190818122217,El);
  11812. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11813. if NamePart.Name<>aClassName then
  11814. RaiseNotYetImplemented(20190818102541,El,IntToStr(Level)+': '+NamePart.Name+'<>'+aClassName);
  11815. if NamePart.Templates<>nil then
  11816. begin
  11817. TypeParamCount:=NamePart.Templates.Count;
  11818. for i:=0 to TypeParamCount-1 do
  11819. begin
  11820. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11821. if length(TemplType.Constraints)>0 then
  11822. RaiseMsg(20190818102850,nIllegalQualifierAfter,sIllegalQualifierAfter,
  11823. [':',TemplType.name],TemplType);
  11824. end;
  11825. end;
  11826. end
  11827. else
  11828. NamePart:=nil;
  11829. {$IFDEF VerbosePasResolver}
  11830. writeln('TPasResolver.AddProcedure searching class "',aClassName,GetGenericParamCommas(TypeParamCount),'" ProcName="',ProcName,'" ...');
  11831. {$ENDIF}
  11832. if not IsValidIdent(aClassName) then
  11833. RaiseNotYetImplemented(20161013170844,El);
  11834. if ClassOrRecType<>nil then
  11835. begin
  11836. ClassOrRecScope:=TPasClassOrRecordScope(ClassOrRecType.CustomData);
  11837. ClassOrRecType:=FindMembersType(ClassOrRecScope,aClassName,
  11838. TypeParamCount,IsDelphi,El);
  11839. end
  11840. else
  11841. ClassOrRecType:=FindMembersType(nil,aClassName,
  11842. TypeParamCount,IsDelphi,El);
  11843. if ClassOrRecType is TPasClassType then
  11844. begin
  11845. if not (TPasClassType(ClassOrRecType).ObjKind in
  11846. ([okClass]+okAllHelpers)) then
  11847. begin
  11848. aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName)-1);
  11849. RaiseXExpectedButYFound(20180321161722,'class',
  11850. aClassname+GetGenericParamCommas(GetTypeParameterCount(ClassOrRecType))+':'+GetElementTypeName(ClassOrRecType),El);
  11851. end
  11852. end;
  11853. if ClassOrRecType.GetModule<>El.GetModule then
  11854. RaiseNotYetImplemented(20190818120051,El);
  11855. if NamePart<>nil then
  11856. begin
  11857. // check that all type param names match
  11858. for i:=0 to TypeParamCount-1 do
  11859. begin
  11860. TemplType:=TPasGenericTemplateType(NamePart.Templates[i]);
  11861. FoundTemplType:=TPasGenericTemplateType(ClassOrRecType.GenericTemplateTypes[i]);
  11862. if not SameText(TemplType.Name,FoundTemplType.Name) then
  11863. RaiseMsg(20190822014652,nXExpectedButYFound,
  11864. sXExpectedButYFound,[FoundTemplType.Name,TemplType.Name],TemplType);
  11865. end;
  11866. end;
  11867. until false;
  11868. if not IsValidIdent(ProcName) then
  11869. RaiseNotYetImplemented(20161013170956,El);
  11870. ProcScope.VisibilityContext:=ClassOrRecType;
  11871. ProcScope.ClassRecScope:=NoNil(ClassOrRecType.CustomData) as TPasClassOrRecordScope;
  11872. if TypeParams<>nil then
  11873. begin
  11874. if Level<>TypeParams.Count then
  11875. RaiseNotYetImplemented(20190818122315,El);
  11876. NamePart:=TProcedureNamePart(TypeParams[Level-1]);
  11877. if NamePart.Name<>ProcName then
  11878. RaiseNotYetImplemented(20190818122551,El,IntToStr(Level)+': '+NamePart.Name+'<>'+ProcName);
  11879. end;
  11880. end
  11881. else
  11882. begin
  11883. // HasDot=false
  11884. end;
  11885. PushScope(ProcScope);
  11886. end;// end source proc, not specialized
  11887. if HasDot then
  11888. begin
  11889. // create GroupScope
  11890. if TopScope<>ProcScope then
  11891. RaiseNotYetImplemented(20191014235935,El,GetObjName(TopScope));
  11892. ProcScope.GroupScope:=CreateGroupScope(ClassOrRecType);
  11893. if ClassOrRecType.Parent is TPasMembersType then
  11894. begin
  11895. // nested class
  11896. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  11897. NestedMembersScope:=CreateGroupScope(ClassOrRecType);
  11898. ProcScope.NestedMembersScope:=NestedMembersScope;
  11899. NestedMembersScope.OnlyTypeMembers:=true;
  11900. // Delphi searches the parent class scopes *after* the section scopes
  11901. // and before the module scope - sigh
  11902. // -> Move scope between module scope and section scope
  11903. i:=0;
  11904. while (i<ScopeCount) and not (FScopes[i] is TPasModuleScope) do
  11905. inc(i);
  11906. InsertScope(NestedMembersScope,i+1);
  11907. while ClassOrRecType.Parent is TPasMembersType do
  11908. begin
  11909. ClassOrRecType:=TPasMembersType(ClassOrRecType.Parent);
  11910. GroupScope_AddTypeAndAncestors(NestedMembersScope,ClassOrRecType);
  11911. end;
  11912. end;
  11913. end;
  11914. // add generic params to scope
  11915. if TypeParams<>nil then
  11916. begin
  11917. NamePart:=TProcedureNamePart(TypeParams[TypeParams.Count-1]);
  11918. if NamePart<>nil then
  11919. AddGenericTemplateIdentifiers(NamePart.Templates,ProcScope);
  11920. end;
  11921. end;
  11922. procedure TPasResolver.AddArgument(El: TPasArgument);
  11923. var
  11924. ProcType: TPasProcedureType;
  11925. i: Integer;
  11926. Arg: TPasArgument;
  11927. CurScope: TPasScope;
  11928. begin
  11929. if (El.Name='') then
  11930. RaiseInternalError(20160922163526,GetObjName(El));
  11931. {$IFDEF VerbosePasResolver}
  11932. writeln('TPasResolver.AddArgument ',GetObjName(El));
  11933. {$ENDIF}
  11934. CurScope:=TopScope;
  11935. if (CurScope=nil) then
  11936. RaiseInvalidScopeForElement(20160922163529,El);
  11937. if El.Parent.ClassType=TPasProperty then
  11938. begin
  11939. if CurScope.ClassType<>TPasPropertyScope then
  11940. RaiseInvalidScopeForElement(20161014124530,El);
  11941. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  11942. end
  11943. else if El.Parent is TPasProcedureType then
  11944. begin
  11945. ProcType:=TPasProcedureType(El.Parent);
  11946. if ProcType.Parent is TPasProcedure then
  11947. begin
  11948. if CurScope.ClassType<>FScopeClass_Proc then
  11949. RaiseInvalidScopeForElement(20160922163529,El,GetObjName(TopScope));
  11950. AddIdentifier(TPasIdentifierScope(CurScope),El.Name,El,pikSimple);
  11951. end
  11952. else
  11953. begin
  11954. for i:=0 to ProcType.Args.Count-1 do
  11955. begin
  11956. Arg:=TPasArgument(ProcType.Args[i]);
  11957. if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
  11958. RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
  11959. end;
  11960. end;
  11961. end
  11962. else
  11963. RaiseNotYetImplemented(20161014124937,El);
  11964. end;
  11965. procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
  11966. var
  11967. CurScope: TPasScope;
  11968. begin
  11969. CurScope:=TopScope;
  11970. if CurScope.ClassType<>FScopeClass_Proc then exit;
  11971. if El.Parent is TPasProcedureType then
  11972. begin
  11973. if not (El.Parent.Parent is TPasProcedure) then
  11974. exit;
  11975. end
  11976. else if not (El.Parent is TPasProcedure) then
  11977. exit;
  11978. AddIdentifier(TPasProcedureScope(CurScope),ResolverResultVar,El,pikSimple);
  11979. end;
  11980. procedure TPasResolver.AddGenericTemplateType(El: TPasGenericTemplateType);
  11981. var
  11982. ParamScope: TPasGenericParamsScope;
  11983. OldIdentifier: TPasIdentifier;
  11984. begin
  11985. if TopScope is TPasGenericParamsScope then
  11986. begin
  11987. ParamScope:=TPasGenericParamsScope(TopScope);
  11988. if ParamScope.Element.Parent<>El.Parent then
  11989. RaiseNotYetImplemented(20190831203132,El,GetObjName(ParamScope.Element));
  11990. end
  11991. else
  11992. begin
  11993. if El.CustomData<>nil then
  11994. RaiseNotYetImplemented(20190831202627,El,GetObjName(El.CustomData));
  11995. ParamScope:=TPasGenericParamsScope.Create;
  11996. AddResolveData(El,ParamScope,lkModule);
  11997. PushScope(ParamScope);
  11998. end;
  11999. OldIdentifier:=ParamScope.FindIdentifier(El.Name);
  12000. if OldIdentifier<>nil then
  12001. RaiseMsg(20190831202920,nDuplicateIdentifier,sDuplicateIdentifier,
  12002. [OldIdentifier.Identifier,GetElementSourcePosStr(OldIdentifier.Element)],El);
  12003. ParamScope.AddIdentifier(El.Name,El,pikSimple);
  12004. end;
  12005. procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
  12006. begin
  12007. PushScope(El,TPasExceptOnScope);
  12008. end;
  12009. procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
  12010. begin
  12011. if TPasWithScope.FreeOnPop then
  12012. RaiseInternalError(20181210162344);
  12013. PushScope(El,TPasWithScope);
  12014. end;
  12015. procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
  12016. begin
  12017. if El=nil then ;
  12018. CheckTopScope(FScopeClass_Proc);
  12019. end;
  12020. procedure TPasResolver.WriteScopes;
  12021. {AllowWriteln}
  12022. var
  12023. i: Integer;
  12024. Scope: TPasScope;
  12025. begin
  12026. writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
  12027. for i:=ScopeCount-1 downto 0 do
  12028. begin
  12029. Scope:=Scopes[i];
  12030. writeln(' ',i,'/',ScopeCount,' ',GetObjName(Scope));
  12031. Scope.WriteIdentifiers(' ');
  12032. end;
  12033. {AllowWriteln-}
  12034. end;
  12035. procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
  12036. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12037. StartEl: TPasElement);
  12038. var
  12039. LeftResolved, RightResolved: TPasResolverResult;
  12040. begin
  12041. if (Bin.OpCode=eopSubIdent)
  12042. or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
  12043. begin
  12044. // Note: bin.left was already resolved via ResolveSubIdent
  12045. ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
  12046. exit;
  12047. end;
  12048. if Bin.OpCode in [eopEqual,eopNotEqual] then
  12049. begin
  12050. if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
  12051. rcSetReferenceFlags in Flags)=cIncompatible then
  12052. RaiseInternalError(20161007215912);
  12053. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  12054. Bin,[rrfReadable]);
  12055. exit;
  12056. end;
  12057. ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
  12058. ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
  12059. // ToDo: check operator overloading
  12060. ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
  12061. end;
  12062. procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out
  12063. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12064. var LeftResolved, RightResolved: TPasResolverResult);
  12065. procedure SetBaseType(BaseType: TResolverBaseType);
  12066. begin
  12067. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  12068. Bin,[rrfReadable]);
  12069. end;
  12070. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  12071. begin
  12072. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  12073. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,Flags);
  12074. end;
  12075. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  12076. begin
  12077. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  12078. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,Flags);
  12079. end;
  12080. var
  12081. ElTypeResolved: TPasResolverResult;
  12082. LeftTypeEl, RightTypeEl: TPasType;
  12083. begin
  12084. if LeftResolved.BaseType=btRange then
  12085. ConvertRangeToElement(LeftResolved);
  12086. if RightResolved.BaseType=btRange then
  12087. ConvertRangeToElement(RightResolved);
  12088. //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  12089. if IsGenericTemplType(LeftResolved) or IsGenericTemplType(RightResolved) then
  12090. begin
  12091. // cannot yet be decided
  12092. case Bin.OpCode of
  12093. eopEqual, eopNotEqual,
  12094. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual,
  12095. eopIn,eopIs:
  12096. begin
  12097. SetBaseType(btBoolean);
  12098. exit;
  12099. end;
  12100. eopAs:
  12101. begin
  12102. SetRightValueExpr([rrfReadable]);
  12103. exit;
  12104. end;
  12105. end;
  12106. ResolvedEl:=LeftResolved;
  12107. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  12108. exit;
  12109. end;
  12110. if LeftResolved.BaseType in btAllInteger then
  12111. begin
  12112. if (rrfReadable in LeftResolved.Flags)
  12113. and (rrfReadable in RightResolved.Flags) then
  12114. begin
  12115. if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
  12116. case Bin.OpCode of
  12117. eopNone:
  12118. if (Bin.Kind=pekRange) then
  12119. begin
  12120. if not (RightResolved.BaseType in btAllInteger) then
  12121. RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
  12122. // use left type for result
  12123. SetLeftValueExpr([rrfReadable]);
  12124. if Bin.Parent is TPasRangeType then
  12125. begin
  12126. ResolvedEl.LoTypeEl:=TPasRangeType(Bin.Parent);
  12127. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  12128. end;
  12129. exit;
  12130. end;
  12131. eopAdd, eopSubtract,
  12132. eopMultiply, eopDiv, eopMod,
  12133. eopPower,
  12134. eopShl, eopShr,
  12135. eopAnd, eopOr, eopXor:
  12136. begin
  12137. if RightResolved.BaseType in btAllFloats then
  12138. // use right type for result
  12139. SetRightValueExpr([rrfReadable])
  12140. else
  12141. // use left type for result
  12142. SetLeftValueExpr([rrfReadable]);
  12143. exit;
  12144. end;
  12145. eopLessThan,
  12146. eopGreaterThan,
  12147. eopLessthanEqual,
  12148. eopGreaterThanEqual:
  12149. begin
  12150. SetBaseType(btBoolean);
  12151. exit;
  12152. end;
  12153. eopDivide:
  12154. begin
  12155. SetBaseType(BaseTypeExtended);
  12156. exit;
  12157. end;
  12158. end
  12159. else if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12160. begin
  12161. if (Bin.OpCode=eopIn) and (RightResolved.SubType in btAllInteger) then
  12162. begin
  12163. SetBaseType(btBoolean);
  12164. exit;
  12165. end;
  12166. end
  12167. else if RightResolved.BaseType=btPointer then
  12168. begin
  12169. if (Bin.OpCode in [eopAdd,eopSubtract])
  12170. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12171. begin
  12172. // integer+CanonicalPointer
  12173. SetResolverValueExpr(ResolvedEl,btPointer,
  12174. RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,[rrfReadable]);
  12175. exit;
  12176. end;
  12177. end
  12178. else if RightResolved.BaseType=btContext then
  12179. begin
  12180. RightTypeEl:=RightResolved.LoTypeEl;
  12181. if RightTypeEl.ClassType=TPasPointerType then
  12182. begin
  12183. if (Bin.OpCode in [eopAdd,eopSubtract])
  12184. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12185. begin
  12186. // integer+TypedPointer
  12187. RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
  12188. SetResolverValueExpr(ResolvedEl,btPointer,
  12189. ResolveAliasType(RightTypeEl),RightTypeEl,Bin,[rrfReadable]);
  12190. exit;
  12191. end;
  12192. end;
  12193. end;
  12194. end;
  12195. end
  12196. else if LeftResolved.BaseType in btAllBooleans then
  12197. begin
  12198. if (rrfReadable in LeftResolved.Flags)
  12199. and (RightResolved.BaseType in btAllBooleans)
  12200. and (rrfReadable in RightResolved.Flags) then
  12201. case Bin.OpCode of
  12202. eopNone:
  12203. if Bin.Kind=pekRange then
  12204. begin
  12205. SetResolverValueExpr(ResolvedEl,btRange,
  12206. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  12207. Bin,[rrfReadable]);
  12208. ResolvedEl.SubType:=LeftResolved.BaseType;
  12209. exit;
  12210. end;
  12211. eopAnd, eopOr, eopXor:
  12212. begin
  12213. // use left type for result
  12214. SetLeftValueExpr([rrfReadable]);
  12215. exit;
  12216. end;
  12217. end;
  12218. end
  12219. else if LeftResolved.BaseType in btAllStringAndChars then
  12220. begin
  12221. if (rrfReadable in LeftResolved.Flags)
  12222. and (rrfReadable in RightResolved.Flags) then
  12223. begin
  12224. if (RightResolved.BaseType in btAllStringAndChars) then
  12225. case Bin.OpCode of
  12226. eopNone:
  12227. if (Bin.Kind=pekRange) and (LeftResolved.BaseType in btAllChars) then
  12228. begin
  12229. if not (RightResolved.BaseType in btAllChars) then
  12230. RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
  12231. SetResolverValueExpr(ResolvedEl,btRange,
  12232. FBaseTypes[LeftResolved.BaseType],FBaseTypes[LeftResolved.BaseType],
  12233. Bin,[rrfReadable]);
  12234. ResolvedEl.SubType:=LeftResolved.BaseType;
  12235. exit;
  12236. end;
  12237. eopAdd:
  12238. if RightResolved.BaseType in btAllStringAndChars then
  12239. if ComputeAddStringRes(LeftResolved,RightResolved,Bin,ResolvedEl) then
  12240. exit;
  12241. eopLessThan,
  12242. eopGreaterThan,
  12243. eopLessthanEqual,
  12244. eopGreaterThanEqual:
  12245. begin
  12246. SetBaseType(btBoolean);
  12247. exit;
  12248. end;
  12249. end
  12250. else if (RightResolved.BaseType in [btSet,btArrayOrSet])
  12251. and (RightResolved.SubType in btAllChars)
  12252. and (LeftResolved.BaseType in btAllChars) then
  12253. begin
  12254. case Bin.OpCode of
  12255. eopIn:
  12256. begin
  12257. SetBaseType(btBoolean);
  12258. exit;
  12259. end;
  12260. end;
  12261. end
  12262. end
  12263. end
  12264. else if LeftResolved.BaseType in btAllFloats then
  12265. begin
  12266. if (rrfReadable in LeftResolved.Flags)
  12267. and (RightResolved.BaseType in (btAllInteger+btAllFloats))
  12268. and (rrfReadable in RightResolved.Flags) then
  12269. case Bin.OpCode of
  12270. eopAdd, eopSubtract,
  12271. eopMultiply, eopDivide, eopMod,
  12272. eopPower:
  12273. begin
  12274. if (RightResolved.BaseType=btCurrency)
  12275. or ((RightResolved.BaseType in btAllFloats)
  12276. and (RightResolved.BaseType>LeftResolved.BaseType)) then
  12277. // use right side as result
  12278. SetRightValueExpr([rrfReadable])
  12279. else
  12280. // use left side as result
  12281. SetLeftValueExpr([rrfReadable]);
  12282. exit;
  12283. end;
  12284. eopLessThan,
  12285. eopGreaterThan,
  12286. eopLessthanEqual,
  12287. eopGreaterThanEqual:
  12288. begin
  12289. SetBaseType(btBoolean);
  12290. exit;
  12291. end;
  12292. end;
  12293. end
  12294. else if LeftResolved.BaseType=btPointer then
  12295. begin
  12296. if (rrfReadable in LeftResolved.Flags)
  12297. and (rrfReadable in RightResolved.Flags) then
  12298. begin
  12299. if (RightResolved.BaseType in btAllInteger) then
  12300. case Bin.OpCode of
  12301. eopAdd,eopSubtract:
  12302. if ElHasBoolSwitch(Bin,bsPointerMath) then
  12303. begin
  12304. // pointer+integer -> pointer
  12305. SetResolverValueExpr(ResolvedEl,btPointer,
  12306. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,[rrfReadable]);
  12307. exit;
  12308. end;
  12309. end
  12310. else if RightResolved.BaseType=btPointer then
  12311. case Bin.OpCode of
  12312. eopLessThan,
  12313. eopGreaterThan,
  12314. eopLessthanEqual,
  12315. eopGreaterThanEqual:
  12316. begin
  12317. SetBaseType(btBoolean);
  12318. exit;
  12319. end;
  12320. end;
  12321. end;
  12322. end
  12323. else if LeftResolved.BaseType=btContext then
  12324. begin
  12325. LeftTypeEl:=LeftResolved.LoTypeEl;
  12326. case Bin.OpCode of
  12327. eopNone:
  12328. if Bin.Kind=pekRange then
  12329. begin
  12330. if (rrfReadable in LeftResolved.Flags)
  12331. and (rrfReadable in RightResolved.Flags) then
  12332. begin
  12333. CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
  12334. ResolvedEl:=LeftResolved;
  12335. ResolvedEl.IdentEl:=nil;
  12336. ResolvedEl.SubType:=ResolvedEl.BaseType;
  12337. ResolvedEl.BaseType:=btRange;
  12338. ResolvedEl.ExprEl:=Bin;
  12339. exit;
  12340. end;
  12341. end;
  12342. eopIn:
  12343. if (rrfReadable in LeftResolved.Flags)
  12344. and (rrfReadable in RightResolved.Flags) then
  12345. begin
  12346. if LeftResolved.BaseType in btArrayRangeTypes then
  12347. begin
  12348. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12349. RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12350. if LeftResolved.BaseType in btAllBooleans then
  12351. begin
  12352. if not (RightResolved.SubType in btAllBooleans) then
  12353. RaiseXExpectedButYFound(20170216152610,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12354. end
  12355. else if LeftResolved.BaseType in btAllChars then
  12356. begin
  12357. if not (RightResolved.SubType in btAllChars) then
  12358. RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12359. end
  12360. else if not (RightResolved.SubType in btAllInteger) then
  12361. RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
  12362. SetBaseType(btBoolean);
  12363. exit;
  12364. end
  12365. else if (LeftResolved.BaseType=btContext)
  12366. and (LeftTypeEl.ClassType=TPasEnumType) then
  12367. begin
  12368. if not (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12369. RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.LoTypeEl.Name,GetElementTypeName(LeftResolved.LoTypeEl),Bin.right);
  12370. RightTypeEl:=RightResolved.LoTypeEl;
  12371. if LeftTypeEl=RightTypeEl then
  12372. // enum in setofenum
  12373. else if RightResolved.LoTypeEl.ClassType=TPasRangeType then
  12374. begin
  12375. ComputeElement(TPasRangeType(RightTypeEl).RangeExpr.left,ElTypeResolved,[rcConstant]);
  12376. if LeftTypeEl<>ElTypeResolved.LoTypeEl then
  12377. RaiseXExpectedButYFound(20171109215833,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12378. end
  12379. else
  12380. RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.LoTypeEl.Name,'set of '+RightResolved.LoTypeEl.Name,Bin.right);
  12381. SetBaseType(btBoolean);
  12382. exit;
  12383. end
  12384. else
  12385. RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
  12386. sInOperatorExpectsSetElementButGot,[GetElementTypeName(LeftResolved.LoTypeEl)],Bin);
  12387. end;
  12388. eopIs:
  12389. begin
  12390. RightTypeEl:=RightResolved.LoTypeEl;
  12391. if (LeftTypeEl is TPasClassType) then
  12392. begin
  12393. if not (rrfReadable in LeftResolved.Flags) then
  12394. RaiseIncompatibleTypeRes(20180204124637,nOperatorIsNotOverloadedAOpB,
  12395. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12396. if (LeftResolved.IdentEl is TPasType) then
  12397. RaiseIncompatibleTypeRes(20180204124638,nOperatorIsNotOverloadedAOpB,
  12398. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12399. // left side is a class instance
  12400. if (RightResolved.IdentEl is TPasType)
  12401. and (RightTypeEl is TPasClassType) then
  12402. begin
  12403. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12404. begin
  12405. if CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible then
  12406. begin
  12407. // e.g. if obj is TFPMemoryImage then ;
  12408. // Note: at compile time the check is reversed: right must inherit from left
  12409. SetBaseType(btBoolean);
  12410. exit;
  12411. end
  12412. else if CheckSrcIsADstType(LeftResolved,RightResolved)<>cIncompatible then
  12413. begin
  12414. // e.g. if Image is TObject then ;
  12415. // This is useful after some unchecked typecast -> allow
  12416. SetBaseType(btBoolean);
  12417. exit;
  12418. end;
  12419. end
  12420. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12421. begin
  12422. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12423. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12424. begin
  12425. // e.g. if classintvar is intftype then ;
  12426. SetBaseType(btBoolean);
  12427. exit;
  12428. end;
  12429. end
  12430. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12431. begin
  12432. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12433. and (not TPasClassType(RightTypeEl).IsExternal) then
  12434. begin
  12435. // e.g. if intfvar is classtype then ;
  12436. SetBaseType(btBoolean);
  12437. exit;
  12438. end;
  12439. end;
  12440. {$IFDEF VerbosePasResolver}
  12441. writeln('TPasResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)));
  12442. writeln('TPasResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
  12443. {$ENDIF}
  12444. end
  12445. else if (RightTypeEl is TPasClassOfType)
  12446. and (rrfReadable in RightResolved.Flags) then
  12447. begin
  12448. // e.g. if Image is ImageClass then ;
  12449. if (CheckClassesAreRelated(LeftResolved.LoTypeEl,
  12450. TPasClassOfType(RightTypeEl).DestType)<>cIncompatible) then
  12451. begin
  12452. SetBaseType(btBoolean);
  12453. exit;
  12454. end;
  12455. end
  12456. else
  12457. RaiseXExpectedButYFound(20170216152625,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12458. end
  12459. else if (proClassOfIs in Options) and (LeftTypeEl is TPasClassOfType)
  12460. and (rrfReadable in LeftResolved.Flags) then
  12461. begin
  12462. if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
  12463. RaiseIncompatibleTypeRes(20180204124657,nOperatorIsNotOverloadedAOpB,
  12464. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12465. // left side is class-of variable
  12466. LeftTypeEl:=ResolveAliasType(TPasClassOfType(LeftTypeEl).DestType);
  12467. if (RightResolved.IdentEl is TPasType)
  12468. and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then
  12469. begin
  12470. // e.g. if ImageClass is TFPMemoryImage then ;
  12471. // Note: at compile time the check is reversed: right must inherit from left
  12472. if CheckClassIsClass(RightResolved.LoTypeEl,LeftTypeEl)<>cIncompatible then
  12473. begin
  12474. SetBaseType(btBoolean);
  12475. exit;
  12476. end
  12477. end
  12478. else if (RightTypeEl is TPasClassOfType) then
  12479. begin
  12480. // e.g. if ImageClassA is ImageClassB then ;
  12481. // or if ImageClassA is TFPImageClass then ;
  12482. RightTypeEl:=ResolveAliasType(TPasClassOfType(RightTypeEl).DestType);
  12483. if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl)<>cIncompatible) then
  12484. begin
  12485. SetBaseType(btBoolean);
  12486. exit;
  12487. end
  12488. end
  12489. else
  12490. RaiseXExpectedButYFound(20170322105252,'class type',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12491. end
  12492. else if LeftResolved.LoTypeEl=nil then
  12493. begin
  12494. {$IFDEF VerbosePasResolver}
  12495. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12496. {$ENDIF}
  12497. RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12498. [BaseTypeNames[LeftResolved.BaseType]],Bin.left);
  12499. end
  12500. else
  12501. begin
  12502. {$IFDEF VerbosePasResolver}
  12503. writeln('TPasResolver.ComputeBinaryExprRes is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
  12504. {$ENDIF}
  12505. RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
  12506. [GetElementTypeName(LeftResolved.LoTypeEl)],Bin.left);
  12507. end;
  12508. end;
  12509. eopAs:
  12510. begin
  12511. if (LeftTypeEl.ClassType=TPasClassType) then
  12512. begin
  12513. if (LeftResolved.IdentEl is TPasType)
  12514. or (not (rrfReadable in LeftResolved.Flags)) then
  12515. RaiseIncompatibleTypeRes(20180204124711,nOperatorIsNotOverloadedAOpB,
  12516. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12517. if RightResolved.IdentEl=nil then
  12518. RaiseXExpectedButYFound(20170216152630,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12519. if not (RightResolved.IdentEl is TPasType) then
  12520. RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
  12521. if not (RightResolved.BaseType=btContext) then
  12522. RaiseXExpectedButYFound(20180426195816,'class',RightResolved.IdentEl.Name,Bin.right);
  12523. RightTypeEl:=RightResolved.LoTypeEl;
  12524. if RightTypeEl is TPasClassType then
  12525. begin
  12526. if TPasClassType(LeftTypeEl).ObjKind=TPasClassType(RightTypeEl).ObjKind then
  12527. begin
  12528. // e.g. classinst as classtype
  12529. if (CheckSrcIsADstType(RightResolved,LeftResolved)<>cIncompatible) then
  12530. begin
  12531. SetRightValueExpr([rrfReadable]);
  12532. exit;
  12533. end;
  12534. end
  12535. else if TPasClassType(LeftTypeEl).ObjKind=okInterface then
  12536. begin
  12537. if (TPasClassType(RightTypeEl).ObjKind=okClass)
  12538. and (not TPasClassType(RightTypeEl).IsExternal) then
  12539. begin
  12540. // e.g. intfvar as classtype
  12541. SetRightValueExpr([rrfReadable]);
  12542. exit;
  12543. end;
  12544. end
  12545. else if TPasClassType(RightTypeEl).ObjKind=okInterface then
  12546. begin
  12547. if (TPasClassType(LeftTypeEl).ObjKind=okClass)
  12548. and (not TPasClassType(LeftTypeEl).IsExternal) then
  12549. begin
  12550. // e.g. classinst as intftype
  12551. SetRightValueExpr([rrfReadable]);
  12552. exit;
  12553. end;
  12554. end;
  12555. end;
  12556. RaiseIncompatibleTypeRes(20180324190713,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12557. end
  12558. else if LeftTypeEl.ClassType=TPasGenericTemplateType then
  12559. begin
  12560. // genericvar as ...
  12561. if (LeftResolved.IdentEl is TPasType)
  12562. or (not (rrfReadable in LeftResolved.Flags)) then
  12563. RaiseIncompatibleTypeRes(20190908191127,nOperatorIsNotOverloadedAOpB,
  12564. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12565. if RightResolved.IdentEl=nil then
  12566. RaiseXExpectedButYFound(20190908191202,'class',GetElementTypeName(RightResolved.LoTypeEl),Bin.right);
  12567. if not (RightResolved.IdentEl is TPasType) then
  12568. RaiseXExpectedButYFound(20190908191204,'class',RightResolved.IdentEl.Name,Bin.right);
  12569. if not (RightResolved.BaseType=btContext) then
  12570. RaiseXExpectedButYFound(20190908191206,'class',RightResolved.IdentEl.Name,Bin.right);
  12571. RightTypeEl:=RightResolved.LoTypeEl;
  12572. if RightTypeEl is TPasClassType then
  12573. begin
  12574. // e.g. genericvar as classtype
  12575. SetRightValueExpr([rrfReadable]);
  12576. exit;
  12577. end;
  12578. RaiseIncompatibleTypeRes(20190908192345,nTypesAreNotRelatedXY,[],LeftResolved,RightResolved,Bin);
  12579. end;
  12580. end;
  12581. eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
  12582. if (rrfReadable in LeftResolved.Flags)
  12583. and (rrfReadable in RightResolved.Flags) then
  12584. begin
  12585. RightTypeEl:=RightResolved.LoTypeEl;
  12586. if (LeftTypeEl.ClassType=TPasEnumType) and (LeftTypeEl=RightTypeEl) then
  12587. begin
  12588. SetBaseType(btBoolean);
  12589. exit;
  12590. end
  12591. else if (LeftTypeEl.ClassType=TPasPointerType)
  12592. and (RightResolved.BaseType in btAllInteger) then
  12593. begin
  12594. SetBaseType(btBoolean);
  12595. exit;
  12596. end;
  12597. end;
  12598. eopSubIdent:
  12599. begin
  12600. ResolvedEl:=RightResolved;
  12601. exit;
  12602. end;
  12603. eopAdd,eopSubtract:
  12604. if (rrfReadable in LeftResolved.Flags)
  12605. and (rrfReadable in RightResolved.Flags) then
  12606. begin
  12607. if (LeftTypeEl.ClassType=TPasArrayType) then
  12608. begin
  12609. if IsDynArray(LeftTypeEl)
  12610. and (Bin.OpCode=eopAdd)
  12611. and ElHasModeSwitch(Bin,msArrayOperators)
  12612. and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
  12613. or IsDynArray(RightResolved.LoTypeEl)) then
  12614. begin
  12615. // dynarr+[...]
  12616. CheckAssignCompatibilityArrayType(LeftResolved,RightResolved,Bin,true);
  12617. SetLeftValueExpr([rrfReadable]);
  12618. exit;
  12619. end;
  12620. end
  12621. else if LeftTypeEl.ClassType=TPasPointerType then
  12622. begin
  12623. if (RightResolved.BaseType in btAllInteger)
  12624. and ElHasBoolSwitch(Bin,bsPointerMath) then
  12625. begin
  12626. // TypedPointer+Integer
  12627. SetLeftValueExpr([rrfReadable]);
  12628. exit;
  12629. end;
  12630. end;
  12631. end;
  12632. end;
  12633. end
  12634. else if LeftResolved.BaseType in [btSet,btArrayOrSet] then
  12635. begin
  12636. if (rrfReadable in LeftResolved.Flags)
  12637. and (rrfReadable in RightResolved.Flags) then
  12638. begin
  12639. if (RightResolved.BaseType in [btSet,btArrayOrSet]) then
  12640. case Bin.OpCode of
  12641. eopAdd,
  12642. eopSubtract,
  12643. eopMultiply,
  12644. eopSymmetricaldifference,
  12645. eopLessthanEqual,
  12646. eopGreaterThanEqual:
  12647. begin
  12648. if RightResolved.LoTypeEl=nil then
  12649. begin
  12650. // right is empty set/array
  12651. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12652. SetBaseType(btBoolean)
  12653. else
  12654. begin
  12655. ResolvedEl:=LeftResolved;
  12656. ResolvedEl.IdentEl:=nil;
  12657. ResolvedEl.ExprEl:=Bin;
  12658. end;
  12659. exit;
  12660. end
  12661. else if LeftResolved.LoTypeEl=nil then
  12662. begin
  12663. // left is empty set/array
  12664. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12665. SetBaseType(btBoolean)
  12666. else
  12667. begin
  12668. ResolvedEl:=RightResolved;
  12669. ResolvedEl.IdentEl:=nil;
  12670. ResolvedEl.ExprEl:=Bin;
  12671. end;
  12672. exit;
  12673. end
  12674. else if (LeftResolved.SubType=RightResolved.SubType)
  12675. or ((LeftResolved.SubType in btAllBooleans)
  12676. and (RightResolved.SubType in btAllBooleans))
  12677. or ((LeftResolved.SubType in btAllInteger)
  12678. and (RightResolved.SubType in btAllInteger)) then
  12679. begin
  12680. // compatible set
  12681. if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
  12682. SetBaseType(btBoolean)
  12683. else
  12684. begin
  12685. ResolvedEl:=LeftResolved;
  12686. ResolvedEl.IdentEl:=nil;
  12687. ResolvedEl.ExprEl:=Bin;
  12688. end;
  12689. exit;
  12690. end;
  12691. {$IFDEF VerbosePasResolver}
  12692. writeln('TPasResolver.ComputeBinaryExprRes + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
  12693. +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
  12694. {$ENDIF}
  12695. end;
  12696. end
  12697. else if RightResolved.BaseType=btContext then
  12698. begin
  12699. RightTypeEl:=RightResolved.LoTypeEl;
  12700. if RightTypeEl.ClassType=TPasArrayType then
  12701. begin
  12702. if IsDynArray(RightTypeEl) then
  12703. begin
  12704. // [...]+dynarr
  12705. CheckAssignCompatibilityArrayType(RightResolved,LeftResolved,Bin,true);
  12706. SetRightValueExpr([rrfReadable]);
  12707. exit;
  12708. end;
  12709. end;
  12710. end;
  12711. end;
  12712. end
  12713. else if LeftResolved.BaseType=btArrayLit then
  12714. begin
  12715. if (rrfReadable in LeftResolved.Flags)
  12716. and (rrfReadable in RightResolved.Flags)
  12717. and (Bin.OpCode=eopAdd)
  12718. and ElHasModeSwitch(Bin,msArrayOperators) then
  12719. begin
  12720. if RightResolved.BaseType=btArrayLit then
  12721. begin
  12722. if LeftResolved.LoTypeEl<>nil then
  12723. ResolvedEl:=LeftResolved
  12724. else
  12725. ResolvedEl:=RightResolved;
  12726. ResolvedEl.IdentEl:=nil;
  12727. ResolvedEl.ExprEl:=Bin;
  12728. exit;
  12729. end
  12730. else if (RightResolved.BaseType=btContext)
  12731. and (RightResolved.LoTypeEl.ClassType=TPasArrayType) then
  12732. begin
  12733. ResolvedEl:=RightResolved;
  12734. ResolvedEl.IdentEl:=nil;
  12735. ResolvedEl.ExprEl:=Bin;
  12736. exit;
  12737. end;
  12738. end;
  12739. end
  12740. else if LeftResolved.BaseType=btModule then
  12741. begin
  12742. if Bin.OpCode=eopSubIdent then
  12743. begin
  12744. ResolvedEl:=RightResolved;
  12745. exit;
  12746. end;
  12747. end;
  12748. {$IFDEF VerbosePasResolver}
  12749. writeln('TPasResolver.ComputeBinaryExprRes OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
  12750. {$ENDIF}
  12751. RaiseIncompatibleTypeRes(20180204114631,nOperatorIsNotOverloadedAOpB,
  12752. [OpcodeStrings[Bin.OpCode]],LeftResolved,RightResolved,Bin);
  12753. if Flags=[] then ;
  12754. end;
  12755. function TPasResolver.ComputeAddStringRes(const LeftResolved,
  12756. RightResolved: TPasResolverResult; ExprEl: TPasExpr; out
  12757. ResolvedEl: TPasResolverResult): boolean;
  12758. procedure SetBaseType(BaseType: TResolverBaseType);
  12759. begin
  12760. SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],FBaseTypes[BaseType],
  12761. ExprEl,[rrfReadable]);
  12762. end;
  12763. procedure SetLeftValueExpr(Flags: TPasResolverResultFlags);
  12764. begin
  12765. SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,
  12766. LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,ExprEl,Flags);
  12767. end;
  12768. procedure SetRightValueExpr(Flags: TPasResolverResultFlags);
  12769. begin
  12770. SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,
  12771. RightResolved.LoTypeEl,RightResolved.HiTypeEl,ExprEl,Flags);
  12772. end;
  12773. begin
  12774. Result:=true;
  12775. case LeftResolved.BaseType of
  12776. btChar:
  12777. begin
  12778. case RightResolved.BaseType of
  12779. btChar: SetBaseType(btString);
  12780. {$ifdef FPC_HAS_CPSTRING}
  12781. btAnsiChar:
  12782. if BaseTypeChar=btAnsiChar then
  12783. SetBaseType(btString)
  12784. else
  12785. SetBaseType(btUnicodeString);
  12786. {$endif}
  12787. btWideChar:
  12788. if BaseTypeChar=btWideChar then
  12789. SetBaseType(btString)
  12790. else
  12791. SetBaseType(btUnicodeString);
  12792. else
  12793. // use right type for result
  12794. SetRightValueExpr([rrfReadable]);
  12795. end;
  12796. exit;
  12797. end;
  12798. {$ifdef FPC_HAS_CPSTRING}
  12799. btAnsiChar:
  12800. begin
  12801. case RightResolved.BaseType of
  12802. btChar:
  12803. if BaseTypeChar=btAnsiChar then
  12804. SetBaseType(btString)
  12805. else
  12806. SetBaseType(btUnicodeString);
  12807. btAnsiChar:
  12808. if BaseTypeChar=btAnsiChar then
  12809. SetBaseType(btString)
  12810. else
  12811. SetBaseType(btAnsiString);
  12812. btWideChar:
  12813. if BaseTypeChar=btWideChar then
  12814. SetBaseType(btString)
  12815. else
  12816. SetBaseType(btUnicodeString);
  12817. else
  12818. // use right type for result
  12819. SetRightValueExpr([rrfReadable]);
  12820. end;
  12821. exit;
  12822. end;
  12823. {$endif}
  12824. btWideChar:
  12825. begin
  12826. case RightResolved.BaseType of
  12827. btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar:
  12828. if BaseTypeChar=btWideChar then
  12829. SetBaseType(btString)
  12830. else
  12831. SetBaseType(btUnicodeString);
  12832. else
  12833. // use right type for result
  12834. SetRightValueExpr([rrfReadable]);
  12835. end;
  12836. exit;
  12837. end;
  12838. {$ifdef FPC_HAS_CPSTRING}
  12839. btShortString:
  12840. begin
  12841. case RightResolved.BaseType of
  12842. btChar,btAnsiChar,btShortString,btWideChar:
  12843. // use left type for result
  12844. SetLeftValueExpr([rrfReadable]);
  12845. else
  12846. // shortstring + string => string
  12847. SetRightValueExpr([rrfReadable]);
  12848. end;
  12849. exit;
  12850. end;
  12851. {$endif}
  12852. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  12853. begin
  12854. // string + x => string
  12855. SetLeftValueExpr([rrfReadable]);
  12856. exit;
  12857. end;
  12858. end;
  12859. Result:=false;
  12860. end;
  12861. procedure TPasResolver.ComputeArgumentAndExpr(Arg: TPasArgument; out
  12862. ArgResolved: TPasResolverResult; Expr: TPasExpr; out
  12863. ExprResolved: TPasResolverResult; SetReferenceFlags: boolean);
  12864. begin
  12865. ComputeElement(Arg,ArgResolved,[]);
  12866. {$IFDEF VerbosePasResolver}
  12867. writeln('TPasResolver.ComputeArgumentAndExpr Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  12868. {$ENDIF}
  12869. if (ArgResolved.LoTypeEl=nil) and (Arg.ArgType<>nil) then
  12870. RaiseInternalError(20160922163628,'TypeEl=nil for '+GetTreeDbg(Arg));
  12871. ComputeArgumentExpr(ArgResolved,Arg.Access,Expr,ExprResolved,SetReferenceFlags);
  12872. end;
  12873. procedure TPasResolver.ComputeArgumentExpr(
  12874. const ArgResolved: TPasResolverResult; Access: TArgumentAccess;
  12875. Expr: TPasExpr; out ExprResolved: TPasResolverResult;
  12876. SetReferenceFlags: boolean);
  12877. var
  12878. NeedVar: Boolean;
  12879. RHSFlags: TPasResolverComputeFlags;
  12880. begin
  12881. RHSFlags:=[];
  12882. NeedVar:=Access in [argVar, argOut];
  12883. if NeedVar then
  12884. Include(RHSFlags,rcNoImplicitProc)
  12885. else if IsProcedureType(ArgResolved,true)
  12886. or (ArgResolved.BaseType=btPointer)
  12887. or ((ArgResolved.LoTypeEl=nil) and (ArgResolved.IdentEl is TPasArgument)) then
  12888. Include(RHSFlags,rcNoImplicitProcType);
  12889. if SetReferenceFlags then
  12890. Include(RHSFlags,rcSetReferenceFlags);
  12891. ComputeElement(Expr,ExprResolved,RHSFlags);
  12892. {$IFDEF VerbosePasResolver}
  12893. writeln('TPasResolver.ComputeArgumentExpr Expr=',GetTreeDbg(Expr,2),' ExprResolved=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
  12894. {$ENDIF}
  12895. end;
  12896. procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
  12897. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  12898. StartEl: TPasElement);
  12899. procedure ComputeIndexProperty(Prop: TPasProperty);
  12900. begin
  12901. if [rcConstant,rcType]*Flags<>[] then
  12902. RaiseConstantExprExp(20170216152635,Params);
  12903. ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
  12904. ResolvedEl.IdentEl:=Prop;
  12905. ResolvedEl.Flags:=[];
  12906. if GetPasPropertyGetter(Prop)<>nil then
  12907. Include(ResolvedEl.Flags,rrfReadable);
  12908. if GetPasPropertySetter(Prop)<>nil then
  12909. Include(ResolvedEl.Flags,rrfWritable);
  12910. end;
  12911. procedure ComputeArrayPointer(TypeEl: TPasType);
  12912. begin
  12913. if TypeEl=nil then
  12914. RaiseInternalError(20180423092254);
  12915. ComputeElement(TypeEl,ResolvedEl,[rcType],Params);
  12916. ResolvedEl.IdentEl:=nil;
  12917. ResolvedEl.ExprEl:=Params;
  12918. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  12919. end;
  12920. var
  12921. TypeEl, ElType: TPasType;
  12922. ArrayEl: TPasArrayType;
  12923. ArgNo: Integer;
  12924. OrigResolved: TPasResolverResult;
  12925. ClassOrRecordScope: TPasClassOrRecordScope;
  12926. Ref: TResolvedReference;
  12927. begin
  12928. ComputeElement(Params.Value,ResolvedEl,
  12929. Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
  12930. {$IFDEF VerbosePasResolver}
  12931. writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  12932. {$ENDIF}
  12933. if ResolvedEl.BaseType in btAllStrings then
  12934. begin
  12935. // stringvar[] => char
  12936. case GetActualBaseType(ResolvedEl.BaseType) of
  12937. {$ifdef FPC_HAS_CPSTRING}
  12938. btAnsiString,btRawByteString,btShortString:
  12939. if BaseTypeChar=btAnsiChar then
  12940. ResolvedEl.BaseType:=btChar
  12941. else
  12942. ResolvedEl.BaseType:=btAnsiChar;
  12943. {$endif}
  12944. btWideString,btUnicodeString:
  12945. if BaseTypeChar=btWideChar then
  12946. ResolvedEl.BaseType:=btChar
  12947. else
  12948. ResolvedEl.BaseType:=btWideChar;
  12949. else
  12950. RaiseNotYetImplemented(20170417202354,Params);
  12951. end;
  12952. // keep ResolvedEl.IdentEl the string var
  12953. ResolvedEl.LoTypeEl:=FBaseTypes[ResolvedEl.BaseType];
  12954. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  12955. ResolvedEl.ExprEl:=Params;
  12956. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
  12957. end
  12958. else if ResolvedEl.BaseType=btPointer then
  12959. // (@something)[]
  12960. ComputeArrayPointer(ResolvedEl.LoTypeEl)
  12961. else if (ResolvedEl.IdentEl is TPasProperty)
  12962. and (GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then
  12963. // property with args
  12964. ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
  12965. else if ResolvedEl.BaseType=btContext then
  12966. begin
  12967. TypeEl:=ResolvedEl.LoTypeEl;
  12968. if (TypeEl.ClassType=TPasClassType)
  12969. or (TypeEl.ClassType=TPasRecordType)
  12970. or (TypeEl.ClassType=TPasClassOfType) then
  12971. begin
  12972. if not (Params.CustomData is TResolvedReference) then
  12973. RaiseNotYetImplemented(20190125143203,Params,GetObjName(Params.CustomData));
  12974. Ref:=TResolvedReference(Params.CustomData);
  12975. if Ref.Declaration is TPasProperty then
  12976. ComputeIndexProperty(TPasProperty(Ref.Declaration))
  12977. else if TypeEl is TPasMembersType then
  12978. begin
  12979. ClassOrRecordScope:=NoNil(TypeEl.CustomData) as TPasClassOrRecordScope;
  12980. ComputeArrayParams_Class(Params,ResolvedEl,ClassOrRecordScope,Flags,StartEl);
  12981. end
  12982. else
  12983. RaiseNotYetImplemented(20161010174916,Params);
  12984. end
  12985. else if TypeEl.ClassType=TPasArrayType then
  12986. begin
  12987. if not (rrfReadable in ResolvedEl.Flags) then
  12988. RaiseMsg(20170517001140,nIllegalQualifierAfter,sIllegalQualifierAfter,
  12989. ['[',TypeEl.ElementTypeName],Params);
  12990. ArrayEl:=TPasArrayType(TypeEl);
  12991. ArgNo:=0;
  12992. repeat
  12993. if length(ArrayEl.Ranges)=0 then
  12994. begin
  12995. inc(ArgNo); // dynamic/open array has one dimension
  12996. if IsDynArray(ArrayEl) then
  12997. Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
  12998. end
  12999. else
  13000. inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
  13001. if ArgNo>length(Params.Params) then
  13002. RaiseInternalError(20161010185535);
  13003. if ArgNo=length(Params.Params) then
  13004. break;
  13005. // continue in sub array
  13006. ArrayEl:=NoNil(ResolveAliasType(ArrayEl.ElType)) as TPasArrayType;
  13007. until false;
  13008. OrigResolved:=ResolvedEl;
  13009. ElType:=GetArrayElType(ArrayEl);
  13010. ComputeElement(ElType,ResolvedEl,Flags,StartEl);
  13011. // identifier and value is the array itself
  13012. ResolvedEl.IdentEl:=OrigResolved.IdentEl;
  13013. ResolvedEl.ExprEl:=OrigResolved.ExprEl;
  13014. ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
  13015. if IsDynArray(ArrayEl) then
  13016. // dyn array elements are writable independent of the array
  13017. Include(ResolvedEl.Flags,rrfWritable);
  13018. end
  13019. else if TypeEl.ClassType=TPasPointerType then
  13020. ComputeArrayPointer(TPasPointerType(TypeEl).DestType)
  13021. else
  13022. RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
  13023. end
  13024. else
  13025. RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
  13026. end;
  13027. procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
  13028. var ResolvedEl: TPasResolverResult; ClassOrRecScope: TPasClassOrRecordScope;
  13029. Flags: TPasResolverComputeFlags; StartEl: TPasElement);
  13030. begin
  13031. RaiseNotYetImplemented(20190125142240,Params);
  13032. if Params=nil then ;
  13033. if ClassOrRecScope=nil then ;
  13034. if Flags=[] then ;
  13035. if StartEl=nil then ;
  13036. SetResolverIdentifier(ResolvedEl,btNone,nil,nil,nil,[]);
  13037. end;
  13038. procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
  13039. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13040. StartEl: TPasElement);
  13041. var
  13042. DeclEl: TPasElement;
  13043. BuiltInProc: TResElDataBuiltInProc;
  13044. Proc: TPasProcedure;
  13045. ParamResolved: TPasResolverResult;
  13046. Ref: TResolvedReference;
  13047. DeclType: TPasType;
  13048. Param0: TPasExpr;
  13049. begin
  13050. Ref:=GetParamsValueRef(Params);
  13051. if Ref=nil then
  13052. RaiseNotYetImplemented(20160928174124,Params);
  13053. DeclEl:=Ref.Declaration;
  13054. if DeclEl.ClassType=TPasUnresolvedSymbolRef then
  13055. begin
  13056. if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
  13057. begin
  13058. BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
  13059. if Assigned(BuiltInProc.GetCallResult) then
  13060. // built-in function
  13061. BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
  13062. else
  13063. // built-in procedure
  13064. SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,
  13065. BuiltInProc.Proc,BuiltInProc.Proc,[]);
  13066. if bipfCanBeStatement in BuiltInProc.Flags then
  13067. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13068. end
  13069. else if DeclEl.CustomData is TResElDataBaseType then
  13070. begin
  13071. // type cast to base type
  13072. DeclType:=TPasUnresolvedSymbolRef(DeclEl);
  13073. if length(Params.Params)<>1 then
  13074. begin
  13075. {$IFDEF VerbosePasResolver}
  13076. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl));
  13077. {$ENDIF}
  13078. RaiseMsg(20180503105409,nWrongNumberOfParametersForTypeCast,
  13079. sWrongNumberOfParametersForTypeCast,[DeclType.Name],Params);
  13080. end;
  13081. Param0:=Params.Params[0];
  13082. ComputeElement(Param0,ParamResolved,[]);
  13083. ComputeTypeCast(DeclType,DeclType,Param0,ParamResolved,ResolvedEl,Flags);
  13084. end
  13085. else
  13086. RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
  13087. end
  13088. else
  13089. begin
  13090. // normal identifier (not built-in)
  13091. ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  13092. if ResolvedEl.BaseType=btProc then
  13093. begin
  13094. if not (ResolvedEl.IdentEl is TPasProcedure) then
  13095. RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
  13096. Proc:=TPasProcedure(ResolvedEl.IdentEl);
  13097. if rcConstant in Flags then
  13098. RaiseConstantExprExp(20170216152637,Params);
  13099. if Proc.ProcType is TPasFunctionType then
  13100. // function call => return result
  13101. ComputeResultElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
  13102. Flags+[rcCall],StartEl)
  13103. else if (Proc.ClassType=TPasConstructor) then
  13104. begin
  13105. // constructor -> return value of type class
  13106. ResolvedEl:=GetReference_ConstructorType(Ref,Params.Value);
  13107. end
  13108. else
  13109. // procedure call, result is neither readable nor writable
  13110. SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,Proc.ProcType,[]);
  13111. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13112. end
  13113. else if ResolvedEl.LoTypeEl is TPasProcedureType then
  13114. begin
  13115. if Params.Value is TParamsExpr then
  13116. begin
  13117. // e.g. Name()() or Name[]()
  13118. Include(ResolvedEl.Flags,rrfReadable);
  13119. end;
  13120. if rrfReadable in ResolvedEl.Flags then
  13121. begin
  13122. // call procvar
  13123. if rcConstant in Flags then
  13124. RaiseConstantExprExp(20170216152639,Params);
  13125. if ResolvedEl.LoTypeEl is TPasFunctionType then
  13126. // function call => return result
  13127. ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  13128. ResolvedEl,Flags+[rcCall],StartEl)
  13129. else
  13130. // procedure call, result is neither readable nor writable
  13131. SetResolverTypeExpr(ResolvedEl,btProc,
  13132. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,[]);
  13133. Include(ResolvedEl.Flags,rrfCanBeStatement);
  13134. end
  13135. else
  13136. begin
  13137. // typecast to proctype
  13138. if length(Params.Params)<>1 then
  13139. begin
  13140. {$IFDEF VerbosePasResolver}
  13141. writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
  13142. {$ENDIF}
  13143. RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
  13144. sWrongNumberOfParametersForTypeCast,[ResolvedEl.LoTypeEl.Name],Params);
  13145. end;
  13146. Param0:=Params.Params[0];
  13147. ComputeElement(Param0,ParamResolved,[]);
  13148. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  13149. ParamResolved,ResolvedEl,Flags);
  13150. end;
  13151. end
  13152. else if (DeclEl is TPasType) then
  13153. begin
  13154. // type cast
  13155. Param0:=Params.Params[0];
  13156. ComputeElement(Param0,ParamResolved,[]);
  13157. ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
  13158. ParamResolved,ResolvedEl,Flags);
  13159. end
  13160. else
  13161. RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
  13162. end;
  13163. end;
  13164. procedure TPasResolver.ComputeTypeCast(ToLoType, ToHiType: TPasType;
  13165. Param: TPasExpr; const ParamResolved: TPasResolverResult; out
  13166. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags);
  13167. function ParamIsVar: boolean;
  13168. var
  13169. IdentEl: TPasElement;
  13170. begin
  13171. IdentEl:=ParamResolved.IdentEl;
  13172. if IdentEl=nil then exit(false);
  13173. if [rcConstant,rcType]*Flags<>[] then
  13174. Result:=(IdentEl.ClassType=TPasConst) and (TPasConst(IdentEl).IsConst)
  13175. else
  13176. Result:=(IdentEl is TPasVariable)
  13177. or (IdentEl.ClassType=TPasArgument)
  13178. or (IdentEl.ClassType=TPasResultElement);
  13179. end;
  13180. var
  13181. WriteFlags: TPasResolverResultFlags;
  13182. KeepWriteFlags: Boolean;
  13183. bt: TResolverBaseType;
  13184. Expr: TPasExpr;
  13185. begin
  13186. {$IFDEF VerbosePasResolver}
  13187. writeln('TPasResolver.ComputeFuncParams START ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved));
  13188. {$ENDIF}
  13189. if ToLoType.CustomData is TResElDataBaseType then
  13190. begin
  13191. // type cast to base type (or alias of base type)
  13192. bt:=GetActualBaseType(TResElDataBaseType(ToLoType.CustomData).BaseType);
  13193. SetResolverValueExpr(ResolvedEl,
  13194. TResElDataBaseType(ToLoType.CustomData).BaseType,
  13195. ToLoType,ToHiType,
  13196. Param,[rrfReadable]);
  13197. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13198. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  13199. if (WriteFlags<>[]) and ParamIsVar then
  13200. begin
  13201. KeepWriteFlags:=false;
  13202. // Param is writable -> check if typecast keeps this
  13203. if (bt=btPointer) then
  13204. begin
  13205. // typecast to pointer
  13206. if (ParamResolved.BaseType=btPointer)
  13207. or (ParamResolved.BaseType in [btString,btUnicodeString,btWideString])
  13208. or (ParamResolved.LoTypeEl=nil) // untyped
  13209. or (ParamResolved.LoTypeEl.ClassType=TPasClassType)
  13210. or IsDynArray(ParamResolved.LoTypeEl)
  13211. then
  13212. // e.g. pointer(ObjVar)
  13213. KeepWriteFlags:=true;
  13214. end
  13215. else if IsSameType(ToLoType,ParamResolved.LoTypeEl,prraNone) then
  13216. // e.g. Byte(TAliasByte)
  13217. KeepWriteFlags:=true;
  13218. if KeepWriteFlags then
  13219. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  13220. end;
  13221. end
  13222. else if ToLoType is TPasProcedureType then
  13223. begin
  13224. // typecast to proctype
  13225. if ParamIsVar then
  13226. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable]
  13227. else
  13228. WriteFlags:=[];
  13229. SetResolverValueExpr(ResolvedEl,btContext,
  13230. ToLoType,ToHiType,
  13231. Param,[rrfReadable]+WriteFlags);
  13232. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13233. end
  13234. else
  13235. begin
  13236. // typecast to custom type, e.g. to classtype, recordtype, arraytype, range, set
  13237. if (Param.Parent is TParamsExpr) then
  13238. Expr:=TParamsExpr(Param.Parent)
  13239. else
  13240. Expr:=Param;
  13241. ComputeElement(ToHiType,ResolvedEl,Flags,Expr);
  13242. ResolvedEl.ExprEl:=Expr;
  13243. ResolvedEl.IdentEl:=ParamResolved.IdentEl;
  13244. ResolvedEl.Flags:=[rrfReadable];
  13245. WriteFlags:=ParamResolved.Flags*[rrfWritable,rrfAssignable];
  13246. if (WriteFlags<>[]) and ParamIsVar then
  13247. begin
  13248. KeepWriteFlags:=false;
  13249. if (rrfReadable in ResolvedEl.Flags) then
  13250. begin
  13251. // typecast a value
  13252. if ParamResolved.BaseType=btPointer then
  13253. begin
  13254. if (ToLoType.ClassType=TPasClassType)
  13255. or IsDynArray(ParamResolved.LoTypeEl) then
  13256. // aClassType(aPointer)
  13257. KeepWriteFlags:=true;
  13258. end
  13259. else if ParamResolved.LoTypeEl=nil then
  13260. // e.g. TAliasType(untyped)
  13261. KeepWriteFlags:=true
  13262. else if ToLoType=ParamResolved.LoTypeEl then
  13263. // e.g. TAliasType(ActualType)
  13264. KeepWriteFlags:=true
  13265. else if (ToLoType.ClassType=TPasClassType)
  13266. and (ParamResolved.LoTypeEl.ClassType=TPasClassType) then
  13267. begin
  13268. // e.g. aClassType(ObjVar)
  13269. if (TPasClassType(ToLoType).ObjKind<>TPasClassType(ParamResolved.LoTypeEl).ObjKind) then
  13270. // e.g. IntfType(ObjVar)
  13271. else
  13272. KeepWriteFlags:=true;
  13273. end
  13274. else if (ToLoType.ClassType=TPasRecordType)
  13275. and (ParamResolved.LoTypeEl.ClassType=TPasRecordType) then
  13276. // typecast record
  13277. KeepWriteFlags:=true
  13278. else if (ToLoType.ClassType=TPasArrayType)
  13279. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  13280. and IsDynArray(ToLoType)
  13281. and IsDynArray(ParamResolved.LoTypeEl) then
  13282. // typecast dyn array to dyn array
  13283. KeepWriteFlags:=true;
  13284. end
  13285. else
  13286. begin
  13287. // typecast a type to a value, e.g. Pointer(TObject)
  13288. end;
  13289. if KeepWriteFlags then
  13290. ResolvedEl.Flags:=ResolvedEl.Flags+WriteFlags;
  13291. end;
  13292. end;
  13293. {$IFDEF VerbosePasResolver}
  13294. writeln('TPasResolver.ComputeFuncParams END ToLoType=',GetObjName(ToLoType),' ',BoolToStr(ToLoType<>ToHiType,'ToHiType='+GetObjName(ToHiType),''),' ',GetResolverResultDbg(ParamResolved),' Result=',GetResolverResultDbg(ResolvedEl));
  13295. {$ENDIF}
  13296. end;
  13297. procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
  13298. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13299. StartEl: TPasElement);
  13300. // [param,param,...]
  13301. var
  13302. ParamResolved, FirstResolved: TPasResolverResult;
  13303. i: Integer;
  13304. Param: TPasExpr;
  13305. IsRange, IsArray: Boolean;
  13306. ArrayType: TPasArrayType;
  13307. begin
  13308. ArrayType:=IsArrayExpr(Params);
  13309. IsArray:=ArrayType<>nil;
  13310. if length(Params.Params)=0 then
  13311. begin
  13312. SetResolverValueExpr(ResolvedEl,btArrayOrSet,nil,nil,Params,[rrfReadable]);
  13313. if IsArray then
  13314. ResolvedEl.BaseType:=btArrayLit;
  13315. exit;
  13316. end;
  13317. FirstResolved:=Default(TPasResolverResult);
  13318. Flags:=Flags-[rcNoImplicitProc]+[rcNoImplicitProcType];
  13319. for i:=0 to length(Params.Params)-1 do
  13320. begin
  13321. Param:=Params.Params[i];
  13322. ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
  13323. IsRange:=ParamResolved.BaseType=btRange;
  13324. if IsRange then
  13325. begin
  13326. if IsArray then
  13327. RaiseXExpectedButYFound(20180615111713,'array value','range expression',Param);
  13328. ConvertRangeToElement(ParamResolved);
  13329. end;
  13330. if FirstResolved.BaseType=btNone then
  13331. begin
  13332. // first value -> check if type usable in a set/array
  13333. FirstResolved:=ParamResolved;
  13334. if IsRange then
  13335. CheckIsOrdinal(FirstResolved,Param,true);
  13336. if rrfReadable in FirstResolved.Flags then
  13337. begin
  13338. // has a value
  13339. if (not IsArray) and (not IsRange)
  13340. and (not CheckIsOrdinal(FirstResolved,Param,false)) then
  13341. begin
  13342. // can't be a set
  13343. IsArray:=true;
  13344. end;
  13345. end
  13346. else
  13347. begin
  13348. IsArray:=true;
  13349. if (FirstResolved.BaseType=btContext) then
  13350. begin
  13351. if FirstResolved.IdentEl is TPasClassType then
  13352. // array of classtypes
  13353. else
  13354. begin
  13355. {$IFDEF VerbosePasResolver}
  13356. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13357. {$ENDIF}
  13358. RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
  13359. end;
  13360. end
  13361. else
  13362. begin
  13363. {$IFDEF VerbosePasResolver}
  13364. writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
  13365. {$ENDIF}
  13366. RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
  13367. end;
  13368. end;
  13369. end
  13370. else
  13371. begin
  13372. // next value
  13373. CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
  13374. end;
  13375. end;
  13376. FirstResolved.IdentEl:=nil;
  13377. FirstResolved.ExprEl:=Params;
  13378. FirstResolved.SubType:=FirstResolved.BaseType;
  13379. if IsArray then
  13380. FirstResolved.BaseType:=btArrayLit
  13381. else
  13382. FirstResolved.BaseType:=btArrayOrSet;
  13383. FirstResolved.Flags:=[rrfReadable];
  13384. ResolvedEl:=FirstResolved;
  13385. end;
  13386. procedure TPasResolver.ComputeDereference(El: TUnaryExpr;
  13387. var ResolvedEl: TPasResolverResult);
  13388. procedure Deref(TypeEl: TPasType);
  13389. var
  13390. Expr: TPasExpr;
  13391. begin
  13392. Expr:=ResolvedEl.ExprEl;
  13393. if Expr=nil then
  13394. Expr:=El;
  13395. ComputeElement(TypeEl,ResolvedEl,[rcNoImplicitProc],El);
  13396. ResolvedEl.IdentEl:=nil;
  13397. ResolvedEl.ExprEl:=Expr;
  13398. ResolvedEl.Flags:=ResolvedEl.Flags+[rrfReadable,rrfWritable];
  13399. end;
  13400. var
  13401. TypeEl: TPasType;
  13402. begin
  13403. if ResolvedEl.BaseType=btPointer then
  13404. begin
  13405. Deref(ResolvedEl.LoTypeEl);
  13406. exit;
  13407. end
  13408. else if ResolvedEl.BaseType=btContext then
  13409. begin
  13410. TypeEl:=ResolvedEl.LoTypeEl;
  13411. if TypeEl.ClassType=TPasPointerType then
  13412. begin
  13413. Deref(TPasPointerType(TypeEl).DestType);
  13414. exit;
  13415. end;
  13416. end;
  13417. RaiseMsg(20180422191139,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  13418. [OpcodeStrings[eopDeref],GetResolverResultDescription(ResolvedEl)],El);
  13419. end;
  13420. procedure TPasResolver.ComputeArrayValuesExpectedType(El: TArrayValues; out
  13421. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13422. StartEl: TPasElement);
  13423. // (expr, expr, ...)
  13424. var
  13425. Parent: TPasElement;
  13426. HiTypeEl, LoTypeEl: TPasType;
  13427. Field: PRecordValuesItem;
  13428. Ref: TResolvedReference;
  13429. Member: TPasVariable;
  13430. i: Integer;
  13431. ArrType: TPasArrayType;
  13432. begin
  13433. Parent:=El.Parent;
  13434. if Parent is TPasVariable then
  13435. begin
  13436. HiTypeEl:=TPasVariable(Parent).VarType;
  13437. if HiTypeEl=nil then
  13438. RaiseMsg(20180429171628,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13439. ['const','array values'],El);
  13440. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13441. if LoTypeEl.ClassType=TPasArrayType then
  13442. // ok
  13443. else
  13444. RaiseIncompatibleTypeDesc(20180429171714,nIncompatibleTypesGotExpected,
  13445. [],'array value',GetTypeDescription(HiTypeEl),El);
  13446. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13447. El,[rrfReadable]);
  13448. end
  13449. else if Parent.ClassType=TRecordValues then
  13450. begin
  13451. // record field array
  13452. // get field
  13453. i:=length(TRecordValues(Parent).Fields)-1;
  13454. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13455. dec(i);
  13456. if i<0 then
  13457. RaiseInternalError(20180429181150);
  13458. Field:=@TRecordValues(Parent).Fields[i];
  13459. // get member
  13460. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13461. Member:=Ref.Declaration as TPasVariable;
  13462. if Member=nil then
  13463. RaiseInternalError(20180429181210);
  13464. ComputeElement(Member,ResolvedEl,[],StartEl);
  13465. ResolvedEl.Flags:=[rrfReadable];
  13466. end
  13467. else if Parent.ClassType=TArrayValues then
  13468. begin
  13469. // array of array
  13470. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13471. if (ResolvedEl.BaseType=btContext)
  13472. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13473. begin
  13474. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13475. if length(ArrType.Ranges)>1 then
  13476. RaiseNotYetImplemented(20180429180930,El);
  13477. HiTypeEl:=ArrType.ElType;
  13478. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13479. if LoTypeEl.ClassType<>TPasArrayType then
  13480. RaiseIncompatibleTypeDesc(20180429180938,nIncompatibleTypesGotExpected,
  13481. [],'array values',GetTypeDescription(HiTypeEl),El);
  13482. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13483. El,[rrfReadable]);
  13484. end
  13485. else
  13486. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13487. [],'array values',GetTypeDescription(ResolvedEl),El);
  13488. end
  13489. else
  13490. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable]);
  13491. end;
  13492. procedure TPasResolver.ComputeRecordValues(El: TRecordValues; out
  13493. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  13494. StartEl: TPasElement);
  13495. // (name:expr; name:expr; ...)
  13496. var
  13497. Parent, Member: TPasElement;
  13498. LoTypeEl, HiTypeEl: TPasType;
  13499. i: Integer;
  13500. Field: PRecordValuesItem;
  13501. Ref: TResolvedReference;
  13502. ArrType: TPasArrayType;
  13503. begin
  13504. Parent:=El.Parent;
  13505. if Parent is TPasVariable then
  13506. begin
  13507. HiTypeEl:=TPasVariable(Parent).VarType;
  13508. if HiTypeEl=nil then
  13509. RaiseMsg(20180429105451,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13510. ['const','record values'],El);
  13511. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13512. if LoTypeEl.ClassType<>TPasRecordType then
  13513. RaiseIncompatibleTypeDesc(20180429104135,nIncompatibleTypesGotExpected,
  13514. [],'record value',GetTypeDescription(HiTypeEl),El);
  13515. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13516. El,[rrfReadable]);
  13517. end
  13518. else if Parent.ClassType=TRecordValues then
  13519. begin
  13520. // nested record
  13521. // get field
  13522. i:=length(TRecordValues(Parent).Fields)-1;
  13523. while (i>=0) and (TRecordValues(Parent).Fields[i].ValueExp<>El) do
  13524. dec(i);
  13525. if i<0 then
  13526. RaiseInternalError(20180429130244);
  13527. Field:=@TRecordValues(Parent).Fields[i];
  13528. // get member
  13529. Ref:=Field^.NameExp.CustomData as TResolvedReference;
  13530. Member:=Ref.Declaration as TPasVariable;
  13531. if Member=nil then
  13532. RaiseInternalError(20180429130548);
  13533. ComputeElement(Member,ResolvedEl,[],StartEl);
  13534. ResolvedEl.Flags:=[rrfReadable];
  13535. end
  13536. else if Parent.ClassType=TArrayValues then
  13537. begin
  13538. // array of record
  13539. ComputeArrayValuesExpectedType(TArrayValues(Parent),ResolvedEl,Flags,StartEl);
  13540. if (ResolvedEl.BaseType=btContext)
  13541. and (ResolvedEl.LoTypeEl.ClassType=TPasArrayType) then
  13542. begin
  13543. ArrType:=TPasArrayType(ResolvedEl.LoTypeEl);
  13544. if length(ArrType.Ranges)>1 then
  13545. RaiseNotYetImplemented(20180429180450,El);
  13546. HiTypeEl:=ArrType.ElType;
  13547. LoTypeEl:=ResolveAliasType(HiTypeEl);
  13548. if LoTypeEl.ClassType<>TPasRecordType then
  13549. RaiseIncompatibleTypeDesc(20180429180642,nIncompatibleTypesGotExpected,
  13550. [],'record values',GetTypeDescription(HiTypeEl),El);
  13551. SetResolverValueExpr(ResolvedEl,btContext,LoTypeEl,HiTypeEl,
  13552. El,[rrfReadable]);
  13553. end
  13554. else
  13555. RaiseIncompatibleTypeDesc(20180429173143,nIncompatibleTypesGotExpected,
  13556. [],'array values',GetTypeDescription(ResolvedEl),El);
  13557. end
  13558. else
  13559. RaiseMsg(20180429110227,nSyntaxErrorExpectedButFound,sSyntaxErrorExpectedButFound,
  13560. ['const','(name:'],El);
  13561. end;
  13562. procedure TPasResolver.CheckIsClass(El: TPasElement;
  13563. const ResolvedEl: TPasResolverResult);
  13564. var
  13565. TypeEl: TPasType;
  13566. begin
  13567. if (ResolvedEl.BaseType<>btContext) then
  13568. RaiseXExpectedButYFound(20170216152245,'class',BaseTypeNames[ResolvedEl.BaseType],El);
  13569. TypeEl:=ResolvedEl.LoTypeEl;
  13570. if (TypeEl.ClassType<>TPasClassType)
  13571. or (TPasClassType(TypeEl).ObjKind<>okClass) then
  13572. RaiseXExpectedButYFound(20170216152246,'class',GetElementTypeName(ResolvedEl.LoTypeEl),El);
  13573. end;
  13574. function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
  13575. ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
  13576. // called when type casting a class instance into an unrelated class
  13577. begin
  13578. if FromClassRes.BaseType=btNone then ;
  13579. if ToClassRes.BaseType=btNone then ;
  13580. if ErrorEl=nil then ;
  13581. Result:=cIncompatible;
  13582. end;
  13583. procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
  13584. const LHS, RHS: TPasResolverResult);
  13585. var
  13586. LBT, RBT: TResolverBaseType;
  13587. begin
  13588. // check both are values
  13589. if not (rrfReadable in LHS.Flags) then
  13590. begin
  13591. if LHS.LoTypeEl<>nil then
  13592. RaiseXExpectedButYFound(20170216152645,'ordinal',GetElementTypeName(LHS.LoTypeEl),Left)
  13593. else
  13594. RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13595. end;
  13596. if not (rrfReadable in RHS.Flags) then
  13597. begin
  13598. if RHS.LoTypeEl<>nil then
  13599. RaiseXExpectedButYFound(20170216152651,'ordinal',GetElementTypeName(RHS.LoTypeEl),Right)
  13600. else
  13601. RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
  13602. end;
  13603. // check both have the same ordinal type
  13604. LBT:=GetActualBaseType(LHS.BaseType);
  13605. RBT:=GetActualBaseType(RHS.BaseType);
  13606. if LBT in btAllBooleans then
  13607. begin
  13608. if RBT in btAllBooleans then
  13609. exit;
  13610. RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13611. end
  13612. else if LBT in btAllInteger then
  13613. begin
  13614. if RBT in btAllInteger then
  13615. exit;
  13616. RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
  13617. end
  13618. else if LBT in btAllChars then
  13619. begin
  13620. if RBT in btAllChars then
  13621. exit;
  13622. RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
  13623. end
  13624. else if LBT=btContext then
  13625. begin
  13626. if LHS.LoTypeEl.ClassType=TPasEnumType then
  13627. begin
  13628. if LHS.LoTypeEl=RHS.LoTypeEl then
  13629. exit;
  13630. if RHS.LoTypeEl.ClassType<>TPasEnumType then
  13631. RaiseXExpectedButYFound(20170216152707,LHS.LoTypeEl.Parent.Name,GetElementTypeName(RHS.LoTypeEl),Right);
  13632. if LHS.LoTypeEl.Parent<>RHS.LoTypeEl.Parent then
  13633. RaiseXExpectedButYFound(20170216152710,LHS.LoTypeEl.Parent.Name,RHS.LoTypeEl.Parent.Name,Right);
  13634. end
  13635. else
  13636. RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13637. end
  13638. else
  13639. RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
  13640. end;
  13641. function TPasResolver.CheckIsOrdinal(
  13642. const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
  13643. RaiseOnError: boolean): boolean;
  13644. begin
  13645. Result:=false;
  13646. if ResolvedEl.BaseType in btAllRanges then
  13647. else if (ResolvedEl.BaseType=btContext) then
  13648. begin
  13649. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  13650. else if RaiseOnError then
  13651. RaiseXExpectedButYFound(20170216152718,'ordinal value',GetElementTypeName(ResolvedEl.LoTypeEl),ErrorEl)
  13652. else
  13653. exit;
  13654. end
  13655. else if RaiseOnError then
  13656. RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
  13657. else
  13658. exit;
  13659. Result:=true;
  13660. end;
  13661. procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
  13662. var LHS: TPasResolverResult; const RHS: TPasResolverResult);
  13663. // LHS defines the array element type
  13664. // check if RHS
  13665. var
  13666. LBT, RBT: TResolverBaseType;
  13667. C: TClass;
  13668. begin
  13669. if (LHS.LoTypeEl=RHS.LoTypeEl) and (LHS.BaseType=RHS.BaseType) then
  13670. exit; // exact same type
  13671. LBT:=GetActualBaseType(LHS.BaseType);
  13672. RBT:=GetActualBaseType(RHS.BaseType);
  13673. if rrfReadable in LHS.Flags then
  13674. begin
  13675. if not (rrfReadable in RHS.Flags) then
  13676. RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
  13677. [],RHS,LHS,Right);
  13678. // array of values
  13679. if LBT in btAllBooleans then
  13680. begin
  13681. if RBT in btAllBooleans then
  13682. begin
  13683. LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
  13684. exit;
  13685. end;
  13686. RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
  13687. end
  13688. else if LBT in btAllInteger then
  13689. begin
  13690. if RBT in btAllInteger then
  13691. begin
  13692. LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
  13693. exit;
  13694. end;
  13695. RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
  13696. end
  13697. else if LBT in btAllChars then
  13698. begin
  13699. if RBT in btAllChars then
  13700. begin
  13701. LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
  13702. exit;
  13703. end;
  13704. RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
  13705. end
  13706. else if LBT in btAllStrings then
  13707. begin
  13708. if RBT in btAllStringAndChars then
  13709. begin
  13710. LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
  13711. exit;
  13712. end;
  13713. RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
  13714. end
  13715. else if LBT=btNil then
  13716. begin
  13717. if RBT=btNil then
  13718. exit
  13719. else if RBT=btPointer then
  13720. begin
  13721. LHS:=RHS;
  13722. exit;
  13723. end
  13724. else if RBT=btContext then
  13725. begin
  13726. C:=RHS.LoTypeEl.ClassType;
  13727. if (C=TPasClassType)
  13728. or (C=TPasClassOfType)
  13729. or (C=TPasPointerType)
  13730. or ((C=TPasArrayType) and IsDynArray(RHS.LoTypeEl))
  13731. or (C=TPasProcedureType)
  13732. or (C=TPasFunctionType) then
  13733. begin
  13734. LHS:=RHS;
  13735. exit;
  13736. end;
  13737. end;
  13738. end
  13739. else if LBT=btContext then
  13740. begin
  13741. C:=LHS.LoTypeEl.ClassType;
  13742. if C=TPasEnumType then
  13743. begin
  13744. if LHS.LoTypeEl=RHS.LoTypeEl then
  13745. exit;
  13746. end
  13747. else if C=TPasClassType then
  13748. begin
  13749. // array of class instances
  13750. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13751. RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
  13752. [],RHS,LHS,Right);
  13753. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13754. begin
  13755. // right class type is a left class type -> ok
  13756. exit;
  13757. end
  13758. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13759. begin
  13760. // left class type is a right class type -> right is the new base class type
  13761. LHS:=RHS;
  13762. exit;
  13763. end;
  13764. end;
  13765. end;
  13766. end
  13767. else
  13768. begin
  13769. // array of types
  13770. if rrfReadable in RHS.Flags then
  13771. RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
  13772. [],RHS,LHS,Right);
  13773. if LBT=btContext then
  13774. begin
  13775. if LHS.LoTypeEl.ClassType=TPasClassType then
  13776. begin
  13777. // array of class type
  13778. if RHS.LoTypeEl.ClassType<>TPasClassType then
  13779. RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
  13780. [],RHS,LHS,Right);
  13781. if CheckClassIsClass(LHS.LoTypeEl,RHS.LoTypeEl)<cIncompatible then
  13782. begin
  13783. // right class type is a left class type -> ok
  13784. exit;
  13785. end
  13786. else if CheckClassIsClass(RHS.LoTypeEl,LHS.LoTypeEl)<cIncompatible then
  13787. begin
  13788. // left class type is a right class type -> right is the new base class type
  13789. LHS:=RHS;
  13790. exit;
  13791. end;
  13792. end;
  13793. end;
  13794. end;
  13795. // can't combine
  13796. if LHS.LoTypeEl=nil then
  13797. RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
  13798. if RHS.LoTypeEl=nil then
  13799. RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
  13800. RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
  13801. [],RHS,LHS,Right);
  13802. end;
  13803. procedure TPasResolver.ConvertRangeToElement(
  13804. var ResolvedEl: TPasResolverResult);
  13805. var
  13806. TypeEl: TPasType;
  13807. begin
  13808. if ResolvedEl.BaseType<>btRange then
  13809. RaiseInternalError(20161001155732);
  13810. if ResolvedEl.LoTypeEl=nil then
  13811. if ResolvedEl.IdentEl<>nil then
  13812. RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
  13813. else
  13814. RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
  13815. TypeEl:=ResolvedEl.LoTypeEl;
  13816. if TypeEl is TPasRangeType then
  13817. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant])
  13818. else
  13819. begin
  13820. ResolvedEl.BaseType:=ResolvedEl.SubType;
  13821. ResolvedEl.SubType:=btNone;
  13822. end;
  13823. end;
  13824. function TPasResolver.IsCharLiteral(const Value: string; ErrorPos: TPasElement
  13825. ): TResolverBaseType;
  13826. // returns true if Value is a Pascal char literal
  13827. // btAnsiChar: #65, #$50, ^G, 'a'
  13828. // btWideChar: #10000, 'ä'
  13829. var
  13830. i: SizeInt;
  13831. p, base, l: Integer;
  13832. begin
  13833. Result:=btNone;
  13834. //writeln('TPasResolver.IsCharLiteral ',BaseTypeChar,' "',Value,'" l=',length(Value));
  13835. l:=length(Value);
  13836. if l=0 then exit;
  13837. p:=1;
  13838. case Value[1] of
  13839. '''':
  13840. begin
  13841. inc(p);
  13842. if p>l then exit;
  13843. {$ifdef FPC_HAS_CPSTRING}
  13844. case Value[2] of
  13845. '''':
  13846. if Value='''''''''' then
  13847. Result:=btAnsiChar; // ''''
  13848. #32..#38,#40..#191:
  13849. if (l=3) and (Value[3]='''') then
  13850. Result:=btAnsiChar; // e.g. 'a'
  13851. #192..#255:
  13852. if BaseTypeChar=btWideChar then
  13853. begin
  13854. // default char is widechar: UTF-8 'ä' is a widechar
  13855. i:=Utf8CodePointLen(@Value[2],4,false);
  13856. //writeln('TPasResolver.IsCharLiteral "',Value,'" ',length(Value),' i=',i);
  13857. if i<2 then
  13858. exit;
  13859. p:=2+i;
  13860. if (p=l) and (Value[p]='''') then
  13861. // single UTF-8 codepoint
  13862. Result:=btWideChar;
  13863. end;
  13864. end;
  13865. {$else}
  13866. case Value[p] of
  13867. '''':
  13868. if (p+2=l) and (Value[p+1]='''') and (Value[p+2]='''') then
  13869. Result:=btWideChar; // ''''
  13870. #$DC00..#$DFFF: ;
  13871. else
  13872. if (l=3) and (Value[3]='''') then
  13873. Result:=btWideChar; // e.g. 'a'
  13874. end;
  13875. {$endif}
  13876. end;
  13877. '#':
  13878. begin
  13879. inc(p);
  13880. if p>l then exit;
  13881. case Value[p] of
  13882. '$': begin base:=16; inc(p); end;
  13883. '&': begin base:=8; inc(p); end;
  13884. '%': begin base:=2; inc(p); end;
  13885. '0'..'9': base:=10;
  13886. else RaiseNotYetImplemented(20170728142709,ErrorPos);
  13887. end;
  13888. i:=0;
  13889. while p<=l do
  13890. begin
  13891. case Value[p] of
  13892. '0'..'9': i:=i*base+ord(Value[p])-ord('0');
  13893. 'A'..'Z': i:=i*base+ord(Value[p])-ord('A')+10;
  13894. 'a'..'z': i:=i*base+ord(Value[p])-ord('a')+10;
  13895. end;
  13896. inc(p);
  13897. end;
  13898. if p>l then
  13899. begin
  13900. {$ifdef FPC_HAS_CPSTRING}
  13901. if i<256 then
  13902. Result:=btAnsiChar
  13903. else
  13904. {$endif}
  13905. Result:=btWideChar;
  13906. end;
  13907. end;
  13908. '^':
  13909. begin
  13910. if (l=2) and (Value[2] in ['a'..'z','A'..'Z']) then
  13911. Result:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  13912. end;
  13913. end;
  13914. if Result in [{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar] then
  13915. begin
  13916. if FBaseTypes[Result]=nil then
  13917. begin
  13918. {$ifdef FPC_HAS_CPSTRING}
  13919. if Result=btAnsiChar then
  13920. Result:=btWideChar
  13921. else
  13922. {$endif}
  13923. Result:=btChar;
  13924. end;
  13925. if Result=BaseTypeChar then
  13926. Result:=btChar;
  13927. end;
  13928. end;
  13929. function TPasResolver.CheckForIn(Loop: TPasImplForLoop; const VarResolved,
  13930. InResolved: TPasResolverResult): boolean;
  13931. begin
  13932. Result:=false;
  13933. if Loop=nil then ;
  13934. if VarResolved.BaseType=btCustom then ;
  13935. if InResolved.BaseType=btCustom then ;
  13936. end;
  13937. function TPasResolver.CheckForInClassOrRec(Loop: TPasImplForLoop; const VarResolved,
  13938. InResolved: TPasResolverResult): boolean;
  13939. var
  13940. LoTypeEl: TPasType;
  13941. EnumeratorClass: TPasClassType;
  13942. EnumeratorScope: TPasDotClassScope;
  13943. Getter, MoveNext, Current: TPasIdentifier;
  13944. GetterFunc, MoveNextFunc: TPasFunction;
  13945. ptm: TProcTypeModifier;
  13946. ResultResolved, MoveNextResolved, CurrentResolved: TPasResolverResult;
  13947. CurrentProp: TPasProperty;
  13948. ForScope: TPasForLoopScope;
  13949. DotScope: TPasDotBaseScope;
  13950. begin
  13951. Result:=false;
  13952. if InResolved.IdentEl is TPasType then
  13953. RaiseMsg(20190120180525,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  13954. [GetBaseDescription(InResolved)],Loop.StartExpr);
  13955. if not (rrfReadable in InResolved.Flags) then
  13956. RaiseMsg(20171221195421,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType,
  13957. [GetBaseDescription(InResolved)],Loop.StartExpr);
  13958. LoTypeEl:=InResolved.LoTypeEl;
  13959. if LoTypeEl=nil then exit;
  13960. // check function InVar.GetEnumerator
  13961. DotScope:=PushDotScope(InResolved.HiTypeEl);
  13962. if DotScope=nil then
  13963. exit;
  13964. // find aRecord.GetEnumerator
  13965. Getter:=DotScope.FindIdentifier('GetEnumerator');
  13966. PopScope;
  13967. if Getter=nil then
  13968. begin
  13969. if LoTypeEl is TPasMembersType then
  13970. RaiseIdentifierNotFound(20171221191511,'GetEnumerator',Loop.StartExpr)
  13971. else
  13972. exit;
  13973. end;
  13974. // check is function
  13975. if Getter.Element.ClassType<>TPasFunction then
  13976. RaiseContextXExpectedButYFound(20171221191638,'GetEnumerator','function',GetElementTypeName(Getter.Element),Loop.StartExpr);
  13977. GetterFunc:=TPasFunction(Getter.Element);
  13978. // check visibility
  13979. if not (GetterFunc.Visibility in [visPublic,visPublished]) then
  13980. RaiseContextXExpectedButYFound(20171221191824,'function GetEnumerator','public',VisibilityNames[GetterFunc.Visibility],Loop.StartExpr);
  13981. // check arguments
  13982. if GetterFunc.FuncType.Args.Count>0 then
  13983. RaiseContextXExpectedButYFound(20171221191944,'function GetEnumerator','no arguments',IntToStr(GetterFunc.ProcType.Args.Count),Loop.StartExpr);
  13984. // check proc type modifiers
  13985. for ptm in GetterFunc.ProcType.Modifiers do
  13986. if not (ptm in [ptmOfObject]) then
  13987. RaiseContextXInvalidY(20171221193455,'function GetEnumerator','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  13988. // check result type
  13989. ComputeResultElement(GetterFunc.FuncType.ResultEl,ResultResolved,[rcCall]);
  13990. if (ResultResolved.BaseType<>btContext) then
  13991. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved),Loop.StartExpr);
  13992. LoTypeEl:=ResultResolved.LoTypeEl;
  13993. if not (LoTypeEl is TPasClassType) then
  13994. RaiseContextXExpectedButYFound(20171221193749,'function GetEnumerator','result class',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  13995. if not (rrfReadable in ResultResolved.Flags) then
  13996. RaiseContextXExpectedButYFound(20171221195506,'function GetEnumerator','result class instance',GetTypeDescription(ResultResolved.LoTypeEl),Loop.StartExpr);
  13997. // find function MoveNext: boolean in Enumerator class
  13998. EnumeratorClass:=TPasClassType(LoTypeEl);
  13999. EnumeratorScope:=PushClassDotScope(EnumeratorClass);
  14000. MoveNext:=EnumeratorScope.FindIdentifier('MoveNext');
  14001. if MoveNext=nil then
  14002. RaiseIdentifierNotFound(20171221195632,'MoveNext',Loop.StartExpr);
  14003. // check is function
  14004. if MoveNext.Element.ClassType<>TPasFunction then
  14005. RaiseContextXExpectedButYFound(20171221195651,'MoveNext','function',GetElementTypeName(MoveNext.Element),Loop.StartExpr);
  14006. MoveNextFunc:=TPasFunction(MoveNext.Element);
  14007. // check visibility
  14008. if not (MoveNextFunc.Visibility in [visPublic,visPublished]) then
  14009. RaiseContextXExpectedButYFound(20171221195712,'function MoveNext','public',VisibilityNames[MoveNextFunc.Visibility],Loop.StartExpr);
  14010. // check arguments
  14011. if MoveNextFunc.FuncType.Args.Count>0 then
  14012. RaiseContextXExpectedButYFound(20171221195723,'function MoveNext','no arguments',IntToStr(MoveNextFunc.ProcType.Args.Count),Loop.StartExpr);
  14013. // check proc type modifiers
  14014. for ptm in MoveNextFunc.ProcType.Modifiers do
  14015. if not (ptm in [ptmOfObject]) then
  14016. RaiseContextXInvalidY(20171221195732,'function MoveNext','modifier '+ProcTypeModifiers[ptm],Loop.StartExpr);
  14017. // check result type
  14018. ComputeResultElement(MoveNextFunc.FuncType.ResultEl,MoveNextResolved,[rcCall]);
  14019. if not (MoveNextResolved.BaseType in btAllBooleans) then
  14020. RaiseContextXExpectedButYFound(20171221200337,'function MoveNext','result boolean',GetTypeDescription(MoveNextResolved),Loop.StartExpr);
  14021. // check property Current
  14022. Current:=EnumeratorScope.FindIdentifier('Current');
  14023. if Current=nil then
  14024. RaiseIdentifierNotFound(20171221200433,'Current',Loop.StartExpr);
  14025. // check is property
  14026. if Current.Element.ClassType<>TPasProperty then
  14027. RaiseContextXExpectedButYFound(20171221200508,'Current','property',GetElementTypeName(Current.Element),Loop.StartExpr);
  14028. CurrentProp:=TPasProperty(Current.Element);
  14029. // check visibility
  14030. if not (CurrentProp.Visibility in [visPublic,visPublished]) then
  14031. RaiseContextXExpectedButYFound(20171221200546,'property Current','public',VisibilityNames[CurrentProp.Visibility],Loop.StartExpr);
  14032. // check arguments
  14033. if CurrentProp.Args.Count>0 then
  14034. RaiseContextXExpectedButYFound(20171221200638,'property Current','no arguments',IntToStr(CurrentProp.Args.Count),Loop.StartExpr);
  14035. // check readable
  14036. if GetPasPropertyGetter(CurrentProp)=nil then
  14037. RaiseContextXInvalidY(20171221200823,'property Current','read accessor',Loop.StartExpr);
  14038. // check result type fits for-loop variable
  14039. ComputeElement(CurrentProp,CurrentResolved,[rcType]);
  14040. if CheckAssignResCompatibility(VarResolved,CurrentResolved,Loop.VariableName,false)=cIncompatible then
  14041. RaiseIncompatibleTypeRes(20171221200018,nIncompatibleTypesGotExpected,[],VarResolved,CurrentResolved,Loop.VariableName);
  14042. PopScope; // pop EnumeratorScope
  14043. ForScope:=Loop.CustomData as TPasForLoopScope;
  14044. ForScope.GetEnumerator:=GetterFunc;
  14045. ForScope.MoveNext:=MoveNextFunc;
  14046. ForScope.Current:=CurrentProp;
  14047. Result:=true;
  14048. end;
  14049. function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
  14050. Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
  14051. begin
  14052. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
  14053. begin
  14054. if RaiseOnError then
  14055. RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
  14056. sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
  14057. exit(false);
  14058. end;
  14059. Result:=true;
  14060. end;
  14061. function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
  14062. Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean;
  14063. Signature: string): integer;
  14064. begin
  14065. if length(Params.Params)>MaxCount then
  14066. begin
  14067. if RaiseOnError then
  14068. begin
  14069. if Signature='' then Signature:=Proc.Signature;
  14070. RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
  14071. sWrongNumberOfParametersForCallTo,[Signature],Params.Params[MaxCount]);
  14072. end;
  14073. exit(cIncompatible);
  14074. end;
  14075. Result:=cExact;
  14076. end;
  14077. function TPasResolver.CheckRaiseTypeArgNo(id: TMaxPrecInt; ArgNo: integer;
  14078. Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
  14079. RaiseOnError: boolean): integer;
  14080. begin
  14081. if RaiseOnError then
  14082. RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  14083. [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
  14084. Result:=cIncompatible;
  14085. end;
  14086. function TPasResolver.FindUsedUnitnameInSection(const aName: string; Section: TPasSection): TPasModule;
  14087. var
  14088. Clause: TPasUsesClause;
  14089. i: Integer;
  14090. Use: TPasUsesUnit;
  14091. ModName: String;
  14092. begin
  14093. Result:=nil;
  14094. if (Section=nil) then exit;
  14095. Clause:=Section.UsesClause;
  14096. for i:=0 to length(Clause)-1 do
  14097. begin
  14098. Use:=Clause[i];
  14099. if (Use.Module=nil) or not (Use.Module is TPasModule) then continue;
  14100. ModName:=Use.Module.Name;
  14101. if CompareText(ModName,aName)=0 then
  14102. exit(TPasModule(Use.Module));
  14103. end;
  14104. end;
  14105. function TPasResolver.FindUsedUnitname(const aName: string; aMod: TPasModule): TPasModule;
  14106. var
  14107. C: TClass;
  14108. begin
  14109. C:=aMod.ClassType;
  14110. if C.InheritsFrom(TPasProgram) then
  14111. Result:=FindUsedUnitnameInSection(aName,TPasProgram(aMod).ProgramSection)
  14112. else if C.InheritsFrom(TPasLibrary) then
  14113. Result:=FindUsedUnitnameInSection(aName,TPasLibrary(aMod).LibrarySection)
  14114. else
  14115. begin
  14116. Result:=FindUsedUnitnameInSection(aName,aMod.InterfaceSection);
  14117. if Result<>nil then exit;
  14118. Result:=FindUsedUnitnameInSection(aName,aMod.ImplementationSection);
  14119. end
  14120. end;
  14121. procedure TPasResolver.FinishAssertCall(Proc: TResElDataBuiltInProc;
  14122. Params: TParamsExpr);
  14123. var
  14124. aMod: TPasModule;
  14125. ModScope: TPasModuleScope;
  14126. aConstructor: TPasConstructor;
  14127. begin
  14128. if Proc=nil then ;
  14129. aMod:=RootElement;
  14130. ModScope:=aMod.CustomData as TPasModuleScope;
  14131. if not (pmsfAssertSearched in ModScope.Flags) then
  14132. FindAssertExceptionConstructors(nil); // no ErrorEl
  14133. if ModScope.AssertClass=nil then exit;
  14134. if length(Params.Params)>1 then
  14135. aConstructor:=ModScope.AssertMsgConstructor
  14136. else
  14137. aConstructor:=ModScope.AssertDefConstructor;
  14138. if aConstructor=nil then exit;
  14139. CreateReference(aConstructor,Params,rraRead);
  14140. end;
  14141. function TPasResolver.FindSystemIdentifier(const aUnitName, aName: string;
  14142. ErrorEl: TPasElement): TPasElement;
  14143. var
  14144. aMod, UtilsMod: TPasModule;
  14145. SectionScope: TPasSectionScope;
  14146. Identifier: TPasIdentifier;
  14147. begin
  14148. Result:=nil;
  14149. // find unit in uses clauses
  14150. aMod:=RootElement;
  14151. UtilsMod:=FindUsedUnitname(aUnitName,aMod);
  14152. if UtilsMod=nil then
  14153. if ErrorEl<>nil then
  14154. RaiseIdentifierNotFound(20200523224738,'unit '+aUnitName,ErrorEl)
  14155. else
  14156. exit;
  14157. // find class in interface
  14158. if UtilsMod.InterfaceSection=nil then
  14159. if ErrorEl<>nil then
  14160. RaiseIdentifierNotFound(20200523224831,aUnitName+'.'+aName,ErrorEl)
  14161. else
  14162. exit;
  14163. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  14164. Identifier:=SectionScope.FindLocalIdentifier(aName);
  14165. if Identifier=nil then
  14166. if ErrorEl<>nil then
  14167. RaiseIdentifierNotFound(20200523224841,aUnitName+'.'+aName,ErrorEl)
  14168. else
  14169. exit;
  14170. Result:=Identifier.Element;
  14171. end;
  14172. function TPasResolver.FindSystemClassType(const aUnitName, aClassName: string;
  14173. ErrorEl: TPasElement): TPasClassType;
  14174. var
  14175. El: TPasElement;
  14176. begin
  14177. Result:=nil;
  14178. El:=FindSystemIdentifier(aUnitName,aClassName,ErrorEl);
  14179. if not (El is TPasClassType) then
  14180. if ErrorEl<>nil then
  14181. RaiseXExpectedButYFound(20180119172517,'class '+aClassName,GetElementTypeName(El),ErrorEl)
  14182. else
  14183. exit;
  14184. Result:=TPasClassType(El);
  14185. if Result.IsForward then
  14186. if ErrorEl<>nil then
  14187. RaiseXExpectedButYFound(20200523225546,'class '+aClassName,'forward '+GetTypeDescription(Result,true),ErrorEl)
  14188. else
  14189. exit;
  14190. if Result.ObjKind<>okClass then
  14191. if ErrorEl<>nil then
  14192. RaiseXExpectedButYFound(20180321163200,'class '+aClassName,GetTypeDescription(Result,true),ErrorEl)
  14193. else
  14194. exit;
  14195. end;
  14196. function TPasResolver.FindSystemClassTypeAndConstructor(const aUnitName,
  14197. aClassName: string; out aClass: TPasClassType; out
  14198. aConstructor: TPasConstructor; ErrorEl: TPasElement): boolean;
  14199. var
  14200. Identifier: TPasIdentifier;
  14201. ClassScope: TPasClassScope;
  14202. begin
  14203. Result:=false;
  14204. aClass:=nil;
  14205. aConstructor:=nil;
  14206. aClass:=FindSystemClassType(aUnitName,aClassName,ErrorEl);
  14207. if aClass=nil then exit;
  14208. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  14209. repeat
  14210. Identifier:=ClassScope.FindIdentifier('create');
  14211. while Identifier<>nil do
  14212. begin
  14213. if Identifier.Element.ClassType=TPasConstructor then
  14214. begin
  14215. aConstructor:=TPasConstructor(Identifier.Element);
  14216. if aConstructor.ProcType.Args.Count=0 then
  14217. exit(true);
  14218. end;
  14219. Identifier:=Identifier.NextSameIdentifier;
  14220. end;
  14221. ClassScope:=ClassScope.AncestorScope;
  14222. until ClassScope=nil;
  14223. aConstructor:=nil;
  14224. if ErrorEl<>nil then
  14225. RaiseIdentifierNotFound(20200523224856,'constructor '+aClassName,ErrorEl);
  14226. end;
  14227. procedure TPasResolver.FindAssertExceptionConstructors(ErrorEl: TPasElement);
  14228. var
  14229. aMod: TPasModule;
  14230. ModScope: TPasModuleScope;
  14231. Identifier: TPasIdentifier;
  14232. aClass: TPasClassType;
  14233. ClassScope: TPasClassScope;
  14234. aConstructor: TPasConstructor;
  14235. Arg: TPasArgument;
  14236. ArgResolved: TPasResolverResult;
  14237. begin
  14238. aMod:=RootElement;
  14239. ModScope:=aMod.CustomData as TPasModuleScope;
  14240. if pmsfAssertSearched in ModScope.Flags then exit;
  14241. Include(ModScope.Flags,pmsfAssertSearched);
  14242. FindSystemClassTypeAndConstructor('sysutils','EAssertionFailed',aClass,aConstructor,ErrorEl);
  14243. if aClass=nil then
  14244. exit;
  14245. ClassScope:=NoNil(aClass.CustomData) as TPasClassScope;
  14246. ModScope.AssertClass:=aClass;
  14247. repeat
  14248. Identifier:=ClassScope.FindIdentifier('create');
  14249. while Identifier<>nil do
  14250. begin
  14251. if Identifier.Element.ClassType=TPasConstructor then
  14252. begin
  14253. aConstructor:=TPasConstructor(Identifier.Element);
  14254. //writeln('TPasResolver.FindAssertExceptionConstructors ',aConstructor.Name,' ',aConstructor.ProcType.Args.Count);
  14255. if aConstructor.ProcType.Args.Count=0 then
  14256. begin
  14257. if ModScope.AssertDefConstructor=nil then
  14258. ModScope.AssertDefConstructor:=aConstructor;
  14259. end
  14260. else if aConstructor.ProcType.Args.Count=1 then
  14261. begin
  14262. if ModScope.AssertMsgConstructor=nil then
  14263. begin
  14264. Arg:=TPasArgument(aConstructor.ProcType.Args[0]);
  14265. //writeln('TPasResolver.FindAssertExceptionConstructors ',GetObjName(Arg.ArgType),' ',GetObjName(BaseTypes[BaseTypeString]));
  14266. ComputeElement(Arg.ArgType,ArgResolved,[rcType]);
  14267. if ArgResolved.BaseType in btAllStrings then
  14268. ModScope.AssertMsgConstructor:=aConstructor;
  14269. end;
  14270. end;
  14271. end;
  14272. Identifier:=Identifier.NextSameIdentifier;
  14273. end;
  14274. ClassScope:=ClassScope.AncestorScope;
  14275. until ClassScope=nil;
  14276. end;
  14277. procedure TPasResolver.FindRangeErrorConstructors(ErrorEl: TPasElement);
  14278. var
  14279. aMod: TPasModule;
  14280. ModScope: TPasModuleScope;
  14281. aClass: TPasClassType;
  14282. aConstructor: TPasConstructor;
  14283. begin
  14284. aMod:=RootElement;
  14285. ModScope:=aMod.CustomData as TPasModuleScope;
  14286. if pmsfRangeErrorSearched in ModScope.Flags then exit;
  14287. Include(ModScope.Flags,pmsfRangeErrorSearched);
  14288. FindSystemClassTypeAndConstructor('sysutils','ERangeError',aClass,aConstructor,ErrorEl);
  14289. ModScope.RangeErrorClass:=aClass;
  14290. ModScope.RangeErrorConstructor:=aConstructor;
  14291. end;
  14292. function TPasResolver.FindTVarRec(ErrorEl: TPasElement): TPasRecordType;
  14293. var
  14294. aMod, UtilsMod: TPasModule;
  14295. SectionScope: TPasSectionScope;
  14296. Identifier: TPasIdentifier;
  14297. El: TPasElement;
  14298. ModScope: TPasModuleScope;
  14299. begin
  14300. aMod:=RootElement;
  14301. ModScope:=aMod.CustomData as TPasModuleScope;
  14302. Result:=ModScope.SystemTVarRec;
  14303. if Result<>nil then exit;
  14304. // find unit in uses clauses
  14305. UtilsMod:=FindUsedUnitname('system',aMod);
  14306. if UtilsMod=nil then
  14307. RaiseIdentifierNotFound(20190215101210,'System.TVarRec',ErrorEl);
  14308. // find class in interface
  14309. if UtilsMod.InterfaceSection=nil then
  14310. RaiseIdentifierNotFound(20190215101231,'System.TVarRec',ErrorEl);
  14311. SectionScope:=NoNil(UtilsMod.InterfaceSection.CustomData) as TPasSectionScope;
  14312. Identifier:=SectionScope.FindLocalIdentifier('TVarRec');
  14313. if Identifier=nil then
  14314. RaiseIdentifierNotFound(20190215101253,'System.TVarRec',ErrorEl);
  14315. El:=Identifier.Element;
  14316. if not (El is TPasRecordType) then
  14317. RaiseXExpectedButYFound(20190215101310,'record TVarRec',GetElementTypeName(El),ErrorEl);
  14318. Result:=TPasRecordType(El);
  14319. ModScope.SystemTVarRec:=Result;
  14320. end;
  14321. function TPasResolver.GetTVarRec(El: TPasArrayType): TPasRecordType;
  14322. var
  14323. aModule: TPasModule;
  14324. ModScope: TPasModuleScope;
  14325. begin
  14326. aModule:=El.GetModule;
  14327. ModScope:=aModule.CustomData as TPasModuleScope;
  14328. Result:=ModScope.SystemTVarRec;
  14329. if Result=nil then
  14330. RaiseNotYetImplemented(20190215111924,El,'missing System.TVarRec');
  14331. end;
  14332. function TPasResolver.FindDefaultConstructor(aClass: TPasClassType
  14333. ): TPasConstructor;
  14334. var
  14335. ClassScope: TPasClassScope;
  14336. Identifier: TPasIdentifier;
  14337. El: TPasElement;
  14338. HasOverload: Boolean;
  14339. Proc: TPasProcedure;
  14340. begin
  14341. Result:=nil;
  14342. if (aClass=nil) or aClass.IsExternal or (aClass.ObjKind<>okClass) then exit;
  14343. ClassScope:=aClass.CustomData as TPasClassScope;
  14344. repeat
  14345. Identifier:=ClassScope.FindLocalIdentifier('create');
  14346. if Identifier<>nil then
  14347. begin
  14348. HasOverload:=false;
  14349. while Identifier<>nil do
  14350. begin
  14351. El:=Identifier.Element;
  14352. if not (El is TPasProcedure) then exit;
  14353. Proc:=TPasProcedure(El);
  14354. if Proc.ClassType=TPasConstructor then
  14355. begin
  14356. if Proc.ProcType.Args.Count=0 then
  14357. exit(TPasConstructor(El));
  14358. end;
  14359. if Proc.IsOverload then
  14360. HasOverload:=true;
  14361. Identifier:=Identifier.NextSameIdentifier;
  14362. end;
  14363. if not HasOverload then exit;
  14364. end;
  14365. ClassScope:=ClassScope.AncestorScope;
  14366. until false;
  14367. end;
  14368. function TPasResolver.GetTypeInfoParamType(Param: TPasExpr; out
  14369. ParamResolved: TPasResolverResult; LoType: boolean): TPasType;
  14370. var
  14371. Decl: TPasElement;
  14372. begin
  14373. Result:=nil;
  14374. // check type or var
  14375. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  14376. Decl:=ParamResolved.IdentEl;
  14377. if Decl=nil then exit;
  14378. if Decl is TPasType then
  14379. Result:=TPasType(Decl)
  14380. else if Decl is TPasVariable then
  14381. Result:=TPasVariable(Decl).VarType
  14382. else if Decl.ClassType=TPasArgument then
  14383. Result:=TPasArgument(Decl).ArgType
  14384. else if Decl.ClassType=TPasResultElement then
  14385. Result:=TPasResultElement(Decl).ResultType
  14386. else if (Decl is TPasProcedure)
  14387. and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
  14388. Result:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
  14389. {$IFDEF VerbosePasResolver}
  14390. {AllowWriteln}
  14391. if Result=nil then
  14392. writeln('TPasResolver.GetTypeInfoParamType Decl=',GetObjName(Decl),' ParamResolved=',GetResolverResultDbg(ParamResolved));
  14393. {AllowWriteln-}
  14394. {$ENDIF}
  14395. if LoType then
  14396. Result:=ResolveAliasType(Result);
  14397. end;
  14398. procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
  14399. const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
  14400. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  14401. PosEl: TPasElement);
  14402. begin
  14403. if MsgType<=mtError then
  14404. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
  14405. else
  14406. LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  14407. if Sender=nil then ;
  14408. end;
  14409. function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
  14410. Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
  14411. var
  14412. Ref: TResolvedReference;
  14413. Decl: TPasElement;
  14414. C: TClass;
  14415. ResolvedType: TPasResolverResult;
  14416. EnumValue: TPasEnumValue;
  14417. EnumType: TPasEnumType;
  14418. EvalFlags: TResEvalFlags;
  14419. begin
  14420. Result:=nil;
  14421. if not (Expr.CustomData is TResolvedReference) then
  14422. RaiseNotYetImplemented(20170518203134,Expr,GetObjName(Expr.CustomData));
  14423. Ref:=TResolvedReference(Expr.CustomData);
  14424. Decl:=Ref.Declaration;
  14425. {$IFDEF VerbosePasResEval}
  14426. writeln('TPasResolver.OnExprEvalIdentifier Value=',Expr.Value,' Decl=',GetObjName(Decl));
  14427. {$ENDIF}
  14428. C:=Decl.ClassType;
  14429. if C=TPasConst then
  14430. begin
  14431. if (TPasConst(Decl).Expr<>nil)
  14432. and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
  14433. begin
  14434. if TPasConst(Decl).VarType<>nil then
  14435. begin
  14436. // typed const
  14437. ComputeElement(TPasConst(Decl).VarType,ResolvedType,[rcType]);
  14438. end
  14439. else
  14440. ResolvedType.BaseType:=btNone;
  14441. EvalFlags:=Flags;
  14442. if not (refConstExt in EvalFlags) then
  14443. Include(EvalFlags,refConst);
  14444. Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,EvalFlags);
  14445. if Result<>nil then
  14446. begin
  14447. if (Result.Element<>nil) and (Result.Element<>TPasConst(Decl).Expr) then
  14448. Result:=Result.Clone;
  14449. Result.IdentEl:=Decl;
  14450. if TPasConst(Decl).VarType<>nil then
  14451. begin
  14452. // typed const
  14453. if Result.Kind=revkInt then
  14454. case ResolvedType.BaseType of
  14455. btByte: TResEvalInt(Result).Typed:=reitByte;
  14456. btShortInt: TResEvalInt(Result).Typed:=reitShortInt;
  14457. btWord: TResEvalInt(Result).Typed:=reitWord;
  14458. btSmallInt: TResEvalInt(Result).Typed:=reitSmallInt;
  14459. btUIntSingle: TResEvalInt(Result).Typed:=reitUIntSingle;
  14460. btIntSingle: TResEvalInt(Result).Typed:=reitIntSingle;
  14461. btLongWord: TResEvalInt(Result).Typed:=reitLongWord;
  14462. btLongint: TResEvalInt(Result).Typed:=reitLongInt;
  14463. btUIntDouble: TResEvalInt(Result).Typed:=reitUIntDouble;
  14464. {$ifdef HasInt64}
  14465. btIntDouble: TResEvalInt(Result).Typed:=reitIntDouble;
  14466. btInt64: TResEvalInt(Result).Typed:=reitNone; // default
  14467. {$else}
  14468. btIntDouble: TResEvalInt(Result).Typed:=reitNone; // default
  14469. {$endif}
  14470. else
  14471. ReleaseEvalValue(Result);
  14472. RaiseNotYetImplemented(20170624181050,TPasConst(Decl).VarType);
  14473. end;
  14474. end;
  14475. exit;
  14476. end;
  14477. end
  14478. else if vmExternal in TPasConst(Decl).VarModifiers then
  14479. begin
  14480. Result:=TResEvalExternal.Create;
  14481. Result.IdentEl:=Decl;
  14482. exit;
  14483. end;
  14484. if refConst in Flags then
  14485. begin
  14486. ReleaseEvalValue(Result);
  14487. RaiseConstantExprExp(20170518214928,Expr);
  14488. end;
  14489. end
  14490. else if C=TPasEnumValue then
  14491. begin
  14492. EnumValue:=TPasEnumValue(Decl);
  14493. EnumType:=EnumValue.Parent as TPasEnumType;
  14494. Result:=TResEvalEnum.CreateValue(EnumType.Values.IndexOf(EnumValue),EnumValue);
  14495. exit;
  14496. end
  14497. else if C.InheritsFrom(TPasType) then
  14498. Result:=EvalTypeRange(TPasType(Decl),Flags);
  14499. {$IFDEF VerbosePasResEval}
  14500. writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags,' refConstExt=',refConstExt in Flags);
  14501. {$ENDIF}
  14502. if (Result=nil) and ([refConst,refConstExt]*Flags<>[]) then
  14503. RaiseConstantExprExp(20170518213616,Expr);
  14504. if Sender=nil then ;
  14505. end;
  14506. function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
  14507. Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
  14508. var
  14509. Ref: TResolvedReference;
  14510. Decl: TPasElement;
  14511. C: TClass;
  14512. BuiltInProc: TResElDataBuiltInProc;
  14513. bt: TResolverBaseType;
  14514. ResolvedEl: TPasResolverResult;
  14515. TypeEl: TPasType;
  14516. begin
  14517. Result:=nil;
  14518. case Params.Kind of
  14519. pekArrayParams: ;
  14520. pekFuncParams:
  14521. if Params.Value.CustomData is TResolvedReference then
  14522. begin
  14523. Ref:=TResolvedReference(Params.Value.CustomData);
  14524. Decl:=Ref.Declaration;
  14525. if Decl is TPasType then
  14526. Decl:=ResolveAliasType(TPasType(Decl));
  14527. C:=Decl.ClassType;
  14528. if C=TPasUnresolvedSymbolRef then
  14529. begin
  14530. if Decl.CustomData is TResElDataBuiltInProc then
  14531. begin
  14532. BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
  14533. {$IFDEF VerbosePasResEval}
  14534. writeln('TPasResolver.OnExprEvalParams Calling BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14535. {$ENDIF}
  14536. if BuiltInProc.Eval<>nil then
  14537. BuiltInProc.Eval(BuiltInProc,Params,Flags,Result)
  14538. else
  14539. case BuiltInProc.BuiltIn of
  14540. bfAssigned: Result:=nil;
  14541. bfConcatArray: Result:=nil;
  14542. bfCopyArray: Result:=nil;
  14543. bfTypeInfo: Result:=nil;
  14544. else
  14545. {$IFDEF VerbosePasResEval}
  14546. writeln('TPasResolver.OnExprEvalParams Unhandled BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
  14547. {$ENDIF}
  14548. RaiseNotYetImplemented(20170624192324,Params);
  14549. end;
  14550. {$IFDEF VerbosePasResEval}
  14551. {AllowWriteln}
  14552. if Result<>nil then
  14553. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=',Result.AsString)
  14554. else
  14555. writeln('TPasResolver.OnExprEvalParams Called BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn],' Result=nil');
  14556. {AllowWriteln-}
  14557. {$ENDIF}
  14558. exit;
  14559. end
  14560. else if Decl.CustomData is TResElDataBaseType then
  14561. begin
  14562. // typecast to basetype
  14563. bt:=TResElDataBaseType(Decl.CustomData).BaseType;
  14564. Result:=EvalBaseTypeCast(Params,bt);
  14565. end;
  14566. {$IFDEF VerbosePasResEval}
  14567. writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',GetObjName(Decl.CustomData));
  14568. {$ENDIF}
  14569. end
  14570. else if C=TPasEnumType then
  14571. begin
  14572. // typecast to enumtype
  14573. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(Decl),Params.Params[0],Flags);
  14574. end
  14575. else if C=TPasRangeType then
  14576. begin
  14577. // typecast to custom range
  14578. ComputeElement(TPasRangeType(Decl).RangeExpr.left,ResolvedEl,[rcConstant]);
  14579. if ResolvedEl.BaseType=btContext then
  14580. begin
  14581. TypeEl:=ResolvedEl.LoTypeEl;
  14582. if TypeEl.ClassType=TPasEnumType then
  14583. begin
  14584. // typecast to enumtype
  14585. Result:=fExprEvaluator.EnumTypeCast(TPasEnumType(TypeEl),Params.Params[0],Flags);
  14586. end
  14587. else
  14588. RaiseNotYetImplemented(20171009223403,Params);
  14589. end
  14590. else
  14591. RaiseNotYetImplemented(20171009223303,Params);
  14592. end;
  14593. end;
  14594. pekSet: ;
  14595. end;
  14596. if Flags=[] then ;
  14597. if Sender=nil then ;
  14598. end;
  14599. procedure TPasResolver.OnRangeCheckEl(Sender: TResExprEvaluator;
  14600. El: TPasElement; var MsgType: TMessageType);
  14601. begin
  14602. if El=nil then exit;
  14603. if (MsgType=mtWarning)
  14604. and (bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
  14605. MsgType:=mtError;
  14606. if Sender=nil then ;
  14607. end;
  14608. function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
  14609. bt: TResolverBaseType): TResEvalvalue;
  14610. procedure TCFloatToInt(Value: TResEvalValue; Flo: TMaxPrecFloat);
  14611. var
  14612. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14613. begin
  14614. if bt in btAllIntegerNoQWord then
  14615. begin
  14616. // float to int
  14617. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14618. if (Flo<MinIntVal) or (Flo>MaxIntVal) then
  14619. fExprEvaluator.EmitRangeCheckConst(20170711001228,
  14620. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14621. {$R-}
  14622. try
  14623. Int:=Round(Flo);
  14624. except
  14625. RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
  14626. end;
  14627. case bt of
  14628. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14629. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14630. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14631. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14632. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14633. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14634. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14635. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14636. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14637. {$ifdef HasInt64}
  14638. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14639. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14640. {$else}
  14641. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14642. {$endif}
  14643. else
  14644. RaiseNotYetImplemented(20170711001513,Params);
  14645. end;
  14646. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14647. exit;
  14648. end
  14649. else if bt=btSingle then
  14650. begin
  14651. // float to single
  14652. try
  14653. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Flo));
  14654. except
  14655. RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
  14656. end;
  14657. end
  14658. else if bt=btDouble then
  14659. begin
  14660. // float to double
  14661. try
  14662. Result:=TResEvalFloat.CreateValue(double(Flo));
  14663. except
  14664. RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
  14665. end;
  14666. end
  14667. else if bt=btCurrency then
  14668. begin
  14669. // float to currency
  14670. try
  14671. Result:=TResEvalCurrency.CreateValue(Currency(Flo));
  14672. except
  14673. RaiseMsg(20180421171840,nRangeCheckError,sRangeCheckError,[],Params);
  14674. end;
  14675. end
  14676. else
  14677. begin
  14678. {$IFDEF VerbosePasResEval}
  14679. writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
  14680. {$ENDIF}
  14681. RaiseNotYetImplemented(20170711002542,Params);
  14682. end;
  14683. end;
  14684. var
  14685. Value: TResEvalValue;
  14686. Int, MinIntVal, MaxIntVal: TMaxPrecInt;
  14687. Flo: TMaxPrecFloat;
  14688. w: WideChar;
  14689. begin
  14690. Result:=nil;
  14691. {$IFDEF VerbosePasResEval}
  14692. writeln('TPasResolver.EvalBaseTypeCast bt=',bt);
  14693. {$ENDIF}
  14694. Value:=Eval(Params.Params[0],[refAutoConstExt]);
  14695. if Value=nil then exit;
  14696. try
  14697. case Value.Kind of
  14698. revkInt:
  14699. begin
  14700. Int:=TResEvalInt(Value).Int;
  14701. {$ifdef HasInt64}
  14702. if bt=btQWord then
  14703. begin
  14704. // int to qword
  14705. {$R-}
  14706. Result:=TResEvalUInt.CreateValue(TMaxPrecUInt(Int));
  14707. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14708. end
  14709. else
  14710. {$endif}
  14711. if bt in btAllIntegerNoQWord then
  14712. begin
  14713. // int to int
  14714. GetIntegerRange(bt,MinIntVal,MaxIntVal);
  14715. if (Int<MinIntVal) or (Int>MaxIntVal) then
  14716. begin
  14717. {$R-}
  14718. case bt of
  14719. btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
  14720. btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
  14721. btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
  14722. btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
  14723. btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
  14724. btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
  14725. {$ifdef HasInt64}
  14726. btInt64: Result:=TResEvalInt.CreateValue(Int);
  14727. {$endif}
  14728. btUIntSingle,
  14729. btIntSingle,
  14730. btUIntDouble,
  14731. btIntDouble:
  14732. fExprEvaluator.EmitRangeCheckConst(20170624194534,
  14733. Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
  14734. else
  14735. RaiseNotYetImplemented(20170624200109,Params);
  14736. end;
  14737. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14738. end
  14739. else
  14740. begin
  14741. {$R-}
  14742. case bt of
  14743. btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
  14744. btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
  14745. btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
  14746. btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
  14747. btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
  14748. btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
  14749. btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
  14750. btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
  14751. btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
  14752. {$ifdef HasInt64}
  14753. btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
  14754. btInt64: Result:=TResEvalInt.CreateValue(Int); // default
  14755. {$else}
  14756. btIntDouble: Result:=TResEvalInt.CreateValue(Int); // default
  14757. {$endif}
  14758. else
  14759. RaiseNotYetImplemented(20170624200109,Params);
  14760. end;
  14761. {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
  14762. end;
  14763. exit;
  14764. end
  14765. else if bt in btAllBooleans then
  14766. case Int of
  14767. 0: Result:=TResEvalBool.CreateValue(false);
  14768. 1: Result:=TResEvalBool.CreateValue(true);
  14769. else
  14770. fExprEvaluator.EmitRangeCheckConst(20170710203254,
  14771. Value.AsString,0,1,Params,mtError);
  14772. end
  14773. {$ifdef FPC_HAS_CPSTRING}
  14774. else if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14775. try
  14776. Result:=TResEvalString.CreateValue(Char(Int));
  14777. except
  14778. RaiseMsg(20180125112510,nRangeCheckError,sRangeCheckError,[],Params);
  14779. end
  14780. {$endif}
  14781. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14782. try
  14783. w:=WideChar(Int);
  14784. Result:=TResEvalUTF16.CreateValue(w);
  14785. except
  14786. RaiseMsg(20180125112716,nRangeCheckError,sRangeCheckError,[],Params);
  14787. end
  14788. else if bt=btSingle then
  14789. try
  14790. Result:=TResEvalFloat.CreateValue({$ifdef pas2js}double{$else}single{$endif}(Int));
  14791. except
  14792. RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
  14793. end
  14794. else if bt=btDouble then
  14795. try
  14796. Result:=TResEvalFloat.CreateValue(Double(Int));
  14797. except
  14798. RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
  14799. end
  14800. else if bt=btCurrency then
  14801. try
  14802. Result:=TResEvalCurrency.CreateValue(Currency(Int));
  14803. except
  14804. RaiseMsg(20180422093631,nRangeCheckError,sRangeCheckError,[],Params);
  14805. end
  14806. else
  14807. begin
  14808. {$IFDEF VerbosePasResEval}
  14809. writeln('TPasResolver.OnExprEvalParams typecast int to ',bt);
  14810. {$ENDIF}
  14811. RaiseNotYetImplemented(20170624194308,Params);
  14812. end;
  14813. end;
  14814. revkFloat:
  14815. begin
  14816. Flo:=TResEvalFloat(Value).FloatValue;
  14817. TCFloatToInt(Value,Flo);
  14818. end;
  14819. revkCurrency:
  14820. begin
  14821. if bt=btCurrency then
  14822. begin
  14823. Result:=Value;
  14824. Value:=nil;
  14825. end
  14826. else
  14827. begin
  14828. Flo:=TResEvalCurrency(Value).Value;
  14829. TCFloatToInt(Value,Flo);
  14830. end;
  14831. end;
  14832. {$ifdef FPC_HAS_CPSTRING}
  14833. revkString:
  14834. begin
  14835. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14836. begin
  14837. // ansichar(ansistring)
  14838. if fExprEvaluator.StringToOrd(Value,nil)>$ffff then
  14839. RaiseXExpectedButYFound(20181005141025,'char','string',Params);
  14840. Result:=Value;
  14841. Value:=nil;
  14842. end
  14843. else if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14844. begin
  14845. // widechar(ansistring)
  14846. if fExprEvaluator.GetWideChar(TResEvalString(Value).S,w) then
  14847. begin
  14848. Result:=Value;
  14849. Value:=nil;
  14850. end
  14851. else
  14852. RaiseXExpectedButYFound(20181005141058,'char','string',Params);
  14853. end
  14854. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  14855. begin
  14856. // ansistring(ansistring)
  14857. Result:=Value;
  14858. Value:=nil;
  14859. end
  14860. else if (bt=btUnicodeString) or (bt=btWideString)
  14861. or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  14862. begin
  14863. // unicodestring(ansistring)
  14864. Result:=TResEvalUTF16.CreateValue(
  14865. fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,Params));
  14866. end
  14867. else if bt=btRawByteString then
  14868. begin
  14869. // rawbytestring(ansistring)
  14870. SetCodePage(TResEvalString(Value).S,CP_NONE,false);
  14871. end;
  14872. end;
  14873. {$endif}
  14874. revkUnicodeString:
  14875. if length(TResEvalUTF16(Value).S)=1 then
  14876. begin
  14877. w:=TResEvalUTF16(Value).S[1];
  14878. {$ifdef FPC_HAS_CPSTRING}
  14879. if (bt=btAnsiChar) or ((bt=btChar) and (BaseTypeChar=btAnsiChar)) then
  14880. begin
  14881. // ansichar(unicodestring)
  14882. if ord(w)<=255 then
  14883. begin
  14884. Result:=Value;
  14885. Value:=nil;
  14886. end
  14887. else
  14888. RaiseMsg(20181005141632,nRangeCheckError,sRangeCheckError,[],Params);
  14889. end
  14890. else
  14891. {$endif}
  14892. if (bt=btWideChar) or ((bt=btChar) and (BaseTypeChar=btWideChar)) then
  14893. begin
  14894. // widechar(unicodestring)
  14895. Result:=Value;
  14896. Value:=nil;
  14897. end;
  14898. end
  14899. {$ifdef FPC_HAS_CPSTRING}
  14900. else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
  14901. begin
  14902. // ansistring(unicodestring)
  14903. Result:=TResEvalString.CreateValue(
  14904. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
  14905. end
  14906. else if bt=btRawByteString then
  14907. begin
  14908. // rawbytestring(unicodestring)
  14909. Result:=TResEvalString.CreateValue(
  14910. fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
  14911. end
  14912. {$endif}
  14913. else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
  14914. begin
  14915. // unicodestring(unicodestring)
  14916. Result:=Value;
  14917. Value:=nil;
  14918. end;
  14919. revkExternal:
  14920. exit;
  14921. else
  14922. {$IFDEF VerbosePasResEval}
  14923. writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
  14924. {$ENDIF}
  14925. RaiseNotYetImplemented(20170624193436,Params);
  14926. end;
  14927. finally
  14928. ReleaseEvalValue(Value);
  14929. end;
  14930. end;
  14931. procedure TPasResolver.AddGenericTemplateIdentifiers(
  14932. GenericTemplateTypes: TFPList; Scope: TPasIdentifierScope);
  14933. var
  14934. TemplType: TPasGenericTemplateType;
  14935. i: Integer;
  14936. begin
  14937. if GenericTemplateTypes=nil then exit;
  14938. for i:=0 to GenericTemplateTypes.Count-1 do
  14939. begin
  14940. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  14941. Scope.AddIdentifier(TemplType.Name,TemplType,pikSimple);
  14942. end;
  14943. end;
  14944. procedure TPasResolver.AddSpecializedTemplateIdentifiers(
  14945. GenericTemplateTypes: TFPList; SpecializedItem: TPRSpecializedItem;
  14946. Scope: TPasIdentifierScope; CheckConstraints: boolean);
  14947. var
  14948. i: Integer;
  14949. TemplType: TPasGenericTemplateType;
  14950. ParamTypes: TPasTypeArray;
  14951. ParamType: TPasType;
  14952. ErrorPos: TPasElement;
  14953. begin
  14954. ParamTypes:=SpecializedItem.Params;
  14955. ErrorPos:=SpecializedItem.FirstSpecialize;
  14956. for i:=0 to length(ParamTypes)-1 do
  14957. begin
  14958. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
  14959. ParamType:=ParamTypes[i];
  14960. if CheckConstraints then
  14961. begin
  14962. if ParamType is TPasGenericTemplateType then
  14963. CheckTemplateFitsTemplate(TPasGenericTemplateType(ParamType),
  14964. TemplType,ErrorPos)
  14965. else
  14966. CheckTemplateFitsParam(ParamType,TemplType,SpecializedItem,
  14967. prtcoAssignToTempl,ErrorPos);
  14968. end;
  14969. AddIdentifier(Scope,TemplType.Name,ParamTypes[i],pikSimple);
  14970. end;
  14971. end;
  14972. function TPasResolver.CreateInferenceTypesForCall(Params: TParamsExpr;
  14973. TargetProc: TPasProcedure): TFPList;
  14974. type
  14975. TInferredType = record
  14976. InferType: TPasType;
  14977. IsVarOut: boolean;
  14978. end;
  14979. TInferredTypes = array of TInferredType;
  14980. procedure RaiseInferTypeMismatch(const Id: TMaxPrecInt; ArgType: TPasType;
  14981. ErrorPos: TPasElement);
  14982. begin
  14983. RaiseMsg(Id,nInferredTypeXFromDiffArgsMismatchFromMethodY,
  14984. sInferredTypeXFromDiffArgsMismatchFromMethodY,
  14985. [ArgType.Name,TargetProc.Name],ErrorPos);
  14986. end;
  14987. procedure Infer(ArgParent: TPasElement; ArgType, ParamLoType, ParamHiType: TPasType;
  14988. NeedVar, IsSubType, IsDelphi: boolean;
  14989. InferenceParams: TInferredTypes; TemplTypes: TFPList;
  14990. ErrorPos: TPasElement);
  14991. var
  14992. C: TClass;
  14993. i: Integer;
  14994. OldInferType, ParamElType: TPasType;
  14995. ResolveAlias: TPRResolveAlias;
  14996. Arr: TPasArrayType;
  14997. Param1Resolved, Param2Resolved: TPasResolverResult;
  14998. NewBaseType, BaseType1, BaseType2: TResolverBaseType;
  14999. begin
  15000. if (ArgType=nil) or (ParamLoType=nil) then exit;
  15001. C:=ArgType.ClassType;
  15002. if C=TPasGenericTemplateType then
  15003. begin
  15004. i:=TemplTypes.IndexOf(ArgType);
  15005. if i>=0 then
  15006. begin
  15007. // a generic type param corresponds to ParamType
  15008. OldInferType:=InferenceParams[i].InferType;
  15009. if OldInferType=nil then
  15010. begin
  15011. // template type inferred first time
  15012. InferenceParams[i].InferType:=ParamHiType;
  15013. InferenceParams[i].IsVarOut:=NeedVar;
  15014. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15015. exit;
  15016. end;
  15017. // already inferred -> check compatibility
  15018. ResolveAlias:=prraAlias;
  15019. if IsDelphi and (NeedVar or InferenceParams[i].IsVarOut) then
  15020. // Delphi allows passing alias, but not type alias to a var arg
  15021. ResolveAlias:=prraSimple;
  15022. if IsSameType(OldInferType,ParamHiType,ResolveAlias) then
  15023. exit; // same types -> ok
  15024. if IsSubType then
  15025. begin
  15026. if CheckElTypeCompatibility(OldInferType,InferenceParams[i].InferType,
  15027. ResolveAlias)<=cGenericExact then
  15028. exit;
  15029. // e.g. "array of TA" and "array of TB"
  15030. RaiseInferTypeMismatch(20191006215539,ArgType,ErrorPos);
  15031. end;
  15032. // top level type does not fit exactly
  15033. if NeedVar then
  15034. begin
  15035. // second is var/out
  15036. if InferenceParams[i].IsVarOut then
  15037. // two var/out arguments mismatch
  15038. RaiseInferTypeMismatch(20191006220355,ArgType,ErrorPos);
  15039. if CheckAssignCompatibility(ParamHiType,OldInferType,
  15040. false,ErrorPos)=cIncompatible then
  15041. // second is var/out, and do not match
  15042. RaiseInferTypeMismatch(20191006220402,ArgType,ErrorPos);
  15043. // first can be widened to fit
  15044. InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15045. InferenceParams[i].InferType:=ParamHiType;
  15046. InferenceParams[i].IsVarOut:=NeedVar;
  15047. ParamHiType.AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15048. exit;
  15049. end
  15050. else if InferenceParams[i].IsVarOut then
  15051. begin
  15052. // first was var/out
  15053. if CheckAssignCompatibility(OldInferType,ParamHiType,
  15054. false,ErrorPos)=cIncompatible then
  15055. // first was var/out, and do not match
  15056. RaiseInferTypeMismatch(20191006220750,ArgType,ErrorPos);
  15057. // second can be widened to fit
  15058. exit;
  15059. end;
  15060. // None is var/out -> find a type compatible to both
  15061. // widen type to some common base types to avoid high number of specialization
  15062. ComputeElement(ParamHiType,Param1Resolved,[],ErrorPos);
  15063. ComputeElement(InferenceParams[i].InferType,Param2Resolved,[],ErrorPos);
  15064. NewBaseType:=btNone;
  15065. BaseType1:=Param1Resolved.BaseType;
  15066. BaseType2:=Param2Resolved.BaseType;
  15067. if BaseType1 in btAllBooleans then
  15068. begin
  15069. if BaseType2 in btAllBooleans then
  15070. if BaseTypes[btBoolean]<>nil then
  15071. NewBaseType:=btBoolean
  15072. else
  15073. NewBaseType:=GetCombinedBoolean(BaseType1,BaseType2,ErrorPos);
  15074. end
  15075. else if BaseType1 in btAllInteger then
  15076. begin
  15077. NewBaseType:=TResolverBaseType(Max(ord(BaseType1),ord(BaseType2)));
  15078. if (BaseTypes[btLongint]<>nil)
  15079. and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint])
  15080. and (BaseType1<>btLongWord) and (BaseType2<>btLongWord) then
  15081. NewBaseType:=btLongint
  15082. {$ifdef HasInt64}
  15083. else if (BaseTypes[btInt64]<>nil)
  15084. and (NewBaseType<=btInt64)
  15085. and (BaseType1<>btQWord) and (BaseType2<>btQWord) then
  15086. NewBaseType:=btInt64
  15087. {$endif}
  15088. else if (BaseTypes[btIntDouble]<>nil)
  15089. and (NewBaseType<=btIntDouble) then
  15090. NewBaseType:=btIntDouble
  15091. {$ifdef HasInt64}
  15092. else if (BaseTypes[btQWord]<>nil)
  15093. and not (NewBaseType in btAllSignedInteger) then
  15094. NewBaseType:=btQWord
  15095. {$endif}
  15096. else
  15097. NewBaseType:=GetCombinedInt(Param1Resolved,Param2Resolved,ErrorPos);
  15098. end
  15099. else if Param1Resolved.BaseType in btAllStringAndChars then
  15100. begin
  15101. if Param2Resolved.BaseType in btAllStringAndChars then
  15102. if BaseTypes[btUnicodeString]<>nil then
  15103. NewBaseType:=btUnicodeString
  15104. else
  15105. NewBaseType:=GetCombinedString(Param1Resolved,Param2Resolved,ErrorPos);
  15106. end
  15107. else if Param1Resolved.BaseType in btAllFloats then
  15108. begin
  15109. if BaseTypes[btDouble]<>nil then
  15110. NewBaseType:=btDouble;
  15111. end;
  15112. if NewBaseType<>btNone then
  15113. begin
  15114. InferenceParams[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15115. InferenceParams[i].InferType:=BaseTypes[NewBaseType];
  15116. InferenceParams[i].IsVarOut:=NeedVar;
  15117. BaseTypes[NewBaseType].AddRef{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15118. exit;
  15119. end;
  15120. // ToDo
  15121. RaiseInferTypeMismatch(20191006220406,ArgType,ErrorPos);
  15122. end;
  15123. end
  15124. else if ArgParent<>ArgType.Parent then
  15125. // ArgType is a reference
  15126. else if C=TPasArrayType then
  15127. begin
  15128. // e.g. Proc(a: array...)
  15129. Arr:=TPasArrayType(ArgType);
  15130. if ParamLoType.ClassType<>TPasArrayType then
  15131. exit;
  15132. ParamElType:=TPasArrayType(ParamLoType).ElType;
  15133. Infer(Arr,Arr.ElType,ParamElType,ResolveAliasType(ParamElType),
  15134. NeedVar,true,IsDelphi,InferenceParams,TemplTypes,ErrorPos);
  15135. end
  15136. else
  15137. begin
  15138. {$IFDEF VerbosePasResolver}
  15139. //writeln('Infer ArgType=',GetObjName(ArgType),' ParamLoType=',GetObjName(ParamLoType));
  15140. {$ENDIF}
  15141. end;
  15142. end;
  15143. procedure InferParam(i: integer; NeedVar: boolean; ParamsExprs: TPasExprArray;
  15144. ProcArgs: TFPList;
  15145. InferenceParams: TInferredTypes; TemplTypes: TFPList; IsDelphi: boolean);
  15146. var
  15147. Arg: TPasArgument;
  15148. ArgType: TPasType;
  15149. ArgResolved, ExprResolved: TPasResolverResult;
  15150. Expr: TPasExpr;
  15151. begin
  15152. //writeln('InferParam i=',i,' NeedVar=',NeedVar,' IsDelphi=',IsDelphi,' ProcArgs.Count=',ProcArgs.Count);
  15153. Arg:=TPasArgument(ProcArgs[i]);
  15154. ArgType:=Arg.ArgType;
  15155. if ArgType=nil then
  15156. exit; // untyped arg
  15157. if (ArgType.Parent<>Arg) and (ArgType.ClassType<>TPasGenericTemplateType) then
  15158. exit; // a reference -> no need to search for a template reference
  15159. if NeedVar<>(Arg.Access in [argVar, argOut]) then
  15160. exit;
  15161. if i<length(ParamsExprs) then
  15162. Expr:=ParamsExprs[i]
  15163. else
  15164. begin
  15165. Expr:=Arg.ValueExpr;
  15166. if Expr=nil then exit;
  15167. end;
  15168. ComputeArgumentAndExpr(Arg,ArgResolved,Expr,ExprResolved,false);
  15169. {$IFDEF VerbosePasResolver}
  15170. writeln('TPasResolver.CreateInferenceTypesForCall Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
  15171. {$ENDIF}
  15172. if ExprResolved.BaseType in btAllWithSubType then
  15173. begin
  15174. // passing a literal set or array or custom range
  15175. {$IFDEF VerbosePasResolver}
  15176. writeln('TPasResolver.CreateInferenceTypesForCall.InferParam ToDo: ',GetResolverResultDbg(ExprResolved));
  15177. {$ENDIF}
  15178. end
  15179. else if (ExprResolved.SubType<>btNone) then
  15180. RaiseNotYetImplemented(20191006203622,Expr)
  15181. else
  15182. Infer(Arg,ArgType,ExprResolved.LoTypeEl,ExprResolved.HiTypeEl,
  15183. NeedVar,false,IsDelphi,
  15184. InferenceParams,TemplTypes,Expr);
  15185. end;
  15186. var
  15187. TemplTypes, ProcArgs: TFPList;
  15188. InferenceTypes: TInferredTypes;
  15189. ParamsExprs: TPasExprArray;
  15190. IsDelphi: Boolean;
  15191. i: Integer;
  15192. begin
  15193. Result:=nil;
  15194. TemplTypes:=GetProcTemplateTypes(TargetProc);
  15195. if (TemplTypes=nil) or (TemplTypes.Count=0) then
  15196. RaiseNotYetImplemented(20191006174321,Params);
  15197. ProcArgs:=TargetProc.ProcType.Args;
  15198. ParamsExprs:=Params.Params;
  15199. if ProcArgs.Count<length(ParamsExprs) then
  15200. RaiseNotYetImplemented(20191006183021,Params);
  15201. IsDelphi:=msDelphi in CurrentParser.CurrentModeswitches;
  15202. try
  15203. SetLength(InferenceTypes{%H-},TemplTypes.Count);
  15204. for i:=0 to TemplTypes.Count-1 do
  15205. InferenceTypes[i]:=Default(TInferredType);
  15206. // first infer from var/out args exact types
  15207. for i:=0 to ProcArgs.Count-1 do
  15208. InferParam(i,true,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  15209. // then infer from the other args
  15210. for i:=0 to ProcArgs.Count-1 do
  15211. InferParam(i,false,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
  15212. // check that all types are inferred
  15213. for i:=0 to TemplTypes.Count-1 do
  15214. if InferenceTypes[i].InferType=nil then
  15215. RaiseMsg(20191006175104,nCouldNotInferTypeArgXForMethodY,
  15216. sCouldNotInferTypeArgXForMethodY,
  15217. [TPasGenericTemplateType(TemplTypes[i]).Name,TargetProc.Name],Params);
  15218. Result:=TFPList.Create;
  15219. for i:=0 to length(InferenceTypes)-1 do
  15220. begin
  15221. Result.Add(InferenceTypes[i].InferType);
  15222. InferenceTypes[i].InferType:=nil;
  15223. end;
  15224. finally
  15225. if Result=nil then
  15226. for i:=0 to length(InferenceTypes)-1 do
  15227. if InferenceTypes[i].InferType<>nil then
  15228. InferenceTypes[i].InferType.Release{$IFDEF CheckPasTreeRefCount}(RefIdInferenceParamsExpr){$ENDIF};
  15229. end;
  15230. end;
  15231. function TPasResolver.CheckGenericConstraintFitsParam(ParamType: TPasType;
  15232. SpecializedItem: TPRSpecializedItem; TemplType: TPasGenericTemplateType;
  15233. ConEl: TPasElement; Operation: TPRTemplateCompOp; ErrorPos: TPasElement
  15234. ): integer;
  15235. function RaiseXExpButYFound(id: TMaxPrecInt; const X: string; Y: TPasType): integer;
  15236. begin
  15237. if ErrorPos<>nil then
  15238. RaiseXExpectedButTypeYFound(id,X,Y,ErrorPos);
  15239. Result:=cIncompatible;
  15240. end;
  15241. procedure RaiseNotValidConstraint(Id: TMaxPrecInt; ConEl: TPasElement);
  15242. begin
  15243. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15244. [GetElementSourcePosStr(ConEl)],ErrorPos);
  15245. end;
  15246. function ElementReferencesTemplateTypes(El: TPasElement;
  15247. GenericTemplateTypes: TFPList): boolean;
  15248. var
  15249. C: TClass;
  15250. Prim: TPrimitiveExpr;
  15251. Decl: TPasElement;
  15252. Bin: TBinaryExpr;
  15253. Spec: TPasSpecializeType;
  15254. Arr: TPasArrayType;
  15255. i: Integer;
  15256. InlineSpec: TInlineSpecializeExpr;
  15257. begin
  15258. Result:=false;
  15259. if El=nil then exit;
  15260. C:=El.ClassType;
  15261. if C=TPrimitiveExpr then
  15262. begin
  15263. Prim:=TPrimitiveExpr(El);
  15264. if Prim.Kind=pekIdent then
  15265. begin
  15266. if Prim.CustomData is TResolvedReference then
  15267. begin
  15268. Decl:=TResolvedReference(Prim.CustomData).Declaration;
  15269. exit(ElementReferencesTemplateTypes(Decl,GenericTemplateTypes));
  15270. end;
  15271. end
  15272. else
  15273. exit;
  15274. end
  15275. else if C=TBinaryExpr then
  15276. begin
  15277. Bin:=TBinaryExpr(El);
  15278. Result:=ElementReferencesTemplateTypes(Bin.left,GenericTemplateTypes)
  15279. or ElementReferencesTemplateTypes(Bin.right,GenericTemplateTypes);
  15280. end
  15281. else if C=TInlineSpecializeExpr then
  15282. begin
  15283. InlineSpec:=TInlineSpecializeExpr(El);
  15284. if ElementReferencesTemplateTypes(InlineSpec.NameExpr,GenericTemplateTypes) then
  15285. exit(true);
  15286. for i:=0 to InlineSpec.Params.Count-1 do
  15287. begin
  15288. Decl:=TPasElement(InlineSpec.Params[i]);
  15289. if Decl.Parent<>InlineSpec then continue;
  15290. if ElementReferencesTemplateTypes(Decl,GenericTemplateTypes) then
  15291. exit(true);
  15292. end;
  15293. end
  15294. else if C=TPasGenericTemplateType then
  15295. Result:=GenericTemplateTypes.IndexOf(El)>=0
  15296. else if C.InheritsFrom(TPasType) then
  15297. begin
  15298. if TPasType(El).Name<>'' then exit;
  15299. if C=TPasSpecializeType then
  15300. begin
  15301. Spec:=TPasSpecializeType(El);
  15302. if ElementReferencesTemplateTypes(Spec.DestType,GenericTemplateTypes) then
  15303. exit(true);
  15304. for i:=0 to Spec.Params.Count-1 do
  15305. if ElementReferencesTemplateTypes(TPasElement(Spec.Params[i]),GenericTemplateTypes) then
  15306. exit(true);
  15307. end
  15308. else if C=TPasArrayType then
  15309. begin
  15310. Arr:=TPasArrayType(El);
  15311. for i:=0 to length(Arr.Ranges)-1 do
  15312. if ElementReferencesTemplateTypes(Arr.Ranges[i],GenericTemplateTypes) then exit(true);
  15313. Result:=ElementReferencesTemplateTypes(Arr.ElType,GenericTemplateTypes);
  15314. end
  15315. else if C=TPasPointerType then
  15316. Result:=ElementReferencesTemplateTypes(TPasPointerType(El).DestType,GenericTemplateTypes)
  15317. else if C=TPasSetType then
  15318. Result:=ElementReferencesTemplateTypes(TPasSetType(El).EnumType,GenericTemplateTypes)
  15319. else if C=TPasEnumType then
  15320. else
  15321. RaiseNotYetImplemented(20190905110152,El);
  15322. end
  15323. else
  15324. RaiseNotYetImplemented(20190905105648,El);
  15325. end;
  15326. var
  15327. ConToken: TToken;
  15328. aClass, ConstraintClass: TPasClassType;
  15329. GenTempl: TPasGenericTemplateType;
  15330. i: Integer;
  15331. ResolvedEl: TPasResolverResult;
  15332. ConType: TPasType;
  15333. GenericTemplateTypes: TFPList;
  15334. GenericEl: TPasElement;
  15335. begin
  15336. ConToken:=GetGenericConstraintKeyword(ConEl);
  15337. case ConToken of
  15338. tkrecord:
  15339. begin
  15340. if ParamType is TPasRecordType then exit(cExact);
  15341. exit(RaiseXExpButYFound(20190725200015,'record type',ParamType));
  15342. end;
  15343. tkclass,tkconstructor:
  15344. begin
  15345. if not (ParamType is TPasClassType) then
  15346. exit(RaiseXExpButYFound(20190726133231,'class type',ParamType));
  15347. aClass:=TPasClassType(ParamType);
  15348. if aClass.ObjKind<>okClass then
  15349. exit(RaiseXExpButYFound(20190726133232,'class type',ParamType));
  15350. if aClass.IsExternal then
  15351. exit(RaiseXExpButYFound(20190726133233,'non external class type',ParamType));
  15352. if ConToken=tkconstructor then
  15353. begin
  15354. if FindDefaultConstructor(aClass)=nil then
  15355. exit(RaiseXExpButYFound(20190831000225,'class type with constructor create()',ParamType));
  15356. end;
  15357. exit;
  15358. end;
  15359. end;
  15360. if not (ConEl is TPasType) then
  15361. RaiseNotYetImplemented(20190912214727,ConEl,GetObjPath(ErrorPos));
  15362. // constraint can be a class type, interface type or a template type
  15363. // Param must be a class
  15364. if SpecializedItem<>nil then
  15365. begin
  15366. GenericEl:=SpecializedItem.GenericEl;
  15367. if GenericEl is TPasGenericType then
  15368. GenericTemplateTypes:=TPasGenericType(GenericEl).GenericTemplateTypes
  15369. else if GenericEl is TPasProcedure then
  15370. GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(GenericEl))
  15371. else
  15372. RaiseNotYetImplemented(20190920114755,ConEl);
  15373. if ElementReferencesTemplateTypes(ConEl,GenericTemplateTypes) then
  15374. begin
  15375. // constraint contains templates -> specialize constraint
  15376. if ConEl is TPasType then
  15377. begin
  15378. // type reference
  15379. ConType:=TPasType(ConEl);
  15380. i:=length(SpecializedItem.SpecializedConstraints);
  15381. Setlength(SpecializedItem.SpecializedConstraints,i+1);
  15382. SpecializedItem.SpecializedConstraints[i]:=nil;
  15383. SpecializeElType(TemplType,SpecializedItem.SpecializedEl,ConType,
  15384. TPasType(SpecializedItem.SpecializedConstraints[i]));
  15385. ConEl:=SpecializedItem.SpecializedConstraints[i];
  15386. end
  15387. else
  15388. // non type reference
  15389. RaiseNotValidConstraint(20190915181137,ConEl);
  15390. end;
  15391. end;
  15392. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15393. if ResolvedEl.BaseType<>btContext then
  15394. RaiseNotValidConstraint(20190914105836,ConEl);
  15395. if ResolvedEl.HiTypeEl.Name='' then
  15396. RaiseNotValidConstraint(20190726134037,GetGenericConstraintErrorEl(ConEl,TemplType));
  15397. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  15398. begin
  15399. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  15400. if GenTempl=ConEl.Parent then
  15401. RaiseNotYetImplemented(20190831213359,GenTempl);
  15402. Result:=CheckTemplateFitsParam(ParamType,GenTempl,nil,Operation,ErrorPos);
  15403. end
  15404. else if ResolvedEl.LoTypeEl is TPasClassType then
  15405. begin
  15406. // constraint is classtype or interfacetype
  15407. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15408. if not (ParamType is TPasClassType) then
  15409. begin
  15410. if ErrorPos<>nil then
  15411. RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],
  15412. ParamType,ConstraintClass,ErrorPos);
  15413. exit(cIncompatible);
  15414. end;
  15415. if not (TPasClassType(ParamType).ObjKind in [okClass,okInterface]) then
  15416. begin
  15417. if ErrorPos<>nil then
  15418. RaiseMsg(20190904175144,nXExpectedButYFound,sXExpectedButYFound,
  15419. ['class',GetTypeDescription(ParamType)],ErrorPos);
  15420. exit(cIncompatible);
  15421. end;
  15422. case ConstraintClass.ObjKind of
  15423. okClass:
  15424. case Operation of
  15425. prtcoAssignToTempl:
  15426. // TemplateClass:=ParamClassType
  15427. if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
  15428. begin
  15429. // ParamType is not ConstraintClass
  15430. if ErrorPos<>nil then
  15431. RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],
  15432. ParamType,ConstraintClass,ErrorPos);
  15433. exit(cIncompatible);
  15434. end;
  15435. prtcoAssignFromTempl:
  15436. // ParamClassType:=TemplateClass
  15437. if CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible then
  15438. begin
  15439. // ConstraintClass is not ParamType
  15440. if ErrorPos<>nil then
  15441. RaiseIncompatibleType(20190915202812,nIncompatibleTypesGotExpected,[''],
  15442. ConstraintClass,ParamType,ErrorPos);
  15443. exit(cIncompatible);
  15444. end;
  15445. prtcoEqual:
  15446. // TemplateClass=ParamClassType
  15447. if (CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible)
  15448. and (CheckClassIsClass(ConstraintClass,ParamType)<>cIncompatible) then
  15449. begin
  15450. // ParamType is not related to ConstraintClass
  15451. if ErrorPos<>nil then
  15452. RaiseIncompatibleType(20190915203651,nIncompatibleTypesGotExpected,[''],
  15453. ParamType,ConstraintClass,ErrorPos);
  15454. exit(cIncompatible);
  15455. end;
  15456. else
  15457. RaiseNotYetImplemented(20190915203439,ConEl);
  15458. end;
  15459. okInterface:
  15460. case Operation of
  15461. prtcoAssignToTempl:
  15462. // TemplateClassWithIntf:=ParamClassType
  15463. if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
  15464. begin
  15465. // ParamType does not implement ConstraintClass
  15466. if ErrorPos<>nil then
  15467. RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],
  15468. ParamType,ConstraintClass,ErrorPos);
  15469. exit(cIncompatible);
  15470. end;
  15471. prtcoAssignFromTempl:
  15472. // ParamClassType:=TemplateClassWithIntf
  15473. begin
  15474. // check when specialize
  15475. end;
  15476. prtcoEqual:
  15477. // TemplateClassWithIntf=ParamClassType
  15478. begin
  15479. // check when specialize
  15480. end;
  15481. else
  15482. RaiseNotYetImplemented(20190915203218,ConEl);
  15483. end;
  15484. else
  15485. if ErrorPos<>nil then
  15486. RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],
  15487. ParamType,ConstraintClass,ErrorPos);
  15488. exit(cIncompatible);
  15489. end;
  15490. end
  15491. else
  15492. begin
  15493. {$IFDEF VerbosePasResolver}
  15494. writeln('TPasResolver.CheckSpecializedParamFitsConstraintExpr ',GetObjPath(ResolvedEl.LoTypeEl));
  15495. {$ENDIF}
  15496. RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15497. [GetElementSourcePosStr(GetGenericConstraintErrorEl(ConEl,ConEl.Parent))],
  15498. ErrorPos);
  15499. end;
  15500. Result:=cExact;
  15501. end;
  15502. function TPasResolver.CheckTemplateFitsParam(ParamType: TPasType;
  15503. GenTempl: TPasGenericTemplateType; SpecializedItem: TPRSpecializedItem;
  15504. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15505. var
  15506. i: Integer;
  15507. begin
  15508. // check if the ParamType fits the constraints
  15509. for i:=0 to length(GenTempl.Constraints)-1 do
  15510. begin
  15511. Result:=CheckGenericConstraintFitsParam(ParamType,SpecializedItem,
  15512. GenTempl,GenTempl.Constraints[i],Operation,ErrorPos);
  15513. if Result=cIncompatible then exit;
  15514. end;
  15515. Result:=cExact;
  15516. end;
  15517. function TPasResolver.CheckTemplateFitsParamRes(
  15518. GenTempl: TPasGenericTemplateType; const ResolvedEl: TPasResolverResult;
  15519. Operation: TPRTemplateCompOp; ErrorPos: TPasElement): integer;
  15520. var
  15521. i: Integer;
  15522. ConEl: TPasElement;
  15523. ConToken: TToken;
  15524. LoTypeEl: TPasType;
  15525. begin
  15526. if length(GenTempl.Constraints)=0 then
  15527. exit(cGenericExact);
  15528. if ResolvedEl.BaseType=btContext then
  15529. begin
  15530. LoTypeEl:=ResolvedEl.LoTypeEl;
  15531. if LoTypeEl is TPasGenericTemplateType then
  15532. begin
  15533. if LoTypeEl=GenTempl then
  15534. exit(cGenericExact);
  15535. if (Operation=prtcoAssignToTempl) and (ErrorPos<>nil) then
  15536. CheckTemplateFitsTemplate(TPasGenericTemplateType(LoTypeEl),GenTempl,ErrorPos);
  15537. Result:=cGenericExact;
  15538. end
  15539. else
  15540. Result:=CheckTemplateFitsParam(LoTypeEl,GenTempl,nil,Operation,ErrorPos);
  15541. end
  15542. else if ResolvedEl.BaseType=btNil then
  15543. begin
  15544. for i:=0 to length(GenTempl.Constraints)-1 do
  15545. begin
  15546. ConEl:=GenTempl.Constraints[i];
  15547. ConToken:=GetGenericConstraintKeyword(ConEl);
  15548. if ConToken=tkrecord then
  15549. begin
  15550. if ErrorPos<>nil then
  15551. RaiseXExpectedButYFound(20190915211000,'record type','nil',ErrorPos);
  15552. exit(cIncompatible);
  15553. end;
  15554. end;
  15555. Result:=cGenericExact;
  15556. end
  15557. else
  15558. begin
  15559. if ErrorPos<>nil then
  15560. RaiseNotYetImplemented(20190915205441,ErrorPos);
  15561. Result:=cIncompatible;
  15562. end;
  15563. end;
  15564. procedure TPasResolver.CheckTemplateFitsTemplate(ParamTemplType,
  15565. GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
  15566. procedure RaiseNotValidConstraint(const Id: TMaxPrecInt; ConEl: TPasElement);
  15567. begin
  15568. RaiseMsg(Id,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
  15569. [GetElementTypeName(ConEl)],GetGenericConstraintErrorEl(ConEl,GenTempl));
  15570. end;
  15571. var
  15572. ParamConstraints: TPasElementArray;
  15573. j, k: Integer;
  15574. ConToken: TToken;
  15575. ConstraintClass, ParamClassType: TPasClassType;
  15576. ConEl, ParamConstraintEl: TPasElement;
  15577. ParamLoType, ParamHiType: TPasType;
  15578. ResolvedEl: TPasResolverResult;
  15579. begin
  15580. ParamConstraints:=ParamTemplType.Constraints;
  15581. for j:=0 to length(GenTempl.Constraints)-1 do
  15582. begin
  15583. ConEl:=GenTempl.Constraints[j];
  15584. ConToken:=GetGenericConstraintKeyword(ConEl);
  15585. if ConToken<>tkEOF then
  15586. begin
  15587. // constraint is keyword
  15588. // -> check if keyword is in ParamConstraints
  15589. k:=length(ParamConstraints)-1;
  15590. while (k>=0) and (GetGenericConstraintKeyword(ParamConstraints[k])<>ConToken) do
  15591. dec(k);
  15592. if k<0 then
  15593. RaiseMsg(20190816230021,nTypeParamXIsMissingConstraintY,
  15594. sTypeParamXIsMissingConstraintY,
  15595. [ParamTemplType.Name,TokenInfos[ConToken]],ErrorPos);
  15596. end
  15597. else if ConEl is TPasType then
  15598. begin
  15599. // constraint is a type
  15600. ComputeElement(ConEl,ResolvedEl,[rcType]);
  15601. if ResolvedEl.BaseType<>btContext then
  15602. RaiseNotValidConstraint(20190816231846,ConEl);
  15603. if not (ResolvedEl.LoTypeEl is TPasClassType) then
  15604. RaiseNotValidConstraint(20190816231849,ConEl);
  15605. ConstraintClass:=TPasClassType(ResolvedEl.LoTypeEl);
  15606. // constraint is class/interface type
  15607. // -> check if one of ParamConstraints fits the constraint type
  15608. // i.e. ParamConstraints must be more strict than target constraints
  15609. k:=length(ParamConstraints)-1;
  15610. while k>=0 do
  15611. begin
  15612. ParamConstraintEl:=ParamConstraints[k];
  15613. if ParamConstraintEl is TPasType then
  15614. begin
  15615. ParamHiType:=TPasType(ParamConstraintEl);
  15616. ParamLoType:=ResolveAliasType(ParamHiType);
  15617. if not (ParamLoType is TPasClassType) then
  15618. RaiseMsg(20190816232459,nXExpectedButYFound,sXExpectedButYFound,
  15619. ['type',GetTypeDescription(ParamHiType)],
  15620. GetGenericConstraintErrorEl(ParamConstraintEl,ParamTemplType));
  15621. ParamClassType:=TPasClassType(ParamLoType);
  15622. if (ConstraintClass.ObjKind=okInterface)
  15623. and (ParamClassType.ObjKind=okClass) then
  15624. begin
  15625. if GetClassImplementsIntf(ParamClassType,ConstraintClass)<>nil then
  15626. break;
  15627. end
  15628. else
  15629. begin
  15630. if CheckClassIsClass(ParamClassType,ConstraintClass)<cIncompatible then
  15631. break;
  15632. end;
  15633. end;
  15634. dec(k);
  15635. end;
  15636. if k<0 then
  15637. begin
  15638. if ConstraintClass.ObjKind=okInterface then
  15639. RaiseMsg(20190816233102,nTypeParamXMustSupportIntfY,
  15640. sTypeParamXMustSupportIntfY,
  15641. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos)
  15642. else
  15643. RaiseMsg(20190816230021,nTypeParamXIsNotCompatibleWithY,
  15644. sTypeParamXIsNotCompatibleWithY,
  15645. [ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos);
  15646. end;
  15647. end
  15648. else
  15649. RaiseNotYetImplemented(20190912215702,GetGenericConstraintErrorEl(ConEl,GenTempl));
  15650. end;
  15651. end;
  15652. function TPasResolver.CreateSpecializedItem(El: TPasElement;
  15653. GenericEl: TPasElement; const ParamsResolved: TPasTypeArray
  15654. ): TPRSpecializedItem;
  15655. var
  15656. NewEl: TPasElement;
  15657. GenScope: TPasGenericScope;
  15658. SpecializedItems: TObjectList;
  15659. procedure InsertBehind(List: TFPList);
  15660. var
  15661. Last: TPasElement;
  15662. i, LastIndex: Integer;
  15663. GenScope: TPasGenericScope;
  15664. ProcScope: TPasProcedureScope;
  15665. begin
  15666. // insert in front of currently parsed elements
  15667. // beware: specializing an element can create other specialized elements
  15668. // add behind last finished specialized element of this GenericEl
  15669. // for example: A = class(B<C<D>>)
  15670. // =>
  15671. // D
  15672. // C<D>
  15673. // B<C<D>>
  15674. // A
  15675. Last:=GenericEl;
  15676. if SpecializedItems<>nil then
  15677. begin
  15678. i:=SpecializedItems.Count-2;
  15679. if i>=0 then
  15680. Last:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
  15681. end;
  15682. LastIndex:=List.IndexOf(Last);
  15683. if (LastIndex<0) then
  15684. if GenericEl is TPasProcedure then
  15685. else
  15686. RaiseNotYetImplemented(20200725093218,El);
  15687. i:=List.Count-1;
  15688. while i>LastIndex do
  15689. begin
  15690. Last:=TPasElement(List[i]);
  15691. if Last is TPasGenericType then
  15692. begin
  15693. if (Last.CustomData<>nil) then
  15694. begin
  15695. GenScope:=Last.CustomData as TPasGenericScope;
  15696. if GenScope.GenericStep>=psgsInterfaceParsed then
  15697. break; // finished generic type
  15698. end;
  15699. // type is still parsed => insert in front
  15700. dec(i);
  15701. end
  15702. else if Last is TPasProcedure then
  15703. begin
  15704. ProcScope:=Last.CustomData as TPasProcedureScope;
  15705. if ProcScope.GenericStep>=psgsInterfaceParsed then
  15706. break; // finished generic proc
  15707. // proc is still parsed => insert in front
  15708. dec(i);
  15709. end
  15710. else
  15711. break;
  15712. end;
  15713. List.Insert(i+1,NewEl);
  15714. end;
  15715. var
  15716. NewName: String;
  15717. NewClass: TPTreeElement;
  15718. SrcModule: TPasModule;
  15719. SrcModuleScope: TPasModuleScope;
  15720. SrcResolver: TPasResolver;
  15721. NewParent: TPasElement;
  15722. TypeItem: TPRSpecializedTypeItem;
  15723. ProcItem: TPRSpecializedProcItem;
  15724. begin
  15725. Result:=nil;
  15726. SrcModule:=GenericEl.GetModule;
  15727. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  15728. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  15729. if SrcResolver<>Self then
  15730. RaiseInternalError(20190728121705);
  15731. GenScope:=TPasGenericScope(GenericEl.CustomData);
  15732. SpecializedItems:=GenScope.SpecializedItems;
  15733. TypeItem:=nil;
  15734. ProcItem:=nil;
  15735. if GenericEl is TPasGenericType then
  15736. begin
  15737. TypeItem:=TPRSpecializedTypeItem.Create;
  15738. Result:=TypeItem;
  15739. end
  15740. else if GenericEl is TPasProcedure then
  15741. begin
  15742. ProcItem:=TPRSpecializedProcItem.Create;
  15743. Result:=ProcItem;
  15744. end
  15745. else
  15746. RaiseNotYetImplemented(20190920140756,GenericEl);
  15747. Result.GenericEl:=GenericEl;
  15748. Result.FirstSpecialize:=El;
  15749. Result.Params:=ParamsResolved;
  15750. Result.Index:=SpecializedItems.Count;
  15751. SpecializedItems.Add(Result);
  15752. NewName:=CreateSpecializedTypeName(Result);
  15753. NewClass:=TPTreeElement(GenericEl.ClassType);
  15754. NewParent:=GenericEl.Parent;
  15755. NewEl:=TPasElement(NewClass.Create(NewName,NewParent));
  15756. if TypeItem<>nil then
  15757. TypeItem.SpecializedType:=TPasGenericType(NewEl) // this calls AddRef
  15758. else
  15759. ProcItem.SpecializedProc:=TPasProcedure(NewEl); // this calls AddRef
  15760. if NewParent is TPasDeclarations then
  15761. begin
  15762. InsertBehind(TPasDeclarations(NewParent).Declarations);
  15763. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasDeclarations.Children');{$ENDIF}
  15764. end
  15765. else if NewParent is TPasMembersType then
  15766. begin
  15767. InsertBehind(TPasMembersType(NewParent).Members);
  15768. {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasMembersType.Members');{$ENDIF}
  15769. end
  15770. else
  15771. NewEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; // fix refcount
  15772. if GenScope.GenericStep>=psgsInterfaceParsed then
  15773. SpecializeGenericIntf(Result);
  15774. if GenScope.GenericStep>=psgsImplementationParsed then
  15775. SpecializeGenericImpl(Result);
  15776. end;
  15777. function TPasResolver.CreateSpecializedTypeName(Item: TPRSpecializedItem): string;
  15778. function GetTypeName(aType: TPasType): string; forward;
  15779. function GetSpecParams(Item: TPRSpecializedItem): string;
  15780. var
  15781. i: Integer;
  15782. begin
  15783. Result:='<';
  15784. for i:=0 to length(Item.Params)-1 do
  15785. begin
  15786. if i>0 then Result:=Result+',';
  15787. Result:=Result+GetTypeName(Item.Params[i]);
  15788. end;
  15789. Result:=Result+'>';
  15790. end;
  15791. function GetTypeName(aType: TPasType): string;
  15792. var
  15793. Arr: TPasArrayType;
  15794. ElType: TPasType;
  15795. ChildItem: TPRSpecializedItem;
  15796. begin
  15797. if aType.Name='' then
  15798. begin
  15799. if aType is TPasArrayType then
  15800. begin
  15801. // e.g. TBird<array of word>
  15802. Result:='array of ';
  15803. Arr:=TPasArrayType(aType);
  15804. if length(Arr.Ranges)>0 then
  15805. RaiseNotYetImplemented(20200905173026,Item.FirstSpecialize);
  15806. ElType:=ResolveAliasType(Arr.ElType,false);
  15807. if ElType is TPasArrayType then
  15808. RaiseNotYetImplemented(20200905173159,Arr,'multidimensional anonymous array as generic param');
  15809. Result:=Result+GetTypeName(ElType);
  15810. end
  15811. else
  15812. RaiseNotYetImplemented(20200905173241,aType);
  15813. end
  15814. else
  15815. begin
  15816. if aType.Parent is TPasType then
  15817. Result:=GetTypeName(TPasType(aType.Parent))
  15818. else if aType is TPasUnresolvedSymbolRef then
  15819. Result:='System'
  15820. else
  15821. Result:=aType.GetModule.Name;
  15822. Result:=Result+'.'+aType.Name;
  15823. if aType.CustomData is TPasGenericScope then
  15824. begin
  15825. ChildItem:=TPasGenericScope(aType.CustomData).SpecializedFromItem;
  15826. if ChildItem<>nil then
  15827. Result:=Result+GetSpecParams(ChildItem);
  15828. end;
  15829. end;
  15830. end;
  15831. begin
  15832. Result:=Item.GenericEl.Name+GetSpecParams(Item);
  15833. end;
  15834. procedure TPasResolver.InitSpecializeScopes(El: TPasElement; out
  15835. State: TScopeStashState);
  15836. function PushParentScopes(CurEl: TPasElement): integer;
  15837. var
  15838. Keep: Integer;
  15839. Scope: TPasScope;
  15840. IntfSection: TInterfaceSection;
  15841. begin
  15842. {$IFDEF VerboseInitSpecializeScopes}
  15843. writeln(' PushParentScopes START ',GetObjName(CurEl));
  15844. {$ENDIF}
  15845. if CurEl=nil then
  15846. RaiseInternalError(20190728125025);
  15847. if CurEl is TPasModule then
  15848. begin
  15849. if not (CurEl.CustomData is TPasModuleScope) then
  15850. RaiseNotYetImplemented(20190728142609,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15851. Keep:=0;
  15852. if FScopeCount<=Keep then
  15853. RaiseInternalError(20190728124857);
  15854. if not (FScopes[Keep] is TPasDefaultScope) then
  15855. RaiseInternalError(20190728124858);
  15856. end
  15857. else
  15858. begin
  15859. if CurEl.Parent=nil then
  15860. RaiseInternalError(20190728130238,GetObjName(CurEl));
  15861. if CurEl.CustomData=nil then
  15862. exit(PushParentScopes(CurEl.Parent));
  15863. if not (CurEl.CustomData is TPasIdentifierScope) then
  15864. RaiseNotYetImplemented(20190728131934,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData));
  15865. Keep:=PushParentScopes(CurEl.Parent);
  15866. end;
  15867. inc(Keep);
  15868. Scope:=TPasScope(CurEl.CustomData);
  15869. {$IFDEF VerboseInitSpecializeScopes}
  15870. writeln(' PushParentScopes ',GetObjName(CurEl),' Scope=',GetObjName(Scope),' Keep=',Keep);
  15871. {$ENDIF}
  15872. if Scope.FreeOnPop then
  15873. RaiseInternalError(20190728131153,GetObjName(CurEl));
  15874. if (Keep<FScopeCount) and (FScopes[Keep]=Scope) then
  15875. // Scope is already on the scopestack
  15876. else
  15877. begin
  15878. if Keep<FScopeCount then
  15879. begin
  15880. // cannot use current scope stack -> stash
  15881. {$IFDEF VerboseInitSpecializeScopes}
  15882. writeln(' PushParentScopes StashScopes Keep=',Keep);
  15883. {$ENDIF}
  15884. StashScopes(Keep);
  15885. if Keep<>FScopeCount then
  15886. RaiseNotYetImplemented(20190813005130,El);
  15887. State.ScopeCount:=ScopeCount;
  15888. end;
  15889. if (CurEl.ClassType=TImplementationSection) then
  15890. begin
  15891. // unit implementation -> push interface scope
  15892. IntfSection:=CurEl.GetModule.InterfaceSection;
  15893. if IntfSection=nil then
  15894. RaiseNotYetImplemented(20190825112907,CurEl);
  15895. if not (IntfSection.CustomData is TPasSectionScope) then
  15896. RaiseNotYetImplemented(20190825112907,CurEl);
  15897. PushScope(TPasSectionScope(IntfSection.CustomData));
  15898. inc(Keep);
  15899. end;
  15900. PushScope(Scope);
  15901. end;
  15902. exit(Keep);
  15903. end;
  15904. var
  15905. Keep: Integer;
  15906. begin
  15907. {$IFDEF VerboseInitSpecializeScopes}
  15908. writeln('TPasResolver.InitSpecializeScopes START ',GetObjName(El));
  15909. {$ENDIF}
  15910. State.ScopeCount:=ScopeCount;
  15911. State.StashCount:=FStashScopeCount;
  15912. Keep:=PushParentScopes(El.Parent)+1;
  15913. if Keep<FScopeCount then
  15914. begin
  15915. // cannot use current scope stack -> stash
  15916. {$IFDEF VerboseInitSpecializeScopes}
  15917. writeln('TPasResolver.InitSpecializeScopes StashScopes Keep=',Keep);
  15918. {$ENDIF}
  15919. StashScopes(Keep);
  15920. if Keep<>FScopeCount then
  15921. RaiseNotYetImplemented(20190813005859,El);
  15922. end;
  15923. {$IFDEF VerboseInitSpecializeScopes}
  15924. WriteScopesShort('TPasResolver.InitSpecializeScopes END');
  15925. {$ENDIF}
  15926. end;
  15927. procedure TPasResolver.RestoreSpecializeScopes(const State: TScopeStashState);
  15928. begin
  15929. while ScopeCount>State.ScopeCount do
  15930. PopScope;
  15931. RestoreStashedScopes(State.StashCount);
  15932. end;
  15933. procedure TPasResolver.SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem
  15934. );
  15935. var
  15936. SpecEl, GenericEl: TPasElement;
  15937. C: TClass;
  15938. NewRecordType, GenRecordType: TPasRecordType;
  15939. NewClassType, GenClassType: TPasClassType;
  15940. NewArrayType, GenArrayType: TPasArrayType;
  15941. GenProcType, NewProcType: TPasProcedureType;
  15942. GenProc, NewProc: TPasProcedure;
  15943. OldScopeState: TScopeStashState;
  15944. begin
  15945. if SpecializedItem.Step<>prssNone then
  15946. exit;
  15947. SpecializedItem.Step:=prssInterfaceBuilding;
  15948. SpecEl:=SpecializedItem.SpecializedEl;
  15949. GenericEl:=SpecializedItem.GenericEl;
  15950. // change scope
  15951. InitSpecializeScopes(GenericEl,OldScopeState);
  15952. {$IFDEF VerbosePasResolver}
  15953. WriteScopesShort('TPasResolver.SpecializeGenericIntf Init SpecEl='+SpecEl.FullName+' GenericEl='+GenericEl.FullName);
  15954. {$ENDIF}
  15955. SpecializePasElementProperties(GenericEl,SpecEl);
  15956. C:=SpecEl.ClassType;
  15957. if C=TPasRecordType then
  15958. begin
  15959. NewRecordType:=TPasRecordType(SpecEl);
  15960. GenRecordType:=TPasRecordType(GenericEl);
  15961. SpecializeRecordType(GenRecordType,NewRecordType,TPRSpecializedTypeItem(SpecializedItem));
  15962. end
  15963. else if C=TPasClassType then
  15964. begin
  15965. NewClassType:=TPasClassType(SpecEl);
  15966. GenClassType:=TPasClassType(GenericEl);
  15967. SpecializeClassType(GenClassType,NewClassType,TPRSpecializedTypeItem(SpecializedItem));
  15968. end
  15969. else if C=TPasArrayType then
  15970. begin
  15971. GenArrayType:=TPasArrayType(GenericEl);
  15972. NewArrayType:=TPasArrayType(SpecEl);
  15973. SpecializeArrayType(GenArrayType,NewArrayType,TPRSpecializedTypeItem(SpecializedItem));
  15974. end
  15975. else if (C=TPasProcedureType)
  15976. or (C=TPasFunctionType) then
  15977. begin
  15978. GenProcType:=TPasProcedureType(GenericEl);
  15979. NewProcType:=TPasProcedureType(SpecEl);
  15980. SpecializeProcedureType(GenProcType,NewProcType,TPRSpecializedTypeItem(SpecializedItem));
  15981. end
  15982. else if C.InheritsFrom(TPasProcedure) then
  15983. begin
  15984. GenProc:=TPasProcedure(GenericEl);
  15985. NewProc:=TPasProcedure(SpecEl);
  15986. SpecializeProcedure(GenProc,NewProc,SpecializedItem);
  15987. end
  15988. else
  15989. RaiseNotYetImplemented(20190728134933,GenericEl);
  15990. {$IFDEF VerbosePasResolver}
  15991. WriteScopesShort('TPasResolver.SpecializeGenericIntf Finish: '+SpecEl.FullName);
  15992. {$ENDIF}
  15993. RestoreSpecializeScopes(OldScopeState);
  15994. {$IFDEF VerbosePasResolver}
  15995. WriteScopesShort('TPasResolver.SpecializeGenericIntf RestoreStashedScopes: '+SpecEl.FullName);
  15996. {$ENDIF}
  15997. end;
  15998. procedure TPasResolver.SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem
  15999. );
  16000. var
  16001. GenericEl: TPasElement;
  16002. GenScope: TPasGenericScope;
  16003. SpecializedTypeItem: TPRSpecializedTypeItem;
  16004. SpecializedProcItem: TPRSpecializedProcItem;
  16005. GenImplProc, GenIntfProc, SpecDeclProc: TPasProcedure;
  16006. GenDeclProcScope: TPasProcedureScope;
  16007. OldScopeState: TScopeStashState;
  16008. begin
  16009. // check specialized type step
  16010. if SpecializedItem.Step>prssInterfaceFinished then
  16011. exit;
  16012. GenericEl:=SpecializedItem.GenericEl;
  16013. if SpecializedItem.Step<prssInterfaceFinished then
  16014. if GenericEl is TPasType then
  16015. RaiseMsg(20190804120128,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  16016. [GetTypeDescription(TPasType(GenericEl))],SpecializedItem.FirstSpecialize)
  16017. else
  16018. RaiseMsg(20190920190727,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  16019. [GenericEl.Name],SpecializedItem.FirstSpecialize);
  16020. SpecializedItem.Step:=prssImplementationBuilding;
  16021. // check generic type is resolved completely
  16022. GenScope:=TPasGenericScope(GenericEl.CustomData);
  16023. if GenScope.GenericStep<psgsImplementationParsed then
  16024. RaiseNotYetImplemented(20190804174019,GenericEl,GetObjName(SpecializedItem.SpecializedEl));
  16025. if GenericEl is TPasMembersType then
  16026. begin
  16027. // specialize all method bodies
  16028. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem);
  16029. if SpecializedTypeItem.ImplProcs=nil then
  16030. SpecializedTypeItem.ImplProcs:=TFPList.Create;
  16031. SpecializeMembersImpl(TPasMembersType(GenericEl),
  16032. TPasMembersType(SpecializedTypeItem.SpecializedType),
  16033. SpecializedTypeItem);
  16034. end
  16035. else if GenericEl is TPasProcedure then
  16036. begin
  16037. // specialize proc implementation
  16038. GenIntfProc:=TPasProcedure(GenericEl);
  16039. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then
  16040. //
  16041. else
  16042. begin
  16043. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem);
  16044. GenDeclProcScope:=TPasProcedureScope(GenScope);
  16045. GenImplProc:=GenDeclProcScope.ImplProc;
  16046. if GenImplProc=nil then
  16047. RaiseNotYetImplemented(20190920211609,SpecializedProcItem.SpecializedProc);
  16048. if GenImplProc.Body=nil then
  16049. RaiseNotYetImplemented(20190920192731,GenImplProc); // GenScope.GenericStep is wrong
  16050. SpecDeclProc:=SpecializedProcItem.SpecializedProc;
  16051. InitSpecializeScopes(GenImplProc,OldScopeState);
  16052. SpecializeGenImplProc(GenIntfProc,SpecDeclProc,SpecializedProcItem);
  16053. RestoreSpecializeScopes(OldScopeState);
  16054. end;
  16055. end;
  16056. SpecializedItem.Step:=prssImplementationFinished;
  16057. end;
  16058. procedure TPasResolver.SpecializeMembers(GenMembersType,
  16059. SpecMembersType: TPasMembersType);
  16060. var
  16061. i: Integer;
  16062. GenEl, NewEl: TPasElement;
  16063. NewClass: TPTreeElement;
  16064. begin
  16065. for i:=0 to GenMembersType.Members.Count-1 do
  16066. begin
  16067. GenEl:=TPasElement(GenMembersType.Members[i]);
  16068. if GenEl.Parent<>GenMembersType then
  16069. RaiseNotYetImplemented(20190728145634,GenEl,GetObjName(GenEl.Parent));
  16070. NewClass:=TPTreeElement(GenEl.ClassType);
  16071. NewEl:=TPasElement(NewClass.Create(GenEl.Name,SpecMembersType));
  16072. SpecMembersType.Members.Add(NewEl);
  16073. SpecializeElement(GenEl,NewEl);
  16074. end;
  16075. end;
  16076. procedure TPasResolver.SpecializeMembersImpl(GenericType,
  16077. SpecType: TPasMembersType; SpecializedItem: TPRSpecializedTypeItem);
  16078. var
  16079. GenClassOrRec, SpecClassOrRec: TPasMembersType;
  16080. i: Integer;
  16081. GenMember, SpecMember, ImplParent: TPasElement;
  16082. GenIntfProc, GenImplProc, SpecIntfProc: TPasProcedure;
  16083. GenIntfProcScope: TPasProcedureScope;
  16084. OldScopeState: TScopeStashState;
  16085. begin
  16086. GenClassOrRec:=TPasMembersType(GenericType);
  16087. SpecClassOrRec:=TPasMembersType(SpecType);
  16088. {$IFDEF VerbosePasResolver}
  16089. writeln('TPasResolver.SpecializeMembersImpl RestoreStashedScopes ',GetObjPath(SpecClassOrRec),' ',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  16090. {$ENDIF}
  16091. // specialize member bodies
  16092. ImplParent:=nil;
  16093. OldScopeState:=default(TScopeStashState);
  16094. for i:=0 to GenClassOrRec.Members.Count-1 do
  16095. begin
  16096. GenMember:=TPasElement(GenClassOrRec.Members[i]);
  16097. SpecMember:=TPasElement(SpecClassOrRec.Members[i]);
  16098. if SpecMember.ClassType<>GenMember.ClassType then
  16099. RaiseNotYetImplemented(20190816002658,GenMember,GetObjName(SpecMember));
  16100. if SpecMember.Name<>GenMember.Name then
  16101. RaiseNotYetImplemented(20190804124220,GenMember,GetObjName(SpecMember));
  16102. if GenMember is TPasProcedure then
  16103. begin
  16104. GenIntfProc:=TPasProcedure(GenMember);
  16105. SpecIntfProc:=TPasProcedure(SpecMember);
  16106. if GenIntfProc.IsAbstract or GenIntfProc.IsExternal then continue;
  16107. GenIntfProcScope:=TPasProcedureScope(GenIntfProc.CustomData);
  16108. GenImplProc:=GenIntfProcScope.ImplProc;
  16109. if GenImplProc=nil then
  16110. RaiseNotYetImplemented(20190921221246,GenIntfProc);
  16111. if ImplParent=nil then
  16112. begin
  16113. // switch scope (e.g. unit implementation section)
  16114. ImplParent:=GenImplProc.Parent;
  16115. InitSpecializeScopes(GenImplProc,OldScopeState);
  16116. {$IFDEF VerbosePasResolver}
  16117. writeln('TPasResolver.SpecializeGenImplProc Specialize implprocs: SpecType=',GetObjName(SpecType),' ImplParent=',GetObjName(ImplParent),' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount,' TopScope=',GetObjName(TopScope));
  16118. {$ENDIF}
  16119. end
  16120. else if ImplParent<>GenImplProc.Parent then
  16121. RaiseNotYetImplemented(20190804130322,GenImplProc,GetObjName(ImplParent));
  16122. SpecializeGenImplProc(GenIntfProc,SpecIntfProc,SpecializedItem);
  16123. end
  16124. else if GenMember is TPasMembersType then
  16125. begin
  16126. // nested record/class type
  16127. SpecializeMembersImpl(TPasMembersType(GenMember),TPasMembersType(SpecMember),
  16128. SpecializedItem);
  16129. end;
  16130. end;
  16131. if ImplParent<>nil then
  16132. begin
  16133. // restore scope
  16134. RestoreSpecializeScopes(OldScopeState);
  16135. end;
  16136. end;
  16137. procedure TPasResolver.SpecializeGenImplProc(GenDeclProc,
  16138. SpecDeclProc: TPasProcedure; SpecializedItem: TPRSpecializedItem);
  16139. procedure InsertBehind(ParentElList: TFPList;
  16140. SpecializedItems: TObjectList; GenImplProc, SpecImplProc: TPasProcedure);
  16141. // insert SpecImplProc behind last specialized impl proc
  16142. // Note: impl procs are not always specialized in order
  16143. var
  16144. Last: TPasProcedure;
  16145. i: Integer;
  16146. begin
  16147. Last:=nil;
  16148. if SpecializedItems<>nil then
  16149. begin
  16150. i:=SpecializedItems.Count-1;
  16151. while i>=0 do
  16152. begin
  16153. Last:=TPRSpecializedProcItem(SpecializedItems[i]).ImplProc;
  16154. if Last=SpecImplProc then
  16155. Last:=nil
  16156. else if Last<>nil then
  16157. break;
  16158. dec(i);
  16159. end;
  16160. end;
  16161. if Last=nil then
  16162. Last:=GenImplProc;
  16163. i:=ParentElList.IndexOf(Last);
  16164. if i<0 then
  16165. begin
  16166. {$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
  16167. {AllowWriteln}
  16168. writeln('InsertBehind GenImplProc=',GetObjPath(GenImplProc),' Last=',GetObjPath(Last));
  16169. for i:=0 to ParentElList.Count-1 do
  16170. begin
  16171. writeln(' ',GetObjName(TObject(ParentElList[i])));
  16172. if TObject(ParentElList[i]) is TPasProcedure then
  16173. writeln(' IsForward=',TPasProcedure(ParentElList[i]).IsForward);
  16174. end;
  16175. {AllowWriteln-}
  16176. {$ENDIF}
  16177. RaiseNotYetImplemented(20191017122900,GenDeclProc);
  16178. end;
  16179. ParentElList.Insert(i+1,SpecImplProc);
  16180. SpecImplProc.AddRef{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Children'){$ENDIF};
  16181. end;
  16182. var
  16183. GenDeclProcScope, GenImplProcScope, SpecDeclProcScope,
  16184. SpecImplProcScope: TPasProcedureScope;
  16185. GenImplProc, SpecImplProc: TPasProcedure;
  16186. NewClass: TPTreeElement;
  16187. SpecClassOrRec, GenClassOrRec: TPasMembersType;
  16188. SpecClassOrRecScope: TPasClassOrRecordScope;
  16189. NewImplProcName, OldClassname: String;
  16190. p, LastDotP: Integer;
  16191. SpecializedProcItem: TPRSpecializedProcItem;
  16192. SpecializedTypeItem: TPRSpecializedTypeItem;
  16193. Templates: TFPList;
  16194. NewParent: TPasElement;
  16195. begin
  16196. SpecializedProcItem:=nil;
  16197. SpecializedTypeItem:=nil;
  16198. if SpecializedItem is TPRSpecializedProcItem then
  16199. // impl proc of a specialized forward proc
  16200. SpecializedProcItem:=TPRSpecializedProcItem(SpecializedItem)
  16201. else if SpecializedItem is TPRSpecializedTypeItem then
  16202. // method of a specialized class/record
  16203. SpecializedTypeItem:=TPRSpecializedTypeItem(SpecializedItem)
  16204. else
  16205. RaiseNotYetImplemented(20190922145050,SpecDeclProc);
  16206. GenDeclProcScope:=TPasProcedureScope(GenDeclProc.CustomData);
  16207. GenImplProc:=GenDeclProcScope.ImplProc;
  16208. if GenImplProc=nil then
  16209. RaiseNotYetImplemented(20190804122134,GenDeclProc);
  16210. if GenImplProc.Body=nil then
  16211. RaiseNotYetImplemented(20190921220216,GenImplProc);
  16212. GenImplProcScope:=TPasProcedureScope(GenImplProc.CustomData);
  16213. SpecDeclProcScope:=TPasProcedureScope(SpecDeclProc.CustomData);
  16214. if SpecDeclProc.Parent is TPasMembersType then
  16215. begin
  16216. SpecClassOrRec:=SpecDeclProc.Parent as TPasMembersType;
  16217. SpecClassOrRecScope:=SpecClassOrRec.CustomData as TPasClassOrRecordScope;
  16218. end
  16219. else
  16220. begin
  16221. SpecClassOrRec:=nil;
  16222. SpecClassOrRecScope:=nil;
  16223. end;
  16224. {$IFDEF VerbosePasResolver}
  16225. writeln('TPasResolver.SpecializeGenImplProc Specialize GenImplProc: ',GetObjName(GenImplProc));
  16226. {$ENDIF}
  16227. // create impl proc name
  16228. if SpecializedTypeItem<>nil then
  16229. begin
  16230. // method of a specialized class/record
  16231. if SpecClassOrRecScope=nil then
  16232. RaiseNotYetImplemented(20190921221839,SpecDeclProc);
  16233. NewImplProcName:=GenImplProc.Name;
  16234. LastDotP:=GetLastDotPos(NewImplProcName);
  16235. if LastDotP<1 then
  16236. RaiseNotYetImplemented(20190921221730,GenImplProc);
  16237. // has classname -> replace generic classname with specialized classname
  16238. p:=LastDotP;
  16239. while (p>1) and (NewImplProcName[p-1]<>'.') do dec(p);
  16240. OldClassname:=copy(NewImplProcName,p,LastDotP-p);
  16241. GenClassOrRec:=GenDeclProc.Parent as TPasMembersType;
  16242. if not SameText(OldClassname,GenClassOrRec.Name) then
  16243. RaiseNotYetImplemented(20190814141833,GenImplProc);
  16244. NewImplProcName:=LeftStr(NewImplProcName,p-1)+SpecClassOrRec.Name+copy(NewImplProcName,LastDotP,length(NewImplProcName));
  16245. end
  16246. else
  16247. begin
  16248. // use classname of GenImplProc and name of SpecDeclProc
  16249. OldClassname:=GenImplProc.Name;
  16250. p:=GetLastDotPos(OldClassname);
  16251. if p>0 then
  16252. NewImplProcName:=LeftStr(OldClassname,p)+SpecDeclProc.Name
  16253. else
  16254. NewImplProcName:=SpecDeclProc.Name;
  16255. end;
  16256. // create impl proc
  16257. NewClass:=TPTreeElement(GenImplProc.ClassType);
  16258. NewParent:=GenImplProc.Parent;
  16259. SpecImplProc:=TPasProcedure(NewClass.Create(NewImplProcName,NewParent));
  16260. SpecDeclProcScope.ImplProc:=SpecImplProc;
  16261. if SpecializedProcItem<>nil then
  16262. SpecializedProcItem.ImplProc:=SpecImplProc
  16263. else
  16264. SpecializedTypeItem.ImplProcs.Add(SpecImplProc);
  16265. if (SpecializedProcItem<>nil) and (NewParent is TPasDeclarations) then
  16266. InsertBehind(TPasDeclarations(NewParent).Declarations,
  16267. GenDeclProcScope.SpecializedItems,GenImplProc,SpecImplProc);
  16268. // create impl proc scope
  16269. SpecImplProcScope:=TPasProcedureScope(CreateScope(SpecImplProc,FScopeClass_Proc));
  16270. SpecImplProcScope.Flags:=[ppsfIsSpecialized];
  16271. SpecImplProcScope.DeclarationProc:=SpecDeclProc;
  16272. SpecImplProcScope.ModeSwitches:=GenImplProcScope.Modeswitches;
  16273. SpecImplProcScope.BoolSwitches:=GenImplProcScope.BoolSwitches;
  16274. SpecImplProcScope.VisibilityContext:=SpecClassOrRec;
  16275. SpecImplProcScope.ClassRecScope:=SpecClassOrRecScope;
  16276. if GenDeclProcScope.SelfArg<>nil then
  16277. RaiseNotYetImplemented(20190922154603,GenImplProc);
  16278. if SpecializedProcItem<>nil then
  16279. begin
  16280. Templates:=GetProcTemplateTypes(GenDeclProc);
  16281. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecImplProcScope,
  16282. false);
  16283. end;
  16284. // specialize props
  16285. SpecializePasElementProperties(GenImplProc,SpecImplProc);
  16286. AddProcedure(SpecImplProc,nil);
  16287. SpecializeProcedure(GenImplProc,SpecImplProc,SpecializedItem);
  16288. end;
  16289. procedure TPasResolver.SpecializeElement(GenEl, SpecEl: TPasElement);
  16290. var
  16291. C: TClass;
  16292. begin
  16293. // first copy sourcefilename and linenumber needed by error messages
  16294. SpecializePasElementProperties(GenEl,SpecEl);
  16295. C:=GenEl.ClassType;
  16296. // expressions
  16297. if C=TPrimitiveExpr then
  16298. SpecializePrimitiveExpr(TPrimitiveExpr(GenEl),TPrimitiveExpr(SpecEl))
  16299. else if C=TUnaryExpr then
  16300. SpecializeUnaryExpr(TUnaryExpr(GenEl),TUnaryExpr(SpecEl))
  16301. else if C=TBinaryExpr then
  16302. SpecializeBinaryExpr(TBinaryExpr(GenEl),TBinaryExpr(SpecEl))
  16303. else if C=TBoolConstExpr then
  16304. SpecializeBoolConstExpr(TBoolConstExpr(GenEl),TBoolConstExpr(SpecEl))
  16305. else if C=TNilExpr then
  16306. SpecializeExpr(TNilExpr(GenEl),TNilExpr(SpecEl))
  16307. else if C=TInheritedExpr then
  16308. SpecializeExpr(TInheritedExpr(GenEl),TInheritedExpr(SpecEl))
  16309. else if C=TParamsExpr then
  16310. SpecializeParamsExpr(TParamsExpr(GenEl),TParamsExpr(SpecEl))
  16311. else if C=TRecordValues then
  16312. SpecializeRecordValues(TRecordValues(GenEl),TRecordValues(SpecEl))
  16313. else if C=TArrayValues then
  16314. SpecializeArrayValues(TArrayValues(GenEl),TArrayValues(SpecEl))
  16315. else if C=TInlineSpecializeExpr then
  16316. SpecializeInlineSpecializeExpr(TInlineSpecializeExpr(GenEl),TInlineSpecializeExpr(SpecEl))
  16317. else if C=TProcedureExpr then
  16318. SpecializeProcedureExpr(TProcedureExpr(GenEl),TProcedureExpr(SpecEl))
  16319. // TPasType
  16320. else if (C=TPasAliasType)
  16321. or (C=TPasTypeAliasType)
  16322. or (C=TPasClassOfType) then
  16323. begin
  16324. AddType(TPasAliasType(SpecEl));
  16325. SpecializeAliasType(TPasAliasType(GenEl),TPasAliasType(SpecEl));
  16326. end
  16327. else if C=TPasPointerType then
  16328. begin
  16329. AddType(TPasPointerType(SpecEl));
  16330. SpecializePointerType(TPasPointerType(GenEl),TPasPointerType(SpecEl));
  16331. end
  16332. else if C=TPasRangeType then
  16333. begin
  16334. AddType(TPasRangeType(SpecEl));
  16335. SpecializeRangeType(TPasRangeType(GenEl),TPasRangeType(SpecEl));
  16336. end
  16337. else if C=TPasArrayType then
  16338. begin
  16339. if GetTypeParameterCount(TPasArrayType(GenEl))>0 then
  16340. RaiseNotYetImplemented(20190815201219,GenEl);
  16341. AddArrayType(TPasArrayType(SpecEl),nil);
  16342. SpecializeArrayType(TPasArrayType(GenEl),TPasArrayType(SpecEl),nil);
  16343. end
  16344. else if C=TPasEnumValue then
  16345. begin
  16346. AddEnumValue(TPasEnumValue(SpecEl));
  16347. SpecializeEnumValue(TPasEnumValue(GenEl),TPasEnumValue(SpecEl));
  16348. end
  16349. else if C=TPasEnumType then
  16350. begin
  16351. AddEnumType(TPasEnumType(SpecEl));
  16352. SpecializeEnumType(TPasEnumType(GenEl),TPasEnumType(SpecEl));
  16353. end
  16354. else if C=TPasSetType then
  16355. SpecializeSetType(TPasSetType(GenEl),TPasSetType(SpecEl))
  16356. else if C=TPasVariant then
  16357. SpecializeVariant(TPasVariant(GenEl),TPasVariant(SpecEl))
  16358. else if C=TPasRecordType then
  16359. begin
  16360. if GetTypeParameterCount(TPasRecordType(GenEl))>0 then
  16361. RaiseNotYetImplemented(20190815201201,GenEl);
  16362. AddRecordType(TPasRecordType(SpecEl),nil);
  16363. SpecializeRecordType(TPasRecordType(GenEl),TPasRecordType(SpecEl),nil);
  16364. end
  16365. else if C=TPasClassType then
  16366. begin
  16367. if GetTypeParameterCount(TPasClassType(GenEl))>0 then
  16368. RaiseNotYetImplemented(20190816214947,GenEl);
  16369. AddClassType(TPasClassType(SpecEl),nil);
  16370. SpecializeClassType(TPasClassType(GenEl),TPasClassType(SpecEl),nil);
  16371. end
  16372. else if C=TPasStringType then
  16373. begin
  16374. AddType(TPasStringType(SpecEl));
  16375. SpecializeStringType(TPasStringType(GenEl),TPasStringType(SpecEl));
  16376. end
  16377. else if C=TPasSpecializeType then
  16378. begin
  16379. AddType(TPasSpecializeType(SpecEl));
  16380. SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
  16381. end
  16382. else if C=TPasGenericTemplateType then
  16383. SpecializeGenericTemplateType(TPasGenericTemplateType(GenEl),TPasGenericTemplateType(SpecEl))
  16384. // empty statement
  16385. else if C=TPasImplCommand then
  16386. // TPasImplBlock
  16387. else if C=TPasImplBeginBlock then
  16388. SpecializeImplBlock(TPasImplBeginBlock(GenEl),TPasImplBeginBlock(SpecEl))
  16389. else if C=TPasImplAsmStatement then
  16390. SpecializeImplAsmStatement(TPasImplAsmStatement(GenEl),TPasImplAsmStatement(SpecEl))
  16391. else if C=TPasImplRepeatUntil then
  16392. SpecializeImplRepeatUntil(TPasImplRepeatUntil(GenEl),TPasImplRepeatUntil(SpecEl))
  16393. else if C=TPasImplIfElse then
  16394. SpecializeImplIfElse(TPasImplIfElse(GenEl),TPasImplIfElse(SpecEl))
  16395. else if C=TPasImplWhileDo then
  16396. SpecializeImplWhileDo(TPasImplWhileDo(GenEl),TPasImplWhileDo(SpecEl))
  16397. else if C=TPasImplWithDo then
  16398. SpecializeImplWithDo(TPasImplWithDo(GenEl),TPasImplWithDo(SpecEl))
  16399. else if C=TPasImplCaseOf then
  16400. SpecializeImplCaseOf(TPasImplCaseOf(GenEl),TPasImplCaseOf(SpecEl))
  16401. else if C=TPasImplCaseStatement then
  16402. SpecializeImplCaseStatement(TPasImplCaseStatement(GenEl),TPasImplCaseStatement(SpecEl))
  16403. else if C=TPasImplCaseElse then
  16404. SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
  16405. else if C=TPasImplAssign then
  16406. SpecializeImplAssign(TPasImplAssign(GenEl),TPasImplAssign(SpecEl))
  16407. else if C=TPasImplSimple then
  16408. SpecializeImplSimple(TPasImplSimple(GenEl),TPasImplSimple(SpecEl))
  16409. else if C=TPasImplForLoop then
  16410. SpecializeImplForLoop(TPasImplForLoop(GenEl),TPasImplForLoop(SpecEl))
  16411. else if C=TPasImplTry then
  16412. SpecializeImplTry(TPasImplTry(GenEl),TPasImplTry(SpecEl))
  16413. else if (C=TPasImplTryFinally)
  16414. or (C=TPasImplTryExcept)
  16415. or (C=TPasImplTryExceptElse) then
  16416. SpecializeImplBlock(TPasImplTryHandler(GenEl),TPasImplTryHandler(SpecEl))
  16417. else if C=TPasImplExceptOn then
  16418. begin
  16419. AddExceptOn(TPasImplExceptOn(SpecEl));
  16420. SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl));
  16421. end
  16422. else if C=TPasImplRaise then
  16423. SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
  16424. // declaration
  16425. else if C=TPasResString then
  16426. begin
  16427. AddResourceString(TPasResString(SpecEl));
  16428. SpecializeResString(TPasResString(GenEl),TPasResString(SpecEl));
  16429. end
  16430. else if C=TPasVariable then
  16431. begin
  16432. AddVariable(TPasVariable(SpecEl));
  16433. SpecializeVariable(TPasVariable(GenEl),TPasVariable(SpecEl),true);
  16434. end
  16435. else if C=TPasConst then
  16436. begin
  16437. AddVariable(TPasConst(SpecEl));
  16438. SpecializeConst(TPasConst(GenEl),TPasConst(SpecEl));
  16439. end
  16440. else if C=TPasProperty then
  16441. begin
  16442. AddProperty(TPasProperty(SpecEl));
  16443. SpecializeProperty(TPasProperty(GenEl),TPasProperty(SpecEl));
  16444. end
  16445. else if C=TPasAttributes then
  16446. SpecializeAttributes(TPasAttributes(GenEl),TPasAttributes(SpecEl))
  16447. else if C=TPasMethodResolution then
  16448. SpecializeMethodResolution(TPasMethodResolution(GenEl),TPasMethodResolution(SpecEl))
  16449. // procedure
  16450. else if C=TPasArgument then
  16451. begin
  16452. AddArgument(TPasArgument(SpecEl));
  16453. SpecializeArgument(TPasArgument(GenEl),TPasArgument(SpecEl));
  16454. end
  16455. else if C=TProcedureBody then
  16456. begin
  16457. AddProcedureBody(TProcedureBody(SpecEl));
  16458. SpecializeProcedureBody(TProcedureBody(GenEl),TProcedureBody(SpecEl));
  16459. end
  16460. else if C=TPasOperator then
  16461. begin
  16462. AddProcedure(TPasOperator(SpecEl),nil);
  16463. SpecializeOperator(TPasOperator(GenEl),TPasOperator(SpecEl));
  16464. end
  16465. else if C.InheritsFrom(TPasProcedure) then
  16466. begin
  16467. AddProcedure(TPasProcedure(SpecEl),nil);
  16468. SpecializeProcedure(TPasProcedure(GenEl),TPasProcedure(SpecEl),nil);
  16469. end
  16470. else if C.InheritsFrom(TPasProcedureType) then
  16471. begin
  16472. AddProcedureType(TPasProcedureType(SpecEl),nil);
  16473. SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
  16474. end
  16475. else
  16476. RaiseNotYetImplemented(20190728151215,GenEl);
  16477. end;
  16478. procedure TPasResolver.SpecializePasElementProperties(GenEl, SpecEl: TPasElement
  16479. );
  16480. begin
  16481. SpecEl.SourceFilename:=GenEl.SourceFilename;
  16482. SpecEl.SourceLinenumber:=GenEl.SourceLinenumber;;
  16483. SpecEl.SourceEndLinenumber:=GenEl.SourceEndLinenumber;
  16484. SpecEl.Visibility:=GenEl.Visibility;
  16485. SpecEl.Hints:=GenEl.Hints;
  16486. SpecEl.HintMessage:=GenEl.HintMessage;
  16487. SpecEl.DocComment:=GenEl.DocComment;
  16488. end;
  16489. procedure TPasResolver.SpecializeVariable(GenEl, SpecEl: TPasVariable;
  16490. Finish: boolean);
  16491. begin
  16492. SpecializeElType(GenEl,SpecEl,GenEl.VarType,SpecEl.VarType);
  16493. SpecEl.VarModifiers:=GenEl.VarModifiers;
  16494. if GenEl.LibraryName<>nil then
  16495. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryName,SpecEl.LibraryName);
  16496. if GenEl.ExportName<>nil then
  16497. SpecializeElExpr(GenEl,SpecEl,GenEl.ExportName,SpecEl.ExportName);
  16498. SpecEl.Modifiers:=GenEl.Modifiers;
  16499. if GenEl.AbsoluteExpr<>nil then
  16500. SpecializeElExpr(GenEl,SpecEl,GenEl.AbsoluteExpr,SpecEl.AbsoluteExpr);
  16501. if GenEl.Expr<>nil then
  16502. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16503. if Finish then
  16504. FinishVariable(SpecEl);
  16505. end;
  16506. procedure TPasResolver.SpecializeConst(GenEl, SpecEl: TPasConst);
  16507. begin
  16508. SpecEl.IsConst:=GenEl.IsConst;
  16509. SpecializeVariable(GenEl,SpecEl,true);
  16510. end;
  16511. procedure TPasResolver.SpecializeProperty(GenEl, SpecEl: TPasProperty);
  16512. begin
  16513. SpecializeVariable(GenEl,SpecEl,false);
  16514. SpecializeElExpr(GenEl,SpecEl,GenEl.IndexExpr,SpecEl.IndexExpr);
  16515. SpecializeElExpr(GenEl,SpecEl,GenEl.ReadAccessor,SpecEl.ReadAccessor);
  16516. SpecializeElExpr(GenEl,SpecEl,GenEl.WriteAccessor,SpecEl.WriteAccessor);
  16517. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16518. SpecializeExprArray(GenEl,SpecEl,GenEl.Implements,SpecEl.Implements);
  16519. SpecializeElExpr(GenEl,SpecEl,GenEl.StoredAccessor,SpecEl.StoredAccessor);
  16520. SpecializeElExpr(GenEl,SpecEl,GenEl.DefaultExpr,SpecEl.DefaultExpr);
  16521. SpecEl.DispIDReadOnly:=GenEl.DispIDReadOnly;
  16522. SpecEl.IsDefault:=GenEl.IsDefault;
  16523. SpecEl.IsNodefault:=GenEl.IsNodefault;
  16524. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16525. {$IFDEF CheckPasTreeRefCount},'TPasProperty.Args'{$ENDIF});
  16526. FinishProperty(SpecEl);
  16527. end;
  16528. function TPasResolver.SpecializeTypeRef(GenEl, SpecEl: TPasElement;
  16529. GenTypeRef: TPasType): TPasType;
  16530. var
  16531. Ref: TPasElement;
  16532. begin
  16533. if GenTypeRef.Name='' then
  16534. RaiseNotYetImplemented(20190813213555,GenEl,GetObjPath(GenTypeRef));
  16535. Ref:=FindElement(GenTypeRef.Name);
  16536. if not (Ref is TPasType) then
  16537. RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
  16538. if SpecEl=nil then ;
  16539. Result:=TPasType(Ref);
  16540. end;
  16541. procedure TPasResolver.SpecializeElType(GenEl, SpecEl: TPasElement;
  16542. GenElType: TPasType; var SpecElType: TPasType);
  16543. var
  16544. NewClass: TPTreeElement;
  16545. begin
  16546. if GenElType=nil then exit;
  16547. if SpecElType<>nil then
  16548. RaiseNotYetImplemented(20190812021617,GenEl);
  16549. if (GenElType.Parent<>GenEl)
  16550. or (GenElType.ClassType=TPasGenericTemplateType) then
  16551. begin
  16552. // reference
  16553. GenElType:=SpecializeTypeRef(GenEl,SpecEl,GenElType);
  16554. SpecElType:=GenElType;
  16555. SpecElType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  16556. exit;
  16557. end;
  16558. // e.g. anonymous type
  16559. if SpecElType<>nil then
  16560. RaiseNotYetImplemented(20190808222744,SpecEl,GetObjName(SpecElType));
  16561. NewClass:=TPTreeElement(GenElType.ClassType);
  16562. SpecElType:=TPasType(NewClass.Create(GenElType.Name,SpecEl));
  16563. SpecializeElement(GenElType,SpecElType);
  16564. end;
  16565. procedure TPasResolver.SpecializeElExpr(GenEl, SpecEl: TPasElement;
  16566. GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
  16567. var
  16568. NewClass: TPTreeElement;
  16569. begin
  16570. if GenElExpr=nil then exit;
  16571. if SpecElExpr<>nil then
  16572. RaiseNotYetImplemented(20190803220248,SpecEl,GetObjName(SpecElExpr));
  16573. if GenElExpr.Parent<>GenEl then
  16574. RaiseNotYetImplemented(20190809160834,GenEl);
  16575. // normal expression
  16576. NewClass:=TPTreeElement(GenElExpr.ClassType);
  16577. SpecElExpr:=TPasExpr(NewClass.Create(GenElExpr.Name,SpecEl));
  16578. SpecializeElement(GenElExpr,SpecElExpr);
  16579. end;
  16580. procedure TPasResolver.SpecializeElImplEl(GenEl, SpecEl: TPasElement;
  16581. GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
  16582. var
  16583. NewClass: TPTreeElement;
  16584. begin
  16585. if GenImplEl=nil then exit;
  16586. if GenImplEl.Parent<>GenEl then
  16587. RaiseNotYetImplemented(20190808222638,GenEl,GetObjName(GenImplEl.Parent));
  16588. NewClass:=TPTreeElement(GenImplEl.ClassType);
  16589. SpecImplEl:=TPasImplElement(NewClass.Create(GenImplEl.Name,SpecEl));
  16590. SpecializeElement(GenImplEl,SpecImplEl);
  16591. end;
  16592. procedure TPasResolver.SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
  16593. GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
  16594. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16595. var
  16596. i: Integer;
  16597. begin
  16598. if GenImplAlias=nil then exit;
  16599. i:=GenEl.Elements.IndexOf(GenImplAlias);
  16600. if i<0 then
  16601. RaiseNotYetImplemented(20190808225239,GenEl);
  16602. SpecImplAlias:=TObject(SpecEl.Elements[i]) as TPasImplElement;
  16603. if SpecImplAlias.ClassType<>GenImplAlias.ClassType then
  16604. RaiseNotYetImplemented(20190808231616,GenImplAlias,GetObjName(SpecImplAlias));
  16605. SpecImplAlias.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16606. end;
  16607. procedure TPasResolver.SpecializeElList(GenEl, SpecEl: TPasElement;
  16608. GenList, SpecList: TFPList; AllowReferences: boolean
  16609. {$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16610. var
  16611. i: Integer;
  16612. GenListItem, SpecListItem, Ref: TPasElement;
  16613. NewClass: TPTreeElement;
  16614. begin
  16615. for i:=0 to GenList.Count-1 do
  16616. begin
  16617. GenListItem:=TPasElement(GenList[i]);
  16618. if GenListItem.Parent<>GenEl then
  16619. begin
  16620. if not AllowReferences then
  16621. RaiseNotYetImplemented(20190808212421,GenEl,IntToStr(i));
  16622. if not (GenListItem is TPasType) then
  16623. RaiseNotYetImplemented(20190812025715,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16624. // reference
  16625. Ref:=SpecializeTypeRef(GenEl,SpecEl,TpasType(GenListItem));
  16626. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16627. SpecList.Add(Ref);
  16628. continue;
  16629. end;
  16630. if GenListItem.ClassType=TPasGenericTemplateType then
  16631. RaiseNotYetImplemented(20190812233309,GenEl);
  16632. NewClass:=TPTreeElement(GenListItem.ClassType);
  16633. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16634. SpecList.Add(SpecListItem);
  16635. SpecializeElement(GenListItem,SpecListItem);
  16636. end;
  16637. end;
  16638. procedure TPasResolver.SpecializeElArray(GenEl, SpecEl: TPasElement;
  16639. GenList: TPasElementArray; var SpecList: TPasElementArray;
  16640. AllowReferences: boolean{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
  16641. var
  16642. l, i: Integer;
  16643. GenListItem, Ref, SpecListItem: TPasElement;
  16644. NewClass: TPTreeElement;
  16645. begin
  16646. if length(SpecList)>0 then
  16647. RaiseNotYetImplemented(20190914102814,GenEl,GetObjName(SpecEl));
  16648. l:=length(GenList);
  16649. SetLength(SpecList,l);
  16650. for i:=0 to l-1 do
  16651. SpecList[i]:=nil;
  16652. for i:=0 to l-1 do
  16653. begin
  16654. GenListItem:=GenList[i];
  16655. if GenListItem.Parent<>GenEl then
  16656. begin
  16657. if not AllowReferences then
  16658. RaiseNotYetImplemented(20190914102952,GenEl,IntToStr(i));
  16659. if not (GenListItem is TPasType) then
  16660. RaiseNotYetImplemented(20190914102957,GenEl,IntToStr(i)+' GenListItem='+GetObjName(GenListItem));
  16661. // reference
  16662. Ref:=SpecializeTypeRef(GenEl,SpecEl,TPasType(GenListItem));
  16663. Ref.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
  16664. SpecList[i]:=Ref;
  16665. continue;
  16666. end;
  16667. if GenListItem.ClassType=TPasGenericTemplateType then
  16668. RaiseNotYetImplemented(20190914103040,GenEl);
  16669. NewClass:=TPTreeElement(GenListItem.ClassType);
  16670. SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
  16671. SpecList[i]:=SpecListItem;
  16672. SpecializeElement(GenListItem,SpecListItem);
  16673. end;
  16674. end;
  16675. procedure TPasResolver.SpecializeProcedure(GenEl, SpecEl: TPasProcedure;
  16676. SpecializedItem: TPRSpecializedItem);
  16677. var
  16678. GenProcType: TPasProcedureType;
  16679. NewClass: TPTreeElement;
  16680. SpecProcScope, GenProcScope: TPasProcedureScope;
  16681. i, j: Integer;
  16682. GenPart, SpecPart: TProcedureNamePart;
  16683. GenTempl, SpecTempl: TPasGenericTemplateType;
  16684. Templates: TFPList;
  16685. GenBody: TProcedureBody;
  16686. begin
  16687. GenProcScope:=GenEl.CustomData as TPasProcedureScope;
  16688. SpecProcScope:=SpecEl.CustomData as TPasProcedureScope;
  16689. if SpecProcScope<>nil then
  16690. begin
  16691. if TopScope<>SpecProcScope then
  16692. RaiseNotYetImplemented(20190920194151,SpecEl);
  16693. end
  16694. else if SpecializedItem<>nil then
  16695. begin
  16696. // specialized generic/parametrized procedure
  16697. SpecProcScope:=TPasProcedureScope(PushScope(SpecEl,ScopeClass_Procedure));
  16698. SpecProcScope.SpecializedFromItem:=SpecializedItem;
  16699. if GenProcScope.DeclarationProc<>nil then
  16700. RaiseNotYetImplemented(20190920203700,SpecEl);
  16701. if GenProcScope.OverriddenProc<>nil then
  16702. RaiseNotYetImplemented(20190920203536,SpecEl);
  16703. SpecProcScope.ClassRecScope:=GenProcScope.ClassRecScope;
  16704. if GenProcScope.SelfArg<>nil then
  16705. RaiseNotYetImplemented(20190920203626,SpecEl);
  16706. // SpecProcScope.Flags
  16707. SpecProcScope.ModeSwitches:=GenProcScope.ModeSwitches;
  16708. SpecProcScope.BoolSwitches:=GenProcScope.BoolSwitches;
  16709. Templates:=GetProcTemplateTypes(GenEl);
  16710. if (Templates=nil) or (Templates.Count=0) then
  16711. RaiseNotYetImplemented(20190920183140,SpecEl);
  16712. AddSpecializedTemplateIdentifiers(Templates,SpecializedItem,SpecProcScope,true);
  16713. end
  16714. else
  16715. RaiseNotYetImplemented(20190922153918,SpecEl);
  16716. Include(SpecProcScope.Flags,ppsfIsSpecialized);
  16717. if GenEl.PublicName<>nil then
  16718. SpecializeElExpr(GenEl,SpecEl,GenEl.PublicName,SpecEl.PublicName);
  16719. if GenEl.LibrarySymbolName<>nil then
  16720. SpecializeElExpr(GenEl,SpecEl,GenEl.LibrarySymbolName,SpecEl.LibrarySymbolName);
  16721. if GenEl.LibraryExpr<>nil then
  16722. SpecializeElExpr(GenEl,SpecEl,GenEl.LibraryExpr,SpecEl.LibraryExpr);
  16723. if GenEl.DispIDExpr<>nil then
  16724. SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
  16725. if GenEl.MessageExpr<>nil then
  16726. SpecializeElExpr(GenEl,SpecEl,GenEl.MessageExpr,SpecEl.MessageExpr);
  16727. SpecEl.MessageName:=GenEl.MessageName;
  16728. SpecEl.MessageType:=GenEl.MessageType;
  16729. SpecEl.AliasName:=GenEl.AliasName;
  16730. SpecEl.Modifiers:=GenEl.Modifiers;
  16731. if GenEl.NameParts<>nil then
  16732. begin
  16733. if SpecEl.NameParts<>nil then
  16734. RaiseNotYetImplemented(20190818125620,SpecEl);
  16735. SpecEl.NameParts:=TFPList.Create;
  16736. for i:=0 to GenEl.NameParts.Count-1 do
  16737. begin
  16738. GenPart:=TProcedureNamePart(GenEl.NameParts[i]);
  16739. SpecPart:=TProcedureNamePart.Create;
  16740. SpecEl.NameParts.Add(SpecPart);
  16741. SpecPart.Name:=GenPart.Name;
  16742. if GenPart.Templates<>nil then
  16743. begin
  16744. if (SpecializedItem<>nil) and (i=GenEl.NameParts.Count-1) then
  16745. begin
  16746. // the templates have been specialized to SpecializedItem.Params
  16747. continue;
  16748. end;
  16749. SpecPart.Templates:=TFPList.Create;
  16750. for j:=0 to GenPart.Templates.Count-1 do
  16751. begin
  16752. GenTempl:=TPasGenericTemplateType(GenPart.Templates[j]);
  16753. if GenTempl.Parent<>GenEl then
  16754. RaiseNotYetImplemented(20190818130001,GenEl,IntToStr(i)+','+IntToStr(j)+':'+GenTempl.Name+' GenParent='+GetObjName(GenTempl.Parent)+' GenEl='+GetObjName(GenEl));
  16755. NewClass:=TPTreeElement(GenTempl.ClassType);
  16756. SpecTempl:=TPasGenericTemplateType(NewClass.Create(GenTempl.Name,SpecEl));
  16757. SpecPart.Templates.Add(SpecTempl);
  16758. SpecializeElement(GenTempl,SpecTempl);
  16759. end;
  16760. end;
  16761. end;
  16762. end;
  16763. if GenEl.ProcType<>nil then
  16764. begin
  16765. GenProcType:=GenEl.ProcType;
  16766. if GenProcType.Parent<>GenEl then
  16767. RaiseNotYetImplemented(20190803212426,GenEl,GetObjName(GenProcType.Parent));
  16768. NewClass:=TPTreeElement(GenProcType.ClassType);
  16769. SpecEl.ProcType:=TPasProcedureType(NewClass.Create(GenProcType.Name,SpecEl));
  16770. SpecializeElement(GenProcType,SpecEl.ProcType);
  16771. end;
  16772. SpecProcScope.GenericStep:=psgsInterfaceParsed;
  16773. if GenEl.Body<>nil then
  16774. begin
  16775. // implementation proc
  16776. if SpecializedItem<>nil then
  16777. SpecializedItem.Step:=prssImplementationBuilding;
  16778. GenBody:=GenEl.Body;
  16779. if GenBody.Parent<>GenEl then
  16780. RaiseNotYetImplemented(20190804183308,GenEl,GetObjName(GenBody.Parent));
  16781. if SpecEl.Body<>nil then
  16782. RaiseNotYetImplemented(20190920211853,SpecEl);
  16783. NewClass:=TPTreeElement(GenBody.ClassType);
  16784. SpecEl.Body:=TProcedureBody(NewClass.Create(GenBody.Name,SpecEl));
  16785. SpecializeElement(GenBody,SpecEl.Body);
  16786. FinishProcedure(SpecEl);
  16787. end
  16788. else if SpecializedItem=nil then
  16789. // declaration proc, parent is specialized
  16790. FinishProcedure(SpecEl)
  16791. else
  16792. begin
  16793. // specialized generic procedure, body is not yet parsed
  16794. SpecializedItem.Step:=prssInterfaceFinished;
  16795. if TopScope<>SpecProcScope then
  16796. RaiseNotYetImplemented(20190920190400,SpecEl);
  16797. PopScope;
  16798. end;
  16799. end;
  16800. procedure TPasResolver.SpecializeOperator(GenEl, SpecEl: TPasOperator);
  16801. begin
  16802. SpecEl.OperatorType:=GenEl.OperatorType;
  16803. SpecEl.TokenBased:=GenEl.TokenBased;
  16804. SpecializeProcedure(GenEl,SpecEl,nil);
  16805. end;
  16806. procedure TPasResolver.SpecializeProcedureType(GenEl,
  16807. SpecEl: TPasProcedureType; SpecializedItem: TPRSpecializedItem);
  16808. var
  16809. GenResultEl, NewResultEl: TPasResultElement;
  16810. NewClass: TPTreeElement;
  16811. i: Integer;
  16812. SpecScope: TPasGenericScope;
  16813. begin
  16814. if GenEl.GenericTemplateTypes<>nil then
  16815. begin
  16816. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_ProcType));
  16817. if SpecializedItem<>nil then
  16818. begin
  16819. // specialized procedure type
  16820. SpecScope.SpecializedFromItem:=SpecializedItem;
  16821. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  16822. SpecializedItem,SpecScope,true);
  16823. end
  16824. else
  16825. begin
  16826. // generic procedure type inside a generic type
  16827. RaiseNotYetImplemented(20190813194550,GenEl);
  16828. end;
  16829. end;
  16830. // Args
  16831. SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
  16832. {$IFDEF CheckPasTreeRefCount},'TPasProcedureType.Args'{$ENDIF});
  16833. for i:=0 to SpecEl.Args.Count-1 do
  16834. FinishArgument(TPasArgument(SpecEl.Args[i]));
  16835. // varargs
  16836. SpecializeElType(GenEl,SpecEl,GenEl.VarArgsType,SpecEl.VarArgsType);
  16837. // calling convention and proc type modifiers
  16838. SpecEl.CallingConvention:=GenEl.CallingConvention;
  16839. SpecEl.Modifiers:=GenEl.Modifiers;
  16840. // function result
  16841. if SpecEl is TPasFunctionType then
  16842. begin
  16843. GenResultEl:=TPasFunctionType(GenEl).ResultEl;
  16844. if GenResultEl.Parent<>GenEl then
  16845. RaiseNotYetImplemented(20190803212935,GenEl,GetObjName(GenResultEl.Parent));
  16846. NewClass:=TPTreeElement(GenResultEl.ClassType);
  16847. NewResultEl:=TPasResultElement(NewClass.Create(GenResultEl.Name,SpecEl));
  16848. TPasFunctionType(SpecEl).ResultEl:=NewResultEl;
  16849. AddFunctionResult(NewResultEl);
  16850. SpecializeElType(GenResultEl,NewResultEl,GenResultEl.ResultType,NewResultEl.ResultType);
  16851. end;
  16852. FinishProcedureType(SpecEl);
  16853. if SpecializedItem<>nil then
  16854. SpecializedItem.Step:=prssImplementationFinished;
  16855. end;
  16856. procedure TPasResolver.SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
  16857. var
  16858. GenBody, NewBody: TPasImplBlock;
  16859. NewClass: TPTreeElement;
  16860. begin
  16861. SpecializeDeclarations(GenEl,SpecEl);
  16862. FinishTypeSection(SpecEl);
  16863. if GenEl.Body<>nil then
  16864. begin
  16865. GenBody:=GenEl.Body;
  16866. if GenBody.Parent<>GenEl then
  16867. RaiseNotYetImplemented(20190804184934,GenBody);
  16868. NewClass:=TPTreeElement(GenBody.ClassType);
  16869. NewBody:=TPasImplBlock(NewClass.Create(GenBody.Name,SpecEl));
  16870. SpecEl.Body:=NewBody;
  16871. SpecializeElement(GenBody,NewBody);
  16872. end;
  16873. end;
  16874. procedure TPasResolver.SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
  16875. var
  16876. i: Integer;
  16877. GenDecl, NewDecl: TPasElement;
  16878. NewClass: TPTreeElement;
  16879. begin
  16880. for i:=0 to GenEl.Declarations.Count-1 do
  16881. begin
  16882. GenDecl:=TPasElement(GenEl.Declarations[i]);
  16883. if GenDecl.Parent<>GenEl then
  16884. RaiseNotYetImplemented(20190806091336,GenEl,GetObjName(GenDecl));
  16885. NewClass:=TPTreeElement(GenDecl.ClassType);
  16886. NewDecl:=TPasElement(NewClass.Create(GenDecl.Name,SpecEl));
  16887. SpecEl.Declarations.Add(NewDecl);
  16888. if NewClass=TPasAttributes then
  16889. SpecEl.Attributes.Add(NewDecl)
  16890. else if (NewClass=TPasClassType)
  16891. or (NewClass=TPasRecordType) then
  16892. SpecEl.Classes.Add(NewDecl)
  16893. else if NewClass=TPasConst then
  16894. SpecEl.Consts.Add(NewDecl)
  16895. else if NewClass=TPasExportSymbol then
  16896. SpecEl.ExportSymbols.Add(NewDecl)
  16897. else if NewClass.InheritsFrom(TPasProcedure) then
  16898. SpecEl.Functions.Add(NewDecl)
  16899. else if NewClass=TPasProperty then
  16900. SpecEl.Properties.Add(NewDecl)
  16901. else if NewClass=TPasResString then
  16902. SpecEl.ResStrings.Add(NewDecl)
  16903. else if NewClass.InheritsFrom(TPasType) then
  16904. SpecEl.Types.Add(NewDecl)
  16905. else if NewClass=TPasVariable then
  16906. SpecEl.Variables.Add(NewDecl)
  16907. else
  16908. RaiseNotYetImplemented(20190804184718,GenDecl);
  16909. SpecializeElement(GenDecl,NewDecl);
  16910. end;
  16911. end;
  16912. procedure TPasResolver.SpecializeSpecializeType(GenEl,
  16913. SpecEl: TPasSpecializeType);
  16914. var
  16915. GenDestType: TPasType;
  16916. Ref: TPasElement;
  16917. begin
  16918. // search DestType<ParamCount>
  16919. GenDestType:=GenEl.DestType;
  16920. if GenDestType=nil then
  16921. RaiseNotYetImplemented(20190812022211,GenEl);
  16922. if GenDestType.Parent=GenEl then
  16923. RaiseNotYetImplemented(20190812022251,GenEl);
  16924. Ref:=FindElementFor(GenDestType.Name,GenEl.Parent,GenEl.Params.Count);
  16925. if not (Ref is TPasGenericType) then
  16926. RaiseNotYetImplemented(20190812022359,GenEl,GetObjName(Ref));
  16927. SpecEl.DestType:=TPasGenericType(Ref);
  16928. SpecEl.DestType.AddRef{$IFDEF CheckPasTreeRefCount}('ResolveTypeReference'){$ENDIF};
  16929. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  16930. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true
  16931. {$IFDEF CheckPasTreeRefCount},'TPasSpecializeType.Params'{$ENDIF});
  16932. FinishSpecializeType(SpecEl);
  16933. {$IFDEF VerbosePasResolver}
  16934. //writeln('TPasResolver.SpecializeSpecializeType ',GetObjName(SpecEl.DestType),' ',GetObjName(SpecEl.CustomData));
  16935. {$ENDIF}
  16936. end;
  16937. procedure TPasResolver.SpecializeGenericTemplateType(GenEl,
  16938. SpecEl: TPasGenericTemplateType);
  16939. var
  16940. GenConstraints, SpecConstraints: TPasElementArray;
  16941. i: Integer;
  16942. ConEl: TPasElement;
  16943. begin
  16944. GenConstraints:=GenEl.Constraints;
  16945. if length(SpecEl.Constraints)>0 then
  16946. RaiseNotYetImplemented(20190914070209,GenEl);
  16947. SetLength(SpecEl.Constraints,length(GenConstraints));
  16948. SpecConstraints:=SpecEl.Constraints;
  16949. for i:=0 to length(SpecConstraints)-1 do
  16950. SpecConstraints[i]:=nil;
  16951. for i:=0 to length(GenConstraints)-1 do
  16952. begin
  16953. ConEl:=GenConstraints[i];
  16954. if ConEl is TPasExpr then
  16955. SpecializeElExpr(GenEl,SpecEl,TPasExpr(ConEl),TPasExpr(SpecConstraints[i]))
  16956. else if ConEl is TPasType then
  16957. SpecializeElType(GenEl,SpecEl,TPasType(ConEl),TPasType(SpecConstraints[i]))
  16958. else
  16959. RaiseNotYetImplemented(20190914070522,GenEl,IntToStr(i)+' '+GetObjName(ConEl));
  16960. end;
  16961. end;
  16962. procedure TPasResolver.SpecializeArgument(GenEl, SpecEl: TPasArgument);
  16963. begin
  16964. SpecEl.Access:=GenEl.Access;
  16965. SpecializeElType(GenEl,SpecEl,GenEl.ArgType,SpecEl.ArgType);
  16966. if GenEl.ValueExpr<>nil then
  16967. SpecializeElExpr(GenEl,SpecEl,GenEl.ValueExpr,SpecEl.ValueExpr);
  16968. // FinishArgument is called when all arguments are ready
  16969. end;
  16970. procedure TPasResolver.SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
  16971. var
  16972. i: Integer;
  16973. GenImpl, NewImpl: TPasImplElement;
  16974. NewClass: TPTreeElement;
  16975. begin
  16976. for i:=0 to GenEl.Elements.Count-1 do
  16977. begin
  16978. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  16979. if GenImpl.Parent<>GenEl then
  16980. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  16981. NewClass:=TPTreeElement(GenImpl.ClassType);
  16982. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  16983. SpecEl.Elements.Add(NewImpl);
  16984. SpecializeElement(GenImpl,NewImpl);
  16985. end;
  16986. end;
  16987. procedure TPasResolver.SpecializeImplAsmStatement(GenEl,
  16988. SpecEl: TPasImplAsmStatement);
  16989. begin
  16990. SpecializeImplBlock(GenEl,SpecEl);
  16991. SpecEl.Tokens.Assign(GenEl.Tokens);
  16992. end;
  16993. procedure TPasResolver.SpecializeImplRepeatUntil(GenEl,
  16994. SpecEl: TPasImplRepeatUntil);
  16995. begin
  16996. SpecializeImplBlock(GenEl,SpecEl);
  16997. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  16998. end;
  16999. procedure TPasResolver.SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
  17000. begin
  17001. // do not call SpecializeImplBlock(GenEl,SpecEl);
  17002. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  17003. SpecializeElImplEl(GenEl,SpecEl,GenEl.IfBranch,SpecEl.IfBranch);
  17004. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,SpecEl.ElseBranch);
  17005. end;
  17006. procedure TPasResolver.SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
  17007. begin
  17008. // do not call SpecializeImplBlock(GenEl,SpecEl);
  17009. SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
  17010. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17011. end;
  17012. procedure TPasResolver.SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
  17013. var
  17014. i: Integer;
  17015. GenExpr, SpecExpr: TPasExpr;
  17016. NewClass: TPTreeElement;
  17017. begin
  17018. if SpecEl.CustomData<>nil then
  17019. RaiseNotYetImplemented(20200530201007,GenEl,GetObjName(SpecEl.CustomData));
  17020. PushScope(SpecEl,TPasWithScope);
  17021. for i:=0 to GenEl.Expressions.Count-1 do
  17022. begin
  17023. GenExpr:=TPasExpr(GenEl.Expressions[i]);
  17024. if GenExpr.Parent<>GenEl then
  17025. RaiseNotYetImplemented(20190808224343,GenEl,IntToStr(i));
  17026. NewClass:=TPTreeElement(GenExpr.ClassType);
  17027. SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
  17028. SpecEl.Expressions.Add(SpecExpr);
  17029. SpecializeElement(GenExpr,SpecExpr);
  17030. BeginScope(stWithExpr,SpecExpr);
  17031. end;
  17032. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17033. FinishWithDo(SpecEl);
  17034. end;
  17035. procedure TPasResolver.SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
  17036. begin
  17037. SpecializeElExpr(GenEl,SpecEl,GenEl.CaseExpr,SpecEl.CaseExpr);
  17038. SpecializeImplBlock(GenEl,SpecEl); // Elements
  17039. if GenEl.ElseBranch<>nil then
  17040. SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,TPasImplElement(SpecEl.ElseBranch)
  17041. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseOf.ElseBranch'{$ENDIF});
  17042. end;
  17043. procedure TPasResolver.SpecializeImplCaseStatement(GenEl,
  17044. SpecEl: TPasImplCaseStatement);
  17045. begin
  17046. SpecializeElList(GenEl,SpecEl,GenEl.Expressions,SpecEl.Expressions,false
  17047. {$IFDEF CheckPasTreeRefCount},'TPasImplCaseStatement.CaseExpr'{$ENDIF});
  17048. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17049. end;
  17050. procedure TPasResolver.SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
  17051. begin
  17052. if GenEl.Elements.Count>0 then
  17053. RaiseNotYetImplemented(20190808142935,GenEl);
  17054. SpecEl.Kind:=GenEl.Kind;
  17055. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  17056. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  17057. end;
  17058. procedure TPasResolver.SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
  17059. begin
  17060. if GenEl.Elements.Count>0 then
  17061. RaiseNotYetImplemented(20190808142935,GenEl);
  17062. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17063. end;
  17064. procedure TPasResolver.SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
  17065. var
  17066. i: Integer;
  17067. GenImpl, NewImpl: TPasImplElement;
  17068. NewClass: TPTreeElement;
  17069. begin
  17070. if GenEl.Variable<>nil then
  17071. RaiseNotYetImplemented(20190808142627,GenEl);
  17072. SpecializeElExpr(GenEl,SpecEl,GenEl.VariableName,SpecEl.VariableName);
  17073. SpecEl.LoopType:=GenEl.LoopType;
  17074. SpecializeElExpr(GenEl,SpecEl,GenEl.StartExpr,SpecEl.StartExpr);
  17075. SpecializeElExpr(GenEl,SpecEl,GenEl.EndExpr,SpecEl.EndExpr);
  17076. FinishForLoopHeader(SpecEl);
  17077. // SpecEl.Body is set via AddElement
  17078. for i:=0 to GenEl.Elements.Count-1 do
  17079. begin
  17080. GenImpl:=TPasImplElement(GenEl.Elements[i]);
  17081. if GenImpl.Parent<>GenEl then
  17082. RaiseNotYetImplemented(20190806092151,GenEl,GetElementSourcePosStr(GenImpl));
  17083. NewClass:=TPTreeElement(GenImpl.ClassType);
  17084. NewImpl:=TPasImplElement(NewClass.Create(GenImpl.Name,SpecEl));
  17085. SpecEl.AddElement(NewImpl);
  17086. SpecializeElement(GenImpl,NewImpl);
  17087. end;
  17088. end;
  17089. procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
  17090. begin
  17091. SpecializeImplBlock(GenEl,SpecEl); // clone elements
  17092. if GenEl.FinallyExcept<>nil then
  17093. SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
  17094. TPasImplElement(SpecEl.FinallyExcept));
  17095. if GenEl.ElseBranch<>nil then
  17096. SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
  17097. TPasImplElement(SpecEl.ElseBranch));
  17098. end;
  17099. procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
  17100. var
  17101. GenVar: TPasVariable;
  17102. NewClass: TPTreeElement;
  17103. begin
  17104. GenVar:=GenEl.VarEl;
  17105. if GenVar<>nil then
  17106. begin
  17107. if GenVar.Parent<>GenEl then
  17108. RaiseNotYetImplemented(20190808232327,GenEl);
  17109. NewClass:=TPTreeElement(GenVar.ClassType);
  17110. SpecEl.VarEl:=TPasVariable(NewClass.Create(GenVar.Name,SpecEl));
  17111. SpecializeElement(GenVar,SpecEl.VarEl);
  17112. if GenVar.VarType<>GenEl.TypeEl then
  17113. RaiseNotYetImplemented(20190808232601,GenEl);
  17114. SpecEl.TypeEl:=SpecEl.VarEl.VarType;
  17115. SpecEl.TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
  17116. end
  17117. else
  17118. SpecializeElType(GenEl,SpecEl,GenEl.TypeEl,SpecEl.TypeEl);
  17119. FinishExceptOnExpr;
  17120. SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
  17121. FinishExceptOnStatement;
  17122. end;
  17123. procedure TPasResolver.SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
  17124. begin
  17125. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptObject,SpecEl.ExceptObject);
  17126. SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptAddr,SpecEl.ExceptAddr);
  17127. end;
  17128. procedure TPasResolver.SpecializeExpr(GenEl, SpecEl: TPasExpr);
  17129. begin
  17130. SpecEl.Kind:=GenEl.Kind;
  17131. SpecEl.OpCode:=GenEl.OpCode;
  17132. SpecializeElExpr(GenEl,SpecEl,GenEl.format1,SpecEl.format1);
  17133. SpecializeElExpr(GenEl,SpecEl,GenEl.format2,SpecEl.format2);
  17134. end;
  17135. procedure TPasResolver.SpecializeExprArray(GenEl, SpecEl: TPasElement;
  17136. GenArray: TPasExprArray; var SpecArray: TPasExprArray);
  17137. var
  17138. i: Integer;
  17139. begin
  17140. if length(SpecArray)>0 then
  17141. RaiseNotYetImplemented(20190808205855,GenEl);
  17142. SetLength(SpecArray,length(GenArray));
  17143. for i:=0 to length(SpecArray)-1 do
  17144. SpecArray[i]:=nil;
  17145. for i:=0 to length(GenArray)-1 do
  17146. SpecializeElExpr(GenEl,SpecEl,GenArray[i],SpecArray[i]);
  17147. end;
  17148. procedure TPasResolver.SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
  17149. begin
  17150. SpecializeExpr(GenEl,SpecEl);
  17151. SpecEl.Value:=GenEl.Value;
  17152. end;
  17153. procedure TPasResolver.SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
  17154. begin
  17155. SpecializeExpr(GenEl,SpecEl);
  17156. SpecializeElExpr(GenEl,SpecEl,GenEl.Operand,SpecEl.Operand);
  17157. end;
  17158. procedure TPasResolver.SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
  17159. begin
  17160. SpecializeExpr(GenEl,SpecEl);
  17161. SpecializeElExpr(GenEl,SpecEl,GenEl.left,SpecEl.left);
  17162. SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
  17163. end;
  17164. procedure TPasResolver.SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
  17165. begin
  17166. SpecializeExpr(GenEl,SpecEl);
  17167. SpecEl.Value:=GenEl.Value;
  17168. end;
  17169. procedure TPasResolver.SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
  17170. begin
  17171. SpecializeExpr(GenEl,SpecEl);
  17172. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  17173. SpecializeExprArray(GenEl,SpecEl,GenEl.Params,SpecEl.Params);
  17174. end;
  17175. procedure TPasResolver.SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
  17176. var
  17177. GenField: TRecordValuesItem;
  17178. i: Integer;
  17179. SpecFieldP: PRecordValuesItem;
  17180. begin
  17181. SpecializeExpr(GenEl,SpecEl);
  17182. // fields
  17183. SetLength(SpecEl.Fields,length(GenEl.Fields));
  17184. for i:=0 to length(SpecEl.Fields)-1 do
  17185. with SpecEl.Fields[i] do
  17186. begin
  17187. NameExp:=nil;
  17188. ValueExp:=nil;
  17189. end;
  17190. for i:=0 to length(GenEl.Fields)-1 do
  17191. begin
  17192. GenField:=GenEl.Fields[i];
  17193. if GenField.NameExp.Parent<>GenEl then
  17194. RaiseNotYetImplemented(20190808205128,GenEl);
  17195. if GenField.ValueExp.Parent<>GenEl then
  17196. RaiseNotYetImplemented(20190808205138,GenEl);
  17197. SpecFieldP:[email protected][i];
  17198. SpecializeElExpr(GenEl,SpecEl,GenField.NameExp,TPasExpr(SpecFieldP^.NameExp));
  17199. SpecializeElExpr(GenEl,SpecEl,GenField.ValueExp,SpecFieldP^.ValueExp);
  17200. end;
  17201. end;
  17202. procedure TPasResolver.SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
  17203. begin
  17204. SpecializeExpr(GenEl,SpecEl);
  17205. SpecializeExprArray(GenEl,SpecEl,GenEl.Values,SpecEl.Values);
  17206. end;
  17207. procedure TPasResolver.SpecializeInlineSpecializeExpr(GenEl,
  17208. SpecEl: TInlineSpecializeExpr);
  17209. begin
  17210. SpecializeExpr(GenEl,SpecEl);
  17211. SpecializeElExpr(GenEl,SpecEl,GenEl.NameExpr,SpecEl.NameExpr);
  17212. SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,
  17213. true{$IFDEF CheckPasTreeRefCount},'TInlineSpecializeExpr.Params'{$ENDIF});
  17214. end;
  17215. procedure TPasResolver.SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
  17216. begin
  17217. SpecializeExpr(GenEl,SpecEl);
  17218. if GenEl.Proc=nil then
  17219. RaiseNotYetImplemented(20190808221018,GenEl);
  17220. RaiseNotYetImplemented(20190808221040,GenEl);
  17221. end;
  17222. procedure TPasResolver.SpecializeResString(GenEl, SpecEl: TPasResString);
  17223. begin
  17224. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17225. FinishResourcestring(SpecEl);
  17226. end;
  17227. procedure TPasResolver.SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
  17228. begin
  17229. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  17230. SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
  17231. // not needed by specialize: FinishTypeAlias();
  17232. FinishTypeDef(SpecEl);
  17233. end;
  17234. procedure TPasResolver.SpecializePointerType(GenEl, SpecEl: TPasPointerType);
  17235. begin
  17236. SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
  17237. FinishPointerType(SpecEl);
  17238. end;
  17239. procedure TPasResolver.SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
  17240. begin
  17241. SpecializeElExpr(GenEl,SpecEl,GenEl.RangeExpr,TPasExpr(SpecEl.RangeExpr));
  17242. FinishRangeType(SpecEl);
  17243. end;
  17244. procedure TPasResolver.SpecializeArrayType(GenEl, SpecEl: TPasArrayType;
  17245. SpecializedItem: TPRSpecializedTypeItem);
  17246. var
  17247. SpecScope: TPasGenericScope;
  17248. begin
  17249. SpecEl.IndexRange:=GenEl.IndexRange;
  17250. SpecEl.PackMode:=GenEl.PackMode;
  17251. if GenEl.GenericTemplateTypes<>nil then
  17252. begin
  17253. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_Array));
  17254. if SpecializedItem<>nil then
  17255. begin
  17256. // specialized generic array
  17257. SpecScope.SpecializedFromItem:=SpecializedItem;
  17258. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  17259. SpecializedItem,SpecScope,true);
  17260. end
  17261. else
  17262. begin
  17263. // generic arraytype inside a generic type
  17264. RaiseNotYetImplemented(20190812225218,GenEl);
  17265. end;
  17266. end;
  17267. SpecializeExprArray(GenEl,SpecEl,GenEl.Ranges,SpecEl.Ranges);
  17268. SpecializeElType(GenEl,SpecEl,GenEl.ElType,SpecEl.ElType);
  17269. FinishArrayType(SpecEl);
  17270. if SpecializedItem<>nil then
  17271. SpecializedItem.Step:=prssImplementationFinished;
  17272. end;
  17273. procedure TPasResolver.SpecializeRecordType(GenEl, SpecEl: TPasRecordType;
  17274. SpecializedItem: TPRSpecializedTypeItem);
  17275. var
  17276. SpecScope: TPasGenericScope;
  17277. begin
  17278. SpecEl.PackMode:=GenEl.PackMode;
  17279. if SpecializedItem<>nil then
  17280. begin
  17281. // specialized generic record
  17282. if SpecEl.CustomData<>nil then
  17283. RaiseNotYetImplemented(20190921204740,SpecEl);
  17284. SpecScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_Record));
  17285. SpecScope.VisibilityContext:=SpecEl;
  17286. SpecScope.SpecializedFromItem:=SpecializedItem;
  17287. AddSpecializedTemplateIdentifiers(GenEl.GenericTemplateTypes,
  17288. SpecializedItem,SpecScope,true);
  17289. if not (msDelphi in CurrentParser.CurrentModeswitches) then
  17290. begin
  17291. // ObjFPC: add canonical type alias
  17292. SpecScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
  17293. end;
  17294. end
  17295. else if GenEl.GenericTemplateTypes.Count>0 then
  17296. begin
  17297. // generic recordtype inside a generic type
  17298. if SpecEl.CustomData=nil then
  17299. RaiseNotYetImplemented(20190815201634,SpecEl);
  17300. SpecScope:=TPasGenericScope(SpecEl.CustomData);
  17301. RaiseNotYetImplemented(20190815194327,GenEl);
  17302. end;
  17303. // specialize sub elements
  17304. SpecializeMembers(GenEl,SpecEl);
  17305. FinishRecordType(SpecEl);
  17306. if SpecializedItem<>nil then
  17307. SpecializedItem.Step:=prssInterfaceFinished;
  17308. end;
  17309. procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType;
  17310. SpecializedItem: TPRSpecializedTypeItem);
  17311. var
  17312. HeaderScope: TPasGenericParamsScope;
  17313. TemplType: TPasGenericTemplateType;
  17314. GenericTemplateTypes: TFPList;
  17315. SpecClassScope: TPasClassScope;
  17316. begin
  17317. GenericTemplateTypes:=GenEl.GenericTemplateTypes;
  17318. SpecEl.ObjKind:=GenEl.ObjKind;
  17319. SpecEl.PackMode:=GenEl.PackMode;
  17320. if GenEl.HelperForType<>nil then
  17321. RaiseNotYetImplemented(20190730182758,GenEl,'');
  17322. if GenEl.IsForward then
  17323. RaiseNotYetImplemented(20190730182858,GenEl);
  17324. SpecEl.IsExternal:=GenEl.IsExternal;
  17325. SpecEl.IsShortDefinition:=GenEl.IsShortDefinition;
  17326. if GenEl.GUIDExpr<>nil then
  17327. SpecializeElExpr(GenEl,SpecEl,GenEl.GUIDExpr,SpecEl.GUIDExpr);
  17328. SpecEl.Modifiers.Assign(GenEl.Modifiers);
  17329. SpecEl.ExternalNameSpace:=GenEl.ExternalNameSpace;
  17330. SpecEl.ExternalName:=GenEl.ExternalName;
  17331. SpecEl.InterfaceType:=GenEl.InterfaceType;
  17332. // ancestor+interfaces
  17333. if SpecializedItem<>nil then
  17334. begin
  17335. // ancestor can be a specialized type. For example: = class(TAncestor<T>)
  17336. // -> create a scope with the specialized parameters
  17337. HeaderScope:=TPasGenericParamsScope.Create;
  17338. SpecializedItem.HeaderScope:=HeaderScope;
  17339. TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
  17340. HeaderScope.Element:=TemplType;
  17341. PushScope(HeaderScope);
  17342. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  17343. SpecializedItem,HeaderScope,true);
  17344. end
  17345. else
  17346. HeaderScope:=nil;
  17347. SpecializeElType(GenEl,SpecEl,
  17348. GenEl.AncestorType,SpecEl.AncestorType);
  17349. SpecializeElList(GenEl,SpecEl,
  17350. GenEl.Interfaces,SpecEl.Interfaces,true
  17351. {$IFDEF CheckPasTreeRefCount},'TPasClassType.Interfaces'{$ENDIF});
  17352. if HeaderScope<>nil then
  17353. begin
  17354. if TopScope<>HeaderScope then
  17355. RaiseNotYetImplemented(20190813003056,GenEl);
  17356. PopScope;
  17357. SpecializedItem.HeaderScope:=nil;
  17358. HeaderScope.Free;
  17359. end;
  17360. FinishAncestors(SpecEl);
  17361. if GenEl.Interfaces.Count<>SpecEl.Interfaces.Count then
  17362. RaiseNotYetImplemented(20200601125556,GenEl,IntToStr(GenEl.Interfaces.Count)+'<>'+IntToStr(SpecEl.Interfaces.Count));
  17363. // Note: class scope was created by FinishAncestors
  17364. SpecClassScope:=NoNil(SpecEl.CustomData) as TPasClassScope;
  17365. if SpecClassScope.SpecializedFromItem<>nil then
  17366. RaiseNotYetImplemented(20190816215413,SpecEl);
  17367. if SpecializedItem<>nil then
  17368. begin
  17369. SpecClassScope.SpecializedFromItem:=SpecializedItem;
  17370. AddSpecializedTemplateIdentifiers(GenericTemplateTypes,
  17371. SpecializedItem,SpecClassScope,false);
  17372. if not (msDelphi in CurrentParser.CurrentModeswitches) then
  17373. begin
  17374. // ObjFPC: add canonical type alias
  17375. SpecClassScope.AddIdentifier(GenEl.Name,SpecEl,pikSimple);
  17376. end;
  17377. end;
  17378. // specialize sub elements
  17379. SpecializeMembers(GenEl,SpecEl);
  17380. if SpecializedItem<>nil then
  17381. SpecializedItem.Step:=prssInterfaceFinished;
  17382. FinishClassType(SpecEl);
  17383. end;
  17384. procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
  17385. begin
  17386. SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
  17387. end;
  17388. procedure TPasResolver.SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
  17389. begin
  17390. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  17391. {$IFDEF CheckPasTreeRefCount},'TPasEnumType.Values'{$ENDIF});
  17392. FinishEnumType(SpecEl);
  17393. end;
  17394. procedure TPasResolver.SpecializeSetType(GenEl, SpecEl: TPasSetType);
  17395. begin
  17396. SpecEl.IsPacked:=GenEl.IsPacked;
  17397. SpecializeElType(GenEl,SpecEl,GenEl.EnumType,SpecEl.EnumType);
  17398. FinishSetType(SpecEl);
  17399. end;
  17400. procedure TPasResolver.SpecializeVariant(GenEl, SpecEl: TPasVariant);
  17401. begin
  17402. SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
  17403. {$IFDEF CheckPasTreeRefCount},'TPasVariant.Values'{$ENDIF});
  17404. RaiseNotYetImplemented(20190808214218,GenEl)
  17405. //ToDo: Members: TPasRecordType;
  17406. end;
  17407. procedure TPasResolver.SpecializeStringType(GenEl, SpecEl: TPasStringType);
  17408. begin
  17409. SpecEl.LengthExpr:=GenEl.LengthExpr;
  17410. FinishTypeDef(SpecEl);
  17411. end;
  17412. procedure TPasResolver.SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
  17413. begin
  17414. SpecializeExprArray(GenEl,SpecEl,GenEl.Calls,SpecEl.Calls);
  17415. FinishAttributes(SpecEl);
  17416. end;
  17417. procedure TPasResolver.SpecializeMethodResolution(GenEl,
  17418. SpecEl: TPasMethodResolution);
  17419. begin
  17420. SpecEl.ProcClass:=GenEl.ProcClass;
  17421. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceName,SpecEl.InterfaceName);
  17422. SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceProc,SpecEl.InterfaceProc);
  17423. SpecializeElExpr(GenEl,SpecEl,GenEl.ImplementationProc,SpecEl.ImplementationProc);
  17424. FinishMethodResolution(SpecEl);
  17425. end;
  17426. function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
  17427. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  17428. var Handled: boolean): integer;
  17429. // called when LHS or RHS BaseType is btCustom
  17430. // if RaiseOnIncompatible=true you can raise an useful error.
  17431. begin
  17432. Result:=cIncompatible;
  17433. if LHS.BaseType=btNone then ;
  17434. if RHS.BaseType=btNone then ;
  17435. if ErrorEl=nil then ;
  17436. if RaiseOnIncompatible then ;
  17437. if Handled then ;
  17438. end;
  17439. function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
  17440. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  17441. ): integer;
  17442. begin
  17443. Result:=cIncompatible;
  17444. if LHS.BaseType=RHS.BaseType then;
  17445. if ErrorEl=nil then;
  17446. if RaiseOnIncompatible then ;
  17447. end;
  17448. function TPasResolver.BI_Length_OnGetCallCompatibility(
  17449. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17450. // check params of built in proc 'length'
  17451. var
  17452. Params: TParamsExpr;
  17453. Param: TPasExpr;
  17454. ParamResolved: TPasResolverResult;
  17455. Ranges: TPasExprArray;
  17456. begin
  17457. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17458. exit(cIncompatible);
  17459. Params:=TParamsExpr(Expr);
  17460. // first param: string or dynamic array or type/const of static array
  17461. Param:=Params.Params[0];
  17462. ComputeElement(Param,ParamResolved,[]);
  17463. Result:=cIncompatible;
  17464. if ParamResolved.BaseType in btAllStringAndChars then
  17465. begin
  17466. if rrfReadable in ParamResolved.Flags then
  17467. Result:=cExact;
  17468. end
  17469. else if ParamResolved.BaseType=btContext then
  17470. begin
  17471. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17472. begin
  17473. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17474. if length(Ranges)=0 then
  17475. begin
  17476. if rrfReadable in ParamResolved.Flags then
  17477. Result:=cExact;
  17478. end
  17479. else
  17480. // static array
  17481. Result:=cExact;
  17482. end;
  17483. end;
  17484. if Result=cIncompatible then
  17485. exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
  17486. 'string or dynamic array',RaiseOnError));
  17487. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17488. end;
  17489. procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17490. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17491. begin
  17492. if Params=nil then ;
  17493. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  17494. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable]);
  17495. end;
  17496. procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
  17497. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17498. var
  17499. Param, Expr: TPasExpr;
  17500. ParamResolved: TPasResolverResult;
  17501. Value: TResEvalValue;
  17502. Ranges: TPasExprArray;
  17503. IdentEl: TPasElement;
  17504. begin
  17505. Evaluated:=nil;
  17506. // first param: string or dynamic array or type/const of static array
  17507. Param:=Params.Params[0];
  17508. ComputeElement(Param,ParamResolved,[]);
  17509. if ParamResolved.BaseType in btAllStringAndChars then
  17510. begin
  17511. if rrfReadable in ParamResolved.Flags then
  17512. begin
  17513. Value:=Eval(Param,Flags);
  17514. if Value=nil then exit;
  17515. case Value.Kind of
  17516. {$ifdef FPC_HAS_CPSTRING}
  17517. revkString:
  17518. Evaluated:=TResEvalInt.CreateValue(length(TResEvalString(Value).S));
  17519. {$endif}
  17520. revkUnicodeString:
  17521. Evaluated:=TResEvalInt.CreateValue(length(TResEvalUTF16(Value).S));
  17522. end;
  17523. ReleaseEvalValue(Value);
  17524. end
  17525. end
  17526. else if ParamResolved.BaseType=btContext then
  17527. begin
  17528. if (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  17529. begin
  17530. Ranges:=TPasArrayType(ParamResolved.LoTypeEl).Ranges;
  17531. if length(Ranges)=0 then
  17532. begin
  17533. // open or dynamic array
  17534. IdentEl:=ParamResolved.IdentEl;
  17535. if (IdentEl is TPasVariable)
  17536. and (TPasVariable(IdentEl).Expr is TPasExpr) then
  17537. begin
  17538. Expr:=TPasVariable(IdentEl).Expr;
  17539. if Expr is TArrayValues then
  17540. Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values))
  17541. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  17542. Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params));
  17543. end;
  17544. end
  17545. else
  17546. begin
  17547. // static array
  17548. Evaluated:=TResEvalInt.CreateValue(GetRangeLength(Ranges[0]));
  17549. end;
  17550. end;
  17551. end;
  17552. if Proc=nil then ;
  17553. end;
  17554. function TPasResolver.BI_SetLength_OnGetCallCompatibility(
  17555. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17556. // check params of built in proc 'setlength'
  17557. var
  17558. Params: TParamsExpr;
  17559. Param: TPasExpr;
  17560. ParamResolved, DimResolved: TPasResolverResult;
  17561. ArgNo: Integer;
  17562. DynArr: TPasArrayType;
  17563. ElType: TPasType;
  17564. begin
  17565. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17566. exit(cIncompatible);
  17567. Params:=TParamsExpr(Expr);
  17568. // first param: string or array variable
  17569. Param:=Params.Params[0];
  17570. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17571. Result:=cIncompatible;
  17572. DynArr:=nil;
  17573. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17574. begin
  17575. if ParamResolved.BaseType in btAllStrings then
  17576. Result:=cExact
  17577. else if ParamResolved.BaseType=btContext then
  17578. begin
  17579. if IsDynArray(ParamResolved.LoTypeEl) then
  17580. begin
  17581. Result:=cExact;
  17582. DynArr:=NoNil(ParamResolved.LoTypeEl) as TPasArrayType;
  17583. end;
  17584. end;
  17585. end;
  17586. if Result=cIncompatible then
  17587. exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
  17588. 'string or dynamic array variable',RaiseOnError));
  17589. // second param: new length
  17590. ArgNo:=2;
  17591. repeat
  17592. Param:=Params.Params[ArgNo-1];
  17593. ComputeElement(Param,DimResolved,[]);
  17594. Result:=cIncompatible;
  17595. if (rrfReadable in DimResolved.Flags)
  17596. and (DimResolved.BaseType in btAllInteger) then
  17597. Result:=cExact;
  17598. if Result=cIncompatible then
  17599. exit(CheckRaiseTypeArgNo(20170329160338,ArgNo,Param,DimResolved,
  17600. 'integer',RaiseOnError));
  17601. if (DynArr=nil) or (ArgNo=length(Params.Params)) then break;
  17602. ElType:=ResolveAliasType(DynArr.ElType);
  17603. if not IsDynArray(ElType) then break;
  17604. DynArr:=NoNil(ElType) as TPasArrayType;
  17605. inc(ArgNo);
  17606. until false;
  17607. Result:=CheckBuiltInMaxParamCount(Proc,Params,ArgNo,RaiseOnError);
  17608. end;
  17609. procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
  17610. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17611. var
  17612. P: TPasExprArray;
  17613. begin
  17614. if Proc=nil then ;
  17615. P:=Params.Params;
  17616. if P=nil then ;
  17617. FinishCallArgAccess(P[0],rraVarParam);
  17618. FinishCallArgAccess(P[1],rraRead);
  17619. end;
  17620. function TPasResolver.BI_InExclude_OnGetCallCompatibility(
  17621. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17622. // check params of built in proc 'include'
  17623. var
  17624. Params: TParamsExpr;
  17625. Param: TPasExpr;
  17626. ParamResolved: TPasResolverResult;
  17627. EnumType: TPasEnumType;
  17628. C: TClass;
  17629. begin
  17630. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  17631. exit(cIncompatible);
  17632. Params:=TParamsExpr(Expr);
  17633. // first param: set variable
  17634. // todo set of int, set of char, set of bool
  17635. Param:=Params.Params[0];
  17636. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17637. EnumType:=nil;
  17638. if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
  17639. and (ParamResolved.IdentEl<>nil) then
  17640. begin
  17641. C:=ParamResolved.IdentEl.ClassType;
  17642. if (C.InheritsFrom(TPasVariable)
  17643. or (C=TPasArgument)
  17644. or (C=TPasResultElement)) then
  17645. begin
  17646. if (ParamResolved.BaseType=btSet)
  17647. and (ParamResolved.LoTypeEl is TPasEnumType) then
  17648. EnumType:=TPasEnumType(ParamResolved.LoTypeEl);
  17649. end;
  17650. end;
  17651. if EnumType=nil then
  17652. begin
  17653. {$IFDEF VerbosePasResolver}
  17654. writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
  17655. {$ENDIF}
  17656. exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
  17657. 'variable of set of enumtype',RaiseOnError));
  17658. end;
  17659. // second param: enum
  17660. Param:=Params.Params[1];
  17661. ComputeElement(Param,ParamResolved,[]);
  17662. if (not (rrfReadable in ParamResolved.Flags))
  17663. or (ParamResolved.LoTypeEl<>EnumType) then
  17664. begin
  17665. if RaiseOnError then
  17666. RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
  17667. ['2'],ParamResolved.LoTypeEl,EnumType,Param);
  17668. exit(cIncompatible);
  17669. end;
  17670. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17671. end;
  17672. procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
  17673. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17674. var
  17675. P: TPasExprArray;
  17676. begin
  17677. if Proc=nil then ;
  17678. P:=Params.Params;
  17679. if P=nil then ;
  17680. FinishCallArgAccess(P[0],rraVarParam);
  17681. FinishCallArgAccess(P[1],rraRead);
  17682. end;
  17683. function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17684. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17685. var
  17686. Params: TParamsExpr;
  17687. begin
  17688. if GetLoop(Expr)=nil then
  17689. RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
  17690. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17691. exit(cExact);
  17692. Params:=TParamsExpr(Expr);
  17693. {$IFDEF VerbosePasResolver}
  17694. writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
  17695. {$ENDIF}
  17696. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17697. end;
  17698. function TPasResolver.BI_Continue_OnGetCallCompatibility(
  17699. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17700. var
  17701. Params: TParamsExpr;
  17702. begin
  17703. if GetLoop(Expr)=nil then
  17704. RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
  17705. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17706. exit(cExact);
  17707. Params:=TParamsExpr(Expr);
  17708. {$IFDEF VerbosePasResolver}
  17709. writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
  17710. {$ENDIF}
  17711. Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
  17712. end;
  17713. function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17714. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17715. var
  17716. Params: TParamsExpr;
  17717. Param: TPasExpr;
  17718. ParamResolved, ResultResolved: TPasResolverResult;
  17719. i: Integer;
  17720. ProcScope: TPasProcedureScope;
  17721. ResultEl: TPasResultElement;
  17722. Flags: TPasResolverComputeFlags;
  17723. CtxProc: TPasProcedure;
  17724. begin
  17725. if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
  17726. exit(cExact);
  17727. Params:=TParamsExpr(Expr);
  17728. {$IFDEF VerbosePasResolver}
  17729. writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
  17730. {$ENDIF}
  17731. // first param: result
  17732. Param:=Params.Params[0];
  17733. Result:=cIncompatible;
  17734. i:=ScopeCount-1;
  17735. while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
  17736. if i>0 then
  17737. begin
  17738. // inside procedure: first param is function result
  17739. ProcScope:=TPasProcedureScope(Scopes[i]);
  17740. CtxProc:=TPasProcedure(ProcScope.Element);
  17741. if not (CtxProc.ProcType is TPasFunctionType) then
  17742. begin
  17743. if RaiseOnError then
  17744. RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
  17745. sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
  17746. exit(cIncompatible);
  17747. end;
  17748. ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
  17749. ComputeResultElement(ResultEl,ResultResolved,[],Expr);
  17750. end
  17751. else
  17752. begin
  17753. // default: main program, param is an integer
  17754. SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],FBaseTypes[btLongint],
  17755. [rrfReadable,rrfWritable]);
  17756. end;
  17757. {$IFDEF VerbosePasResolver}
  17758. writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
  17759. {$ENDIF}
  17760. Flags:=[];
  17761. if IsProcedureType(ResultResolved,true) then
  17762. Include(Flags,rcNoImplicitProc);
  17763. ComputeElement(Param,ParamResolved,Flags);
  17764. {$IFDEF VerbosePasResolver}
  17765. writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
  17766. {$ENDIF}
  17767. if rrfReadable in ParamResolved.Flags then
  17768. Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
  17769. if Result=cIncompatible then
  17770. begin
  17771. if RaiseOnError then
  17772. RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
  17773. ['1'],ParamResolved,ResultResolved,Param);
  17774. exit;
  17775. end;
  17776. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17777. end;
  17778. function TPasResolver.BI_IncDec_OnGetCallCompatibility(
  17779. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17780. var
  17781. Params: TParamsExpr;
  17782. Param: TPasExpr;
  17783. ParamResolved, IncrResolved: TPasResolverResult;
  17784. TypeEl: TPasType;
  17785. bt: TResolverBaseType;
  17786. begin
  17787. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17788. exit(cIncompatible);
  17789. Params:=TParamsExpr(Expr);
  17790. // first param: var Integer
  17791. Param:=Params.Params[0];
  17792. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  17793. {$IFDEF VerbosePasResolver}
  17794. writeln('TPasResolver.BI_IncDec_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  17795. {$ENDIF}
  17796. Result:=cIncompatible;
  17797. // Expr must be a variable
  17798. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  17799. begin
  17800. if RaiseOnError then
  17801. RaiseVarExpected(20170216152319,Expr,ParamResolved.IdentEl);
  17802. exit;
  17803. end;
  17804. bt:=ParamResolved.BaseType;
  17805. if bt=btRange then
  17806. bt:=ParamResolved.SubType;
  17807. if bt in btAllInteger then
  17808. Result:=cExact
  17809. else if bt=btPointer then
  17810. begin
  17811. if ElHasBoolSwitch(Expr,bsPointerMath) then
  17812. Result:=cExact;
  17813. end
  17814. else if bt=btContext then
  17815. begin
  17816. TypeEl:=ParamResolved.LoTypeEl;
  17817. if (TypeEl.ClassType=TPasPointerType)
  17818. and ElHasBoolSwitch(Expr,bsPointerMath) then
  17819. Result:=cExact
  17820. else if TypeEl.ClassType=TPasRangeType then
  17821. Result:=cExact;
  17822. end;
  17823. if Result=cIncompatible then
  17824. exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
  17825. if length(Params.Params)=1 then
  17826. exit;
  17827. // second param: increment/decrement
  17828. Param:=Params.Params[1];
  17829. ComputeElement(Param,IncrResolved,[]);
  17830. Result:=cIncompatible;
  17831. if rrfReadable in IncrResolved.Flags then
  17832. begin
  17833. if IncrResolved.BaseType in btAllInteger then
  17834. Result:=cExact;
  17835. end;
  17836. if Result=cIncompatible then
  17837. exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
  17838. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  17839. end;
  17840. procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
  17841. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17842. var
  17843. P: TPasExprArray;
  17844. begin
  17845. if Proc=nil then ;
  17846. P:=Params.Params;
  17847. FinishCallArgAccess(P[0],rraVarParam);
  17848. if Length(P)>1 then
  17849. FinishCallArgAccess(P[1],rraRead);
  17850. end;
  17851. function TPasResolver.BI_Assigned_OnGetCallCompatibility(
  17852. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17853. // check params of built in proc 'Assigned'
  17854. var
  17855. Params: TParamsExpr;
  17856. Param: TPasExpr;
  17857. ParamResolved: TPasResolverResult;
  17858. C: TClass;
  17859. begin
  17860. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17861. exit(cIncompatible);
  17862. Params:=TParamsExpr(Expr);
  17863. // first param: pointer, class, class instance, proc type or array
  17864. Param:=Params.Params[0];
  17865. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  17866. Result:=cIncompatible;
  17867. if ParamResolved.BaseType in [btNil,btPointer] then
  17868. Result:=cExact
  17869. else if (ParamResolved.BaseType=btContext) then
  17870. begin
  17871. C:=ParamResolved.LoTypeEl.ClassType;
  17872. if (C=TPasClassType)
  17873. or (C=TPasClassOfType)
  17874. or C.InheritsFrom(TPasProcedureType)
  17875. or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.LoTypeEl).Ranges)=0)) then
  17876. Result:=cExact;
  17877. end;
  17878. if Result=cIncompatible then
  17879. exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
  17880. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17881. end;
  17882. procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17883. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17884. begin
  17885. SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,
  17886. FBaseTypes[btBoolean],FBaseTypes[btBoolean],[rrfReadable]);
  17887. if Params=nil then ;
  17888. end;
  17889. procedure TPasResolver.BI_Assigned_OnFinishParamsExpr(
  17890. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  17891. var
  17892. P: TPasExpr;
  17893. ResolvedEl: TPasResolverResult;
  17894. begin
  17895. if Proc=nil then ;
  17896. P:=Params.Params[0];
  17897. AccessExpr(P,rraRead);
  17898. ComputeElement(P,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
  17899. end;
  17900. function TPasResolver.BI_Chr_OnGetCallCompatibility(
  17901. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  17902. var
  17903. Params: TParamsExpr;
  17904. Param: TPasExpr;
  17905. ParamResolved: TPasResolverResult;
  17906. begin
  17907. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17908. exit(cIncompatible);
  17909. Params:=TParamsExpr(Expr);
  17910. // first param: integer
  17911. Param:=Params.Params[0];
  17912. ComputeElement(Param,ParamResolved,[]);
  17913. Result:=cIncompatible;
  17914. if rrfReadable in ParamResolved.Flags then
  17915. begin
  17916. if ParamResolved.BaseType in btAllInteger then
  17917. Result:=cExact;
  17918. end;
  17919. if Result=cIncompatible then
  17920. exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
  17921. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17922. end;
  17923. procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17924. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17925. begin
  17926. SetResolverIdentifier(ResolvedEl,BaseTypeChar,Proc.Proc,
  17927. FBaseTypes[BaseTypeChar],FBaseTypes[BaseTypeChar],[rrfReadable]);
  17928. if Params=nil then ;
  17929. end;
  17930. procedure TPasResolver.BI_Chr_OnEval(Proc: TResElDataBuiltInProc;
  17931. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  17932. var
  17933. Param: TPasExpr;
  17934. Value: TResEvalValue;
  17935. begin
  17936. Evaluated:=nil;
  17937. Param:=Params.Params[0];
  17938. Value:=Eval(Param,Flags);
  17939. {$IFDEF VerbosePasResEval}
  17940. {AllowWriteln}
  17941. if Value=nil then
  17942. writeln('TPasResolver.BI_Chr_OnEval Value=NIL')
  17943. else
  17944. writeln('TPasResolver.BI_Chr_OnEval Value=',Value.AsDebugString);
  17945. {AllowWriteln-}
  17946. {$ENDIF}
  17947. if Value=nil then exit;
  17948. try
  17949. Evaluated:=fExprEvaluator.ChrValue(Value,Params);
  17950. finally
  17951. ReleaseEvalValue(Value);
  17952. end;
  17953. if Proc=nil then ;
  17954. end;
  17955. function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
  17956. Expr: TPasExpr; RaiseOnError: boolean): integer;
  17957. var
  17958. Params: TParamsExpr;
  17959. Param: TPasExpr;
  17960. ParamResolved, ResolvedEl: TPasResolverResult;
  17961. TypeEl: TPasType;
  17962. begin
  17963. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  17964. exit(cIncompatible);
  17965. Params:=TParamsExpr(Expr);
  17966. // first param: bool, enum or char
  17967. Param:=Params.Params[0];
  17968. ComputeElement(Param,ParamResolved,[]);
  17969. Result:=cIncompatible;
  17970. if rrfReadable in ParamResolved.Flags then
  17971. begin
  17972. if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
  17973. Result:=cExact
  17974. else if (ParamResolved.BaseType=btContext) and (ParamResolved.LoTypeEl is TPasEnumType) then
  17975. Result:=cExact
  17976. else if ParamResolved.BaseType=btRange then
  17977. begin
  17978. if ParamResolved.SubType in btAllBooleans+btAllChars then
  17979. Result:=cExact
  17980. else if ParamResolved.SubType=btContext then
  17981. begin
  17982. TypeEl:=ParamResolved.LoTypeEl;
  17983. if TypeEl.ClassType=TPasRangeType then
  17984. begin
  17985. ComputeElement(TPasRangeType(TypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  17986. if ResolvedEl.LoTypeEl.ClassType=TPasEnumType then
  17987. exit(cExact);
  17988. end;
  17989. end;
  17990. end;
  17991. end;
  17992. if Result=cIncompatible then
  17993. exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
  17994. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  17995. end;
  17996. procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
  17997. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  17998. begin
  17999. SetResolverIdentifier(ResolvedEl,btLongint,Proc.Proc,
  18000. FBaseTypes[btLongint],FBaseTypes[btLongint],[rrfReadable]);
  18001. if Params=nil then ;
  18002. end;
  18003. procedure TPasResolver.BI_Ord_OnEval(Proc: TResElDataBuiltInProc;
  18004. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18005. var
  18006. Param: TPasExpr;
  18007. Value: TResEvalValue;
  18008. begin
  18009. Evaluated:=nil;
  18010. Param:=Params.Params[0];
  18011. Value:=Eval(Param,Flags);
  18012. {$IFDEF VerbosePasResEval}
  18013. {AllowWriteln}
  18014. if Value=nil then
  18015. writeln('TPasResolver.BI_Ord_OnEval Value=NIL')
  18016. else
  18017. writeln('TPasResolver.BI_Ord_OnEval Value=',Value.AsDebugString);
  18018. {AllowWriteln-}
  18019. {$ENDIF}
  18020. if Value=nil then exit;
  18021. try
  18022. Evaluated:=fExprEvaluator.OrdValue(Value,Params);
  18023. finally
  18024. ReleaseEvalValue(Value);
  18025. end;
  18026. if Proc=nil then ;
  18027. end;
  18028. function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
  18029. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18030. // check params of built in proc 'Low' or 'High'
  18031. var
  18032. Params: TParamsExpr;
  18033. Param: TPasExpr;
  18034. ParamResolved: TPasResolverResult;
  18035. C: TClass;
  18036. begin
  18037. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18038. exit(cIncompatible);
  18039. Params:=TParamsExpr(Expr);
  18040. // first param: enumtype, range, built-in ordinal type (char, longint, ...)
  18041. Param:=Params.Params[0];
  18042. ComputeElement(Param,ParamResolved,[]);
  18043. Result:=cIncompatible;
  18044. if ParamResolved.BaseType in btAllRanges then
  18045. // e.g. high(char)
  18046. Result:=cExact
  18047. else if ParamResolved.BaseType=btSet then
  18048. Result:=cExact
  18049. else if (ParamResolved.BaseType=btContext) then
  18050. begin
  18051. C:=ParamResolved.LoTypeEl.ClassType;
  18052. if (C=TPasArrayType)
  18053. or (C=TPasSetType)
  18054. or (C=TPasEnumType) then
  18055. Result:=cExact;
  18056. end;
  18057. if Result=cIncompatible then
  18058. begin
  18059. {$IFDEF VerbosePasResolver}
  18060. writeln('TPasResolver.BI_LowHigh_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  18061. {$ENDIF}
  18062. exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'ordinal type, array or set',RaiseOnError));
  18063. end;
  18064. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18065. end;
  18066. procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18067. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18068. var
  18069. ArrayEl: TPasArrayType;
  18070. Param: TPasExpr;
  18071. TypeEl: TPasType;
  18072. begin
  18073. Param:=Params.Params[0];
  18074. ComputeElement(Param,ResolvedEl,[]);
  18075. if ResolvedEl.BaseType=btContext then
  18076. begin
  18077. TypeEl:=ResolvedEl.LoTypeEl;
  18078. if TypeEl.ClassType=TPasArrayType then
  18079. begin
  18080. // array: result type is type of first dimension
  18081. ArrayEl:=TPasArrayType(TypeEl);
  18082. if length(ArrayEl.Ranges)=0 then
  18083. SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
  18084. FBaseTypes[BaseTypeLength],FBaseTypes[BaseTypeLength],[rrfReadable])
  18085. else
  18086. begin
  18087. ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
  18088. if ResolvedEl.BaseType=btRange then
  18089. ConvertRangeToElement(ResolvedEl);
  18090. end;
  18091. end
  18092. else if TypeEl.ClassType=TPasSetType then
  18093. begin
  18094. ResolvedEl.LoTypeEl:=TPasSetType(TypeEl).EnumType;
  18095. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  18096. end;
  18097. end
  18098. else if ResolvedEl.BaseType=btSet then
  18099. begin
  18100. ResolvedEl.BaseType:=ResolvedEl.SubType;
  18101. ResolvedEl.SubType:=btNone;
  18102. end
  18103. else
  18104. ;// ordinal: result type is argument type
  18105. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
  18106. end;
  18107. procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
  18108. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18109. function IsDynArrayConstExpr(IdentEl: TPasElement): boolean;
  18110. begin
  18111. Result:=false;
  18112. if not (IdentEl is TPasVariable) then exit;
  18113. if not (TPasVariable(IdentEl).Expr is TPasExpr) then exit;
  18114. if (IdentEl.ClassType=TPasConst) and TPasConst(IdentEl).IsConst then
  18115. exit(true);
  18116. if fExprEvaluator.IsConst(Params) then
  18117. exit(true); // a const refers an initial value
  18118. end;
  18119. var
  18120. Param: TPasExpr;
  18121. ParamResolved: TPasResolverResult;
  18122. var
  18123. TypeEl: TPasType;
  18124. ArrayEl: TPasArrayType;
  18125. Value: TResEvalValue;
  18126. EnumType: TPasEnumType;
  18127. aSet: TResEvalSet;
  18128. bt: TResolverBaseType;
  18129. Int, MinInt, MaxInt: TMaxPrecInt;
  18130. i: Integer;
  18131. Expr: TPasExpr;
  18132. begin
  18133. Evaluated:=nil;
  18134. Param:=Params.Params[0];
  18135. ComputeElement(Param,ParamResolved,[]);
  18136. TypeEl:=ParamResolved.LoTypeEl;
  18137. if ParamResolved.BaseType=btContext then
  18138. begin
  18139. if TypeEl.ClassType=TPasArrayType then
  18140. begin
  18141. // array: low/high of first dimension
  18142. ArrayEl:=TPasArrayType(TypeEl);
  18143. if length(ArrayEl.Ranges)=0 then
  18144. begin
  18145. // dyn or open array
  18146. if Proc.BuiltIn=bfLow then
  18147. Evaluated:=TResEvalInt.CreateValue(0)
  18148. else if IsDynArrayConstExpr(ParamResolved.IdentEl) then
  18149. begin
  18150. Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
  18151. if Expr is TArrayValues then
  18152. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
  18153. else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  18154. Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
  18155. if Evaluated=nil then
  18156. RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
  18157. end
  18158. else
  18159. exit;
  18160. end
  18161. else
  18162. begin
  18163. // static array
  18164. Evaluated:=EvalRangeLimit(ArrayEl.Ranges[0],Flags,Proc.BuiltIn=bfLow,Param);
  18165. end;
  18166. end
  18167. else if TypeEl.ClassType=TPasSetType then
  18168. begin
  18169. // set: first/last enum
  18170. TypeEl:=TPasSetType(TypeEl).EnumType;
  18171. if TypeEl.ClassType=TPasEnumType then
  18172. begin
  18173. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  18174. if Proc.BuiltIn=bfLow then
  18175. Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
  18176. else
  18177. Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
  18178. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  18179. end
  18180. else
  18181. begin
  18182. {$IFDEF VerbosePasResolver}
  18183. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  18184. {$ENDIF}
  18185. RaiseNotYetImplemented(20170601203026,Params);
  18186. end;
  18187. end
  18188. else if TypeEl.ClassType=TPasEnumType then
  18189. begin
  18190. EnumType:=TPasEnumType(TypeEl);
  18191. if Proc.BuiltIn=bfLow then
  18192. i:=0
  18193. else
  18194. i:=EnumType.Values.Count-1;
  18195. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  18196. end;
  18197. end
  18198. else if ParamResolved.BaseType=btSet then
  18199. begin
  18200. Value:=Eval(Param,Flags);
  18201. if Value=nil then exit;
  18202. case Value.Kind of
  18203. revkSetOfInt:
  18204. begin
  18205. aSet:=TResEvalSet(Value);
  18206. if length(aSet.Ranges)=0 then
  18207. RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
  18208. if Proc.BuiltIn=bfLow then
  18209. Int:=aSet.RangeStart
  18210. else
  18211. Int:=aSet.RangeEnd;
  18212. case aSet.ElKind of
  18213. revskEnum:
  18214. begin
  18215. EnumType:=aSet.IdentEl as TPasEnumType;
  18216. Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
  18217. end;
  18218. revskInt:
  18219. Evaluated:=TResEvalInt.CreateValue(Int);
  18220. revskChar:
  18221. {$ifdef FPC_HAS_CPSTRING}
  18222. if Int<256 then
  18223. Evaluated:=TResEvalString.CreateValue(chr(Int))
  18224. else
  18225. {$endif}
  18226. Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
  18227. revskBool:
  18228. if Int=0 then
  18229. Evaluated:=TResEvalBool.CreateValue(false)
  18230. else
  18231. Evaluated:=TResEvalBool.CreateValue(true)
  18232. end;
  18233. end;
  18234. else
  18235. RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
  18236. end;
  18237. end
  18238. else if (TypeEl is TPasUnresolvedSymbolRef)
  18239. and (TypeEl.CustomData is TResElDataBaseType) then
  18240. begin
  18241. // low,high(base type)
  18242. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  18243. bt:=GetActualBaseType(bt);
  18244. if bt in btAllBooleans then
  18245. Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
  18246. {$ifdef HasInt64}
  18247. else if bt=btQWord then
  18248. begin
  18249. if Proc.BuiltIn=bfLow then
  18250. Evaluated:=TResEvalInt.CreateValue(0)
  18251. else
  18252. Evaluated:=TResEvalUInt.CreateValue(High(QWord));
  18253. end
  18254. {$endif}
  18255. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  18256. begin
  18257. if Proc.BuiltIn=bfLow then
  18258. Evaluated:=TResEvalInt.CreateValue(MinInt)
  18259. else
  18260. Evaluated:=TResEvalInt.CreateValue(MaxInt);
  18261. end
  18262. {$ifdef FPC_HAS_CPSTRING}
  18263. else if bt=btAnsiChar then
  18264. begin
  18265. if Proc.BuiltIn=bfLow then
  18266. Evaluated:=TResEvalString.CreateValue(#0)
  18267. else
  18268. Evaluated:=TResEvalString.CreateValue(#255);
  18269. end
  18270. {$endif}
  18271. else if bt=btWideChar then
  18272. begin
  18273. if Proc.BuiltIn=bfLow then
  18274. Evaluated:=TResEvalUTF16.CreateValue(#0)
  18275. else
  18276. Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
  18277. end
  18278. else
  18279. begin
  18280. {$IFDEF VerbosePasResolver}
  18281. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  18282. {$ENDIF}
  18283. RaiseNotYetImplemented(20170602070738,Params);
  18284. end;
  18285. end
  18286. else if ParamResolved.LoTypeEl is TPasRangeType then
  18287. begin
  18288. // e.g. type t = 2..10;
  18289. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,Proc.BuiltIn=bfLow,Param);
  18290. end
  18291. else
  18292. begin
  18293. {$IFDEF VerbosePasResolver}
  18294. writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ParamResolved));
  18295. {$ENDIF}
  18296. RaiseNotYetImplemented(20170601202353,Params);
  18297. end;
  18298. {$IFDEF VerbosePasResEval}
  18299. {AllowWriteln}
  18300. if Evaluated=nil then
  18301. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated NO SET')
  18302. else
  18303. writeln('TPasResolver.BI_LowHigh_OnEval END ResolvedEl=',GetResolverResultDbg(ParamResolved),' Evaluated=',Evaluated.AsDebugString);
  18304. {AllowWriteln-}
  18305. {$ENDIF}
  18306. end;
  18307. function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
  18308. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18309. // check params of built in proc 'Pred' or 'Succ'
  18310. var
  18311. Params: TParamsExpr;
  18312. Param: TPasExpr;
  18313. ParamResolved: TPasResolverResult;
  18314. begin
  18315. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18316. exit(cIncompatible);
  18317. Params:=TParamsExpr(Expr);
  18318. // first param: enum, range, set, char or integer
  18319. Param:=Params.Params[0];
  18320. ComputeElement(Param,ParamResolved,[]);
  18321. Result:=cIncompatible;
  18322. if CheckIsOrdinal(ParamResolved,Param,false) then
  18323. Result:=cExact;
  18324. if Result=cIncompatible then
  18325. exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
  18326. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18327. end;
  18328. procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18329. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18330. begin
  18331. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18332. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18333. if Proc=nil then ;
  18334. end;
  18335. procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
  18336. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18337. var
  18338. Param: TPasExpr;
  18339. begin
  18340. //writeln('TPasResolver.BI_PredSucc_OnEval START');
  18341. Evaluated:=nil;
  18342. Param:=Params.Params[0];
  18343. Evaluated:=Eval(Param,Flags);
  18344. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated<>nil);
  18345. if Evaluated=nil then exit;
  18346. //writeln('TPasResolver.BI_PredSucc_OnEval Param=',Evaluated.AsString);
  18347. if Evaluated.Element<>nil then
  18348. Evaluated:=Evaluated.Clone;
  18349. if Proc.BuiltIn=bfPred then
  18350. fExprEvaluator.PredValue(Evaluated,Params)
  18351. else
  18352. fExprEvaluator.SuccValue(Evaluated,Params);
  18353. end;
  18354. function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
  18355. const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
  18356. ): integer;
  18357. function CheckFormat(FormatExpr: TPasExpr; Index: integer;
  18358. const ParamResolved: TPasResolverResult): boolean;
  18359. var
  18360. ResolvedEl: TPasResolverResult;
  18361. Ok: Boolean;
  18362. begin
  18363. if FormatExpr=nil then exit(true);
  18364. Result:=false;
  18365. Ok:=false;
  18366. if ParamResolved.BaseType in btAllFloats then
  18367. // floats supports value:Width:Precision
  18368. Ok:=true
  18369. else
  18370. // all other only support value:Width
  18371. Ok:=Index<2;
  18372. if not Ok then
  18373. begin
  18374. if RaiseOnError then
  18375. RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
  18376. exit;
  18377. end;
  18378. ComputeElement(FormatExpr,ResolvedEl,[]);
  18379. if not (ResolvedEl.BaseType in btAllInteger) then
  18380. begin
  18381. if RaiseOnError then
  18382. RaiseXExpectedButYFound(20170319221515,
  18383. 'integer',GetResolverResultDescription(ResolvedEl,true),FormatExpr);
  18384. exit;
  18385. end;
  18386. if not (rrfReadable in ResolvedEl.Flags) then
  18387. begin
  18388. if RaiseOnError then
  18389. RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
  18390. exit;
  18391. end;
  18392. Result:=true;
  18393. end;
  18394. var
  18395. bt: TResolverBaseType;
  18396. C: TClass;
  18397. begin
  18398. Result:=cIncompatible;
  18399. bt:=ParamResolved.BaseType;
  18400. if bt=btRange then
  18401. bt:=ParamResolved.SubType;
  18402. if bt in (btAllInteger+btAllBooleans+btAllFloats) then
  18403. Result:=cExact
  18404. else if IsFunc and (bt in btAllStringAndChars) then
  18405. Result:=cExact
  18406. else if bt=btContext then
  18407. begin
  18408. C:=ParamResolved.LoTypeEl.ClassType;
  18409. if (C=TPasEnumType) or (C=TPasRangeType) then
  18410. Result:=cExact
  18411. end;
  18412. if Result=cIncompatible then
  18413. exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
  18414. if not CheckFormat(Param.format1,1,ParamResolved) then
  18415. exit(cIncompatible);
  18416. if not CheckFormat(Param.format2,2,ParamResolved) then
  18417. exit(cIncompatible);
  18418. end;
  18419. function TPasResolver.BI_StrProc_OnGetCallCompatibility(
  18420. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18421. // check params of built-in procedure 'Str'
  18422. var
  18423. Params: TParamsExpr;
  18424. Param: TPasExpr;
  18425. ParamResolved: TPasResolverResult;
  18426. begin
  18427. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  18428. exit(cIncompatible);
  18429. Params:=TParamsExpr(Expr);
  18430. if ParentNeedsExprResult(Params) then
  18431. begin
  18432. if RaiseOnError then
  18433. RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
  18434. sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
  18435. exit(cIncompatible);
  18436. end;
  18437. // first param: boolean, integer, enum, class instance
  18438. Param:=Params.Params[0];
  18439. ComputeElement(Param,ParamResolved,[]);
  18440. Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
  18441. if Result=cIncompatible then
  18442. exit;
  18443. // second parameter: string variable
  18444. Param:=Params.Params[1];
  18445. ComputeElement(Param,ParamResolved,[]);
  18446. Result:=cIncompatible;
  18447. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18448. begin
  18449. if ParamResolved.BaseType in btAllStrings then
  18450. Result:=cExact;
  18451. end;
  18452. if Result=cIncompatible then
  18453. exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
  18454. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  18455. end;
  18456. procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  18457. Params: TParamsExpr);
  18458. var
  18459. P: TPasExprArray;
  18460. begin
  18461. if Proc=nil then ;
  18462. P:=Params.Params;
  18463. if P=nil then ;
  18464. FinishCallArgAccess(P[0],rraRead);
  18465. FinishCallArgAccess(P[1],rraVarParam);
  18466. end;
  18467. function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
  18468. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18469. var
  18470. Params: TParamsExpr;
  18471. Param: TPasExpr;
  18472. ParamResolved: TPasResolverResult;
  18473. i: Integer;
  18474. begin
  18475. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18476. exit(cIncompatible);
  18477. Params:=TParamsExpr(Expr);
  18478. if not ParentNeedsExprResult(Params) then
  18479. begin
  18480. // not in an expression -> the 'procedure str' is needed, not the 'function str'
  18481. if RaiseOnError then
  18482. RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
  18483. sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
  18484. exit(cIncompatible);
  18485. end;
  18486. // param: string, boolean, integer, enum, class instance
  18487. for i:=0 to length(Params.Params)-1 do
  18488. begin
  18489. Param:=Params.Params[i];
  18490. ComputeElement(Param,ParamResolved,[]);
  18491. Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
  18492. if Result=cIncompatible then
  18493. exit;
  18494. end;
  18495. Result:=cExact;
  18496. end;
  18497. procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18498. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18499. begin
  18500. SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,
  18501. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable]);
  18502. if Params=nil then ;
  18503. if Proc=nil then ;
  18504. end;
  18505. procedure TPasResolver.BI_StrFunc_OnEval(Proc: TResElDataBuiltInProc;
  18506. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18507. begin
  18508. Evaluated:=fExprEvaluator.EvalStrFunc(Params,Flags);
  18509. if Proc=nil then ;
  18510. end;
  18511. function TPasResolver.BI_WriteStrProc_OnGetCallCompatibility(
  18512. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18513. // check params of built-in procedure 'Str'
  18514. var
  18515. Params: TParamsExpr;
  18516. Param: TPasExpr;
  18517. ParamResolved: TPasResolverResult;
  18518. i: Integer;
  18519. begin
  18520. if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
  18521. exit(cIncompatible);
  18522. Params:=TParamsExpr(Expr);
  18523. // first parameter: string variable
  18524. Param:=Params.Params[0];
  18525. ComputeElement(Param,ParamResolved,[]);
  18526. Result:=cIncompatible;
  18527. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18528. begin
  18529. if ParamResolved.BaseType in btAllStrings then
  18530. Result:=cExact;
  18531. end;
  18532. if Result=cIncompatible then
  18533. exit(CheckRaiseTypeArgNo(20180527190304,1,Param,ParamResolved,'string variable',RaiseOnError));
  18534. // other parameters: boolean, integer, enum, class instance
  18535. for i:=1 to length(Params.Params)-1 do
  18536. begin
  18537. Param:=Params.Params[i];
  18538. ComputeElement(Param,ParamResolved,[]);
  18539. Result:=BI_Str_CheckParam(false,Param,ParamResolved,i,RaiseOnError);
  18540. if Result=cIncompatible then
  18541. exit;
  18542. end;
  18543. end;
  18544. procedure TPasResolver.BI_WriteStrProc_OnFinishParamsExpr(
  18545. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18546. var
  18547. P: TPasExprArray;
  18548. i: Integer;
  18549. begin
  18550. if Proc=nil then ;
  18551. P:=Params.Params;
  18552. if P=nil then ;
  18553. FinishCallArgAccess(P[0],rraOutParam);
  18554. for i:=0 to length(Params.Params)-1 do
  18555. FinishCallArgAccess(P[i],rraRead);
  18556. end;
  18557. function TPasResolver.BI_Val_OnGetCallCompatibility(
  18558. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18559. // check params of built-in procedure 'Val(const s: string; out v: valtype; out code: integer)'
  18560. var
  18561. Params: TParamsExpr;
  18562. Param: TPasExpr;
  18563. ParamResolved: TPasResolverResult;
  18564. bt: TResolverBaseType;
  18565. C: TClass;
  18566. begin
  18567. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18568. exit(cIncompatible);
  18569. Params:=TParamsExpr(Expr);
  18570. // first parameter: string
  18571. Param:=Params.Params[0];
  18572. ComputeElement(Param,ParamResolved,[]);
  18573. Result:=cIncompatible;
  18574. if ParamResolved.BaseType in btAllStrings then
  18575. Result:=cExact;
  18576. if Result=cIncompatible then
  18577. exit(CheckRaiseTypeArgNo(20181214141250,1,Param,ParamResolved,'string',RaiseOnError));
  18578. // second parameter: var value
  18579. Param:=Params.Params[1];
  18580. ComputeElement(Param,ParamResolved,[]);
  18581. Result:=cIncompatible;
  18582. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18583. begin
  18584. bt:=ParamResolved.BaseType;
  18585. if bt=btRange then
  18586. bt:=ParamResolved.SubType;
  18587. if bt in (btAllInteger+btAllBooleans+btAllFloats) then
  18588. Result:=cExact
  18589. else if bt=btContext then
  18590. begin
  18591. C:=ParamResolved.LoTypeEl.ClassType;
  18592. if (C=TPasEnumType) or (C=TPasRangeType) then
  18593. Result:=cExact;
  18594. end;
  18595. end;
  18596. if Result=cIncompatible then
  18597. exit(CheckRaiseTypeArgNo(20181214141704,2,Param,ParamResolved,
  18598. 'boolean/integer/float/enum variable',RaiseOnError));
  18599. // third parameter: out Code: integer
  18600. Param:=Params.Params[2];
  18601. ComputeElement(Param,ParamResolved,[]);
  18602. Result:=cIncompatible;
  18603. if ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18604. begin
  18605. if ParamResolved.BaseType in btAllInteger then
  18606. Result:=cExact;
  18607. end;
  18608. if Result=cIncompatible then
  18609. exit(CheckRaiseTypeArgNo(20181214141511,3,Param,ParamResolved,'integer variable',RaiseOnError));
  18610. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18611. end;
  18612. procedure TPasResolver.BI_Val_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
  18613. Params: TParamsExpr);
  18614. var
  18615. P: TPasExprArray;
  18616. begin
  18617. if Proc=nil then ;
  18618. P:=Params.Params;
  18619. if P=nil then ;
  18620. FinishCallArgAccess(P[0],rraRead);
  18621. FinishCallArgAccess(P[1],rraOutParam);
  18622. FinishCallArgAccess(P[2],rraOutParam);
  18623. end;
  18624. function TPasResolver.BI_LoHi_OnGetCallCompatibility(
  18625. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18626. var
  18627. Params: TParamsExpr;
  18628. Param: TPasExpr;
  18629. ParamResolved: TPasResolverResult;
  18630. begin
  18631. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18632. Exit(cIncompatible);
  18633. Params:=TParamsExpr(Expr);
  18634. // first Param: any integer type
  18635. Param:=Params.params[0];
  18636. ComputeElement(Param,ParamResolved,[]);
  18637. Result:=cIncompatible;
  18638. if (rrfReadable in ParamResolved.Flags)
  18639. and (ParamResolved.BaseType in btAllInteger)
  18640. then
  18641. Result:=cExact;
  18642. if Result=cIncompatible then
  18643. Exit(CheckRaiseTypeArgNo(20190128232600,1,Param,ParamResolved,'integer type',RaiseOnError));
  18644. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  18645. end;
  18646. procedure TPasResolver.BI_LoHi_OnGetCallResult(Proc: TResElDataBuiltInProc;
  18647. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  18648. var
  18649. ResolvedParam: TPasResolverResult;
  18650. BaseType: TResolverBaseType;
  18651. Mask: LongWord;
  18652. begin
  18653. ComputeElement(Params.Params[0],ResolvedParam,[]);
  18654. GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18655. case Mask of
  18656. $F, $FF: BaseType := btByte;
  18657. $FFFF: BaseType := btWord;
  18658. else { $FFFFFFFF } BaseType := btLongWord;
  18659. end;
  18660. SetResolverIdentifier(ResolvedEl,BaseType,Proc.Proc,
  18661. FBaseTypes[BaseType],FBaseTypes[BaseType],[rrfReadable]);
  18662. end;
  18663. procedure TPasResolver.BI_LoHi_OnEval(Proc: TResElDataBuiltInProc;
  18664. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18665. var
  18666. Param: TPasExpr;
  18667. ResolvedParam: TPasResolverResult;
  18668. Value: TResEvalValue;
  18669. Shift: Integer;
  18670. Mask: LongWord;
  18671. begin
  18672. Evaluated := nil;
  18673. Param := Params.Params[0];
  18674. Value := Eval(Param,Flags);
  18675. {$IFDEF VerbosePasResEval}
  18676. {AllowWriteln}
  18677. if value=nil then
  18678. writeln('TPasResolver.BI_LoHi_OnEval Value=NIL')
  18679. else
  18680. writeln('TPasResolver.BI_LoHi_OnEval Value=',value.AsDebugString);
  18681. {AllowWriteln-}
  18682. {$ENDIF}
  18683. if Value=nil then exit;
  18684. try
  18685. ComputeElement(Param,ResolvedParam,[]);
  18686. Shift := GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
  18687. Evaluated := fExprEvaluator.LoHiValue(Value,Shift,Mask,Params);
  18688. finally
  18689. ReleaseEvalValue(Value);
  18690. end;
  18691. end;
  18692. function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
  18693. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18694. var
  18695. Params: TParamsExpr;
  18696. Param: TPasExpr;
  18697. ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
  18698. i: Integer;
  18699. ArrType: TPasArrayType;
  18700. ElType: TPasType;
  18701. begin
  18702. Result:=cIncompatible;
  18703. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18704. exit;
  18705. Params:=TParamsExpr(Expr);
  18706. FirstElTypeResolved:=Default(TPasResolverResult);
  18707. for i:=0 to length(Params.Params)-1 do
  18708. begin
  18709. // all params: array
  18710. Param:=Params.Params[i];
  18711. ComputeElement(Param,ParamResolved,[]);
  18712. ElTypeResolved:=default(TPasResolverResult);
  18713. if rrfReadable in ParamResolved.Flags then
  18714. begin
  18715. if ParamResolved.BaseType=btContext then
  18716. begin
  18717. if IsDynArray(ParamResolved.LoTypeEl) then
  18718. begin
  18719. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  18720. ElType:=GetArrayElType(ArrType);
  18721. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18722. end;
  18723. end
  18724. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  18725. SetResolverValueExpr(ElTypeResolved,ParamResolved.SubType,
  18726. ParamResolved.LoTypeEl,ParamResolved.HiTypeEl,Param,ParamResolved.Flags);
  18727. end;
  18728. if ElTypeResolved.BaseType=btNone then
  18729. exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18730. Include(ElTypeResolved.Flags,rrfReadable);
  18731. if i=0 then
  18732. begin
  18733. FirstElTypeResolved:=ElTypeResolved;
  18734. Include(FirstElTypeResolved.Flags,rrfWritable);
  18735. end
  18736. else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
  18737. exit(cIncompatible);
  18738. end;
  18739. Result:=cExact;
  18740. end;
  18741. procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
  18742. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18743. ResolvedEl: TPasResolverResult);
  18744. begin
  18745. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18746. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18747. ResolvedEl.ExprEl:=Params;
  18748. ResolvedEl.IdentEl:=nil;
  18749. if ResolvedEl.BaseType=btArrayOrSet then
  18750. ResolvedEl.BaseType:=btArrayLit;
  18751. if Proc=nil then ;
  18752. end;
  18753. function TPasResolver.BI_ConcatString_OnGetCallCompatibility(
  18754. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18755. var
  18756. Params: TParamsExpr;
  18757. i: Integer;
  18758. Param: TPasExpr;
  18759. ParamResolved: TPasResolverResult;
  18760. begin
  18761. Result:=cIncompatible;
  18762. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18763. exit;
  18764. Params:=TParamsExpr(Expr);
  18765. for i:=0 to length(Params.Params)-1 do
  18766. begin
  18767. // all params: char or string
  18768. Param:=Params.Params[i];
  18769. ComputeElement(Param,ParamResolved,[]);
  18770. if not (rrfReadable in ParamResolved.Flags)
  18771. or not (ParamResolved.BaseType in btAllStringAndChars) then
  18772. exit(CheckRaiseTypeArgNo(20181219230329,i+1,Param,ParamResolved,'string',RaiseOnError));
  18773. end;
  18774. Result:=cExact;
  18775. end;
  18776. procedure TPasResolver.BI_ConcatString_OnGetCallResult(
  18777. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18778. ResolvedEl: TPasResolverResult);
  18779. var
  18780. i: Integer;
  18781. Param: TPasExpr;
  18782. ParamResolved, CombinedResolved: TPasResolverResult;
  18783. ParamsArr: TPasExprArray;
  18784. begin
  18785. if Proc=nil then ;
  18786. ParamsArr:=Params.Params;
  18787. for i:=0 to length(ParamsArr)-1 do
  18788. begin
  18789. // all params: char or string
  18790. Param:=ParamsArr[i];
  18791. ComputeElement(Param,ParamResolved,[]);
  18792. if i=0 then
  18793. ResolvedEl:=ParamResolved
  18794. else
  18795. begin
  18796. ComputeAddStringRes(ResolvedEl,ParamResolved,Params,CombinedResolved);
  18797. ResolvedEl:=CombinedResolved;
  18798. end;
  18799. end;
  18800. end;
  18801. procedure TPasResolver.BI_ConcatString_OnEval(Proc: TResElDataBuiltInProc;
  18802. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  18803. var
  18804. i: Integer;
  18805. Param: TPasExpr;
  18806. Value, NewValue: TResEvalValue;
  18807. ok: Boolean;
  18808. begin
  18809. if Proc=nil then ;
  18810. Value:=nil;
  18811. Evaluated:=nil;
  18812. ok:=false;
  18813. try
  18814. for i:=0 to length(Params.Params)-1 do
  18815. begin
  18816. // all params: char or string
  18817. Param:=Params.Params[i];
  18818. Value:=Eval(Param,Flags);
  18819. if Value=nil then
  18820. exit;
  18821. if i=0 then
  18822. begin
  18823. Evaluated:=Value;
  18824. Value:=nil;
  18825. end
  18826. else
  18827. begin
  18828. NewValue:=ExprEvaluator.EvalStringAddExpr(Param,Params.Params[i-1],Param,
  18829. Evaluated,Value);
  18830. ReleaseEvalValue(Evaluated);
  18831. Evaluated:=NewValue;
  18832. ReleaseEvalValue(Value);
  18833. end;
  18834. end;
  18835. ok:=true;
  18836. finally
  18837. ReleaseEvalValue(Value);
  18838. if not ok then
  18839. ReleaseEvalValue(Evaluated);
  18840. end;
  18841. end;
  18842. function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
  18843. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18844. var
  18845. Params: TParamsExpr;
  18846. Param: TPasExpr;
  18847. ParamResolved: TPasResolverResult;
  18848. begin
  18849. Result:=cIncompatible;
  18850. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  18851. exit;
  18852. Params:=TParamsExpr(Expr);
  18853. // first param: array
  18854. Param:=Params.Params[0];
  18855. ComputeElement(Param,ParamResolved,[]);
  18856. if rrfReadable in ParamResolved.Flags then
  18857. begin
  18858. if ParamResolved.BaseType=btContext then
  18859. begin
  18860. if IsDynArray(ParamResolved.LoTypeEl) then
  18861. Result:=cExact;
  18862. end
  18863. else if ParamResolved.BaseType in [btArrayLit,btArrayOrSet] then
  18864. Result:=cExact;
  18865. end;
  18866. if Result=cIncompatible then
  18867. exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18868. if length(Params.Params)=1 then
  18869. exit(cExact);
  18870. // check optional Start index
  18871. Param:=Params.Params[1];
  18872. ComputeElement(Param,ParamResolved,[]);
  18873. if not (rrfReadable in ParamResolved.Flags)
  18874. or not (ParamResolved.BaseType in btAllInteger) then
  18875. exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
  18876. if length(Params.Params)=2 then
  18877. exit(cExact);
  18878. // check optional Count
  18879. Param:=Params.Params[2];
  18880. ComputeElement(Param,ParamResolved,[]);
  18881. if not (rrfReadable in ParamResolved.Flags)
  18882. or not (ParamResolved.BaseType in btAllInteger) then
  18883. exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
  18884. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18885. end;
  18886. procedure TPasResolver.BI_CopyArray_OnGetCallResult(
  18887. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  18888. ResolvedEl: TPasResolverResult);
  18889. begin
  18890. if Proc=nil then ;
  18891. ComputeElement(Params.Params[0],ResolvedEl,[]);
  18892. ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
  18893. ResolvedEl.ExprEl:=Params;
  18894. ResolvedEl.IdentEl:=nil;
  18895. if ResolvedEl.BaseType=btArrayOrSet then
  18896. ResolvedEl.BaseType:=btArrayLit;
  18897. end;
  18898. function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
  18899. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18900. // Insert(Item,var Array,Index)
  18901. var
  18902. Params: TParamsExpr;
  18903. Param, ItemParam: TPasExpr;
  18904. ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
  18905. ArrType: TPasArrayType;
  18906. ElType: TPasType;
  18907. begin
  18908. Result:=cIncompatible;
  18909. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18910. exit;
  18911. Params:=TParamsExpr(Expr);
  18912. // check Item
  18913. ItemParam:=Params.Params[0];
  18914. ComputeElement(ItemParam,ItemResolved,[]);
  18915. if not (rrfReadable in ItemResolved.Flags) then
  18916. exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
  18917. // check Array
  18918. Param:=Params.Params[1];
  18919. ComputeElement(Param,ParamResolved,[]);
  18920. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18921. begin
  18922. if RaiseOnError then
  18923. RaiseVarExpected(20170329171514,Param,ParamResolved.IdentEl);
  18924. exit;
  18925. end;
  18926. if (ParamResolved.BaseType<>btContext)
  18927. or not IsDynArray(ParamResolved.LoTypeEl) then
  18928. exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
  18929. ArrType:=TPasArrayType(ParamResolved.LoTypeEl);
  18930. ElType:=GetArrayElType(ArrType);
  18931. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18932. if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
  18933. exit(cIncompatible);
  18934. // check insert Index
  18935. Param:=Params.Params[2];
  18936. ComputeElement(Param,ParamResolved,[]);
  18937. if not (rrfReadable in ParamResolved.Flags)
  18938. or not (ParamResolved.BaseType in btAllInteger) then
  18939. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  18940. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  18941. end;
  18942. procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
  18943. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  18944. var
  18945. P: TPasExprArray;
  18946. Param0, Param1: TPasExpr;
  18947. ArrayResolved, ElTypeResolved: TPasResolverResult;
  18948. ElType: TPasType;
  18949. begin
  18950. if Proc=nil then ;
  18951. P:=Params.Params;
  18952. Param0:=P[0];
  18953. Param1:=P[1];
  18954. FinishCallArgAccess(Param0,rraRead);
  18955. FinishCallArgAccess(Param1,rraVarParam);
  18956. FinishCallArgAccess(P[2],rraRead);
  18957. if not (Param0 is TPrimitiveExpr) then
  18958. begin
  18959. // insert complex expression, e.g. insert([1],Arr,index)
  18960. // -> mark array and set literals
  18961. ComputeElement(Param1,ArrayResolved,[]);
  18962. if (ArrayResolved.BaseType<>btContext)
  18963. or not IsDynArray(ArrayResolved.LoTypeEl) then
  18964. RaiseNotYetImplemented(20180622144039,Param1);
  18965. ElType:=GetArrayElType(TPasArrayType(ArrayResolved.LoTypeEl));
  18966. ComputeElement(ElType,ElTypeResolved,[rcType]);
  18967. if (ElTypeResolved.BaseType=btContext)
  18968. and (ElTypeResolved.LoTypeEl.ClassType=TPasArrayType) then
  18969. MarkArrayExprRecursive(Param0,TPasArrayType(ElTypeResolved.LoTypeEl));
  18970. end;
  18971. end;
  18972. function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
  18973. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  18974. // DeleteScope(var Array; Start, Count: integer)
  18975. var
  18976. Params: TParamsExpr;
  18977. Param: TPasExpr;
  18978. ParamResolved: TPasResolverResult;
  18979. begin
  18980. Result:=cIncompatible;
  18981. if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
  18982. exit;
  18983. Params:=TParamsExpr(Expr);
  18984. // check Array
  18985. Param:=Params.Params[0];
  18986. ComputeElement(Param,ParamResolved,[]);
  18987. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  18988. begin
  18989. if RaiseOnError then
  18990. RaiseVarExpected(20170329173421,Param,ParamResolved.IdentEl);
  18991. exit;
  18992. end;
  18993. if (ParamResolved.BaseType<>btContext)
  18994. or not IsDynArray(ParamResolved.LoTypeEl) then
  18995. exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
  18996. // check param Start
  18997. Param:=Params.Params[1];
  18998. ComputeElement(Param,ParamResolved,[]);
  18999. if not (rrfReadable in ParamResolved.Flags)
  19000. or not (ParamResolved.BaseType in btAllInteger) then
  19001. exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
  19002. // check param Count
  19003. Param:=Params.Params[2];
  19004. ComputeElement(Param,ParamResolved,[]);
  19005. if not (rrfReadable in ParamResolved.Flags)
  19006. or not (ParamResolved.BaseType in btAllInteger) then
  19007. exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
  19008. Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
  19009. end;
  19010. procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
  19011. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19012. var
  19013. P: TPasExprArray;
  19014. begin
  19015. if Proc=nil then ;
  19016. P:=Params.Params;
  19017. if P=nil then ;
  19018. FinishCallArgAccess(P[0],rraVarParam);
  19019. FinishCallArgAccess(P[1],rraRead);
  19020. FinishCallArgAccess(P[2],rraRead);
  19021. end;
  19022. function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
  19023. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19024. var
  19025. Params: TParamsExpr;
  19026. Param: TPasExpr;
  19027. aType: TPasType;
  19028. ParamResolved: TPasResolverResult;
  19029. begin
  19030. Result:=cIncompatible;
  19031. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19032. exit;
  19033. Params:=TParamsExpr(Expr);
  19034. Param:=Params.Params[0];
  19035. aType:=GetTypeInfoParamType(Param,ParamResolved,true);
  19036. if aType=nil then
  19037. RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19038. aType:=ResolveAliasType(aType);
  19039. if not HasTypeInfo(aType) then
  19040. RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
  19041. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19042. end;
  19043. procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
  19044. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  19045. begin
  19046. if Proc=nil then;
  19047. if Params=nil then ;
  19048. SetResolverTypeExpr(ResolvedEl,btPointer,
  19049. FBaseTypes[btPointer],FBaseTypes[btPointer],[rrfReadable]);
  19050. end;
  19051. function TPasResolver.BI_GetTypeKind_OnGetCallCompatibility(
  19052. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19053. var
  19054. Params: TParamsExpr;
  19055. Param: TPasExpr;
  19056. aType: TPasType;
  19057. ParamResolved: TPasResolverResult;
  19058. begin
  19059. Result:=cIncompatible;
  19060. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19061. exit;
  19062. Params:=TParamsExpr(Expr);
  19063. Param:=Params.Params[0];
  19064. aType:=GetTypeInfoParamType(Param,ParamResolved,true);
  19065. if aType=nil then
  19066. RaiseMsg(20200826205441,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19067. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19068. end;
  19069. procedure TPasResolver.BI_GetTypeKind_OnGetCallResult(
  19070. Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
  19071. ResolvedEl: TPasResolverResult);
  19072. var
  19073. El: TPasElement;
  19074. EnumType: TPasEnumType;
  19075. begin
  19076. El:=FindSystemIdentifier('system','ttypekind',Params);
  19077. if not (El is TPasEnumType) then
  19078. RaiseXExpectedButYFound(20200826211458,'enum type System.TTypeKind',GetElementTypeName(El),Params);
  19079. EnumType:=TPasEnumType(El);
  19080. SetResolverTypeExpr(ResolvedEl,btContext,EnumType,EnumType,[rrfReadable]);
  19081. if Proc=nil then ;
  19082. end;
  19083. procedure TPasResolver.BI_GetTypeKind_OnEval(Proc: TResElDataBuiltInProc;
  19084. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  19085. var
  19086. aType: TPasType;
  19087. El: TPasElement;
  19088. TypeKindType: TPasEnumType;
  19089. C: TClass;
  19090. aClass: TPasClassType;
  19091. bt: TResolverBaseType;
  19092. Value: TPasEnumValue;
  19093. aName: String;
  19094. i: Integer;
  19095. ParamResolved: TPasResolverResult;
  19096. begin
  19097. Evaluated:=nil;
  19098. aType:=GetTypeInfoParamType(Params.Params[0],ParamResolved,true);
  19099. C:=aType.ClassType;
  19100. aName:='tkUnknown';
  19101. if C=TPasEnumType then
  19102. aName:='tkEnumeration'
  19103. else if C=TPasSetType then
  19104. aName:='tkSet'
  19105. else if C=TPasRecordType then
  19106. aName:='tkRecord'
  19107. else if C=TPasClassType then
  19108. begin
  19109. aClass:=TPasClassType(aType);
  19110. case aClass.ObjKind of
  19111. okObject: aName:='tkObject';
  19112. okInterface:
  19113. case aClass.InterfaceType of
  19114. citCom: aName:='tkInterface';
  19115. else aName:='tkInterfaceRaw';
  19116. end;
  19117. okClassHelper, okRecordHelper, okTypeHelper: aName:='tkHelper';
  19118. else
  19119. aName:='tkClass';
  19120. end;
  19121. end
  19122. else if C=TPasClassOfType then
  19123. aName:='tkClassRef'
  19124. else if C.InheritsFrom(TPasProcedure) then
  19125. aName:='tkMethod'
  19126. else if C.InheritsFrom(TPasProcedureType) then
  19127. aName:='tkProcVar'
  19128. else
  19129. begin
  19130. bt:=ParamResolved.BaseType;
  19131. case bt of
  19132. btChar: {$ifdef FPC_HAS_CPSTRING}if BaseTypeChar=btAnsiChar then aName:='tkChar' else {$ENDIF}aName:='tkWChar';
  19133. {$ifdef FPC_HAS_CPSTRING}
  19134. btAnsiChar: aName:='tkChar';
  19135. {$endif}
  19136. btWideChar: aName:='tkWChar';
  19137. btString: {$ifdef FPC_HAS_CPSTRING}if BaseTypeString=btAnsiString then aName:='tkAString' else {$ENDIF}aName:='tkUString';
  19138. {$ifdef FPC_HAS_CPSTRING}
  19139. btAnsiString,
  19140. btShortString,
  19141. btRawByteString: aName:='tkAString';
  19142. {$endif}
  19143. btWideString: aName:='tkWString';
  19144. btUnicodeString: aName:='tkUString';
  19145. btPointer: aName:='tkPointer';
  19146. {$ifdef HasInt64}
  19147. btQWord,
  19148. btInt64,
  19149. btComp: aName:='tkInt64';
  19150. {$endif}
  19151. else
  19152. if bt in btAllBooleans then
  19153. aName:='tkBool'
  19154. else if bt in btAllInteger then
  19155. aName:='tkInteger'
  19156. else if bt in btAllFloats then
  19157. aName:='tkFloat';
  19158. end;
  19159. end;
  19160. El:=FindSystemIdentifier('system','ttypekind',Params);
  19161. TypeKindType:=El as TPasEnumType;
  19162. for i:=0 to TypeKindType.Values.Count-1 do
  19163. begin
  19164. Value:=TPasEnumValue(TypeKindType.Values[i]);
  19165. if SameText(aName,Value.Name) then
  19166. begin
  19167. Evaluated:=TResEvalEnum.CreateValue(i,Value);
  19168. exit;
  19169. end;
  19170. end;
  19171. if Proc=nil then ;
  19172. if Flags=[] then ;
  19173. end;
  19174. function TPasResolver.BI_Assert_OnGetCallCompatibility(
  19175. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19176. // check params of built-in procedure 'Assert'
  19177. // Assert(bool)
  19178. // Assert(bool,string)
  19179. var
  19180. Params: TParamsExpr;
  19181. Param: TPasExpr;
  19182. ParamResolved: TPasResolverResult;
  19183. begin
  19184. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19185. exit(cIncompatible);
  19186. Params:=TParamsExpr(Expr);
  19187. // first param: boolean
  19188. Param:=Params.Params[0];
  19189. ComputeElement(Param,ParamResolved,[]);
  19190. if not (rrfReadable in ParamResolved.Flags)
  19191. or not (ParamResolved.BaseType in btAllBooleans) then
  19192. exit(CheckRaiseTypeArgNo(20180117123819,1,Param,ParamResolved,'boolean',RaiseOnError));
  19193. // optional second parameter: string
  19194. if length(Params.Params)>1 then
  19195. begin
  19196. Param:=Params.Params[1];
  19197. ComputeElement(Param,ParamResolved,[]);
  19198. if not (rrfReadable in ParamResolved.Flags)
  19199. or not (ParamResolved.BaseType in btAllStringAndChars) then
  19200. exit(CheckRaiseTypeArgNo(20180117123932,2,Param,ParamResolved,'string',RaiseOnError));
  19201. end;
  19202. Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
  19203. end;
  19204. procedure TPasResolver.BI_Assert_OnFinishParamsExpr(
  19205. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19206. begin
  19207. FinishAssertCall(Proc,Params);
  19208. end;
  19209. function TPasResolver.BI_New_OnGetCallCompatibility(
  19210. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19211. var
  19212. Params: TParamsExpr;
  19213. Param: TPasExpr;
  19214. TypeEl, SubTypeEl: TPasType;
  19215. ParamResolved: TPasResolverResult;
  19216. begin
  19217. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19218. exit(cIncompatible);
  19219. Params:=TParamsExpr(Expr);
  19220. // first param: var PRecord
  19221. Param:=Params.Params[0];
  19222. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19223. {$IFDEF VerbosePasResolver}
  19224. writeln('TPasResolver.BI_New_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  19225. {$ENDIF}
  19226. Result:=cIncompatible;
  19227. // Expr must be a variable
  19228. if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
  19229. begin
  19230. if RaiseOnError then
  19231. RaiseVarExpected(20180425005303,Expr,ParamResolved.IdentEl);
  19232. exit;
  19233. end;
  19234. if ParamResolved.BaseType=btContext then
  19235. begin
  19236. TypeEl:=ParamResolved.LoTypeEl;
  19237. if TypeEl.ClassType=TPasPointerType then
  19238. begin
  19239. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  19240. if SubTypeEl.ClassType=TPasRecordType then
  19241. Result:=cExact;
  19242. end;
  19243. end;
  19244. if Result=cIncompatible then
  19245. exit(CheckRaiseTypeArgNo(20180425005421,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  19246. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19247. end;
  19248. procedure TPasResolver.BI_New_OnFinishParamsExpr(
  19249. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19250. begin
  19251. if Proc=nil then ;
  19252. FinishCallArgAccess(Params.Params[0],rraOutParam);
  19253. end;
  19254. function TPasResolver.BI_Dispose_OnGetCallCompatibility(
  19255. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19256. var
  19257. Params: TParamsExpr;
  19258. Param: TPasExpr;
  19259. TypeEl, SubTypeEl: TPasType;
  19260. ParamResolved: TPasResolverResult;
  19261. begin
  19262. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19263. exit(cIncompatible);
  19264. Params:=TParamsExpr(Expr);
  19265. // first param: var PRecord
  19266. Param:=Params.Params[0];
  19267. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19268. {$IFDEF VerbosePasResolver}
  19269. writeln('TPasResolver.BI_Dispose_OnGetCallCompatibility ParamResolved=',GetResolverResultDbg(ParamResolved));
  19270. {$ENDIF}
  19271. Result:=cIncompatible;
  19272. if (rrfReadable in ParamResolved.Flags) then
  19273. if ParamResolved.BaseType=btContext then
  19274. begin
  19275. TypeEl:=ParamResolved.LoTypeEl;
  19276. if TypeEl.ClassType=TPasPointerType then
  19277. begin
  19278. SubTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
  19279. if SubTypeEl.ClassType=TPasRecordType then
  19280. Result:=cExact;
  19281. end;
  19282. end;
  19283. if Result=cIncompatible then
  19284. exit(CheckRaiseTypeArgNo(20180425010620,1,Param,ParamResolved,'pointer of record',RaiseOnError));
  19285. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19286. end;
  19287. procedure TPasResolver.BI_Dispose_OnFinishParamsExpr(
  19288. Proc: TResElDataBuiltInProc; Params: TParamsExpr);
  19289. begin
  19290. if Proc=nil then ;
  19291. FinishCallArgAccess(Params.Params[0],rraRead);
  19292. end;
  19293. function TPasResolver.BI_Default_OnGetCallCompatibility(
  19294. Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
  19295. var
  19296. Params: TParamsExpr;
  19297. Param: TPasExpr;
  19298. ParamResolved: TPasResolverResult;
  19299. Decl: TPasElement;
  19300. aType: TPasType;
  19301. begin
  19302. Result:=cIncompatible;
  19303. if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
  19304. exit;
  19305. Params:=TParamsExpr(Expr);
  19306. // check type or var
  19307. Param:=Params.Params[0];
  19308. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19309. Decl:=ParamResolved.IdentEl;
  19310. aType:=nil;
  19311. if (Decl<>nil) and (ParamResolved.LoTypeEl<>nil) then
  19312. begin
  19313. if Decl is TPasType then
  19314. aType:=TPasType(Decl)
  19315. else if Decl is TPasVariable then
  19316. aType:=TPasVariable(Decl).VarType
  19317. else if Decl.ClassType=TPasArgument then
  19318. aType:=TPasArgument(Decl).ArgType;
  19319. {$IFDEF VerbosePasResolver}
  19320. {AllowWriteln}
  19321. if aType=nil then
  19322. writeln('TPasResolver.BI_Default_OnGetCallCompatibility Decl=',GetObjName(Decl));
  19323. {AllowWriteln-}
  19324. {$ENDIF}
  19325. end;
  19326. if aType=nil then
  19327. begin
  19328. {$IFDEF VerbosePasResolver}
  19329. writeln('TPasResolver.BI_Default_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
  19330. {$ENDIF}
  19331. RaiseMsg(20180501004009,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
  19332. end;
  19333. Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
  19334. end;
  19335. procedure TPasResolver.BI_Default_OnGetCallResult(Proc: TResElDataBuiltInProc;
  19336. Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
  19337. var
  19338. Param: TPasExpr;
  19339. begin
  19340. if Proc=nil then ;
  19341. Param:=Params.Params[0];
  19342. ComputeElement(Param,ResolvedEl,[rcNoImplicitProc]);
  19343. ResolvedEl.Flags:=[rrfReadable];
  19344. ResolvedEl.IdentEl:=nil;
  19345. end;
  19346. procedure TPasResolver.BI_Default_OnEval(Proc: TResElDataBuiltInProc;
  19347. Params: TParamsExpr; Flags: TResEvalFlags; out Evaluated: TResEvalValue);
  19348. var
  19349. Param: TPasExpr;
  19350. ParamResolved: TPasResolverResult;
  19351. TypeEl: TPasType;
  19352. EnumType: TPasEnumType;
  19353. i: Integer;
  19354. ArrayEl: TPasArrayType;
  19355. bt: TResolverBaseType;
  19356. MinInt, MaxInt: TMaxPrecInt;
  19357. begin
  19358. if Proc=nil then ;
  19359. Evaluated:=nil;
  19360. Param:=Params.Params[0];
  19361. ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
  19362. TypeEl:=ParamResolved.LoTypeEl;
  19363. if ParamResolved.BaseType=btContext then
  19364. begin
  19365. if TypeEl.ClassType=TPasArrayType then
  19366. begin
  19367. // array: []
  19368. RaiseNotYetImplemented(20180501005214,Param);
  19369. ArrayEl:=TPasArrayType(TypeEl);
  19370. if length(ArrayEl.Ranges)=0 then
  19371. begin
  19372. // dyn or open array
  19373. end
  19374. else
  19375. begin
  19376. // static array
  19377. end;
  19378. end
  19379. else if TypeEl.ClassType=TPasSetType then
  19380. begin
  19381. // set: first/last enum
  19382. TypeEl:=TPasSetType(TypeEl).EnumType;
  19383. if TypeEl.ClassType=TPasEnumType then
  19384. begin
  19385. EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
  19386. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,EnumType);
  19387. end
  19388. else
  19389. begin
  19390. {$IFDEF VerbosePasResolver}
  19391. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved),' TypeEl=',TypeEl.ClassName);
  19392. {$ENDIF}
  19393. RaiseNotYetImplemented(20180501005348,Params);
  19394. end;
  19395. end
  19396. else if TypeEl.ClassType=TPasEnumType then
  19397. begin
  19398. EnumType:=TPasEnumType(TypeEl);
  19399. i:=0;
  19400. Evaluated:=TResEvalEnum.CreateValue(i,TPasEnumValue(EnumType.Values[i]))
  19401. end;
  19402. end
  19403. else if (TypeEl is TPasUnresolvedSymbolRef)
  19404. and (TypeEl.CustomData is TResElDataBaseType) then
  19405. begin
  19406. // default(base type)
  19407. bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
  19408. bt:=GetActualBaseType(bt);
  19409. if bt in btAllBooleans then
  19410. Evaluated:=TResEvalBool.CreateValue(false)
  19411. {$ifdef HasInt64}
  19412. else if bt=btQWord then
  19413. Evaluated:=TResEvalInt.CreateValue(0)
  19414. {$endif}
  19415. else if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinInt,MaxInt) then
  19416. Evaluated:=TResEvalInt.CreateValue(MinInt)
  19417. {$ifdef FPC_HAS_CPSTRING}
  19418. else if bt in [btAnsiString,btShortString] then
  19419. Evaluated:=TResEvalString.CreateValue('')
  19420. {$endif}
  19421. else if bt in [btUnicodeString,btWideString] then
  19422. Evaluated:=TResEvalUTF16.CreateValue('')
  19423. {$ifdef FPC_HAS_CPSTRING}
  19424. else if bt=btAnsiChar then
  19425. Evaluated:=TResEvalString.CreateValue(#0)
  19426. {$endif}
  19427. else if bt=btWideChar then
  19428. Evaluated:=TResEvalUTF16.CreateValue(#0)
  19429. else if bt in btAllFloats then
  19430. Evaluated:=TResEvalFloat.CreateValue(0.0)
  19431. else
  19432. begin
  19433. {$IFDEF VerbosePasResolver}
  19434. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19435. {$ENDIF}
  19436. RaiseNotYetImplemented(20180501005645,Params);
  19437. end;
  19438. end
  19439. else if ParamResolved.LoTypeEl is TPasRangeType then
  19440. begin
  19441. // e.g. type t = 2..10;
  19442. Evaluated:=EvalRangeLimit(TPasRangeType(TypeEl).RangeExpr,FLags,true,Param);
  19443. end
  19444. else if ParamResolved.BaseType=btSet then
  19445. begin
  19446. if ParamResolved.SubType=btContext then
  19447. begin
  19448. if ParamResolved.LoTypeEl.ClassType=TPasEnumType then
  19449. Evaluated:=TResEvalSet.CreateEmpty(revskEnum,TPasEnumType(ParamResolved.LoTypeEl))
  19450. else
  19451. begin
  19452. {$IFDEF VerbosePasResolver}
  19453. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19454. {$ENDIF}
  19455. RaiseNotYetImplemented(20180501125138,Param);
  19456. end;
  19457. end
  19458. else
  19459. begin
  19460. {$IFDEF VerbosePasResolver}
  19461. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19462. {$ENDIF}
  19463. RaiseNotYetImplemented(20180501125014,Param);
  19464. end;
  19465. end
  19466. else
  19467. begin
  19468. {$IFDEF VerbosePasResolver}
  19469. writeln('TPasResolver.BI_Default_OnEval ',GetResolverResultDbg(ParamResolved));
  19470. {$ENDIF}
  19471. RaiseNotYetImplemented(20180501004839,Param);
  19472. end;
  19473. end;
  19474. constructor TPasResolver.Create;
  19475. begin
  19476. inherited Create;
  19477. FDefaultScope:=TPasDefaultScope.Create;
  19478. FPendingForwardProcs:=TFPList.Create;
  19479. FBaseTypeChar:={$ifdef FPC_HAS_CPSTRING}btAnsiChar{$else}btWideChar{$endif};
  19480. FBaseTypeString:={$ifdef FPC_HAS_CPSTRING}btAnsiString{$else}btUnicodeString{$endif};
  19481. FBaseTypeExtended:=btDouble;
  19482. FBaseTypeLength:={$ifdef HasInt64}btInt64{$else}btIntDouble{$endif};
  19483. FDynArrayMinIndex:=0;
  19484. FDynArrayMaxIndex:=High(TMaxPrecInt);
  19485. cTGUIDToString:=cTypeConversion+1;
  19486. cStringToTGUID:=cTypeConversion+1;
  19487. cInterfaceToTGUID:=cTypeConversion+1;
  19488. cInterfaceToString:=cTypeConversion+2;
  19489. FScopeClass_Array:=TPasArrayScope;
  19490. FScopeClass_Class:=TPasClassScope;
  19491. FScopeClass_InitialFinalization:=TPasInitialFinalizationScope;
  19492. FScopeClass_Module:=TPasModuleScope;
  19493. FScopeClass_Proc:=TPasProcedureScope;
  19494. FScopeClass_ProcType:=TPasProcTypeScope;
  19495. FScopeClass_Record:=TPasRecordScope;
  19496. FScopeClass_Section:=TPasSectionScope;
  19497. FScopeClass_WithExpr:=TPasWithExprScope;
  19498. fExprEvaluator:=TResExprEvaluator.Create;
  19499. fExprEvaluator.OnLog:=@OnExprEvalLog;
  19500. fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
  19501. fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
  19502. fExprEvaluator.OnRangeCheckEl:=@OnRangeCheckEl;
  19503. PushScope(FDefaultScope);
  19504. end;
  19505. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  19506. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  19507. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  19508. var
  19509. aScanner: TPascalScanner;
  19510. SrcPos: TPasSourcePos;
  19511. begin
  19512. // get source position for good error messages
  19513. aScanner:=CurrentParser.Scanner;
  19514. if (ASourceFilename='') or StoreSrcColumns then
  19515. begin
  19516. SrcPos.FileName:=aScanner.CurFilename;
  19517. SrcPos.Row:=aScanner.CurRow;
  19518. SrcPos.Column:=aScanner.CurColumn;
  19519. end
  19520. else
  19521. begin
  19522. SrcPos.FileName:=ASourceFilename;
  19523. SrcPos.Row:=ASourceLinenumber;
  19524. SrcPos.Column:=0;
  19525. end;
  19526. Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
  19527. end;
  19528. function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
  19529. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  19530. const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
  19531. var
  19532. El: TPasElement;
  19533. SrcY: integer;
  19534. SectionScope: TPasSectionScope;
  19535. begin
  19536. Result:=nil;
  19537. {$IFDEF VerbosePasResolver}
  19538. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  19539. {$ENDIF}
  19540. if (AParent=nil) and (FRootElement<>nil) then
  19541. RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
  19542. if ASrcPos.FileName='' then
  19543. begin
  19544. {$IFDEF VerbosePasResolver}
  19545. writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
  19546. {$ENDIF}
  19547. RaiseInternalError(20160922163541,'missing filename');
  19548. end;
  19549. SrcY:=ASrcPos.Row;
  19550. if StoreSrcColumns then
  19551. SrcY:=MangleSourceLineNumber(SrcY,ASrcPos.Column);
  19552. if AClass=TSelfExpr then
  19553. RaiseInternalError(20190131154235);
  19554. // create element
  19555. El:=AClass.Create(AName,AParent);
  19556. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('CreateElement');{$ENDIF}
  19557. FLastElement:=El;
  19558. try
  19559. El.Visibility:=AVisibility;
  19560. El.SourceFilename:=ASrcPos.FileName;
  19561. El.SourceLinenumber:=SrcY;
  19562. if FRootElement=nil then
  19563. begin
  19564. RootElement:=El as TPasModule;
  19565. if FStep=prsInit then
  19566. FStep:=prsParsing;
  19567. end
  19568. else if (AParent is TPasSection) and (TPasSection(AParent).Declarations.Count=0) then
  19569. begin
  19570. // first element of section
  19571. SectionScope:=TPasSectionScope(AParent.CustomData);
  19572. SectionScope.BoolSwitches:=CurrentParser.Scanner.CurrentBoolSwitches;
  19573. SectionScope.ModeSwitches:=CurrentParser.Scanner.CurrentModeSwitches;
  19574. end;
  19575. if IsElementSkipped(El) then exit;
  19576. // create scope
  19577. if AClass.InheritsFrom(TPasExpr) then
  19578. // resolved when finished
  19579. else if (AClass=TPasVariable)
  19580. or (AClass=TPasConst) then
  19581. AddVariable(TPasVariable(El))
  19582. else if AClass=TPasResString then
  19583. AddResourceString(TPasResString(El))
  19584. else if (AClass=TPasProperty) then
  19585. AddProperty(TPasProperty(El))
  19586. else if AClass=TPasArgument then
  19587. AddArgument(TPasArgument(El))
  19588. else if AClass=TPasEnumType then
  19589. AddEnumType(TPasEnumType(El))
  19590. else if AClass=TPasEnumValue then
  19591. AddEnumValue(TPasEnumValue(El))
  19592. else if (AClass=TUnresolvedPendingRef) then
  19593. else if (AClass=TPasAliasType)
  19594. or (AClass=TPasTypeAliasType)
  19595. or (AClass=TPasClassOfType)
  19596. or (AClass=TPasPointerType)
  19597. or (AClass=TPasSetType)
  19598. or (AClass=TPasRangeType)
  19599. or (AClass=TPasSpecializeType) then
  19600. AddType(TPasType(El))
  19601. else if AClass=TPasArrayType then
  19602. AddArrayType(TPasArrayType(El),TypeParams)
  19603. else if (AClass=TPasProcedureType)
  19604. or (AClass=TPasFunctionType) then
  19605. AddProcedureType(TPasProcedureType(El),TypeParams)
  19606. else if AClass=TPasGenericTemplateType then
  19607. AddGenericTemplateType(TPasGenericTemplateType(El))
  19608. else if AClass=TPasStringType then
  19609. begin
  19610. AddType(TPasType(El));
  19611. {$ifdef FPC_HAS_CPSTRING}
  19612. if BaseTypes[btShortString]=nil then
  19613. {$endif}
  19614. RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
  19615. end
  19616. else if AClass=TPasRecordType then
  19617. AddRecordType(TPasRecordType(El),TypeParams)
  19618. else if AClass=TPasClassType then
  19619. AddClassType(TPasClassType(El),TypeParams)
  19620. else if AClass=TPasVariant then
  19621. else if AClass.InheritsFrom(TPasProcedure) then
  19622. AddProcedure(TPasProcedure(El),TypeParams)
  19623. else if AClass=TPasResultElement then
  19624. AddFunctionResult(TPasResultElement(El))
  19625. else if AClass=TProcedureBody then
  19626. AddProcedureBody(TProcedureBody(El))
  19627. else if AClass=TPasMethodResolution then
  19628. else if AClass=TPasImplExceptOn then
  19629. AddExceptOn(TPasImplExceptOn(El))
  19630. else if AClass=TPasImplWithDo then
  19631. AddWithDo(TPasImplWithDo(El))
  19632. else if AClass=TPasImplLabelMark then
  19633. else if AClass=TPasOverloadedProc then
  19634. else if (AClass=TInterfaceSection)
  19635. or (AClass=TImplementationSection)
  19636. or (AClass=TProgramSection)
  19637. or (AClass=TLibrarySection) then
  19638. AddSection(TPasSection(El))
  19639. else if (AClass=TPasModule)
  19640. or (AClass=TPasProgram)
  19641. or (AClass=TPasLibrary) then
  19642. AddModule(TPasModule(El))
  19643. else if AClass=TPasUsesUnit then
  19644. else if AClass=TInitializationSection then
  19645. AddInitialFinalizationSection(TInitializationSection(El))
  19646. else if AClass=TFinalizationSection then
  19647. AddInitialFinalizationSection(TFinalizationSection(El))
  19648. else if AClass=TPasImplCommand then
  19649. else if AClass.InheritsFrom(TPasImplBlock) then
  19650. // resolved when finished
  19651. else if AClass=TPasAttributes then
  19652. else if AClass=TPasUnresolvedUnitRef then
  19653. RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
  19654. else
  19655. RaiseNotYetImplemented(20160922163544,El);
  19656. Result:=El;
  19657. finally
  19658. if Result=nil then
  19659. El.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  19660. end;
  19661. end;
  19662. function TPasResolver.FindModule(const AName: String; NameExpr,
  19663. InFileExpr: TPasExpr): TPasModule;
  19664. var
  19665. InFilename, FileUnitName: String;
  19666. begin
  19667. if InFileExpr<>nil then
  19668. begin
  19669. InFilename:=GetUsesUnitInFilename(InFileExpr);
  19670. if InFilename='' then
  19671. RaiseXExpectedButYFound(20180222001220,
  19672. 'file path','empty string',InFileExpr);
  19673. if msDelphi in CurrentParser.CurrentModeswitches then
  19674. begin
  19675. // in delphi the last unit name must match the filename
  19676. FileUnitName:=ChangeFileExt(ExtractFileName(InFilename),'');
  19677. if CompareText(AName,FileUnitName)<>0 then
  19678. RaiseXExpectedButYFound(20180222230400,AName,FileUnitName,InFileExpr);
  19679. end;
  19680. end;
  19681. Result:=FindUnit(AName,InFilename,NameExpr,InFileExpr);
  19682. if Result=nil then
  19683. begin
  19684. if InFileExpr<>nil then
  19685. RaiseMsg(20180223140434,nCantFindUnitX,sCantFindUnitX,[InFilename],InFileExpr)
  19686. else
  19687. RaiseMsg(20180223140409,nCantFindUnitX,sCantFindUnitX,[AName],NameExpr);
  19688. end;
  19689. end;
  19690. function TPasResolver.FindElement(const aName: String): TPasElement;
  19691. begin
  19692. Result:=FindElementFor(aName,nil,0);
  19693. end;
  19694. function TPasResolver.FindElementFor(const aName: String; AParent: TPasElement;
  19695. TypeParamCount: integer): TPasElement;
  19696. // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
  19697. var
  19698. p: SizeInt;
  19699. RightPath, CurName, LeftPath: String;
  19700. NeedPop: Boolean;
  19701. CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
  19702. CurSection: TPasSection;
  19703. i: Integer;
  19704. UsesUnit: TPasUsesUnit;
  19705. CurScope: TPasDotBaseScope;
  19706. FindData: TPRFindData;
  19707. begin
  19708. Result:=nil;
  19709. ErrorEl:=nil; // use nil to use scanner position as error position
  19710. RightPath:=aName;
  19711. LeftPath:='';
  19712. p:=1;
  19713. CurScopeEl:=nil;
  19714. repeat
  19715. p:=Pos('.',RightPath);
  19716. if p<1 then
  19717. begin
  19718. CurName:=RightPath;
  19719. RightPath:='';
  19720. end
  19721. else
  19722. begin
  19723. CurName:=LeftStr(RightPath,p-1);
  19724. Delete(RightPath,1,p);
  19725. if RightPath='' then
  19726. RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  19727. end;
  19728. if LeftPath='' then
  19729. LeftPath:=CurName
  19730. else
  19731. LeftPath:=LeftPath+'.'+CurName;
  19732. {$IFDEF VerbosePasResolver}
  19733. {AllowWriteln}
  19734. if RightPath<>'' then
  19735. writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
  19736. {AllowWriteln-}
  19737. {$ENDIF}
  19738. if not IsValidIdent(CurName) then
  19739. RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
  19740. if CurScopeEl<>nil then
  19741. begin
  19742. NeedPop:=true;
  19743. if CurScopeEl is TPasType then
  19744. begin
  19745. if (CurScopeEl is TPasGenericType)
  19746. and not IsFullySpecialized(TPasGenericType(CurScopeEl)) then
  19747. RaiseMsg(20200217131215,nGenericsWithoutSpecializationAsType,
  19748. sGenericsWithoutSpecializationAsType,['reference'],ErrorEl);
  19749. CurScope:=PushDotScope(TPasType(CurScopeEl));
  19750. if CurScope=nil then
  19751. RaiseMsg(20190122122529,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19752. ['.',LeftPath],ErrorEl);
  19753. CurScope.OnlyTypeMembers:=true;
  19754. end
  19755. else if CurScopeEl is TPasModule then
  19756. PushModuleDotScope(TPasModule(CurScopeEl))
  19757. else
  19758. RaiseMsg(20170504174021,nIllegalQualifierAfter,sIllegalQualifierAfter,
  19759. ['.',LeftPath],ErrorEl);
  19760. end
  19761. else
  19762. NeedPop:=false;
  19763. if (RightPath='') and (TypeParamCount>0) then
  19764. begin
  19765. NextEl:=FindGenericEl(CurName,TypeParamCount,FindData,ErrorEl);
  19766. if (FindData.StartScope<>nil) and (FindData.StartScope.ClassType=ScopeClass_WithExpr)
  19767. and (wesfNeedTmpVar in TPasWithExprScope(FindData.StartScope).Flags) then
  19768. RaiseInternalError(20190801104033); // caller forgot to handle "With"
  19769. end
  19770. else
  19771. NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true);
  19772. {$IFDEF VerbosePasResolver}
  19773. //if RightPath<>'' then
  19774. // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
  19775. {$ENDIF}
  19776. if NextEl is TPasModule then
  19777. begin
  19778. if CurScopeEl is TPasModule then
  19779. RaiseXExpectedButYFound(20170328001619,'class',GetElementTypeName(NextEl)+' '+NextEl.Name,ErrorEl);
  19780. if Pos('.',NextEl.Name)>0 then
  19781. begin
  19782. // dotted module name -> check if the full module name is in aName
  19783. if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
  19784. begin
  19785. if CompareText(NextEl.Name,aName)=0 then
  19786. RaiseXExpectedButYFound(20170504165825,'type',GetElementTypeName(NextEl),ErrorEl)
  19787. else
  19788. RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
  19789. end;
  19790. RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
  19791. end;
  19792. CurScopeEl:=NextEl;
  19793. end
  19794. else if NextEl.ClassType=TPasUsesUnit then
  19795. begin
  19796. // the first name of a used unit matches -> find longest match
  19797. CurSection:=NextEl.Parent as TPasSection;
  19798. i:=length(CurSection.UsesClause)-1;
  19799. BestEl:=nil;
  19800. while i>=0 do
  19801. begin
  19802. UsesUnit:=CurSection.UsesClause[i];
  19803. CurName:=UsesUnit.Name;
  19804. if IsDottedIdentifierPrefix(CurName,aName)
  19805. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19806. BestEl:=UsesUnit;
  19807. dec(i);
  19808. if (i<0) and (CurSection.ClassType=TImplementationSection) then
  19809. begin
  19810. CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
  19811. if CurSection=nil then break;
  19812. i:=length(CurSection.UsesClause)-1;
  19813. end;
  19814. end;
  19815. // check module name too
  19816. CurName:=RootElement.Name;
  19817. if IsDottedIdentifierPrefix(CurName,aName)
  19818. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19819. BestEl:=RootElement;
  19820. if BestEl=nil then
  19821. RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
  19822. RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
  19823. if BestEl.ClassType=TPasUsesUnit then
  19824. CurScopeEl:=TPasUsesUnit(BestEl).Module
  19825. else
  19826. CurScopeEl:=BestEl;
  19827. end
  19828. else if NextEl<>nil then
  19829. CurScopeEl:=NextEl
  19830. else
  19831. RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
  19832. // restore scope
  19833. if NeedPop then
  19834. PopScope;
  19835. if RightPath='' then
  19836. exit(NextEl);
  19837. until false;
  19838. if AParent=nil then ;;
  19839. end;
  19840. function TPasResolver.FindElementWithoutParams(const AName: String;
  19841. ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
  19842. var
  19843. Data: TPRFindData;
  19844. begin
  19845. Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs,NoGenerics);
  19846. if Data.Found=nil then exit; // forward type: class-of or ^
  19847. CheckFoundElement(Data,nil);
  19848. if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
  19849. and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
  19850. RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
  19851. end;
  19852. function TPasResolver.FindElementWithoutParams(const AName: String; out
  19853. Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs,
  19854. NoGenerics: boolean): TPasElement;
  19855. var
  19856. Abort: boolean;
  19857. begin
  19858. //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
  19859. Result:=Nil;
  19860. Abort:=false;
  19861. Data:=Default(TPRFindData);
  19862. Data.ErrorPosEl:=ErrorPosEl;
  19863. Data.SkipGenerics:=NoGenerics;
  19864. IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort);
  19865. Result:=Data.Found;
  19866. if Result=nil then
  19867. begin
  19868. if (ErrorPosEl=nil) and (LastElement<>nil) then
  19869. begin
  19870. if (LastElement.ClassType=TPasClassOfType)
  19871. and (TPasClassOfType(LastElement).DestType=nil) then
  19872. begin
  19873. // 'class of' of a not yet defined class
  19874. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  19875. CurrentParser.CurSourcePos);
  19876. exit;
  19877. end
  19878. else if (LastElement.ClassType=TPasPointerType)
  19879. and (TPasPointerType(LastElement).DestType=nil) then
  19880. begin
  19881. // pointer of a not yet defined type
  19882. Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
  19883. CurrentParser.CurSourcePos);
  19884. exit;
  19885. end
  19886. end;
  19887. RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
  19888. end;
  19889. if NoProcsWithArgs and (Result is TPasProcedure)
  19890. and ProcNeedsParams(TPasProcedure(Result).ProcType)
  19891. then
  19892. // proc needs parameters
  19893. RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
  19894. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
  19895. end;
  19896. function TPasResolver.FindFirstEl(const AName: String; out Data: TPRFindData;
  19897. ErrorPosEl: TPasElement): TPasElement;
  19898. var
  19899. Abort: boolean;
  19900. begin
  19901. Abort:=false;
  19902. Data:=Default(TPRFindData);
  19903. Data.ErrorPosEl:=ErrorPosEl;
  19904. IterateElements(AName,@OnFindFirst,@Data,Abort);
  19905. Result:=Data.Found;
  19906. end;
  19907. procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
  19908. // Input: El is TPasUsesUnit
  19909. // Output: El is either a TPasUsesUnit or the root module
  19910. var
  19911. CurUsesUnit: TPasUsesUnit;
  19912. BestEl: TPasElement;
  19913. aName, CurName: String;
  19914. Clause: TPasUsesClause;
  19915. i: Integer;
  19916. Section: TPasSection;
  19917. begin
  19918. {$IFDEF VerbosePasResolver}
  19919. //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
  19920. {$ENDIF}
  19921. if not (El is TPasUsesUnit) then
  19922. RaiseInternalError(20170503000945);
  19923. aName:=GetNameExprValue(Expr);
  19924. if aName='' then
  19925. RaiseNotYetImplemented(20170503110217,Expr);
  19926. repeat
  19927. Expr:=GetNextDottedExpr(Expr);
  19928. if Expr=nil then break;
  19929. CurName:=GetNameExprValue(Expr);
  19930. if CurName='' then
  19931. RaiseNotYetImplemented(20170502164242,Expr);
  19932. aName:=aName+'.'+CurName;
  19933. until false;
  19934. {$IFDEF VerbosePasResolver}
  19935. //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
  19936. {$ENDIF}
  19937. // search in uses clause
  19938. BestEl:=nil;
  19939. Section:=TPasUsesUnit(El).Parent as TPasSection;
  19940. repeat
  19941. Clause:=Section.UsesClause;
  19942. for i:=0 to length(Clause)-1 do
  19943. begin
  19944. CurUsesUnit:=Clause[i];
  19945. CurName:=CurUsesUnit.Name;
  19946. if IsDottedIdentifierPrefix(CurName,aName)
  19947. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19948. BestEl:=CurUsesUnit; // a better match
  19949. end;
  19950. if Section is TImplementationSection then
  19951. begin
  19952. // search in interface uses clause too
  19953. Section:=(Section.Parent as TPasModule).InterfaceSection;
  19954. end
  19955. else
  19956. break;
  19957. until Section=nil;
  19958. {$IFDEF VerbosePasResolver}
  19959. //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
  19960. {$ENDIF}
  19961. // check module name
  19962. CurName:=El.GetModule.Name;
  19963. if IsDottedIdentifierPrefix(CurName,aName)
  19964. and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
  19965. BestEl:=El.GetModule; // a better match
  19966. if BestEl=nil then
  19967. begin
  19968. // no dotted module name fits the expression
  19969. RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
  19970. end;
  19971. El:=BestEl;
  19972. {$IFDEF VerbosePasResolver}
  19973. //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
  19974. {$ENDIF}
  19975. end;
  19976. function TPasResolver.FindGenericEl(const AName: string;
  19977. TemplateCount: integer; out Find: TPRFindData; ErrorPosEl: TPasElement
  19978. ): TPasElement;
  19979. var
  19980. Data: TPRFindGenericData;
  19981. Abort: boolean;
  19982. begin
  19983. Data:=Default(TPRFindGenericData);
  19984. Data.TemplateCount:=TemplateCount;
  19985. Data.Find.ErrorPosEl:=ErrorPosEl;
  19986. Abort:=false;
  19987. IterateElements(AName,@OnFindFirst_GenericEl,@Data,Abort);
  19988. Find:=Data.Find;
  19989. Result:=Find.Found;
  19990. if Result=nil then
  19991. begin
  19992. {$IFDEF VerbosePasResolver}
  19993. WriteScopesShort('TPasResolver.FindGenericType');
  19994. {$ENDIF}
  19995. RaiseMsg(20190801104759,nIdentifierNotFound,sIdentifierNotFound,[AName+GetGenericParamCommas(TemplateCount)],ErrorPosEl);
  19996. end;
  19997. CheckFoundElement(Find,nil);
  19998. end;
  19999. procedure TPasResolver.IterateElements(const aName: string;
  20000. const OnIterateElement: TIterateScopeElement; Data: Pointer;
  20001. var Abort: boolean);
  20002. var
  20003. i: Integer;
  20004. Scope: TPasScope;
  20005. begin
  20006. for i:=FScopeCount-1 downto 0 do
  20007. begin
  20008. Scope:=Scopes[i];
  20009. Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
  20010. if Abort then
  20011. exit;
  20012. if Scope is TPasSubExprScope then break;
  20013. end;
  20014. end;
  20015. procedure TPasResolver.CheckFoundElement(
  20016. const FindData: TPRFindData; Ref: TResolvedReference);
  20017. // check visibility rules
  20018. // Call this method after finding an element by searching the scopes.
  20019. function IsFieldInheritingConst(aRef: TResolvedReference): boolean;
  20020. // returns true of aRef is a TPasVariable that inherits its const from parent.
  20021. // For example
  20022. // type TRecord = record
  20023. // a: word; // inherits const
  20024. // const b: word = 3; // does not inherit const
  20025. // class var c: word; // does not inherit const
  20026. // end;
  20027. // procedure DoIt(const r:TRecord)
  20028. var
  20029. El: TPasElement;
  20030. begin
  20031. El:=aRef.Declaration;
  20032. Result:=(El.ClassType=TPasVariable)
  20033. and (TPasVariable(El).VarModifiers*[vmClass, vmStatic]=[]);
  20034. //writeln('IsFieldInheritingConst ',GetObjName(El),' ',Result,' vmClass=',vmClass in TPasVariable(El).VarModifiers);
  20035. end;
  20036. var
  20037. Proc: TPasProcedure;
  20038. StartScope: TPasScope;
  20039. OnlyTypeMembers, IsClassOf: Boolean;
  20040. C: TClass;
  20041. ClassRecScope: TPasClassOrRecordScope;
  20042. i: Integer;
  20043. AbstractProcs: TArrayOfPasProcedure;
  20044. TypeEl: TPasType;
  20045. begin
  20046. StartScope:=FindData.StartScope;
  20047. OnlyTypeMembers:=false;
  20048. IsClassOf:=false;
  20049. if StartScope is TPasDotBaseScope then
  20050. begin
  20051. OnlyTypeMembers:=TPasDotBaseScope(StartScope).OnlyTypeMembers;
  20052. if StartScope.ClassType=TPasDotClassScope then
  20053. IsClassOf:=TPasDotClassScope(StartScope).IsClassOf;
  20054. if Ref<>nil then
  20055. begin
  20056. Include(Ref.Flags,rrfDotScope);
  20057. if TPasDotBaseScope(StartScope).ConstParent
  20058. and IsFieldInheritingConst(Ref) then
  20059. Include(Ref.Flags,rrfConstInherited);
  20060. end;
  20061. end
  20062. else if StartScope.ClassType=FScopeClass_WithExpr then
  20063. begin
  20064. OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
  20065. IsClassOf:=wesfIsClassOf in TPasWithExprScope(StartScope).Flags;
  20066. if Ref<>nil then
  20067. begin
  20068. Include(Ref.Flags,rrfDotScope);
  20069. if (wesfConstParent in TPasWithExprScope(StartScope).Flags)
  20070. and IsFieldInheritingConst(Ref) then
  20071. Include(Ref.Flags,rrfConstInherited);
  20072. end;
  20073. end
  20074. else if StartScope.ClassType=FScopeClass_Proc then
  20075. begin
  20076. Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
  20077. //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
  20078. if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
  20079. OnlyTypeMembers:=true;
  20080. end
  20081. else if StartScope.ClassType=TPasGroupScope then
  20082. OnlyTypeMembers:=TPasGroupScope(StartScope).OnlyTypeMembers;
  20083. //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
  20084. // ' StartIsDot=',StartScope is TPasDotBaseScope,
  20085. // ' OnlyTypeMembers=',(StartScope is TPasDotBaseScope)
  20086. // and TPasDotBaseScope(StartScope).OnlyTypeMembers,
  20087. // ' FindData.Found=',GetObjName(FindData.Found));
  20088. if OnlyTypeMembers then
  20089. begin
  20090. //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
  20091. // and (vmClass in TPasVariable(FindData.Found).VarModifiers));
  20092. // only class vars/procs allowed
  20093. if FindData.Found.ClassType=TPasConstructor then
  20094. // constructor: ok
  20095. else if IsClassMethod(FindData.Found)
  20096. then
  20097. // class proc: ok
  20098. else if (FindData.Found is TPasVariable)
  20099. and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
  20100. // class var/const/property: ok
  20101. else if FindData.Found is TPasType then
  20102. // nested type: ok
  20103. else if FindData.Found is TPasEnumValue then
  20104. // e.g. enumtype.enumvalue: ok
  20105. else
  20106. begin
  20107. RaiseMsg(20170216152348,nInstanceMemberXInaccessible,
  20108. sInstanceMemberXInaccessible,[FindData.Found.Name],FindData.ErrorPosEl);
  20109. end;
  20110. end
  20111. else if (proExtClassInstanceNoTypeMembers in Options)
  20112. and (StartScope is TPasDotClassScope)
  20113. and TPasClassType(TPasDotClassScope(StartScope).ClassRecScope.Element).IsExternal then
  20114. begin
  20115. // e.g. ExtClassInstance.Member
  20116. C:=FindData.Found.ClassType;
  20117. if (C=TPasProcedure) or (C=TPasFunction) then
  20118. // ok
  20119. else if (C=TPasConst) then
  20120. // ok
  20121. else if ((C=TPasVariable) or (C=TPasProperty))
  20122. and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
  20123. // ok
  20124. else if IsHelper(FindData.Found.Parent) then
  20125. // ok
  20126. else
  20127. begin
  20128. RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
  20129. sExternalClassInstanceCannotAccessStaticX,
  20130. [GetElementTypeName(FindData.Found)+' '+FindData.Found.Name],
  20131. FindData.ErrorPosEl);
  20132. end;
  20133. end;
  20134. if (FindData.Found is TPasProcedure) then
  20135. begin
  20136. Proc:=TPasProcedure(FindData.Found);
  20137. if Proc.IsVirtual or Proc.IsOverride then
  20138. begin
  20139. if StartScope.ClassType=TPasInheritedScope then
  20140. begin
  20141. // inherited expr -> call directly
  20142. if Proc.IsAbstract then
  20143. RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
  20144. sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
  20145. end
  20146. else
  20147. begin
  20148. // call via virtual method table
  20149. if Ref<>nil then
  20150. Ref.Flags:=Ref.Flags+[rrfVMT];
  20151. end;
  20152. end;
  20153. // constructor: NewInstance or normal call
  20154. // it is a NewInstance iff the scope is a class/record, e.g. TObject.Create
  20155. if (Proc.ClassType=TPasConstructor)
  20156. and (Ref<>nil) then
  20157. begin
  20158. if OnlyTypeMembers then
  20159. Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
  20160. // store the class in Ref.Context
  20161. if Ref.Context<>nil then
  20162. RaiseInternalError(20170131141936);
  20163. Ref.Context:=TResolvedRefCtxConstructor.Create;
  20164. TypeEl:=nil;
  20165. ClassRecScope:=nil;
  20166. C:=StartScope.ClassType;
  20167. if C.InheritsFrom(TPasDotClassOrRecordScope) then
  20168. ClassRecScope:=TPasDotClassOrRecordScope(StartScope).ClassRecScope
  20169. else if C=ScopeClass_WithExpr then
  20170. begin
  20171. ClassRecScope:=TPasWithExprScope(StartScope).ClassRecScope;
  20172. if ClassRecScope=nil then
  20173. TypeEl:=TPasWithExprScope(StartScope).Scope.Element as TPasType;
  20174. end
  20175. else if C=ScopeClass_Procedure then
  20176. ClassRecScope:=TPasProcedureScope(StartScope).ClassRecScope
  20177. else if C=TPasDotHelperScope then
  20178. TypeEl:=NoNil(TPasDotHelperScope(StartScope).Element) as TPasType
  20179. else
  20180. RaiseInternalError(20170131150855,GetObjName(StartScope));
  20181. if TypeEl<>nil then
  20182. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl
  20183. else
  20184. begin
  20185. if ClassRecScope=nil then
  20186. RaiseInternalError(20190123120156,GetObjName(StartScope));
  20187. TypeEl:=ClassRecScope.Element as TPasMembersType;
  20188. if (TypeEl.ClassType=TPasClassType)
  20189. and (TPasClassType(TypeEl).HelperForType<>nil) then
  20190. TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
  20191. TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
  20192. if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
  20193. begin
  20194. if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
  20195. LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
  20196. sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
  20197. else
  20198. begin
  20199. AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
  20200. if (length(AbstractProcs)>0) then
  20201. begin
  20202. if IsClassOf then
  20203. // aClass.Create: do not warn
  20204. else
  20205. for i:=0 to length(AbstractProcs)-1 do
  20206. LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
  20207. sConstructingClassXWithAbstractMethodY,
  20208. [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
  20209. end;
  20210. end;
  20211. end;
  20212. end;
  20213. end;
  20214. {$IFDEF VerbosePasResolver}
  20215. {AllowWriteln}
  20216. if (Proc.ClassType=TPasConstructor) then
  20217. begin
  20218. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  20219. if Ref=nil then
  20220. write(' no ref!')
  20221. else
  20222. begin
  20223. write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
  20224. ' StartScope=',GetObjName(StartScope),
  20225. ' OnlyTypeMembers=',OnlyTypeMembers);
  20226. end;
  20227. writeln;
  20228. end;
  20229. {AllowWriteln-}
  20230. {$ENDIF}
  20231. // destructor: FreeInstance or normal call
  20232. // it is a normal call if 'inherited'
  20233. if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
  20234. if not (StartScope is TPasInheritedScope) then
  20235. Ref.Flags:=Ref.Flags+[rrfFreeInstance];
  20236. {$IFDEF VerbosePasResolver}
  20237. {AllowWriteln}
  20238. if (Proc.ClassType=TPasDestructor) then
  20239. begin
  20240. write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
  20241. if Ref=nil then
  20242. write(' no ref!')
  20243. else
  20244. begin
  20245. write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
  20246. ' StartScope=',GetObjName(StartScope));
  20247. if StartScope is TPasDotClassOrRecordScope then
  20248. write(' InheritedExpr=',StartScope is TPasInheritedScope);
  20249. end;
  20250. writeln;
  20251. end;
  20252. {AllowWriteln-}
  20253. {$ENDIF}
  20254. end;
  20255. CheckFoundElementVisibility(FindData,Ref);
  20256. end;
  20257. procedure TPasResolver.CheckFoundElementVisibility(const FindData: TPRFindData;
  20258. Ref: TResolvedReference);
  20259. var
  20260. Context: TPasElement;
  20261. FoundContext: TPasMembersType;
  20262. CurScope: TPasScope;
  20263. {$IFDEF VerbosePasResolver}
  20264. i: Integer;
  20265. {$ENDIF}
  20266. begin
  20267. // check class visibility
  20268. if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
  20269. begin
  20270. Context:=GetVisibilityContext;
  20271. FoundContext:=FindData.Found.Parent as TPasMembersType;
  20272. case FindData.Found.Visibility of
  20273. visPrivate:
  20274. // private members can only be accessed in same module
  20275. if FoundContext.GetModule<>Context.GetModule then
  20276. RaiseMsg(20170216152354,nCantAccessXMember,sCantAccessXMember,
  20277. ['private',FindData.Found.Name],FindData.ErrorPosEl);
  20278. visProtected:
  20279. begin
  20280. // protected members can only be accessed in same module
  20281. // or descendant classes
  20282. CurScope:=TopScope;
  20283. if FoundContext.GetModule=Context.GetModule then
  20284. // same module -> ok
  20285. else if (Context is TPasType)
  20286. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  20287. // context in class or descendant
  20288. else if (CurScope is TPasDotClassOrRecordScope)
  20289. and (TPasDotClassOrRecordScope(CurScope).ClassRecScope.Element.GetModule=Context.GetModule) then
  20290. // e.g. aClassInThisModule.identifier
  20291. else if (CurScope is TPasWithExprScope)
  20292. and (TPasWithExprScope(CurScope).Scope.Element<>nil)
  20293. and (TPasWithExprScope(CurScope).Scope.Element.GetModule=Context.GetModule) then
  20294. // e.g. with aClassInThisModule do identifier
  20295. else
  20296. RaiseMsg(20170216152356,nCantAccessXMember,sCantAccessXMember,
  20297. ['protected',FindData.Found.Name],FindData.ErrorPosEl);
  20298. end;
  20299. visStrictPrivate:
  20300. // strict private members can only be accessed in their class
  20301. if Context<>FoundContext then
  20302. begin
  20303. {$IFDEF VerbosePasResolver}
  20304. {AllowWriteln}
  20305. writeln('TPasResolver.CheckFoundElement Context=',GetElementDbgPath(Context),' FoundContext=',GetElementDbgPath(FoundContext));
  20306. for i:=ScopeCount-1 downto 0 do
  20307. writeln(' ',i,' ',Scopes[i].ClassName,' Element=',GetObjName(Scopes[i].Element),' VisibilityContext=',GetObjName(Scopes[i].VisibilityContext));
  20308. {AllowWriteln-}
  20309. {$ENDIF}
  20310. RaiseMsg(20170216152357,nCantAccessXMember,sCantAccessXMember,
  20311. ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
  20312. end;
  20313. visStrictProtected:
  20314. // strict protected members can only be accessed in their and descendant classes
  20315. if (Context is TPasType)
  20316. and (CheckClassIsClass(TPasType(Context),FoundContext)<>cIncompatible) then
  20317. // context in class or descendant
  20318. else
  20319. RaiseMsg(20170216152400,nCantAccessXMember,sCantAccessXMember,
  20320. ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
  20321. end;
  20322. end;
  20323. if Ref=nil then ;
  20324. end;
  20325. function TPasResolver.GetVisibilityContext: TPasElement;
  20326. var
  20327. i: Integer;
  20328. begin
  20329. for i:=ScopeCount-1 downto 0 do
  20330. begin
  20331. Result:=Scopes[i].VisibilityContext;
  20332. if Result<>nil then exit;
  20333. end;
  20334. Result:=nil;
  20335. end;
  20336. procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
  20337. begin
  20338. case ScopeType of
  20339. stWithExpr: PushWithExprScope(El as TPasExpr);
  20340. else
  20341. RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
  20342. end;
  20343. end;
  20344. procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
  20345. begin
  20346. if IsElementSkipped(El) then exit;
  20347. case ScopeType of
  20348. stModule: FinishModule(El as TPasModule);
  20349. stUsesClause: FinishUsesClause;
  20350. stTypeSection: FinishTypeSection(El);
  20351. stTypeDef: FinishTypeDef(El as TPasType);
  20352. stResourceString: FinishResourcestring(El as TPasResString);
  20353. stProcedure: FinishProcedure(El as TPasProcedure);
  20354. stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
  20355. stExceptOnExpr: FinishExceptOnExpr;
  20356. stExceptOnStatement: FinishExceptOnStatement;
  20357. stWithExpr: FinishWithDo(El as TPasImplWithDo);
  20358. stForLoopHeader: FinishForLoopHeader(El as TPasImplForLoop);
  20359. stDeclaration: FinishDeclaration(El);
  20360. stAncestors: FinishAncestors(El as TPasClassType);
  20361. stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
  20362. else
  20363. RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
  20364. end;
  20365. end;
  20366. procedure TPasResolver.FinishTypeAlias(var NewType: TPasType);
  20367. var
  20368. TypeEl, DestType: TPasType;
  20369. AncestorClass, aClass: TPasClassType;
  20370. Scope: TPasIdentifierScope;
  20371. OldType: TPasTypeAliasType;
  20372. LocalScope: TPasScope;
  20373. begin
  20374. DestType:=TPasTypeAliasType(NewType).DestType;
  20375. TypeEl:=ResolveSimpleAliasType(DestType);
  20376. if TypeEl is TPasClassType then
  20377. begin
  20378. // change "=type aClassType" to "=class(aClassType)"
  20379. // or change "=type aInterfaceType" to "=interface(aInterfaceType)"
  20380. AncestorClass := TPasClassType(TypeEl);
  20381. // remove aliastype from scope
  20382. LocalScope:=GetLocalScope;
  20383. Scope:=LocalScope as TPasIdentifierScope;
  20384. Scope.RemoveLocalIdentifier(NewType);
  20385. // create class or interface
  20386. aClass := TPasClassType(CreateElement(TPasClassType,
  20387. NewType.Name,NewType.Parent,NewType.Visibility,
  20388. NewType.SourceFilename,NewType.SourceLinenumber));
  20389. aClass.ObjKind := AncestorClass.ObjKind;
  20390. // release old alias type
  20391. OldType := TPasTypeAliasType(NewType);
  20392. NewType := aClass;
  20393. TPasTypeAliasType(OldType).DestType:=nil; // clear reference
  20394. OldType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
  20395. // set ancestor
  20396. aClass.AncestorType := DestType;
  20397. {$IFDEF CheckPasTreeRefCount}DestType.ChangeRefId('ResolveTypeReference','TPasClassType.AncestorType');{$ENDIF}
  20398. FinishScope(stAncestors,aClass);
  20399. end;
  20400. end;
  20401. function TPasResolver.IsUnitIntfFinished(AModule: TPasModule): boolean;
  20402. var
  20403. CurIntf: TInterfaceSection;
  20404. begin
  20405. CurIntf:=AModule.InterfaceSection;
  20406. Result:=(CurIntf<>nil)
  20407. and (CurIntf.CustomData is TPasSectionScope)
  20408. and TPasSectionScope(CurIntf.CustomData).Finished;
  20409. end;
  20410. procedure TPasResolver.NotifyPendingUsedInterfaces;
  20411. // called after unit interface is ready to be used by other modules
  20412. var
  20413. ModuleScope: TPasModuleScope;
  20414. i: Integer;
  20415. PendingResolver: TPasResolver;
  20416. PendingSection: TPasSection;
  20417. begin
  20418. // call all PendingResolvers
  20419. // Note that a waiting resolver might continue parsing
  20420. ModuleScope:=RootElement.CustomData as TPasModuleScope;
  20421. i:=ModuleScope.PendingResolvers.Count-1;
  20422. while i>=0 do
  20423. begin
  20424. PendingResolver:=TObject(ModuleScope.PendingResolvers[i]) as TPasResolver;
  20425. PendingSection:=PendingResolver.GetLastSection;
  20426. {$IFDEF VerbosePasResolver}
  20427. writeln('TPasResolver.NotifyPendingUsedInterfaces "',ModuleScope.Element.Name,'" Pending="',PendingResolver.RootElement.Name,'"');
  20428. {$ENDIF}
  20429. if PendingSection=nil then
  20430. RaiseInternalError(20180305141421);
  20431. PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
  20432. dec(i);
  20433. if i>=ModuleScope.PendingResolvers.Count then
  20434. i:=ModuleScope.PendingResolvers.Count-1;
  20435. end;
  20436. end;
  20437. function TPasResolver.GetPendingUsedInterface(Section: TPasSection
  20438. ): TPasUsesUnit;
  20439. var
  20440. i: Integer;
  20441. UseUnit: TPasUsesUnit;
  20442. begin
  20443. Result:=nil;
  20444. for i:=0 to length(Section.UsesClause)-1 do
  20445. begin
  20446. UseUnit:=Section.UsesClause[i];
  20447. if not (UseUnit.Module is TPasModule) then continue;
  20448. if not IsUnitIntfFinished(TPasModule(UseUnit.Module)) then
  20449. exit(UseUnit);
  20450. end;
  20451. end;
  20452. function TPasResolver.CheckPendingUsedInterface(Section: TPasSection): boolean;
  20453. var
  20454. PendingModule: TPasModule;
  20455. PendingModuleScope: TPasModuleScope;
  20456. List: TFPList;
  20457. WasPending: Boolean;
  20458. begin
  20459. {$IFDEF VerbosePasResolver}
  20460. //writeln('TPasResolver.CheckPendingUsedInterface START "',RootElement.Name,'" Section.PendingUsedIntf=',Section.PendingUsedIntf<>nil);
  20461. {$ENDIF}
  20462. WasPending:=Section.PendingUsedIntf<>nil;
  20463. if WasPending then
  20464. begin
  20465. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  20466. if not IsUnitIntfFinished(PendingModule) then
  20467. exit; // still pending
  20468. // other unit interface is finished
  20469. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20470. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" UnitIntf finished of "',PendingModule.Name,'"');
  20471. {$ENDIF}
  20472. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  20473. PendingModuleScope.PendingResolvers.Remove(Self);
  20474. Section.PendingUsedIntf:=nil;
  20475. end;
  20476. Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
  20477. //writeln('TPasResolver.CheckPendingUsedInterface ',GetObjName(RootElement),' Section=',GetObjName(Section),' PendingUsedIntf=',GetObjName(Section.PendingUsedIntf));
  20478. if Section.PendingUsedIntf<>nil then
  20479. begin
  20480. // module not yet finished due to pending used interfaces
  20481. PendingModule:=Section.PendingUsedIntf.Module as TPasModule;
  20482. PendingModuleScope:=NoNil(PendingModule.CustomData) as TPasModuleScope;
  20483. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20484. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" waiting for unit intf of "',PendingModule.Name,'"');
  20485. {$ENDIF}
  20486. List:=PendingModuleScope.PendingResolvers;
  20487. if List.IndexOf(Self)<0 then
  20488. List.Add(Self);
  20489. Result:=not WasPending;
  20490. end
  20491. else
  20492. begin
  20493. {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
  20494. {AllowWriteln}
  20495. if WasPending then
  20496. writeln('TPasResolver.CheckPendingUsedInterface "',RootElement.Name,'" uses section complete: ',Section.ClassName);
  20497. {AllowWriteln-}
  20498. {$ENDIF}
  20499. Result:=WasPending;
  20500. if Result then
  20501. UsedInterfacesFinished(Section);
  20502. end;
  20503. end;
  20504. procedure TPasResolver.UsedInterfacesFinished(Section: TPasSection);
  20505. // if there is a unit cycle that stopped parsing this unit
  20506. // this method is called after the needed used unit interfaces have finished
  20507. begin
  20508. {$IFDEF VerbosePasResolver}
  20509. writeln('TPasResolver.UsesSectionFinished ',Section.ElementTypeName,' "',RootElement.Name,'"...');
  20510. {$ENDIF}
  20511. CurrentParser.ParseContinue;
  20512. if Section=nil then ;
  20513. end;
  20514. function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
  20515. // called by the parser when reading DoParseConstValueExpression
  20516. var
  20517. C: TClass;
  20518. V: TPasVariable;
  20519. TypeEl: TPasType;
  20520. begin
  20521. Result:=false;
  20522. if El=nil then exit;
  20523. C:=El.ClassType;
  20524. if (C=TPasConst) or (C=TPasVariable) then
  20525. begin
  20526. V:=TPasVariable(El);
  20527. if V.VarType=nil then exit;
  20528. TypeEl:=ResolveAliasType(V.VarType);
  20529. Result:=TypeEl.ClassType=TPasArrayType;
  20530. end;
  20531. //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
  20532. end;
  20533. function TPasResolver.GetDefaultClassVisibility(AClass: TPasClassType
  20534. ): TPasMemberVisibility;
  20535. var
  20536. ClassScope: TPasClassScope;
  20537. begin
  20538. if AClass.CustomData=nil then
  20539. exit(visDefault);
  20540. ClassScope:=(AClass.CustomData as TPasClassScope);
  20541. if pcsfPublished in ClassScope.Flags then
  20542. Result:=visPublished
  20543. else
  20544. Result:=visPublic;
  20545. end;
  20546. procedure TPasResolver.ModeChanged(Sender: TObject; NewMode: TModeSwitch;
  20547. Before: boolean; var Handled: boolean);
  20548. begin
  20549. inherited ModeChanged(Sender, NewMode, Before, Handled);
  20550. if not Before then
  20551. begin
  20552. if LastElement is TPasSection then
  20553. TPasSectionScope(LastElement.CustomData).ModeSwitches:=CurrentParser.CurrentModeswitches;
  20554. end;
  20555. end;
  20556. class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
  20557. Line, Column: integer);
  20558. begin
  20559. Line:=Linenumber;
  20560. Column:=0;
  20561. if Line<0 then begin
  20562. Line:=-Line;
  20563. Column:=Line mod ParserMaxEmbeddedColumn;
  20564. Line:=Line div ParserMaxEmbeddedColumn;
  20565. end;
  20566. end;
  20567. class function TPasResolver.GetDbgSourcePosStr(El: TPasElement): string;
  20568. var
  20569. Line, Column: integer;
  20570. begin
  20571. if El=nil then exit('nil');
  20572. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  20573. Result:=El.SourceFilename+'('+IntToStr(Line);
  20574. if Column>0 then
  20575. Result:=Result+','+IntToStr(Column);
  20576. Result:=Result+')';
  20577. end;
  20578. function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
  20579. var
  20580. Line, Column: integer;
  20581. begin
  20582. if El=nil then exit('nil');
  20583. UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
  20584. if (Line=0) then
  20585. begin
  20586. if El is TPasUnresolvedSymbolRef then
  20587. exit('intrinsic');
  20588. end;
  20589. Result:=CurrentParser.Scanner.FormatPath(El.SourceFilename)+'('+IntToStr(Line);
  20590. if Column>0 then
  20591. Result:=Result+','+IntToStr(Column);
  20592. Result:=Result+')';
  20593. end;
  20594. destructor TPasResolver.Destroy;
  20595. begin
  20596. {$IFDEF VerbosePasResolverMem}
  20597. writeln('TPasResolver.Destroy START ',ClassName);
  20598. {$ENDIF}
  20599. Clear;
  20600. {$IFDEF VerbosePasResolverMem}
  20601. writeln('TPasResolver.Destroy PopScope...');
  20602. {$ENDIF}
  20603. PopScope; // free default scope
  20604. {$IFDEF VerbosePasResolverMem}
  20605. writeln('TPasResolver.Destroy FPendingForwards...');
  20606. {$ENDIF}
  20607. FreeAndNil(FPendingForwardProcs);
  20608. FreeAndNil(fExprEvaluator);
  20609. ClearBuiltInIdentifiers;
  20610. inherited Destroy;
  20611. {$IFDEF VerbosePasResolverMem}
  20612. writeln('TPasResolver.Destroy END ',ClassName);
  20613. {$ENDIF}
  20614. end;
  20615. procedure TPasResolver.Clear;
  20616. begin
  20617. ClearHelperList(FActiveHelpers);
  20618. RestoreStashedScopes(0);
  20619. // clear stack, keep DefaultScope
  20620. while (FScopeCount>0) and (FTopScope<>DefaultScope) do
  20621. PopScope;
  20622. ClearResolveDataList(lkModule);
  20623. end;
  20624. procedure TPasResolver.ClearBuiltInIdentifiers;
  20625. var
  20626. bt: TResolverBaseType;
  20627. bp: TResolverBuiltInProc;
  20628. begin
  20629. ClearResolveDataList(lkBuiltIn);
  20630. for bt in TResolverBaseType do
  20631. ReleaseAndNil(TPasElement(FBaseTypes[bt]){$IFDEF CheckPasTreeRefCount},'TPasResolver.AddBaseType'{$ENDIF});
  20632. for bp in TResolverBuiltInProc do
  20633. FBuiltInProcs[bp]:=nil;
  20634. end;
  20635. procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
  20636. const TheBaseTypes: TResolveBaseTypes;
  20637. const TheBaseProcs: TResolverBuiltInProcs);
  20638. var
  20639. bt: TResolverBaseType;
  20640. begin
  20641. for bt in TheBaseTypes do
  20642. AddBaseType(BaseTypeNames[bt],bt);
  20643. if bfLength in TheBaseProcs then
  20644. AddBuiltInProc('Length','function Length(const String or Array): sizeint',
  20645. @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
  20646. @BI_Length_OnEval,nil,bfLength);
  20647. if bfSetLength in TheBaseProcs then
  20648. AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
  20649. @BI_SetLength_OnGetCallCompatibility,nil,nil,
  20650. @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
  20651. if bfInclude in TheBaseProcs then
  20652. AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
  20653. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20654. @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
  20655. if bfExclude in TheBaseProcs then
  20656. AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
  20657. @BI_InExclude_OnGetCallCompatibility,nil,nil,
  20658. @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
  20659. if bfBreak in TheBaseProcs then
  20660. AddBuiltInProc('Break','procedure Break',
  20661. @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
  20662. if bfContinue in TheBaseProcs then
  20663. AddBuiltInProc('Continue','procedure Continue',
  20664. @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
  20665. if bfExit in TheBaseProcs then
  20666. AddBuiltInProc('Exit','procedure Exit(result)',
  20667. @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
  20668. if bfInc in TheBaseProcs then
  20669. AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
  20670. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20671. @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
  20672. if bfDec in TheBaseProcs then
  20673. AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
  20674. @BI_IncDec_OnGetCallCompatibility,nil,nil,
  20675. @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
  20676. if bfAssigned in TheBaseProcs then
  20677. AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
  20678. @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
  20679. nil,@BI_Assigned_OnFinishParamsExpr,bfAssigned);
  20680. if bfChr in TheBaseProcs then
  20681. AddBuiltInProc('Chr','function Chr(const Integer): char',
  20682. @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,
  20683. @BI_Chr_OnEval,nil,bfChr);
  20684. if bfOrd in TheBaseProcs then
  20685. AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
  20686. @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,
  20687. @BI_Ord_OnEval,nil,bfOrd);
  20688. if bfLow in TheBaseProcs then
  20689. AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
  20690. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20691. @BI_LowHigh_OnEval,nil,bfLow);
  20692. if bfHigh in TheBaseProcs then
  20693. AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
  20694. @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
  20695. @BI_LowHigh_OnEval,nil,bfHigh);
  20696. if bfPred in TheBaseProcs then
  20697. AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
  20698. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20699. @BI_PredSucc_OnEval,nil,bfPred);
  20700. if bfSucc in TheBaseProcs then
  20701. AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
  20702. @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
  20703. @BI_PredSucc_OnEval,nil,bfSucc);
  20704. if bfStrProc in TheBaseProcs then
  20705. AddBuiltInProc('Str','procedure Str(const var; var String)',
  20706. @BI_StrProc_OnGetCallCompatibility,nil,nil,
  20707. @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
  20708. if bfStrFunc in TheBaseProcs then
  20709. AddBuiltInProc('Str','function Str(const var): String',
  20710. @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
  20711. @BI_StrFunc_OnEval,nil,bfStrFunc);
  20712. if bfWriteStr in TheBaseProcs then
  20713. AddBuiltInProc('WriteStr','procedure WriteStr(out String; params...)',
  20714. @BI_WriteStrProc_OnGetCallCompatibility,nil,nil,
  20715. @BI_WriteStrProc_OnFinishParamsExpr,bfWriteStr,[bipfCanBeStatement]);
  20716. if bfVal in TheBaseProcs then
  20717. AddBuiltInProc('Val','procedure Val(const String; var Value: bool|int|float|enum; out Int)',
  20718. @BI_Val_OnGetCallCompatibility,nil,nil,
  20719. @BI_Val_OnFinishParamsExpr,bfVal,[bipfCanBeStatement]);
  20720. if bfLo in TheBaseProcs then
  20721. AddBuiltInProc('Lo','function Lo(X: any integer type): Byte|Word)',
  20722. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20723. @BI_LoHi_OnEval,nil,bfLo);
  20724. if bfHi in TheBaseProcs then
  20725. AddBuiltInProc('Hi','function Hi(X: any integer type): Byte|Word)',
  20726. @BI_LoHi_OnGetCallCompatibility,@BI_LoHi_OnGetCallResult,
  20727. @BI_LoHi_OnEval,nil,bfHi);
  20728. if bfConcatArray in TheBaseProcs then
  20729. AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
  20730. @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
  20731. nil,nil,bfConcatArray);
  20732. if bfConcatString in TheBaseProcs then
  20733. AddBuiltInProc('Concat','function Concat(const String1, String2, ...): String',
  20734. @BI_ConcatString_OnGetCallCompatibility,@BI_ConcatString_OnGetCallResult,
  20735. @BI_ConcatString_OnEval,nil,bfConcatString);
  20736. if bfCopyArray in TheBaseProcs then
  20737. AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
  20738. @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
  20739. nil,nil,bfCopyArray);
  20740. if bfInsertArray in TheBaseProcs then
  20741. AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
  20742. @BI_InsertArray_OnGetCallCompatibility,nil,nil,
  20743. @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
  20744. if bfDeleteArray in TheBaseProcs then
  20745. AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
  20746. @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
  20747. @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
  20748. if bfTypeInfo in TheBaseProcs then
  20749. AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
  20750. @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
  20751. nil,nil,bfTypeInfo);
  20752. if bfGetTypeKind in TheBaseProcs then
  20753. AddBuiltInProc('GetTypeKind','function GetTypeKind(type or var identifier): System.TTypeKind',
  20754. @BI_GetTypeKind_OnGetCallCompatibility,@BI_GetTypeKind_OnGetCallResult,
  20755. @BI_GetTypeKind_OnEval,nil,bfGetTypeKind);
  20756. if bfAssert in TheBaseProcs then
  20757. AddBuiltInProc('Assert','procedure Assert(bool[,string])',
  20758. @BI_Assert_OnGetCallCompatibility,nil,nil,
  20759. @BI_Assert_OnFinishParamsExpr,bfAssert,[bipfCanBeStatement]);
  20760. if bfNew in TheBaseProcs then
  20761. AddBuiltInProc('New','procedure New(out ^record)',
  20762. @BI_New_OnGetCallCompatibility,nil,nil,
  20763. @BI_New_OnFinishParamsExpr,bfNew,[bipfCanBeStatement]);
  20764. if bfDispose in TheBaseProcs then
  20765. AddBuiltInProc('Dispose','procedure Dispose(var ^record)',
  20766. @BI_Dispose_OnGetCallCompatibility,nil,nil,
  20767. @BI_Dispose_OnFinishParamsExpr,bfDispose,[bipfCanBeStatement]);
  20768. if bfDefault in TheBaseProcs then
  20769. AddBuiltInProc('Default','function Default(T): T',
  20770. @BI_Default_OnGetCallCompatibility,@BI_Default_OnGetCallResult,
  20771. @BI_Default_OnEval,nil,bfDefault,[]);
  20772. end;
  20773. function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
  20774. ): TResElDataBaseType;
  20775. var
  20776. El: TPasUnresolvedSymbolRef;
  20777. begin
  20778. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20779. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TPasResolver.AddBaseType');{$ENDIF}
  20780. if not (Typ in [btNone,btCustom]) then
  20781. FBaseTypes[Typ]:=El;
  20782. Result:=TResElDataBaseType.Create;
  20783. Result.BaseType:=Typ;
  20784. AddResolveData(El,Result,lkBuiltIn);
  20785. FDefaultScope.AddIdentifier(aName,El,pikBaseType);
  20786. end;
  20787. function TPasResolver.AddCustomBaseType(const aName: string;
  20788. aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
  20789. var
  20790. CustomData: TResElDataBaseType;
  20791. begin
  20792. Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20793. {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('TPasResolver.AddCustomBaseType');{$ENDIF}
  20794. CustomData:=aClass.Create;
  20795. CustomData.BaseType:=btCustom;
  20796. AddResolveData(Result,CustomData,lkBuiltIn);
  20797. FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
  20798. end;
  20799. function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
  20800. ResolveAlias: boolean): boolean;
  20801. begin
  20802. Result:=false;
  20803. if aType=nil then exit;
  20804. if ResolveAlias then
  20805. aType:=ResolveAliasType(aType);
  20806. if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
  20807. Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
  20808. end;
  20809. function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
  20810. const GetCallCompatibility: TOnGetCallCompatibility;
  20811. const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
  20812. const FinishParamsExpr: TOnFinishParamsExpr;
  20813. const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
  20814. ): TResElDataBuiltInProc;
  20815. var
  20816. El: TPasUnresolvedSymbolRef;
  20817. begin
  20818. El:=TPasUnresolvedSymbolRef.Create(aName,nil);
  20819. Result:=TResElDataBuiltInProc.Create;
  20820. Result.Proc:=El;
  20821. {$IFDEF CheckPasTreeRefCount}El.RefIds.Add('TResElDataBuiltInProc.Proc');{$ENDIF}
  20822. Result.Signature:=Signature;
  20823. Result.BuiltIn:=BuiltIn;
  20824. Result.GetCallCompatibility:=GetCallCompatibility;
  20825. Result.GetCallResult:=GetCallResult;
  20826. Result.Eval:=EvalConst;
  20827. Result.FinishParamsExpression:=FinishParamsExpr;
  20828. Result.Flags:=Flags;
  20829. AddResolveData(El,Result,lkBuiltIn);
  20830. FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
  20831. if BuiltIn<>bfCustom then
  20832. FBuiltInProcs[BuiltIn]:=Result;
  20833. end;
  20834. procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
  20835. Kind: TResolveDataListKind);
  20836. begin
  20837. if Data.Element<>nil then
  20838. RaiseInternalError(20171111162227);
  20839. if El.CustomData<>nil then
  20840. RaiseInternalError(20171111162236);
  20841. Data.Element:=El;
  20842. Data.Owner:=Self;
  20843. Data.Next:=FLastCreatedData[Kind];
  20844. FLastCreatedData[Kind]:=Data;
  20845. El.CustomData:=Data;
  20846. end;
  20847. function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
  20848. Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
  20849. procedure RaiseAlreadySet;
  20850. var
  20851. FormerDeclEl: TPasElement;
  20852. begin
  20853. {AllowWriteln}
  20854. writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  20855. writeln(' RefEl at ',GetElementSourcePosStr(RefEl));
  20856. writeln(' RefEl.CustomData=',GetObjName(RefEl.CustomData));
  20857. if RefEl.CustomData is TResolvedReference then
  20858. begin
  20859. FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
  20860. writeln(' TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
  20861. ' IsSame=',FormerDeclEl=DeclEl);
  20862. end;
  20863. {AllowWriteln-}
  20864. RaiseInternalError(20160922163554,'customdata<>nil');
  20865. end;
  20866. begin
  20867. if RefEl.CustomData<>nil then
  20868. RaiseAlreadySet;
  20869. {$IFDEF VerbosePasResolver}
  20870. writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
  20871. {$ENDIF}
  20872. Result:=TResolvedReference.Create;
  20873. if FindData<>nil then
  20874. begin
  20875. if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
  20876. Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
  20877. end;
  20878. AddResolveData(RefEl,Result,lkModule);
  20879. Result.Declaration:=DeclEl;
  20880. if RefEl is TPasExpr then
  20881. SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
  20882. EmitElementHints(RefEl,DeclEl);
  20883. end;
  20884. procedure TPasResolver.WriteScopesShort(Title: string);
  20885. var
  20886. i: Integer;
  20887. begin
  20888. {AllowWriteln}
  20889. writeln(Title,' ScopeCount=',ScopeCount,' FStashScopeCount=',FStashScopeCount);
  20890. for i:=0 to FScopeCount-1 do
  20891. writeln(' ',i,'/',FScopeCount,' ',GetObjName(FScopes[i]));
  20892. {AllowWriteln-}
  20893. end;
  20894. function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
  20895. ): TPasScope;
  20896. begin
  20897. if not ScopeClass.IsStoredInElement then
  20898. RaiseInternalError(20160923121858);
  20899. if El.CustomData<>nil then
  20900. RaiseInternalError(20160923121849);
  20901. {$IFDEF VerbosePasResolver}
  20902. writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
  20903. {$ENDIF}
  20904. Result:=ScopeClass.Create;
  20905. if Result.FreeOnPop then
  20906. begin
  20907. Result.Element:=El;
  20908. El.CustomData:=Result;
  20909. Result.Owner:=Self;
  20910. end
  20911. else
  20912. // add to free list
  20913. AddResolveData(El,Result,lkModule);
  20914. end;
  20915. function TPasResolver.CreateGroupScope(HiType: TPasType; WithTopHelpers: boolean
  20916. ): TPasGroupScope;
  20917. begin
  20918. Result:=TPasGroupScope.Create;
  20919. Result.Element:=HiType;
  20920. GroupScope_AddTypeAndAncestors(Result,HiType,WithTopHelpers);
  20921. end;
  20922. procedure TPasResolver.GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope;
  20923. HiType: TPasType; WithTopHelpers: boolean);
  20924. var
  20925. IsClass: Boolean;
  20926. i: Integer;
  20927. Entry: TPRHelperEntry;
  20928. HelperForType, LoType: TPasType;
  20929. AncestorScope, HelperScope: TPasClassScope;
  20930. C: TClass;
  20931. begin
  20932. HiType:=ResolveAliasType(HiType,false);
  20933. LoType:=ResolveAliasType(HiType);
  20934. IsClass:=LoType.ClassType=TPasClassType;
  20935. if IsClass and (TPasClassType(LoType).HelperForType<>nil) then
  20936. begin
  20937. // start in a helper
  20938. WithTopHelpers:=false;
  20939. // first add helper and its ancestors
  20940. HelperScope:=TPasClassScope(LoType.CustomData);
  20941. while HelperScope<>nil do
  20942. begin
  20943. Scope.Add(HelperScope);
  20944. HelperScope:=HelperScope.AncestorScope;
  20945. end;
  20946. // then add the HelperForType and its ancestors
  20947. HiType:=ResolveAliasType(TPasClassType(HiType).HelperForType,false);
  20948. LoType:=ResolveAliasType(HiType);
  20949. IsClass:=LoType.ClassType=TPasClassType;
  20950. end;
  20951. repeat
  20952. // first add helper(s)
  20953. if WithTopHelpers then
  20954. begin
  20955. for i:=length(FActiveHelpers)-1 downto 0 do
  20956. begin
  20957. Entry:=FActiveHelpers[i];
  20958. HelperForType:=Entry.HelperForType;
  20959. if IsSameType(HelperForType,HiType,prraNone) then
  20960. begin
  20961. // add Helper and its ancestors
  20962. HelperScope:=TPasClassScope(Entry.Helper.CustomData);
  20963. while HelperScope<>nil do
  20964. begin
  20965. Scope.Add(HelperScope);
  20966. HelperScope:=HelperScope.AncestorScope;
  20967. end;
  20968. if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
  20969. break;
  20970. end;
  20971. end;
  20972. end
  20973. else
  20974. WithTopHelpers:=true;
  20975. // then add scope of LoType
  20976. C:=LoType.ClassType;
  20977. if (C=TPasClassType) or (C=TPasRecordType) then
  20978. Scope.Add(LoType.CustomData as TPasIdentifierScope);
  20979. // continue with ancestor
  20980. if not IsClass then break;
  20981. AncestorScope:=(LoType.CustomData as TPasClassScope).AncestorScope;
  20982. if AncestorScope=nil then break;
  20983. HiType:=TPasClassType(AncestorScope.Element);
  20984. LoType:=HiType;
  20985. until LoType=nil;
  20986. end;
  20987. procedure TPasResolver.PopScope;
  20988. var
  20989. Scope: TPasScope;
  20990. begin
  20991. if FScopeCount=0 then
  20992. RaiseInternalError(20160922163557);
  20993. {$IFDEF VerbosePasResolver}
  20994. {AllowWriteln}
  20995. //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
  20996. writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
  20997. {AllowWriteln-}
  20998. {$ENDIF}
  20999. dec(FScopeCount);
  21000. if FTopScope.FreeOnPop then
  21001. begin
  21002. Scope:=FScopes[FScopeCount];
  21003. if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
  21004. Scope.Element.CustomData:=nil;
  21005. if Scope=FDefaultScope then
  21006. FDefaultScope:=nil;
  21007. FScopes[FScopeCount]:=nil;
  21008. Scope.Free;
  21009. end;
  21010. if FScopeCount>0 then
  21011. FTopScope:=FScopes[FScopeCount-1]
  21012. else
  21013. FTopScope:=nil;
  21014. end;
  21015. procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
  21016. var
  21017. WithScope: TPasWithScope;
  21018. i: Integer;
  21019. begin
  21020. WithScope:=El.CustomData as TPasWithScope;
  21021. for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
  21022. begin
  21023. CheckTopScope(ScopeClass_WithExpr);
  21024. if TopScope<>WithScope.ExpressionScopes[i] then
  21025. RaiseInternalError(20160923102846);
  21026. PopScope;
  21027. end;
  21028. CheckTopScope(TPasWithScope);
  21029. PopScope;
  21030. end;
  21031. procedure TPasResolver.PopGenericParamScope(El: TPasGenericType);
  21032. var
  21033. TemplType: TPasGenericTemplateType;
  21034. begin
  21035. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  21036. begin
  21037. TemplType:=TPasGenericTemplateType(El.GenericTemplateTypes[0]);
  21038. if not (TopScope is TPasGenericParamsScope) then
  21039. RaiseNotYetImplemented(20190831204109,El,GetObjName(TopScope));
  21040. if TopScope.Element<>TemplType then
  21041. RaiseNotYetImplemented(20190831204134,El,GetObjName(TopScope.Element));
  21042. PopScope;
  21043. end
  21044. else
  21045. begin
  21046. if TopScope is TPasGenericParamsScope then
  21047. RaiseNotYetImplemented(20190831204213,El,GetObjName(TopScope.Element));
  21048. end;
  21049. end;
  21050. procedure TPasResolver.PushScope(Scope: TPasScope);
  21051. begin
  21052. if Scope=nil then
  21053. RaiseInternalError(20160922163601);
  21054. if length(FScopes)=FScopeCount then
  21055. SetLength(FScopes,FScopeCount*2+10);
  21056. FScopes[FScopeCount]:=Scope;
  21057. inc(FScopeCount);
  21058. FTopScope:=Scope;
  21059. {$IFDEF VerbosePasResolver}
  21060. writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
  21061. {$ENDIF}
  21062. end;
  21063. function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
  21064. ): TPasScope;
  21065. begin
  21066. Result:=CreateScope(El,ScopeClass);
  21067. PushScope(Result);
  21068. end;
  21069. function TPasResolver.PushGroupScope(HiType: TPasType): TPasGroupScope;
  21070. begin
  21071. Result:=CreateGroupScope(HiType);
  21072. PushScope(Result);
  21073. end;
  21074. function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
  21075. begin
  21076. Result:=TPasModuleDotScope.Create;
  21077. Result.Owner:=Self;
  21078. Result.Module:=aModule;
  21079. if aModule is TPasProgram then
  21080. begin // program
  21081. if TPasProgram(aModule).ProgramSection<>nil then
  21082. Result.InterfaceScope:=
  21083. NoNil(TPasProgram(aModule).ProgramSection.CustomData) as TPasSectionScope;
  21084. end
  21085. else if aModule is TPasLibrary then
  21086. begin // library
  21087. if TPasLibrary(aModule).LibrarySection<>nil then
  21088. Result.InterfaceScope:=
  21089. NoNil(TPasLibrary(aModule).LibrarySection.CustomData) as TPasSectionScope;
  21090. end
  21091. else
  21092. begin // unit
  21093. if aModule.InterfaceSection<>nil then
  21094. Result.InterfaceScope:=
  21095. NoNil(aModule.InterfaceSection.CustomData) as TPasSectionScope;
  21096. if (aModule=RootElement)
  21097. and (aModule.ImplementationSection<>nil)
  21098. and (aModule.ImplementationSection.CustomData<>nil)
  21099. then
  21100. Result.ImplementationScope:=NoNil(aModule.ImplementationSection.CustomData) as TPasSectionScope;
  21101. if CompareText(aModule.Name,'system')=0 then
  21102. Result.SystemScope:=DefaultScope;
  21103. end;
  21104. PushScope(Result);
  21105. end;
  21106. function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType;
  21107. WithTopHelpers: boolean): TPasDotClassScope;
  21108. var
  21109. ClassScope: TPasClassScope;
  21110. Ref: TResolvedReference;
  21111. begin
  21112. if CurClassType.IsForward then
  21113. begin
  21114. Ref:=CurClassType.CustomData as TResolvedReference;
  21115. CurClassType:=Ref.Declaration as TPasClassType;
  21116. end;
  21117. if CurClassType.CustomData=nil then
  21118. RaiseInternalError(20160922163611);
  21119. ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
  21120. Result:=TPasDotClassScope.Create;
  21121. Result.Owner:=Self;
  21122. Result.ClassRecScope:=ClassScope;
  21123. Result.GroupScope:=CreateGroupScope(CurClassType,WithTopHelpers);
  21124. PushScope(Result);
  21125. end;
  21126. function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotClassOrRecordScope;
  21127. var
  21128. RecScope: TPasRecordScope;
  21129. begin
  21130. RecScope:=NoNil(CurRecordType.CustomData) as TPasRecordScope;
  21131. Result:=TPasDotClassOrRecordScope.Create;
  21132. Result.Owner:=Self;
  21133. Result.ClassRecScope:=RecScope;
  21134. Result.GroupScope:=CreateGroupScope(CurRecordType);
  21135. PushScope(Result);
  21136. end;
  21137. function TPasResolver.PushInheritedScope(ClassOrRec: TPasMembersType;
  21138. WithTopHelpers: boolean; AncestorScope: TPasClassScope): TPasInheritedScope;
  21139. begin
  21140. Result:=TPasInheritedScope.Create;
  21141. Result.Owner:=Self;
  21142. Result.ClassRecScope:=NoNil(ClassOrRec.CustomData) as TPasClassOrRecordScope;
  21143. Result.AncestorScope:=AncestorScope;
  21144. Result.GroupScope:=CreateGroupScope(ClassOrRec,WithTopHelpers);
  21145. PushScope(Result);
  21146. end;
  21147. function TPasResolver.PushEnumDotScope(HiType: TPasType;
  21148. EnumLoType: TPasEnumType): TPasDotEnumTypeScope;
  21149. begin
  21150. Result:=TPasDotEnumTypeScope.Create;
  21151. Result.Owner:=Self;
  21152. Result.EnumScope:=NoNil(EnumLoType.CustomData) as TPasEnumTypeScope;
  21153. Result.GroupScope:=CreateGroupScope(HiType);
  21154. PushScope(Result);
  21155. end;
  21156. function TPasResolver.PushHelperDotScope(HiType: TPasType): TPasDotBaseScope;
  21157. var
  21158. Group: TPasGroupScope;
  21159. begin
  21160. Group:=CreateGroupScope(HiType);
  21161. if Group.Count=0 then
  21162. begin
  21163. Group.Free;
  21164. exit(nil);
  21165. end;
  21166. Result:=TPasDotHelperScope.Create;
  21167. Result.Element:=HiType;
  21168. Result.Owner:=Self;
  21169. Result.GroupScope:=Group;
  21170. PushScope(Result);
  21171. end;
  21172. function TPasResolver.PushTemplateDotScope(TemplType: TPasGenericTemplateType;
  21173. ErrorEl: TPasElement): TPasDotBaseScope;
  21174. procedure PushConstraintScope(ConEl: TPasElement);
  21175. var
  21176. ConToken: TToken;
  21177. DotClassScope: TPasDotClassScope;
  21178. MemberType: TPasMembersType;
  21179. GenTempl: TPasGenericTemplateType;
  21180. aClass: TPasClassType;
  21181. aConstructor: TPasConstructor;
  21182. i: Integer;
  21183. ResolvedEl: TPasResolverResult;
  21184. begin
  21185. ConToken:=GetGenericConstraintKeyword(ConEl);
  21186. case ConToken of
  21187. tkrecord: ;
  21188. tkclass, tkconstructor:
  21189. begin
  21190. if Result<>nil then
  21191. RaiseNotYetImplemented(20190831005217,TemplType);
  21192. if not FindSystemClassTypeAndConstructor('system','tobject',aClass,aConstructor,ErrorEl) then
  21193. RaiseIdentifierNotFound(20190831002421,'system.TObject.Create()',ErrorEl);
  21194. DotClassScope:=TPasDotClassScope.Create;
  21195. Result:=DotClassScope;
  21196. PushScope(Result);
  21197. DotClassScope.Owner:=Self;
  21198. DotClassScope.ClassRecScope:=aClass.CustomData as TPasClassScope;
  21199. Result.GroupScope:=CreateGroupScope(aClass,false);
  21200. end;
  21201. else
  21202. if not (ConEl is TPasType) then
  21203. RaiseNotYetImplemented(20190914070842,TemplType,GetObjName(ConEl));
  21204. ComputeElement(ConEl,ResolvedEl,[rcType]);
  21205. if ResolvedEl.BaseType<>btContext then
  21206. RaiseNotYetImplemented(20190915183241,ConEl);
  21207. if ResolvedEl.IdentEl=nil then
  21208. RaiseNotYetImplemented(20190831214135,ConEl);
  21209. if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
  21210. begin
  21211. GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
  21212. if ConEl.HasParent(GenTempl) then
  21213. RaiseNotYetImplemented(20190831214258,ConEl);
  21214. for i:=0 to length(GenTempl.Constraints)-1 do
  21215. PushConstraintScope(GenTempl.Constraints[i]);
  21216. end
  21217. else if ResolvedEl.LoTypeEl is TPasMembersType then
  21218. begin
  21219. MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
  21220. if Result=nil then
  21221. begin
  21222. DotClassScope:=TPasDotClassScope.Create;
  21223. Result:=DotClassScope;
  21224. PushScope(Result);
  21225. DotClassScope.Owner:=Self;
  21226. DotClassScope.ClassRecScope:=MemberType.CustomData as TPasClassScope;
  21227. Result.GroupScope:=CreateGroupScope(ResolvedEl.HiTypeEl,false);
  21228. end
  21229. else
  21230. GroupScope_AddTypeAndAncestors(Result.GroupScope,MemberType,false);
  21231. end
  21232. else
  21233. RaiseNotYetImplemented(20190831001450, ConEl);
  21234. end;
  21235. end;
  21236. var
  21237. i: Integer;
  21238. begin
  21239. Result:=nil;
  21240. for i:=0 to length(TemplType.Constraints)-1 do
  21241. PushConstraintScope(TemplType.Constraints[i]);
  21242. end;
  21243. function TPasResolver.PushDotScope(HiType: TPasType): TPasDotBaseScope;
  21244. var
  21245. C: TClass;
  21246. LoType: TPasType;
  21247. begin
  21248. LoType:=ResolveAliasType(HiType);
  21249. C:=LoType.ClassType;
  21250. if C=TPasClassType then
  21251. Result:=PushClassDotScope(TPasClassType(LoType))
  21252. else if C=TPasRecordType then
  21253. Result:=PushRecordDotScope(TPasRecordType(LoType))
  21254. else if C=TPasEnumType then
  21255. Result:=PushEnumDotScope(HiType,TPasEnumType(LoType))
  21256. else if C=TPasGenericTemplateType then
  21257. Result:=PushTemplateDotScope(TPasGenericTemplateType(LoType),HiType)
  21258. else
  21259. Result:=PushHelperDotScope(HiType);
  21260. end;
  21261. function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
  21262. var
  21263. WithEl: TPasImplWithDo;
  21264. WithScope: TPasWithScope;
  21265. ExprResolved: TPasResolverResult;
  21266. ErrorEl: TPasExpr;
  21267. LoType, HiType, DestType: TPasType;
  21268. ExprScope: TPasGroupScope;
  21269. ClassEl: TPasClassType;
  21270. WithExprScope: TPasWithExprScope;
  21271. Flags: TPasWithExprScopeFlags;
  21272. ClassRecScope: TPasClassOrRecordScope;
  21273. begin
  21274. if not (Expr.Parent is TPasImplWithDo) then
  21275. RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
  21276. WithEl:=TPasImplWithDo(Expr.Parent);
  21277. if not (WithEl.CustomData is TPasWithScope) then
  21278. RaiseInternalError(20181210175526);
  21279. WithScope:=TPasWithScope(WithEl.CustomData);
  21280. ResolveExpr(Expr,rraRead);
  21281. ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
  21282. {$IFDEF VerbosePasResolver}
  21283. writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
  21284. {$ENDIF}
  21285. ErrorEl:=Expr;
  21286. HiType:=ExprResolved.HiTypeEl;
  21287. LoType:=ExprResolved.LoTypeEl;
  21288. // ToDo: use last element in Expr for error position
  21289. if LoType=nil then
  21290. RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21291. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  21292. if (ExprResolved.BaseType in btAllIntrinsicTypes) then
  21293. // ok
  21294. else if (ExprResolved.BaseType=btContext) then
  21295. // ok
  21296. else
  21297. RaiseMsg(20190210143257,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21298. [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
  21299. Flags:=[];
  21300. CheckUseAsType(LoType,20190123113957,Expr);
  21301. ClassRecScope:=nil;
  21302. ExprScope:=nil;
  21303. if LoType.ClassType=TPasClassOfType then
  21304. begin
  21305. // e.g. with ImageClass do FindHandlerFromExtension()
  21306. DestType:=TPasClassOfType(LoType).DestType;
  21307. ClassEl:=ResolveAliasType(DestType) as TPasClassType;
  21308. ExprScope:=CreateGroupScope(DestType);
  21309. ClassRecScope:=TPasClassOrRecordScope(ClassEl.CustomData);
  21310. Include(Flags,wesfOnlyTypeMembers);
  21311. Include(Flags,wesfIsClassOf);
  21312. end
  21313. else if LoType is TPasMembersType then
  21314. ClassRecScope:=TPasClassOrRecordScope(LoType.CustomData);
  21315. if ExprScope=nil then
  21316. begin
  21317. ExprScope:=CreateGroupScope(HiType);
  21318. if ExprScope.Count=0 then
  21319. begin
  21320. ExprScope.Free;
  21321. RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
  21322. [GetElementTypeName(LoType)],ErrorEl);
  21323. end;
  21324. if ExprResolved.IdentEl is TPasType then
  21325. // e.g. with TPoint do PointInCircle
  21326. Include(Flags,wesfOnlyTypeMembers);
  21327. end;
  21328. WithExprScope:=ScopeClass_WithExpr.Create;
  21329. WithExprScope.WithScope:=WithScope;
  21330. WithExprScope.Index:=WithEl.Expressions.Count;
  21331. WithExprScope.Expr:=Expr;
  21332. WithExprScope.Scope:=ExprScope;
  21333. WithExprScope.ClassRecScope:=ClassRecScope;
  21334. if not (ExprResolved.IdentEl is TPasType) then
  21335. Include(Flags,wesfNeedTmpVar);
  21336. if (not (rrfWritable in ExprResolved.Flags))
  21337. and (ExprResolved.BaseType=btContext)
  21338. and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
  21339. Include(Flags,wesfConstParent);
  21340. WithExprScope.Flags:=Flags;
  21341. WithScope.ExpressionScopes.Add(WithExprScope);
  21342. PushScope(WithExprScope);
  21343. Result:=WithExprScope;
  21344. end;
  21345. function TPasResolver.StashScopes(NewScopeCnt: integer): integer;
  21346. begin
  21347. Result:=FStashScopeCount;
  21348. if NewScopeCnt>ScopeCount then
  21349. RaiseInternalError(20190728125505);
  21350. while ScopeCount>NewScopeCnt do
  21351. begin
  21352. {$IFDEF VerbosePasResolver}
  21353. writeln('TPasResolver.StashScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  21354. {$ENDIF}
  21355. if FStashScopeCount=length(FStashScopes) then
  21356. SetLength(FStashScopes,FStashScopeCount+4);
  21357. FStashScopes[FStashScopeCount]:=TopScope;
  21358. inc(FStashScopeCount);
  21359. dec(FScopeCount);
  21360. FScopes[FScopeCount]:=nil;
  21361. if FScopeCount>0 then
  21362. FTopScope:=FScopes[FScopeCount-1]
  21363. else
  21364. FTopScope:=nil;
  21365. end;
  21366. end;
  21367. function TPasResolver.StashSubExprScopes: integer;
  21368. // move all subexpr scopes from Scopes to StashScopes
  21369. var
  21370. NewScopeCnt: Integer;
  21371. begin
  21372. NewScopeCnt:=FScopeCount;
  21373. while (NewScopeCnt>0) and (FScopes[NewScopeCnt-1] is TPasSubExprScope) do
  21374. dec(NewScopeCnt);
  21375. Result:=StashScopes(NewScopeCnt);
  21376. end;
  21377. procedure TPasResolver.RestoreStashedScopes(StashDepth: integer);
  21378. // restore sub scopes
  21379. begin
  21380. while FStashScopeCount>StashDepth do
  21381. begin
  21382. {$IFDEF VerbosePasResolver}
  21383. writeln('TPasResolver.RestoreStashScopes moving ',FStashScopes[FStashScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' StashScopeCount=',FStashScopeCount);
  21384. {$ENDIF}
  21385. if FScopeCount=length(FScopes) then
  21386. SetLength(FScopes,FScopeCount+4);
  21387. dec(FStashScopeCount);
  21388. FScopes[FScopeCount]:=FStashScopes[FStashScopeCount];
  21389. FTopScope:=FScopes[FScopeCount];
  21390. FStashScopes[FStashScopeCount]:=nil;
  21391. inc(FScopeCount);
  21392. end;
  21393. end;
  21394. procedure TPasResolver.DeleteScope(Index: integer);
  21395. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  21396. procedure Delete(var A: TPasScopeArray; Index, Count: integer); overload;
  21397. var
  21398. i: Integer;
  21399. begin
  21400. if Index<0 then
  21401. raise Exception.Create('20191014232344');
  21402. if Index+Count>length(A) then
  21403. raise Exception.Create('20191014232345');
  21404. for i:=Index+Count to length(A)-1 do
  21405. A[i-Count]:=A[i];
  21406. SetLength(A,length(A)-Count);
  21407. end;
  21408. {$ENDIF}
  21409. begin
  21410. Delete(FScopes,Index,1);
  21411. dec(FScopeCount);
  21412. end;
  21413. procedure TPasResolver.InsertScope(Scope: TPasScope; Index: integer);
  21414. {$IF defined(fpc) and (FPC_FULLVERSION<30101)}
  21415. procedure Insert(Item: TPasScope; var A: TPasScopeArray; Index: integer); overload;
  21416. var
  21417. i: Integer;
  21418. begin
  21419. if Index<0 then
  21420. raise Exception.Create('20191014232355');
  21421. if Index>length(A) then
  21422. raise Exception.Create('20191014232356');
  21423. SetLength(A,length(A)+1);
  21424. for i:=length(A)-1 downto Index+1 do
  21425. A[i]:=A[i-1];
  21426. A[Index]:=Item;
  21427. end;
  21428. {$ENDIF}
  21429. begin
  21430. Insert(Scope,FScopes,Index);
  21431. inc(FScopeCount);
  21432. end;
  21433. function TPasResolver.GetCurrentProcScope(ErrorEl: TPasElement
  21434. ): TPasProcedureScope;
  21435. var
  21436. Scope: TPasScope;
  21437. i: Integer;
  21438. begin
  21439. i:=ScopeCount;
  21440. repeat
  21441. dec(i);
  21442. if i<0 then
  21443. RaiseMsg(20171006001229,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  21444. Scope:=Scopes[i];
  21445. if Scope is TPasProcedureScope then
  21446. exit(TPasProcedureScope(Scope));
  21447. until false;
  21448. Result:=nil;
  21449. end;
  21450. function TPasResolver.GetProcScope(El: TPasElement): TPasProcedureScope;
  21451. var
  21452. CurEl: TPasElement;
  21453. begin
  21454. CurEl:=El;
  21455. while CurEl<>nil do
  21456. begin
  21457. if CurEl is TPasProcedure then
  21458. exit(TPasProcedureScope(CurEl.CustomData));
  21459. CurEl:=CurEl.Parent;
  21460. end;
  21461. Result:=nil;
  21462. end;
  21463. function TPasResolver.GetCurrentSelfScope(ErrorEl: TPasElement): TPasProcedureScope;
  21464. begin
  21465. Result:=GetCurrentProcScope(ErrorEl);
  21466. Result:=Result.GetSelfScope;
  21467. end;
  21468. function TPasResolver.GetSelfScope(El: TPasElement): TPasProcedureScope;
  21469. begin
  21470. Result:=GetProcScope(El);
  21471. if Result<>nil then
  21472. Result:=Result.GetSelfScope;
  21473. end;
  21474. procedure TPasResolver.AddHelper(Helper: TPasClassType;
  21475. var List: TPRHelperEntryArray);
  21476. var
  21477. NewEntry: TPRHelperEntry;
  21478. Added: Integer;
  21479. HelperForType: TPasType;
  21480. begin
  21481. HelperForType:=ResolveAliasType(Helper.HelperForType,false);
  21482. NewEntry:=TPRHelperEntry.Create;
  21483. NewEntry.Helper:=Helper;
  21484. NewEntry.HelperForType:=HelperForType;
  21485. Added:=length(List);
  21486. NewEntry.Added:=Added;
  21487. SetLength(List,Added+1);
  21488. List[Added]:=NewEntry;
  21489. end;
  21490. procedure TPasResolver.AddActiveHelper(Helper: TPasClassType);
  21491. begin
  21492. AddHelper(Helper,FActiveHelpers);
  21493. end;
  21494. class function TPasResolver.MangleSourceLineNumber(Line, Column: integer
  21495. ): integer;
  21496. begin
  21497. if (Column<ParserMaxEmbeddedColumn)
  21498. and (Line<ParserMaxEmbeddedRow) then
  21499. Result:=-(Line*ParserMaxEmbeddedColumn+integer(Column))
  21500. else
  21501. Result:=Line;
  21502. end;
  21503. procedure TPasResolver.SetLastMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  21504. MsgNumber: integer; const Fmt: String;
  21505. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21506. PosEl: TPasElement);
  21507. var
  21508. {$IFDEF VerbosePasResolver}
  21509. s: string;
  21510. {$ENDIF}
  21511. Column, Row: integer;
  21512. begin
  21513. FLastMsgId := id;
  21514. FLastMsgType := MsgType;
  21515. FLastMsgNumber := MsgNumber;
  21516. FLastMsgPattern := Fmt;
  21517. FLastMsg := SafeFormat(Fmt,Args);
  21518. FLastElement := PosEl;
  21519. if PosEl=nil then
  21520. FLastSourcePos:=CurrentParser.CurSourcePos
  21521. else
  21522. begin
  21523. FLastSourcePos.FileName:=PosEl.SourceFilename;
  21524. UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
  21525. if Row>=0 then
  21526. FLastSourcePos.Row:=Row
  21527. else
  21528. FLastSourcePos.Row:=0;
  21529. if Column>=0 then
  21530. FLastSourcePos.Column:=Column
  21531. else
  21532. FLastSourcePos.Column:=0;
  21533. end;
  21534. CreateMsgArgs(FLastMsgArgs,Args);
  21535. {$IFDEF VerbosePasResolver}
  21536. {AllowWriteln}
  21537. write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
  21538. s:='';
  21539. str(MsgType,s);
  21540. write(s);
  21541. writeln(': [',MsgNumber,'] ',FLastMsg);
  21542. {AllowWriteln-}
  21543. {$ENDIF}
  21544. end;
  21545. procedure TPasResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
  21546. const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21547. ErrorPosEl: TPasElement);
  21548. var
  21549. E: EPasResolve;
  21550. begin
  21551. SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
  21552. E:=EPasResolve.Create(FLastMsg);
  21553. E.Id:=Id;
  21554. E.MsgType:=mtError;
  21555. E.MsgNumber:=MsgNumber;
  21556. E.MsgPattern:=Fmt;
  21557. E.PasElement:=ErrorPosEl;
  21558. E.Args:=FLastMsgArgs;
  21559. E.SourcePos:=FLastSourcePos;
  21560. raise E;
  21561. end;
  21562. procedure TPasResolver.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
  21563. Msg: string);
  21564. var
  21565. s: String;
  21566. begin
  21567. s:=sNotYetImplemented+' ['+IntToStr(id)+']';
  21568. if Msg<>'' then
  21569. s:=s+' "'+Msg+'"';
  21570. {$IFDEF VerbosePasResolver}
  21571. writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
  21572. {$ENDIF}
  21573. RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
  21574. end;
  21575. procedure TPasResolver.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
  21576. begin
  21577. {$IFDEF VerbosePasResolver}
  21578. writeln('TPasResolver.RaiseInternalError [',id,'] ',Msg);
  21579. {$ENDIF}
  21580. raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
  21581. end;
  21582. procedure TPasResolver.RaiseInvalidScopeForElement(id: TMaxPrecInt; El: TPasElement;
  21583. const Msg: string);
  21584. var
  21585. i: Integer;
  21586. s: String;
  21587. begin
  21588. s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
  21589. for i:=0 to ScopeCount-1 do
  21590. begin
  21591. if i>0 then s:=s+',';
  21592. s:=s+Scopes[i].ClassName;
  21593. end;
  21594. if Msg<>'' then
  21595. s:=s+': '+Msg;
  21596. RaiseInternalError(id,s);
  21597. end;
  21598. procedure TPasResolver.RaiseIdentifierNotFound(id: TMaxPrecInt; Identifier: string;
  21599. El: TPasElement);
  21600. begin
  21601. {$IFDEF VerbosePasResolver}
  21602. writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
  21603. WriteScopes;
  21604. {$ENDIF}
  21605. RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
  21606. end;
  21607. procedure TPasResolver.RaiseXExpectedButYFound(id: TMaxPrecInt; const X, Y: string;
  21608. El: TPasElement);
  21609. begin
  21610. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
  21611. end;
  21612. procedure TPasResolver.RaiseXExpectedButTypeYFound(id: TMaxPrecInt;
  21613. const X: string; Y: TPasType; El: TPasElement);
  21614. begin
  21615. RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,
  21616. [x,GetTypeDescription(Y)],El);
  21617. end;
  21618. procedure TPasResolver.RaiseContextXExpectedButYFound(id: TMaxPrecInt; const C, X,
  21619. Y: string; El: TPasElement);
  21620. begin
  21621. RaiseMsg(id,nContextExpectedXButFoundY,sContextExpectedXButFoundY,[C,X,Y],El);
  21622. end;
  21623. procedure TPasResolver.RaiseContextXInvalidY(id: TMaxPrecInt; const X, Y: string;
  21624. El: TPasElement);
  21625. begin
  21626. RaiseMsg(id,nContextXInvalidY,sContextXInvalidY,[X,Y],El);
  21627. end;
  21628. procedure TPasResolver.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
  21629. begin
  21630. RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
  21631. end;
  21632. procedure TPasResolver.RaiseVarExpected(id: TMaxPrecInt; ErrorEl: TPasElement;
  21633. IdentEl: TPasElement);
  21634. begin
  21635. if IdentEl is TPasProperty then
  21636. RaiseMsg(id,nNoMemberIsProvidedToAccessProperty,
  21637. sNoMemberIsProvidedToAccessProperty,[],ErrorEl)
  21638. else
  21639. RaiseMsg(id,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  21640. end;
  21641. procedure TPasResolver.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
  21642. begin
  21643. RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
  21644. end;
  21645. procedure TPasResolver.RaiseIncompatibleTypeDesc(id: TMaxPrecInt; MsgNumber: integer;
  21646. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21647. const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
  21648. function GetString(ArgNo: integer): string;
  21649. begin
  21650. if ArgNo>High(Args) then
  21651. exit('invalid param '+IntToStr(ArgNo));
  21652. {$ifdef pas2js}
  21653. if isString(Args[ArgNo]) then
  21654. Result:=String(Args[ArgNo])
  21655. else
  21656. Result:='invalid param '+jsTypeOf(Args[ArgNo]);
  21657. {$else}
  21658. case Args[ArgNo].VType of
  21659. vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
  21660. else
  21661. Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
  21662. end;
  21663. {$endif}
  21664. end;
  21665. begin
  21666. case MsgNumber of
  21667. nIllegalTypeConversionTo:
  21668. RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
  21669. nIncompatibleTypesGotExpected:
  21670. RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
  21671. nIncompatibleTypeArgNo:
  21672. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
  21673. nIncompatibleTypeArgNoVarParamMustMatchExactly:
  21674. RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
  21675. [GetString(0),GotDesc,ExpDesc],ErrorEl);
  21676. nResultTypeMismatchExpectedButFound:
  21677. RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
  21678. nXExpectedButYFound:
  21679. RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
  21680. nOperatorIsNotOverloadedAOpB:
  21681. RaiseMsg(id,MsgNumber,sOperatorIsNotOverloadedAOpB,[GotDesc,GetString(0),ExpDesc],ErrorEl);
  21682. nTypesAreNotRelatedXY:
  21683. RaiseMsg(id,MsgNumber,sTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  21684. else
  21685. RaiseInternalError(20170329112911);
  21686. end;
  21687. end;
  21688. procedure TPasResolver.RaiseIncompatibleType(id: TMaxPrecInt; MsgNumber: integer;
  21689. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21690. GotType, ExpType: TPasType; ErrorEl: TPasElement);
  21691. var
  21692. GotDesc, ExpDesc: String;
  21693. begin
  21694. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  21695. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  21696. end;
  21697. procedure TPasResolver.RaiseIncompatibleTypeRes(id: TMaxPrecInt; MsgNumber: integer;
  21698. const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21699. const GotType, ExpType: TPasResolverResult;
  21700. ErrorEl: TPasElement);
  21701. var
  21702. GotDesc, ExpDesc: String;
  21703. begin
  21704. {$IFDEF VerbosePasResolver}
  21705. writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  21706. {$ENDIF}
  21707. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  21708. RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
  21709. end;
  21710. procedure TPasResolver.RaiseHelpersCannotBeUsedAsType(id: TMaxPrecInt;
  21711. ErrorEl: TPasElement);
  21712. begin
  21713. RaiseMsg(id,nHelpersCannotBeUsedAsTypes,sHelpersCannotBeUsedAsTypes,[],ErrorEl);
  21714. end;
  21715. procedure TPasResolver.RaiseInvalidProcTypeModifier(id: TMaxPrecInt;
  21716. ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
  21717. begin
  21718. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(ProcType),
  21719. ProcTypeModifiers[ptm]],ErrorEl);
  21720. end;
  21721. procedure TPasResolver.RaiseInvalidProcModifier(id: TMaxPrecInt; Proc: TPasProcedure;
  21722. pm: TProcedureModifier; ErrorEl: TPasElement);
  21723. begin
  21724. RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[GetElementTypeName(Proc),
  21725. ModifierNames[pm]],ErrorEl);
  21726. end;
  21727. procedure TPasResolver.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
  21728. MsgNumber: integer; const Fmt: String;
  21729. Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
  21730. PosEl: TPasElement);
  21731. var
  21732. Scanner: TPascalScanner;
  21733. State: TWarnMsgState;
  21734. {$IFDEF VerbosePasResolver}
  21735. s: String;
  21736. {$ENDIF}
  21737. begin
  21738. Scanner:=CurrentParser.Scanner;
  21739. if (Scanner<>nil) then
  21740. begin
  21741. if (FStep<prsFinishingModule)
  21742. and (Scanner.IgnoreMsgType(MsgType)) then
  21743. exit; // during parsing consider directives like $Hints on|off
  21744. if MsgType>=mtWarning then
  21745. begin
  21746. State:=Scanner.WarnMsgState[MsgNumber];
  21747. case State of
  21748. wmsOff:
  21749. begin
  21750. {$IFDEF VerbosePasResolver}
  21751. {AllowWriteln}
  21752. write('TPasResolver.LogMsg ignoring ',id,' ',GetElementSourcePosStr(PosEl),' ');
  21753. s:='';
  21754. str(MsgType,s);
  21755. write(s);
  21756. writeln(': [',MsgNumber,'] ',SafeFormat(Fmt,Args));
  21757. {AllowWriteln-}
  21758. {$ENDIF}
  21759. exit; // ignore
  21760. end;
  21761. wmsError:
  21762. begin
  21763. RaiseMsg(id,MsgNumber,Fmt,Args,PosEl);
  21764. exit;
  21765. end;
  21766. end;
  21767. end;
  21768. end;
  21769. SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
  21770. if Assigned(OnLog) then
  21771. OnLog(Self,FLastMsg)
  21772. else if Assigned(CurrentParser.OnLog) then
  21773. CurrentParser.OnLog(Self,FLastMsg);
  21774. end;
  21775. class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
  21776. MsgNumbers: TIntegerDynArray): boolean;
  21777. procedure SetNumber(Number: integer);
  21778. begin
  21779. {$IF FPC_FULLVERSION>=30101}
  21780. MsgNumbers:=[Number];
  21781. {$ELSE}
  21782. Setlength(MsgNumbers,1);
  21783. MsgNumbers[0]:=Number;
  21784. {$ENDIF}
  21785. end;
  21786. procedure SetNumbers(Numbers: array of integer);
  21787. var
  21788. i: Integer;
  21789. begin
  21790. Setlength(MsgNumbers,length(Numbers));
  21791. for i:=0 to high(Numbers) do
  21792. MsgNumbers[i]:=Numbers[i];
  21793. end;
  21794. begin
  21795. if Identifier='' then exit(false);
  21796. if Identifier[1] in ['0'..'9'] then exit(false);
  21797. Result:=true;
  21798. case UpperCase(Identifier) of
  21799. // FPC:
  21800. 'CONSTRUCTING_ABSTRACT': SetNumber(nConstructingClassXWithAbstractMethodY); // Constructing an instance of a class with abstract methods.
  21801. //'IMPLICIT_VARIANTS': ; // Implicit use of the variants unit.
  21802. // useanalyzer: 'NO_RETVAL': ; // Function result is not set.
  21803. 'SYMBOL_DEPRECATED': SetNumber(nSymbolXIsDeprecated); // Deprecated symbol.
  21804. 'SYMBOL_EXPERIMENTAL': SetNumber(nSymbolXIsExperimental); // Experimental symbol
  21805. 'SYMBOL_LIBRARY': SetNumber(nSymbolXBelongsToALibrary); // Not used.
  21806. 'SYMBOL_PLATFORM': SetNumber(nSymbolXIsNotPortable); // Platform-dependent symbol.
  21807. 'SYMBOL_UNIMPLEMENTED': SetNumber(nSymbolXIsNotImplemented); // Unimplemented symbol.
  21808. //'UNIT_DEPRECATED': ; // Deprecated unit.
  21809. //'UNIT_EXPERIMENTAL': ; // Experimental unit.
  21810. //'UNIT_LIBRARY': ; //
  21811. //'UNIT_PLATFORM': ; // Platform dependent unit.
  21812. //'UNIT_UNIMPLEMENTED': ; // Unimplemented unit.
  21813. //'ZERO_NIL_COMPAT': ; // Converting 0 to NIL
  21814. //'IMPLICIT_STRING_CAST': ; // Implicit string type conversion
  21815. //'IMPLICIT_STRING_CAST_LOSS': ; // Implicit string typecast with potential data loss from ”$1” to ”$2”
  21816. //'EXPLICIT_STRING_CAST': ; // Explicit string type conversion
  21817. //'EXPLICIT_STRING_CAST_LOSS': ; // Explicit string typecast with potential data loss from ”$1” to ”$2”
  21818. //'CVT_NARROWING_STRING_LOST': ; // Unicode constant cast with potential data loss
  21819. // Delphi:
  21820. 'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
  21821. 'GARBAGE': SetNumber(nTextAfterFinalIgnored); // text after final end.
  21822. 'BOUNDS_ERROR': SetNumbers([nRangeCheckError,
  21823. nHighRangeLimitLTLowRangeLimit,
  21824. nRangeCheckEvaluatingConstantsVMinMax,
  21825. nRangeCheckInSetConstructor]);
  21826. 'MESSAGE_DIRECTIVE': SetNumber(nUserDefined); // $message directive
  21827. else
  21828. Result:=false;
  21829. end;
  21830. end;
  21831. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  21832. ExpType: TPasResolverResult; out GotDesc, ExpDesc: String);
  21833. var
  21834. NeedProcSignature: Boolean;
  21835. begin
  21836. {$IFDEF VerbosePasResolver}
  21837. writeln('TPasResolver.GetIncompatibleTypeDesc Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
  21838. {$ENDIF}
  21839. if (GotType.BaseType<>ExpType.BaseType)
  21840. and (GotType.BaseType<>btContext) and (ExpType.BaseType<>btContext) then
  21841. begin
  21842. GotDesc:=GetBaseDescription(GotType);
  21843. if ExpType.BaseType=btNil then
  21844. ExpDesc:=BaseTypeNames[btPointer]
  21845. else
  21846. ExpDesc:=GetBaseDescription(ExpType);
  21847. if GotDesc<>ExpDesc then
  21848. exit;
  21849. GotDesc:=GetBaseDescription(GotType,true);
  21850. ExpDesc:=GetBaseDescription(ExpType,true);
  21851. end
  21852. else if (GotType.LoTypeEl<>nil) and (ExpType.LoTypeEl<>nil) then
  21853. begin
  21854. NeedProcSignature:=(GotType.LoTypeEl is TPasProcedureType)
  21855. and (ExpType.LoTypeEl is TPasProcedureType);
  21856. if NeedProcSignature then
  21857. begin
  21858. // procedural types
  21859. GetIncompatibleProcParamsDesc(TPasProcedureType(GotType.LoTypeEl),
  21860. TPasProcedureType(ExpType.LoTypeEl),GotDesc,ExpDesc);
  21861. if GotDesc<>ExpDesc then
  21862. exit;
  21863. end;
  21864. GotDesc:=GetTypeDescription(GotType);
  21865. ExpDesc:=GetTypeDescription(ExpType);
  21866. if GotDesc<>ExpDesc then
  21867. exit;
  21868. if GotType.HiTypeEl<>ExpType.HiTypeEl then
  21869. begin
  21870. GotDesc:=GetTypeDescription(GotType.HiTypeEl);
  21871. ExpDesc:=GetTypeDescription(ExpType.HiTypeEl);
  21872. if GotDesc<>ExpDesc then
  21873. exit;
  21874. end;
  21875. GotDesc:=GetTypeDescription(GotType,true);
  21876. ExpDesc:=GetTypeDescription(ExpType,true);
  21877. end
  21878. else
  21879. begin
  21880. GotDesc:=GetResolverResultDescription(GotType,true);
  21881. ExpDesc:=GetResolverResultDescription(ExpType,true);
  21882. if GotDesc<>ExpDesc then
  21883. exit;
  21884. GotDesc:=GetResolverResultDescription(GotType,false);
  21885. ExpDesc:=GetResolverResultDescription(ExpType,false);
  21886. end;
  21887. end;
  21888. procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
  21889. ExpType: TPasType; out GotDesc, ExpDesc: String);
  21890. var
  21891. GotLoType, ExpLoType: TPasType;
  21892. begin
  21893. GotLoType:=ResolveAliasType(GotType);
  21894. ExpLoType:=ResolveAliasType(ExpType);
  21895. if (GotLoType<>nil) and (ExpLoType<>nil) then
  21896. begin
  21897. if (GotLoType.ClassType=ExpLoType.ClassType)
  21898. and (GotLoType is TPasProcedureType) then
  21899. begin
  21900. // procedural types
  21901. GetIncompatibleProcParamsDesc(TPasProcedureType(GotLoType),
  21902. TPasProcedureType(ExpLoType),GotDesc,ExpDesc);
  21903. if GotDesc<>ExpDesc then
  21904. exit;
  21905. end;
  21906. end;
  21907. GotDesc:=GetTypeDescription(GotType);
  21908. ExpDesc:=GetTypeDescription(ExpType);
  21909. if GotDesc<>ExpDesc then exit;
  21910. GotDesc:=GetTypeDescription(GotType,true);
  21911. ExpDesc:=GetTypeDescription(ExpType,true);
  21912. end;
  21913. procedure TPasResolver.GetIncompatibleProcParamsDesc(GotType,
  21914. ExpType: TPasProcedureType; out GotDesc, ExpDesc: string);
  21915. procedure AppendClass(ProcType: TPasProcedureType; var Desc: string);
  21916. var
  21917. C: TClass;
  21918. begin
  21919. C:=ProcType.ClassType;
  21920. if C=TPasProcedureType then
  21921. Desc:=Desc+'procedure'
  21922. else if C=TPasFunctionType then
  21923. Desc:=Desc+'function'
  21924. else
  21925. RaiseNotYetImplemented(20200216114419,ProcType,ProcType.ClassName);
  21926. end;
  21927. var
  21928. i: Integer;
  21929. GotArg, ExpArg: TPasArgument;
  21930. GotArgs, ExpArgs: TFPList;
  21931. GotArgDesc, ExpArgDesc: String;
  21932. GotArgType, ExpArgType: TPasType;
  21933. begin
  21934. GotDesc:='';
  21935. ExpDesc:='';
  21936. // reference to
  21937. if (ptmReferenceTo in GotType.Modifiers) and not (ptmReferenceTo in ExpType.Modifiers) then
  21938. GotDesc:='reference to '
  21939. else if not (ptmReferenceTo in GotType.Modifiers) and (ptmReferenceTo in ExpType.Modifiers) then
  21940. ExpDesc:='reference to ';
  21941. // type
  21942. AppendClass(GotType,GotDesc);
  21943. AppendClass(ExpType,ExpDesc);
  21944. // Args
  21945. GotDesc:=GotDesc+'(';
  21946. ExpDesc:=ExpDesc+'(';
  21947. GotArgs:=GotType.Args;
  21948. ExpArgs:=ExpType.Args;
  21949. for i:=0 to GotArgs.Count-1 do
  21950. begin
  21951. if i>0 then
  21952. GotDesc:=GotDesc+';';
  21953. GotArg:=TPasArgument(GotArgs[i]);
  21954. GotArgType:=ResolveAliasType(GotArg.ArgType);
  21955. if i<ExpArgs.Count then
  21956. begin
  21957. if i>0 then
  21958. ExpDesc:=ExpDesc+';';
  21959. ExpArg:=TPasArgument(ExpArgs[i]);
  21960. ExpArgType:=ResolveAliasType(ExpArg.ArgType);
  21961. if GotArgType=ExpArgType then
  21962. begin
  21963. GotDesc:=GotDesc+GetTypeDescription(GotArgType);
  21964. ExpDesc:=ExpDesc+GetTypeDescription(ExpArgType);
  21965. end
  21966. else
  21967. begin
  21968. GetIncompatibleTypeDesc(GotArgType,ExpArgType,GotArgDesc,ExpArgDesc);
  21969. GotDesc:=GotDesc+GotArgDesc;
  21970. ExpDesc:=ExpDesc+ExpArgDesc;
  21971. end;
  21972. end
  21973. else
  21974. begin
  21975. // GotType has more args than ExpType
  21976. GotDesc:=GotDesc+GetTypeDescription(GotArgType);
  21977. end;
  21978. end;
  21979. for i:=GotArgs.Count to ExpArgs.Count-1 do
  21980. begin
  21981. // ExpType has more args then GotType
  21982. if i>0 then
  21983. ExpDesc:=ExpDesc+';';
  21984. ExpArg:=TPasArgument(ExpArgs[i]);
  21985. ExpArgType:=ResolveAliasType(ExpArg.ArgType);
  21986. ExpDesc:=ExpDesc+GetTypeDescription(ExpArgType);
  21987. end;
  21988. GotDesc:=GotDesc+')';
  21989. ExpDesc:=ExpDesc+')';
  21990. // function result
  21991. if GotType is TPasFunctionType then
  21992. GotDesc:=GotDesc+': '+GetTypeDescription(ResolveAliasType(TPasFunctionType(GotType).ResultEl.ResultType));
  21993. if ExpType is TPasFunctionType then
  21994. ExpDesc:=ExpDesc+': '+GetTypeDescription(ResolveAliasType(TPasFunctionType(ExpType).ResultEl.ResultType));
  21995. // modifiers
  21996. if (ptmOfObject in GotType.Modifiers) and not (ptmOfObject in ExpType.Modifiers) then
  21997. GotDesc:=GotDesc+' of Object'
  21998. else if not (ptmOfObject in GotType.Modifiers) and (ptmOfObject in ExpType.Modifiers) then
  21999. ExpDesc:=ExpDesc+' of Object';
  22000. if (ptmIsNested in GotType.Modifiers) and not (ptmIsNested in ExpType.Modifiers) then
  22001. GotDesc:=GotDesc+' is nested'
  22002. else if not (ptmIsNested in GotType.Modifiers) and (ptmIsNested in ExpType.Modifiers) then
  22003. ExpDesc:=ExpDesc+' is nested';
  22004. if (ptmStatic in GotType.Modifiers) and not (ptmStatic in ExpType.Modifiers) then
  22005. GotDesc:=GotDesc+'; static'
  22006. else if not (ptmStatic in GotType.Modifiers) and (ptmStatic in ExpType.Modifiers) then
  22007. ExpDesc:=ExpDesc+'; static';
  22008. if (ptmAsync in GotType.Modifiers) and not (ptmAsync in ExpType.Modifiers) then
  22009. GotDesc:=GotDesc+'; async'
  22010. else if not (ptmAsync in GotType.Modifiers) and (ptmAsync in ExpType.Modifiers) then
  22011. ExpDesc:=ExpDesc+'; async';
  22012. if (ptmVarargs in GotType.Modifiers) and not (ptmVarargs in ExpType.Modifiers) then
  22013. GotDesc:=GotDesc+'; varargs'
  22014. else if not (ptmVarargs in GotType.Modifiers) and (ptmVarargs in ExpType.Modifiers) then
  22015. ExpDesc:=ExpDesc+'; varargs'
  22016. else
  22017. begin
  22018. if GotType.VarArgsType<>nil then
  22019. GotDesc:=GotDesc+'; varargs of '+GetTypeDescription(ResolveAliasType(GotType.VarArgsType));
  22020. if ExpType.VarArgsType<>nil then
  22021. ExpDesc:=ExpDesc+'; varargs of '+GetTypeDescription(ResolveAliasType(ExpType.VarArgsType));
  22022. end;
  22023. // calling convention
  22024. if GotType.CallingConvention<>ExpType.CallingConvention then
  22025. begin
  22026. GotDesc:=GotDesc+';'+cCallingConventions[GotType.CallingConvention];
  22027. ExpDesc:=ExpDesc+';'+cCallingConventions[ExpType.CallingConvention];
  22028. end;
  22029. if GotDesc=ExpDesc then
  22030. begin
  22031. if GotType.Parent is TPasAnonymousProcedure then
  22032. GotDesc:='anonymous '+GotDesc;
  22033. if ExpType.Parent is TPasAnonymousProcedure then
  22034. ExpDesc:='anonymous '+ExpDesc;
  22035. end;
  22036. end;
  22037. function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
  22038. Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
  22039. ): integer;
  22040. var
  22041. ProcArgs: TFPList;
  22042. i, ParamCnt, ParamCompatibility: Integer;
  22043. Param, Value: TPasExpr;
  22044. ParamResolved, ArgResolved: TPasResolverResult;
  22045. Flags: TPasResolverComputeFlags;
  22046. begin
  22047. Result:=cExact;
  22048. ProcArgs:=ProcType.Args;
  22049. Value:=Params.Value;
  22050. if Value is TBinaryExpr then
  22051. Value:=TBinaryExpr(Value).right; // Note: parser guarantees that this is the rightmost
  22052. // check args
  22053. ParamCnt:=length(Params.Params);
  22054. ArgResolved.BaseType:=btNone;
  22055. i:=0;
  22056. while i<ParamCnt do
  22057. begin
  22058. Param:=Params.Params[i];
  22059. {$IFDEF VerbosePasResolver}
  22060. writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
  22061. {$ENDIF}
  22062. if i<ProcArgs.Count then
  22063. begin
  22064. ParamCompatibility:=CheckParamCompatibility(Param,
  22065. TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
  22066. if ParamCompatibility=cIncompatible then
  22067. exit(cIncompatible);
  22068. end
  22069. else
  22070. begin
  22071. if ptmVarargs in ProcType.Modifiers then
  22072. begin
  22073. if ProcType.VarArgsType<>nil then
  22074. begin
  22075. if ArgResolved.BaseType=btNone then
  22076. ComputeElement(ProcType.VarArgsType,ArgResolved,[rcType]);
  22077. ComputeArgumentExpr(ArgResolved,argConst,
  22078. Param,ParamResolved,SetReferenceFlags);
  22079. ParamCompatibility:=CheckParamResCompatibility(Param,ParamResolved,
  22080. ArgResolved,i,RaiseOnError,SetReferenceFlags);
  22081. if ParamCompatibility=cIncompatible then
  22082. exit(cIncompatible);
  22083. end
  22084. else
  22085. begin
  22086. if SetReferenceFlags then
  22087. Flags:=[rcNoImplicitProcType,rcSetReferenceFlags]
  22088. else
  22089. Flags:=[rcNoImplicitProcType];
  22090. ComputeElement(Param,ParamResolved,Flags,Param);
  22091. if not (rrfReadable in ParamResolved.Flags) then
  22092. begin
  22093. if RaiseOnError then
  22094. RaiseVarExpected(20180712001415,Param,ParamResolved.IdentEl);
  22095. exit(cIncompatible);
  22096. end;
  22097. ParamCompatibility:=cExact;
  22098. end;
  22099. end
  22100. else
  22101. begin
  22102. // too many arguments
  22103. if RaiseOnError then
  22104. RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
  22105. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
  22106. exit(cIncompatible);
  22107. end;
  22108. end;
  22109. if Result<cTypeConversion then
  22110. inc(Result,ParamCompatibility)
  22111. else
  22112. Result:=Max(Result,ParamCompatibility);
  22113. inc(i);
  22114. end;
  22115. if (i<ProcArgs.Count) then
  22116. if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
  22117. begin
  22118. // not enough arguments
  22119. if RaiseOnError then
  22120. // ToDo: position cursor on identifier
  22121. RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
  22122. sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
  22123. exit(cIncompatible);
  22124. end
  22125. else
  22126. begin
  22127. // the rest are default params
  22128. end;
  22129. end;
  22130. function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
  22131. Params: TParamsExpr; RaiseOnError: boolean): integer;
  22132. var
  22133. PropArg: TPasArgument;
  22134. ArgNo, ParamComp: Integer;
  22135. Param: TPasExpr;
  22136. PropArgs: TFPList;
  22137. begin
  22138. Result:=cExact;
  22139. PropArgs:=GetPasPropertyArgs(PropEl);
  22140. if PropArgs.Count<length(Params.Params) then
  22141. begin
  22142. if not RaiseOnError then exit(cIncompatible);
  22143. RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
  22144. [PropEl.Name],Params)
  22145. end
  22146. else if PropArgs.Count>length(Params.Params) then
  22147. begin
  22148. if not RaiseOnError then exit(cIncompatible);
  22149. RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
  22150. [TPasArgument(PropArgs[length(Params.Params)]).Name],Params);
  22151. end;
  22152. for ArgNo:=0 to PropArgs.Count-1 do
  22153. begin
  22154. PropArg:=TPasArgument(PropArgs[ArgNo]);
  22155. Param:=Params.Params[ArgNo];
  22156. ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
  22157. if ParamComp=cIncompatible then
  22158. exit(cIncompatible);
  22159. inc(Result,ParamComp);
  22160. end;
  22161. end;
  22162. function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
  22163. Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
  22164. var
  22165. ArgNo: Integer;
  22166. Param: TPasExpr;
  22167. ParamResolved: TPasResolverResult;
  22168. procedure GetNextParam;
  22169. begin
  22170. if ArgNo>=length(Params.Params) then
  22171. RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  22172. [],Params);
  22173. Param:=Params.Params[ArgNo];
  22174. ComputeElement(Param,ParamResolved,[]);
  22175. inc(ArgNo);
  22176. end;
  22177. var
  22178. DimNo: integer;
  22179. RangeResolved, OrigRangeResolved, OrigParamResolved: TPasResolverResult;
  22180. bt: TResolverBaseType;
  22181. NextType, TypeEl: TPasType;
  22182. RangeExpr: TPasExpr;
  22183. TypeFits: Boolean;
  22184. ParamValue: TResEvalValue;
  22185. begin
  22186. ArgNo:=0;
  22187. repeat
  22188. if length(ArrayEl.Ranges)=0 then
  22189. begin
  22190. // dynamic/open array -> needs exactly one integer
  22191. GetNextParam;
  22192. if (not (rrfReadable in ParamResolved.Flags))
  22193. or not (ParamResolved.BaseType in btAllInteger) then
  22194. exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
  22195. if EmitHints then
  22196. begin
  22197. ParamValue:=Eval(Param,[refAutoConstExt]);
  22198. if ParamValue<>nil then
  22199. try // has const value -> check range
  22200. if ParamValue.Kind=revkExternal then
  22201. // ignore
  22202. else if (ParamValue.Kind<>revkInt)
  22203. or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
  22204. or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
  22205. fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
  22206. DynArrayMinIndex,DynArrayMaxIndex,Param);
  22207. finally
  22208. ReleaseEvalValue(ParamValue);
  22209. end;
  22210. end;
  22211. end
  22212. else
  22213. begin
  22214. // static array
  22215. for DimNo:=0 to length(ArrayEl.Ranges)-1 do
  22216. begin
  22217. GetNextParam;
  22218. RangeExpr:=ArrayEl.Ranges[DimNo];
  22219. ComputeElement(RangeExpr,RangeResolved,[]);
  22220. bt:=RangeResolved.BaseType;
  22221. if not (rrfReadable in ParamResolved.Flags) then
  22222. begin
  22223. if not RaiseOnError then exit(cIncompatible);
  22224. RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
  22225. [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
  22226. end;
  22227. TypeFits:=false;
  22228. OrigRangeResolved:=RangeResolved;
  22229. OrigParamResolved:=ParamResolved;
  22230. if bt=btRange then
  22231. begin
  22232. ConvertRangeToElement(RangeResolved);
  22233. bt:=RangeResolved.BaseType;
  22234. end;
  22235. if ParamResolved.BaseType=btRange then
  22236. begin
  22237. ConvertRangeToElement(ParamResolved);
  22238. end;
  22239. if (bt in btAllBooleans) then
  22240. begin
  22241. if (ParamResolved.BaseType in btAllBooleans) then
  22242. TypeFits:=true;
  22243. end
  22244. else if (bt in btAllInteger) then
  22245. begin
  22246. if (ParamResolved.BaseType in btAllInteger) then
  22247. TypeFits:=true;
  22248. end
  22249. else if (bt in btAllChars) then
  22250. begin
  22251. if (ParamResolved.BaseType in btAllChars) then
  22252. TypeFits:=true;
  22253. end
  22254. else if (bt=btContext) then
  22255. begin
  22256. TypeEl:=RangeResolved.LoTypeEl;
  22257. if ParamResolved.BaseType=btContext then
  22258. begin
  22259. if (TypeEl.ClassType=TPasEnumType)
  22260. and IsSameType(TypeEl,ParamResolved.LoTypeEl,prraNone) then
  22261. TypeFits:=true;
  22262. end;
  22263. end;
  22264. if not TypeFits then
  22265. begin
  22266. // incompatible
  22267. if not RaiseOnError then exit(cIncompatible);
  22268. RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
  22269. [IntToStr(ArgNo)],OrigParamResolved,OrigRangeResolved,Param);
  22270. end;
  22271. if EmitHints then
  22272. fExprEvaluator.IsInRange(Param,RangeExpr,true);
  22273. end;
  22274. end;
  22275. if ArgNo=length(Params.Params) then exit(cExact);
  22276. // there are more parameters -> continue in sub array
  22277. NextType:=ResolveAliasType(ArrayEl.ElType);
  22278. if NextType.ClassType<>TPasArrayType then
  22279. RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
  22280. [],Params);
  22281. ArrayEl:=TPasArrayType(NextType);
  22282. until false;
  22283. Result:=cIncompatible;
  22284. end;
  22285. function TPasResolver.CheckProcOverloadCompatibility(Proc1, Proc2: TPasProcedure): boolean;
  22286. // returns if number and type of arguments fit
  22287. // does not check calling convention
  22288. var
  22289. ProcArgs1, ProcArgs2, TemplTypes1, TemplTypes2: TFPList;
  22290. i, Comp: Integer;
  22291. begin
  22292. Result:=false;
  22293. if (Proc1.NameParts<>nil) or (Proc2.NameParts<>nil) then
  22294. begin
  22295. TemplTypes1:=GetProcTemplateTypes(Proc1);
  22296. TemplTypes2:=GetProcTemplateTypes(Proc2);
  22297. if TemplTypes1=nil then
  22298. begin
  22299. if TemplTypes2<>nil then
  22300. exit;
  22301. end
  22302. else if TemplTypes2=nil then
  22303. exit
  22304. else if TemplTypes1.Count<>TemplTypes2.Count then
  22305. exit;
  22306. end;
  22307. ProcArgs1:=Proc1.ProcType.Args;
  22308. ProcArgs2:=Proc2.ProcType.Args;
  22309. {$IFDEF VerbosePasResolver}
  22310. writeln('TPasResolver.CheckProcOverloadCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
  22311. {$ENDIF}
  22312. // check args
  22313. if ProcArgs1.Count<>ProcArgs2.Count then
  22314. exit;
  22315. for i:=0 to ProcArgs1.Count-1 do
  22316. begin
  22317. {$IFDEF VerbosePasResolver}
  22318. writeln('TPasResolver.CheckProcOverloadCompatibility ',i,'/',ProcArgs1.Count);
  22319. {$ENDIF}
  22320. Comp:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
  22321. if Comp>cExact then
  22322. exit;
  22323. end;
  22324. Result:=true;
  22325. end;
  22326. function TPasResolver.CheckProcTypeCompatibility(Proc1,
  22327. Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
  22328. RaiseOnIncompatible: boolean): boolean;
  22329. // if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
  22330. function ModifierError(Modifier: TProcTypeModifier): boolean;
  22331. begin
  22332. Result:=false;
  22333. if not RaiseOnIncompatible then exit;
  22334. RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
  22335. [GetElementTypeName(Proc1),ProcTypeModifiers[Modifier]],ErrorEl);
  22336. end;
  22337. var
  22338. ProcArgs1, ProcArgs2: TFPList;
  22339. i: Integer;
  22340. Result1Resolved, Result2Resolved: TPasResolverResult;
  22341. ExpectedArg, ActualArg: TPasArgument;
  22342. begin
  22343. Result:=false;
  22344. if Proc1.ClassType<>Proc2.ClassType then
  22345. begin
  22346. if RaiseOnIncompatible then
  22347. RaiseXExpectedButYFound(20170402112353,GetElementTypeName(Proc1),GetElementTypeName(Proc2),ErrorEl);
  22348. exit;
  22349. end;
  22350. if Proc1.IsReferenceTo then
  22351. begin
  22352. if IsAssign then
  22353. // aRefTo:=aproc -> any IsNested/OfObject is allowed
  22354. else
  22355. ; // aRefTo = AnyProc -> ok
  22356. end
  22357. else if Proc2.IsReferenceTo then
  22358. begin
  22359. if IsAssign then
  22360. // NonRefTo := aRefTo -> not possible
  22361. exit(ModifierError(ptmReferenceTo))
  22362. else
  22363. ; // AnyProc = aRefTo -> ok
  22364. end
  22365. else if Proc2.Parent is TPasAnonymousProcedure then
  22366. begin
  22367. if IsAssign then
  22368. // NonRefTo := AnonymousProc -> not possible
  22369. exit(ModifierError(ptmReferenceTo))
  22370. else
  22371. ; // AnyProc = AnonymousProc -> ok
  22372. end
  22373. else
  22374. begin
  22375. // neither Proc1 nor Proc2 is a reference-to -> check isNested and OfObject
  22376. if Proc1.IsNested<>Proc2.IsNested then
  22377. exit(ModifierError(ptmIsNested));
  22378. if Proc1.IsOfObject<>Proc2.IsOfObject then
  22379. begin
  22380. if (proProcTypeWithoutIsNested in Options) then
  22381. exit(ModifierError(ptmOfObject))
  22382. else if Proc1.IsNested then
  22383. // "is nested" can handle both, proc and method.
  22384. else
  22385. exit(ModifierError(ptmOfObject))
  22386. end;
  22387. end;
  22388. if Proc1.CallingConvention<>Proc2.CallingConvention then
  22389. begin
  22390. if (proSafecallAllowsDefault in Options)
  22391. and (Proc1.CallingConvention=ccSafeCall)
  22392. and (Proc2.CallingConvention=ccDefault) then
  22393. // ok
  22394. else
  22395. begin
  22396. if RaiseOnIncompatible then
  22397. RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
  22398. [],ErrorEl);
  22399. exit;
  22400. end;
  22401. end;
  22402. ProcArgs1:=Proc1.Args;
  22403. ProcArgs2:=Proc2.Args;
  22404. if ProcArgs1.Count<>ProcArgs2.Count then
  22405. begin
  22406. if RaiseOnIncompatible then
  22407. RaiseMsg(20170902142829,nIncompatibleTypesGotParametersExpected,
  22408. sIncompatibleTypesGotParametersExpected,
  22409. [IntToStr(ProcArgs1.Count),IntToStr(ProcArgs2.Count)],ErrorEl);
  22410. exit;
  22411. end;
  22412. for i:=0 to ProcArgs1.Count-1 do
  22413. begin
  22414. {$IFDEF VerbosePasResolver}
  22415. writeln('TPasResolver.CheckProcTypeCompatibility ',i,'/',ProcArgs1.Count);
  22416. {$ENDIF}
  22417. ExpectedArg:=TPasArgument(ProcArgs1[i]);
  22418. ActualArg:=TPasArgument(ProcArgs2[i]);
  22419. if CheckProcArgCompatibility(ExpectedArg,ActualArg)>cGenericExact then
  22420. begin
  22421. if RaiseOnIncompatible then
  22422. begin
  22423. if ExpectedArg.Access<>ActualArg.Access then
  22424. RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
  22425. [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
  22426. AccessDescriptions[ExpectedArg.Access]],
  22427. ErrorEl);
  22428. RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
  22429. [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
  22430. end;
  22431. exit;
  22432. end;
  22433. end;
  22434. if Proc1 is TPasFunctionType then
  22435. begin
  22436. ComputeResultElement(TPasFunctionType(Proc1).ResultEl,Result1Resolved,[]);
  22437. ComputeResultElement(TPasFunctionType(Proc2).ResultEl,Result2Resolved,[]);
  22438. if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
  22439. or not IsSameType(Result1Resolved.HiTypeEl,Result2Resolved.HiTypeEl,prraSimple) then
  22440. begin
  22441. if RaiseOnIncompatible then
  22442. RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
  22443. [],Result1Resolved,Result2Resolved,ErrorEl);
  22444. exit;
  22445. end;
  22446. if Proc1.IsAsync<>Proc2.IsAsync then
  22447. RaiseMsg(20200524112519,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ErrorEl);
  22448. end;
  22449. Result:=true;
  22450. end;
  22451. function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument
  22452. ): integer;
  22453. begin
  22454. // check access: var, const, ...
  22455. if Arg1.Access<>Arg2.Access then exit(cIncompatible);
  22456. Result:=CheckElTypeCompatibility(Arg1.ArgType,Arg2.ArgType,prraSimple);
  22457. end;
  22458. function TPasResolver.CheckElTypeCompatibility(Arg1, Arg2: TPasType;
  22459. ResolveAlias: TPRResolveAlias): integer;
  22460. var
  22461. Arg1Resolved, Arg2Resolved: TPasResolverResult;
  22462. C: TClass;
  22463. Arr1, Arr2: TPasArrayType;
  22464. TemplType1, TemplType2: TPasGenericTemplateType;
  22465. Templates1, Templates2, ProcArgs1, ProcArgs2: TFPList;
  22466. i: Integer;
  22467. Proc1, Proc2: TPasProcedureType;
  22468. begin
  22469. if Arg1=Arg2 then exit(cExact);
  22470. ComputeElement(Arg1,Arg1Resolved,[rcType]);
  22471. ComputeElement(Arg2,Arg2Resolved,[rcType]);
  22472. {$IFDEF VerbosePasResolver}
  22473. writeln('TPasResolver.CheckElTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
  22474. {$ENDIF}
  22475. if IsGenericTemplType(Arg1Resolved) then
  22476. begin
  22477. Result:=cGenericExact;
  22478. if Arg1Resolved.LoTypeEl=Arg2Resolved.LoTypeEl then
  22479. exit(cExact)
  22480. else if IsGenericTemplType(Arg2Resolved) then
  22481. begin
  22482. TemplType1:=TPasGenericTemplateType(Arg1Resolved.LoTypeEl);
  22483. TemplType2:=TPasGenericTemplateType(Arg2Resolved.LoTypeEl);
  22484. if (TemplType1.Parent is TPasProcedure)
  22485. and (TemplType2.Parent is TPasProcedure) then
  22486. begin
  22487. Templates1:=GetProcTemplateTypes(TPasProcedure(TemplType1.Parent));
  22488. Templates2:=GetProcTemplateTypes(TPasProcedure(TemplType2.Parent));
  22489. i:=Templates1.IndexOf(TemplType1);
  22490. if (i>=0) and (i=Templates2.IndexOf(TemplType2)) then
  22491. exit(cExact);
  22492. end;
  22493. end;
  22494. exit;
  22495. end
  22496. else if IsGenericTemplType(Arg2Resolved) then
  22497. exit(cGenericExact);
  22498. if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
  22499. or (Arg1Resolved.LoTypeEl=nil)
  22500. or (Arg2Resolved.LoTypeEl=nil) then
  22501. exit(cIncompatible);
  22502. if ResolveAlias=prraSimple then
  22503. begin
  22504. if IsSameType(Arg1Resolved.HiTypeEl,Arg2Resolved.HiTypeEl,prraSimple) then
  22505. exit(cExact);
  22506. end
  22507. else
  22508. begin
  22509. if IsSameType(Arg1Resolved.LoTypeEl,Arg2Resolved.LoTypeEl,prraNone) then
  22510. exit(cExact);
  22511. end;
  22512. if Arg1Resolved.BaseType=btContext then
  22513. begin
  22514. C:=Arg1Resolved.LoTypeEl.ClassType;
  22515. if C<>Arg2Resolved.LoTypeEl.ClassType then
  22516. exit(cIncompatible);
  22517. if C=TPasArrayType then
  22518. begin
  22519. Arr1:=TPasArrayType(Arg1Resolved.LoTypeEl);
  22520. Arr2:=TPasArrayType(Arg2Resolved.LoTypeEl);
  22521. if length(Arr1.Ranges)<>length(Arr2.Ranges) then
  22522. exit(cIncompatible);
  22523. if length(Arr1.Ranges)>0 then
  22524. RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
  22525. Result:=CheckElTypeCompatibility(GetArrayElType(Arr1),GetArrayElType(Arr2),ResolveAlias);
  22526. exit;
  22527. end
  22528. else if (C.InheritsFrom(TPasProcedureType))
  22529. and not (msDelphi in CurrentParser.CurrentModeswitches) then
  22530. begin
  22531. // FPC checks proc types arguments by signature, Delphi checks by type
  22532. Proc1:=TPasProcedureType(Arg1Resolved.LoTypeEl);
  22533. Proc2:=TPasProcedureType(Arg2Resolved.LoTypeEl);
  22534. if Proc1.CallingConvention<>Proc2.CallingConvention then
  22535. exit(cIncompatible);
  22536. if Proc1.Modifiers<>Proc2.Modifiers then
  22537. exit(cIncompatible);
  22538. if Proc1.VarArgsType<>Proc2.VarArgsType then
  22539. begin
  22540. Result:=CheckElTypeCompatibility(Proc1.VarArgsType,Proc2.VarArgsType,ResolveAlias);
  22541. if Result=cIncompatible then exit;
  22542. end;
  22543. ProcArgs1:=Proc1.Args;
  22544. ProcArgs2:=Proc2.Args;
  22545. if ProcArgs1.Count<>ProcArgs2.Count then
  22546. exit(cIncompatible);
  22547. for i:=0 to ProcArgs1.Count-1 do
  22548. begin
  22549. Result:=CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i]));
  22550. if Result>cGenericExact then
  22551. exit(cIncompatible);
  22552. end;
  22553. exit(cExact);
  22554. end;
  22555. end;
  22556. Result:=cIncompatible;
  22557. end;
  22558. function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
  22559. ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
  22560. var
  22561. El: TPasElement;
  22562. begin
  22563. Result:=false;
  22564. El:=ResolvedEl.IdentEl;
  22565. if El=nil then
  22566. begin
  22567. if (ResolvedEl.ExprEl is TUnaryExpr)
  22568. and (TUnaryExpr(ResolvedEl.ExprEl).OpCode=eopDeref) then
  22569. begin
  22570. // e.g. p^:=
  22571. end
  22572. else
  22573. begin
  22574. if ErrorOnFalse then
  22575. begin
  22576. {$IFDEF VerbosePasResolver}
  22577. writeln('TPasResolver.CheckCanBeLHS no identifier: ',GetResolverResultDbg(ResolvedEl));
  22578. {$ENDIF}
  22579. if (ResolvedEl.LoTypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
  22580. RaiseXExpectedButYFound(20170216152727,'identifier',GetElementTypeName(ResolvedEl.LoTypeEl),ResolvedEl.ExprEl)
  22581. else
  22582. RaiseVarExpected(20170216152426,ErrorEl,ResolvedEl.IdentEl);
  22583. end;
  22584. exit;
  22585. end;
  22586. end;
  22587. if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
  22588. exit(not IsVariableConst(El,ErrorEl,ErrorOnFalse));
  22589. // not writable
  22590. if not ErrorOnFalse then exit;
  22591. {$IFDEF VerbosePasResolver}
  22592. writeln('TPasResolver.CheckCanBeLHS not writable: ',GetResolverResultDbg(ResolvedEl));
  22593. {$ENDIF}
  22594. if ResolvedEl.IdentEl is TPasProperty then
  22595. RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
  22596. else if ResolvedEl.IdentEl is TPasConst then
  22597. RaiseMsg(20180430012042,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],ErrorEl)
  22598. else
  22599. RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
  22600. end;
  22601. function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
  22602. RaiseOnIncompatible: boolean; ErrorEl: TPasElement): integer;
  22603. var
  22604. LeftResolved, RightResolved: TPasResolverResult;
  22605. Flags: TPasResolverComputeFlags;
  22606. IsProcType: Boolean;
  22607. begin
  22608. if ErrorEl=nil then
  22609. ErrorEl:=RHS;
  22610. ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
  22611. Flags:=[];
  22612. IsProcType:=IsProcedureType(LeftResolved,true);
  22613. if IsProcType then
  22614. if msDelphi in CurrentParser.CurrentModeswitches then
  22615. Include(Flags,rcNoImplicitProc)
  22616. else
  22617. Include(Flags,rcNoImplicitProcType);
  22618. ComputeElement(RHS,RightResolved,Flags);
  22619. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  22620. if RHS is TPasExpr then
  22621. CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
  22622. end;
  22623. procedure TPasResolver.CheckAssignExprRange(
  22624. const LeftResolved: TPasResolverResult; RHS: TPasExpr);
  22625. // if RHS is a constant check if it fits into range LeftResolved
  22626. var
  22627. LRangeValue, RValue: TResEvalValue;
  22628. Int, MinVal, MaxVal: TMaxPrecInt;
  22629. RangeExpr: TBinaryExpr;
  22630. C: TClass;
  22631. EnumType: TPasEnumType;
  22632. bt: TResolverBaseType;
  22633. LTypeEl: TPasType;
  22634. begin
  22635. LTypeEl:=LeftResolved.LoTypeEl;
  22636. if (LTypeEl<>nil)
  22637. and ((LTypeEl.ClassType=TPasArrayType)
  22638. or (LTypeEl.ClassType=TPasRecordType)) then
  22639. exit; // arrays and records are checked by element, not by the whole value
  22640. if LTypeEl is TPasClassOfType then
  22641. exit; // class-of are checked only by type, not by value
  22642. RValue:=Eval(RHS,[refAutoConstExt]);
  22643. if RValue=nil then
  22644. exit; // not a const expression
  22645. {$IFDEF VerbosePasResEval}
  22646. writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
  22647. {$ENDIF}
  22648. LRangeValue:=nil;
  22649. try
  22650. if RValue.Kind=revkExternal then
  22651. // skip
  22652. else if LeftResolved.BaseType=btCustom then
  22653. CheckAssignExprRangeToCustom(LeftResolved,RValue,RHS)
  22654. else if LeftResolved.BaseType=btSet then
  22655. begin
  22656. // assign to a set
  22657. C:=LTypeEl.ClassType;
  22658. if C=TPasRangeType then
  22659. begin
  22660. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  22661. LRangeValue:=Eval(RangeExpr,[refConst],false);
  22662. end
  22663. else if C=TPasEnumType then
  22664. begin
  22665. EnumType:=TPasEnumType(LTypeEl);
  22666. LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
  22667. 0,TMaxPrecInt(EnumType.Values.Count)-1);
  22668. end
  22669. else if C=TPasUnresolvedSymbolRef then
  22670. begin
  22671. // set of basetype
  22672. if LTypeEl.CustomData is TResElDataBaseType then
  22673. begin
  22674. bt:=GetActualBaseType(TResElDataBaseType(LTypeEl.CustomData).BaseType);
  22675. if (bt in btAllIntegerNoQWord) and GetIntegerRange(bt,MinVal,MaxVal) then
  22676. LRangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
  22677. else if bt=btBoolean then
  22678. LRangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
  22679. {$ifdef FPC_HAS_CPSTRING}
  22680. else if bt=btAnsiChar then
  22681. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
  22682. {$endif}
  22683. else if bt=btWideChar then
  22684. LRangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
  22685. else
  22686. RaiseNotYetImplemented(20170714205110,RHS);
  22687. end
  22688. else
  22689. RaiseNotYetImplemented(20170714204803,RHS);
  22690. end
  22691. else
  22692. RaiseNotYetImplemented(20170714193100,RHS);
  22693. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true);
  22694. end
  22695. else if LTypeEl is TPasRangeType then
  22696. begin
  22697. RangeExpr:=TPasRangeType(LTypeEl).RangeExpr;
  22698. LRangeValue:=Eval(RangeExpr,[refConst]);
  22699. if LeftResolved.BaseType=btSet then
  22700. fExprEvaluator.IsSetCompatible(RValue,RHS,LRangeValue,true)
  22701. else
  22702. fExprEvaluator.IsInRange(RValue,RHS,LRangeValue,RangeExpr,true);
  22703. end
  22704. else if (LeftResolved.BaseType in btAllIntegerNoQWord)
  22705. and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
  22706. case RValue.Kind of
  22707. revkInt:
  22708. if (MinVal>TResEvalInt(RValue).Int)
  22709. or (MaxVal<TResEvalInt(RValue).Int) then
  22710. fExprEvaluator.EmitRangeCheckConst(20170530093126,
  22711. IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
  22712. revkUInt:
  22713. if (TResEvalUInt(RValue).UInt>High(TMaxPrecInt))
  22714. or (MinVal>TMaxPrecInt(TResEvalUInt(RValue).UInt))
  22715. or (MaxVal<TMaxPrecInt(TResEvalUInt(RValue).UInt)) then
  22716. fExprEvaluator.EmitRangeCheckConst(20170530093616,
  22717. IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
  22718. revkFloat:
  22719. if TResEvalFloat(RValue).IsInt(Int) then
  22720. begin
  22721. if (MinVal>Int) or (MaxVal<Int) then
  22722. fExprEvaluator.EmitRangeCheckConst(20170802133307,
  22723. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  22724. end
  22725. else
  22726. begin
  22727. {$IFDEF VerbosePasResEval}
  22728. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalFloat(RValue).FloatValue),' ',TResEvalFloat(RValue).FloatValue<TMaxPrecFloat(low(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue>TMaxPrecFloat(high(TMaxPrecInt)),' ',TResEvalFloat(RValue).FloatValue,' ',high(TMaxPrecInt));
  22729. {$ENDIF}
  22730. RaiseRangeCheck(20170802133750,RHS);
  22731. end;
  22732. revkCurrency:
  22733. if TResEvalCurrency(RValue).IsInt(Int) then
  22734. begin
  22735. if (MinVal>Int) or (MaxVal<Int) then
  22736. fExprEvaluator.EmitRangeCheckConst(20180421171325,
  22737. IntToStr(Int),MinVal,MaxVal,RHS,mtError);
  22738. end
  22739. else
  22740. begin
  22741. {$IFDEF VerbosePasResEval}
  22742. writeln('TPasResolver.CheckAssignExprRange ',Frac(TResEvalCurrency(RValue).Value),' ',TResEvalCurrency(RValue).Value,' ',high(TMaxPrecInt));
  22743. {$ENDIF}
  22744. RaiseRangeCheck(20180421171438,RHS);
  22745. end;
  22746. else
  22747. {$IFDEF VerbosePasResEval}
  22748. writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
  22749. {$ENDIF}
  22750. RaiseNotYetImplemented(20170530092731,RHS);
  22751. end
  22752. {$ifdef HasInt64}
  22753. else if LeftResolved.BaseType=btQWord then
  22754. case RValue.Kind of
  22755. revkInt:
  22756. if (TResEvalInt(RValue).Int<0) then
  22757. fExprEvaluator.EmitRangeCheckConst(20170530094316,
  22758. IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
  22759. revkUInt: ;
  22760. else
  22761. RaiseNotYetImplemented(20170530094311,RHS);
  22762. end
  22763. {$endif}
  22764. else if RValue.Kind in [revkNil,revkBool] then
  22765. // simple type check is enough
  22766. else if LeftResolved.BaseType in [btSingle,btDouble,btCurrency] then
  22767. // simple type check is enough
  22768. // ToDo: warn if precision loss
  22769. else if LeftResolved.BaseType in btAllChars then
  22770. begin
  22771. case RValue.Kind of
  22772. {$ifdef FPC_HAS_CPSTRING}
  22773. revkString,
  22774. {$endif}
  22775. revkUnicodeString:
  22776. Int:=fExprEvaluator.StringToOrd(RValue,RHS);
  22777. else
  22778. RaiseNotYetImplemented(20170714171218,RHS);
  22779. end;
  22780. case GetActualBaseType(LeftResolved.BaseType) of
  22781. {$ifdef FPC_HAS_CPSTRING}
  22782. btAnsiChar: MaxVal:=$ff;
  22783. {$endif}
  22784. btWideChar: MaxVal:=$ffff;
  22785. end;
  22786. if (Int>MaxVal) then
  22787. fExprEvaluator.EmitRangeCheckConst(20170714171911,
  22788. '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
  22789. end
  22790. else if LeftResolved.BaseType in btAllStrings then
  22791. // simple type check is enough
  22792. // ToDo: warn if unicode to non-utf8
  22793. else if LeftResolved.BaseType=btContext then
  22794. // simple type check is enough
  22795. else if LeftResolved.BaseType=btRange then
  22796. begin
  22797. if (LeftResolved.ExprEl is TBinaryExpr)
  22798. and (TBinaryExpr(LeftResolved.ExprEl).Kind=pekRange) then
  22799. begin
  22800. LRangeValue:=Eval(LeftResolved.ExprEl,[refConst]);
  22801. try
  22802. case LRangeValue.Kind of
  22803. revkRangeInt:
  22804. case TResEvalRangeInt(LRangeValue).ElKind of
  22805. revskEnum:
  22806. if (RValue.Kind<>revkEnum) then
  22807. RaiseNotYetImplemented(20171009171251,RHS)
  22808. else if (TResEvalEnum(RValue).Index<TResEvalRangeInt(LRangeValue).RangeStart)
  22809. or (TResEvalEnum(RValue).Index>TResEvalRangeInt(LRangeValue).RangeEnd) then
  22810. fExprEvaluator.EmitRangeCheckConst(20171009171442,
  22811. TResEvalEnum(RValue).AsString,
  22812. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeStart),
  22813. TResEvalRangeInt(LRangeValue).ElementAsString(TResEvalRangeInt(LRangeValue).RangeEnd),
  22814. RHS);
  22815. else
  22816. RaiseNotYetImplemented(20171009165348,LeftResolved.ExprEl);
  22817. end;
  22818. else
  22819. RaiseNotYetImplemented(20171009165326,LeftResolved.ExprEl);
  22820. end;
  22821. finally
  22822. ReleaseEvalValue(LRangeValue);
  22823. end;
  22824. end
  22825. else
  22826. RaiseNotYetImplemented(20171009171005,RHS);
  22827. end
  22828. else
  22829. begin
  22830. {$IFDEF VerbosePasResolver}
  22831. writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
  22832. {$ENDIF}
  22833. RaiseNotYetImplemented(20170530095243,RHS);
  22834. end;
  22835. finally
  22836. ReleaseEvalValue(RValue);
  22837. ReleaseEvalValue(LRangeValue);
  22838. end;
  22839. end;
  22840. procedure TPasResolver.CheckAssignExprRangeToCustom(
  22841. const LeftResolved: TPasResolverResult; RValue: TResEvalValue; RHS: TPasExpr);
  22842. begin
  22843. if LeftResolved.BaseType<>btCustom then exit;
  22844. if RValue=nil then exit;
  22845. if RHS=nil then ;
  22846. end;
  22847. function TPasResolver.CheckAssignResCompatibility(const LHS,
  22848. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  22849. ): integer;
  22850. var
  22851. LTypeEl, RTypeEl: TPasType;
  22852. Handled: Boolean;
  22853. C: TClass;
  22854. LBT, RBT: TResolverBaseType;
  22855. LRange, RValue, Value: TResEvalValue;
  22856. RightSubResolved: TPasResolverResult;
  22857. wc: WideChar;
  22858. begin
  22859. // check if the RHS can be converted to LHS
  22860. {$IFDEF VerbosePasResolver}
  22861. writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  22862. {$ENDIF}
  22863. Result:=-1;
  22864. Handled:=false;
  22865. Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
  22866. if Handled and (Result>=cExact) and (Result<cIncompatible) then
  22867. exit;
  22868. if not Handled then
  22869. begin
  22870. LBT:=GetActualBaseType(LHS.BaseType);
  22871. RBT:=GetActualBaseType(RHS.BaseType);
  22872. if IsGenericTemplType(LHS) then
  22873. begin
  22874. // Template := RHS
  22875. if not RaiseOnIncompatible then
  22876. ErrorEl:=nil;
  22877. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),
  22878. RHS,prtcoAssignToTempl,ErrorEl);
  22879. exit;
  22880. end
  22881. else if IsGenericTemplType(RHS) then
  22882. begin
  22883. // LHS := Template
  22884. if not RaiseOnIncompatible then
  22885. ErrorEl:=nil;
  22886. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),
  22887. LHS,prtcoAssignFromTempl,ErrorEl);
  22888. exit;
  22889. end;
  22890. if LHS.LoTypeEl=nil then
  22891. begin
  22892. if LBT=btUntyped then
  22893. begin
  22894. // untyped parameter
  22895. Result:=cTypeConversion;
  22896. end
  22897. else
  22898. RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
  22899. end
  22900. else if LBT=RBT then
  22901. begin
  22902. if LBT=btContext then
  22903. exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
  22904. else
  22905. begin
  22906. // same base type, maybe not same type (e.g. longint and integer)
  22907. if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  22908. and HasExactType(RHS) then
  22909. Result:=cExact
  22910. else
  22911. Result:=cAliasExact;
  22912. end;
  22913. end
  22914. else if (LBT in btAllBooleans)
  22915. and (RBT in btAllBooleans) then
  22916. Result:=cCompatible
  22917. else if (LBT in btAllChars) then
  22918. begin
  22919. if (RBT in btAllChars) then
  22920. case LBT of
  22921. {$ifdef FPC_HAS_CPSTRING}
  22922. btAnsiChar:
  22923. Result:=cLossyConversion;
  22924. {$endif}
  22925. btWideChar:
  22926. {$ifdef FPC_HAS_CPSTRING}
  22927. if RBT=btAnsiChar then
  22928. Result:=cCompatible
  22929. else
  22930. {$endif}
  22931. Result:=cLossyConversion;
  22932. else
  22933. RaiseNotYetImplemented(20170728132440,ErrorEl,BaseTypeNames[LBT]);
  22934. end
  22935. else if (RBT=btRange) and (RHS.SubType in btAllChars) then
  22936. begin
  22937. if LBT=btWideChar then
  22938. exit(cCompatible);
  22939. {$ifdef FPC_HAS_CPSTRING}
  22940. // LHS is ansichar
  22941. if GetActualBaseType(RHS.SubType)=btAnsiChar then
  22942. exit(cExact);
  22943. RValue:=Eval(RHS,[refAutoConstExt]);
  22944. if RValue<>nil then
  22945. try
  22946. // ansichar:=constvalue
  22947. case RValue.Kind of
  22948. revkString:
  22949. if not ExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  22950. exit(cIncompatible);
  22951. revkUnicodeString:
  22952. begin
  22953. if length(TResEvalUTF16(RValue).S)<>1 then
  22954. exit(cIncompatible);
  22955. wc:=TResEvalUTF16(RValue).S[1];
  22956. end;
  22957. revkExternal:
  22958. exit(cCompatible);
  22959. else
  22960. RaiseNotYetImplemented(20171108194650,ErrorEl);
  22961. end;
  22962. if ord(wc)>255 then
  22963. exit(cIncompatible);
  22964. exit(cCompatible);
  22965. finally
  22966. ReleaseEvalValue(RValue);
  22967. end;
  22968. // LHS is ansichar, RHS is not a const
  22969. if (RHS.ExprEl is TBinaryExpr) and (TBinaryExpr(RHS.ExprEl).Kind=pekRange) then
  22970. begin
  22971. RValue:=Eval(RHS.ExprEl,[refConst]);
  22972. try
  22973. if RValue.Kind<>revkRangeInt then
  22974. RaiseNotYetImplemented(20171108195035,ErrorEl);
  22975. if TResEvalRangeInt(RValue).RangeStart>255 then
  22976. exit(cIncompatible);
  22977. if TResEvalRangeInt(RValue).RangeEnd>255 then
  22978. exit(cLossyConversion);
  22979. exit(cCompatible);
  22980. finally
  22981. ReleaseEvalValue(RValue);
  22982. end;
  22983. end;
  22984. {$endif}
  22985. RaiseNotYetImplemented(20171108195216,ErrorEl);
  22986. end;
  22987. end
  22988. else if (LBT in btAllStrings) then
  22989. begin
  22990. if (RBT in btAllStringAndChars) then
  22991. case LBT of
  22992. {$ifdef FPC_HAS_CPSTRING}
  22993. btAnsiString:
  22994. if RBT in [btAnsiChar,btShortString,btRawByteString] then
  22995. Result:=cCompatible
  22996. else
  22997. Result:=cLossyConversion;
  22998. btShortString:
  22999. if RBT=btAnsiChar then
  23000. Result:=cCompatible
  23001. else
  23002. Result:=cLossyConversion;
  23003. btRawByteString:
  23004. if RBT in [btAnsiChar,btAnsiString,btShortString] then
  23005. Result:=cCompatible
  23006. else
  23007. Result:=cLossyConversion;
  23008. {$endif}
  23009. btWideString,btUnicodeString:
  23010. Result:=cCompatible;
  23011. else
  23012. {$IFDEF VerbosePasResolver}
  23013. writeln('TPasResolver.CheckAssignResCompatibility ',{$ifdef pas2js}str(LBT){$else}LBT{$ENDIF});
  23014. {$ENDIF}
  23015. RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
  23016. end
  23017. else if RBT=btContext then
  23018. begin
  23019. RTypeEl:=RHS.LoTypeEl;
  23020. if RTypeEl.ClassType=TPasClassType then
  23021. begin
  23022. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  23023. and IsTGUIDString(LHS) then
  23024. // aGUIDString:=IntfTypeOrVar
  23025. exit(cInterfaceToString); // no check for rrfReadable
  23026. end
  23027. else if RTypeEl.ClassType=TPasRecordType then
  23028. begin
  23029. if IsTGUID(TPasRecordType(RTypeEl)) then
  23030. // aString:=GUID
  23031. Result:=cTGUIDToString;
  23032. end;
  23033. end;
  23034. end
  23035. else if (LBT in btAllInteger)
  23036. and (RBT in btAllInteger) then
  23037. begin
  23038. Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
  23039. case LBT of
  23040. btByte,
  23041. btShortInt: inc(Result,cLossyConversion);
  23042. btWord,
  23043. btSmallInt:
  23044. if not (RBT in [btByte,btShortInt]) then
  23045. inc(Result,cLossyConversion);
  23046. btUIntSingle:
  23047. if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
  23048. inc(Result,cLossyConversion);
  23049. btIntSingle:
  23050. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
  23051. inc(Result,cLossyConversion);
  23052. btLongWord,
  23053. btLongint:
  23054. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
  23055. inc(Result,cLossyConversion);
  23056. btUIntDouble:
  23057. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
  23058. inc(Result,cLossyConversion);
  23059. btIntDouble:
  23060. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
  23061. inc(Result,cLossyConversion);
  23062. {$ifdef HasInt64}
  23063. btQWord,
  23064. btInt64,btComp:
  23065. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
  23066. btLongWord,btLongint,btUIntDouble,btIntDouble]) then
  23067. inc(Result,cLossyConversion);
  23068. {$endif}
  23069. else
  23070. RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
  23071. end;
  23072. end
  23073. else if (LBT in btAllFloats)
  23074. and (RBT in btAllFloats) then
  23075. begin
  23076. Result:=cFloatToFloatConversion+ord(LBT)-ord(RBT);
  23077. case LBT of
  23078. btSingle:
  23079. if RBT>btSingle then
  23080. inc(Result,cLossyConversion);
  23081. btDouble:
  23082. if RBT>btDouble then
  23083. inc(Result,cLossyConversion);
  23084. btExtended,btCExtended:
  23085. if RBT>btCExtended then
  23086. inc(Result,cLossyConversion);
  23087. btCurrency:
  23088. inc(Result,cLossyConversion);
  23089. else
  23090. RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
  23091. end;
  23092. end
  23093. else if (LBT in btAllFloats)
  23094. and (RBT in btAllInteger) then
  23095. begin
  23096. Result:=cIntToFloatConversion+ord(LBT)-ord(RBT);
  23097. case LBT of
  23098. btSingle:
  23099. if RBT>btUIntSingle then
  23100. inc(Result,cLossyConversion);
  23101. btDouble:
  23102. if RBT>btUIntDouble then
  23103. inc(Result,cLossyConversion);
  23104. btExtended,btCExtended:
  23105. if RBT>btCExtended then
  23106. inc(Result,cLossyConversion);
  23107. btCurrency:
  23108. if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
  23109. btIntSingle,btUIntSingle,
  23110. btLongWord,btLongint]) then
  23111. inc(Result,cLossyConversion);
  23112. else
  23113. RaiseNotYetImplemented(20170417205911,ErrorEl,BaseTypeNames[LBT]);
  23114. end;
  23115. end
  23116. else if LBT=btNil then
  23117. begin
  23118. if RaiseOnIncompatible then
  23119. RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
  23120. [],ErrorEl);
  23121. exit(cIncompatible);
  23122. end
  23123. else if LBT=btRange then
  23124. begin
  23125. if (LHS.ExprEl is TBinaryExpr) and (TBinaryExpr(LHS.ExprEl).Kind=pekRange) then
  23126. begin
  23127. LRange:=Eval(LHS.ExprEl,[refConst]);
  23128. RValue:=nil;
  23129. try
  23130. {$IFDEF VerbosePasResolver}
  23131. //writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString);
  23132. {$ENDIF}
  23133. case LRange.Kind of
  23134. revkRangeInt:
  23135. case TResEvalRangeInt(LRange).ElKind of
  23136. revskEnum:
  23137. if RHS.BaseType=btContext then
  23138. begin
  23139. if IsSameType(TResEvalRangeInt(LRange).ElType,RHS.LoTypeEl,prraAlias) then
  23140. begin
  23141. // same enum type
  23142. {$IFDEF VerbosePasResolver}
  23143. writeln('TPasResolver.CheckAssignResCompatibility LeftRange=',LRange.AsDebugString,' Left.ElType=',GetObjName(TResEvalRangeInt(LRange).ElType),' RHS.TypeEl=',GetObjName(RHS.LoTypeEl));
  23144. {$ENDIF}
  23145. // ToDo: check if LRange is smaller than Range of RHS (cLossyConversion)
  23146. exit(cExact);
  23147. end;
  23148. end;
  23149. revskInt:
  23150. if RHS.BaseType in btAllInteger then
  23151. begin
  23152. RValue:=Eval(RHS,[refAutoConstExt]);
  23153. if RValue<>nil then
  23154. begin
  23155. // ToDo: check range
  23156. end;
  23157. exit(cCompatible);
  23158. end;
  23159. revskChar:
  23160. if RHS.BaseType in btAllStringAndChars then
  23161. begin
  23162. RValue:=Eval(RHS,[refAutoConstExt]);
  23163. if RValue<>nil then
  23164. begin
  23165. case RValue.Kind of
  23166. {$ifdef FPC_HAS_CPSTRING}
  23167. revkString:
  23168. if not fExprEvaluator.GetWideChar(TResEvalString(RValue).S,wc) then
  23169. exit(cIncompatible);
  23170. {$endif}
  23171. revkUnicodeString:
  23172. begin
  23173. if length(TResEvalUTF16(RValue).S)<>1 then
  23174. exit(cIncompatible);
  23175. wc:=TResEvalUTF16(RValue).S[1];
  23176. end;
  23177. revkExternal:
  23178. exit(cCompatible);
  23179. else
  23180. RaiseNotYetImplemented(20171108192232,ErrorEl);
  23181. end;
  23182. if (ord(wc)<TResEvalRangeInt(LRange).RangeStart)
  23183. or (ord(wc)>TResEvalRangeInt(LRange).RangeEnd) then
  23184. exit(cIncompatible);
  23185. end;
  23186. exit(cCompatible);
  23187. end;
  23188. revskBool:
  23189. if RHS.BaseType=btBoolean then
  23190. begin
  23191. RValue:=Eval(RHS,[refAutoConstExt]);
  23192. if RValue<>nil then
  23193. begin
  23194. // ToDo: check range
  23195. end;
  23196. exit(cCompatible);
  23197. end;
  23198. end;
  23199. end;
  23200. finally
  23201. ReleaseEvalValue(LRange);
  23202. ReleaseEvalValue(RValue);
  23203. end;
  23204. end;
  23205. end
  23206. else if LBT=btSet then
  23207. begin
  23208. if RBT=btArrayOrSet then
  23209. begin
  23210. if RHS.SubType=btNone then
  23211. // a:=[]
  23212. Result:=cExact
  23213. else if IsSameType(LHS.HiTypeEl,RHS.HiTypeEl,prraSimple)
  23214. and HasExactType(RHS) then
  23215. Result:=cExact
  23216. else if LHS.SubType=RHS.SubType then
  23217. Result:=cAliasExact
  23218. else if (LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans) then
  23219. Result:=cCompatible
  23220. else if (LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger) then
  23221. begin
  23222. // ToDo: range check
  23223. Result:=cCompatible;
  23224. end
  23225. else if (LHS.SubType in btAllChars) and (RHS.SubType in btAllChars) then
  23226. begin
  23227. // ToDo: range check
  23228. Result:=cCompatible;
  23229. end;
  23230. end;
  23231. end
  23232. else if LBT in [btArrayLit,btArrayOrSet,btModule,btProc] then
  23233. begin
  23234. if RaiseOnIncompatible then
  23235. RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  23236. exit(cIncompatible);
  23237. end
  23238. else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
  23239. begin
  23240. if RaiseOnIncompatible then
  23241. RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
  23242. exit(cIncompatible);
  23243. end
  23244. else if RBT=btNil then
  23245. begin
  23246. if LBT=btPointer then
  23247. Result:=cExact
  23248. else if LBT=btContext then
  23249. begin
  23250. LTypeEl:=LHS.LoTypeEl;
  23251. C:=LTypeEl.ClassType;
  23252. if (C=TPasClassType)
  23253. or (C=TPasClassOfType)
  23254. or (C=TPasPointerType)
  23255. or C.InheritsFrom(TPasProcedureType)
  23256. or IsDynArray(LTypeEl) then
  23257. Result:=cExact;
  23258. end;
  23259. end
  23260. else if RBT=btProc then
  23261. begin
  23262. if (msDelphi in CurrentParser.CurrentModeswitches)
  23263. and (LHS.LoTypeEl is TPasProcedureType)
  23264. and (RHS.IdentEl is TPasProcedure) then
  23265. begin
  23266. // for example ProcVar:=Proc
  23267. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  23268. TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
  23269. exit(cExact);
  23270. end
  23271. else if (LHS.LoTypeEl is TPasProcedureType)
  23272. and (RHS.ExprEl is TProcedureExpr) then
  23273. begin
  23274. // for example ProcVar:=anonymous-procedure...
  23275. if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
  23276. TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
  23277. exit(cExact);
  23278. end
  23279. end
  23280. else if LBT=btPointer then
  23281. begin
  23282. if RBT=btPointer then
  23283. begin
  23284. LTypeEl:=LHS.LoTypeEl;
  23285. RTypeEl:=RHS.LoTypeEl;
  23286. if IsBaseType(LTypeEl,btPointer) then
  23287. Result:=cExact // btPointer can take any pointer
  23288. else if IsBaseType(RTypeEl,btPointer) then
  23289. Result:=cTypeConversion // any pointer can take a btPointer
  23290. else if IsSameType(LTypeEl,RTypeEl,prraAlias) then
  23291. Result:=cExact // pointer of same type
  23292. else if (LTypeEl.ClassType=TPasPointerType)
  23293. and (RTypeEl.ClassType=TPasPointerType) then
  23294. Result:=CheckAssignCompatibility(TPasPointerType(LTypeEl).DestType,
  23295. TPasPointerType(RTypeEl).DestType,RaiseOnIncompatible);
  23296. end
  23297. else if IsBaseType(LHS.LoTypeEl,btPointer) then
  23298. begin
  23299. // UntypedPointer:=...
  23300. if RBT=btContext then
  23301. begin
  23302. RTypeEl:=RHS.LoTypeEl;
  23303. C:=RTypeEl.ClassType;
  23304. if C=TPasClassType then
  23305. // UntypedPointer:=ClassTypeOrInstance
  23306. exit(cTypeConversion)
  23307. else if C=TPasClassOfType then
  23308. // UntypedPointer:=ClassOfVar
  23309. Result:=cTypeConversion
  23310. else if C=TPasArrayType then
  23311. begin
  23312. if IsDynArray(RTypeEl) then
  23313. // UntypedPointer:=DynArray
  23314. Result:=cTypeConversion;
  23315. end
  23316. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  23317. // UntypedPointer:=procvar
  23318. Result:=cLossyConversion
  23319. else if C=TPasPointerType then
  23320. // UntypedPointer:=TypedPointer
  23321. Result:=cExact;
  23322. end;
  23323. end;
  23324. end
  23325. else if (LBT=btContext) then
  23326. begin
  23327. LTypeEl:=LHS.LoTypeEl;
  23328. if (LTypeEl.ClassType=TPasArrayType) then
  23329. Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
  23330. else if LTypeEl.ClassType=TPasEnumType then
  23331. begin
  23332. if (RHS.BaseType=btRange) and (RHS.SubType=btContext) then
  23333. begin
  23334. RTypeEl:=RHS.LoTypeEl;
  23335. if RTypeEl.ClassType=TPasRangeType then
  23336. begin
  23337. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,RightSubResolved,[rcConstant]);
  23338. if (RightSubResolved.BaseType=btContext)
  23339. and IsSameType(LTypeEl,RightSubResolved.LoTypeEl,prraAlias) then
  23340. begin
  23341. // enumtype := enumrange
  23342. Result:=cExact;
  23343. end;
  23344. end;
  23345. end;
  23346. end
  23347. else if LTypeEl.ClassType=TPasRecordType then
  23348. begin
  23349. if (RBT in btAllStrings) and IsTGUID(TPasRecordType(LTypeEl))
  23350. and (rrfReadable in RHS.Flags) then
  23351. begin
  23352. // GUIDVar := string, e.g. IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}'
  23353. Value:=Eval(RHS,[refConstExt]);
  23354. try
  23355. if Value=nil then
  23356. if RaiseOnIncompatible then
  23357. RaiseXExpectedButYFound(20180414105916,'string literal','string', ErrorEl)
  23358. else
  23359. exit(cIncompatible);
  23360. finally
  23361. ReleaseEvalValue(Value);
  23362. end;
  23363. Result:=cStringToTGUID;
  23364. end;
  23365. end
  23366. else if LTypeEl.ClassType=TPasPointerType then
  23367. begin
  23368. // TypedPointer:=
  23369. if RHS.BaseType=btPointer then
  23370. begin
  23371. RTypeEl:=RHS.LoTypeEl;
  23372. if IsBaseType(RTypeEl,btPointer) then
  23373. // TypedPointer:=UntypedPointer
  23374. Result:=cTypeConversion
  23375. else
  23376. begin
  23377. // TypedPointer:=@Var
  23378. Result:=CheckAssignCompatibilityPointerType(
  23379. TPasPointerType(LTypeEl).DestType,RTypeEl,ErrorEl,false);
  23380. end;
  23381. end;
  23382. end;
  23383. end;
  23384. end;
  23385. if (Result>=0) and (Result<cIncompatible) then
  23386. begin
  23387. // type fits -> check readable
  23388. if not (rrfReadable in RHS.Flags) then
  23389. begin
  23390. if RaiseOnIncompatible then
  23391. begin
  23392. {$IFDEF VerbosePasResolver}
  23393. writeln('TPasResolver.CheckAssignResCompatibility RHS not readable. LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  23394. {$ENDIF}
  23395. RaiseVarExpected(20170318235637,ErrorEl,RHS.IdentEl);
  23396. end;
  23397. exit(cIncompatible);
  23398. end;
  23399. exit;
  23400. end;
  23401. // incompatible
  23402. {$IFDEF VerbosePasResolver}
  23403. writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
  23404. {$ENDIF}
  23405. if not RaiseOnIncompatible then
  23406. exit(cIncompatible);
  23407. // create error messages
  23408. RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
  23409. [],RHS,LHS,ErrorEl);
  23410. end;
  23411. function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
  23412. ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
  23413. ): integer;
  23414. // check if the RightResolved is type compatible to LeftResolved
  23415. var
  23416. LFlags, RFlags: TPasResolverComputeFlags;
  23417. LeftResolved, RightResolved: TPasResolverResult;
  23418. LeftErrorEl, RightErrorEl: TPasElement;
  23419. begin
  23420. Result:=cIncompatible;
  23421. // Delphi resolves both sides, so it forbids "if procvar=procvar then"
  23422. // FPC is more clever. It supports "if procvar=@proc then", "function=value"
  23423. if msDelphi in CurrentParser.CurrentModeswitches then
  23424. LFlags:=[]
  23425. else
  23426. LFlags:=[rcNoImplicitProcType];
  23427. if SetReferenceFlags then
  23428. Include(LFlags,rcSetReferenceFlags);
  23429. ComputeElement(Left,LeftResolved,LFlags);
  23430. if (msDelphi in CurrentParser.CurrentModeswitches) then
  23431. RFlags:=LFlags
  23432. else
  23433. begin
  23434. if LeftResolved.BaseType=btNil then
  23435. RFlags:=[rcNoImplicitProcType]
  23436. else if IsProcedureType(LeftResolved,true) then
  23437. RFlags:=[rcNoImplicitProcType]
  23438. else
  23439. RFlags:=[];
  23440. end;
  23441. if SetReferenceFlags then
  23442. Include(RFlags,rcSetReferenceFlags);
  23443. {$IFDEF VerbosePasResolver}
  23444. writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
  23445. {$ENDIF}
  23446. ComputeElement(Right,RightResolved,RFlags);
  23447. if ErrorEl=nil then
  23448. begin
  23449. LeftErrorEl:=Left;
  23450. RightErrorEl:=Right;
  23451. end
  23452. else
  23453. begin
  23454. LeftErrorEl:=ErrorEl;
  23455. RightErrorEl:=ErrorEl;
  23456. end;
  23457. Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
  23458. RaiseOnIncompatible,RightErrorEl);
  23459. end;
  23460. function TPasResolver.CheckEqualResCompatibility(const LHS,
  23461. RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
  23462. RErrorEl: TPasElement): integer;
  23463. var
  23464. LTypeEl, RTypeEl: TPasType;
  23465. ResolvedEl: TPasResolverResult;
  23466. begin
  23467. Result:=cIncompatible;
  23468. if RErrorEl=nil then RErrorEl:=LErrorEl;
  23469. // check if the RHS is type compatible to LHS
  23470. {$IFDEF VerbosePasResolver}
  23471. writeln('TPasResolver.CheckEqualResCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  23472. {$ENDIF}
  23473. if not (rrfReadable in LHS.Flags) then
  23474. begin
  23475. if (LHS.BaseType=btContext) then
  23476. begin
  23477. LTypeEl:=LHS.LoTypeEl;
  23478. if (LTypeEl.ClassType=TPasClassType)
  23479. and (ResolveAliasTypeEl(LHS.IdentEl)=LTypeEl) then
  23480. begin
  23481. // LHS is class type, e.g. TObject or IInterface
  23482. if RHS.BaseType=btNil then
  23483. exit(cExact)
  23484. else if RHS.BaseType in btAllStrings then
  23485. begin
  23486. if (rrfReadable in RHS.Flags)
  23487. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  23488. and IsTGUIDString(RHS) then
  23489. // e.g. IUnknown=aGUIDString
  23490. exit(cInterfaceToString);
  23491. end
  23492. else if (RHS.BaseType=btContext) then
  23493. begin
  23494. RTypeEl:=RHS.LoTypeEl;
  23495. if (RTypeEl.ClassType=TPasClassOfType)
  23496. and (rrfReadable in RHS.Flags)
  23497. and (TPasClassType(LTypeEl).ObjKind=okClass) then
  23498. // for example if TImage=ImageClass then
  23499. exit(cExact)
  23500. else if (RTypeEl.ClassType=TPasRecordType)
  23501. and (rrfReadable in RHS.Flags)
  23502. and (TPasClassType(LTypeEl).ObjKind=okInterface)
  23503. and IsTGUID(TPasRecordType(RTypeEl)) then
  23504. // e.g. if IUnknown=TGuidVar then
  23505. exit(cInterfaceToTGUID);
  23506. end;
  23507. end;
  23508. end;
  23509. RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
  23510. end;
  23511. if not (rrfReadable in RHS.Flags) then
  23512. begin
  23513. if (RHS.BaseType=btContext) then
  23514. begin
  23515. RTypeEl:=RHS.LoTypeEl;
  23516. if (RTypeEl.ClassType=TPasClassType)
  23517. and (ResolveAliasTypeEl(RHS.IdentEl)=RTypeEl) then
  23518. begin
  23519. // RHS is class type, e.g. TObject or IInterface
  23520. if LHS.BaseType=btNil then
  23521. exit(cExact)
  23522. else if LHS.BaseType in btAllStrings then
  23523. begin
  23524. if (rrfReadable in LHS.Flags)
  23525. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  23526. and IsTGUIDString(LHS) then
  23527. // e.g. aGUIDString=IUnknown
  23528. exit(cInterfaceToString);
  23529. end
  23530. else if (LHS.BaseType=btContext) then
  23531. begin
  23532. LTypeEl:=LHS.LoTypeEl;
  23533. if (LTypeEl.ClassType=TPasClassOfType)
  23534. and (rrfReadable in LHS.Flags)
  23535. and (TPasClassType(RTypeEl).ObjKind=okClass) then
  23536. // for example if ImageClass=TImage then
  23537. exit(cExact)
  23538. else if (LTypeEl.ClassType=TPasRecordType)
  23539. and (rrfReadable in LHS.Flags)
  23540. and (TPasClassType(RTypeEl).ObjKind=okInterface)
  23541. and IsTGUID(TPasRecordType(LTypeEl)) then
  23542. // e.g. if TGuidVar=IUnknown then
  23543. exit(cInterfaceToTGUID);
  23544. end;
  23545. end;
  23546. end;
  23547. RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
  23548. end;
  23549. if IsGenericTemplType(LHS) then
  23550. begin
  23551. // TemplateVar = x
  23552. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(LHS.LoTypeEl),RHS,prtcoEqual,nil);
  23553. if Result<>cIncompatible then exit;
  23554. end
  23555. else if IsGenericTemplType(RHS) then
  23556. begin
  23557. // x = TemplateVar
  23558. Result:=CheckTemplateFitsParamRes(TPasGenericTemplateType(RHS.LoTypeEl),LHS,prtcoEqual,nil);
  23559. if Result<>cIncompatible then exit;
  23560. end;
  23561. if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
  23562. begin
  23563. Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
  23564. if (Result=cIncompatible) and RaiseOnIncompatible then
  23565. RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
  23566. [],RHS,LHS,LErrorEl);
  23567. exit;
  23568. end
  23569. else if LHS.BaseType=RHS.BaseType then
  23570. begin
  23571. if LHS.BaseType=btContext then
  23572. exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
  23573. else
  23574. exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
  23575. end
  23576. else if LHS.BaseType in btAllInteger then
  23577. begin
  23578. if RHS.BaseType in btAllInteger+btAllFloats then
  23579. exit(cCompatible)
  23580. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  23581. exit(cCompatible);
  23582. end
  23583. else if LHS.BaseType in btAllFloats then
  23584. begin
  23585. if RHS.BaseType in btAllInteger+btAllFloats then
  23586. exit(cCompatible);
  23587. end
  23588. else if LHS.BaseType in btAllBooleans then
  23589. begin
  23590. if RHS.BaseType in btAllBooleans then
  23591. exit(cCompatible)
  23592. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  23593. exit(cCompatible);
  23594. end
  23595. else if LHS.BaseType in btAllStringAndChars then
  23596. begin
  23597. if RHS.BaseType in btAllStringAndChars then
  23598. exit(cCompatible)
  23599. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  23600. exit(cCompatible)
  23601. else if RHS.BaseType=btContext then
  23602. begin
  23603. RTypeEl:=RHS.LoTypeEl;
  23604. if (RTypeEl.ClassType=TPasClassType) then
  23605. begin
  23606. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  23607. and IsTGUIDString(LHS) then
  23608. // e.g. aGUIDString=IntfVar
  23609. exit(cInterfaceToString);
  23610. end
  23611. else if (RTypeEl.ClassType=TPasRecordType)
  23612. and IsTGUID(TPasRecordType(RTypeEl)) then
  23613. // e.g. aString=GuidVar
  23614. exit(cTGUIDToString);
  23615. end;
  23616. end
  23617. else if LHS.BaseType=btNil then
  23618. begin
  23619. if RHS.BaseType in [btPointer,btNil] then
  23620. exit(cExact)
  23621. else if RHS.BaseType=btContext then
  23622. begin
  23623. LTypeEl:=RHS.LoTypeEl;
  23624. if (LTypeEl.ClassType=TPasClassType)
  23625. or (LTypeEl.ClassType=TPasClassOfType)
  23626. or (LTypeEl.ClassType=TPasPointerType)
  23627. or (LTypeEl is TPasProcedureType)
  23628. or IsDynArray(LTypeEl) then
  23629. exit(cExact);
  23630. end;
  23631. if RaiseOnIncompatible then
  23632. RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
  23633. [],RHS,LHS,RErrorEl)
  23634. else
  23635. exit(cIncompatible);
  23636. end
  23637. else if RHS.BaseType=btNil then
  23638. begin
  23639. if LHS.BaseType=btPointer then
  23640. exit(cExact)
  23641. else if LHS.BaseType=btContext then
  23642. begin
  23643. LTypeEl:=LHS.LoTypeEl;
  23644. if (LTypeEl.ClassType=TPasClassType)
  23645. or (LTypeEl.ClassType=TPasClassOfType)
  23646. or (LTypeEl.ClassType=TPasPointerType)
  23647. or (LTypeEl is TPasProcedureType)
  23648. or IsDynArray(LTypeEl) then
  23649. exit(cExact);
  23650. end;
  23651. if RaiseOnIncompatible then
  23652. RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
  23653. [],RHS,LHS,LErrorEl)
  23654. else
  23655. exit(cIncompatible);
  23656. end
  23657. else if LHS.BaseType=btPointer then
  23658. begin
  23659. if RHS.BaseType=btContext then
  23660. begin
  23661. RTypeEl:=RHS.LoTypeEl;
  23662. if RTypeEl.ClassType=TPasPointerType then
  23663. // @Something=TypedPointer
  23664. exit(cExact)
  23665. else if RTypeEl.ClassType=TPasClassType then
  23666. // @Something=ClassOrInterface
  23667. exit(cCompatible)
  23668. else if RTypeEl.ClassType=TPasClassOfType then
  23669. // @Something=ClassOf
  23670. exit(cCompatible);
  23671. end;
  23672. end
  23673. else if LHS.BaseType in [btSet,btArrayOrSet] then
  23674. begin
  23675. if RHS.BaseType in [btSet,btArrayOrSet] then
  23676. begin
  23677. if LHS.LoTypeEl=nil then
  23678. exit(cExact); // empty set
  23679. if RHS.LoTypeEl=nil then
  23680. exit(cExact); // empty set
  23681. if IsSameType(LHS.LoTypeEl,RHS.LoTypeEl,prraAlias) then
  23682. exit(cExact);
  23683. if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+btAllChars)) then
  23684. exit(cExact);
  23685. if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
  23686. or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
  23687. exit(cCompatible);
  23688. if RaiseOnIncompatible then
  23689. RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  23690. ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
  23691. else
  23692. exit(cIncompatible);
  23693. end;
  23694. end
  23695. else if LHS.BaseType=btRange then
  23696. begin
  23697. if LHS.SubType in btAllInteger then
  23698. begin
  23699. // e.g. 2..4
  23700. if RHS.BaseType in btAllInteger then
  23701. exit(cCompatible)
  23702. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllInteger) then
  23703. exit(cCompatible);
  23704. end
  23705. else if LHS.SubType in btAllBooleans then
  23706. begin
  23707. if RHS.BaseType in btAllBooleans then
  23708. exit(cCompatible)
  23709. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllBooleans) then
  23710. exit(cCompatible);
  23711. end
  23712. else if LHS.SubType in btAllChars then
  23713. begin
  23714. if RHS.BaseType in btAllStringAndChars then
  23715. exit(cCompatible)
  23716. else if (RHS.BaseType=btRange) and (RHS.SubType in btAllChars) then
  23717. exit(cCompatible);
  23718. end
  23719. else if LHS.SubType=btContext then
  23720. begin
  23721. LTypeEl:=LHS.LoTypeEl;
  23722. if LTypeEl.ClassType=TPasRangeType then
  23723. begin
  23724. ComputeElement(TPasRangeType(LTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  23725. if ResolvedEl.BaseType=btContext then
  23726. begin
  23727. LTypeEl:=ResolvedEl.LoTypeEl;
  23728. if LTypeEl.ClassType=TPasEnumType then
  23729. begin
  23730. if RHS.BaseType=btContext then
  23731. begin
  23732. RTypeEl:=RHS.LoTypeEl;
  23733. if (LTypeEl=RTypeEl) then
  23734. exit(cCompatible);
  23735. end;
  23736. end;
  23737. end;
  23738. end;
  23739. end;
  23740. end
  23741. else if LHS.BaseType=btContext then
  23742. begin
  23743. LTypeEl:=LHS.LoTypeEl;
  23744. if LTypeEl.ClassType=TPasEnumType then
  23745. begin
  23746. if RHS.BaseType=btRange then
  23747. begin
  23748. RTypeEl:=RHS.LoTypeEl;
  23749. if RTypeEl.ClassType=TPasRangeType then
  23750. begin
  23751. ComputeElement(TPasRangeType(RTypeEl).RangeExpr.left,ResolvedEl,[rcConstant]);
  23752. if ResolvedEl.BaseType=btContext then
  23753. begin
  23754. RTypeEl:=ResolvedEl.LoTypeEl;
  23755. if LTypeEl=RTypeEl then
  23756. exit(cCompatible);
  23757. end;
  23758. end;
  23759. end;
  23760. end
  23761. else if LTypeEl.ClassType=TPasClassType then
  23762. begin
  23763. if RHS.BaseType=btPointer then
  23764. exit(cCompatible)
  23765. else if TPasClassType(LTypeEl).ObjKind=okInterface then
  23766. begin
  23767. if RHS.BaseType in btAllStrings then
  23768. begin
  23769. if IsTGUIDString(RHS) then
  23770. // e.g. IntfVar=aGUIDString
  23771. exit(cInterfaceToString);
  23772. end
  23773. else if RHS.BaseType=btContext then
  23774. begin
  23775. RTypeEl:=RHS.LoTypeEl;
  23776. if (RTypeEl.ClassType=TPasRecordType)
  23777. and IsTGUID(TPasRecordType(RTypeEl)) then
  23778. // e.g. IntfVar=GuidVar
  23779. exit(cInterfaceToTGUID);
  23780. end;
  23781. end;
  23782. end
  23783. else if LTypeEl.ClassType=TPasClassOfType then
  23784. begin
  23785. if RHS.BaseType=btPointer then
  23786. exit(cCompatible);
  23787. end
  23788. else if LTypeEl.ClassType=TPasRecordType then
  23789. begin
  23790. if IsTGUID(TPasRecordType(LTypeEl)) then
  23791. begin
  23792. // LHS is TGUID
  23793. if (RHS.BaseType in btAllStrings) then
  23794. // GuidVar=aString
  23795. exit(cTGUIDToString)
  23796. else if RHS.BaseType=btContext then
  23797. begin
  23798. RTypeEl:=RHS.LoTypeEl;
  23799. if (RTypeEl.ClassType=TPasClassType)
  23800. and (TPasClassType(RTypeEl).ObjKind=okInterface) then
  23801. // GUIDVar=IntfVar
  23802. exit(cInterfaceToTGUID);
  23803. end;
  23804. end;
  23805. end
  23806. else if LTypeEl.ClassType=TPasPointerType then
  23807. begin
  23808. if RHS.BaseType=btPointer then
  23809. // TypedPointer=@Something
  23810. exit(cExact);
  23811. end;
  23812. end;
  23813. if RaiseOnIncompatible then
  23814. RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
  23815. [],RHS,LHS,RErrorEl)
  23816. else
  23817. exit(cIncompatible);
  23818. end;
  23819. function TPasResolver.IsVariableConst(El, PosEl: TPasElement;
  23820. RaiseIfConst: boolean): boolean;
  23821. var
  23822. CurEl: TPasElement;
  23823. VarResolved: TPasResolverResult;
  23824. Loop: TPasImplForLoop;
  23825. begin
  23826. Result:=false;
  23827. CurEl:=PosEl;
  23828. while CurEl<>nil do
  23829. begin
  23830. if (CurEl.ClassType=TPasImplForLoop) then
  23831. begin
  23832. Loop:=TPasImplForLoop(CurEl);
  23833. if (Loop.VariableName<>PosEl) then
  23834. begin
  23835. ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
  23836. if VarResolved.IdentEl=El then
  23837. begin
  23838. if RaiseIfConst then
  23839. RaiseMsg(20180430100719,nIllegalAssignmentToForLoopVar,
  23840. sIllegalAssignmentToForLoopVar,[El.Name],PosEl);
  23841. exit(true);
  23842. end;
  23843. end;
  23844. end;
  23845. CurEl:=CurEl.Parent;
  23846. end;
  23847. end;
  23848. function TPasResolver.ResolvedElCanBeVarParam(
  23849. const ResolvedEl: TPasResolverResult; PosEl: TPasElement;
  23850. RaiseIfConst: boolean): boolean;
  23851. function NotLocked(El: TPasElement): boolean;
  23852. begin
  23853. Result:=not IsVariableConst(El,PosEl,RaiseIfConst);
  23854. end;
  23855. var
  23856. IdentEl: TPasElement;
  23857. begin
  23858. Result:=false;
  23859. if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
  23860. exit;
  23861. if ResolvedEl.IdentEl=nil then
  23862. exit(true);
  23863. IdentEl:=ResolvedEl.IdentEl;
  23864. if IdentEl.ClassType=TPasVariable then
  23865. exit(NotLocked(IdentEl));
  23866. if (IdentEl.ClassType=TPasConst) then
  23867. begin
  23868. if TPasConst(IdentEl).IsConst then
  23869. begin
  23870. if RaiseIfConst then
  23871. RaiseMsg(20180430100719,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  23872. exit(false);
  23873. end;
  23874. exit(NotLocked(IdentEl));
  23875. end;
  23876. if (IdentEl.ClassType=TPasArgument) then
  23877. begin
  23878. if TPasArgument(IdentEl).Access in [argConst,argConstRef] then
  23879. begin
  23880. if RaiseIfConst then
  23881. RaiseMsg(20180430100843,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
  23882. exit(false);
  23883. end;
  23884. Result:=(TPasArgument(IdentEl).Access in [argDefault, argVar, argOut]);
  23885. exit(Result and NotLocked(IdentEl));
  23886. end;
  23887. if IdentEl.ClassType=TPasResultElement then
  23888. exit(NotLocked(IdentEl));
  23889. if (proPropertyAsVarParam in Options)
  23890. and (IdentEl.ClassType=TPasProperty) then
  23891. exit(NotLocked(IdentEl));
  23892. end;
  23893. function TPasResolver.ResolvedElIsClassOrRecordInstance(
  23894. const ResolvedEl: TPasResolverResult): boolean;
  23895. var
  23896. TypeEl: TPasType;
  23897. begin
  23898. Result:=false;
  23899. if ResolvedEl.BaseType<>btContext then exit;
  23900. TypeEl:=ResolvedEl.LoTypeEl;
  23901. if TypeEl=nil then exit;
  23902. if TypeEl.ClassType=TPasClassType then
  23903. begin
  23904. if TPasClassType(TypeEl).ObjKind<>okClass then exit;
  23905. end
  23906. else if TypeEl.ClassType=TPasRecordType then
  23907. else
  23908. exit;
  23909. if (ResolvedEl.IdentEl is TPasVariable)
  23910. or (ResolvedEl.IdentEl.ClassType=TPasArgument)
  23911. or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
  23912. exit(true);
  23913. end;
  23914. function TPasResolver.GetResolver(El: TPasElement): TPasResolver;
  23915. var
  23916. Module: TPasModule;
  23917. Scope: TPasModuleScope;
  23918. begin
  23919. Result:=nil;
  23920. if El=nil then exit;
  23921. Module:=El.GetModule;
  23922. if Module=nil then exit;
  23923. Scope:=Module.CustomData as TPasModuleScope;
  23924. if Scope=nil then exit;
  23925. Result:=Scope.Owner as TPasResolver;
  23926. end;
  23927. function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
  23928. ): boolean;
  23929. begin
  23930. Result:=ms in GetElModeSwitches(El);
  23931. end;
  23932. function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
  23933. var
  23934. C: TClass;
  23935. begin
  23936. while El<>nil do
  23937. begin
  23938. if El.CustomData<>nil then
  23939. begin
  23940. C:=El.CustomData.ClassType;
  23941. if C.InheritsFrom(TPasProcedureScope) then
  23942. exit(TPasProcedureScope(El.CustomData).ModeSwitches)
  23943. else if C.InheritsFrom(TPasSectionScope) then
  23944. exit(TPasSectionScope(El.CustomData).ModeSwitches);
  23945. end;
  23946. El:=El.Parent;
  23947. end;
  23948. Result:=CurrentParser.CurrentModeswitches;
  23949. end;
  23950. function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
  23951. ): boolean;
  23952. begin
  23953. Result:=bs in GetElBoolSwitches(El);
  23954. end;
  23955. function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
  23956. var
  23957. C: TClass;
  23958. begin
  23959. Result:=CurrentParser.Scanner.CurrentBoolSwitches;
  23960. while El<>nil do
  23961. begin
  23962. if El.CustomData<>nil then
  23963. begin
  23964. C:=El.CustomData.ClassType;
  23965. if C.InheritsFrom(TPasProcedureScope) then
  23966. exit(TPasProcedureScope(El.CustomData).BoolSwitches)
  23967. else if C.InheritsFrom(TPasSectionScope) then
  23968. exit(TPasSectionScope(El.CustomData).BoolSwitches)
  23969. else if C.InheritsFrom(TPasModuleScope) then
  23970. exit(TPasModuleScope(El.CustomData).BoolSwitches);
  23971. end;
  23972. El:=El.Parent;
  23973. end;
  23974. end;
  23975. function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
  23976. Flags: TPRProcTypeDescFlags): string;
  23977. var
  23978. Args, Templates: TFPList;
  23979. i: Integer;
  23980. Arg: TPasArgument;
  23981. ArgType: TPasType;
  23982. Proc: TPasProcedure;
  23983. begin
  23984. if ProcType=nil then exit('nil');
  23985. Result:=ProcType.TypeName;
  23986. if ProcType.IsReferenceTo then
  23987. Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
  23988. if ProcType.Parent is TPasProcedure then
  23989. begin
  23990. Proc:=TPasProcedure(ProcType.Parent);
  23991. if (prptdUseName in Flags) then
  23992. begin
  23993. if prptdAddPaths in Flags then
  23994. Result:=Result+' '+Proc.FullName
  23995. else
  23996. Result:=Result+' '+Proc.Name;
  23997. end;
  23998. Templates:=GetProcTemplateTypes(Proc);
  23999. if Templates<>nil then
  24000. Result:=Result+GetGenericParamCommas(Templates.Count);
  24001. end;
  24002. Args:=ProcType.Args;
  24003. if Args.Count>0 then
  24004. begin
  24005. Result:=Result+'(';
  24006. for i:=0 to Args.Count-1 do
  24007. begin
  24008. if i>0 then Result:=Result+';';
  24009. Arg:=TPasArgument(Args[i]);
  24010. if AccessNames[Arg.Access]<>'' then
  24011. Result:=Result+AccessNames[Arg.Access];
  24012. if Arg.ArgType=nil then
  24013. Result:=Result+'untyped'
  24014. else
  24015. begin
  24016. ArgType:=Arg.ArgType;
  24017. if prptdResolveSimpleAlias in Flags then
  24018. ArgType:=ResolveSimpleAliasType(ArgType);
  24019. Result:=Result+GetTypeDescription(ArgType,prptdAddPaths in Flags);
  24020. end;
  24021. end;
  24022. Result:=Result+')';
  24023. end;
  24024. if ProcType.IsOfObject then
  24025. Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
  24026. if ProcType.IsNested then
  24027. Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
  24028. if cCallingConventions[ProcType.CallingConvention]<>'' then
  24029. Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
  24030. end;
  24031. function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
  24032. OnlyType: boolean): string;
  24033. function GetSubTypeName: string;
  24034. begin
  24035. if (T.LoTypeEl<>nil) and (T.LoTypeEl.Name<>'') then
  24036. Result:=T.LoTypeEl.Name
  24037. else
  24038. Result:=BaseTypeNames[T.SubType];
  24039. end;
  24040. var
  24041. ArrayEl: TPasArrayType;
  24042. begin
  24043. case T.BaseType of
  24044. btModule: exit(GetElementTypeName(T.IdentEl)+' '+T.IdentEl.Name);
  24045. btNil: exit('nil');
  24046. btRange:
  24047. Result:='range of '+GetSubTypeName;
  24048. btSet:
  24049. Result:='set of '+GetSubTypeName;
  24050. btArrayLit:
  24051. Result:='array of '+GetSubTypeName;
  24052. btArrayOrSet:
  24053. Result:='set/array literal of '+GetSubTypeName;
  24054. btContext:
  24055. begin
  24056. if T.LoTypeEl.ClassType=TPasClassOfType then
  24057. Result:='class of '+TPasClassOfType(T.LoTypeEl).DestType.Name
  24058. else if T.LoTypeEl.ClassType=TPasAliasType then
  24059. Result:=TPasAliasType(T.LoTypeEl).DestType.Name
  24060. else if T.LoTypeEl.ClassType=TPasTypeAliasType then
  24061. Result:='type '+TPasAliasType(T.LoTypeEl).DestType.Name
  24062. else if T.LoTypeEl.ClassType=TPasArrayType then
  24063. begin
  24064. ArrayEl:=TPasArrayType(T.LoTypeEl);
  24065. if length(ArrayEl.Ranges)=0 then
  24066. begin
  24067. if ArrayEl.ElType=nil then
  24068. Result:='array of const'
  24069. else
  24070. begin
  24071. Result:='array of '+ArrayEl.ElType.Name;
  24072. if IsOpenArray(ArrayEl) then
  24073. Result:='open '+Result;
  24074. end;
  24075. end
  24076. else
  24077. Result:='static array[] of '+ArrayEl.ElType.Name;
  24078. end
  24079. else if T.LoTypeEl is TPasProcedureType then
  24080. Result:=GetProcTypeDescription(TPasProcedureType(T.LoTypeEl),[])
  24081. else if T.LoTypeEl.Name<>'' then
  24082. Result:=T.LoTypeEl.Name
  24083. else
  24084. Result:=T.LoTypeEl.ElementTypeName;
  24085. end;
  24086. btCustom:
  24087. Result:=T.LoTypeEl.Name;
  24088. else
  24089. Result:=BaseTypeNames[T.BaseType];
  24090. end;
  24091. if (not OnlyType) and (T.LoTypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
  24092. Result:=T.IdentEl.Name+':'+Result;
  24093. end;
  24094. function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
  24095. function GetName: string;
  24096. var
  24097. s: String;
  24098. Spec: TPasSpecializeType;
  24099. P: TPasElement;
  24100. i: Integer;
  24101. GenScope: TPasGenericScope;
  24102. Params: TPasTypeArray;
  24103. begin
  24104. Result:=aType.Name;
  24105. if Result='' then
  24106. begin
  24107. if aType is TPasArrayType then
  24108. begin
  24109. if length(TPasArrayType(aType).Ranges)>0 then
  24110. Result:='static array'
  24111. else if TPasArrayType(aType).ElType=nil then
  24112. Result:='array of const'
  24113. else if IsOpenArray(aType) then
  24114. Result:='open array'
  24115. else
  24116. Result:='dynamic array';
  24117. end
  24118. else if aType is TPasSpecializeType then
  24119. begin
  24120. Spec:=TPasSpecializeType(aType);
  24121. if Spec.CustomData is TPasSpecializeTypeData then
  24122. exit(GetTypeDescription(TPasSpecializeTypeData(Spec.CustomData).SpecializedType));
  24123. Result:=GetTypeDescription(Spec.DestType,true)+'<';
  24124. for i:=0 to Spec.Params.Count-1 do
  24125. begin
  24126. P:=TPasElement(Spec.Params[i]);
  24127. if P is TPasType then
  24128. Result:=Result+GetTypeDescription(TPasType(P));
  24129. if i>0 then
  24130. Result:=Result+',';
  24131. end;
  24132. Result:=Result+'>';
  24133. end
  24134. else
  24135. Result:=GetElementTypeName(aType);
  24136. end
  24137. else if aType is TPasGenericType then
  24138. begin
  24139. i:=GetTypeParameterCount(TPasGenericType(aType));
  24140. if i>0 then
  24141. // generic, not specialized
  24142. Result:=Result+GetGenericParamCommas(GetTypeParameterCount(TPasGenericType(aType)))
  24143. else if aType.CustomData is TPasGenericScope then
  24144. begin
  24145. GenScope:=TPasGenericScope(aType.CustomData);
  24146. if (GenScope.SpecializedFromItem<>nil) and IsValidIdent(aType.Name) then
  24147. begin
  24148. // specialized without params in name -> append params
  24149. Params:=GenScope.SpecializedFromItem.Params;
  24150. Result:=Result+'<';
  24151. for i:=0 to length(Params)-1 do
  24152. begin
  24153. Result:=Result+GetTypeDescription(Params[i],AddPath);
  24154. if i>0 then
  24155. Result:=Result+',';
  24156. end;
  24157. Result:=Result+'>';
  24158. end
  24159. end;
  24160. end;
  24161. if AddPath then
  24162. begin
  24163. s:=aType.ParentPath;
  24164. if (s<>'') and (s<>'.') then
  24165. Result:=s+'.'+Result;
  24166. end;
  24167. end;
  24168. begin
  24169. if aType=nil then exit('untyped');
  24170. Result:=GetName;
  24171. if (aType.ClassType=TPasUnresolvedSymbolRef) then
  24172. begin
  24173. if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
  24174. Result:=Result+'()';
  24175. exit;
  24176. end;
  24177. end;
  24178. function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
  24179. AddPath: boolean): string;
  24180. var
  24181. s: String;
  24182. begin
  24183. Result:=GetTypeDescription(R.LoTypeEl,AddPath);
  24184. if R.BaseType in [btSet,btArrayLit,btArrayOrSet] then
  24185. Result:=BaseTypeNames[R.BaseType]+' of '+Result;
  24186. if (R.LoTypeEl<>nil) and (R.IdentEl=R.LoTypeEl) then
  24187. begin
  24188. s:=GetElementTypeName(R.LoTypeEl);
  24189. if s<>'' then
  24190. Result:=s+' '+Result
  24191. else
  24192. Result:='type '+Result;
  24193. end;
  24194. end;
  24195. function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
  24196. AddPath: boolean): string;
  24197. begin
  24198. if R.BaseType=btContext then
  24199. Result:=GetTypeDescription(R,AddPath)
  24200. else if (R.BaseType=btPointer) and not IsBaseType(R.LoTypeEl,btPointer) then
  24201. Result:='^'+GetTypeDescription(R,AddPath)
  24202. else
  24203. Result:=BaseTypeNames[R.BaseType];
  24204. end;
  24205. function TPasResolver.GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
  24206. var
  24207. Scope: TPasProcedureScope;
  24208. Body: TPasImplBlock;
  24209. begin
  24210. Result:=nil;
  24211. if Proc=nil then exit;
  24212. if Proc.Body<>nil then
  24213. Body:=Proc.Body.Body
  24214. else
  24215. Body:=nil;
  24216. if Body=nil then
  24217. begin
  24218. if Proc.CustomData=nil then exit;
  24219. Scope:=Proc.CustomData as TPasProcedureScope;
  24220. Proc:=Scope.ImplProc;
  24221. if Proc=nil then exit;
  24222. if Proc.Body=nil then exit;
  24223. Body:=Proc.Body.Body;
  24224. if Body=nil then exit;
  24225. end;
  24226. if Body.Elements=nil then exit;
  24227. if Body.Elements.Count=0 then exit;
  24228. Result:=TPasImplElement(Body.Elements[0]);
  24229. end;
  24230. function TPasResolver.GetProcTemplateTypes(Proc: TPasProcedure): TFPList;
  24231. var
  24232. NameParts: TProcedureNamePart;
  24233. begin
  24234. if Proc.NameParts=nil then
  24235. exit(nil);
  24236. NameParts:=TProcedureNamePart(Proc.NameParts[Proc.NameParts.Count-1]);
  24237. Result:=NameParts.Templates;
  24238. if (Result<>nil) and (Result.Count=0) then
  24239. exit(nil);
  24240. end;
  24241. function TPasResolver.GetProcName(Proc: TPasProcedure; WithTemplates: boolean
  24242. ): string;
  24243. var
  24244. NameParts: TProcedureNameParts;
  24245. i, j: Integer;
  24246. NamePart: TProcedureNamePart;
  24247. TemplType: TPasGenericTemplateType;
  24248. Templates: TFPList;
  24249. begin
  24250. if Proc=nil then exit('(nil)');
  24251. Result:=Proc.Name;
  24252. if WithTemplates then
  24253. begin
  24254. NameParts:=Proc.NameParts;
  24255. if NameParts=nil then exit;
  24256. Result:='';
  24257. for i:=0 to NameParts.Count-1 do
  24258. begin
  24259. NamePart:=TProcedureNamePart(NameParts[i]);
  24260. if i>0 then
  24261. Result:=Result+'.';
  24262. Result:=Result+NamePart.Name;
  24263. Templates:=NamePart.Templates;
  24264. if (Templates<>nil) and (Templates.Count>0) then
  24265. begin
  24266. for j:=0 to Templates.Count-1 do
  24267. begin
  24268. TemplType:=TPasGenericTemplateType(NamePart.Templates[j]);
  24269. if j=0 then
  24270. Result:=Result+'<'
  24271. else
  24272. Result:=Result+',';
  24273. Result:=Result+TemplType.Name;
  24274. end;
  24275. Result:=Result+'>';
  24276. end;
  24277. end;
  24278. end;
  24279. end;
  24280. function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
  24281. WithRedeclarations: boolean): TPasProperty;
  24282. begin
  24283. Result:=nil;
  24284. if El=nil then exit;
  24285. if (not WithRedeclarations) and (El.VarType<>nil) then exit;
  24286. if El.CustomData=nil then exit;
  24287. Result:=TPasPropertyScope(El.CustomData).AncestorProp;
  24288. end;
  24289. function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
  24290. begin
  24291. Result:=nil;
  24292. while El<>nil do
  24293. begin
  24294. if El.VarType<>nil then
  24295. exit(El.VarType);
  24296. El:=GetPasPropertyAncestor(El);
  24297. end;
  24298. end;
  24299. function TPasResolver.GetPasPropertyArgs(El: TPasProperty): TFPList;
  24300. begin
  24301. while El<>nil do
  24302. begin
  24303. if El.VarType<>nil then
  24304. exit(El.Args);
  24305. El:=GetPasPropertyAncestor(El);
  24306. end;
  24307. Result:=nil;
  24308. end;
  24309. function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
  24310. // search the member variable or getter function of a property
  24311. var
  24312. DeclEl: TPasElement;
  24313. begin
  24314. Result:=nil;
  24315. while El<>nil do
  24316. begin
  24317. if El.ReadAccessor<>nil then
  24318. begin
  24319. DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
  24320. Result:=DeclEl;
  24321. exit;
  24322. end;
  24323. El:=GetPasPropertyAncestor(El);
  24324. end;
  24325. end;
  24326. function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
  24327. // search the member variable or setter procedure of a property
  24328. var
  24329. DeclEl: TPasElement;
  24330. begin
  24331. Result:=nil;
  24332. while El<>nil do
  24333. begin
  24334. if El.WriteAccessor<>nil then
  24335. begin
  24336. DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
  24337. Result:=DeclEl;
  24338. exit;
  24339. end;
  24340. El:=GetPasPropertyAncestor(El);
  24341. end;
  24342. end;
  24343. function TPasResolver.GetPasPropertyIndex(El: TPasProperty): TPasExpr;
  24344. // search the index expression of a property
  24345. begin
  24346. Result:=nil;
  24347. while El<>nil do
  24348. begin
  24349. if El.IndexExpr<>nil then
  24350. begin
  24351. Result:=El.IndexExpr;
  24352. exit;
  24353. end;
  24354. El:=GetPasPropertyAncestor(El);
  24355. end;
  24356. end;
  24357. function TPasResolver.GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
  24358. // search the stored expression of a property
  24359. begin
  24360. Result:=nil;
  24361. while El<>nil do
  24362. begin
  24363. if El.StoredAccessor<>nil then
  24364. begin
  24365. Result:=El.StoredAccessor;
  24366. exit;
  24367. end;
  24368. El:=GetPasPropertyAncestor(El);
  24369. end;
  24370. end;
  24371. function TPasResolver.GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
  24372. // search the stored expression of a property
  24373. begin
  24374. Result:=nil;
  24375. while El<>nil do
  24376. begin
  24377. if El.DefaultExpr<>nil then
  24378. begin
  24379. Result:=El.DefaultExpr;
  24380. exit;
  24381. end
  24382. else if El.IsNodefault then
  24383. exit(nil);
  24384. El:=GetPasPropertyAncestor(El);
  24385. end;
  24386. end;
  24387. function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
  24388. Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
  24389. SetReferenceFlags: boolean): integer;
  24390. var
  24391. ExprResolved, ParamResolved: TPasResolverResult;
  24392. NeedVar: Boolean;
  24393. begin
  24394. Result:=cIncompatible;
  24395. ComputeArgumentAndExpr(Param,ParamResolved,Expr,ExprResolved,SetReferenceFlags);
  24396. NeedVar:=Param.Access in [argVar, argOut];
  24397. if NeedVar then
  24398. begin
  24399. // Expr must be a variable
  24400. if not ResolvedElCanBeVarParam(ExprResolved,Expr) then
  24401. begin
  24402. {$IFDEF VerbosePasResolver}
  24403. writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
  24404. {$ENDIF}
  24405. if RaiseOnError then
  24406. begin
  24407. if ExprResolved.IdentEl is TPasConst then
  24408. RaiseMsg(20180430012609,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],Expr)
  24409. else
  24410. RaiseVarExpected(20180430012457,Expr,ExprResolved.IdentEl);
  24411. end;
  24412. exit;
  24413. end;
  24414. if (Param.ArgType=nil) then
  24415. exit(cExact); // untyped argument
  24416. if (ParamResolved.BaseType=ExprResolved.BaseType) then
  24417. begin
  24418. if msDelphi in CurrentParser.CurrentModeswitches then
  24419. begin
  24420. // Delphi allows passing alias, but not type alias to a var arg
  24421. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  24422. exit(cExact);
  24423. end
  24424. else if IsSameType(ParamResolved.LoTypeEl,ExprResolved.LoTypeEl,prraNone) then
  24425. begin
  24426. // ObjFPC allows passing type alias to a var arg, but simple alias wins
  24427. if IsSameType(ParamResolved.HiTypeEl,ExprResolved.HiTypeEl,prraSimple) then
  24428. exit(cExact)
  24429. else
  24430. exit(cAliasExact);
  24431. end;
  24432. if (ParamResolved.BaseType=btContext)
  24433. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType)
  24434. and (ExprResolved.LoTypeEl.ClassType=TPasArrayType) then
  24435. begin
  24436. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
  24437. if Result<>cIncompatible then exit;
  24438. end;
  24439. end;
  24440. if IsGenericTemplType(ParamResolved) then
  24441. exit(cGenericExact);
  24442. //writeln('TPasResolver.CheckParamCompatibility NeedVar ParamResolved=',GetResolverResultDbg(ParamResolved),' ExprResolved=',GetResolverResultDbg(ExprResolved));
  24443. if RaiseOnError then
  24444. RaiseIncompatibleTypeRes(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
  24445. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,
  24446. Expr);
  24447. exit(cIncompatible);
  24448. end;
  24449. Result:=CheckParamResCompatibility(Expr,ExprResolved,ParamResolved,ParamNo,
  24450. RaiseOnError,SetReferenceFlags);
  24451. end;
  24452. function TPasResolver.CheckParamResCompatibility(Expr: TPasExpr;
  24453. const ExprResolved, ParamResolved: TPasResolverResult; ParamNo: integer;
  24454. RaiseOnError: boolean; SetReferenceFlags: boolean): integer;
  24455. var
  24456. UseAssignError: Boolean;
  24457. begin
  24458. UseAssignError:=false;
  24459. if RaiseOnError and (ExprResolved.BaseType in [btArrayLit,btArrayOrSet]) then
  24460. // e.g. Call([1,2]) -> on mismatch jump to the wrong param expression
  24461. UseAssignError:=true;
  24462. Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,UseAssignError);
  24463. if (Result=cIncompatible) and RaiseOnError then
  24464. RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
  24465. [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
  24466. if SetReferenceFlags and (ParamResolved.BaseType=btContext)
  24467. and (ParamResolved.LoTypeEl.ClassType=TPasArrayType) then
  24468. MarkArrayExprRecursive(Expr,TPasArrayType(ParamResolved.LoTypeEl));
  24469. end;
  24470. function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
  24471. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24472. ): integer;
  24473. var
  24474. RTypeEl, LTypeEl: TPasType;
  24475. SrcResolved, DstResolved: TPasResolverResult;
  24476. LArray, RArray: TPasArrayType;
  24477. GotDesc, ExpDesc: String;
  24478. CurTVarRec: TPasRecordType;
  24479. LeftClass, RightClass: TPasClassType;
  24480. function RaiseIncompatType(Id: TMaxPrecInt): integer;
  24481. begin
  24482. Result:=cIncompatible;
  24483. if not RaiseOnIncompatible then exit;
  24484. RaiseIncompatibleTypeRes(Id,nIncompatibleTypesGotExpected,
  24485. [],RHS,LHS,ErrorEl);
  24486. end;
  24487. begin
  24488. if (RHS.LoTypeEl=nil) then
  24489. RaiseInternalError(20160922163645);
  24490. if (LHS.LoTypeEl=nil) then
  24491. RaiseInternalError(20160922163648);
  24492. LTypeEl:=LHS.LoTypeEl;
  24493. RTypeEl:=RHS.LoTypeEl;
  24494. // Note: do not check if LHS is writable, because this method is used for 'const' too.
  24495. if (LTypeEl=RTypeEl) and (rrfReadable in RHS.Flags) then
  24496. exit(cExact);
  24497. {$IFDEF VerbosePasResolver}
  24498. writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
  24499. {$ENDIF}
  24500. Result:=-1;
  24501. if LTypeEl.ClassType=TPasClassType then
  24502. begin
  24503. if RHS.BaseType=btNil then
  24504. Result:=cExact
  24505. else if RTypeEl.ClassType=TPasClassType then
  24506. begin
  24507. Result:=cIncompatible;
  24508. if not (rrfReadable in RHS.Flags) then
  24509. exit(RaiseIncompatType(20190215112914));
  24510. LeftClass:=TPasClassType(LTypeEl);
  24511. RightClass:=TPasClassType(RTypeEl);
  24512. if LeftClass.ObjKind=RightClass.ObjKind then
  24513. Result:=CheckSrcIsADstType(RHS,LHS)
  24514. else if LeftClass.ObjKind=okInterface then
  24515. begin
  24516. if (RightClass.ObjKind=okClass)
  24517. and (not RightClass.IsExternal) then
  24518. begin
  24519. // IntfVar:=ClassInstVar
  24520. if GetClassImplementsIntf(RightClass,LeftClass)<>nil then
  24521. exit(cTypeConversion);
  24522. end;
  24523. end;
  24524. if Result=cIncompatible then
  24525. Result:=CheckAssignCompatibilityClasses(LeftClass,RightClass);
  24526. if (Result=cIncompatible) and RaiseOnIncompatible then
  24527. RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
  24528. [],RTypeEl,LTypeEl,ErrorEl);
  24529. end
  24530. else
  24531. exit(RaiseIncompatType(20190215112919));
  24532. end
  24533. else if LTypeEl.ClassType=TPasClassOfType then
  24534. begin
  24535. if RHS.BaseType=btNil then
  24536. Result:=cExact
  24537. else if (RTypeEl.ClassType=TPasClassOfType) then
  24538. begin
  24539. if RHS.IdentEl is TPasType then
  24540. begin
  24541. Result:=cIncompatible;
  24542. if RaiseOnIncompatible then
  24543. begin
  24544. if ResolveAliasType(TPasType(RHS.IdentEl)) is TPasClassOfType then
  24545. RaiseMsg(20180317103206,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24546. ['type class-of','class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  24547. else
  24548. RaiseMsg(20180511123859,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24549. [GetResolverResultDescription(RHS),'class of '+TPasClassOfType(LTypeEl).DestType.Name],ErrorEl)
  24550. end;
  24551. end
  24552. else
  24553. begin
  24554. // e.g. ImageClass:=AnotherImageClass;
  24555. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  24556. TPasClassOfType(LTypeEl).DestType);
  24557. if (Result=cIncompatible) and RaiseOnIncompatible then
  24558. RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24559. ['class of '+TPasClassOfType(RTypeEl).DestType.PathName,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  24560. end;
  24561. end
  24562. else if (RHS.IdentEl is TPasType)
  24563. and (ResolveAliasType(TPasType(RHS.IdentEl)).ClassType=TPasClassType) then
  24564. begin
  24565. // e.g. ImageClass:=TFPMemoryImage;
  24566. Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType);
  24567. if (Result=cIncompatible) and RaiseOnIncompatible then
  24568. RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24569. [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.PathName],ErrorEl);
  24570. // do not check rrfReadable -> exit
  24571. exit;
  24572. end;
  24573. end
  24574. else if LTypeEl is TPasProcedureType then
  24575. begin
  24576. if RHS.BaseType=btNil then
  24577. exit(cExact);
  24578. //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);
  24579. if (LTypeEl.ClassType=RTypeEl.ClassType)
  24580. and (rrfReadable in RHS.Flags) then
  24581. begin
  24582. // e.g. ProcVar1:=ProcVar2
  24583. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  24584. true,ErrorEl,RaiseOnIncompatible) then
  24585. exit(cExact);
  24586. end;
  24587. if RaiseOnIncompatible then
  24588. begin
  24589. if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
  24590. RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24591. [GetElementTypeName(RTypeEl),GetElementTypeName(LTypeEl)],ErrorEl);
  24592. end;
  24593. end
  24594. else if LTypeEl.ClassType=TPasArrayType then
  24595. begin
  24596. LArray:=TPasArrayType(LTypeEl);
  24597. if (length(LArray.Ranges)=0) and (RTypeEl.ClassType=TPasArrayType) then
  24598. begin
  24599. // DynOrOpenArr:=array
  24600. RArray:=TPasArrayType(RTypeEl);
  24601. if length(RArray.Ranges)=1 then
  24602. begin
  24603. // DynOrOpenArr:=SingleDimStaticArr
  24604. if (msDelphi in CurrentParser.CurrentModeswitches)
  24605. and not IsOpenArray(LArray) then
  24606. begin
  24607. // DynArr:=SingleDimStaticArr forbidden in Delphi
  24608. // Note: OpenArr:=StaticArr is allowed in Delphi
  24609. if RaiseOnIncompatible then
  24610. RaiseIncompatibleTypeDesc(20180620115341,nIncompatibleTypesGotExpected,
  24611. [],'static array','dynamic array',ErrorEl);
  24612. exit(cIncompatible);
  24613. end;
  24614. end
  24615. else if length(RArray.Ranges)>1 then
  24616. begin
  24617. // DynOrOpenArr:=MultiDimStaticArr -> no
  24618. if RaiseOnIncompatible then
  24619. RaiseIncompatibleTypeDesc(20180620115235,nIncompatibleTypesGotExpected,
  24620. [],'multi dimensional static array','dynamic array',ErrorEl);
  24621. exit(cIncompatible);
  24622. end
  24623. else if not (proOpenAsDynArrays in Options) then
  24624. begin
  24625. if IsOpenArray(LArray) then
  24626. // OpenArray:=OpenOrDynArr -> ok
  24627. else if IsOpenArray(RArray) then
  24628. begin
  24629. // DynArray:=OpenArray
  24630. if RaiseOnIncompatible then
  24631. RaiseIncompatibleTypeDesc(20180620115515,nIncompatibleTypesGotExpected,
  24632. [],'open array','dynamic array',ErrorEl);
  24633. exit(cIncompatible)
  24634. end
  24635. else
  24636. begin
  24637. // DynArray:=DynArr
  24638. if (msDelphi in CurrentParser.CurrentModeswitches)
  24639. and (LArray<>RArray) then
  24640. begin
  24641. // Delphi does not allow assigning arrays with same element types
  24642. exit(RaiseIncompatType(20190215112626));
  24643. end;
  24644. end;
  24645. end;
  24646. // check element type
  24647. if LArray.ElType=nil then
  24648. begin
  24649. // ArrayOfConst:=SingleDimArr
  24650. if RArray.ElType=nil then
  24651. // ArrayOfConst:=ArrayOfConst
  24652. Result:=cExact
  24653. else
  24654. begin
  24655. CurTVarRec:=GetTVarRec(LArray);
  24656. if ResolveAliasType(RArray.ElType)=CurTVarRec then
  24657. // ArrayOfConst:=ArrayOfTVarRec
  24658. Result:=cExact
  24659. else
  24660. // ArrayOfConst:=SingleDimArr
  24661. exit(RaiseIncompatType(20190215112715));
  24662. end;
  24663. end
  24664. else if RArray.ElType=nil then
  24665. // ArrayOfNonConst:=ArrayOfConst
  24666. exit(RaiseIncompatType(20190215112907))
  24667. else
  24668. begin
  24669. Result:=CheckElTypeCompatibility(LArray.ElType,RArray.ElType,prraAlias);
  24670. if Result=cIncompatible then
  24671. if RaiseOnIncompatible then
  24672. begin
  24673. GetIncompatibleTypeDesc(LArray.ElType,RArray.ElType,GotDesc,ExpDesc);
  24674. RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
  24675. ['array of '+GotDesc,
  24676. 'array of '+ExpDesc],ErrorEl)
  24677. end
  24678. else
  24679. exit(cIncompatible);
  24680. end;
  24681. end;
  24682. end
  24683. else if LTypeEl.ClassType=TPasRecordType then
  24684. begin
  24685. if (RTypeEl is TPasClassType) and (TPasClassType(RTypeEl).ObjKind=okInterface)
  24686. and IsTGUID(TPasRecordType(LTypeEl)) then
  24687. begin
  24688. // GUIDVar := IntfTypeOrVar
  24689. exit(cInterfaceToTGUID);
  24690. end;
  24691. // records of different type
  24692. end
  24693. else if LTypeEl.ClassType=TPasEnumType then
  24694. begin
  24695. // enums of different type
  24696. end
  24697. else if RTypeEl.ClassType=TPasSetType then
  24698. begin
  24699. // sets of different type are compatible if enum types are compatible
  24700. if LTypeEl.ClassType=TPasSetType then
  24701. begin
  24702. ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
  24703. ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
  24704. if (SrcResolved.LoTypeEl<>nil)
  24705. and (SrcResolved.LoTypeEl=DstResolved.LoTypeEl) then
  24706. Result:=cExact
  24707. else if (SrcResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24708. and (DstResolved.LoTypeEl.CustomData is TResElDataBaseType)
  24709. and (CompareText(SrcResolved.LoTypeEl.Name,DstResolved.LoTypeEl.Name)=0) then
  24710. Result:=cExact
  24711. else if RaiseOnIncompatible then
  24712. RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
  24713. [],SrcResolved,DstResolved,ErrorEl)
  24714. else
  24715. exit(cIncompatible);
  24716. end
  24717. else
  24718. exit(RaiseIncompatType(20190215112924));
  24719. end
  24720. else if LTypeEl.ClassType=TPasPointerType then
  24721. begin
  24722. if RTypeEl.ClassType=TPasPointerType then
  24723. begin
  24724. // TypedPointer:=TypedPointer
  24725. Result:=CheckAssignCompatibilityPointerType(TPasPointerType(LTypeEl).DestType,
  24726. TPasPointerType(RTypeEl).DestType,ErrorEl,false);
  24727. if Result=cIncompatible then
  24728. exit(RaiseIncompatType(20190215112927));
  24729. end;
  24730. end
  24731. else
  24732. {$IFDEF VerbosePasResolver}
  24733. RaiseNotYetImplemented(20160922163654,ErrorEl);
  24734. {$ELSE}
  24735. ;
  24736. {$ENDIF}
  24737. if Result=-1 then
  24738. exit(RaiseIncompatType(20190215112931));
  24739. if not (rrfReadable in RHS.Flags) then
  24740. exit(RaiseIncompatType(20190215112934));
  24741. end;
  24742. function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
  24743. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  24744. ): integer;
  24745. procedure Check_ArrayOfChar_String(ArrType: TPasArrayType;
  24746. ArrLength: integer; const ElTypeResolved: TPasResolverResult;
  24747. Expr: TPasExpr; ErrorEl: TPasElement);
  24748. // check if assigning a string to an array of char fits
  24749. var
  24750. Value: TResEvalValue;
  24751. ElBT: TResolverBaseType;
  24752. l: Integer;
  24753. S: String;
  24754. {$ifdef FPC_HAS_CPSTRING}
  24755. US: UnicodeString;
  24756. {$endif}
  24757. begin
  24758. if Expr=nil then exit;
  24759. ElBT:=GetActualBaseType(ElTypeResolved.BaseType);
  24760. if length(ArrType.Ranges)=0 then
  24761. begin
  24762. // dynamic array of char can hold any string
  24763. // ToDo: check if value can be converted without loss
  24764. Result:=cExact;
  24765. exit;
  24766. end;
  24767. // static array -> check length of string
  24768. Value:=Eval(Expr,[refAutoConst]); // no external const allowed
  24769. try
  24770. case Value.Kind of
  24771. {$ifdef FPC_HAS_CPSTRING}
  24772. revkString:
  24773. if ElBT=btAnsiChar then
  24774. l:=length(TResEvalString(Value).S)
  24775. else
  24776. begin
  24777. US:=fExprEvaluator.GetUnicodeStr(TResEvalString(Value).S,ErrorEl);
  24778. l:=length(US);
  24779. end;
  24780. {$endif}
  24781. revkUnicodeString:
  24782. begin
  24783. if ElBT=btWideChar then
  24784. l:=length(TResEvalUTF16(Value).S)
  24785. else
  24786. begin
  24787. S:=String(TResEvalUTF16(Value).S);
  24788. l:=length(S);
  24789. end;
  24790. end;
  24791. else
  24792. {$IFDEF VerbosePasResolver}
  24793. writeln('Check_ArrayOfChar_String Value=',Value.AsDebugString);
  24794. {$ENDIF}
  24795. exit; // incompatible
  24796. end;
  24797. if ArrLength<>l then
  24798. begin
  24799. {$IFDEF VerbosePasResolver}
  24800. writeln('Check_ArrayOfChar_String ElType=',ElBT,'=',GetResolverResultDbg(ElTypeResolved),' Value=',Value.AsDebugString);
  24801. {$ENDIF}
  24802. RaiseMsg(20170913113216,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  24803. [IntToStr(ArrLength),IntToStr(l)],ErrorEl);
  24804. end;
  24805. Result:=cExact;
  24806. finally
  24807. ReleaseEvalValue(Value);
  24808. end;
  24809. end;
  24810. procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
  24811. Values: TPasResolverResult; ErrorEl: TPasElement);
  24812. var
  24813. ElTypeResolved: TPasResolverResult;
  24814. procedure CheckArrOfCharAssignString;
  24815. begin
  24816. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  24817. if ElTypeResolved.BaseType in btAllChars then
  24818. Result:=cTypeConversion; // ArrOfChar:=aString
  24819. end;
  24820. var
  24821. Range, Value, Expr: TPasExpr;
  24822. RangeResolved, ValueResolved: TPasResolverResult;
  24823. i, ExpectedCount, ValCnt: Integer;
  24824. IsLastRange, IsConstExpr: Boolean;
  24825. ArrayValues: TPasExprArray;
  24826. LeftResult: integer;
  24827. ExprCompFlags: TPasResolverComputeFlags;
  24828. BuiltInProc: TResElDataBuiltInProc;
  24829. Ref: TResolvedReference;
  24830. RArrayType: TPasArrayType;
  24831. begin
  24832. {$IFDEF VerbosePasResolver}
  24833. writeln('TPasResolver.CheckAssignCompatibilityArrayType.CheckRange ArrType=',GetObjName(ArrType),' RgIndex=',RangeIndex,' Values=',GetResolverResultDbg(Values));
  24834. {$ENDIF}
  24835. if not (rrfReadable in RHS.Flags) then
  24836. exit;
  24837. if (Values.BaseType=btContext) and (RangeIndex=0) and (Values.LoTypeEl=ArrType) then
  24838. begin
  24839. Result:=cExact;
  24840. exit;
  24841. end;
  24842. Expr:=Values.ExprEl;
  24843. if (Expr=nil) and (Values.IdentEl is TPasConst)
  24844. and (TPasConst(Values.IdentEl).VarType=nil) then
  24845. Expr:=TPasVariable(Values.IdentEl).Expr;
  24846. IsConstExpr:=(Expr<>nil) and ExprEvaluator.IsConst(Expr);
  24847. if IsConstExpr then
  24848. ExprCompFlags:=[rcConstant]
  24849. else
  24850. ExprCompFlags:=[];
  24851. if Expr<>nil then
  24852. begin
  24853. if IsEmptyArrayExpr(Values) then
  24854. begin
  24855. if length(ArrType.Ranges)=0 then
  24856. begin
  24857. if RaiseOnIncompatible then
  24858. MarkArrayExprRecursive(Values.ExprEl,ArrType);
  24859. Result:=cExact; // empty set fits open and dyn array
  24860. exit;
  24861. end;
  24862. end
  24863. else if IsArrayOperatorAdd(Expr) and not (Values.BaseType in btAllStrings) then
  24864. begin
  24865. // a:=left+right
  24866. if length(ArrType.Ranges)>0 then
  24867. exit; // ToDo: StaticArray:=A+B
  24868. // check a:=left
  24869. ComputeElement(TBinaryExpr(Expr).left,ValueResolved,ExprCompFlags);
  24870. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24871. if Result=cIncompatible then exit;
  24872. LeftResult:=Result;
  24873. // check a:=right
  24874. Result:=cIncompatible;
  24875. ComputeElement(TBinaryExpr(Expr).right,ValueResolved,ExprCompFlags);
  24876. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24877. if Result=cIncompatible then exit;
  24878. if Result<LeftResult then
  24879. Result:=LeftResult;
  24880. exit;
  24881. end
  24882. else if (Expr<>nil) and (Expr.ClassType=TParamsExpr)
  24883. and (TParamsExpr(Expr).Kind=pekFuncParams) then
  24884. begin
  24885. if TParamsExpr(Expr).Value.CustomData is TResolvedReference then
  24886. begin
  24887. Ref:=TResolvedReference(TParamsExpr(Expr).Value.CustomData);
  24888. if (Ref.Declaration is TPasUnresolvedSymbolRef)
  24889. and (Ref.Declaration.CustomData is TResElDataBuiltInProc) then
  24890. begin
  24891. BuiltInProc:=TResElDataBuiltInProc(Ref.Declaration.CustomData);
  24892. ArrayValues:=TParamsExpr(Expr).Params;
  24893. if BuiltInProc.BuiltIn=bfConcatArray then
  24894. begin
  24895. // check Concat(array1,array2,...)
  24896. Result:=cExact;
  24897. for i:=0 to length(ArrayValues)-1 do
  24898. begin
  24899. LeftResult:=Result;
  24900. Result:=cIncompatible;
  24901. ComputeElement(ArrayValues[i],ValueResolved,ExprCompFlags);
  24902. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24903. if Result=cIncompatible then exit;
  24904. if Result<LeftResult then
  24905. Result:=LeftResult;
  24906. end;
  24907. exit;
  24908. end
  24909. else if BuiltInProc.BuiltIn=bfCopyArray then
  24910. begin
  24911. // check Copy(A...)
  24912. ComputeElement(ArrayValues[0],ValueResolved,ExprCompFlags);
  24913. CheckRange(ArrType,RangeIndex,ValueResolved,ErrorEl);
  24914. exit;
  24915. end;
  24916. end;
  24917. end;
  24918. end;
  24919. end;
  24920. ExpectedCount:=-1;
  24921. if length(ArrType.Ranges)=0 then
  24922. begin
  24923. // dynamic or open array
  24924. if (Expr<>nil) then
  24925. begin
  24926. if Expr.ClassType=TArrayValues then
  24927. ExpectedCount:=length(TArrayValues(Expr).Values)
  24928. else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
  24929. ExpectedCount:=length(TParamsExpr(Expr).Params)
  24930. else if (Values.BaseType in btAllStringAndChars) then
  24931. begin
  24932. // e.g. const a: dynarray = string
  24933. // or e.g. pass a string literal to an open array
  24934. CheckArrOfCharAssignString;
  24935. exit;
  24936. end
  24937. else
  24938. begin
  24939. // invalid
  24940. exit;
  24941. end;
  24942. end
  24943. else
  24944. begin
  24945. // type check
  24946. if (Values.BaseType<>btContext) or (Values.LoTypeEl.ClassType<>TPasArrayType) then
  24947. begin
  24948. // RHS is not an array
  24949. if (Values.BaseType in btAllStringAndChars) then
  24950. begin
  24951. // e.g. pass a string literal to an open array
  24952. CheckArrOfCharAssignString;
  24953. end;
  24954. exit;
  24955. end;
  24956. RArrayType:=TPasArrayType(Values.LoTypeEl);
  24957. if length(RArrayType.Ranges)>0 then
  24958. begin
  24959. if RaiseOnIncompatible then
  24960. RaiseXExpectedButYFound(20180622104834,'dynamic array','static array',ErrorEl);
  24961. exit;
  24962. end;
  24963. // dynarr:=dynarr -> check element type
  24964. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  24965. Include(ElTypeResolved.Flags,rrfWritable);
  24966. ComputeElement(GetArrayElType(RArrayType),ValueResolved,[rcType]);
  24967. Include(ValueResolved.Flags,rrfReadable);
  24968. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,ErrorEl,RaiseOnIncompatible);
  24969. exit;
  24970. end;
  24971. Range:=nil;
  24972. IsLastRange:=true;
  24973. end
  24974. else
  24975. begin
  24976. // static array
  24977. Range:=ArrType.Ranges[RangeIndex];
  24978. ExpectedCount:=GetRangeLength(Range);
  24979. if ExpectedCount=0 then
  24980. begin
  24981. ComputeElement(Range,RangeResolved,[rcConstant]);
  24982. RaiseNotYetImplemented(20170222232409,Expr,'range '+GetResolverResultDbg(RangeResolved));
  24983. end;
  24984. IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
  24985. if Expr=nil then
  24986. begin
  24987. if (ValueResolved.BaseType=btContext) and (ValueResolved.LoTypeEl.ClassType=TPasArrayType) then
  24988. begin
  24989. {$IFDEF VerbosePasResolver}
  24990. writeln('CheckRange TODO StaticArr:=Arr');
  24991. {$ENDIF}
  24992. end;
  24993. exit;
  24994. end;
  24995. end;
  24996. if IsLastRange then
  24997. begin
  24998. ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
  24999. ElTypeResolved.ExprEl:=Range;
  25000. Include(ElTypeResolved.Flags,rrfWritable);
  25001. end
  25002. else
  25003. ElTypeResolved.BaseType:=btNone;
  25004. if (Expr<>nil)
  25005. and ((Expr.ClassType=TArrayValues)
  25006. or ((Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet))) then
  25007. begin
  25008. // array literal
  25009. if (ErrorEl.Parent is TPasVariable) then
  25010. begin
  25011. // array initialization e.g. var a: tarray = []
  25012. if msDelphi in CurrentParser.CurrentModeswitches then
  25013. begin
  25014. // Delphi expects square brackets for dynamic arrays
  25015. // and round brackets for static arrays
  25016. if length(ArrType.Ranges)>0 then
  25017. begin
  25018. // static array
  25019. if Expr.ClassType<>TArrayValues then
  25020. begin
  25021. if RaiseOnIncompatible then
  25022. RaiseXExpectedButYFound(20180615121203,'(','[',ErrorEl);
  25023. exit;
  25024. end;
  25025. end
  25026. else
  25027. begin
  25028. // dyn array
  25029. if Expr.ClassType=TArrayValues then
  25030. begin
  25031. if RaiseOnIncompatible then
  25032. RaiseXExpectedButYFound(20180615122953,'[','(',ErrorEl);
  25033. exit;
  25034. end;
  25035. end;
  25036. end
  25037. else
  25038. begin
  25039. // ObjFPC always expects round brackets in initialization
  25040. if Expr.ClassType<>TArrayValues then
  25041. begin
  25042. if RaiseOnIncompatible then
  25043. RaiseXExpectedButYFound(20170913181208,'(','[',ErrorEl);
  25044. exit;
  25045. end;
  25046. end;
  25047. end;
  25048. // check each value
  25049. if Expr.ClassType=TArrayValues then
  25050. ArrayValues:=TArrayValues(Expr).Values
  25051. else
  25052. ArrayValues:=TParamsExpr(Expr).Params;
  25053. ValCnt:=length(ArrayValues);
  25054. Include(ExprCompFlags,rcNoImplicitProcType);
  25055. for i:=0 to ExpectedCount-1 do
  25056. begin
  25057. if i=ValCnt then
  25058. begin
  25059. // not enough values
  25060. if ValCnt>0 then
  25061. ErrorEl:=ArrayValues[ValCnt-1];
  25062. RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25063. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  25064. end;
  25065. Value:=ArrayValues[i];
  25066. ComputeElement(Value,ValueResolved,ExprCompFlags);
  25067. if IsLastRange then
  25068. begin
  25069. // last dimension -> check element type
  25070. Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
  25071. if Result=cIncompatible then
  25072. exit;
  25073. CheckAssignExprRange(ElTypeResolved,Value);
  25074. end
  25075. else
  25076. begin
  25077. // multi dimensional array -> check next range
  25078. CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
  25079. end;
  25080. end;
  25081. if ExpectedCount<ValCnt then
  25082. begin
  25083. // too many values
  25084. ErrorEl:=ArrayValues[ExpectedCount];
  25085. if RaiseOnIncompatible then
  25086. RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25087. [IntToStr(ExpectedCount),IntToStr(ValCnt)],ErrorEl);
  25088. exit;
  25089. end;
  25090. if RaiseOnIncompatible and (Expr.ClassType=TParamsExpr) then
  25091. // mark [] expression as an array
  25092. MarkArrayExpr(TParamsExpr(Expr),ArrType);
  25093. end
  25094. else
  25095. begin
  25096. // single value
  25097. // Note: the parser does not store the difference between (1) and 1
  25098. if not IsLastRange then
  25099. begin
  25100. if RaiseOnIncompatible then
  25101. RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25102. [IntToStr(ExpectedCount),'1'],ErrorEl);
  25103. exit;
  25104. end;
  25105. if (Values.BaseType in btAllStrings) and (ElTypeResolved.BaseType in btAllChars) then
  25106. begin
  25107. // e.g. array of char = ''
  25108. Check_ArrayOfChar_String(ArrType,ExpectedCount,ElTypeResolved,Expr,ErrorEl);
  25109. exit;
  25110. end;
  25111. if (ExpectedCount>1) then
  25112. begin
  25113. if RaiseOnIncompatible then
  25114. begin
  25115. {$IFDEF VerbosePasResolver}
  25116. writeln('CheckRange Values=',GetResolverResultDbg(Values),' ElTypeResolved=',GetResolverResultDbg(ElTypeResolved));
  25117. {$ENDIF}
  25118. RaiseMsg(20170913103143,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
  25119. [IntToStr(ExpectedCount),'1'],ErrorEl);
  25120. end;
  25121. exit;
  25122. end;
  25123. // check element type
  25124. Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
  25125. if Result=cIncompatible then
  25126. exit;
  25127. if Expr<>nil then
  25128. CheckAssignExprRange(ElTypeResolved,Expr);
  25129. end;
  25130. end;
  25131. var
  25132. LArrType: TPasArrayType;
  25133. begin
  25134. Result:=cIncompatible;
  25135. {$IFDEF VerbosePasResolver}
  25136. writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
  25137. {$ENDIF}
  25138. if (LHS.BaseType<>btContext) or (not (LHS.LoTypeEl is TPasArrayType)) then
  25139. RaiseInternalError(20170222230012);
  25140. LArrType:=TPasArrayType(LHS.LoTypeEl);
  25141. if (LArrType.ElType=nil) and (rrfReadable in RHS.Flags)
  25142. and (RHS.BaseType in [btArrayLit,btArrayOrSet]) then
  25143. begin
  25144. // ArrayOfConst:=[]
  25145. exit(cExact);
  25146. end;
  25147. CheckRange(LArrType,0,RHS,ErrorEl);
  25148. if (Result=cIncompatible) and RaiseOnIncompatible then
  25149. RaiseIncompatibleTypeRes(20180622104721,nIncompatibleTypesGotExpected,[],RHS,LHS,ErrorEl);
  25150. end;
  25151. function TPasResolver.CheckAssignCompatibilityPointerType(LTypeEl,
  25152. RTypeEl: TPasType; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  25153. ): integer;
  25154. var
  25155. LeftResolved, RightResolved: TPasResolverResult;
  25156. begin
  25157. ComputeElement(LTypeEl,LeftResolved,[rcNoImplicitProc]);
  25158. ComputeElement(RTypeEl,RightResolved,[rcNoImplicitProc]);
  25159. Include(LeftResolved.Flags,rrfWritable);
  25160. Include(RightResolved.Flags,rrfReadable);
  25161. Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,ErrorEl,RaiseOnIncompatible);
  25162. end;
  25163. function TPasResolver.CheckEqualCompatibilityUserType(const LHS,
  25164. RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
  25165. ): integer;
  25166. // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
  25167. var
  25168. LTypeEl, RTypeEl: TPasType;
  25169. AResolved, BResolved: TPasResolverResult;
  25170. function IncompatibleElements: integer;
  25171. begin
  25172. Result:=cIncompatible;
  25173. if not RaiseOnIncompatible then exit;
  25174. RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
  25175. [],LTypeEl,RTypeEl,ErrorEl);
  25176. end;
  25177. begin
  25178. if (LHS.LoTypeEl=nil) then
  25179. RaiseInternalError(20161007223118);
  25180. if (RHS.LoTypeEl=nil) then
  25181. RaiseInternalError(20161007223119);
  25182. LTypeEl:=LHS.LoTypeEl;
  25183. RTypeEl:=RHS.LoTypeEl;
  25184. if LTypeEl=RTypeEl then
  25185. exit(cExact);
  25186. if LTypeEl.ClassType=TPasClassType then
  25187. begin
  25188. if RTypeEl.ClassType=TPasClassType then
  25189. begin
  25190. // e.g. if Sender=Button1 then
  25191. Result:=CheckSrcIsADstType(LHS,RHS);
  25192. if Result=cIncompatible then
  25193. Result:=CheckSrcIsADstType(RHS,LHS);
  25194. if (Result=cIncompatible) and RaiseOnIncompatible then
  25195. RaiseIncompatibleTypeRes(20180324190757,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  25196. exit;
  25197. end
  25198. else if RTypeEl.ClassType=TPasRecordType then
  25199. begin
  25200. if (TPasClassType(LTypeEl).ObjKind=okInterface)
  25201. and IsTGUID(TPasRecordType(RTypeEl)) then
  25202. // IntfVar=GuidVar
  25203. exit(cInterfaceToTGUID);
  25204. end;
  25205. exit(IncompatibleElements);
  25206. end
  25207. else if LTypeEl.ClassType=TPasClassOfType then
  25208. begin
  25209. if RTypeEl.ClassType=TPasClassOfType then
  25210. begin
  25211. // for example: if ImageClass=ImageClass then
  25212. Result:=CheckClassIsClass(TPasClassOfType(LTypeEl).DestType,
  25213. TPasClassOfType(RTypeEl).DestType);
  25214. if Result=cIncompatible then
  25215. Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
  25216. TPasClassOfType(LTypeEl).DestType);
  25217. if (Result=cIncompatible) and RaiseOnIncompatible then
  25218. RaiseIncompatibleTypeRes(20180324190804,nTypesAreNotRelatedXY,[],LHS,RHS,ErrorEl);
  25219. exit;
  25220. end;
  25221. exit(IncompatibleElements);
  25222. end
  25223. else if LTypeEl.ClassType=TPasEnumType then
  25224. begin
  25225. // enums of different type
  25226. if not RaiseOnIncompatible then
  25227. exit(cIncompatible);
  25228. if RTypeEl.ClassType=TPasEnumValue then
  25229. RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
  25230. [],TPasEnumType(LTypeEl),TPasEnumType(RTypeEl),ErrorEl)
  25231. else
  25232. exit(IncompatibleElements);
  25233. end
  25234. else if LTypeEl.ClassType=TPasRecordType then
  25235. begin
  25236. if RTypeEl.ClassType=TPasClassType then
  25237. begin
  25238. if (TPasClassType(RTypeEl).ObjKind=okInterface)
  25239. and IsTGUID(TPasRecordType(LTypeEl)) then
  25240. // GuidVar=IntfVar
  25241. exit(cInterfaceToTGUID);
  25242. end;
  25243. end
  25244. else if LTypeEl.ClassType=TPasSetType then
  25245. begin
  25246. if RTypeEl.ClassType=TPasSetType then
  25247. begin
  25248. ComputeElement(TPasSetType(LTypeEl).EnumType,AResolved,[]);
  25249. ComputeElement(TPasSetType(RTypeEl).EnumType,BResolved,[]);
  25250. if (AResolved.LoTypeEl<>nil)
  25251. and (AResolved.LoTypeEl=BResolved.LoTypeEl) then
  25252. exit(cExact);
  25253. if (AResolved.LoTypeEl.CustomData is TResElDataBaseType)
  25254. and (BResolved.LoTypeEl.CustomData is TResElDataBaseType)
  25255. and (CompareText(AResolved.LoTypeEl.Name,BResolved.LoTypeEl.Name)=0) then
  25256. exit(cExact);
  25257. if RaiseOnIncompatible then
  25258. RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
  25259. [],AResolved,BResolved,ErrorEl)
  25260. else
  25261. exit(cIncompatible);
  25262. end
  25263. else
  25264. exit(IncompatibleElements);
  25265. end
  25266. else if LTypeEl is TPasProcedureType then
  25267. begin
  25268. if RTypeEl is TPasProcedureType then
  25269. begin
  25270. // e.g. ProcVar1 = ProcVar2
  25271. if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
  25272. false,nil,false) then
  25273. exit(cExact);
  25274. end
  25275. else
  25276. exit(IncompatibleElements);
  25277. end
  25278. else if LTypeEl.ClassType=TPasPointerType then
  25279. begin
  25280. if RTypeEl.ClassType=TPasPointerType then
  25281. // TypedPointer=TypedPointer
  25282. exit(cExact);
  25283. end;
  25284. exit(IncompatibleElements);
  25285. end;
  25286. function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
  25287. RaiseOnError: boolean): integer;
  25288. // for example if TClassA(AnObject)=nil then ;
  25289. var
  25290. Param: TPasExpr;
  25291. ParamResolved, ResolvedEl: TPasResolverResult;
  25292. begin
  25293. if length(Params.Params)<>1 then
  25294. begin
  25295. if RaiseOnError then
  25296. RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
  25297. sWrongNumberOfParametersForTypeCast,[El.Name],Params);
  25298. exit(cIncompatible);
  25299. end;
  25300. Param:=Params.Params[0];
  25301. ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
  25302. ComputeElement(El,ResolvedEl,[rcType]);
  25303. Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
  25304. end;
  25305. function TPasResolver.CheckTypeCastRes(const FromResolved,
  25306. ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
  25307. ): integer;
  25308. procedure WarnClassTypesAreNotRelated(GotType, ExpType: TPasClassType);
  25309. var
  25310. GotDesc, ExpDesc: String;
  25311. begin
  25312. GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
  25313. LogMsg(20200209140450,mtWarning,nClassTypesAreNotRelatedXY,
  25314. sClassTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
  25315. end;
  25316. var
  25317. ToTypeEl, ToType, FromType, FromTypeEl: TPasType;
  25318. ToTypeBaseType: TResolverBaseType;
  25319. C: TClass;
  25320. ToProcType, FromProcType: TPasProcedureType;
  25321. TemplType: TPasGenericTemplateType;
  25322. i: Integer;
  25323. ConToken: TToken;
  25324. ConEl: TPasElement;
  25325. ToClassType, FromClassType: TPasClassType;
  25326. begin
  25327. Result:=cIncompatible;
  25328. ToTypeEl:=ToResolved.LoTypeEl;
  25329. if (ToTypeEl<>nil)
  25330. and (rrfReadable in FromResolved.Flags) then
  25331. begin
  25332. C:=ToTypeEl.ClassType;
  25333. if FromResolved.BaseType=btUntyped then
  25334. begin
  25335. // typecast an untyped parameter
  25336. Result:=cCompatible;
  25337. end
  25338. else if C=TPasUnresolvedSymbolRef then
  25339. begin
  25340. if ToTypeEl.CustomData is TResElDataBaseType then
  25341. begin
  25342. // base type cast, e.g. double(aninteger)
  25343. if ToTypeEl=FromResolved.LoTypeEl then
  25344. exit(cExact);
  25345. ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
  25346. if ToTypeBaseType=FromResolved.BaseType then
  25347. Result:=cExact
  25348. else if ToTypeBaseType in btAllInteger then
  25349. begin
  25350. if FromResolved.BaseType in (btArrayRangeTypes+[btRange,btCurrency]) then
  25351. Result:=cCompatible
  25352. else if FromResolved.BaseType=btContext then
  25353. begin
  25354. FromTypeEl:=FromResolved.LoTypeEl;
  25355. if FromTypeEl.ClassType=TPasEnumType then
  25356. // e.g. longint(TEnum)
  25357. Result:=cCompatible;
  25358. end;
  25359. end
  25360. else if ToTypeBaseType in btAllFloats then
  25361. begin
  25362. if FromResolved.BaseType in btAllFloats then
  25363. Result:=cCompatible
  25364. else if FromResolved.BaseType in btAllInteger then
  25365. Result:=cCompatible;
  25366. end
  25367. else if ToTypeBaseType in btAllBooleans then
  25368. begin
  25369. if FromResolved.BaseType in btAllBooleans then
  25370. Result:=cCompatible
  25371. else if FromResolved.BaseType in btAllInteger then
  25372. Result:=cCompatible;
  25373. end
  25374. else if ToTypeBaseType in btAllChars then
  25375. begin
  25376. if FromResolved.BaseType in (btArrayRangeTypes+[btRange]) then
  25377. Result:=cCompatible
  25378. else if FromResolved.BaseType=btContext then
  25379. begin
  25380. FromTypeEl:=FromResolved.LoTypeEl;
  25381. if FromTypeEl.ClassType=TPasEnumType then
  25382. // e.g. char(TEnum)
  25383. Result:=cCompatible;
  25384. end;
  25385. end
  25386. else if ToTypeBaseType in btAllStrings then
  25387. begin
  25388. if FromResolved.BaseType in btAllStringAndChars then
  25389. Result:=cCompatible
  25390. else if (FromResolved.BaseType=btPointer)
  25391. and (ToTypeBaseType in btAllStringPointer) then
  25392. Result:=cExact;
  25393. end
  25394. else if ToTypeBaseType=btPointer then
  25395. begin
  25396. if FromResolved.BaseType in ([btPointer]+btAllStringPointer) then
  25397. Result:=cExact
  25398. else if FromResolved.BaseType=btContext then
  25399. begin
  25400. FromTypeEl:=FromResolved.LoTypeEl;
  25401. C:=FromTypeEl.ClassType;
  25402. if (C=TPasClassType)
  25403. or (C=TPasClassOfType)
  25404. or (C=TPasPointerType)
  25405. or ((C=TPasArrayType) and IsDynArray(FromTypeEl)) then
  25406. Result:=cExact
  25407. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  25408. begin
  25409. // from procvar to pointer
  25410. FromProcType:=TPasProcedureType(FromTypeEl);
  25411. if FromProcType.IsOfObject then
  25412. begin
  25413. if proMethodAddrAsPointer in Options then
  25414. Result:=cCompatible
  25415. else if RaiseOnError then
  25416. RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25417. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmOfObject],
  25418. BaseTypeNames[btPointer]],ErrorEl);
  25419. end
  25420. else if FromProcType.IsNested then
  25421. begin
  25422. if RaiseOnError then
  25423. RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25424. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmIsNested],
  25425. BaseTypeNames[btPointer]],ErrorEl);
  25426. end
  25427. else if FromProcType.IsReferenceTo then
  25428. begin
  25429. if proProcTypeWithoutIsNested in Options then
  25430. Result:=cCompatible
  25431. else if RaiseOnError then
  25432. RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25433. [GetElementTypeName(FromProcType)+' '+ProcTypeModifiers[ptmReferenceTo],
  25434. BaseTypeNames[btPointer]],ErrorEl);
  25435. end
  25436. else
  25437. Result:=cCompatible;
  25438. end;
  25439. end;
  25440. end;
  25441. end;
  25442. end
  25443. else if C=TPasClassType then
  25444. begin
  25445. ToClassType:=TPasClassType(ToTypeEl);
  25446. // to class
  25447. if FromResolved.BaseType=btContext then
  25448. begin
  25449. FromTypeEl:=FromResolved.LoTypeEl;
  25450. if FromTypeEl.ClassType=TPasClassType then
  25451. begin
  25452. FromClassType:=TPasClassType(FromTypeEl);
  25453. if FromResolved.IdentEl is TPasType then
  25454. RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25455. if FromClassType.ObjKind=ToClassType.ObjKind then
  25456. begin
  25457. // type cast upwards or downwards
  25458. Result:=CheckSrcIsADstType(FromResolved,ToResolved);
  25459. if Result=cIncompatible then
  25460. Result:=CheckSrcIsADstType(ToResolved,FromResolved);
  25461. end
  25462. else if ToClassType.ObjKind=okInterface then
  25463. begin
  25464. if (FromClassType.ObjKind=okClass)
  25465. and (not FromClassType.IsExternal) then
  25466. begin
  25467. // e.g. intftype(classinstvar)
  25468. Result:=cCompatible;
  25469. end;
  25470. end
  25471. else if FromClassType.ObjKind=okInterface then
  25472. begin
  25473. if (ToClassType.ObjKind=okClass)
  25474. and (not ToClassType.IsExternal) then
  25475. begin
  25476. // e.g. classtype(intfvar)
  25477. Result:=cCompatible;
  25478. end;
  25479. end;
  25480. if Result=cIncompatible then
  25481. Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
  25482. if (Result=cIncompatible) and (FromClassType.ObjKind=ToClassType.ObjKind) then
  25483. begin
  25484. if RaiseOnError then
  25485. WarnClassTypesAreNotRelated(FromClassType,ToClassType);
  25486. Result:=cTypeConversion;
  25487. end;
  25488. end
  25489. else if FromTypeEl.ClassType=TPasGenericTemplateType then
  25490. begin
  25491. // e.g. aClassType(T)
  25492. TemplType:=TPasGenericTemplateType(FromTypeEl);
  25493. if length(TemplType.Constraints)=0 then
  25494. begin
  25495. // typecast unconstrained template to a classtype
  25496. // -> check when specialize
  25497. Result:=cExact;
  25498. end
  25499. else
  25500. for i:=0 to length(TemplType.Constraints)-1 do
  25501. begin
  25502. ConEl:=TemplType.Constraints[i];
  25503. ConToken:=GetGenericConstraintKeyword(ConEl);
  25504. case ConToken of
  25505. tkrecord: ; // invalid type cast
  25506. tkClass, tkconstructor:
  25507. Result:=cExact;
  25508. else
  25509. // identifier constraint: class or interface -> allow
  25510. Result:=cExact;
  25511. break;
  25512. end;
  25513. end;
  25514. end;
  25515. end
  25516. else if FromResolved.BaseType=btPointer then
  25517. begin
  25518. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25519. Result:=cExact; // untyped pointer to class instance
  25520. end
  25521. else if FromResolved.BaseType=btNil then
  25522. Result:=cExact; // nil to class or interface
  25523. end
  25524. else if C=TPasGenericTemplateType then
  25525. begin
  25526. // e.g. T(var)
  25527. TemplType:=TPasGenericTemplateType(ToTypeEl);
  25528. FromTypeEl:=FromResolved.LoTypeEl;
  25529. for i:=0 to length(TemplType.Constraints)-1 do
  25530. begin
  25531. ConEl:=TemplType.Constraints[i];
  25532. ConToken:=GetGenericConstraintKeyword(ConEl);
  25533. case ConToken of
  25534. tkrecord:
  25535. if FromResolved.BaseType=btContext then
  25536. begin
  25537. if FromTypeEl.ClassType=TPasRecordType then
  25538. // typecast record to template record
  25539. Result:=cExact
  25540. else if FromTypeEl.ClassType=TPasGenericType then
  25541. // typecast template to template record
  25542. Result:=cExact;
  25543. end;
  25544. tkClass, tkconstructor:
  25545. Result:=cExact;
  25546. else
  25547. // identifier constraint: class or interface -> allow
  25548. Result:=cExact;
  25549. break;
  25550. end;
  25551. end;
  25552. end
  25553. else if C=TPasClassOfType then
  25554. begin
  25555. //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.LoTypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
  25556. if FromResolved.BaseType=btContext then
  25557. begin
  25558. if FromResolved.LoTypeEl.ClassType=TPasClassOfType then
  25559. begin
  25560. if (FromResolved.IdentEl is TPasType) then
  25561. RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25562. // type cast classof(classof-var) upwards or downwards
  25563. ToType:=TPasClassOfType(ToTypeEl).DestType;
  25564. FromType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
  25565. Result:=CheckClassesAreRelated(ToType,FromType);
  25566. end;
  25567. end
  25568. else if FromResolved.BaseType=btPointer then
  25569. begin
  25570. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25571. Result:=cExact; // untyped pointer to class-of
  25572. end
  25573. else if FromResolved.BaseType=btNil then
  25574. Result:=cExact; // nil to class-of
  25575. end
  25576. else if C=TPasRecordType then
  25577. begin
  25578. if FromResolved.BaseType=btContext then
  25579. begin
  25580. if FromResolved.LoTypeEl.ClassType=TPasRecordType then
  25581. begin
  25582. // typecast record to record
  25583. Result:=cExact;
  25584. end;
  25585. end;
  25586. end
  25587. else if (C=TPasEnumType)
  25588. or (C=TPasRangeType) then
  25589. begin
  25590. if CheckIsOrdinal(FromResolved,ErrorEl,true) then
  25591. Result:=cExact;
  25592. end
  25593. else if C=TPasArrayType then
  25594. begin
  25595. if FromResolved.BaseType=btContext then
  25596. begin
  25597. if FromResolved.LoTypeEl.ClassType=TPasArrayType then
  25598. Result:=CheckTypeCastArray(TPasArrayType(FromResolved.LoTypeEl),
  25599. TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
  25600. end
  25601. else if FromResolved.BaseType=btPointer then
  25602. begin
  25603. if IsDynArray(ToResolved.LoTypeEl)
  25604. and IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25605. Result:=cExact; // untyped pointer to dynamic array
  25606. end
  25607. else if FromResolved.BaseType=btNil then
  25608. begin
  25609. if IsDynArray(ToResolved.LoTypeEl) then
  25610. Result:=cExact; // nil to dynamic array
  25611. end;
  25612. end
  25613. else if (C=TPasProcedureType) or (C=TPasFunctionType) then
  25614. begin
  25615. ToProcType:=TPasProcedureType(ToTypeEl);
  25616. if IsBaseType(FromResolved.LoTypeEl,btPointer) then
  25617. begin
  25618. // type cast untyped pointer value to proctype
  25619. if ToProcType.IsOfObject then
  25620. begin
  25621. if proMethodAddrAsPointer in Options then
  25622. Result:=cCompatible
  25623. else if RaiseOnError then
  25624. RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25625. [BaseTypeNames[btPointer],
  25626. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
  25627. end
  25628. else if ToProcType.IsNested then
  25629. begin
  25630. if RaiseOnError then
  25631. RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25632. [BaseTypeNames[btPointer],
  25633. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
  25634. end
  25635. else if ToProcType.IsReferenceTo then
  25636. begin
  25637. if proMethodAddrAsPointer in Options then
  25638. Result:=cCompatible
  25639. else if RaiseOnError then
  25640. RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25641. [BaseTypeNames[btPointer],
  25642. ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
  25643. end
  25644. else
  25645. Result:=cCompatible;
  25646. end
  25647. else if FromResolved.BaseType=btContext then
  25648. begin
  25649. FromTypeEl:=FromResolved.LoTypeEl;
  25650. if FromTypeEl is TPasProcedureType then
  25651. begin
  25652. // type cast procvar to proctype
  25653. FromProcType:=TPasProcedureType(FromTypeEl);
  25654. if ToProcType.IsReferenceTo then
  25655. Result:=cCompatible
  25656. else if FromProcType.IsReferenceTo then
  25657. Result:=cCompatible
  25658. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  25659. and not (proMethodAddrAsPointer in Options) then
  25660. begin
  25661. if RaiseOnError then
  25662. RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25663. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  25664. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  25665. end
  25666. else if FromProcType.IsNested<>ToProcType.IsNested then
  25667. begin
  25668. if RaiseOnError then
  25669. RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25670. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  25671. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  25672. end
  25673. else
  25674. Result:=cCompatible;
  25675. end
  25676. end
  25677. else if FromResolved.BaseType=btProc then
  25678. begin
  25679. FromTypeEl:=FromResolved.LoTypeEl;
  25680. if FromTypeEl is TPasProcedureType then
  25681. begin
  25682. // typecast procedure (or anonymous procedure) to proctype
  25683. FromProcType:=TPasProcedureType(FromTypeEl);
  25684. if (msDelphi in CurrentParser.CurrentModeswitches)
  25685. and (FromResolved.IdentEl=nil)
  25686. and (FromResolved.LoTypeEl.Name<>'') then
  25687. // Delphi forbids typecast (non anonymous) procedure to proctype
  25688. else if ToProcType.IsReferenceTo then
  25689. Result:=cCompatible
  25690. else if FromResolved.IdentEl=nil then
  25691. // anonymous proc to proctype
  25692. Result:=cCompatible
  25693. else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
  25694. and not (proMethodAddrAsPointer in Options) then
  25695. begin
  25696. // e.g. TProcedure(Obj.DoIt)
  25697. if RaiseOnError then
  25698. RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25699. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
  25700. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
  25701. end
  25702. else if FromProcType.IsNested<>ToProcType.IsNested then
  25703. begin
  25704. if RaiseOnError then
  25705. RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
  25706. [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
  25707. ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
  25708. end
  25709. else
  25710. Result:=cCompatible;
  25711. end;
  25712. end
  25713. else if FromResolved.BaseType=btNil then
  25714. // typecast nil to procedure type
  25715. Result:=cExact;
  25716. end
  25717. else if C=TPasPointerType then
  25718. begin
  25719. // typecast to typedpointer
  25720. if FromResolved.BaseType in [btPointer,btNil] then
  25721. Result:=cExact
  25722. else if FromResolved.BaseType=btContext then
  25723. begin
  25724. FromTypeEl:=FromResolved.LoTypeEl;
  25725. C:=FromTypeEl.ClassType;
  25726. if (C=TPasPointerType)
  25727. or (C=TPasClassOfType)
  25728. or (C=TPasClassType)
  25729. or (C.InheritsFrom(TPasProcedureType))
  25730. or IsDynArray(FromTypeEl) then
  25731. Result:=cCompatible;
  25732. end;
  25733. end
  25734. end
  25735. else if ToTypeEl<>nil then
  25736. begin
  25737. // FromResolved is not readable
  25738. if FromResolved.BaseType=btContext then
  25739. begin
  25740. FromTypeEl:=FromResolved.LoTypeEl;
  25741. if (FromTypeEl.ClassType=TPasClassType)
  25742. and (FromTypeEl=FromResolved.IdentEl)
  25743. and (ToResolved.BaseType=btContext) then
  25744. begin
  25745. ToTypeEl:=ToResolved.LoTypeEl;
  25746. if (ToTypeEl.ClassType=TPasClassOfType)
  25747. and (ToTypeEl=ToResolved.IdentEl) then
  25748. begin
  25749. // for example class-of(Self) in a class function
  25750. ToType:=TPasClassOfType(ToTypeEl).DestType;
  25751. FromType:=TPasClassType(FromTypeEl);
  25752. Result:=CheckClassesAreRelated(ToType,FromType);
  25753. end;
  25754. end;
  25755. end;
  25756. if (Result=cIncompatible) and RaiseOnError then
  25757. begin
  25758. if FromResolved.IdentEl is TPasType then
  25759. RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
  25760. end;
  25761. end;
  25762. if Result=cIncompatible then
  25763. begin
  25764. {$IFDEF VerbosePasResolver}
  25765. writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
  25766. {$ENDIF}
  25767. if RaiseOnError then
  25768. RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
  25769. [],FromResolved,ToResolved,ErrorEl);
  25770. exit;
  25771. end;
  25772. end;
  25773. function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
  25774. ErrorEl: TPasElement; RaiseOnError: boolean): integer;
  25775. function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
  25776. out ElTypeResolved: TPasResolverResult): boolean;
  25777. begin
  25778. inc(NextIndex);
  25779. if NextIndex<length(ArrType.Ranges) then
  25780. begin
  25781. ElTypeResolved.BaseType:=btNone;
  25782. exit(true);
  25783. end;
  25784. ComputeElement(GetArrayElType(ArrType),ElTypeResolved,[rcType]);
  25785. if (ElTypeResolved.BaseType<>btContext)
  25786. or (ElTypeResolved.LoTypeEl.ClassType<>TPasArrayType) then
  25787. exit(false);
  25788. ArrType:=TPasArrayType(ElTypeResolved.LoTypeEl);
  25789. NextIndex:=0;
  25790. Result:=true;
  25791. end;
  25792. var
  25793. FromIndex, ToIndex: Integer;
  25794. FromElTypeRes, ToElTypeRes: TPasResolverResult;
  25795. StartFromType, StartToType: TPasArrayType;
  25796. begin
  25797. {$IFDEF VerbosePasResolver}
  25798. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
  25799. {$ENDIF}
  25800. StartFromType:=FromType;
  25801. StartToType:=ToType;
  25802. Result:=cIncompatible;
  25803. // check dimensions
  25804. FromIndex:=0;
  25805. ToIndex:=0;
  25806. repeat
  25807. {$IFDEF VerbosePasResolver}
  25808. writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  25809. {$ENDIF}
  25810. if length(ToType.Ranges)=0 then
  25811. // ToType is dynamic/open array -> fits any size
  25812. else
  25813. begin
  25814. // ToType is ranged
  25815. // ToDo: check size of dimension
  25816. end;
  25817. // check next dimension
  25818. if not NextDim(FromType,FromIndex,FromElTypeRes) then
  25819. begin
  25820. // at end of FromType
  25821. if NextDim(ToType,ToIndex,ToElTypeRes) then
  25822. begin
  25823. {$IFDEF VerbosePasResolver}
  25824. writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  25825. {$ENDIF}
  25826. break; // ToType has more dimensions
  25827. end;
  25828. // have same dimension -> check ElType
  25829. {$IFDEF VerbosePasResolver}
  25830. writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
  25831. {$ENDIF}
  25832. Include(FromElTypeRes.Flags,rrfReadable);
  25833. Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
  25834. break;
  25835. end
  25836. else
  25837. begin
  25838. // FromType has more dimensions
  25839. if not NextDim(ToType,ToIndex,ToElTypeRes) then
  25840. begin
  25841. {$IFDEF VerbosePasResolver}
  25842. writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
  25843. {$ENDIF}
  25844. break; // ToType has less dimensions
  25845. end;
  25846. end;
  25847. until false;
  25848. if (Result=cIncompatible) and RaiseOnError then
  25849. RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
  25850. [],StartFromType,StartToType,ErrorEl);
  25851. end;
  25852. procedure TPasResolver.ComputeElement(El: TPasElement; out
  25853. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  25854. StartEl: TPasElement);
  25855. procedure ComputeIdentifier(Expr: TPasExpr);
  25856. var
  25857. Ref: TResolvedReference;
  25858. Proc: TPasProcedure;
  25859. ProcType: TPasProcedureType;
  25860. begin
  25861. Ref:=TResolvedReference(Expr.CustomData);
  25862. ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
  25863. if rrfConstInherited in Ref.Flags then
  25864. Exclude(ResolvedEl.Flags,rrfWritable);
  25865. {$IFDEF VerbosePasResolver}
  25866. {AllowWriteln}
  25867. if Expr is TPrimitiveExpr then
  25868. writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
  25869. else
  25870. writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
  25871. {AllowWriteln-}
  25872. {$ENDIF}
  25873. //if (Expr is TPrimitiveExpr) and (Expr.Parent is TParamsExpr) and (TPrimitiveExpr(Expr).Value='FA') then
  25874. // RaiseNotYetImplemented(20180621235200,Expr);
  25875. if not (rcSetReferenceFlags in Flags)
  25876. and (rrfNoImplicitCallWithoutParams in Ref.Flags) then
  25877. exit;
  25878. if (ResolvedEl.BaseType=btProc) then
  25879. begin
  25880. // proc
  25881. if rcNoImplicitProc in Flags then
  25882. begin
  25883. if rcSetReferenceFlags in Flags then
  25884. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25885. end
  25886. else if [rcConstant,rcType]*Flags=[] then
  25887. begin
  25888. // implicit call without params is allowed -> check if possible
  25889. Proc:=ResolvedEl.IdentEl as TPasProcedure;
  25890. if not ProcNeedsParams(Proc.ProcType) then
  25891. begin
  25892. // parameter less proc -> implicit call possible
  25893. if ResolvedEl.IdentEl is TPasFunction then
  25894. begin
  25895. // function => return result
  25896. ComputeResultElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
  25897. ResolvedEl,Flags+[rcCall],StartEl);
  25898. end
  25899. else if (ResolvedEl.IdentEl.ClassType=TPasConstructor) then
  25900. begin
  25901. // constructor -> return value of type class
  25902. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  25903. end
  25904. else if ParentNeedsExprResult(Expr) then
  25905. begin
  25906. // a procedure
  25907. exit;
  25908. end;
  25909. if rcSetReferenceFlags in Flags then
  25910. begin
  25911. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25912. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25913. end;
  25914. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25915. end;
  25916. end;
  25917. end
  25918. else if IsProcedureType(ResolvedEl,true) then
  25919. begin
  25920. // proc type
  25921. if [rcNoImplicitProc,rcNoImplicitProcType]*Flags<>[] then
  25922. begin
  25923. if rcSetReferenceFlags in Flags then
  25924. Include(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25925. end
  25926. else if [rcConstant,rcType]*Flags=[] then
  25927. begin
  25928. // implicit call without params is allowed -> check if possible
  25929. ProcType:=TPasProcedureType(ResolvedEl.LoTypeEl);
  25930. if not ProcNeedsParams(ProcType) then
  25931. begin
  25932. // parameter less proc type -> implicit call possible
  25933. if ResolvedEl.LoTypeEl is TPasFunctionType then
  25934. // function => return result
  25935. ComputeResultElement(TPasFunctionType(ResolvedEl.LoTypeEl).ResultEl,
  25936. ResolvedEl,Flags+[rcCall],StartEl)
  25937. else if ParentNeedsExprResult(Expr) then
  25938. begin
  25939. // a procedure has no result
  25940. exit;
  25941. end;
  25942. if rcSetReferenceFlags in Flags then
  25943. begin
  25944. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25945. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25946. end;
  25947. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25948. end;
  25949. end;
  25950. end;
  25951. end;
  25952. procedure ComputeInherited(Expr: TInheritedExpr);
  25953. var
  25954. Ref: TResolvedReference;
  25955. Proc: TPasProcedure;
  25956. TypeEl: TPasProcedureType;
  25957. HasName: Boolean;
  25958. begin
  25959. // "inherited;"
  25960. Ref:=TResolvedReference(El.CustomData);
  25961. Proc:=NoNil(Ref.Declaration) as TPasProcedure;
  25962. TypeEl:=TPasProcedure(Proc).ProcType;
  25963. SetResolverIdentifier(ResolvedEl,btProc,Proc,
  25964. TypeEl,TypeEl,[rrfCanBeStatement]);
  25965. HasName:=(El.Parent.ClassType=TBinaryExpr)
  25966. and (TBinaryExpr(El.Parent).OpCode=eopNone); // true if 'inherited Proc;'
  25967. if HasName or (rcNoImplicitProc in Flags) then
  25968. exit;
  25969. // inherited; -> implicit call possible
  25970. if Proc is TPasFunction then
  25971. begin
  25972. // function => return result
  25973. ComputeResultElement(TPasFunction(Proc).FuncType.ResultEl,
  25974. ResolvedEl,Flags+[rcCall],StartEl);
  25975. Exclude(ResolvedEl.Flags,rrfWritable);
  25976. end
  25977. else if (Proc.ClassType=TPasConstructor)
  25978. and (rrfNewInstance in Ref.Flags) then
  25979. begin
  25980. // new instance constructor -> return value of type class
  25981. ResolvedEl:=GetReference_ConstructorType(Ref,Expr);
  25982. end
  25983. else if ParentNeedsExprResult(Expr) then
  25984. begin
  25985. // a procedure
  25986. exit;
  25987. end;
  25988. if rcSetReferenceFlags in Flags then
  25989. begin
  25990. Exclude(Ref.Flags,rrfNoImplicitCallWithoutParams);
  25991. Include(Ref.Flags,rrfImplicitCallWithoutParams);
  25992. end;
  25993. Include(ResolvedEl.Flags,rrfCanBeStatement);
  25994. end;
  25995. procedure ComputeSpecializeType(SpecType: TPasSpecializeType);
  25996. var
  25997. TypeEl: TPasType;
  25998. begin
  25999. if SpecType.CustomData is TPasSpecializeTypeData then
  26000. begin
  26001. TypeEl:=TPasSpecializeTypeData(SpecType.CustomData).SpecializedType;
  26002. if TypeEl=nil then
  26003. RaiseNotYetImplemented(20190908153503,El);
  26004. SetResolverIdentifier(ResolvedEl,btContext,TypeEl,TypeEl,TypeEl,[]);
  26005. end
  26006. else
  26007. begin
  26008. TypeEl:=SpecType.DestType;
  26009. if TypeEl=nil then
  26010. RaiseNotYetImplemented(20190908153434,El);
  26011. SetResolverIdentifier(ResolvedEl,btContext,SpecType,TypeEl,SpecType,[]);
  26012. end;
  26013. end;
  26014. var
  26015. DeclEl: TPasElement;
  26016. ElClass: TClass;
  26017. bt: TResolverBaseType;
  26018. TypeEl: TPasType;
  26019. Value: TResEvalValue;
  26020. Int: TMaxPrecInt;
  26021. begin
  26022. if StartEl=nil then StartEl:=El;
  26023. ResolvedEl:=Default(TPasResolverResult);
  26024. {$IFDEF VerbosePasResolver}
  26025. writeln('TPasResolver.ComputeElement El=',GetObjName(El));
  26026. {$ENDIF}
  26027. if El=nil then
  26028. exit;
  26029. ElClass:=El.ClassType;
  26030. if ElClass=TPrimitiveExpr then
  26031. begin
  26032. case TPrimitiveExpr(El).Kind of
  26033. pekIdent,pekSelf:
  26034. begin
  26035. if not (El.CustomData is TResolvedReference) then
  26036. RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
  26037. ComputeIdentifier(TPrimitiveExpr(El));
  26038. end;
  26039. pekNumber:
  26040. begin
  26041. if NumberIsFloat(TPrimitiveExpr(El).Value) then
  26042. bt:=BaseTypeExtended
  26043. else if length(TPrimitiveExpr(El).Value)<9 then
  26044. bt:=btLongint
  26045. else
  26046. begin
  26047. // with 9+ it could be longword: e.g. $87654321
  26048. Value:=Eval(TPrimitiveExpr(El),[]);
  26049. if Value=nil then
  26050. RaiseNotYetImplemented(20190130162601,El);
  26051. try
  26052. case Value.Kind of
  26053. revkInt:
  26054. begin
  26055. Int:=TResEvalInt(Value).Int;
  26056. bt:=GetSmallestIntegerBaseType(Int,Int);
  26057. end;
  26058. {$IFDEF HasInt64}
  26059. revkUInt:
  26060. bt:=btQWord;
  26061. {$ENDIF}
  26062. else
  26063. bt:=BaseTypeExtended;
  26064. end;
  26065. finally
  26066. ReleaseEvalValue(Value);
  26067. end;
  26068. end;
  26069. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  26070. TPrimitiveExpr(El),[rrfReadable])
  26071. end;
  26072. pekString:
  26073. begin
  26074. {$IFDEF VerbosePasResolver}
  26075. writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
  26076. {$ENDIF}
  26077. bt:=IsCharLiteral(TPrimitiveExpr(El).Value,El);
  26078. if bt in btAllChars then
  26079. begin
  26080. if bt=BaseTypeChar then
  26081. bt:=btChar;
  26082. SetResolverValueExpr(ResolvedEl,bt,FBaseTypes[bt],FBaseTypes[bt],
  26083. TPrimitiveExpr(El),[rrfReadable]);
  26084. end
  26085. else
  26086. SetResolverValueExpr(ResolvedEl,btString,
  26087. FBaseTypes[btString],FBaseTypes[btString],
  26088. TPrimitiveExpr(El),[rrfReadable]);
  26089. end;
  26090. pekNil:
  26091. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  26092. TPrimitiveExpr(El),[rrfReadable]);
  26093. pekBoolConst:
  26094. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  26095. TPrimitiveExpr(El),[rrfReadable]);
  26096. else
  26097. RaiseNotYetImplemented(20160922163701,El);
  26098. end;
  26099. end
  26100. else if ElClass=TPasUnresolvedSymbolRef then
  26101. begin
  26102. // built-in type
  26103. if El.CustomData is TResElDataBaseType then
  26104. SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
  26105. El,TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[])
  26106. else if El.CustomData is TResElDataBuiltInProc then
  26107. begin
  26108. SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,
  26109. TPasUnresolvedSymbolRef(El),TPasUnresolvedSymbolRef(El),[]);
  26110. if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
  26111. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26112. end
  26113. else
  26114. RaiseNotYetImplemented(20160926194756,El);
  26115. end
  26116. else if ElClass=TBoolConstExpr then
  26117. SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],FBaseTypes[btBoolean],
  26118. TBoolConstExpr(El),[rrfReadable])
  26119. else if ElClass=TBinaryExpr then
  26120. ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
  26121. else if ElClass=TUnaryExpr then
  26122. begin
  26123. if TUnaryExpr(El).OpCode in [eopAddress,eopMemAddress] then
  26124. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
  26125. else
  26126. ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
  26127. {$IFDEF VerbosePasResolver}
  26128. writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
  26129. {$ENDIF}
  26130. case TUnaryExpr(El).OpCode of
  26131. eopAdd, eopSubtract:
  26132. if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
  26133. exit
  26134. else if IsGenericTemplType(ResolvedEl) then
  26135. exit
  26136. else
  26137. RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26138. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26139. eopNot:
  26140. begin
  26141. if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
  26142. else
  26143. ComputeUnaryNot(TUnaryExpr(El),ResolvedEl,Flags);
  26144. exit;
  26145. end;
  26146. eopAddress:
  26147. if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
  26148. begin
  26149. SetResolverValueExpr(ResolvedEl,btContext,
  26150. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  26151. exit;
  26152. end
  26153. else if (rrfReadable in ResolvedEl.Flags) and (ResolvedEl.BaseType<>btPointer) then
  26154. begin
  26155. SetResolverValueExpr(ResolvedEl,btPointer,
  26156. ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
  26157. exit;
  26158. end
  26159. else
  26160. RaiseMsg(20180208121541,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26161. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26162. eopDeref:
  26163. begin
  26164. ComputeDereference(TUnaryExpr(El),ResolvedEl);
  26165. exit;
  26166. end;
  26167. eopMemAddress:
  26168. if (ResolvedEl.BaseType=btContext)
  26169. and ((ResolvedEl.LoTypeEl is TPasProcedureType)
  26170. or IsGenericTemplType(ResolvedEl)) then
  26171. // @@ProcVar
  26172. exit
  26173. else
  26174. RaiseMsg(20180208121549,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
  26175. [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
  26176. end;
  26177. {$IFDEF VerbosePasResolver}
  26178. writeln('TPasResolver.ComputeElement OpCode=',TUnaryExpr(El).OpCode);
  26179. {$ENDIF}
  26180. RaiseNotYetImplemented(20160926142426,El);
  26181. end
  26182. else if ElClass=TParamsExpr then
  26183. case TParamsExpr(El).Kind of
  26184. pekArrayParams: // a[]
  26185. ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26186. pekFuncParams: // a()
  26187. ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26188. pekSet: // []
  26189. ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
  26190. else
  26191. RaiseNotYetImplemented(20161010184559,El);
  26192. end
  26193. else if ElClass=TInheritedExpr then
  26194. begin
  26195. // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
  26196. if El.CustomData is TResolvedReference then
  26197. ComputeInherited(TInheritedExpr(El))
  26198. else
  26199. // no ancestor proc
  26200. SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,nil,[rrfCanBeStatement]);
  26201. end
  26202. else if (ElClass=TPasAliasType) or (ElClass=TPasTypeAliasType) then
  26203. begin
  26204. // e.g. 'type a = b' -> compute b
  26205. ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
  26206. ResolvedEl.IdentEl:=El;
  26207. ResolvedEl.HiTypeEl:=TPasAliasType(El);
  26208. end
  26209. else if (ElClass=TPasVariable) then
  26210. begin
  26211. // e.g. 'var a:b' -> compute b, use a as IdentEl
  26212. if rcConstant in Flags then
  26213. RaiseConstantExprExp(20170216152737,StartEl);
  26214. ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  26215. ResolvedEl.IdentEl:=El;
  26216. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26217. end
  26218. else if (ElClass=TPasConst) then
  26219. begin
  26220. // e.g. 'var a:b' -> compute b, use a as IdentEl
  26221. if TPasConst(El).VarType<>nil then
  26222. begin
  26223. // typed const
  26224. if (not TPasConst(El).IsConst) and ([rcConstant,rcType]*Flags<>[]) then
  26225. RaiseConstantExprExp(20170216152739,StartEl);
  26226. ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
  26227. ResolvedEl.IdentEl:=El;
  26228. if TPasConst(El).IsConst then
  26229. ResolvedEl.Flags:=[rrfReadable]
  26230. else
  26231. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26232. end
  26233. else
  26234. begin
  26235. // untyped const
  26236. ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
  26237. ResolvedEl.IdentEl:=El;
  26238. ResolvedEl.Flags:=[rrfReadable];
  26239. end;
  26240. end
  26241. else if (ElClass=TPasEnumValue) then
  26242. begin
  26243. TypeEl:=NoNil(El.Parent) as TPasEnumType;
  26244. SetResolverIdentifier(ResolvedEl,btContext,El,TypeEl,TypeEl,[rrfReadable])
  26245. end
  26246. else if (ElClass=TPasEnumType) then
  26247. SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),TPasEnumType(El),[])
  26248. else if (ElClass=TPasProperty) then
  26249. begin
  26250. if rcConstant in Flags then
  26251. RaiseConstantExprExp(20170216152741,StartEl);
  26252. if GetPasPropertyArgs(TPasProperty(El)).Count=0 then
  26253. begin
  26254. ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
  26255. Flags+[rcType],StartEl);
  26256. ResolvedEl.IdentEl:=El;
  26257. ResolvedEl.Flags:=[];
  26258. if GetPasPropertyGetter(TPasProperty(El))<>nil then
  26259. Include(ResolvedEl.Flags,rrfReadable);
  26260. if GetPasPropertySetter(TPasProperty(El))<>nil then
  26261. Include(ResolvedEl.Flags,rrfWritable);
  26262. if IsProcedureType(ResolvedEl,true) then
  26263. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26264. end
  26265. else
  26266. begin
  26267. // index property without name
  26268. // Note: computing the pekArrayParams TParamsExpr will convert this to the type
  26269. SetResolverIdentifier(ResolvedEl,btArrayProperty,El,nil,nil,[]);
  26270. end;
  26271. end
  26272. else if ElClass=TPasArgument then
  26273. begin
  26274. if rcConstant in Flags then
  26275. RaiseConstantExprExp(20170216152744,StartEl);
  26276. if TPasArgument(El).ArgType=nil then
  26277. // untyped parameter
  26278. SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,nil,[])
  26279. else
  26280. begin
  26281. // typed parameter -> use param as IdentEl, compute type
  26282. ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
  26283. ResolvedEl.IdentEl:=El;
  26284. end;
  26285. ResolvedEl.Flags:=[rrfReadable];
  26286. if TPasArgument(El).Access in [argDefault, argVar, argOut] then
  26287. Include(ResolvedEl.Flags,rrfWritable);
  26288. if IsProcedureType(ResolvedEl,true) then
  26289. Include(ResolvedEl.Flags,rrfCanBeStatement);
  26290. end
  26291. else if ElClass=TPasClassType then
  26292. begin
  26293. if TPasClassType(El).IsForward and (El.CustomData<>nil) then
  26294. begin
  26295. DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
  26296. TypeEl:=NoNil(DeclEl) as TPasClassType;
  26297. end
  26298. else
  26299. TypeEl:=TPasClassType(El);
  26300. SetResolverIdentifier(ResolvedEl,btContext,
  26301. TypeEl,TypeEl,TypeEl,[]);
  26302. end
  26303. else if ElClass=TPasClassOfType then
  26304. SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),TPasClassOfType(El),[])
  26305. else if ElClass=TPasPointerType then
  26306. SetResolverIdentifier(ResolvedEl,btContext,El,TPasPointerType(El),TPasPointerType(El),[])
  26307. else if ElClass=TPasRecordType then
  26308. SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),TPasRecordType(El),[])
  26309. else if ElClass=TPasRangeType then
  26310. begin
  26311. ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
  26312. ResolvedEl.IdentEl:=El;
  26313. ResolvedEl.LoTypeEl:=TPasRangeType(El);
  26314. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  26315. if ResolvedEl.ExprEl=nil then
  26316. ResolvedEl.ExprEl:=TPasRangeType(El).RangeExpr;
  26317. ResolvedEl.Flags:=[];
  26318. end
  26319. else if ElClass=TPasSetType then
  26320. begin
  26321. ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
  26322. if ResolvedEl.BaseType=btRange then
  26323. begin
  26324. ConvertRangeToElement(ResolvedEl);
  26325. ResolvedEl.LoTypeEl:=TPasSetType(El).EnumType;
  26326. ResolvedEl.HiTypeEl:=ResolvedEl.LoTypeEl;
  26327. end;
  26328. ResolvedEl.SubType:=ResolvedEl.BaseType;
  26329. ResolvedEl.BaseType:=btSet;
  26330. ResolvedEl.IdentEl:=El;
  26331. ResolvedEl.Flags:=[];
  26332. end
  26333. else if ElClass=TPasResultElement then
  26334. begin
  26335. if rcConstant in Flags then
  26336. RaiseConstantExprExp(20170216152746,StartEl);
  26337. ComputeResultElement(TPasResultElement(El),ResolvedEl,Flags,StartEl);
  26338. end
  26339. else if ElClass=TPasUsesUnit then
  26340. begin
  26341. if TPasUsesUnit(El).Module is TPasModule then
  26342. SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,nil,[])
  26343. else
  26344. RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
  26345. end
  26346. else if El.InheritsFrom(TPasModule) then
  26347. SetResolverIdentifier(ResolvedEl,btModule,El,nil,nil,[])
  26348. else if ElClass=TNilExpr then
  26349. SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],FBaseTypes[btNil],
  26350. TNilExpr(El),[rrfReadable])
  26351. else if El.InheritsFrom(TPasProcedure) then
  26352. begin
  26353. TypeEl:=TPasProcedure(El).ProcType;
  26354. SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
  26355. if (TPasProcedure(El).ProcType is TPasFunctionType)
  26356. or (ElClass=TPasConstructor) then
  26357. Include(ResolvedEl.Flags,rrfReadable);
  26358. // Note: implicit calls are handled in TPrimitiveExpr
  26359. end
  26360. else if El.InheritsFrom(TPasProcedureType) then
  26361. begin
  26362. SetResolverIdentifier(ResolvedEl,btContext,El,
  26363. TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
  26364. // Note: implicit calls are handled in TPrimitiveExpr
  26365. end
  26366. else if ElClass=TProcedureExpr then
  26367. begin
  26368. TypeEl:=TProcedureExpr(El).Proc.ProcType;
  26369. SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
  26370. end
  26371. else if ElClass=TPasArrayType then
  26372. SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
  26373. else if ElClass=TArrayValues then
  26374. SetResolverValueExpr(ResolvedEl,btArrayLit,nil,nil,TArrayValues(El),[rrfReadable])
  26375. else if ElClass=TRecordValues then
  26376. ComputeRecordValues(TRecordValues(El),ResolvedEl,Flags,StartEl)
  26377. else if ElClass=TPasStringType then
  26378. begin
  26379. {$ifdef FPC_HAS_CPSTRING}
  26380. SetResolverTypeExpr(ResolvedEl,btShortString,
  26381. BaseTypes[btShortString],BaseTypes[btShortString],[rrfReadable]);
  26382. if BaseTypes[btShortString]=nil then
  26383. {$endif}
  26384. RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
  26385. end
  26386. else if ElClass=TPasResString then
  26387. SetResolverIdentifier(ResolvedEl,btString,El,
  26388. FBaseTypes[btString],FBaseTypes[btString],[rrfReadable])
  26389. else if ElClass=TPasGenericTemplateType then
  26390. SetResolverIdentifier(ResolvedEl,btContext,El,TPasGenericTemplateType(El),
  26391. TPasGenericTemplateType(El),[])
  26392. else if ElClass=TPasSpecializeType then
  26393. ComputeSpecializeType(TPasSpecializeType(El))
  26394. else if ElClass=TInlineSpecializeExpr then
  26395. ComputeElement(TInlineSpecializeExpr(El).NameExpr,ResolvedEl,Flags,StartEl)
  26396. else
  26397. RaiseNotYetImplemented(20160922163705,El);
  26398. {$IF defined(nodejs) and defined(VerbosePasResolver)}
  26399. if not isNumber(ResolvedEl.BaseType) then
  26400. begin
  26401. {AllowWriteln}
  26402. writeln('TPasResolver.ComputeElement ',GetObjName(El),' typeof ResolvedEl.BaseType=',jsTypeOf(ResolvedEl.BaseType),' ResolvedEl=',GetResolverResultDbg(ResolvedEl));
  26403. RaiseInternalError(20181101123527,jsTypeOf(ResolvedEl.LoTypeEl));
  26404. {AllowWriteln-}
  26405. end;
  26406. {$ENDIF}
  26407. end;
  26408. procedure TPasResolver.ComputeResultElement(El: TPasResultElement; out
  26409. ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
  26410. StartEl: TPasElement);
  26411. begin
  26412. if El.ResultType=nil then
  26413. RaiseNotYetImplemented(20200524214458,El);
  26414. ComputeElement(El.ResultType,ResolvedEl,Flags+[rcType,rcNoImplicitProc],StartEl);
  26415. ResolvedEl.IdentEl:=El;
  26416. ResolvedEl.Flags:=[rrfReadable,rrfWritable];
  26417. end;
  26418. function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
  26419. Store: boolean): TResEvalValue;
  26420. // Important: Caller must free result with ReleaseEvalValue(Result)
  26421. begin
  26422. Result:=fExprEvaluator.Eval(Expr,Flags);
  26423. if Result=nil then exit;
  26424. {$IFDEF VerbosePasResEval}
  26425. writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  26426. {$ENDIF}
  26427. if Store
  26428. and (Expr.CustomData=nil)
  26429. and (Result.Element=nil)
  26430. and (not fExprEvaluator.IsSimpleExpr(Expr))
  26431. and (Expr.GetModule=RootElement) then
  26432. begin
  26433. //writeln('TPasResolver.Eval STORE Expr=',GetObjName(Expr),' Result=',Result.AsDebugString);
  26434. AddResolveData(Expr,Result,lkModule);
  26435. end;
  26436. end;
  26437. function TPasResolver.Eval(const Value: TPasResolverResult;
  26438. Flags: TResEvalFlags; Store: boolean): TResEvalValue;
  26439. var
  26440. Expr: TPasExpr;
  26441. begin
  26442. Result:=nil;
  26443. if Value.ExprEl<>nil then
  26444. Result:=Eval(Value.ExprEl,Flags,Store)
  26445. else if Value.IdentEl is TPasConst then
  26446. begin
  26447. Expr:=TPasVariable(Value.IdentEl).Expr;
  26448. if Expr=nil then exit;
  26449. Result:=Eval(Expr,Flags,Store)
  26450. end;
  26451. end;
  26452. function TPasResolver.IsSameType(TypeA, TypeB: TPasType;
  26453. ResolveAlias: TPRResolveAlias): boolean;
  26454. begin
  26455. if (TypeA=nil) or (TypeB=nil) then exit(false);
  26456. case ResolveAlias of
  26457. prraSimple:
  26458. begin
  26459. TypeA:=ResolveSimpleAliasType(TypeA);
  26460. TypeB:=ResolveSimpleAliasType(TypeB);
  26461. end;
  26462. prraAlias:
  26463. begin
  26464. TypeA:=ResolveAliasType(TypeA);
  26465. TypeB:=ResolveAliasType(TypeB);
  26466. end;
  26467. end;
  26468. if TypeA=TypeB then exit(true);
  26469. if (TypeA.ClassType=TPasUnresolvedSymbolRef)
  26470. and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
  26471. begin
  26472. Result:=CompareText(TypeA.Name,TypeB.Name)=0;
  26473. exit;
  26474. end;
  26475. Result:=false;
  26476. end;
  26477. function TPasResolver.HasExactType(const ResolvedEl: TPasResolverResult
  26478. ): boolean;
  26479. var
  26480. IdentEl: TPasElement;
  26481. Expr: TPasExpr;
  26482. begin
  26483. IdentEl:=ResolvedEl.IdentEl;
  26484. if IdentEl<>nil then
  26485. begin
  26486. if IdentEl is TPasVariable then
  26487. exit(TPasVariable(IdentEl).VarType<>nil)
  26488. else if IdentEl.ClassType=TPasArgument then
  26489. exit(TPasArgument(IdentEl).ArgType<>nil)
  26490. else if IdentEl.ClassType=TPasResultElement then
  26491. exit(TPasResultElement(IdentEl).ResultType<>nil)
  26492. else if IdentEl is TPasType then
  26493. exit(true)
  26494. else
  26495. exit(false);
  26496. end;
  26497. Expr:=ResolvedEl.ExprEl;
  26498. if Expr<>nil then
  26499. begin
  26500. if Expr.Kind in [pekNumber,pekString,pekNil,pekBoolConst] then
  26501. exit(true)
  26502. else
  26503. exit(false);
  26504. end;
  26505. Result:=false;
  26506. end;
  26507. function TPasResolver.IndexOfGenericParam(Params: TPasExprArray): integer;
  26508. var
  26509. i: Integer;
  26510. ParamResolved: TPasResolverResult;
  26511. begin
  26512. for i:=0 to length(Params)-1 do
  26513. begin
  26514. ComputeElement(Params[i],ParamResolved,[]);
  26515. if ParamResolved.LoTypeEl is TPasGenericTemplateType then
  26516. exit(i);
  26517. end;
  26518. Result:=-1;
  26519. end;
  26520. procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
  26521. ErrorEl: TPasElement);
  26522. begin
  26523. if aType=nil then exit;
  26524. if aType is TPasGenericType then
  26525. begin
  26526. if aType.ClassType=TPasClassType then
  26527. begin
  26528. if TPasClassType(aType).HelperForType<>nil then
  26529. RaiseHelpersCannotBeUsedAsType(id,ErrorEl);
  26530. end;
  26531. if (TPasGenericType(aType).GenericTemplateTypes<>nil)
  26532. and (TPasGenericType(aType).GenericTemplateTypes.Count>0) then
  26533. begin
  26534. // ref to generic type without specialization
  26535. if not (msDelphi in CurrentParser.CurrentModeswitches)
  26536. and (ErrorEl.HasParent(aType)) then
  26537. // ObjFPC allows referring to parent without type params
  26538. else
  26539. RaiseMsg(id,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,
  26540. [ErrorEl.ElementTypeName],ErrorEl);
  26541. end;
  26542. end;
  26543. end;
  26544. function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
  26545. SkipAlias: boolean): TPasType;
  26546. var
  26547. DeclEl: TPasElement;
  26548. ClassScope: TPasClassScope;
  26549. begin
  26550. Result:=nil;
  26551. if ClassEl=nil then
  26552. exit;
  26553. if ClassEl.CustomData=nil then
  26554. exit;
  26555. if ClassEl.IsForward then
  26556. begin
  26557. DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
  26558. ClassEl:=NoNil(DeclEl) as TPasClassType;
  26559. Result:=ClassEl;
  26560. end
  26561. else
  26562. begin
  26563. ClassScope:=ClassEl.CustomData as TPasClassScope;
  26564. if not (pcsfAncestorResolved in ClassScope.Flags) then
  26565. exit;
  26566. if SkipAlias then
  26567. begin
  26568. if ClassScope.AncestorScope=nil then
  26569. exit;
  26570. Result:=TPasClassType(ClassScope.AncestorScope.Element);
  26571. end
  26572. else
  26573. Result:=ClassScope.DirectAncestor;
  26574. end;
  26575. end;
  26576. function TPasResolver.GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
  26577. var
  26578. Parent: TPasElement;
  26579. i: Integer;
  26580. CurClass: TPasClassType;
  26581. Ref: TResolvedReference;
  26582. Decls: TFPList;
  26583. begin
  26584. Result:=nil;
  26585. if ClassEl=nil then exit;
  26586. Parent:=ClassEl.Parent;
  26587. if not (Parent is TPasDeclarations) then
  26588. RaiseNotYetImplemented(20200926214106,ClassEl);
  26589. Decls:=TPasDeclarations(Parent).Classes;
  26590. for i:=0 to Decls.Count-1 do
  26591. begin
  26592. CurClass:=TPasClassType(Decls[i]);
  26593. if CurClass=ClassEl then exit;
  26594. if not CurClass.IsForward then continue;
  26595. Ref:=TResolvedReference(CurClass.CustomData);
  26596. if Ref.Declaration=ClassEl then
  26597. exit(TPasClassType(Ref.Declaration));
  26598. end;
  26599. end;
  26600. function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
  26601. begin
  26602. while El<>nil do
  26603. begin
  26604. if El is TProcedureBody then
  26605. exit(TProcedureBody(El));
  26606. El:=El.Parent;
  26607. end;
  26608. Result:=nil;
  26609. end;
  26610. function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
  26611. begin
  26612. Result:=GetProcFirstImplEl(Proc)<>nil;
  26613. end;
  26614. function TPasResolver.IndexOfImplementedInterface(ClassEl: TPasClassType;
  26615. aType: TPasType): integer;
  26616. var
  26617. List: TFPList;
  26618. i: Integer;
  26619. begin
  26620. if aType=nil then exit(-1);
  26621. aType:=ResolveAliasType(aType);
  26622. List:=ClassEl.Interfaces;
  26623. for i:=0 to List.Count-1 do
  26624. if ResolveAliasType(TPasType(List[i]))=aType then
  26625. exit(i);
  26626. Result:=-1;
  26627. end;
  26628. function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
  26629. begin
  26630. while El<>nil do
  26631. begin
  26632. if (El.ClassType=TPasImplRepeatUntil)
  26633. or (El.ClassType=TPasImplWhileDo)
  26634. or (El.ClassType=TPasImplForLoop) then
  26635. exit(TPasImplElement(El));
  26636. El:=El.Parent;
  26637. end;
  26638. Result:=nil;
  26639. end;
  26640. function TPasResolver.ResolveAliasType(aType: TPasType; SkipTypeAlias: boolean
  26641. ): TPasType;
  26642. var
  26643. C: TClass;
  26644. begin
  26645. while aType<>nil do
  26646. begin
  26647. C:=aType.ClassType;
  26648. if C=TPasAliasType then
  26649. aType:=TPasAliasType(aType).DestType
  26650. else if (C=TPasTypeAliasType) and SkipTypeAlias then
  26651. aType:=TPasAliasType(aType).DestType
  26652. else if (C=TPasClassType) and TPasClassType(aType).IsForward
  26653. and (aType.CustomData is TResolvedReference) then
  26654. aType:=NoNil(TResolvedReference(aType.CustomData).Declaration) as TPasType
  26655. else if C=TPasSpecializeType then
  26656. begin
  26657. if aType.CustomData is TPasSpecializeTypeData then
  26658. exit(TPasSpecializeTypeData(aType.CustomData).SpecializedType);
  26659. aType:=TPasSpecializeType(aType).DestType;
  26660. end
  26661. else
  26662. exit(aType);
  26663. end;
  26664. Result:=nil;
  26665. end;
  26666. function TPasResolver.ResolveAliasTypeEl(El: TPasElement): TPasType;
  26667. begin
  26668. if (El is TPasType) then
  26669. Result:=ResolveAliasType(TPasType(El))
  26670. else
  26671. Result:=nil;
  26672. end;
  26673. function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
  26674. { returns true if El is
  26675. a) the last element of an @ operator expression
  26676. e.g. '@p().o[].El' or '@El[]'
  26677. b) mode delphi: the last element of a right side of an assignment
  26678. c) an accessor function, e.g. property P read El;
  26679. }
  26680. var
  26681. Parent: TPasElement;
  26682. Prop: TPasProperty;
  26683. begin
  26684. Result:=false;
  26685. if El=nil then exit;
  26686. if not IsNameExpr(El) then
  26687. exit;
  26688. repeat
  26689. Parent:=El.Parent;
  26690. //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
  26691. if Parent.ClassType=TUnaryExpr then
  26692. begin
  26693. if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
  26694. end
  26695. else if Parent.ClassType=TBinaryExpr then
  26696. begin
  26697. if TBinaryExpr(Parent).right<>El then exit;
  26698. if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
  26699. end
  26700. else if Parent.ClassType=TParamsExpr then
  26701. begin
  26702. if TParamsExpr(Parent).Value<>El then exit;
  26703. end
  26704. else if Parent.ClassType=TPasProperty then
  26705. begin
  26706. Prop:=TPasProperty(Parent);
  26707. Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
  26708. exit;
  26709. end
  26710. else if Parent.ClassType=TPasImplAssign then
  26711. begin
  26712. if TPasImplAssign(Parent).right<>El then exit;
  26713. if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
  26714. exit;
  26715. end
  26716. else
  26717. exit;
  26718. El:=TPasExpr(Parent);
  26719. until false;
  26720. end;
  26721. function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
  26722. var
  26723. C: TClass;
  26724. P: TPasElement;
  26725. begin
  26726. if (El=nil) or (El.Parent=nil) then exit(false);
  26727. Result:=false;
  26728. P:=El.Parent;
  26729. C:=P.ClassType;
  26730. if C=TBinaryExpr then
  26731. begin
  26732. if TBinaryExpr(P).right=El then
  26733. begin
  26734. if (TBinaryExpr(P).OpCode=eopSubIdent)
  26735. or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
  26736. Result:=ParentNeedsExprResult(TBinaryExpr(P))
  26737. else
  26738. Result:=true;
  26739. end
  26740. else
  26741. Result:=true;
  26742. end
  26743. else if C.InheritsFrom(TPasExpr) then
  26744. Result:=true
  26745. else if (C=TPasEnumValue)
  26746. or (C=TPasArgument)
  26747. or (C=TPasVariable)
  26748. or (C=TPasExportSymbol) then
  26749. Result:=true
  26750. else if C=TPasClassType then
  26751. Result:=TPasClassType(P).GUIDExpr=El
  26752. else if C=TPasProperty then
  26753. Result:=(TPasProperty(P).IndexExpr=El)
  26754. or (TPasProperty(P).DispIDExpr=El)
  26755. or (TPasProperty(P).DefaultExpr=El)
  26756. else if C=TPasProcedure then
  26757. Result:=(TPasProcedure(P).LibraryExpr=El)
  26758. or (TPasProcedure(P).DispIDExpr=El)
  26759. else if C=TPasImplRepeatUntil then
  26760. Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
  26761. else if C=TPasImplIfElse then
  26762. Result:=(TPasImplIfElse(P).ConditionExpr=El)
  26763. else if C=TPasImplWhileDo then
  26764. Result:=(TPasImplWhileDo(P).ConditionExpr=El)
  26765. else if C=TPasImplWithDo then
  26766. Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
  26767. else if C=TPasImplCaseOf then
  26768. Result:=(TPasImplCaseOf(P).CaseExpr=El)
  26769. else if C=TPasImplCaseStatement then
  26770. Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
  26771. else if C=TPasImplForLoop then
  26772. Result:=(TPasImplForLoop(P).StartExpr=El)
  26773. or (TPasImplForLoop(P).EndExpr=El)
  26774. else if C=TPasImplAssign then
  26775. Result:=(TPasImplAssign(P).right=El)
  26776. else if C=TPasImplRaise then
  26777. Result:=(TPasImplRaise(P).ExceptAddr=El);
  26778. end;
  26779. function TPasResolver.GetReference_ConstructorType(Ref: TResolvedReference;
  26780. Expr: TPasExpr): TPasResolverResult;
  26781. var
  26782. TypeEl: TPasType;
  26783. begin
  26784. TypeEl:=(Ref.Context as TResolvedRefCtxConstructor).Typ;
  26785. if TypeEl=nil then
  26786. RaiseNotYetImplemented(20190125205339,Expr)
  26787. else if TypeEl is TPasMembersType then
  26788. SetResolverValueExpr(Result,btContext,TypeEl,TypeEl,Expr,[rrfReadable])
  26789. else
  26790. begin
  26791. ComputeElement(TypeEl,Result,[rcType]);
  26792. Result.ExprEl:=Expr;
  26793. Result.Flags:=[rrfReadable];
  26794. end;
  26795. end;
  26796. function TPasResolver.GetParamsValueRef(Params: TParamsExpr): TResolvedReference;
  26797. var
  26798. El: TPasExpr;
  26799. begin
  26800. Result:=nil;
  26801. if Params=nil then exit;
  26802. El:=Params.Value;
  26803. while El<>nil do
  26804. begin
  26805. if El.CustomData is TResolvedReference then
  26806. exit(TResolvedReference(El.CustomData));
  26807. if El.ClassType=TInlineSpecializeExpr then
  26808. El:=TInlineSpecializeExpr(El).NameExpr
  26809. else if (El.ClassType=TBinaryExpr)
  26810. and (TBinaryExpr(El).OpCode=eopSubIdent) then
  26811. El:=TBinaryExpr(El).right
  26812. else
  26813. exit;
  26814. end;
  26815. end;
  26816. function TPasResolver.GetSetType(const ResolvedSet: TPasResolverResult
  26817. ): TPasSetType;
  26818. var
  26819. IdentEl: TPasElement;
  26820. aType: TPasType;
  26821. C: TClass;
  26822. begin
  26823. Result:=nil;
  26824. if ResolvedSet.BaseType=btSet then
  26825. begin
  26826. IdentEl:=ResolvedSet.IdentEl;
  26827. if IdentEl=nil then exit;
  26828. C:=IdentEl.ClassType;
  26829. if (C=TPasVariable)
  26830. or (C=TPasConst) then
  26831. aType:=TPasVariable(IdentEl).VarType
  26832. else if C=TPasProperty then
  26833. aType:=GetPasPropertyType(TPasProperty(IdentEl))
  26834. else if C=TPasArgument then
  26835. aType:=TPasArgument(IdentEl).ArgType
  26836. else if C.InheritsFrom(TPasProcedure)
  26837. and (TPasProcedure(IdentEl).ProcType is TPasFunctionType) then
  26838. aType:=TPasFunctionType(TPasProcedure(IdentEl).ProcType).ResultEl.ResultType
  26839. else if C=TPasSetType then
  26840. exit(TPasSetType(IdentEl))
  26841. else
  26842. exit;
  26843. if aType.ClassType=TPasSetType then
  26844. Result:=TPasSetType(aType);
  26845. end
  26846. else if ResolvedSet.BaseType=btContext then
  26847. begin
  26848. if ResolvedSet.LoTypeEl.ClassType=TPasSetType then
  26849. if ResolvedSet.HiTypeEl.ClassType=TPasSetType then
  26850. Result:=TPasSetType(ResolvedSet.HiTypeEl)
  26851. else
  26852. Result:=TPasSetType(ResolvedSet.LoTypeEl);
  26853. end;
  26854. end;
  26855. function TPasResolver.IsDynArray(TypeEl: TPasType; OptionalOpenArray: boolean
  26856. ): boolean;
  26857. begin
  26858. TypeEl:=ResolveAliasType(TypeEl);
  26859. if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType) then
  26860. exit(false);
  26861. if length(TPasArrayType(TypeEl).Ranges)<>0 then
  26862. exit(false);
  26863. // Note: Array of Const is an open array of TVarRec
  26864. if OptionalOpenArray and (proOpenAsDynArrays in Options) then
  26865. Result:=true
  26866. else
  26867. Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
  26868. end;
  26869. function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
  26870. begin
  26871. Result:=(TypeEl<>nil)
  26872. and (TypeEl.ClassType=TPasArrayType)
  26873. and (length(TPasArrayType(TypeEl).Ranges)=0)
  26874. and (TypeEl.Parent<>nil)
  26875. and (TypeEl.Parent.ClassType=TPasArgument);
  26876. end;
  26877. function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
  26878. begin
  26879. TypeEl:=ResolveAliasType(TypeEl);
  26880. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  26881. and (length(TPasArrayType(TypeEl).Ranges)=0);
  26882. end;
  26883. function TPasResolver.IsArrayOfConst(TypeEl: TPasType): boolean;
  26884. begin
  26885. Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
  26886. and (TPasArrayType(TypeEl).ElType=nil);
  26887. end;
  26888. function TPasResolver.GetArrayElType(ArrType: TPasArrayType): TPasType;
  26889. begin
  26890. Result:=ArrType.ElType;
  26891. if Result=nil then
  26892. Result:=GetTVarRec(ArrType);
  26893. end;
  26894. function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
  26895. var
  26896. C: TClass;
  26897. begin
  26898. Result:=false;
  26899. if Expr=nil then exit;
  26900. if Expr.Parent=nil then exit;
  26901. C:=Expr.Parent.ClassType;
  26902. if C.InheritsFrom(TPasVariable) then
  26903. Result:=(TPasVariable(Expr.Parent).Expr=Expr)
  26904. else if C=TPasArgument then
  26905. Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
  26906. end;
  26907. function TPasResolver.IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
  26908. begin
  26909. Result:=(ResolvedEl.BaseType in [btSet,btArrayOrSet,btArrayLit])
  26910. and (ResolvedEl.SubType=btNone);
  26911. end;
  26912. function TPasResolver.IsClassMethod(El: TPasElement): boolean;
  26913. var
  26914. C: TClass;
  26915. begin
  26916. if El=nil then exit(false);
  26917. C:=El.ClassType;;
  26918. Result:=(C=TPasClassConstructor)
  26919. or (C=TPasClassDestructor)
  26920. or (C=TPasClassProcedure)
  26921. or (C=TPasClassFunction)
  26922. or (C=TPasClassOperator);
  26923. end;
  26924. function TPasResolver.IsClassField(El: TPasElement): boolean;
  26925. var
  26926. C: TClass;
  26927. begin
  26928. if ((El.ClassType=TPasVariable) or (El.ClassType=TPasConst))
  26929. and ([vmClass,vmStatic]*TPasVariable(El).VarModifiers<>[]) then
  26930. begin
  26931. C:=El.Parent.ClassType;
  26932. Result:=(C=TPasClassType) or (C=TPasRecordType);
  26933. end
  26934. else
  26935. Result:=false;
  26936. end;
  26937. function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
  26938. var
  26939. ProcType: TPasProcedureType;
  26940. begin
  26941. if not (El is TPasProcedure) then exit(nil);
  26942. ProcType:=TPasProcedure(El).ProcType;
  26943. if ProcType is TPasFunctionType then
  26944. Result:=TPasFunctionType(ProcType)
  26945. else
  26946. Result:=nil;
  26947. end;
  26948. function TPasResolver.MethodIsStatic(El: TPasProcedure): boolean;
  26949. begin
  26950. Result:=(ptmStatic in El.ProcType.Modifiers)
  26951. or (El.ClassType=TPasClassConstructor)
  26952. or (El.ClassType=TPasClassDestructor);
  26953. end;
  26954. function TPasResolver.IsMethod(El: TPasProcedure): boolean;
  26955. var
  26956. ProcScope: TPasProcedureScope;
  26957. begin
  26958. Result:=false;
  26959. if El=nil then exit;
  26960. if El.Parent is TPasMembersType then exit(true);
  26961. if not (El.CustomData is TPasProcedureScope) then exit;
  26962. ProcScope:=TPasProcedureScope(El.CustomData);
  26963. Result:=IsMethod(ProcScope.DeclarationProc);
  26964. end;
  26965. function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
  26966. begin
  26967. Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
  26968. and (TPasClassType(El.Parent).HelperForType<>nil);
  26969. end;
  26970. function TPasResolver.IsHelper(El: TPasElement): boolean;
  26971. begin
  26972. Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil);
  26973. end;
  26974. function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
  26975. const ExtName: string): boolean;
  26976. var
  26977. AncestorScope: TPasClassScope;
  26978. begin
  26979. Result:=false;
  26980. if aClass=nil then exit;
  26981. while aClass<>nil do
  26982. begin
  26983. if aClass.ExternalName=ExtName then exit(true);
  26984. AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
  26985. if AncestorScope=nil then exit;
  26986. aClass:=NoNil(AncestorScope.Element) as TPasClassType;
  26987. end;
  26988. end;
  26989. function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
  26990. HasValue: boolean): boolean;
  26991. var
  26992. TypeEl: TPasType;
  26993. begin
  26994. if (ResolvedEl.BaseType<>btContext) then
  26995. exit(false);
  26996. TypeEl:=ResolvedEl.LoTypeEl;
  26997. if not (TypeEl is TPasProcedureType) then
  26998. exit(false);
  26999. if HasValue and not (rrfReadable in ResolvedEl.Flags) then
  27000. exit(false);
  27001. Result:=true;
  27002. end;
  27003. function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
  27004. ): boolean;
  27005. begin
  27006. Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasArrayType);
  27007. end;
  27008. function TPasResolver.IsArrayExpr(Expr: TParamsExpr): TPasArrayType;
  27009. var
  27010. Ref: TResolvedReference;
  27011. begin
  27012. Result:=nil;
  27013. if Expr=nil then exit;
  27014. if Expr.Kind<>pekSet then exit;
  27015. if not (Expr.CustomData is TResolvedReference) then exit;
  27016. Ref:=TResolvedReference(Expr.CustomData);
  27017. if Ref.Declaration is TPasArrayType then
  27018. Result:=TPasArrayType(Ref.Declaration);
  27019. end;
  27020. function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
  27021. begin
  27022. Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
  27023. and ElHasModeSwitch(Expr,msArrayOperators);
  27024. end;
  27025. function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
  27026. var
  27027. Value: TPasExpr;
  27028. Ref: TResolvedReference;
  27029. Decl: TPasElement;
  27030. C: TClass;
  27031. begin
  27032. Result:=false;
  27033. if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
  27034. Value:=Params.Value;
  27035. if not IsNameExpr(Value) then
  27036. exit;
  27037. if not (Value.CustomData is TResolvedReference) then exit;
  27038. Ref:=TResolvedReference(Value.CustomData);
  27039. Decl:=Ref.Declaration;
  27040. C:=Decl.ClassType;
  27041. if (C=TPasAliasType) or (C=TPasTypeAliasType) then
  27042. begin
  27043. Decl:=ResolveAliasType(TPasAliasType(Decl));
  27044. C:=Decl.ClassType;
  27045. end;
  27046. if (C=TPasProcedureType)
  27047. or (C=TPasFunctionType) then
  27048. exit(true)
  27049. else if (C=TPasClassType)
  27050. or (C=TPasClassOfType)
  27051. or (C=TPasEnumType)
  27052. or (C=TPasRecordType)
  27053. or (C=TPasArrayType)
  27054. or (C=TPasSpecializeType)
  27055. or (C=TPasGenericTemplateType) then
  27056. exit(true)
  27057. else if (C=TPasUnresolvedSymbolRef)
  27058. and (Decl.CustomData is TResElDataBaseType) then
  27059. exit(true);
  27060. end;
  27061. function TPasResolver.GetTypeParameterCount(aType: TPasGenericType): integer;
  27062. begin
  27063. if aType=nil then exit(0);
  27064. if aType.GenericTemplateTypes=nil then exit(0);
  27065. Result:=aType.GenericTemplateTypes.Count;
  27066. end;
  27067. function TPasResolver.GetGenericConstraintKeyword(El: TPasElement): TToken;
  27068. var
  27069. Prim: TPrimitiveExpr;
  27070. begin
  27071. if (El=nil) or (El.ClassType<>TPrimitiveExpr) then
  27072. exit(tkEOF);
  27073. Prim:=TPrimitiveExpr(El);
  27074. if Prim.Kind<>pekIdent then
  27075. exit(tkEOF);
  27076. case lowercase(Prim.Value) of
  27077. 'record': Result:=tkrecord;
  27078. 'class': Result:=tkclass;
  27079. 'constructor': Result:=tkconstructor;
  27080. else Result:=tkEOF;
  27081. end;
  27082. end;
  27083. function TPasResolver.GetGenericConstraintErrorEl(ConstraintEl,
  27084. TemplType: TPasElement): TPasElement;
  27085. begin
  27086. if (ConstraintEl is TPasExpr) or (ConstraintEl.Parent=TemplType) then
  27087. Result:=ConstraintEl
  27088. else
  27089. Result:=TemplType;
  27090. end;
  27091. function TPasResolver.GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
  27092. Params: TFPList): TPasElement;
  27093. var
  27094. Data: TPasSpecializeTypeData;
  27095. GenScope: TPasGenericScope;
  27096. GenericTemplateList: TFPList;
  27097. i, j: Integer;
  27098. Param: TPasElement;
  27099. ParamsResolved: TPasTypeArray;
  27100. ResolvedEl: TPasResolverResult;
  27101. SpecializedElList: TObjectList;
  27102. Item: TPRSpecializedItem;
  27103. SrcModule: TPasModule;
  27104. SrcModuleScope: TPasModuleScope;
  27105. SrcResolver: TPasResolver;
  27106. IsSelf: Boolean;
  27107. GenericType: TPasGenericType;
  27108. GenericProc: TPasProcedure;
  27109. ProcScope: TPasProcedureScope;
  27110. begin
  27111. Result:=nil;
  27112. if (El.ClassType=TPasSpecializeType) and (El.CustomData<>nil) then
  27113. RaiseNotYetImplemented(20190726142522,El);
  27114. // check if there is already such a specialization
  27115. GenScope:=nil;
  27116. GenericType:=nil;
  27117. GenericProc:=nil;
  27118. if GenericEl is TPasGenericType then
  27119. begin
  27120. GenericType:=TPasGenericType(GenericEl);
  27121. if not (GenericEl.CustomData is TPasGenericScope) then
  27122. RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27123. [GetTypeDescription(GenericType)],El);
  27124. GenScope:=TPasGenericScope(GenericEl.CustomData);
  27125. if (not (GenericType is TPasClassType))
  27126. and (GenScope.GenericStep<psgsInterfaceParsed) then
  27127. RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27128. [GetTypeDescription(GenericType)],El);
  27129. GenericTemplateList:=GenericType.GenericTemplateTypes;
  27130. end
  27131. else if GenericEl is TPasProcedure then
  27132. begin
  27133. GenericProc:=TPasProcedure(GenericEl);
  27134. if not (GenericProc.CustomData is TPasProcedureScope) then
  27135. RaiseMsg(20190919132733,nIdentifierNotFound,sIdentifierNotFound,
  27136. [GenericProc.Name],El);
  27137. ProcScope:=TPasProcedureScope(GenericProc.CustomData);
  27138. if ProcScope.DeclarationProc<>nil then
  27139. RaiseNotYetImplemented(20190920182602,El);
  27140. GenScope:=ProcScope;
  27141. if GenScope.GenericStep<psgsInterfaceParsed then
  27142. RaiseMsg(20190920120649,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
  27143. [GetElementDbgPath(GenericProc)],El);
  27144. GenericTemplateList:=GetProcTemplateTypes(GenericProc);
  27145. end
  27146. else
  27147. RaiseNotYetImplemented(20190919132603,GenericEl);
  27148. SpecializedElList:=GenScope.SpecializedItems;
  27149. if GenericTemplateList=nil then
  27150. RaiseMsg(20190905111703,nXExpectedButYFound,sXExpectedButYFound,
  27151. ['generic templates',GenericEl.Name],El);
  27152. if GenericTemplateList.Count<>Params.Count then
  27153. RaiseMsg(20190905111704,nXExpectedButYFound,sXExpectedButYFound,
  27154. ['type with '+IntToStr(Params.Count)+' generic template(s)',
  27155. GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
  27156. SetLength(ParamsResolved{%H-},Params.Count);
  27157. IsSelf:=true;
  27158. for i:=0 to Params.Count-1 do
  27159. begin
  27160. Param:=TPasElement(Params[i]);
  27161. ComputeElement(Param,ResolvedEl,[rcType]);
  27162. ParamsResolved[i]:=ResolvedEl.LoTypeEl;
  27163. if ResolvedEl.LoTypeEl<>TPasType(GenericTemplateList[i]) then
  27164. IsSelf:=false;
  27165. end;
  27166. if IsSelf then
  27167. exit(GenericEl);
  27168. if SpecializedElList=nil then
  27169. begin
  27170. SpecializedElList:=TObjectList.Create(true);
  27171. if GenScope<>nil then
  27172. GenScope.SpecializedItems:=SpecializedElList
  27173. else
  27174. RaiseNotYetImplemented(20190919133159,El);
  27175. end;
  27176. i:=SpecializedElList.Count-1;
  27177. Item:=nil;
  27178. while i>=0 do
  27179. begin
  27180. Item:=TPRSpecializedItem(SpecializedElList[i]);
  27181. j:=length(Item.Params)-1;
  27182. while j>=0 do
  27183. begin
  27184. if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
  27185. and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
  27186. break;
  27187. dec(j);
  27188. end;
  27189. if j<0 then
  27190. break;
  27191. Item:=nil;
  27192. dec(i);
  27193. end;
  27194. if Item=nil then
  27195. begin
  27196. // new specialization
  27197. SrcModule:=GenericEl.GetModule;
  27198. SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
  27199. SrcResolver:=SrcModuleScope.Owner as TPasResolver;
  27200. Item:=SrcResolver.CreateSpecializedItem(El,GenericEl,ParamsResolved)
  27201. end;
  27202. Result:=Item.SpecializedEl;
  27203. if El.ClassType=TPasSpecializeType then
  27204. begin
  27205. Data:=TPasSpecializeTypeData.Create;
  27206. // add to free list
  27207. AddResolveData(El,Data,lkModule);
  27208. Data.SpecializedType:=Result as TPasGenericType; // no AddRef
  27209. end;
  27210. end;
  27211. procedure TPasResolver.FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope);
  27212. var
  27213. El: TPasGenericType;
  27214. SpecializedItems: TObjectList;
  27215. i: Integer;
  27216. SpecializedItem: TPRSpecializedTypeItem;
  27217. OldScopeState: TScopeStashState;
  27218. begin
  27219. El:=Scope.Element as TPasGenericType;
  27220. if Scope.GenericStep<>psgsNone then
  27221. RaiseNotYetImplemented(20200219124544,El);
  27222. Scope.GenericStep:=psgsInterfaceParsed;
  27223. SpecializedItems:=Scope.SpecializedItems;
  27224. if SpecializedItems<>nil then
  27225. // finish interfaces of started specializations
  27226. for i:=0 to SpecializedItems.Count-1 do
  27227. begin
  27228. SpecializedItem:=TPRSpecializedTypeItem(SpecializedItems[i]);
  27229. SpecializedItem.GenericEl:=El;
  27230. if SpecializedItem.Step<>prssNone then continue;
  27231. InitSpecializeScopes(El,OldScopeState);
  27232. {$IFDEF VerbosePasResolver}
  27233. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finishing specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  27234. {$ENDIF}
  27235. SpecializeGenericIntf(SpecializedItem);
  27236. {$IFDEF VerbosePasResolver}
  27237. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finished specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
  27238. {$ENDIF}
  27239. RestoreSpecializeScopes(OldScopeState);
  27240. {$IFDEF VerbosePasResolver}
  27241. WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf RestoreStashedScopes '+GetObjName(SpecializedItem.SpecializedType));
  27242. {$ENDIF}
  27243. end;
  27244. end;
  27245. procedure TPasResolver.FinishSpecializations(Scope: TPasGenericScope);
  27246. var
  27247. SpecializedItems: TObjectList;
  27248. i: Integer;
  27249. begin
  27250. SpecializedItems:=Scope.SpecializedItems;
  27251. if SpecializedItems=nil then exit;
  27252. for i:=0 to SpecializedItems.Count-1 do
  27253. SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
  27254. end;
  27255. function TPasResolver.IsSpecialized(El: TPasGenericType): boolean;
  27256. begin
  27257. Result:=(El<>nil) and (El.CustomData is TPasGenericScope)
  27258. and (TPasGenericScope(El.CustomData).SpecializedFromItem<>nil);
  27259. end;
  27260. function TPasResolver.IsFullySpecialized(El: TPasGenericType): boolean;
  27261. var
  27262. GenScope: TPasGenericScope;
  27263. Params: TPasTypeArray;
  27264. i: Integer;
  27265. begin
  27266. if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
  27267. exit(false);
  27268. if not (El.CustomData is TPasGenericScope) then exit(true);
  27269. GenScope:=TPasGenericScope(El.CustomData);
  27270. if GenScope.SpecializedFromItem=nil then exit(true);
  27271. Params:=GenScope.SpecializedFromItem.Params;
  27272. for i:=0 to length(Params)-1 do
  27273. if Params[i] is TPasGenericTemplateType then exit(false);
  27274. Result:=true;
  27275. end;
  27276. function TPasResolver.IsFullySpecialized(Proc: TPasProcedure): boolean;
  27277. var
  27278. Templates: TFPList;
  27279. ProcScope: TPasProcedureScope;
  27280. Params: TPasTypeArray;
  27281. i: Integer;
  27282. begin
  27283. if Proc.CustomData=nil then exit(false);
  27284. ProcScope:=TPasProcedureScope(Proc.CustomData);
  27285. if ProcScope.DeclarationProc<>nil then
  27286. begin
  27287. Proc:=ProcScope.DeclarationProc;
  27288. ProcScope:=TPasProcedureScope(Proc.CustomData);
  27289. end;
  27290. Templates:=GetProcTemplateTypes(Proc);
  27291. if (Templates<>nil) and (Templates.Count>0) then
  27292. exit(false);
  27293. if ProcScope.SpecializedFromItem=nil then
  27294. exit(true);
  27295. Params:=ProcScope.SpecializedFromItem.Params;
  27296. for i:=0 to length(Params)-1 do
  27297. if Params[i] is TPasGenericTemplateType then exit(false);
  27298. Result:=true;
  27299. end;
  27300. function TPasResolver.IsInterfaceType(const ResolvedEl: TPasResolverResult;
  27301. IntfType: TPasClassInterfaceType): boolean;
  27302. begin
  27303. if ResolvedEl.BaseType<>btContext then exit(false);
  27304. Result:=IsInterfaceType(ResolvedEl.LoTypeEl,IntfType);
  27305. end;
  27306. function TPasResolver.IsInterfaceType(TypeEl: TPasType;
  27307. IntfType: TPasClassInterfaceType): boolean;
  27308. begin
  27309. if TypeEl=nil then exit(false);
  27310. TypeEl:=ResolveAliasType(TypeEl);
  27311. Result:=(TypeEl.ClassType=TPasClassType)
  27312. and (TPasClassType(TypeEl).ObjKind=okInterface)
  27313. and (TPasClassType(TypeEl).InterfaceType=IntfType);
  27314. end;
  27315. function TPasResolver.IsTGUID(RecTypeEl: TPasRecordType): boolean;
  27316. var
  27317. Members: TFPList;
  27318. El: TPasElement;
  27319. begin
  27320. Result:=false;
  27321. if not SameText(RecTypeEl.Name,'TGUID') then exit;
  27322. if SameText(RecTypeEl.GetModule.Name,'system') then exit(true);
  27323. Members:=RecTypeEl.Members;
  27324. if Members.Count<4 then exit;
  27325. El:=TPasElement(Members[0]);
  27326. if not SameText(El.Name,'D1') then exit;
  27327. El:=TPasElement(Members[1]);
  27328. if not SameText(El.Name,'D2') then exit;
  27329. El:=TPasElement(Members[2]);
  27330. if not SameText(El.Name,'D3') then exit;
  27331. El:=TPasElement(Members[3]);
  27332. if not SameText(El.Name,'D4') then exit;
  27333. Result:=true;
  27334. end;
  27335. function TPasResolver.IsTGUIDString(const ResolvedEl: TPasResolverResult
  27336. ): boolean;
  27337. var
  27338. TypeEl: TPasType;
  27339. C: TClass;
  27340. IdentEl: TPasElement;
  27341. begin
  27342. if not (ResolvedEl.BaseType in btAllStrings) then
  27343. exit(false);
  27344. if (ResolvedEl.ExprEl<>nil) and (ResolvedEl.LoTypeEl<>nil) then
  27345. exit(true); // untyped string literal
  27346. IdentEl:=ResolvedEl.IdentEl;
  27347. if IdentEl<>nil then
  27348. begin
  27349. C:=IdentEl.ClassType;
  27350. if C.InheritsFrom(TPasVariable) then
  27351. TypeEl:=TPasVariable(IdentEl).VarType
  27352. else if C=TPasArgument then
  27353. TypeEl:=TPasArgument(IdentEl).ArgType
  27354. else if C=TPasResultElement then
  27355. TypeEl:=TPasResultElement(IdentEl).ResultType
  27356. else
  27357. TypeEl:=nil;
  27358. while TypeEl<>nil do
  27359. begin
  27360. if (TypeEl.ClassType=TPasAliasType)
  27361. or (TypeEl.ClassType=TPasTypeAliasType) then
  27362. begin
  27363. if SameText(TypeEl.Name,'TGUIDString') then
  27364. exit(true);
  27365. TypeEl:=TPasAliasType(TypeEl).DestType;
  27366. end
  27367. else
  27368. break;
  27369. end;
  27370. end;
  27371. Result:=false;
  27372. end;
  27373. function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
  27374. var
  27375. ClassEl: TPasClassType;
  27376. ClassScope: TPasClassScope;
  27377. aModule: TPasModule;
  27378. begin
  27379. Result:=false;
  27380. if (El=nil)
  27381. or (El.ClassType<>TPasClassType) then exit;
  27382. ClassEl:=TPasClassType(El);
  27383. if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
  27384. while not SameText(ClassEl.Name,'TCustomAttribute') do
  27385. begin
  27386. ClassScope:=ClassEl.CustomData as TPasClassScope;
  27387. if ClassScope.AncestorScope=nil then exit;
  27388. ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
  27389. end;
  27390. if not (ClassEl.Parent is TPasSection) then
  27391. exit; // this TCustomAttribute is not top level
  27392. aModule:=ClassEl.GetModule;
  27393. Result:=IsSystemUnit(aModule);
  27394. end;
  27395. function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
  27396. var
  27397. Section: TPasSection;
  27398. begin
  27399. Result:=false;
  27400. if El=nil then exit;
  27401. if SameText(El.Name,'system') then exit(true);
  27402. // tests and scripts are their own system unit: check if this is the root module
  27403. if El.ClassType=TPasProgram then
  27404. Section:=TPasProgram(El).ProgramSection
  27405. else if El.ClassType=TPasLibrary then
  27406. Section:=TPasLibrary(El).LibrarySection
  27407. else
  27408. Section:=El.InterfaceSection;
  27409. Result:=length(Section.UsesClause)=0;
  27410. end;
  27411. function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
  27412. var
  27413. Parent: TPasElement;
  27414. C: TClass;
  27415. Members: TFPList;
  27416. i: Integer;
  27417. begin
  27418. Result:=nil;
  27419. if El=nil then exit;
  27420. // find El in El.Parent members
  27421. Parent:=El.Parent;
  27422. if Parent=nil then exit;
  27423. C:=Parent.ClassType;
  27424. if C.InheritsFrom(TPasDeclarations) then
  27425. Members:=TPasDeclarations(Parent).Declarations
  27426. else if C.InheritsFrom(TPasMembersType) then
  27427. Members:=TPasMembersType(Parent).Members
  27428. else
  27429. exit;
  27430. i:=Members.IndexOf(El);
  27431. if i<0 then exit;
  27432. Result:=GetAttributeCalls(Members,i);
  27433. end;
  27434. function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
  27435. ): TPasExprArray;
  27436. procedure AddAttributesInFront(Members: TFPList; i: integer);
  27437. var
  27438. j, l, k: Integer;
  27439. Calls: TPasExprArray;
  27440. begin
  27441. // find attributes in front
  27442. j:=i;
  27443. while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
  27444. dec(j);
  27445. // collect all attribute calls
  27446. l:=0;
  27447. while j<i do
  27448. begin
  27449. Calls:=TPasAttributes(Members[j]).Calls;
  27450. SetLength(Result,l+length(Calls));
  27451. for k:=0 to length(Calls)-1 do
  27452. begin
  27453. Result[l]:=Calls[k];
  27454. inc(l);
  27455. end;
  27456. inc(j);
  27457. end;
  27458. end;
  27459. var
  27460. El, CurEl: TPasElement;
  27461. begin
  27462. Result:=nil;
  27463. El:=TPasElement(Members[Index]);
  27464. AddAttributesInFront(Members,Index);
  27465. if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
  27466. repeat
  27467. dec(Index);
  27468. if Index<1 then break;
  27469. CurEl:=TPasElement(Members[Index]);
  27470. if (CurEl.ClassType=TPasClassType)
  27471. and TPasClassType(CurEl).IsForward
  27472. and (TPasClassType(CurEl).CustomData is TResolvedReference)
  27473. and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
  27474. then
  27475. begin
  27476. // class has a forward declaration -> add attributes
  27477. AddAttributesInFront(Members,Index);
  27478. break;
  27479. end;
  27480. until false;
  27481. end;
  27482. function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
  27483. begin
  27484. Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
  27485. end;
  27486. function TPasResolver.IsProcOverride(AncestorProc, DescendantProc: TPasProcedure
  27487. ): boolean;
  27488. var
  27489. Proc, OverriddenProc: TPasProcedure;
  27490. begin
  27491. Result:=false;
  27492. Proc:=DescendantProc;
  27493. if not Proc.IsOverride then exit;
  27494. if not AncestorProc.IsOverride and not AncestorProc.IsVirtual then exit;
  27495. repeat
  27496. OverriddenProc:=TPasProcedureScope(Proc.CustomData).OverriddenProc;
  27497. if AncestorProc=OverriddenProc then exit(true);
  27498. Proc:=OverriddenProc;
  27499. until Proc=nil;
  27500. end;
  27501. function TPasResolver.GetTopLvlProc(El: TPasElement): TPasProcedure;
  27502. begin
  27503. Result:=nil;
  27504. while El<>nil do
  27505. begin
  27506. if El is TPasProcedure then
  27507. Result:=TPasProcedure(El);
  27508. El:=El.Parent;
  27509. end;
  27510. end;
  27511. function TPasResolver.GetParentProc(El: TPasElement; GetDeclProc: boolean
  27512. ): TPasProcedure;
  27513. var
  27514. ProcScope: TPasProcedureScope;
  27515. begin
  27516. Result:=nil;
  27517. while El<>nil do
  27518. begin
  27519. if El is TPasProcedure then
  27520. begin
  27521. Result:=TPasProcedure(El);
  27522. if GetDeclProc and (El.CustomData is TPasProcedureScope) then
  27523. begin
  27524. ProcScope:=TPasProcedureScope(El.CustomData);
  27525. if ProcScope.DeclarationProc<>nil then
  27526. Result:=ProcScope.DeclarationProc;
  27527. end;
  27528. exit;
  27529. end;
  27530. El:=El.Parent;
  27531. end;
  27532. end;
  27533. function TPasResolver.GetRangeLength(RangeExpr: TPasExpr): TMaxPrecInt;
  27534. var
  27535. Range: TResEvalValue;
  27536. begin
  27537. Result:=0;
  27538. Range:=Eval(RangeExpr,[refConst]);
  27539. if Range=nil then
  27540. RaiseNotYetImplemented(20170910210416,RangeExpr);
  27541. try
  27542. case Range.Kind of
  27543. revkRangeInt:
  27544. Result:=TResEvalRangeInt(Range).RangeEnd-TResEvalRangeInt(Range).RangeStart+1;
  27545. revkRangeUInt:
  27546. Result:=TResEvalRangeUInt(Range).RangeEnd-TResEvalRangeUInt(Range).RangeStart+1;
  27547. else
  27548. RaiseNotYetImplemented(20170910210554,RangeExpr);
  27549. end;
  27550. finally
  27551. ReleaseEvalValue(Range);
  27552. end;
  27553. {$IFDEF VerbosePasResolver}
  27554. {AllowWriteln}
  27555. //if Result=0 then
  27556. writeln('TPasResolver.GetRangeLength Result=',Result);
  27557. {AllowWriteln-}
  27558. {$ENDIF}
  27559. end;
  27560. function TPasResolver.EvalRangeLimit(RangeExpr: TPasExpr; Flags: TResEvalFlags;
  27561. EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue;
  27562. var
  27563. Range: TResEvalValue;
  27564. EnumType: TPasEnumType;
  27565. begin
  27566. Result:=nil;
  27567. Range:=Eval(RangeExpr,Flags+[refConst]);
  27568. if Range=nil then
  27569. RaiseNotYetImplemented(20170601191258,RangeExpr);
  27570. case Range.Kind of
  27571. revkRangeInt:
  27572. case TResEvalRangeInt(Range).ElKind of
  27573. revskEnum:
  27574. begin
  27575. EnumType:=NoNil(TResEvalRangeInt(Range).ElType) as TPasEnumType;
  27576. if EvalLow then
  27577. Result:=TResEvalEnum.CreateValue(
  27578. TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
  27579. else
  27580. Result:=TResEvalEnum.CreateValue(
  27581. TResEvalRangeInt(Range).RangeEnd,
  27582. TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
  27583. end;
  27584. revskInt:
  27585. if EvalLow then
  27586. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
  27587. else
  27588. Result:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
  27589. revskChar:
  27590. {$ifdef FPC_HAS_CPSTRING}
  27591. if TResEvalRangeInt(Range).RangeEnd<256 then
  27592. begin
  27593. if EvalLow then
  27594. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
  27595. else
  27596. Result:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd));
  27597. end
  27598. else
  27599. {$endif}
  27600. begin
  27601. if EvalLow then
  27602. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeStart))
  27603. else
  27604. Result:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
  27605. end;
  27606. revskBool:
  27607. if EvalLow then
  27608. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeStart<>0)
  27609. else
  27610. Result:=TResEvalBool.CreateValue(TResEvalRangeInt(Range).RangeEnd<>0);
  27611. else
  27612. ReleaseEvalValue(Range);
  27613. RaiseNotYetImplemented(20170601195240,ErrorEl);
  27614. end;
  27615. revkRangeUInt:
  27616. if EvalLow then
  27617. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
  27618. else
  27619. Result:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
  27620. else
  27621. ReleaseEvalValue(Range);
  27622. RaiseNotYetImplemented(20170601195336,ErrorEl);
  27623. end;
  27624. ReleaseEvalValue(Range);
  27625. end;
  27626. function TPasResolver.EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags
  27627. ): TResEvalValue;
  27628. var
  27629. C: TClass;
  27630. BaseTypeData: TResElDataBaseType;
  27631. begin
  27632. Result:=nil;
  27633. Decl:=ResolveAliasType(Decl);
  27634. C:=Decl.ClassType;
  27635. if C=TPasRangeType then
  27636. begin
  27637. Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
  27638. if (Result<>nil) and (Result.IdentEl=nil) then
  27639. begin
  27640. Result.IdentEl:=Decl;
  27641. exit;
  27642. end;
  27643. end
  27644. else if C=TPasEnumType then
  27645. begin
  27646. Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
  27647. 0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
  27648. Result.IdentEl:=Decl;
  27649. exit;
  27650. end
  27651. else if C=TPasUnresolvedSymbolRef then
  27652. begin
  27653. if (Decl.CustomData is TResElDataBaseType) then
  27654. begin
  27655. BaseTypeData:=TResElDataBaseType(Decl.CustomData);
  27656. case BaseTypeData.BaseType of
  27657. btChar:
  27658. begin
  27659. Result:=TResEvalRangeInt.Create;
  27660. TResEvalRangeInt(Result).ElKind:=revskChar;
  27661. TResEvalRangeInt(Result).RangeStart:=0;
  27662. {$ifdef FPC_HAS_CPSTRING}
  27663. if BaseTypeChar in [btChar,btAnsiChar] then
  27664. TResEvalRangeInt(Result).RangeEnd:=$ff
  27665. else
  27666. {$endif}
  27667. TResEvalRangeInt(Result).RangeEnd:=$ffff;
  27668. end;
  27669. {$ifdef FPC_HAS_CPSTRING}
  27670. btAnsiChar:
  27671. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
  27672. {$endif}
  27673. btWideChar:
  27674. Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
  27675. btBoolean,btByteBool,btWordBool{$ifdef HasInt64},btQWordBool{$endif}:
  27676. Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
  27677. btByte,
  27678. btShortInt,
  27679. btWord,
  27680. btSmallInt,
  27681. btLongWord,
  27682. btLongint,
  27683. {$ifdef HasInt64}
  27684. btInt64,
  27685. btComp,
  27686. {$endif}
  27687. btIntSingle,
  27688. btUIntSingle,
  27689. btIntDouble,
  27690. btUIntDouble:
  27691. begin
  27692. Result:=TResEvalRangeInt.Create;
  27693. TResEvalRangeInt(Result).ElKind:=revskInt;
  27694. GetIntegerRange(BaseTypeData.BaseType,
  27695. TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
  27696. end;
  27697. end;
  27698. end;
  27699. end;
  27700. end;
  27701. function TPasResolver.HasTypeInfo(El: TPasType): boolean;
  27702. begin
  27703. Result:=false;
  27704. if El=nil then exit;
  27705. if El.CustomData is TResElDataBaseType then
  27706. exit(true); // base type
  27707. if El.Parent=nil then exit;
  27708. if El.Parent is TPasType then
  27709. begin
  27710. if not HasTypeInfo(TPasType(El.Parent)) then
  27711. exit;
  27712. end
  27713. else if ElHasModeSwitch(El,msOmitRTTI) then
  27714. exit
  27715. else if El.Parent is TPasAnonymousProcedure then
  27716. exit;
  27717. Result:=true;
  27718. end;
  27719. function TPasResolver.GetActualBaseType(bt: TResolverBaseType
  27720. ): TResolverBaseType;
  27721. begin
  27722. case bt of
  27723. btChar: Result:=BaseTypeChar;
  27724. btString: Result:=BaseTypeString;
  27725. btExtended: Result:=BaseTypeExtended;
  27726. else Result:=bt;
  27727. end;
  27728. end;
  27729. function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
  27730. ErrorEl: TPasElement): TResolverBaseType;
  27731. begin
  27732. if Bool1=Bool2 then exit(Bool1);
  27733. case Bool1 of
  27734. btBoolean: Result:=Bool2;
  27735. btByteBool: if Bool2<>btBoolean then Result:=Bool2;
  27736. btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
  27737. btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
  27738. {$ifdef HasInt64}
  27739. btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
  27740. {$endif}
  27741. else
  27742. RaiseNotYetImplemented(20170420093805,ErrorEl);
  27743. end;
  27744. end;
  27745. function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
  27746. ErrorEl: TPasElement): TResolverBaseType;
  27747. var
  27748. Precision1, Precision2: word;
  27749. Signed1, Signed2: boolean;
  27750. begin
  27751. if Int1.BaseType=Int2.BaseType then exit;
  27752. GetIntegerProps(Int1.BaseType,Precision1,Signed1);
  27753. GetIntegerProps(Int2.BaseType,Precision2,Signed2);
  27754. if Precision1=Precision2 then
  27755. begin
  27756. if Signed1<>Signed2 then
  27757. Precision1:=Max(Precision1,Precision2)+1;
  27758. end;
  27759. Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
  27760. end;
  27761. procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
  27762. Precision: word; out Signed: boolean);
  27763. begin
  27764. case bt of
  27765. btByte: begin Precision:=8; Signed:=false; end;
  27766. btShortInt: begin Precision:=8; Signed:=true; end;
  27767. btWord: begin Precision:=16; Signed:=false; end;
  27768. btSmallInt: begin Precision:=16; Signed:=true; end;
  27769. btIntSingle: begin Precision:=23; Signed:=true; end;
  27770. btUIntSingle: begin Precision:=22; Signed:=false; end;
  27771. btLongWord: begin Precision:=32; Signed:=false; end;
  27772. btLongint: begin Precision:=32; Signed:=true; end;
  27773. btIntDouble: begin Precision:=53; Signed:=true; end;
  27774. btUIntDouble: begin Precision:=52; Signed:=false; end;
  27775. {$ifdef HasInt64}
  27776. btQWord: begin Precision:=64; Signed:=false; end;
  27777. btInt64,btComp: begin Precision:=64; Signed:=true; end;
  27778. {$endif}
  27779. else
  27780. RaiseInternalError(20170420095727);
  27781. end;
  27782. end;
  27783. function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
  27784. MaxVal: TMaxPrecInt): boolean;
  27785. begin
  27786. Result:=true;
  27787. if bt=btExtended then bt:=BaseTypeExtended;
  27788. case bt of
  27789. btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
  27790. btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
  27791. btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
  27792. btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
  27793. btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
  27794. btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
  27795. {$ifdef HasInt64}
  27796. btInt64,
  27797. btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
  27798. {$endif}
  27799. btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
  27800. btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
  27801. btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
  27802. btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
  27803. btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
  27804. else
  27805. Result:=false;
  27806. end;
  27807. end;
  27808. function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
  27809. ErrorEl: TPasElement): TResolverBaseType;
  27810. begin
  27811. if Precision<=8 then
  27812. begin
  27813. if Signed then
  27814. Result:=btShortInt
  27815. else
  27816. Result:=btByte;
  27817. if BaseTypes[Result]<>nil then exit;
  27818. end;
  27819. if Precision<=16 then
  27820. begin
  27821. if Signed then
  27822. Result:=btSmallInt
  27823. else
  27824. Result:=btWord;
  27825. if BaseTypes[Result]<>nil then exit;
  27826. end;
  27827. if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
  27828. exit(btUIntSingle);
  27829. if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
  27830. exit(btIntSingle);
  27831. if Precision<=32 then
  27832. begin
  27833. if Signed then
  27834. Result:=btLongint
  27835. else
  27836. Result:=btLongWord;
  27837. if BaseTypes[Result]<>nil then exit;
  27838. end;
  27839. if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
  27840. exit(btUIntDouble);
  27841. if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
  27842. exit(btIntDouble);
  27843. {$ifdef HasInt64}
  27844. if Precision<=64 then
  27845. begin
  27846. if Signed then
  27847. Result:=btInt64
  27848. else
  27849. Result:=btQWord;
  27850. if BaseTypes[Result]<>nil then exit;
  27851. end;
  27852. {$endif}
  27853. if ErrorEl<>nil then
  27854. RaiseRangeCheck(20170420100336,ErrorEl)
  27855. else
  27856. Result:=btNone;
  27857. end;
  27858. function TPasResolver.GetSmallestIntegerBaseType(MinVal, MaxVal: TMaxPrecInt
  27859. ): TResolverBaseType;
  27860. // returns BaseTypeExtended if too big
  27861. var
  27862. V: TMaxPrecInt;
  27863. begin
  27864. if MinVal>MaxVal then
  27865. MinVal:=MaxVal;
  27866. if MinVal<0 then
  27867. begin
  27868. if MaxVal>-(MinVal+1) then
  27869. V:=MaxVal
  27870. else
  27871. V:=-(MinVal+1);
  27872. if V<=high(ShortInt) then
  27873. Result:=btShortInt
  27874. else if V<=high(SmallInt) then
  27875. Result:=btSmallInt
  27876. else if (BaseTypes[btIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  27877. Result:=btIntSingle
  27878. else if V<=High(Longint) then
  27879. Result:=btLongint
  27880. else if (BaseTypes[btIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  27881. Result:=btIntDouble
  27882. else
  27883. begin
  27884. Result:=btIntMax;
  27885. if BaseTypes[Result]=nil then
  27886. Result:=BaseTypeExtended;
  27887. end;
  27888. end
  27889. else
  27890. begin
  27891. V:=MaxVal;
  27892. if V<=high(Byte) then
  27893. Result:=btByte
  27894. else if V<=high(Word) then
  27895. Result:=btWord
  27896. else if (BaseTypes[btUIntSingle]<>nil) and (V<=MaxSafeIntSingle) then
  27897. Result:=btUIntSingle
  27898. else if V<=High(LongWord) then
  27899. Result:=btLongWord
  27900. else if (BaseTypes[btUIntDouble]<>nil) and (V<=MaxSafeIntDouble) then
  27901. Result:=btUIntDouble
  27902. else
  27903. begin
  27904. Result:=btIntMax;
  27905. if BaseTypes[Result]=nil then
  27906. Result:=BaseTypeExtended;
  27907. end;
  27908. end;
  27909. end;
  27910. function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
  27911. ErrorEl: TPasElement): TResolverBaseType;
  27912. var
  27913. bt1, bt2: TResolverBaseType;
  27914. begin
  27915. bt1:=GetActualBaseType(Char1.BaseType);
  27916. bt2:=GetActualBaseType(Char2.BaseType);
  27917. if bt1=bt2 then exit(bt1);
  27918. if not (bt1 in btAllChars) then
  27919. RaiseInternalError(20170420103128);
  27920. Result:=btWideChar;
  27921. if Result=BaseTypeChar then
  27922. Result:=btChar;
  27923. if ErrorEl=nil then ;
  27924. end;
  27925. function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
  27926. ErrorEl: TPasElement): TResolverBaseType;
  27927. var
  27928. bt1, bt2: TResolverBaseType;
  27929. begin
  27930. bt1:=GetActualBaseType(Str1.BaseType);
  27931. bt2:=GetActualBaseType(Str2.BaseType);
  27932. if bt1=bt2 then exit(bt1);
  27933. case bt1 of
  27934. {$ifdef FPC_HAS_CPSTRING}
  27935. btAnsiChar:
  27936. case bt2 of
  27937. btChar: Result:=btChar;
  27938. btWideChar: Result:=btWideChar;
  27939. else Result:=bt2;
  27940. end;
  27941. {$endif}
  27942. btWideChar:
  27943. case bt2 of
  27944. {$ifdef FPC_HAS_CPSTRING}
  27945. btAnsiChar: Result:=btWideChar;
  27946. {$endif}
  27947. btWideString: Result:=btWideString;
  27948. btString,btUnicodeString
  27949. {$ifdef FPC_HAS_CPSTRING},btShortString,btAnsiString,btRawByteString{$endif}:
  27950. Result:=btUnicodeString;
  27951. else RaiseNotYetImplemented(20170420103808,ErrorEl);
  27952. end;
  27953. {$ifdef FPC_HAS_CPSTRING}
  27954. btShortString:
  27955. case bt2 of
  27956. btChar,btAnsiChar: Result:=btShortString;
  27957. btString,btAnsiString: Result:=btAnsiString;
  27958. btRawByteString: Result:=btRawByteString;
  27959. btWideChar,btUnicodeString: Result:=btUnicodeString;
  27960. btWideString: Result:=btWideString;
  27961. else RaiseNotYetImplemented(20170420120937,ErrorEl);
  27962. end;
  27963. {$endif}
  27964. btString{$ifdef FPC_HAS_CPSTRING},btAnsiString{$endif}:
  27965. case bt2 of
  27966. {$ifdef FPC_HAS_CPSTRING}
  27967. btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
  27968. {$endif}
  27969. btWideChar,btUnicodeString: Result:=btUnicodeString;
  27970. btWideString: Result:=btWideString;
  27971. else RaiseNotYetImplemented(20170420121201,ErrorEl);
  27972. end;
  27973. {$ifdef FPC_HAS_CPSTRING}
  27974. btRawByteString:
  27975. case bt2 of
  27976. btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
  27977. btString,btAnsiString: Result:=btAnsiString;
  27978. btWideChar,btUnicodeString: Result:=btUnicodeString;
  27979. btWideString: Result:=btWideString;
  27980. else RaiseNotYetImplemented(20170420121352,ErrorEl);
  27981. end;
  27982. {$endif}
  27983. btWideString:
  27984. case bt2 of
  27985. btChar,btWideChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,btShortString,{$endif}btWideString:
  27986. Result:=btWideString;
  27987. btString,{$ifdef FPC_HAS_CPSTRING}btAnsiString,{$endif}btUnicodeString:
  27988. Result:=btUnicodeString;
  27989. else RaiseNotYetImplemented(20170420121532,ErrorEl);
  27990. end;
  27991. btUnicodeString:
  27992. Result:=btUnicodeString;
  27993. else
  27994. RaiseNotYetImplemented(20170420103153,ErrorEl);
  27995. end;
  27996. if Result=BaseTypeChar then
  27997. Result:=btChar
  27998. else if Result=BaseTypeString then
  27999. Result:=btString;
  28000. end;
  28001. function TPasResolver.GetCombinedBaseType(const A, B: TPasResolverResult;
  28002. ErrorEl: TPasElement): TResolverBaseType;
  28003. begin
  28004. Result:=btNone;
  28005. if A.BaseType in btAllBooleans then
  28006. begin
  28007. if B.BaseType in btAllBooleans then
  28008. Result:=GetCombinedBoolean(A.BaseType,B.BaseType,ErrorEl);
  28009. end
  28010. else if A.BaseType in btAllInteger then
  28011. begin
  28012. if B.BaseType in btAllInteger then
  28013. Result:=GetCombinedInt(A,B,ErrorEl);
  28014. end
  28015. else if A.BaseType in btAllChars then
  28016. begin
  28017. if B.BaseType in btAllChars then
  28018. Result:=GetCombinedChar(A,B,ErrorEl)
  28019. else if B.BaseType in btAllStrings then
  28020. Result:=GetCombinedString(A,B,ErrorEl);
  28021. end
  28022. else if A.BaseType in btAllStrings then
  28023. begin
  28024. if B.BaseType in btAllStringAndChars then
  28025. Result:=GetCombinedString(A,B,ErrorEl);
  28026. end;
  28027. end;
  28028. function TPasResolver.IsElementSkipped(El: TPasElement): boolean;
  28029. begin
  28030. Result:=El=nil;
  28031. end;
  28032. function TPasResolver.FindLocalBuiltInSymbol(El: TPasElement): TPasElement;
  28033. var
  28034. Data: TObject;
  28035. begin
  28036. Data:=El.CustomData;
  28037. if Data=nil then
  28038. RaiseInternalError(20180215185302,GetObjName(El));
  28039. if Data.ClassType=TResElDataBaseType then
  28040. Result:=BaseTypes[TResElDataBaseType(Data).BaseType]
  28041. else if Data.ClassType=TResElDataBuiltInProc then
  28042. Result:=BuiltInProcs[TResElDataBuiltInProc(Data).BuiltIn].Element
  28043. else
  28044. Result:=nil;
  28045. end;
  28046. function TPasResolver.GetFirstSection(WithUnitImpl: boolean): TPasSection;
  28047. var
  28048. Module: TPasModule;
  28049. begin
  28050. Result:=nil;
  28051. Module:=RootElement;
  28052. if Module=nil then exit;
  28053. if Module is TPasProgram then
  28054. Result:=TPasProgram(Module).ProgramSection
  28055. else if Module is TPasLibrary then
  28056. Result:=TPasLibrary(Module).LibrarySection
  28057. else
  28058. begin
  28059. Result:=Module.InterfaceSection;
  28060. if WithUnitImpl and (Result=nil) then
  28061. Result:=Module.ImplementationSection;
  28062. end;
  28063. end;
  28064. function TPasResolver.GetLastSection: TPasSection;
  28065. var
  28066. Module: TPasModule;
  28067. begin
  28068. Result:=nil;
  28069. Module:=RootElement;
  28070. if Module=nil then exit;
  28071. if Module is TPasProgram then
  28072. Result:=TPasProgram(Module).ProgramSection
  28073. else if Module is TPasLibrary then
  28074. Result:=TPasLibrary(Module).LibrarySection
  28075. else if Module.ImplementationSection<>nil then
  28076. Result:=Module.ImplementationSection
  28077. else
  28078. Result:=Module.InterfaceSection;
  28079. end;
  28080. function TPasResolver.GetParentSection(El: TPasElement): TPasSection;
  28081. begin
  28082. while El<>nil do
  28083. begin
  28084. if El is TPasSection then exit(TPasSection(El));
  28085. El:=El.Parent;
  28086. end;
  28087. Result:=nil;
  28088. end;
  28089. function TPasResolver.FindUsedUnitInSection(aMod: TPasModule;
  28090. Section: TPasSection): TPasUsesUnit;
  28091. var
  28092. Clause: TPasUsesClause;
  28093. i: Integer;
  28094. begin
  28095. Result:=nil;
  28096. if Section=nil then exit;
  28097. Clause:=Section.UsesClause;
  28098. for i:=0 to length(Clause)-1 do
  28099. if Clause[i].Module=aMod then exit(Clause[i]);
  28100. end;
  28101. function TPasResolver.FirstSectionUsesUnit(aModule: TPasModule): boolean;
  28102. var
  28103. aSection: TPasSection;
  28104. begin
  28105. Result:=false;
  28106. aSection:=GetFirstSection(false);
  28107. if aSection=nil then
  28108. exit;
  28109. Result:=FindUsedUnitInSection(aModule,aSection)<>nil;
  28110. end;
  28111. function TPasResolver.ImplementationUsesUnit(aModule: TPasModule;
  28112. NotInIntf: boolean): boolean;
  28113. var
  28114. MyModule: TPasModule;
  28115. begin
  28116. Result:=false;
  28117. MyModule:=RootElement;
  28118. if MyModule=nil then exit;
  28119. if FindUsedUnitInSection(aModule,MyModule.ImplementationSection)=nil then
  28120. exit;
  28121. if NotInIntf then
  28122. Result:=not FirstSectionUsesUnit(aModule);
  28123. end;
  28124. function TPasResolver.GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
  28125. isLoFunc: Boolean; out Mask: LongWord): Integer;
  28126. const
  28127. SHIFT_SIZE: array[btByte..{$IFDEF HasInt64}btComp{$ELSE}btIntDouble{$ENDIF}] of Integer = (
  28128. 4, // btByte
  28129. 8, // btShortInt FPC lo/hi(shortint) works like SmallInt
  28130. 8, 8, // btWord, btSmallInt
  28131. 16, 16, 16, 16, // btUIntSingle, btIntSingle, btLongWord, btLongint
  28132. 32, 32 // btUIntDouble, btIntDouble
  28133. {$IFDEF HasInt64}
  28134. , 32, 32, 32 // btQWord, btInt64, btComp
  28135. {$endif}
  28136. );
  28137. begin
  28138. if (BaseType >= Low(SHIFT_SIZE)) and (BaseType <= High(SHIFT_SIZE)) then
  28139. begin
  28140. if msDelphi in CurrentParser.CurrentModeswitches then
  28141. Result := 8
  28142. else
  28143. Result := SHIFT_SIZE[BaseType];
  28144. case Result of
  28145. 8: Mask := $FF;
  28146. 16: Mask := $FFFF;
  28147. 32: Mask := $FFFFFFFF;
  28148. else
  28149. {4} Mask := $F;
  28150. end;
  28151. if isLoFunc then
  28152. Result := 0;
  28153. end
  28154. else
  28155. begin
  28156. RaiseInternalError(20190130122300);
  28157. Result := -1;
  28158. end;
  28159. end;
  28160. function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
  28161. ResolvedDestType: TPasResolverResult): integer;
  28162. // finds distance between classes SrcType and DestType
  28163. begin
  28164. Result:=CheckClassIsClass(ResolvedSrcType.LoTypeEl,ResolvedDestType.LoTypeEl);
  28165. end;
  28166. function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType): integer;
  28167. // check if Src is equal or descends from Dest
  28168. // Generics: TBird<T> is both directions a TBird<word>
  28169. // and TBird<TMap<T>> is both directions a TBird<TMap<word>>
  28170. // but a TBird<word> is not a TBird<char>
  28171. function CheckSpecialized(SrcScope, DestScope: TPasGenericScope): boolean;
  28172. var
  28173. SrcParams, DestParams: TPasTypeArray;
  28174. i: Integer;
  28175. SrcParam, DestParam: TPasType;
  28176. SrcParamScope, DestParamScope: TPasGenericScope;
  28177. SrcSpecializedFromItem, DestSpecializedFromItem: TPRSpecializedItem;
  28178. begin
  28179. SrcSpecializedFromItem:=SrcScope.SpecializedFromItem;
  28180. DestSpecializedFromItem:=DestScope.SpecializedFromItem;
  28181. if SrcSpecializedFromItem=nil then
  28182. exit(false);
  28183. if DestSpecializedFromItem=nil then
  28184. exit(false);
  28185. if SrcSpecializedFromItem.GenericEl<>DestSpecializedFromItem.GenericEl then
  28186. exit(false);
  28187. // specialized from same generic -> check params
  28188. SrcParams:=SrcSpecializedFromItem.Params;
  28189. DestParams:=DestSpecializedFromItem.Params;
  28190. for i:=0 to length(SrcParams)-1 do
  28191. begin
  28192. SrcParam:=SrcParams[i];
  28193. DestParam:=DestParams[i];
  28194. if (SrcParam is TPasGenericTemplateType)
  28195. or (DestParam is TPasGenericTemplateType)
  28196. or (SrcParam=DestParam)
  28197. then
  28198. // ok
  28199. else if (SrcParam is TPasGenericType) and (DestParam is TPasGenericType) then
  28200. begin
  28201. // e.g. TList<Src<...>> and TList<Dest<...>>
  28202. SrcParamScope:=SrcParam.CustomData as TPasGenericScope;
  28203. DestParamScope:=DestParam.CustomData as TPasGenericScope;
  28204. if not CheckSpecialized(SrcParamScope,DestParamScope) then
  28205. exit(false);
  28206. end
  28207. else
  28208. exit(false); // specialized with different params -> incompatible
  28209. end;
  28210. Result:=true;
  28211. end;
  28212. var
  28213. SrcClassEl: TPasClassType;
  28214. SrcScope, DestScope: TPasClassScope;
  28215. GenericType: TPasGenericType;
  28216. begin
  28217. {$IFDEF VerbosePasResolver}
  28218. writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  28219. {$ENDIF}
  28220. if DestType=nil then exit(cIncompatible);
  28221. DestType:=ResolveAliasType(DestType);
  28222. if DestType.ClassType<>TPasClassType then
  28223. exit(cIncompatible);
  28224. DestScope:=DestType.CustomData as TPasClassScope;
  28225. Result:=cExact;
  28226. while SrcType<>nil do
  28227. begin
  28228. {$IFDEF VerbosePasResolver}
  28229. writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
  28230. {$ENDIF}
  28231. if SrcType=DestType then
  28232. exit
  28233. else if SrcType.ClassType=TPasAliasType then
  28234. // alias -> skip
  28235. SrcType:=TPasAliasType(SrcType).DestType
  28236. else if SrcType.ClassType=TPasTypeAliasType then
  28237. begin
  28238. // type alias -> increase distance
  28239. SrcType:=TPasAliasType(SrcType).DestType;
  28240. inc(Result);
  28241. end
  28242. else if SrcType.ClassType=TPasSpecializeType then
  28243. begin
  28244. // specialize -> skip
  28245. if SrcType.CustomData is TPasSpecializeTypeData then
  28246. SrcType:=TPasSpecializeTypeData(SrcType.CustomData).SpecializedType
  28247. else
  28248. SrcType:=TPasSpecializeType(SrcType).DestType;
  28249. end
  28250. else if SrcType.ClassType=TPasClassType then
  28251. begin
  28252. SrcClassEl:=TPasClassType(SrcType);
  28253. if SrcClassEl.IsForward then
  28254. // class forward -> skip
  28255. SrcType:=(SrcClassEl.CustomData as TResolvedReference).Declaration as TPasType
  28256. else
  28257. begin
  28258. if (SrcClassEl.GenericTemplateTypes<>nil) and (SrcClassEl.GenericTemplateTypes.Count>0) then
  28259. begin
  28260. // SrcType is a generic
  28261. if DestScope.SpecializedFromItem<>nil then
  28262. begin
  28263. // DestType is specialized
  28264. GenericType:=TPasGenericType(DestScope.SpecializedFromItem.GenericEl);
  28265. {$IFDEF VerbosePasResolver}
  28266. writeln(' DestType is specialized from ',GetObjName(GenericType));
  28267. {$ENDIF}
  28268. if SrcType=GenericType then
  28269. exit; // DestType is a specialized SrcType
  28270. end;
  28271. end;
  28272. SrcScope:=SrcClassEl.CustomData as TPasClassScope;
  28273. if (SrcScope.SpecializedFromItem<>nil)
  28274. and (DestScope.SpecializedFromItem<>nil)
  28275. and CheckSpecialized(SrcScope,DestScope) then
  28276. exit;
  28277. // class ancestor -> increase distance
  28278. SrcType:=SrcScope.DirectAncestor;
  28279. inc(Result);
  28280. end;
  28281. end
  28282. else
  28283. exit(cIncompatible);
  28284. end;
  28285. Result:=cIncompatible;
  28286. end;
  28287. function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType): integer;
  28288. begin
  28289. Result:=CheckClassIsClass(TypeA,TypeB);
  28290. if Result<>cIncompatible then exit;
  28291. Result:=CheckClassIsClass(TypeB,TypeA);
  28292. end;
  28293. function TPasResolver.CheckAssignCompatibilityClasses(LType,
  28294. RType: TPasClassType): integer;
  28295. begin
  28296. Result:=cIncompatible;
  28297. if LType=nil then ;
  28298. if RType=nil then ;
  28299. end;
  28300. function TPasResolver.GetClassImplementsIntf(ClassEl, Intf: TPasClassType
  28301. ): TPasClassType;
  28302. begin
  28303. Result:=nil;
  28304. while ClassEl<>nil do
  28305. begin
  28306. if (ClassEl=Intf) or (IndexOfImplementedInterface(ClassEl,Intf)>=0) then
  28307. exit(ClassEl);
  28308. ClassEl:=GetPasClassAncestor(ClassEl,true) as TPasClassType;
  28309. end;
  28310. end;
  28311. end.